File:
[LON-CAPA] /
loncom /
metadata_database /
lonmetadata_test.pl
Revision
1.5:
download - view:
text,
annotated -
select for diffs
Fri Jun 11 19:52:12 2004 UTC (19 years, 10 months ago) by
matthew
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse
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.
#!/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;
}
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmetadata_test.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / metadata_database