Toaster at 17:33, 16 September 2008

2008-09-16T17:33:01Z

New page

<pre>
#!/usr/bin/perl
#
# test script for perl srb module
#
# uncomment to use specified values instead of ~/.srb/.MdasEnv and ~/.srb/.MdasAuth
$mcat = 'bodleian';
$port = 6618;
#$password = 'PASSWORD';
$user = 'toaster';
$domain = 'umiacs';
$authscheme = 'ENCRYPT1';
$serverDn = '';

#
# Values to test read/open/write/delete
#
# collection to dump file to
my $ingestcoll = '/home/toaster.umiacs';
# collection to create under ingestcoll
my $newcollection = 'testcoll';
# destination object
my $ingestobj = 'testfile2';
# local file to ingest
my $localfile = '/tmp/testfile2';
# resource to ingest into
my $resource = 'bodleian-prod';

use srbcore;

########################
# test connection functions
#
print "\n*************\nTesting connection functions\n*************\n\n";

#
#srbConnect
#
print "Testing: srbConnect\n";
my $conn = srbcore::srbConnect($mcat,$port,$password,$user,$domain,$authscheme,$serverDn);
my $connstatus = srbcore::clStatus($conn);
if ($connstatus == 0) {
print "Connection Successful\n";
} else {
print "Connection Failed: $connstatus ".srbcore::clErrorMessage($conn)."\n";
print srbcore::srbError($connstatus,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

#
# test connection reset
#
print "Testing: clReset\n";
srbcore::clReset($conn);
if ($connstatus == 0) {
print "Connection Reset Successful\n";
} else {
print "Connection Failed: $connstatus ".srbcore::clErrorMessage($conn)."\n";
print srbcore::srbError($connstatus,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

########################
# test object creation, reading, deletion
#
print "\n*************\nTesting Object functions\n*************\n\n";

#
#srbObjCreate
#
my $datasize = (stat($file))[7];
$datasize = -1 unless $datasize;

print "Testing: srbObjCreate\n";
my $objfd = srbcore::srbObjCreate($conn,$srbcore::MDAS_CATALOG,$ingestobj,'generic',$resource, $ingestcoll,"",$datasize);
print " result: fd $objfd\n";
if ($objfd < 0) {
print srbcore::srbError($objfd,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

#
#srbObjWrite
#
print "Writing to $ingestcoll/$ingestobj\n";
print "Testing: srbObjWrite\n";
open(INPFILE,"$localfile") or print "cannot open $localfile\n";
my $buf,$bufsize;
while (($bufsize = read(INPFILE, $buf, 16384)) != 0) {
print " read: $bufsize\n";
if (!defined($bufsize)) {
print "Error reading $file\n";
exit 1;
}
my $srbwrite = srbcore::srbObjWrite($conn,$objfd,$buf,$bufsize);
print " wrote: $srbwrite\n";
if ($srbwrite < 0) {
print "Error writing: $srbwrite\n";
print srbcore::srbError($srbwrite,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}
}
close(INPFILE);
#
#srbObjClose
#
print "Testing: srbObjClose\n";
my $closeres = srbcore::srbObjClose($conn,$objfd);
print " result: $closeres\n";

#
#srbObjRead
#
print "Reading from $ingestcoll/$ingestobj\n";
print "Testing: srbObjRead\n";
my $obj = srbcore::srbObjOpen($conn,$ingestobj,$srb::O_RDONLY,$ingestcoll);
if ($obj < 0) {
print " Open failed: $obj\n";
print srbcore::clErrorMessage($conn);
print srbcore::srbError($obj,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}
# create a char * buffer that srbObjRead can write into
my $buf = "." x 1025;
my $read = srbcore::srbObjRead($conn,$obj,$buf,length($buf));
print " read: $read";;
while ($read > 0) {
$printbuf = substr($buf,0,$read);
last if ($read < 1025);
my $buf = "." x 1025;
$read = srbcore::srbObjRead($conn,$obj,$buf,length($buf));
print ", $read";;
}
print "\n";
if ($read < 0) {
print " Read Error: $read fd: $obj\n";
print srbcore::srbError($read,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}
srbcore::srbObjClose($conn,$obj);

#
#srbModifyDataset
#
print "Testing: srbModifyDataset\n";
my $objmod = srbcore::srbModifyDataset($conn,$srbcore::MDAS_CATALOG,$ingestobj,$ingestcoll,"","","0","test metadata",$srbcore::D_INSERT_USER_DEFINED_STRING_META_DATA);
print " result: $objmod\n";
if ($objmod < 0) {
print srbcore::srbError($objmod,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

#
#srbObjUnlink
#
print "Deleting $ingestcoll/$ingestobj\n";
print "Testing: srbObjUnlink\n";
my $objdel = srbcore::srbObjUnlink($conn,$ingestobj,$ingestcoll);
print " result: $objdel\n";
if ($objdel < 0) {
print srbcore::srbError($objdel,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

########################
# test collection items
#
print "\n*************\nTesting Collection functions\n*************\n\n";
#
# srbLsCollect - returns reference to array of items in directory
# formatted same as srbListCollect
print "Testing: srbLsCollect\n";
print " Listing of $ingestcoll\n";
my $coll = srbcore::srbLsCollect ($conn, $ingestcoll);
foreach $i (@$coll) { print " - $i\n"; }

#
# create collection
#
print "Attempting to create $newcollection in $ingestcoll\n";
print "Testing: srbCreateCollect\n";
my $collcreate = srbcore::srbCreateCollect($conn,$srbcore::MDAS_CATALOG,$ingestcoll,$newcollection);
print " result: $collcreate\n";
if ($collcreate < 0) {
print srbcore::srbError($collcreate,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

#
# remove collection through srbModifyCollect
#
print "Attempting to remove $ingestcoll/$newcollection\n";
print "Testing: srbModifyCollect\n";
my $collremove = srbcore::srbModifyCollect($conn,$srbcore::MDAS_CATALOG,
"$ingestcoll/$newcollection","","","",$srbcore::D_DELETE_COLL);
print " result: $collremove\n";
if ($collremove < 0) {
print srbcore::srbError($collremove,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

########################
# Metadata tests
#
print "\n*************\nTesting Metadata functions\n*************\n\n";
print "Creating new search result\n";
print "Testing: newsrbcore::srb_search_results(\$conn) \n";
#
# create srb_search_reqults object
#
my $qresult = new srbcore::srb_search_results($conn);

# searching in the srb required two arrays, qval and sval
# qval - string array containing partial sql query for each item you
# wish to search.
# ie. $qval[$srbcore::DATA_NAME] = " = 'testdb'";
# will seach DATA_NAME for anything that is equal to 'testdb'
# sval - array of ints used to select what columns are returned from a search
# $sval[$srbcore::DATA_GRP_NAME] = 1 will cause DATA_GRP_NAME to
# be returned.
my @qval,@sval;

# Initialize qval and sval for searching
# select where DATA_GRP_NAME = '$ingestcoll'
$qval[$srbcore::DATA_GRP_NAME] = " = '$ingestcoll'";
# we want DATA_GRP_ID and DATA_NAME returned to us
$sval[$srbcore::DATA_GRP_ID] = 1;
$sval[$srbcore::DATA_NAME] = 1;

#
#srbSearch = srbSearch(qval, sval,srb_search_results, items to return)
#
#
print "Testing: srbSearch\n";
my $searchres = srbcore::srbSearch(\@qval, \@sval,$qresult,100);
print " result: $searchres\n";

#
# srb_search_results->get_row
#
print "Retrieving row for DATA_NAME\n";
print "Testing: srb_search_results->get_row\n";
my $resultlist = $qresult->get_row($srbcore::DATA_NAME);
foreach $item (@$resultlist) {
print " $item\n";
}

#
# srb_search_results->get_num_rows
#
print "Testing: srb_search_results->get_num_rows\n";
print " result: ".$qresult->get_num_rows()." row\n";

#
# srb_search_results->get_item tests
#
print "Testing: srb_search_results->get_item\n";
print "Fetching individual item DATA_GRP_ID,\n result 0 will return first result in DATA_GRP_ID list\n";
print " ".$qresult->get_item($srbcore::DATA_GRP_ID,0)."\n";
print "Fetching individual item DATA_GRP_ID,\n result get_num_rows + 1 shoult be null since it's out of range\n";
print " ".$qresult->get_item($srbcore::DATA_GRP_ID,$qresult->get_num_rows()+1)."\n";
print "Fetching individual item DATA_GRP_NAME,\n result 0 should be null since we didn't set sval for it.\n";
print " ".$qresult->get_item($srbcore::DATA_GRP_NAME,0)."\n";

#
# more_results
# - see if srbSearch return everything, or if there is still more out there
#

print "Test for more results than are contained in srb_search_results\n";
print "Testing: srb_search_results->more_results\n";
print " result: ". $qresult->more_results()."\n";

#
# get_next
# - return additional XX results
print "Retrieving next 100 results, may return error if there are none\n";
print "Testing: srb_search_results->get_next\n";
my $moreresults = $qresult->get_next(100);
print " result: $moreresults\n";
if ($moreresults < 0) {
print srbcore::srbError($moreresults,$srbcore::SRB_LONG_MSG|$srbcore::SRB_RCMD_ACTION);
}

#
#close connection
#
srbcore::clFinish($conn);
</pre>

SRB:Perl test.pl - Revision history

Toaster at 17:33, 16 September 2008