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 (20 years, 6 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_5_msu, version_2_11_5, 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>