[LON-CAPA-cvs] cvs: loncom /metadata_database lonmetadata_test.pl /metadata_database/LONCAPA lonmetadata.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Fri, 11 Jun 2004 19:52:12 -0000
This is a MIME encoded message
--matthew1086983532
Content-Type: text/plain
matthew Fri Jun 11 15:52:12 2004 EDT
Modified files:
/loncom/metadata_database lonmetadata_test.pl
/loncom/metadata_database/LONCAPA lonmetadata.pm
Log:
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.
--matthew1086983532
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20040611155212.txt"
Index: loncom/metadata_database/lonmetadata_test.pl
diff -u loncom/metadata_database/lonmetadata_test.pl:1.4 loncom/metadata_database/lonmetadata_test.pl:1.5
--- loncom/metadata_database/lonmetadata_test.pl:1.4 Thu Apr 8 10:51:19 2004
+++ loncom/metadata_database/lonmetadata_test.pl Fri Jun 11 15:52:12 2004
@@ -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 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(&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 @@
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 @@
$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 @@
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;
+}
+
+}
Index: loncom/metadata_database/LONCAPA/lonmetadata.pm
diff -u loncom/metadata_database/LONCAPA/lonmetadata.pm:1.9 loncom/metadata_database/LONCAPA/lonmetadata.pm:1.10
--- loncom/metadata_database/LONCAPA/lonmetadata.pm:1.9 Fri Apr 23 16:30:07 2004
+++ loncom/metadata_database/LONCAPA/lonmetadata.pm Fri Jun 11 15:52:12 2004
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonmetadata.pm,v 1.9 2004/04/23 20:30:07 matthew Exp $
+# $Id: lonmetadata.pm,v 1.10 2004/06/11 19:52:12 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -285,8 +285,7 @@
sub clear_sth { $sth=undef; $sth_table=undef;}
sub store_metadata {
- my $dbh = shift();
- my $tablename = shift();
+ my ($dbh,$tablename,@Metadata)=@_;
my $errors = '';
if (! defined($sth) ||
( defined($tablename) && ($sth_table ne $tablename)) ||
@@ -294,15 +293,19 @@
&create_statement_handler($dbh,$tablename);
}
my $successcount = 0;
- while (my $mdata = shift()) {
+ foreach my $mdata (@Metadata) {
next if (ref($mdata) ne "HASH");
my @MData;
foreach my $field (@Metadata_Table_Description) {
- if (exists($mdata->{$field->{'name'}})) {
- if ($mdata->{$field->{'name'}} eq 'nan') {
+ my $fname = $field->{'name'};
+ if (exists($mdata->{$fname}) &&
+ defined($mdata->{$fname}) &&
+ $mdata->{$fname} ne '') {
+ if ($mdata->{$fname} eq 'nan' ||
+ $mdata->{$fname} eq '') {
push(@MData,'NULL');
} else {
- push(@MData,$mdata->{$field->{'name'}});
+ push(@MData,$mdata->{$fname});
}
} else {
push(@MData,undef);
@@ -314,6 +317,7 @@
} else {
$errors = join(',',$errors,$sth->errstr);
}
+ $errors =~ s/^,//;
}
if (wantarray()) {
return ($successcount,$errors);
@@ -342,10 +346,11 @@
######################################################################
######################################################################
sub lookup_metadata {
- my ($dbh,$condition,$fetchparameter) = @_;
+ my ($dbh,$condition,$fetchparameter,$tablename) = @_;
+ $tablename = 'metadata' if (! defined($tablename));
my $error;
my $returnvalue=[];
- my $request = 'SELECT * FROM metadata';
+ my $request = 'SELECT * FROM '.$tablename;
if (defined($condition)) {
$request .= ' WHERE '.$condition;
}
@@ -374,13 +379,86 @@
=item delete_metadata()
-Not implemented yet
+Removes a single metadata record, based on its url.
+
+Inputs: $dbh, the database handler.
+$tablename, the name of the metadata table to remove from. default: 'metadata'
+$url, the url of the resource to remove from the metadata database.
+
+Returns: undef on success, dbh errorstr on failure.
+
+=cut
+
+######################################################################
+######################################################################
+sub delete_metadata {
+ my ($dbh,$tablename,$url) = @_;
+ $tablename = 'metadata' if (! defined($tablename));
+ my $error;
+ my $delete_command = 'DELETE FROM '.$tablename.' WHERE url='.
+ $dbh->quote($url);
+ $dbh->do($delete_command);
+ if ($dbh->err) {
+ $error = $dbh->errstr();
+ }
+ return $error;
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item update_metadata
+
+Updates metadata record in mysql database. It does not matter if the record
+currently exists. Fields not present in the new metadata will be taken
+from the current record, if it exists. To delete an entry for a key, set
+it to "" or undef.
+
+Inputs:
+$dbh, database handle
+$newmetadata, hash reference containing the new metadata
+$tablename, metadata table name. Defaults to 'metadata'.
+
+Returns:
+$error on failure. undef on success.
=cut
######################################################################
######################################################################
-sub delete_metadata {}
+sub update_metadata {
+ my ($dbh,$tablename,$newmetadata)=@_;
+ my $error;
+ $tablename = 'metadata' if (! defined($tablename));
+ if (! exists($newmetadata->{'url'})) {
+ $error = 'Unable to update: no url specified';
+ }
+ return $error if (defined($error));
+ #
+ # Retrieve current values
+ my $row;
+ ($error,$row) = &lookup_metadata($dbh,
+ ' url='.$dbh->quote($newmetadata->{'url'}),
+ undef,$tablename);
+ return $error if ($error);
+ my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});
+ #
+ # Update metadata values
+ while (my ($key,$value) = each(%$newmetadata)) {
+ $metadata{$key} = $value;
+ }
+ #
+ # Delete old data (deleting a nonexistant record does not produce an error.
+ $error = &delete_metadata($dbh,$tablename,$newmetadata->{'url'});
+ return $error if (defined($error));
+ #
+ # Store updated metadata
+ my $success;
+ ($success,$error) = &store_metadata($dbh,$tablename,\%metadata);
+ return $error;
+}
######################################################################
######################################################################
@@ -719,9 +797,6 @@
return $str;
}
-
-
-
1;
__END__;
--matthew1086983532--