Annotation of loncom/metadata_database/lonmetadata_test.pl, revision 1.5
1.1 matthew 1: #!/usr/bin/perl -w
2: # The LearningOnline Network with CAPA
3: #
1.5 ! matthew 4: # $Id: lonmetadata_test.pl,v 1.4 2004/04/08 14:51:19 matthew Exp $
1.1 matthew 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();
1.5 ! matthew 33: use Test::Simple tests => 7;
1.1 matthew 34:
1.3 matthew 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
1.1 matthew 41:
42: ok(&create_test_db(),'database creation');
43: ok(&test_creation(),'table creation');
1.2 matthew 44: ok(&test_named_creation(),'named table creation');
1.1 matthew 45: ok(&test_inserts(),'insert test');
1.5 ! matthew 46: ok(&test_retrieval(),'retrieval test');
! 47: ok(&test_delete(),'delete test');
! 48: ok(&test_update(),'update test');
1.1 matthew 49:
50: exit;
51:
52: #####################################################################
53: #####################################################################
54: ##
55: ## Tests live down below
56: ##
57: #####################################################################
58: #####################################################################
59: sub create_test_db {
1.2 matthew 60: my $dbh = DBI->connect("DBI:mysql:test","root",$supersecretpassword,
1.1 matthew 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 {
1.2 matthew 78: my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
1.1 matthew 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:
1.2 matthew 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: }
1.5 ! matthew 107: return 1;
1.2 matthew 108: }
109:
1.1 matthew 110: sub test_inserts {
1.5 ! matthew 111: my @TestRecords = &testrecords();
1.4 matthew 112: my $tablename = 'metadatatest';
1.2 matthew 113: my $dbh = DBI->connect("DBI:mysql:lonmetatest","root",$supersecretpassword,
1.5 ! matthew 114: { RaiseError =>1,PrintError=>1});
1.4 matthew 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
1.1 matthew 124: foreach my $data (@TestRecords) {
1.4 matthew 125: my ($count,$error) = &LONCAPA::lonmetadata::store_metadata($dbh,
126: $tablename,
127: $data);
1.1 matthew 128: if (! $count) {
129: warn $error;
130: return 0;
131: }
132: }
1.5 ! matthew 133: $dbh->do('DROP TABLE '.$tablename);
! 134: $dbh->disconnect();
1.1 matthew 135: return 1;
136: }
1.5 ! matthew 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: }
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