Return to lonmetadata_test.pl CVS log

Up to [LON-CAPA] / loncom / metadata_database

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;
}

}

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.