[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.4 and 1.5

version 1.4, 2004/04/08 14:51: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 => 4;  use Test::Simple tests => 7;
   
 ##  ##
 ##  Note: The root password to my MySQL server is shown below.  ##  Note: The root password to my MySQL server is shown below.
Line 43  ok(&create_test_db(),'database creation' Line 43  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_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 100  sub test_named_creation { Line 103  sub test_named_creation {
     if ($dbh->err) {      if ($dbh->err) {
         $dbh->disconnect();          $dbh->disconnect();
         return 0;          return 0;
     } else {  
         $dbh->disconnect();  
         return 1;  
     }      }
       return 1;
 }  }
   
 sub test_inserts {  sub test_inserts {
       my @TestRecords = &testrecords();
     my $tablename = 'metadatatest';      my $tablename = 'metadatatest';
     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,      my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
                            { RaiseError =>0,PrintError=>0});                             { RaiseError =>1,PrintError=>1});
     my @TestRecords = (  
                       { url => 'm/b/h/test1' },  
                       { 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',  
                     },  
                       );  
     # Create the table      # Create the table
     my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename);      my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename);
     $dbh->do($request);      $dbh->do($request);
Line 162  sub test_inserts { Line 119  sub test_inserts {
         $dbh->disconnect();          $dbh->disconnect();
         warn "Unable to create table for test";          warn "Unable to create table for test";
         return 0;          return 0;
     } else {  
         $dbh->disconnect();  
         return 1;  
     }      }
     # Store the sample records      # Store the sample records
     foreach my $data (@TestRecords) {      foreach my $data (@TestRecords) {
Line 176  sub test_inserts { Line 130  sub test_inserts {
             return 0;              return 0;
         }          }
     }      }
       $dbh->do('DROP TABLE '.$tablename);
       $dbh->disconnect();
     return 1;      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});
       if (! &build_test_table($dbh,$tablename)) {
           return 0;
       }
       my @TestRecords = &testrecords();
       foreach my $record (@TestRecords) {
           $record->{'title'}.= 'newtitle';
           my $error = &LONCAPA::lonmetadata::update_metadata
               ($dbh,$tablename,
                { url   => $record->{'url'},
                  title => $record->{'title'} });
           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;
           }
       }
       #
       # Now test by updating a resource that does not have an entry.
       my @NewThings = (
               { url => 'm/b/h/test100' },
               { url => "m/b/h/t'e\"st101" },
               { title => 'test document 102',
                 author => 'matthew',
                 subject => 'subject 1',
                 url => 'm/b/h/test102',
                 keywords => 'key word',
                 version => '1.4',
                 notes => 'note note note',
                 abstract => 'probably' },);
       foreach my $record (@NewThings) {
           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) {
           my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,
                                                                      $tablename,
                                                                      $data); 
           if (! $count) {
               warn $error;
               return 0;
           }
       }
       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.4  
changed lines
  Added in v.1.5

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