[BACK]Return to lonmetadata_test.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / metadata_database

Diff for /loncom/metadata_database/lonmetadata_test.pl between versions 1.1 and 1.5

version 1.1, 2004/01/12 21:33:19 version 1.5, 2004/06/11 19:52:12
Line 30  use strict; Line 30  use strict;
   
 use DBI;  use DBI;
 use LONCAPA::lonmetadata();  use LONCAPA::lonmetadata();
 use Test::Simple tests => 3;  use Test::Simple tests => 7;
   
   ##
   ##  Note: The root password to my MySQL server is shown below.
   ##  Access is only allowed from localhost so it should be okay.
   ##  Now if you will excuse me I have to change the password on my luggage.
   ##
   my $supersecretpassword = '123';  # shhhh
   
 ok(&create_test_db(),'database creation');  ok(&create_test_db(),'database creation');
 ok(&test_creation(),'table creation');  ok(&test_creation(),'table creation');
   ok(&test_named_creation(),'named table creation');
 ok(&test_inserts(),'insert test');  ok(&test_inserts(),'insert test');
   ok(&test_retrieval(),'retrieval test');
   ok(&test_delete(),'delete test');
   ok(&test_update(),'update test');
   
 exit;  exit;
   
Line 47  exit; Line 57  exit;
 #####################################################################  #####################################################################
 #####################################################################  #####################################################################
 sub create_test_db {  sub create_test_db {
     my $dbh = DBI->connect("DBI:mysql:test","root","123",      my $dbh = DBI->connect("DBI:mysql:test","root",$supersecretpassword,
                            { RaiseError =>0,PrintError=>0});                             { RaiseError =>0,PrintError=>0});
     if (! defined($dbh)) {      if (! defined($dbh)) {
         return 0;          return 0;
Line 65  sub create_test_db { Line 75  sub create_test_db {
 }  }
   
 sub test_creation {  sub test_creation {
     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root","123",      my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                            { RaiseError =>0,PrintError=>0});                             { RaiseError =>0,PrintError=>0});
     my $request = &LONCAPA::lonmetadata::create_metadata_storage();      my $request = &LONCAPA::lonmetadata::create_metadata_storage();
     $dbh->do($request);      $dbh->do($request);
Line 78  sub test_creation { Line 88  sub test_creation {
     }      }
 }  }
   
   sub test_named_creation {
       my $request = 
                &LONCAPA::lonmetadata::create_metadata_storage('nonmetadata');
       my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                              { RaiseError =>0,PrintError=>0});
       $dbh->do($request); # Create the table, only return 0 if we cannot.
       if ($dbh->err) {
           $dbh->disconnect();
           return 0;
       }
       $dbh->do('DROP TABLE nonmetadata'); # This will generate an error if the
                                           # table does not exist
       if ($dbh->err) {
           $dbh->disconnect();
           return 0;
       }
       return 1;
   }
   
 sub test_inserts {  sub test_inserts {
     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root","123",      my @TestRecords = &testrecords();
       my $tablename = 'metadatatest';
       my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                              { RaiseError =>1,PrintError=>1});
       # Create the table
       my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename);
       $dbh->do($request);
       if ($dbh->err) {
           $dbh->disconnect();
           warn "Unable to create table for test";
           return 0;
       }
       # Store the sample records
       foreach my $data (@TestRecords) {
           my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,
                                                                      $tablename,
                                                                      $data);
           if (! $count) {
               warn $error;
               return 0;
           }
       }
       $dbh->do('DROP TABLE '.$tablename);
       $dbh->disconnect();
       return 1;
   }
   
   sub test_retrieval {
       &LONCAPA::lonmetadata::clear_sth();
       my $tablename = 'metadatatest';
       my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                              { RaiseError =>0,PrintError=>0});
       if (! &build_test_table($dbh,$tablename)) {
           warn "Unable to build test table\n";
           return 0;
       }
       # Retrieve records
       my $count=0;
       my @TestRecords = &testrecords();
       foreach my $data (@TestRecords) {
           my ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
                                 ($dbh,' url='.$dbh->quote($data->{'url'}),
                                  undef,$tablename);
           if ($error) {
               warn "Retrieval error for item $count\n";
               return 0;
           }
           my %fromdb = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
           if (&metadata_do_not_match($data,\%fromdb)) {
               warn(&metadata_mismatch_error.$/);
               return 0;
           }
           $count++;
       }
       #
       $dbh->do('DROP TABLE '.$tablename);
       $dbh->disconnect();
       return 1;
   }
   
   sub test_delete {
       my $tablename = 'metadatatest';
       my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                              { RaiseError =>0,PrintError=>0});
       if (! &build_test_table($dbh,$tablename)) {
           return 0;
       }
       my @TestRecords = &testrecords();
       foreach my $record (@TestRecords) {
           my $error = &LONCAPA::lonmetadata::delete_metadata($dbh,$tablename,
                                                              $record->{'url'});
           if ($error) {
               warn $error;
               return 0;
           }
           # Verify delete has taken place
           my $row;
           ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
                                 ($dbh,' url='.$dbh->quote($record->{'url'}),
                                  undef,$tablename);
           if (defined($row) && ref($row) eq 'ARRAY' && defined($row->[0])) {
               # We retrieved the record we just deleted.  This is BAD.
               return 1;
           }
       }
       $dbh->do('DROP TABLE '.$tablename);
       $dbh->disconnect();
       return 1;
   }
   
   sub test_update {
       my $tablename = 'metadatatest';
       my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                            { RaiseError =>0,PrintError=>0});                             { RaiseError =>0,PrintError=>0});
     my @TestRecords = (      if (! &build_test_table($dbh,$tablename)) {
                       { url => 'm/b/h/test1' },          return 0;
                       { title => 'test document 1',      }
                         author => 'matthew',      my @TestRecords = &testrecords();
                         subject => 'subject 1',      foreach my $record (@TestRecords) {
                         url => 'm/b/h/test2',          $record->{'title'}.= 'newtitle';
                         keywords => 'key word',          my $error = &LONCAPA::lonmetadata::update_metadata
                         version => '1.4',              ($dbh,$tablename,
                         notes => 'note note note',               { url   => $record->{'url'},
                         abstract => 'probably',                 title => $record->{'title'} });
                         mime => 'none',          if ($error) {
                         language => 'english',              warn $error.$/;
                         creationdate =>'',              return 0;
                         lastrevisiondate =>'',          }
                         owner => 'hallmat3',          my $row;
                         copyright => 'default',          ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
                         dependencies => undef,                      ($dbh,' url='.$dbh->quote($record->{'url'}),
                         modifyinguser => 'hallmat3',                       undef,$tablename);
                         authorspace => 'hallmat3',          if ($error) {
                         lowestgradelevel =>'1',              warn $error.$/;
                         highestgradelevel => 16,              return 0;
                         standards => 'Delaware Required Instruction Program',          }
                         count => '2544444',          my %fromdb = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
                         course => '4',          if (&metadata_do_not_match($record,\%fromdb)) {
                         course_list => 'course 1, course 2, course 3, course 4',              warn(&metadata_mismatch_error.$/);
                         goto => '1',              return 0;
                         goto_list =>'m/b/h/test1',          }
                         comefrom => '0',      }
                         comefrom_list =>'',      #
                         sequsage => '1',      # Now test by updating a resource that does not have an entry.
                         sequsage_list =>'mbhtest.sequence',      my @NewThings = (
                         stdno => '0',              { url => 'm/b/h/test100' },
                         stdno_list => '',              { url => "m/b/h/t'e\"st101" },
                         avetries => '0.0',              { title => 'test document 102',
                         avetries_list =>'',                author => 'matthew',
                         difficulty =>'',                subject => 'subject 1',
                         difficulty_list => '',                url => 'm/b/h/test102',
                         clear => '5',                keywords => 'key word',
                         technical => '4',                version => '1.4',
                         correct => '3',                notes => 'note note note',
                         helpful => '2',                abstract => 'probably' },);
                         depth => '5',      foreach my $record (@NewThings) {
                         hostname =>'6',          print "testing ".$record->{'url'}.$/;
                     },          my $error = &LONCAPA::lonmetadata::update_metadata
                       );              ($dbh,$tablename,$record);
           if ($error) {
               warn $error.$/;
               return 0;
           }
           my $row;
           ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
                       ($dbh,' url='.$dbh->quote($record->{'url'}),
                        undef,$tablename);
           if ($error) {
               warn $error.$/;
               return 0;
           }
           my %fromdb = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
           if (&metadata_do_not_match($record,\%fromdb)) {
               warn(&metadata_mismatch_error.$/);
               return 0;
           }
       }
       $dbh->do('DROP TABLE '.$tablename);
       $dbh->disconnect();
       return 1;
   }
   
   ##################################################################
   ##################################################################
   sub build_test_table {
       my ($dbh,$tablename) = @_;
       &LONCAPA::lonmetadata::clear_sth();
       if (! defined($tablename)) {
           warn "No table name specified in build_test_table.\n";
           return 0;
       }
       my @TestRecords = &testrecords();
       # Create the table
       my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename);
       $dbh->do($request);
       if ($dbh->err) {
           $dbh->disconnect();
           warn "Unable to create table for test";
           return 0;
       }
       # Store the sample records 
     foreach my $data (@TestRecords) {      foreach my $data (@TestRecords) {
         my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,$data);          my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,
                                                                      $tablename,
                                                                      $data); 
         if (! $count) {          if (! $count) {
             warn $error;              warn $error;
             return 0;              return 0;
Line 135  sub test_inserts { Line 300  sub test_inserts {
     }      }
     return 1;      return 1;
 }  }
   
   ##################################################################
   ##################################################################
   sub testrecords {
       return (
               { url => 'm/b/h/test1' },
               { url => "m/b/h/t'e\"st1" },
               { title => 'test document 1',
                 author => 'matthew',
                 subject => 'subject 1',
                 url => 'm/b/h/test2',
                 keywords => 'key word',
                 version => '1.4',
                 notes => 'note note note',
                 abstract => 'probably',
                 mime => 'none',
                 language => 'english',
                 creationdate =>'',
                 lastrevisiondate =>'',
                 owner => 'hallmat3',
                 copyright => 'default',
                 dependencies => undef,
                 modifyinguser => 'hallmat3',
                 authorspace => 'hallmat3',
                 lowestgradelevel =>'1',
                 highestgradelevel => 16,
                 standards => 'Delaware Required Instruction Program',
                 count => '2544444',
                 course => '4',
                 course_list => 'course 1, course 2, course 3, course 4',
                 goto => '1',
                 goto_list =>'m/b/h/test1',
                 comefrom => '0',
                 comefrom_list =>'',
                 sequsage => '1',
                 sequsage_list =>'mbhtest.sequence',
                 stdno => '0',
                 stdno_list => '',
                 avetries => '0.0',
                 avetries_list =>'',
                 difficulty =>'',
                 difficulty_list => '',
                 clear => '5',
                 technical => '4',
                 correct => '3',
                 helpful => '2',
                 depth => '5',
                 hostname =>'6',
             },
               );
   }
   
   ##################################################################
   ##################################################################
   {
   
       my $error;
   
   sub metadata_do_not_match {
       my ($orig,$fromdb) = @_;
       my %checkedfields;
       my $url = $orig->{'url'};
       foreach my $field (keys(%$orig)){
           #
           # Make sure the field exists
           if (! exists($fromdb->{$field})) {
               $error = 'url='.$url.': field '.$field.' missing.';
               return 1;
           }
           #
           # Make sure each field matches
           my ($old,$new) = ($orig->{$field},$fromdb->{$field});
           if (! defined($new) && ! defined($old)) {
               next;
           } elsif (! defined($new) && defined($old)){
               if ($old eq '') {
                   next; # This is okay, we treat undef and '' equivalently.
               } else {
                   $error  = 'url='.$url.' mismatch on '.$field.$/;
                   $error .= 'old="'.$orig->{'field'}.'" new=undef'.$/;
                   return 1;
               }
           } elsif (defined($new) && ! defined($old)) {
               if ($new eq '') {
                   next; # This is okay, we treat undef and '' equivalently.
               } else {
                   $error  = 'url='.$url.' mismatch on '.$field.$/;
                   $error .= 'old=undef new="'.$new.'"'.$/;
                   return 1;
               }
           } elsif (($old ne $new)) {
               if ($field =~ /date$/  && $old eq '' && 
                   $new eq '0000-00-00 00:00:00') {
                   # '' is the same as '0' for dates
                   next;
               }
               if ($old =~ /\d*\.?\d*/) {
                   next if (abs($old - $new) < 0.000001);
               }
               #
               $error  = 'url='.$url.' mismatch on '.$field.$/;
               $error .= 'old="'.$old.'" new="'.$new.'"';
               return 1;
           }
           #
           $checkedfields{$field}++;
       }
       foreach my $k (keys(%{$fromdb})) {
           next if (exists($checkedfields{$k}));
           next if (! defined($fromdb->{$k}));
           next if ($fromdb->{$k} eq '' ||
                    $fromdb->{$k} eq '0' ||
                    $fromdb->{$k} eq '0000-00-00 00:00:00');
           $error = 'new has field '.$k.' which old does not have.  '.
               'value = '.$fromdb->{$k};
           return 1;
       }
       return 0;
   }
   
   sub metadata_mismatch_error {
       return $error;
   }
   
   }
Removed from v.1.1  
changed lines
  Added in v.1.5

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>