--- loncom/metadata_database/lonmetadata_test.pl 2004/04/08 14:51:19 1.4 +++ loncom/metadata_database/lonmetadata_test.pl 2004/06/11 19:52:12 1.5 @@ -1,7 +1,7 @@ #!/usr/bin/perl -w # The LearningOnline Network with CAPA # -# $Id: lonmetadata_test.pl,v 1.4 2004/04/08 14:51:19 matthew Exp $ +# $Id: lonmetadata_test.pl,v 1.5 2004/06/11 19:52:12 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,7 +30,7 @@ use strict; use DBI; use LONCAPA::lonmetadata(); -use Test::Simple tests => 4; +use Test::Simple tests => 7; ## ## Note: The root password to my MySQL server is shown below. @@ -43,6 +43,9 @@ ok(&create_test_db(),'database creation' ok(&test_creation(),'table creation'); ok(&test_named_creation(),'named table creation'); ok(&test_inserts(),'insert test'); +ok(&test_retrieval(),'retrieval test'); +ok(&test_delete(),'delete test'); +ok(&test_update(),'update test'); exit; @@ -100,61 +103,15 @@ sub test_named_creation { if ($dbh->err) { $dbh->disconnect(); return 0; - } else { - $dbh->disconnect(); - return 1; } + return 1; } sub test_inserts { + my @TestRecords = &testrecords(); my $tablename = 'metadatatest'; my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword, - { RaiseError =>0,PrintError=>0}); - 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', - }, - ); + { RaiseError =>1,PrintError=>1}); # Create the table my $request = &LONCAPA::lonmetadata::create_metadata_storage($tablename); $dbh->do($request); @@ -162,9 +119,6 @@ sub test_inserts { $dbh->disconnect(); warn "Unable to create table for test"; return 0; - } else { - $dbh->disconnect(); - return 1; } # Store the sample records foreach my $data (@TestRecords) { @@ -176,5 +130,298 @@ sub test_inserts { 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}); + 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; +} + +}