Return to lonmetadata_test.pl CVS log

Up to [LON-CAPA] / loncom / metadata_database

lonmetadata:
  Minor changes to &store_metadata, should be a little more readable now.
  &lookup_metadata: added $tablename input parameter, defaults to 'metadata'.
  Implemented &delete_metadata
  Added &update_metadata
lonmetadata_test.pl:
  Added tests for &lookup_metadata, &delete_metadata, and &update_metadata
  Added utility routines &metadata_do_not_match, &metadata_mismatch_error,
  &testrecords, &build_test_table.

    1: #!/usr/bin/perl -w
    2: # The LearningOnline Network with CAPA
    3: #
    4: # $Id: lonmetadata_test.pl,v 1.5 2004/06/11 19:52:12 matthew Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ######################################################################
   29: use strict;
   30: 
   31: use DBI;
   32: use LONCAPA::lonmetadata();
   33: use Test::Simple tests => 7;
   34: 
   35: ##
   36: ##  Note: The root password to my MySQL server is shown below.
   37: ##  Access is only allowed from localhost so it should be okay.
   38: ##  Now if you will excuse me I have to change the password on my luggage.
   39: ##
   40: my $supersecretpassword = '123';  # shhhh
   41: 
   42: ok(&create_test_db(),'database creation');
   43: ok(&test_creation(),'table creation');
   44: ok(&test_named_creation(),'named table creation');
   45: ok(&test_inserts(),'insert test');
   46: ok(&test_retrieval(),'retrieval test');
   47: ok(&test_delete(),'delete test');
   48: ok(&test_update(),'update test');
   49: 
   50: exit;
   51: 
   52: #####################################################################
   53: #####################################################################
   54: ##
   55: ##  Tests live down below
   56: ##
   57: #####################################################################
   58: #####################################################################
   59: sub create_test_db {
   60:     my $dbh = DBI->connect("DBI:mysql:test","root",$supersecretpassword,
   61:                            { RaiseError =>0,PrintError=>0});
   62:     if (! defined($dbh)) {
   63:         return 0;
   64:     }
   65:     my $request = 'DROP DATABASE IF EXISTS lonmetatest';
   66:     $dbh->do($request);
   67:     $request = 'CREATE DATABASE lonmetatest';
   68:     $dbh->do($request);
   69:     if ($dbh->err) {
   70:         return 0;
   71:     } else {
   72:         return 1;
   73:     }
   74:     $dbh->disconnect();
   75: }
   76: 
   77: sub test_creation {
   78:     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
   79:                            { RaiseError =>0,PrintError=>0});
   80:     my $request = &LONCAPA::lonmetadata::create_metadata_storage();
   81:     $dbh->do($request);
   82:     if ($dbh->err) {
   83:         $dbh->disconnect();
   84:         return 0;
   85:     } else {
   86:         $dbh->disconnect();
   87:         return 1;
   88:     }
   89: }
   90: 
   91: sub test_named_creation {
   92:     my $request = 
   93:              &LONCAPA::lonmetadata::create_metadata_storage('nonmetadata');
   94:     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
   95:                            { RaiseError =>0,PrintError=>0});
   96:     $dbh->do($request); # Create the table, only return 0 if we cannot.
   97:     if ($dbh->err) {
   98:         $dbh->disconnect();
   99:         return 0;
  100:     }
  101:     $dbh->do('DROP TABLE nonmetadata'); # This will generate an error if the
  102:                                         # table does not exist
  103:     if ($dbh->err) {
  104:         $dbh->disconnect();
  105:         return 0;
  106:     }
  107:     return 1;
  108: }
  109: 
  110: sub test_inserts {
  111:     my @TestRecords = &testrecords();
  112:     my $tablename = 'metadatatest';
  113:     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
  114:                            { RaiseError =>1,PrintError=>1});
  115:     # Create the table
  116:     my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename);
  117:     $dbh->do($request);
  118:     if ($dbh->err) {
  119:         $dbh->disconnect();
  120:         warn "Unable to create table for test";
  121:         return 0;
  122:     }
  123:     # Store the sample records
  124:     foreach my $data (@TestRecords) {
  125:         my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,
  126:                                                                    $tablename,
  127:                                                                    $data);
  128:         if (! $count) {
  129:             warn $error;
  130:             return 0;
  131:         }
  132:     }
  133:     $dbh->do('DROP TABLE '.$tablename);
  134:     $dbh->disconnect();
  135:     return 1;
  136: }
  137: 
  138: sub test_retrieval {
  139:     &LONCAPA::lonmetadata::clear_sth();
  140:     my $tablename = 'metadatatest';
  141:     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
  142:                            { RaiseError =>0,PrintError=>0});
  143:     if (! &build_test_table($dbh,$tablename)) {
  144:         warn "Unable to build test table\n";
  145:         return 0;
  146:     }
  147:     # Retrieve records
  148:     my $count=0;
  149:     my @TestRecords = &testrecords();
  150:     foreach my $data (@TestRecords) {
  151:         my ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
  152:                               ($dbh,' url='.$dbh->quote($data->{'url'}),
  153:                                undef,$tablename);
  154:         if ($error) {
  155:             warn "Retrieval error for item $count\n";
  156:             return 0;
  157:         }
  158:         my %fromdb = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
  159:         if (&metadata_do_not_match($data,\%fromdb)) {
  160:             warn(&metadata_mismatch_error.$/);
  161:             return 0;
  162:         }
  163:         $count++;
  164:     }
  165:     #
  166:     $dbh->do('DROP TABLE '.$tablename);
  167:     $dbh->disconnect();
  168:     return 1;
  169: }
  170: 
  171: sub test_delete {
  172:     my $tablename = 'metadatatest';
  173:     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
  174:                            { RaiseError =>0,PrintError=>0});
  175:     if (! &build_test_table($dbh,$tablename)) {
  176:         return 0;
  177:     }
  178:     my @TestRecords = &testrecords();
  179:     foreach my $record (@TestRecords) {
  180:         my $error = &LONCAPA::lonmetadata::delete_metadata($dbh,$tablename,
  181:                                                            $record->{'url'});
  182:         if ($error) {
  183:             warn $error;
  184:             return 0;
  185:         }
  186:         # Verify delete has taken place
  187:         my $row;
  188:         ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
  189:                               ($dbh,' url='.$dbh->quote($record->{'url'}),
  190:                                undef,$tablename);
  191:         if (defined($row) && ref($row) eq 'ARRAY' && defined($row->[0])) {
  192:             # We retrieved the record we just deleted.  This is BAD.
  193:             return 1;
  194:         }
  195:     }
  196:     $dbh->do('DROP TABLE '.$tablename);
  197:     $dbh->disconnect();
  198:     return 1;
  199: }
  200: 
  201: sub test_update {
  202:     my $tablename = 'metadatatest';
  203:     my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
  204:                            { RaiseError =>0,PrintError=>0});
  205:     if (! &build_test_table($dbh,$tablename)) {
  206:         return 0;
  207:     }
  208:     my @TestRecords = &testrecords();
  209:     foreach my $record (@TestRecords) {
  210:         $record->{'title'}.= 'newtitle';
  211:         my $error = &LONCAPA::lonmetadata::update_metadata
  212:             ($dbh,$tablename,
  213:              { url   => $record->{'url'},
  214:                title => $record->{'title'} });
  215:         if ($error) {
  216:             warn $error.$/;
  217:             return 0;
  218:         }
  219:         my $row;
  220:         ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
  221:                     ($dbh,' url='.$dbh->quote($record->{'url'}),
  222:                      undef,$tablename);
  223:         if ($error) {
  224:             warn $error.$/;
  225:             return 0;
  226:         }
  227:         my %fromdb = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
  228:         if (&metadata_do_not_match($record,\%fromdb)) {
  229:             warn(&metadata_mismatch_error.$/);
  230:             return 0;
  231:         }
  232:     }
  233:     #
  234:     # Now test by updating a resource that does not have an entry.
  235:     my @NewThings = (
  236:             { url => 'm/b/h/test100' },
  237:             { url => "m/b/h/t'e\"st101" },
  238:             { title => 'test document 102',
  239:               author => 'matthew',
  240:               subject => 'subject 1',
  241:               url => 'm/b/h/test102',
  242:               keywords => 'key word',
  243:               version => '1.4',
  244:               notes => 'note note note',
  245:               abstract => 'probably' },);
  246:     foreach my $record (@NewThings) {
  247:         print "testing ".$record->{'url'}.$/;
  248:         my $error = &LONCAPA::lonmetadata::update_metadata
  249:             ($dbh,$tablename,$record);
  250:         if ($error) {
  251:             warn $error.$/;
  252:             return 0;
  253:         }
  254:         my $row;
  255:         ($error,$row) = &LONCAPA::lonmetadata::lookup_metadata
  256:                     ($dbh,' url='.$dbh->quote($record->{'url'}),
  257:                      undef,$tablename);
  258:         if ($error) {
  259:             warn $error.$/;
  260:             return 0;
  261:         }
  262:         my %fromdb = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
  263:         if (&metadata_do_not_match($record,\%fromdb)) {
  264:             warn(&metadata_mismatch_error.$/);
  265:             return 0;
  266:         }
  267:     }
  268:     $dbh->do('DROP TABLE '.$tablename);
  269:     $dbh->disconnect();
  270:     return 1;
  271: }
  272: 
  273: ##################################################################
  274: ##################################################################
  275: sub build_test_table {
  276:     my ($dbh,$tablename) = @_;
  277:     &LONCAPA::lonmetadata::clear_sth();
  278:     if (! defined($tablename)) {
  279:         warn "No table name specified in build_test_table.\n";
  280:         return 0;
  281:     }
  282:     my @TestRecords = &testrecords();
  283:     # Create the table
  284:     my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename);
  285:     $dbh->do($request);
  286:     if ($dbh->err) {
  287:         $dbh->disconnect();
  288:         warn "Unable to create table for test";
  289:         return 0;
  290:     }
  291:     # Store the sample records 
  292:     foreach my $data (@TestRecords) {
  293:         my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,
  294:                                                                    $tablename,
  295:                                                                    $data); 
  296:         if (! $count) {
  297:             warn $error;
  298:             return 0;
  299:         }
  300:     }
  301:     return 1;
  302: }
  303: 
  304: ##################################################################
  305: ##################################################################
  306: sub testrecords {
  307:     return (
  308:             { url => 'm/b/h/test1' },
  309:             { url => "m/b/h/t'e\"st1" },
  310:             { title => 'test document 1',
  311:               author => 'matthew',
  312:               subject => 'subject 1',
  313:               url => 'm/b/h/test2',
  314:               keywords => 'key word',
  315:               version => '1.4',
  316:               notes => 'note note note',
  317:               abstract => 'probably',
  318:               mime => 'none',
  319:               language => 'english',
  320:               creationdate =>'',
  321:               lastrevisiondate =>'',
  322:               owner => 'hallmat3',
  323:               copyright => 'default',
  324:               dependencies => undef,
  325:               modifyinguser => 'hallmat3',
  326:               authorspace => 'hallmat3',
  327:               lowestgradelevel =>'1',
  328:               highestgradelevel => 16,
  329:               standards => 'Delaware Required Instruction Program',
  330:               count => '2544444',
  331:               course => '4',
  332:               course_list => 'course 1, course 2, course 3, course 4',
  333:               goto => '1',
  334:               goto_list =>'m/b/h/test1',
  335:               comefrom => '0',
  336:               comefrom_list =>'',
  337:               sequsage => '1',
  338:               sequsage_list =>'mbhtest.sequence',
  339:               stdno => '0',
  340:               stdno_list => '',
  341:               avetries => '0.0',
  342:               avetries_list =>'',
  343:               difficulty =>'',
  344:               difficulty_list => '',
  345:               clear => '5',
  346:               technical => '4',
  347:               correct => '3',
  348:               helpful => '2',
  349:               depth => '5',
  350:               hostname =>'6',
  351:           },
  352:             );
  353: }
  354: 
  355: ##################################################################
  356: ##################################################################
  357: {
  358: 
  359:     my $error;
  360: 
  361: sub metadata_do_not_match {
  362:     my ($orig,$fromdb) = @_;
  363:     my %checkedfields;
  364:     my $url = $orig->{'url'};
  365:     foreach my $field (keys(%$orig)){
  366:         #
  367:         # Make sure the field exists
  368:         if (! exists($fromdb->{$field})) {
  369:             $error = 'url='.$url.': field '.$field.' missing.';
  370:             return 1;
  371:         }
  372:         #
  373:         # Make sure each field matches
  374:         my ($old,$new) = ($orig->{$field},$fromdb->{$field});
  375:         if (! defined($new) && ! defined($old)) {
  376:             next;
  377:         } elsif (! defined($new) && defined($old)){
  378:             if ($old eq '') {
  379:                 next; # This is okay, we treat undef and '' equivalently.
  380:             } else {
  381:                 $error  = 'url='.$url.' mismatch on '.$field.$/;
  382:                 $error .= 'old="'.$orig->{'field'}.'" new=undef'.$/;
  383:                 return 1;
  384:             }
  385:         } elsif (defined($new) && ! defined($old)) {
  386:             if ($new eq '') {
  387:                 next; # This is okay, we treat undef and '' equivalently.
  388:             } else {
  389:                 $error  = 'url='.$url.' mismatch on '.$field.$/;
  390:                 $error .= 'old=undef new="'.$new.'"'.$/;
  391:                 return 1;
  392:             }
  393:         } elsif (($old ne $new)) {
  394:             if ($field =~ /date$/  && $old eq '' && 
  395:                 $new eq '0000-00-00 00:00:00') {
  396:                 # '' is the same as '0' for dates
  397:                 next;
  398:             }
  399:             if ($old =~ /\d*\.?\d*/) {
  400:                 next if (abs($old - $new) < 0.000001);
  401:             }
  402:             #
  403:             $error  = 'url='.$url.' mismatch on '.$field.$/;
  404:             $error .= 'old="'.$old.'" new="'.$new.'"';
  405:             return 1;
  406:         }
  407:         #
  408:         $checkedfields{$field}++;
  409:     }
  410:     foreach my $k (keys(%{$fromdb})) {
  411:         next if (exists($checkedfields{$k}));
  412:         next if (! defined($fromdb->{$k}));
  413:         next if ($fromdb->{$k} eq '' ||
  414:                  $fromdb->{$k} eq '0' ||
  415:                  $fromdb->{$k} eq '0000-00-00 00:00:00');
  416:         $error = 'new has field '.$k.' which old does not have.  '.
  417:             'value = '.$fromdb->{$k};
  418:         return 1;
  419:     }
  420:     return 0;
  421: }
  422: 
  423: sub metadata_mismatch_error {
  424:     return $error;
  425: }
  426: 
  427: }