#!/usr/bin/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test1.t'
use lib '.','./t'; # for inheritance and Win32 test
use lib './blib/lib','../blib/lib','./lib','../lib','..';
# can run from here or distribution base
######################### We start with some black magic to print on failure.
BEGIN { $| = 1; print "1..186\n"; }
END {print "not ok 1\n" unless $loaded;}
use MARC::XML 0.4;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
#
#Added tests should have an comment matching /# \d/
#If so, the following will renumber all the tests
#to match Perl's idea of test:
#perl -pe 'BEGIN{$i=1};if (/# \d/){ $i++};s/# \d+/# $i/' test1.t > test1.t1
#
######################### End of test renumber.
use strict;
my $tc = 2; # next test number
sub is_ok {
my $result = shift;
printf (($result ? "" : "not ")."ok %d\n",$tc++);
return $result;
}
sub is_zero {
my $result = shift;
if (defined $result) {
return is_ok ($result == 0);
}
else {
printf ("not ok %d\n",$tc++);
}
}
sub is_bad {
my $result = shift;
printf (($result ? "not " : "")."ok %d\n",$tc++);
return (not $result);
}
sub filestring {
my $file = shift;
local $/ = undef;
unless (open(YY, $file)) {warn "Can't open file $file: $!\n"; return;}
binmode YY;
my $yy = <YY>;
unless (close YY) {warn "Can't close file $file: $!\n"; return;}
return $yy;
}
my $file = "output.xml";
my $testfile = "t/output.xml";
if (-e $testfile) {
$file = $testfile;
}
unless (-e $file) {
die "No MARC sample file found\n";
}
my $naptime = 0; # pause between output pages
if (@ARGV) {
$naptime = shift @ARGV;
unless ($naptime =~ /^[0-5]$/) {
die "Usage: perl test?.t [ page_delay (0..5) ]";
}
}
$MARC::TEST = 1; # for "constant" date stamp
my $x;
unlink 'output.txt', 'output.html', 'output.isbd', 'output2.xml',
'output.urls', 'output2.html', 'output.mkr';
# Create the new MARC::XML object. You can use any variable name you like...
# Read the xml source file into the MARC::XML object.
unless (is_ok ($x = MARC::XML->new ($file,"XML"))) { # 2
printf "could not create MARC::XML from $file\n";
exit 1;
# next test would die at runtime without $x
}
is_ok (2 == $x->marc_count); # 3
#Output the MARC::XML object to an ascii file
is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 4
#Output the MARC::XML object to an html file
is_ok ($x->output({file=>">output.html",'format'=>"HTML"})); # 5
#Output the MARC::XML object to an xml file
is_ok ($x->output({file=>">output2.xml",'format'=>"XML"})); # 6
#Output the MARC::XML object to an url file
is_ok ($x->output({file=>">output.urls",'format'=>"URLS"})); # 7
#Output the MARC::XML object to an isbd file
is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"})); # 8
#Output the MARC::XML object to a marcmaker file
is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"})); # 9
#Output the MARC::XML object to an html file with titles
is_ok ($x->output({file=>">output2.html",
'format'=>"HTML","245"=>"TITLE:"})); # 10
is_ok (-s 'output.txt'); # 11
is_ok (-s 'output.html'); # 12
is_ok (-s 'output2.xml'); # 13
is_ok (-s 'output.urls'); # 14
#Append the MARC::XML object to an html file with titles
is_ok ($x->output({file=>">>output2.html",
'format'=>"HTML","245"=>"TITLE:"})); # 15
#Append to an html file with titles incrementally
is_ok ($x->output({file=>">output.html",'format'=>"HTML_START"})); # 16
is_ok ($x->output({file=>">>output.html",
'format'=>"HTML_BODY","245"=>"TITLE:"})); # 17
is_ok ($x->output({file=>">>output.html",'format'=>"HTML_FOOTER"})); # 18
my ($y1, $y2, $yy);
is_ok ($y1 = $x->output({'format'=>"HTML","245"=>"TITLE:"})); # 19
$y2 = "$y1$y1";
is_ok ($yy = filestring ("output2.html")); # 20
is_ok ($yy eq $y2); # 21
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
is_ok ($yy = filestring ("output.html")); # 22
is_ok ($y1 eq $yy); # 23
#Simple test of (un)?pack.*
my $mldr = $x->ldr(1);
my $rhldr = $x->unpack_ldr(1);
is_ok('c' eq ${$rhldr}{RecStat}); # 24
is_ok('a' eq ${$rhldr}{Type}); # 25
is_ok('m' eq ${$rhldr}{BLvl}); # 26
my $rhff = $x->unpack_008(1);
is_ok('741021' eq ${$rhff}{Entered}); # 27
is_ok('s' eq ${$rhff}{DtSt}); # 28
is_ok('1884' eq ${$rhff}{Date1}); # 29
my ($m000) = $x->getvalue({field=>'000',record=>1});
my ($m001) = $x->getvalue({field=>'001',record=>1});
my ($m003) = $x->getvalue({field=>'003',record=>1});
my ($m005) = $x->getvalue({field=>'005',record=>1});
my ($m008) = $x->getvalue({field=>'008',record=>1});
is_ok($m000 eq "00901cam 2200241Ia 45e0"); # 30
is_ok($m001 eq "ocm01047729 "); # 31
is_ok($m003 eq "OCoLC"); # 32
is_ok($m005 eq "19960221075055.7"); # 33
is_ok($m008 eq "741021s1884 enkaf 000 1 eng d"); # 34
is_ok($x->_pack_ldr($rhldr) eq $m000); # 35
is_ok($x->_pack_ldr($rhldr) eq $x->ldr(1)); # 36
is_ok($x->_pack_008($m000,$rhff) eq $m008); # 37
$x->pack_ldr(1);
is_ok($x->ldr(1) eq $mldr); # 38
$x->pack_008(1);
my ($cmp008) = $x->getvalue({field=>'008',record=>1});
is_ok($cmp008 eq $m008); # 39
my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'});
my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'});
my ($indi12) = $x->getvalue({field=>'245',record=>1,subfield=>'i12'});
is_ok($indi1 eq "1"); # 40
is_ok($indi2 eq "4"); # 41
is_ok($indi12 eq "14"); # 42
my ($m100a) = $x->getvalue({field=>'100',record=>1,subfield=>'a'});
my ($m100d) = $x->getvalue({field=>'100',record=>1,subfield=>'d'});
my ($m100e) = $x->getvalue({field=>'100',record=>1,subfield=>'e'});
is_ok($m100a eq "Twain, Mark,"); # 43
is_ok($m100d eq "1835-1910."); # 44
is_bad(defined $m100e); # 45
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
my @ind12 = $x->getvalue({field=>'246',record=>2,subfield=>'i12'});
is_ok(3 == scalar @ind12); # 46
is_ok($ind12[0] eq "30"); # 47
is_ok($ind12[1] eq "3 "); # 48
is_ok($ind12[2] eq "30"); # 49
my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'});
is_ok(3 == scalar @m246a); # 50
is_ok($m246a[0] eq "Photo archive"); # 51
is_ok($m246a[1] eq "Associated Press photo archive"); # 52
is_ok($m246a[2] eq "AP photo archive"); # 53
my @records=$x->searchmarc({field=>"245"});
is_ok(2 == scalar @records); # 54
is_ok($records[0] == 1); # 55
is_ok($records[1] == 2); # 56
@records=$x->searchmarc({field=>"245",subfield=>"a"});
is_ok(2 == scalar @records); # 57
is_ok($records[0] == 1); # 58
is_ok($records[1] == 2); # 59
@records=$x->searchmarc({field=>"245",subfield=>"b"});
is_ok(1 == scalar @records); # 60
is_ok($records[0] == 1); # 61
@records=$x->searchmarc({field=>"245",subfield=>"h"});
is_ok(1 == scalar @records); # 62
is_ok($records[0] == 2); # 63
@records=$x->searchmarc({field=>"246",subfield=>"a"});
is_ok(1 == scalar @records); # 64
is_ok($records[0] == 2); # 65
@records=$x->searchmarc({field=>"245",regex=>"/huckleberry/i"});
is_ok(1 == scalar @records); # 66
is_ok($records[0] == 1); # 67
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
@records=$x->searchmarc({field=>"260",subfield=>"c",regex=>"/19../"});
is_ok(1 == scalar @records); # 68
is_ok($records[0] == 2); # 69
@records=$x->searchmarc({field=>"245",notregex=>"/huckleberry/i"});
is_ok(1 == scalar @records); # 70
is_ok($records[0] == 2); # 71
@records=$x->searchmarc({field=>"260",subfield=>"c",notregex=>"/19../"});
is_ok(1 == scalar @records); # 72
is_ok($records[0] == 1); # 73
@records=$x->searchmarc({field=>"900",subfield=>"c"});
is_ok(0 == scalar @records); # 74
is_bad(defined $records[0]); # 75
@records=$x->searchmarc({field=>"999"});
is_ok(0 == scalar @records); # 76
is_bad(defined $records[0]); # 77
is_ok (-s 'output.isbd'); # 78
is_ok (-s 'output.mkr'); # 79
my $update246 = {field=>'246',record=>2,ordered=>'y'};
my @u246 = $x->getupdate($update246);
is_ok(21 == @u246); # 80
is_ok(1 == $x->searchmarc($update246)); # 81
is_ok(3 == $x->deletemarc($update246)); # 82
is_ok($u246[0] eq "i1"); # 83
is_ok($u246[1] eq "3"); # 84
is_ok($u246[2] eq "i2"); # 85
is_ok($u246[3] eq "0"); # 86
is_ok($u246[4] eq "a"); # 87
is_ok($u246[5] eq "Photo archive"); # 88
is_ok($u246[6] eq "\036"); # 89
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
is_ok($u246[7] eq "i1"); # 90
is_ok($u246[8] eq "3"); # 91
is_ok($u246[9] eq "i2"); # 92
is_ok($u246[10] eq " "); # 93
is_ok($u246[11] eq "a"); # 94
is_ok($u246[12] eq "Associated Press photo archive"); # 95
is_ok($u246[13] eq "\036"); # 96
is_ok($u246[14] eq "i1"); # 97
is_ok($u246[15] eq "3"); # 98
is_ok($u246[16] eq "i2"); # 99
is_ok($u246[17] eq "0"); # 100
is_ok($u246[18] eq "a"); # 101
is_ok($u246[19] eq "AP photo archive"); # 102
is_ok($u246[20] eq "\036"); # 103
is_ok ($y1 = $x->output({'format'=>"HTML_HEADER"})); # 104
my $header = "Content-type: text/html\015\012\015\012";
is_ok ($y1 eq $header); # 105
is_ok ($y1 = $x->output({'format'=>"HTML_START"})); # 106
$header = "<html><body>";
is_ok ($y1 eq $header); # 107
is_ok ($y1 = $x->output({'format'=>"HTML_START",'title'=>"Testme"})); # 108
$header = "<html><head><title>Testme</title></head>\n<body>";
is_ok ($y1 eq $header); # 109
is_ok ($y1 = $x->output({'format'=>"HTML_FOOTER"})); # 110
$header = "\n</body></html>\n";
is_ok ($y1 eq $header); # 111
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
is_ok(0 == $x->searchmarc($update246)); # 112
@records = $x->getupdate($update246);
is_ok(0 == @records); # 113
# prototype setupdate()
@records = ();
foreach $y1 (@u246) {
unless ($y1 eq "\036") {
push @records, $y1;
next;
}
$x->addfield($update246, @records) || warn "not added\n";
@records = ();
}
@u246 = $x->getupdate($update246);
is_ok(21 == @u246); # 114
is_ok($u246[0] eq "i1"); # 115
is_ok($u246[1] eq "3"); # 116
is_ok($u246[2] eq "i2"); # 117
is_ok($u246[3] eq "0"); # 118
is_ok($u246[4] eq "a"); # 119
is_ok($u246[5] eq "Photo archive"); # 120
is_ok($u246[6] eq "\036"); # 121
is_ok($u246[7] eq "i1"); # 122
is_ok($u246[8] eq "3"); # 123
is_ok($u246[9] eq "i2"); # 124
is_ok($u246[10] eq " "); # 125
is_ok($u246[11] eq "a"); # 126
is_ok($u246[12] eq "Associated Press photo archive"); # 127
is_ok($u246[13] eq "\036"); # 128
is_ok($u246[14] eq "i1"); # 129
is_ok($u246[15] eq "3"); # 130
is_ok($u246[16] eq "i2"); # 131
is_ok($u246[17] eq "0"); # 132
is_ok($u246[18] eq "a"); # 133
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
is_ok($u246[19] eq "AP photo archive"); # 134
is_ok($u246[20] eq "\036"); # 135
@records = $x->searchmarc({field=>'900'});
is_ok(0 == @records); # 136
@records = $x->searchmarc({field=>'999'});
is_ok(0 == @records); # 137
is_ok($x->addfield({record=>1, field=>"999", ordered=>"n",
i1=>"5", i2=>"3", value=>[c=>"wL70",
d=>"AR Clinton PL",f=>"53525"]})); # 138
is_ok($x->addfield({record=>1, field=>"900", ordered=>"y",
i1=>"6", i2=>"7", value=>[z=>"part 1",
z=>"part 2",z=>"part 3"]})); # 139
is_ok($x->addfield({record=>2, field=>"900", ordered=>"y",
i1=>"9", i2=>"8", value=>[z=>"part 4"]})); # 140
@records = $x->searchmarc({field=>'900'});
is_ok(2 == @records); # 141
@records = $x->searchmarc({field=>'999'});
is_ok(1 == @records); # 142
@records = $x->getupdate({field=>'900',record=>1});
is_ok(11 == @records); # 143
is_ok($records[0] eq "i1"); # 144
is_ok($records[1] eq "6"); # 145
is_ok($records[2] eq "i2"); # 146
is_ok($records[3] eq "7"); # 147
is_ok($records[4] eq "z"); # 148
is_ok($records[5] eq "part 1"); # 149
is_ok($records[6] eq "z"); # 150
is_ok($records[7] eq "part 2"); # 151
is_ok($records[8] eq "z"); # 152
is_ok($records[9] eq "part 3"); # 153
is_ok($records[10] eq "\036"); # 154
@records = $x->getupdate({field=>'900',record=>2});
is_ok(7 == @records); # 155
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
is_ok($records[0] eq "i1"); # 156
is_ok($records[1] eq "9"); # 157
is_ok($records[2] eq "i2"); # 158
is_ok($records[3] eq "8"); # 159
is_ok($records[4] eq "z"); # 160
is_ok($records[5] eq "part 4"); # 161
is_ok($records[6] eq "\036"); # 162
@records = $x->getupdate({field=>'999',record=>1});
is_ok(11 == @records); # 163
is_ok($records[0] eq "i1"); # 164
is_ok($records[1] eq "5"); # 165
is_ok($records[2] eq "i2"); # 166
is_ok($records[3] eq "3"); # 167
is_ok($records[4] eq "c"); # 168
is_ok($records[5] eq "wL70"); # 169
is_ok($records[6] eq "d"); # 170
is_ok($records[7] eq "AR Clinton PL"); # 171
is_ok($records[8] eq "f"); # 172
is_ok($records[9] eq "53525"); # 173
is_ok($records[10] eq "\036"); # 174
@records = $x->getupdate({field=>'999',record=>2});
is_ok(0 == @records); # 175
if ($naptime) {
print "++++ page break\n";
sleep $naptime;
}
@records = $x->getupdate({field=>'001',record=>2});
is_ok(2 == @records); # 176
is_ok($records[0] eq "ocm40139019 "); # 177
is_ok($records[1] eq "\036"); # 178
is_ok ($yy = filestring ($file)); # 179
is_ok ($y2 = filestring ("output2.xml")); # 180
is_ok ($yy eq $y2); # 181
undef $x;
unless (is_ok ($x = MARC::XML->new ($file,"XML",'y'))) { # 182
printf "could not create MARC::XML from $file\n";
exit 1;
# next test would die at runtime without $x
}
#Output the MARC::XML object to an xml file
is_ok ($x->output({file=>">output2.xml",'format'=>"XML"})); # 183
my $z1 = -s $file;
my $z2 = -s 'output2.xml';
is_ok ($z1 == -s 'output2.xml'); # 184
is_ok ($y2 = filestring ("output2.xml")); # 185
is_ok ($yy ne $y2); # 186