#!/usr/bin/perl -w # The LearningOnline Network with CAPA # # $Id: lonmetadata_test.pl,v 1.5 2004/06/11 19:52:12 matthew Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ###################################################################### use strict; use DBI; use LONCAPA::lonmetadata(); 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(&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; ##################################################################### ##################################################################### ## ## Tests live down below ## ##################################################################### ##################################################################### sub create_test_db { my $dbh = DBI->connect("DBI:mysql:test","root",$supersecretpassword, { RaiseError =>0,PrintError=>0}); if (! defined($dbh)) { return 0; } my $request = 'DROP DATABASE IF EXISTS lonmetatest'; $dbh->do($request); $request = 'CREATE DATABASE lonmetatest'; $dbh->do($request); if ($dbh->err) { return 0; } else { return 1; } $dbh->disconnect(); } sub test_creation { my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword, { RaiseError =>0,PrintError=>0}); my $request = &LONCAPA::lonmetadata::create_metadata_storage(); $dbh->do($request); if ($dbh->err) { $dbh->disconnect(); return 0; } else { $dbh->disconnect(); return 1; } } 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 { 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}); 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; } }