MARC-1.07/ 40755 764 764 0 7100722641 10510 5ustar billbbillbMARC-1.07/t/ 40755 764 764 0 7100722641 10753 5ustar billbbillbMARC-1.07/t/test1.t100644 764 764 33572 7100717431 12330 0ustar billbbillb#!/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 ######################### We start with some black magic to print on failure. BEGIN { $| = 1; print "1..187\n"; } END {print "not ok 1\n" unless $loaded;} use MARC 1.03; $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 = ; unless (close YY) {warn "Can't close file $file: $!\n"; return;} return $yy; } my $file = "marc.dat"; my $file2 = "badmarc.dat"; my $testdir = "t"; if (-d $testdir) { $file = "$testdir/$file"; $file2 = "$testdir/$file2"; } unless (-e $file) { die "No MARC sample file found\n"; } unless (-e $file2) { die "Missing bad sample file for MARC tests: $file2\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) ]"; } } my $x; unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd', 'output.urls', 'output2.html', 'output.mkr'; # Create the new MARC object. You can use any variable name you like... # Read the MARC file into the MARC object. unless (is_ok ($x = MARC->new ($file))) { # 2 printf "could not create MARC from $file\n"; exit 1; # next test would die at runtime without $x } is_ok (2 == $x->marc_count); # 3 #Output the MARC object to an ascii file is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 4 #Output the MARC object to an html file is_ok ($x->output({file=>">output.html",'format'=>"HTML"})); # 5 #Try to output the MARC object to an xml file my $quiet = $^W; $^W = 0; is_bad ($x->output({file=>">output.xml",'format'=>"XML"})); # 6 $^W = $quiet; #Output the MARC object to an url file is_ok ($x->output({file=>">output.urls",'format'=>"URLS"})); # 7 #Output the MARC object to an isbd file is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"})); # 8 #Output the MARC object to a marcmaker file is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"})); # 9 #Output the MARC 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_bad (-e 'output.xml'); # 13 is_ok (-s 'output.urls'); # 14 #Append the MARC 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 "19990808143752.0"); # 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'}); if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($m100a eq "Twain, Mark,"); # 43 is_ok($m100d eq "1835-1910."); # 44 is_bad(defined $m100e); # 45 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 if ($naptime) { print "++++ page break\n"; sleep $naptime; } @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 @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 if ($naptime) { print "++++ page break\n"; sleep $naptime; } 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 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 if ($naptime) { print "++++ page break\n"; sleep $naptime; } 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 = ""; is_ok ($y1 eq $header); # 107 is_ok ($y1 = $x->output({'format'=>"HTML_START",'title'=>"Testme"})); # 108 $header = "Testme\n"; is_ok ($y1 eq $header); # 109 is_ok ($y1 = $x->output({'format'=>"HTML_FOOTER"})); # 110 $header = "\n\n"; is_ok ($y1 eq $header); # 111 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 if ($naptime) { print "++++ page break\n"; sleep $naptime; } 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 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 if ($naptime) { print "++++ page break\n"; sleep $naptime; } 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 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 if ($naptime) { print "++++ page break\n"; sleep $naptime; } 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 @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(2 == $x->deletemarc()); # 179 is_zero($x->marc_count); # 180 $MARC::TEST = 1; is_ok('0 but true' eq $x->openmarc({file=>$file2, 'format'=>"usmarc"})); # 181 is_ok(-1 == $x->nextmarc(2)); # 182 is_ok(1 == $x->marc_count); # 183 is_bad(defined $x->nextmarc(1)); # 184 is_ok(1 == $x->nextmarc(2)); # 185 is_ok(2 == $x->marc_count); # 186 is_ok($x->closemarc); # 187 MARC-1.07/t/test2.t100644 764 764 15752 7100717505 12333 0ustar billbbillb#!/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 ######################### We start with some black magic to print on failure. BEGIN { $| = 1; print "1..65\n"; } END {print "not ok 1\n" unless $loaded;} use MARC 1.04; $loaded = 1; print "ok 1\n"; ######################### End of black magic. use strict; my $tc = 2; # next test number use strict; use File::Compare; sub out_cmp { my $outfile = shift; my $reffile = shift; if (-s $outfile && -s $reffile) { return is_zero (compare($outfile, $reffile)); } printf ("not ok %d\n",$tc++); } sub is_zero { my $result = shift; if (defined $result) { return is_ok ($result == 0); } printf ("not ok %d\n",$tc++); } sub is_ok { my $result = shift; printf (($result ? "" : "not ")."ok %d\n",$tc++); return $result; } sub is_bad { my $result = shift; printf (($result ? "not " : "")."ok %d\n",$tc++); return (not $result); } my $file = "makrbrkr.mrc"; my $file2 = "brkrtest.ref"; my $file3 = "makrtest.src"; my $file4 = "makrtest.bad"; my $testdir = "t"; if (-d $testdir) { $file = "$testdir/$file"; $file2 = "$testdir/$file2"; $file3 = "$testdir/$file3"; $file4 = "$testdir/$file4"; } unless (-e $file) { die "Missing sample file for MARCMaker tests: $file\n"; } unless (-e $file2) { die "Missing results file for MARCBreaker tests: $file2\n"; } unless (-e $file3) { die "Missing source file for MARCMaker tests: $file3\n"; } unless (-e $file4) { die "Missing bad source file for MARCMaker tests: $file4\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) ]"; } } my $x; unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd', 'output.urls', 'output2.bkr', 'output.mkr', 'output.bkr'; # Create the new MARC object. You can use any variable name you like... # Read the MARC file into the MARC object. unless (is_ok ($x = MARC->new($file3,"marcmaker"))) { # 2 die "could not create MARC from $file3\n"; # next test would die at runtime without $x } $MARC::TEST = 1; # so outputs have known dates for 005 is_ok (8 == $x->marc_count); # 3 #Output the MARC object to a marcmaker file with nolinebreak is_ok ($x->output({file=>">output.bkr",'format'=>"marcmaker", nolinebreak=>'y'})); # 4 out_cmp ("output.bkr", $file2); # 5 my $y; is_ok ($y = $x->output()); # 6 #Output the MARC object to an ascii file is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 7 #Output the MARC object to a marcmaker file is_ok ($x->output({file=>">output2.bkr",'format'=>"marcmaker"})); # 8 #Output the MARC object to a marc file is_ok ($x->output({file=>">output.mkr",'format'=>"marc"})); # 9 out_cmp ("output.mkr", $file); # 10 $MARC::TEST = 0; #minimal impact $^W = 0; my ($m000) = $x->getvalue({record=>'1',field=>'000'}); my ($m001) = $x->getvalue({record=>'1',field=>'001'}); is_ok ($m000 eq "01200nam 2200253 a 4500"); # 11 is_ok ($m001 eq "tes96000001 "); # 12 my ($m002) = $x->getvalue({record=>'1',field=>'002'}); my ($m003) = $x->getvalue({record=>'1',field=>'003'}); is_bad (defined $m002); # 13 is_ok ($m003 eq "ViArRB"); # 14 my ($m004) = $x->getvalue({record=>'1',field=>'004'}); my ($m005) = $x->getvalue({record=>'1',field=>'005'}); is_bad (defined $m004); # 15 is_ok ($m005 eq "19960221075055.7"); # 16 my ($m006) = $x->getvalue({record=>'1',field=>'006'}); my ($m007) = $x->getvalue({record=>'1',field=>'007'}); is_bad (defined $m006); # 17 is_bad (defined $m007); # 18 my ($m008) = $x->getvalue({record=>'1',field=>'008'}); my ($m009) = $x->getvalue({record=>'1',field=>'009'}); is_ok ($m008 eq "960221s1955 dcuabcdjdbkoqu001 0deng d"); # 19 is_bad (defined $m009); # 20 if ($naptime) { print "++++ page break\n"; sleep $naptime; } my ($m260a) = $x->getvalue({record=>'8',field=>'260',subfield=>'a'}); my ($m260b) = $x->getvalue({record=>'8',field=>'260',subfield=>'b'}); my ($m260c) = $x->getvalue({record=>'8',field=>'260',subfield=>'c'}); is_ok ($m260a eq "Washington, DC :"); # 21 is_ok ($m260b eq "Library of Congress,"); # 22 is_ok ($m260c eq "1955."); # 23 my @m260 = $x->getvalue({record=>'8',field=>'260'}); is_ok ($m260[0] eq "Washington, DC : Library of Congress, 1955. "); # 24 my ($m245i1) = $x->getvalue({record=>'8',field=>'245',subfield=>'i1'}); my ($m245i2) = $x->getvalue({record=>'8',field=>'245',subfield=>'i2'}); my ($m245i12) = $x->getvalue({record=>'8',field=>'245',subfield=>'i12'}); is_ok ($m245i1 eq "1"); # 25 is_ok ($m245i2 eq "2"); # 26 is_ok ($m245i12 eq "12"); # 27 is_ok (3 == $x->selectmarc(["1","7-8"])); # 28 is_ok (3 == $x->marc_count); # 29 my @records=$x->searchmarc({field=>"020"}); is_ok(2 == scalar @records); # 30 is_ok($records[0] == 2); # 31 is_ok($records[1] == 3); # 32 @records=$x->searchmarc({field=>"020",subfield=>"c"}); is_ok(1 == scalar @records); # 33 is_ok($records[0] == 3); # 34 @records = $x->getupdate({field=>'020',record=>2}); is_ok(7 == @records); # 35 is_ok($records[0] eq "i1"); # 36 is_ok($records[1] eq " "); # 37 is_ok($records[2] eq "i2"); # 38 is_ok($records[3] eq " "); # 39 is_ok($records[4] eq "a"); # 40 is_ok($records[5] eq "8472236579"); # 41 is_ok($records[6] eq "\036"); # 42 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok(1 == $x->deletemarc({field=>'020',record=>2})); # 43 $records[6] = "c"; $records[7] = "new data"; is_ok($x->addfield({field=>'020',record=>2}, @records)); # 44 @records=$x->searchmarc({field=>"020",subfield=>"c"}); is_ok(2 == scalar @records); # 45 is_ok($records[0] == 2); # 46 is_ok($records[1] == 3); # 47 @records = $x->getvalue({record=>'2',field=>'020',delimiter=>'|'}); is_ok(1 == scalar @records); # 48 is_ok($records[0] eq "|a8472236579|cnew data"); # 49 is_ok(1 == $x->deletemarc({field=>'020',record=>2,subfield=>'c'})); # 50 @records=$x->searchmarc({field=>"020",subfield=>"c"}); is_ok(1 == scalar @records); # 51 is_ok($records[0] == 3); # 52 @records = $x->getvalue({record=>'2',field=>'020',delimiter=>'|'}); is_ok(1 == scalar @records); # 53 is_ok($records[0] eq "|a8472236579"); # 54 is_ok(3 == $x->deletemarc()); # 55 is_zero($x->marc_count); # 56 $MARC::TEST = 1; is_ok('0 but true' eq $x->openmarc({file=>$file4, 'format'=>"marcmaker"})); # 57 is_ok(-2 == $x->nextmarc(4)); # 58 is_ok(2 == $x->marc_count); # 59 is_ok($x->closemarc); # 60 is_ok(2 == $x->deletemarc()); # 61 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok(2 == $x->openmarc({file=>$file4, increment=>2, 'format'=>"marcmaker"})); # 62 is_bad(defined $x->nextmarc(1)); # 63 is_ok(2 == $x->marc_count); # 64 is_ok($x->closemarc); # 65 MARC-1.07/t/badmarc.dat100644 764 764 11204 7062775765 13177 0ustar billbbillb00901cam 2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884 enkaf 000 1 eng d aKSUcKSUdGZM aPS1305b.A1 1884 aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /cby Mark Twain (Samuel Clemens) ; with 174 illustrations. aLondon :bChatto & Windus,c1884. axvi, 438 p., [1] leaf of plates :bill. ;c20 cm. aFirst English ed. aState B; gatherings saddle-stitched with wire staples. aAdvertisements on p. [1]-32 at end. aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn. aE0bVOD01BADcmm 2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau c eng d aVODcVOD aTR820b.A2 aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive aComputer image data. aState College, Pa. :bAccuweather,c1998- aMode of access: World Wide Web. aTitle from homepage. aPublished jointly by Accuweather and The Associated Press. aSubscription based access. a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource. aE0bVOD00901camADD 2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884 enkaf 000 1 eng d aKSUcKSUdGZM aPS1305b.A1 1884 aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /cby Mark Twain (Samuel Clemens) ; with 174 illustrations. aLondon :bChatto & Windus,c1884. axvi, 438 p., [1] leaf of plates :bill. ;c20 cm. aFirst English ed. aState B; gatherings saddle-stitched with wire staples. aAdvertisements on p. [1]-32 at end. aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn. aE0bVOD01467cmm 2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau c eng d aVODcVOD aTR820b.A2 aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive aComputer image data. aState College, Pa. :bAccuweather,c1998- aMode of access: World Wide Web. aTitle from homepage. aPublished jointly by Accuweather and The Associated Press. aSubscription based access. a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource. aE0bVOD MARC-1.07/t/test3.t100644 764 764 17137 7100717523 12333 0ustar billbbillb#!/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 ######################### We start with some black magic to print on failure. BEGIN { $| = 1; print "1..79\n"; } END {print "not ok 1\n" unless $loaded;} use MARCopt; # check inheritance & export $loaded = 1; print "ok 1\n"; ######################### End of black magic. 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 = ; unless (close YY) {warn "Can't close file $file: $!\n"; return;} return $yy; } my $file = "marc.dat"; my $testfile = "t/marc.dat"; 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) ]"; } } my $x; unlink 'output.txt', 'output.html', 'output.xml', 'output.isbd', 'output.urls', 'output2.html', 'output.mkr'; # Create the new MARCopt object. You can use any variable name you like... # Read the MARC file into the MARCopt object. unless (is_ok ($x = MARCopt->new ($file))) { # 2 printf "could not create MARCopt from $file\n"; exit 1; # next test would die at runtime without $x } is_ok (2 == $x->marc_count); # 3 #Output the MARCopt object to an ascii file is_ok ($x->output({file=>">output.txt",'format'=>"ASCII"})); # 4 #Output the MARCopt object to an html file is_ok ($x->output({file=>">output.html",'format'=>"HTML"})); # 5 #Try to output the MARCopt object to an xml file my $quiet = $^W; $^W = 0; is_bad ($x->output({file=>">output.xml",'format'=>"XML"})); # 6 $^W = $quiet; #Output the MARCopt object to an url file is_ok ($x->output({file=>">output.urls",'format'=>"URLS"})); # 7 #Output the MARCopt object to an isbd file is_ok ($x->output({file=>">output.isbd",'format'=>"ISBD"})); # 8 #Output the MARCopt object to a marcmaker file is_ok ($x->output({file=>">output.mkr",'format'=>"marcmaker"})); # 9 #Output the MARCopt 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_bad (-e 'output.xml'); # 13 is_ok (-s 'output.urls'); # 14 #Append the MARCopt 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 $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 "19990808143752.0"); # 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 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"); # 38 is_ok($indi2 eq "4"); # 39 is_ok($indi12 eq "14"); # 40 if ($naptime) { print "++++ page break\n"; sleep $naptime; } 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,"); # 41 is_ok($m100d eq "1835-1910."); # 42 is_bad(defined $m100e); # 43 my @ind12 = $x->getvalue({field=>'246',record=>2,subfield=>'i12'}); is_ok(3 == scalar @ind12); # 44 is_ok($ind12[0] eq "30"); # 45 is_ok($ind12[1] eq "3 "); # 46 is_ok($ind12[2] eq "30"); # 47 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'}); is_ok(3 == scalar @m246a); # 48 is_ok($m246a[0] eq "Photo archive"); # 49 is_ok($m246a[1] eq "Associated Press photo archive"); # 50 is_ok($m246a[2] eq "AP photo archive"); # 51 my @records=$x->searchmarc({field=>"245"}); is_ok(2 == scalar @records); # 52 is_ok($records[0] == 1); # 53 is_ok($records[1] == 2); # 54 @records=$x->searchmarc({field=>"245",subfield=>"a"}); is_ok(2 == scalar @records); # 55 is_ok($records[0] == 1); # 56 is_ok($records[1] == 2); # 57 @records=$x->searchmarc({field=>"245",subfield=>"b"}); is_ok(1 == scalar @records); # 58 is_ok($records[0] == 1); # 59 @records=$x->searchmarc({field=>"245",subfield=>"h"}); is_ok(1 == scalar @records); # 60 is_ok($records[0] == 2); # 61 if ($naptime) { print "++++ page break\n"; sleep $naptime; } @records=$x->searchmarc({field=>"246",subfield=>"a"}); is_ok(1 == scalar @records); # 62 is_ok($records[0] == 2); # 63 @records=$x->searchmarc({field=>"245",regex=>"/huckleberry/i"}); is_ok(1 == scalar @records); # 64 is_ok($records[0] == 1); # 65 @records=$x->searchmarc({field=>"260",subfield=>"c",regex=>"/19../"}); is_ok(1 == scalar @records); # 66 is_ok($records[0] == 2); # 67 @records=$x->searchmarc({field=>"245",notregex=>"/huckleberry/i"}); is_ok(1 == scalar @records); # 68 is_ok($records[0] == 2); # 69 @records=$x->searchmarc({field=>"260",subfield=>"c",notregex=>"/19../"}); is_ok(1 == scalar @records); # 70 is_ok($records[0] == 1); # 71 @records=$x->searchmarc({field=>"900",subfield=>"c"}); is_ok(0 == scalar @records); # 72 is_bad(defined $records[0]); # 73 @records=$x->searchmarc({field=>"999"}); is_ok(0 == scalar @records); # 74 is_bad(defined $records[0]); # 75 is_ok (-s 'output.isbd'); # 76 is_ok (-s 'output.mkr'); # 77 is_ok ($y1 = $x->output({'format'=>"HTML_HEADER"})); # 78 is_ok ($y1 eq "Content-type: text/html\015\012\015\012"); # 79 MARC-1.07/t/test4.t100644 764 764 24373 7100717540 12333 0ustar billbbillb#!/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 ######################### We start with some black magic to print on failure. BEGIN { $| = 1; print "1..116\n"; } END {print "not ok 1\n" unless $loaded;} use MARC 1.03; $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 -pi.bak -e 'BEGIN{$i=1};if (/# \d/){ $i++};s/# \d+/# $i/' test4.t # ######################### End of test renumber. use strict; my $tc = 2; # next test number my $WCB = 0; 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 = ; unless (close YY) {warn "Can't close file $file: $!\n"; return;} return $yy; } sub array_eq_str { my ($ra1,$ra2)=@_; my @a1= @$ra1; my @a2= @$ra2; return 0 unless (scalar(@a1) == scalar(@a2)); for my $i (0..scalar(@a1)-1) { print "WCB: a1 = $a1[$i]...\n" if $WCB; print "WCB: a2 = $a2[$i]...\n" if $WCB; return 0 unless ($a1[$i] eq $a2[$i]); } return 1; } sub printarr { my @b=@_; print "(",(join ", ",grep {s/^/'/;s/$/'/} @b),")"; } my $file = "marc.dat"; my $testfile = "t/marc.dat"; 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) ]"; } } my $x; unlink 'output4.txt','output4.mkr','output4a.txt'; # Create the new MARC object. You can use any variable name you like... # Read the MARC file into the MARC object. unless (is_ok ($x = MARC->new ($file))) { # 2 printf "could not create MARC from $file\n"; exit 1; # next test would die at runtime without $x } #Output the MARC object to an ascii file is_ok ($x->output({file=>">output4.txt",'format'=>"ASCII"})); # 3 #Output the MARC object to a marcmaker file is_ok ($x->output({file=>">output4.mkr",'format'=>"marcmaker"})); # 4 is_ok (-s 'output4.txt'); # 5 is_ok (-s 'output4.mkr'); # 6 my @a1 = ('1',2,'b'); my @a2 = (1,2,'b'); my @b1 = ('1',2); my @b2 = ('1',2,'c'); is_ok ( array_eq_str(\@a1,\@a2) ); # 7 is_bad( array_eq_str(\@a1,\@b1) ); # 8 is_bad( array_eq_str(\@a1,\@b2) ); # 9 delete $x->[1]{500}; for (@{$x->[1]{array}}) { $x->add_map(1,$_) if $_->[0] eq '500'; } is_ok(${$x->[1]{500}{'a'}[0]} eq 'First English ed.'); # 10 ${$x->[1]{500}{'a'}[0]} ="boo"; is_ok(${$x->[1]{500}{'a'}[0]} eq 'boo'); # 11 my @new500=(500,'x','y',a=>"foo",b=>"bar"); $x->add_map(1,[@new500]); is_ok( array_eq_str($x->[1]{500}{field}[4],\@new500) ); # 12 $x->rebuild_map(1,500); my @add008 = ('008',"abcde"); $x->add_map(1,[@add008]); is_ok( array_eq_str($x->[1]{'008'}{field}[1],\@add008) ); # 13 #delete $x->[1]{'008'}; $x->rebuild_map(1,'008'); my @m008 = ('008', '741021s1884 enkaf 000 1 eng d'); is_ok( array_eq_str($x->[1]{'008'}{field}[0],\@m008) ); # 14 is_ok( !defined($x->[1]{'008'}{field}[1])); # 15 my @m5000 = (500, ' ', ' ', a=> 'boo'); is_ok( array_eq_str($x->[1]{'500'}{field}[0],\@m5000) ); # 16 my @m5001 = (500, ' ', ' ', a=>'State B; gatherings saddle-stitched with wire staples.'); is_ok( array_eq_str($x->[1]{'500'}{field}[1],\@m5001) ); # 17 my @m5002 = (500, ' ', ' ', a=> 'Advertisements on p. [1]-32 at end.'); is_ok( array_eq_str($x->[1]{'500'}{field}[2],\@m5002) ); # 18 my @m5003 = (500, ' ', ' ', a=> 'Bound in red S cloth; stamped in black and gold.'); is_ok( array_eq_str($x->[1]{'500'}{field}[3],\@m5003) ); # 19 is_ok( $x->deletefirst({field=>'500',record=>1}) ); # 20 $x->updatefirst({field=>'247',record=>1, rebuild_map =>0}, ('xxx',1," ", a =>"Photo marchive")); $x->updatefirst({field=>'500',record=>1, rebuild_map =>0}, ('xxx',1," ", a =>"First English Fed.")); is_ok( $x->updatefirst({field=>'500',subfield=>"h",record=>1, rebuild_map =>0}, ('xxx',1," ", a =>"First English Fed.",h=>"foobar,the fed")) ); # 21 is_ok( $x->updatefirst({field=>'500',subfield=>"k",record=>1, rebuild_map =>0}, ('xxx',1," ", a =>"First English Fed.",k=>"koobar,the fed")) ); # 22 if ($naptime) { print "++++ page break\n"; sleep $naptime; } ## is_ok($m008 eq "741021s1884 enkaf 000 1 eng d"); 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,"); # 23 is_ok($m100d eq "1835-1910."); # 24 is_bad(defined $m100e); # 25 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'}); is_ok(3 == scalar @m246a); # 26 is_ok($m246a[0] eq "Photo archive"); # 27 is_ok($m246a[1] eq "Associated Press photo archive"); # 28 is_ok($m246a[2] eq "AP photo archive"); # 29 is_ok ($x->output({file=>">output4a.txt",'format'=>"ASCII"})); # 30 my $update246 = {field=>'246',record=>2,ordered=>'y'}; my @u246 = $x->getupdate($update246); is_ok(21 == @u246); # 31 is_ok($u246[0] eq "i1"); # 32 is_ok($u246[1] eq "3"); # 33 is_ok($u246[2] eq "i2"); # 34 is_ok($u246[3] eq "0"); # 35 is_ok($u246[4] eq "a"); # 36 is_ok($u246[5] eq "Photo archive"); # 37 is_ok($u246[6] eq "\036"); # 38 is_ok($u246[7] eq "i1"); # 39 is_ok($u246[8] eq "3"); # 40 is_ok($u246[9] eq "i2"); # 41 is_ok($u246[10] eq " "); # 42 is_ok($u246[11] eq "a"); # 43 is_ok($u246[12] eq "Associated Press photo archive"); # 44 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($u246[13] eq "\036"); # 45 is_ok($u246[14] eq "i1"); # 46 is_ok($u246[15] eq "3"); # 47 is_ok($u246[16] eq "i2"); # 48 is_ok($u246[17] eq "0"); # 49 is_ok($u246[18] eq "a"); # 50 is_ok($u246[19] eq "AP photo archive"); # 51 is_ok($u246[20] eq "\036"); # 52 is_ok(3 == $x->deletemarc($update246)); # 53 my @records = (); foreach my $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); # 54 is_ok($u246[0] eq "i1"); # 55 is_ok($u246[1] eq "3"); # 56 is_ok($u246[2] eq "i2"); # 57 is_ok($u246[3] eq "0"); # 58 is_ok($u246[4] eq "a"); # 59 is_ok($u246[5] eq "Photo archive"); # 60 is_ok($u246[6] eq "\036"); # 61 is_ok($u246[7] eq "i1"); # 62 is_ok($u246[8] eq "3"); # 63 is_ok($u246[9] eq "i2"); # 64 is_ok($u246[10] eq " "); # 65 is_ok($u246[11] eq "a"); # 66 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($u246[12] eq "Associated Press photo archive"); # 67 is_ok($u246[13] eq "\036"); # 68 is_ok($u246[14] eq "i1"); # 69 is_ok($u246[15] eq "3"); # 70 is_ok($u246[16] eq "i2"); # 71 is_ok($u246[17] eq "0"); # 72 is_ok($u246[18] eq "a"); # 73 is_ok($u246[19] eq "AP photo archive"); # 74 is_ok($u246[20] eq "\036"); # 75 is_ok($x->addfield({record=>1, field=>"999", ordered=>"n", i1=>"5", i2=>"3", value=>[c=>"wL70", d=>"AR Clinton PL",f=>"53525"]})); # 76 is_ok($x->addfield({record=>1, field=>"900", ordered=>"y", i1=>"6", i2=>"7", value=>[z=>"part 1", z=>"part 2",z=>"part 3"]})); # 77 is_ok($x->addfield({record=>2, field=>"900", ordered=>"y", i1=>"9", i2=>"8", value=>[z=>"part 4"]})); # 78 @records = $x->searchmarc({field=>'900'}); is_ok(2 == @records); # 79 @records = $x->searchmarc({field=>'999'}); is_ok(1 == @records); # 80 @records = $x->getupdate({field=>'900',record=>1}); is_ok(11 == @records); # 81 is_ok($records[0] eq "i1"); # 82 is_ok($records[1] eq "6"); # 83 is_ok($records[2] eq "i2"); # 84 is_ok($records[3] eq "7"); # 85 is_ok($records[4] eq "z"); # 86 is_ok($records[5] eq "part 1"); # 87 is_ok($records[6] eq "z"); # 88 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($records[7] eq "part 2"); # 89 is_ok($records[8] eq "z"); # 90 is_ok($records[9] eq "part 3"); # 91 is_ok($records[10] eq "\036"); # 92 @records = $x->getupdate({field=>'900',record=>2}); is_ok(7 == @records); # 93 is_ok($records[0] eq "i1"); # 94 is_ok($records[1] eq "9"); # 95 is_ok($records[2] eq "i2"); # 96 is_ok($records[3] eq "8"); # 97 is_ok($records[4] eq "z"); # 98 is_ok($records[5] eq "part 4"); # 99 is_ok($records[6] eq "\036"); # 100 @records = $x->getupdate({field=>'999',record=>1}); is_ok(11 == @records); # 101 is_ok($records[0] eq "i1"); # 102 is_ok($records[1] eq "5"); # 103 is_ok($records[2] eq "i2"); # 104 is_ok($records[3] eq "3"); # 105 is_ok($records[4] eq "c"); # 106 is_ok($records[5] eq "wL70"); # 107 is_ok($records[6] eq "d"); # 108 is_ok($records[7] eq "AR Clinton PL"); # 109 is_ok($records[8] eq "f"); # 110 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($records[9] eq "53525"); # 111 is_ok($records[10] eq "\036"); # 112 @records = $x->getupdate({field=>'999',record=>2}); is_ok(0 == @records); # 113 @records = $x->getupdate({field=>'001',record=>2}); is_ok(2 == @records); # 114 is_ok($records[0] eq "ocm40139019 "); # 115 is_ok($records[1] eq "\036"); # 116 MARC-1.07/t/brkrtest.ref100644 764 764 41405 7062775765 13460 0ustar billbbillb=LDR 00000nam\\2200000\a\4500 =001 tes96000001\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0deng\d =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit. =245 10$aNew test record number 1 with ordinary data$h[large print] /$cby Jane Deer-Doe ; edited by Patty O'Furniture. =246 1\$aNew test record number one with ordinary data =260 \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957> =300 \\$av. 1-<5> :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 1 =500 \\$aThis is a test of ordinary features like replacement of the mnemonics for currency and dollar signs and backslashes (backsolidus {bsol}) used for blanks in certain areas. =500 \\$aThis is a test for the conversion of curly braces; the opening curly brace ({lcub}) and the closing curly brace ({rcub}). =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =700 1\$aO'Furniture, Patty,$eed. =LDR 00000nam\\2200000\a\4500 =001 tes96000002\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 2 with currently defined ANSEL characters (mostly diacritics) input with their real hexadecimal values$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 2 =500 \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000003\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 3 with currently defined ANSEL characters (mostly diacritics) input with mnemonic strings$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 3 =500 \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000004\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 4 with newly-defined diacritics$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 4 =500 \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}, also included are new extended characters degree sign 98.6{deg}, small script l in 45{scriptl}, the phono copyright mark in {phono}1994, the copyright mark in {copy}1955, the musical sharp in concerto in F{sharp} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!. =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000005\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 5 for all diacritics$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 5 =500 \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika =500 \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}; also included are new extended characters degree sign 98.6{deg}, small script l in 45{scriptl}, the phono copyright mark in {scriptl}1994, the copyright mark in {phono}1955, the musical sharp in concerto in F{copy} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!. =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000006\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 12$aA new ultimate test record for diacritics$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 6 =500 \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F{flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W{lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K{ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c{oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika =500 \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}, also included are new extended characters degree sign 98.6{deg}, small script l in 45{scriptl}, the phono copyright mark in {phono}1994, the copyright mark in {copy}1955, the musical sharp in concerto in F{sharp} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!. =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000007\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 12$aA check of the processing of unrecognized mnemonic strings like {zilch} which might be encountered in the MARCMakr input file. =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 7 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}). =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =856 2\$aftp.loc.gov$d{bsol}pub{bsol}marc =LDR 00000nam\\2200000\a\4500 =001 tes96000008\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =020 \\$a0777000008 :$c{dollar}35.99 =020 \\$a0777000008 :$c{dollar}35.99 =020 \\$z3777000008 (German ed.):$c{dollar}46.00 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2\$aDeer-Doe, Jane,$d1957- =245 12$aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices). =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 \0$aTest record series ;$vno. 8 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}). MARC-1.07/t/makrbrkr.mrc100644 764 764 36651 7062775765 13447 0ustar billbbillb01200nam 2200253 a 4500001001300000003000700013005001700020008004100037040001900078050002200097100005500119245011400174246005000288260005600338300005100394440003200445500017000477500011600647504007200763500002000835650002700855600003500882700002900917tes96000001 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0deng d aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, J.q(Jane),csaint,d1355-1401,cspirit.10aNew test record number 1 with ordinary datah[large print] /cby Jane Deer-Doe ; edited by Patty O'Furniture.1 aNew test record number one with ordinary data aWashington, DC :bLibrary of Congress,c1955-<1957> av. 1-<5> :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 1 aThis is a test of ordinary features like replacement of the mnemonics for currency and dollar signs and backslashes (backsolidus \) used for blanks in certain areas. aThis is a test for the conversion of curly braces; the opening curly brace ({) and the closing curly brace (}). aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.1 aO'Furniture, Patty,eed.02665nam 2200229 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245016500161260005000326300004900376440003200425500182400457504007202281500002002353650002702373600003502400tes96000002 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 2 with currently defined ANSEL characters (mostly diacritics) input with their real hexadecimal valuesh[large print] /cby Jane Deer-Doe aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 2 aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.02652nam 2200229 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245015200161260005000313300004900363440003200412500182400444504007202268500002002340650002702360600003502387tes96000003 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 3 with currently defined ANSEL characters (mostly diacritics) input with mnemonic stringsh[large print] /cby Jane Deer-Doe aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 3 aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.01276nam 2200229 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245009400161260005000255300004900305440003200354500050600386504007200892500002000964650002700984600003501011tes96000004 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 4 with newly-defined diacriticsh[large print] /cby Jane Deer-Doe aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 4 aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {text}, also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Â1994, the copyright mark in Ã1955, the musical sharp in concerto in FÄ major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!. aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.03101nam 2200241 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245008300161260005000244300004900294440003200343500182400375500050602199504007202705500002002777650002702797600003502824tes96000005 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-10aNew test record number 5 for all diacriticsh[large print] /cby Jane Deer-Doe aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 5 aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {text}; also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Á1994, the copyright mark in Â1955, the musical sharp in concerto in Fà major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!. aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.03099nam 2200241 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245008100161260005000242300004900292440003200341500182400373500050602197504007202703500002002775650002702795600003502822tes96000006 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-12aA new ultimate test record for diacriticsh[large print] /cby Jane Deer-Doe aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 6 aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {text}, also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Â1994, the copyright mark in Ã1955, the musical sharp in concerto in FÄ major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!. aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.00959nam 2200241 a 4500001001300000003000700013005001700020008004100037020001500078040001900093050002200112100002700134245013100161260005000292300004900342440003200391500011300423504007200536500002000608650002700628600003500655856002700690tes96000007 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-12aA check of the processing of unrecognized mnemonic strings like &zilch; which might be encountered in the MARCMakr input file. aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 7 aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called (\). aIncludes Bibliographies, discographies, filmographies, and reviews. aIncludes index. 4aTest recordxJuvenile.14aDoe, John,d1955- xBiography.2 aftp.loc.govd\pub\marc00833nam 2200217 a 4500001001300000003000700013005001700020008004100037020001500078020002500093020002500118020003700143040001900180050002200199100002700221245012300248260005000371300004900421440003200470500011300502tes96000008 ViArRB19960221075055.7960221s1955 dcuabcdjdbkoqu001 0dspa d a8472236579 a0777000008 :c$35.99 a0777000008 :c$35.99 z3777000008 (German ed.):c$46.00 aViArRBcViArRB 4aPQ1234b.T39 19552 aDeer-Doe, Jane,d1957-12aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices). aWashington, DC :bLibrary of Congress,c1955. a300 p. :bill., maps, ports., charts ;c cm. 0aTest record series ;vno. 8 aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called (\).MARC-1.07/t/test5.t100644 764 764 31033 7100717571 12327 0ustar billbbillb#!/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 ######################### We start with some black magic to print on failure. BEGIN { $| = 1; print "1..109\n"; } END {print "not ok 1\n" unless $loaded;} use MARC 1.07; $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 -pi.bak -e 'BEGIN{$i=1};next if /^#/;if (/# \d/){ $i++};s/# \d+/# $i/' test5.t # ######################### 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 = ; unless (close YY) {warn "Can't close file $file: $!\n"; return;} return $yy; } sub array_eq_str { my ($ra1,$ra2)=@_; my @a1= @$ra1; my @a2= @$ra2; return 0 unless (scalar(@a1) == scalar(@a2)); for my $i (0..scalar(@a1)-1) { return 0 unless ($a1[$i] eq $a2[$i]); } return 1; } sub printarr { my @b=@_; print "(",(join ", ",grep {s/^/'/;s/$/'/} @b),")"; } my $file = "marc4.dat"; my $testfile = "t/marc4.dat"; 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) ]"; } } my $x; unlink 'output4.txt','output4.mkr'; # Create the new MARC object. You can use any variable name you like... # Read the MARC file into the MARC object. unless (is_ok ($x = MARC->new ($file))) { # 2 printf "could not create MARC from $file\n"; exit 1; # next test would die at runtime without $x } #Output the MARC object to an ascii file is_ok ($x->output({file=>">output4.txt",'format'=>"ASCII"})); # 3 #Output the MARC object to a marcmaker file is_ok ($x->output({file=>">output4.mkr",'format'=>"marcmaker"})); # 4 is_ok (-s 'output4.txt'); # 5 is_ok (-s 'output4.mkr'); # 6 my @a1 = ('1',2,'b'); my @a2 = (1,2,'b'); my @b1 = ('1',2); my @b2 = ('1',2,'c'); is_ok ( array_eq_str(\@a1,\@a2) ); # 7 is_bad( array_eq_str(\@a1,\@b1) ); # 8 is_bad( array_eq_str(\@a1,\@b2) ); # 9 # I have found updatefirst/deletefirst functionality very tricky to # implement. And this is the second time I have implemented it. There # are several semantics that can go either way. These tests are # intended to cover all semantic choices and data dependencies, # providing reasonable evidence that any straightforward # implementation is correct. # Note to implementors. You should maintain a couple of obvious # invariants by construction. Don't change any but the current record # and don't change any but the current field (and subfield if it # exists). Not hard to do, but someone has to say it.... If you need # to violate the subfield constraint (possible if you put extra # information in the field to reflect workflow) do it in updatehook(). ## 9. Tests are for "all significant variations", which we # split by function: deletion or update # Given deletion the variations are: # da. tag < or > 10, (tags 1 090) # db. 0,1, or more matches (tags 2 11 3 49 500) # dc. subfield spec or not (tags 5 245) # dd. indicator or not in the subfield spec (tag > 10) # de. last subfield or not (tags 3 049) # df. match in the first field or not. (tags 500 subfield c and a) # Given update the variations are: # ua. to be tag < or > 10, (tags 1 3 5 8) # ub. 0,1, or more matches (tags 2 11 3 49 500) # uc. subfield spec or not (tags 4 # ud. indicator or not in the subfield spec # uf. match in the first field or not. (tags 500 subfield c and a) # This gives an upper bound of 2*3*2*2*2*2 + 2*3*2*2*2 = 96+48 = 148 # tests. (There is some collapse possible, so we may get away with # (much) less.) (Currently we have 16 deletes and 14 updates. Better...) ## 9. What needs to be tested. # We must check that only the affected fields and subfields are # touched. Therefore we need to check, e.g. the 008 field when # we are munging the 245's. From the structure of current code # this is provably correct, but subclasses my override this... my ($m008) = $x->getvalue({field=>'008',record=>1,delimeter=>"\c_"}); # Deletion. #da1.db3 not currently tested. Check with a repeat 006 sometime. #da1.db1.dc1 #da1.db1.dc2 #da1.db2.dc1 #da1.db2.dc2 #da2.db1.dc1.dd1 #da2.db1.dc1.dd2 #da2.db1.dc2 #da2.db2.dc1.dd1 #da2.db2.dc1.dd2.de1 #da2.db2.dc1.dd2.de2 #da2.db2.dc2 #da2.db3.dc1.dd1 #da2.db3.dc1.dd2 #da2.db3.dc1.dd2.de1 #da2.db3.dc1.dd2.de2.df1 #da2.db3.dc1.dd2.de2.df2 # Update. #ua1.ub3 not currently tested. Check with a repeat 006 sometime. #ua1.ub1.uc1 #ua1.ub1.uc2 #ua1.ub2.uc1 #ua1.ub2.uc2 #ua2.ub1.uc1.ud1 #ua2.ub1.uc1.ud2 #ua2.ub1.uc2 #ua2.ub2.uc1.ud1 #ua2.ub2.uc1.ud2 #ua2.ub2.uc2 #ua2.ub3.uc1.ud1 #ua2.ub3.uc1.ud2.uf1 #ua2.ub3.uc1.ud2.uf2 my %o=(); for (qw(001 002 005 049 090 245 247 500)) { my @tmp = $x->getupdate({record=>1,field=>$_}); $o{$_}=\@tmp; } my $templc1d1 = {record=>1,field=>245,subfield=>'i1'}; my $templc1d2 = {record=>1,field=>245,subfield=>'a'}; my $templc2 = {record=>1,field=>245}; my $subfieldf1 = 'a'; my $subfieldf2 = 'c'; my $fieldf = 500; #F u a1.b1.c2 002 a my $ftempl = {record=>1,field=>'002'}; my $templ = {record=>1,field=>'002'}; $templ->{subfield}= 'a'; undef $@; eval{$x->updatefirst($templ,('002',"x","y", a =>"zz"));}; is_ok( $@ =~/Cannot update subfields of control fields/); # 10 my @new =$x->getupdate($ftempl); my $ranew = \@new; my ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'}); my ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'}); is_ok($indi1 eq "1"); # 11 is_ok($indi2 eq "4"); # 12 my @m245 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"}); my @m247 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"}); my @m500 = $x->getvalue({field=>'245',record=>1,subfield=>'a',delimiter=>"\c_"}); $x->updatefirst({field=>'245',record=>1,subfield => 'a'}, ('245','a','b', a=>'foo')); ($indi1) = $x->getvalue({field=>'245',record=>1,subfield=>'i1'}); ($indi2) = $x->getvalue({field=>'245',record=>1,subfield=>'i2'}); is_ok($indi1 eq "1"); # 13 is_ok($indi2 eq "4"); # 14 my ($m245_a) = $x->getvalue({field=>'245',record=>1,subfield=>'a'}); $x->deletefirst({field=>'500',record=>1}); $x->updatefirst({field=>'247',record=>1}, (i1=>1,i2=>" ", a =>"Photo marchive")); $x->updatefirst({field=>'500',record=>1}, (i1=>1,i2=>" ", a =>"First English Fed.")); is_ok($m008 eq "741021s1884 enkaf 000 1 eng d"); # 15 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,"); # 16 is_ok($m100d eq "1835-1910."); # 17 is_bad(defined $m100e); # 18 my @m246a = $x->getvalue({field=>'246',record=>2,subfield=>'a'}); is_ok(3 == scalar @m246a); # 19 is_ok($m246a[0] eq "Photo archive"); # 20 is_ok($m246a[1] eq "Associated Press photo archive"); # 21 is_ok($m246a[2] eq "AP photo archive"); # 22 if ($naptime) { print "++++ page break\n"; sleep $naptime; } my $update246 = {field=>'246',record=>2,ordered=>'y'}; my @u246 = $x->getupdate($update246); is_ok(21 == @u246); # 23 is_ok($u246[0] eq "i1"); # 24 is_ok($u246[1] eq "3"); # 25 is_ok($u246[2] eq "i2"); # 26 is_ok($u246[3] eq "0"); # 27 is_ok($u246[4] eq "a"); # 28 is_ok($u246[5] eq "Photo archive"); # 29 is_ok($u246[6] eq "\036"); # 30 is_ok($u246[7] eq "i1"); # 31 is_ok($u246[8] eq "3"); # 32 is_ok($u246[9] eq "i2"); # 33 is_ok($u246[10] eq " "); # 34 is_ok($u246[11] eq "a"); # 35 is_ok($u246[12] eq "Associated Press photo archive"); # 36 is_ok($u246[13] eq "\036"); # 37 is_ok($u246[14] eq "i1"); # 38 is_ok($u246[15] eq "3"); # 39 is_ok($u246[16] eq "i2"); # 40 is_ok($u246[17] eq "0"); # 41 is_ok($u246[18] eq "a"); # 42 is_ok($u246[19] eq "AP photo archive"); # 43 is_ok($u246[20] eq "\036"); # 44 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok(3 == $x->deletemarc($update246)); # 45 my @records = (); foreach my $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); # 46 is_ok($u246[0] eq "i1"); # 47 is_ok($u246[1] eq "3"); # 48 is_ok($u246[2] eq "i2"); # 49 is_ok($u246[3] eq "0"); # 50 is_ok($u246[4] eq "a"); # 51 is_ok($u246[5] eq "Photo archive"); # 52 is_ok($u246[6] eq "\036"); # 53 is_ok($u246[7] eq "i1"); # 54 is_ok($u246[8] eq "3"); # 55 is_ok($u246[9] eq "i2"); # 56 is_ok($u246[10] eq " "); # 57 is_ok($u246[11] eq "a"); # 58 is_ok($u246[12] eq "Associated Press photo archive"); # 59 is_ok($u246[13] eq "\036"); # 60 is_ok($u246[14] eq "i1"); # 61 is_ok($u246[15] eq "3"); # 62 is_ok($u246[16] eq "i2"); # 63 is_ok($u246[17] eq "0"); # 64 is_ok($u246[18] eq "a"); # 65 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($u246[19] eq "AP photo archive"); # 66 is_ok($u246[20] eq "\036"); # 67 is_ok($x->addfield({record=>1, field=>"999", ordered=>"n", i1=>"5", i2=>"3", value=>[c=>"wL70", d=>"AR Clinton PL",f=>"53525"]})); # 68 is_ok($x->addfield({record=>1, field=>"900", ordered=>"y", i1=>"6", i2=>"7", value=>[z=>"part 1", z=>"part 2",z=>"part 3"]})); # 69 is_ok($x->addfield({record=>2, field=>"900", ordered=>"y", i1=>"9", i2=>"8", value=>[z=>"part 4"]})); # 70 @records = $x->searchmarc({field=>'900'}); is_ok(2 == @records); # 71 @records = $x->searchmarc({field=>'999'}); is_ok(1 == @records); # 72 @records = $x->getupdate({field=>'900',record=>1}); is_ok(11 == @records); # 73 is_ok($records[0] eq "i1"); # 74 is_ok($records[1] eq "6"); # 75 is_ok($records[2] eq "i2"); # 76 is_ok($records[3] eq "7"); # 77 is_ok($records[4] eq "z"); # 78 is_ok($records[5] eq "part 1"); # 79 is_ok($records[6] eq "z"); # 80 is_ok($records[7] eq "part 2"); # 81 is_ok($records[8] eq "z"); # 82 is_ok($records[9] eq "part 3"); # 83 is_ok($records[10] eq "\036"); # 84 @records = $x->getupdate({field=>'900',record=>2}); is_ok(7 == @records); # 85 is_ok($records[0] eq "i1"); # 86 is_ok($records[1] eq "9"); # 87 if ($naptime) { print "++++ page break\n"; sleep $naptime; } is_ok($records[2] eq "i2"); # 88 is_ok($records[3] eq "8"); # 89 is_ok($records[4] eq "z"); # 90 is_ok($records[5] eq "part 4"); # 91 is_ok($records[6] eq "\036"); # 92 @records = $x->getupdate({field=>'999',record=>1}); is_ok(11 == @records); # 93 is_ok($records[0] eq "i1"); # 94 is_ok($records[1] eq "5"); # 95 is_ok($records[2] eq "i2"); # 96 is_ok($records[3] eq "3"); # 97 is_ok($records[4] eq "c"); # 98 is_ok($records[5] eq "wL70"); # 99 is_ok($records[6] eq "d"); # 100 is_ok($records[7] eq "AR Clinton PL"); # 101 is_ok($records[8] eq "f"); # 102 is_ok($records[9] eq "53525"); # 103 is_ok($records[10] eq "\036"); # 104 is_ok($MARC::VERSION == $MARC::Rec::VERSION); # 105 @records = $x->getupdate({field=>'999',record=>2}); is_ok(0 == @records); # 106 @records = $x->getupdate({field=>'001',record=>2}); is_ok(2 == @records); # 107 is_ok($records[0] eq "ocm40139019 "); # 108 is_ok($records[1] eq "\036"); # 109 my $string_rec = $x->[1]->as_string(); my $tmp_rec=$x->[0]{proto_rec}->copy_struct(); $tmp_rec->from_string($string_rec); 1;# for debug MARC-1.07/t/makrtest.src100644 764 764 40261 7062775765 13464 0ustar billbbillb=LDR 00000nam\\2200000\a\4500 =001 tes96000001\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0deng\d =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit. =245 10$aNew test record number 1 with ordinary data$h[large print] /$cby Jane Deer-Doe ; edited by Patty O'Furniture. =246 1\$aNew test record number one with ordinary data =260 \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957> =300 \\$av. 1-<5>\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 1 =500 \\$aThis is a test of ordinary features like replacement of the mnemonics for currency and dollar signs and backslashes (backsolidus {bsol}) used for blanks in certain areas. =500 \\$aThis is a test for the conversion of curly braces; the opening curly brace ({lcub}) and the closing curly brace ({rcub}). =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =700 1\$aO'Furniture, Patty,$eed. =LDR 00000nam\\2200000\a\4500 =001 tes96000002\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 2 with currently defined ANSEL characters (mostly diacritics) input with their real hexadecimal values$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 2 =500 \\$aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000003 =003 ViArRB =005 19960221075055.7 =008 960221s1955\\ dcuabcdjdbkoqu001 0dspa d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 3 with currently defined ANSEL characters (mostly diacritics) input with mnemonic strings $h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300 p. :$bill., maps, ports., charts ;$c cm. =440 0$aTest record series ;$vno. 3 =500 \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F {flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W {lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K {ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c {oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000004\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 4 with newly-defined diacritics $h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 4 =500 \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}, also included are new extended characters degree sign 98.6 {deg}, small script l in 45{scriptl}, the phono copyright mark in {phono}1994, the copyright mark in {copy}1955, the musical sharp in concerto in F{sharp} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!. =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000005\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 10$aNew test record number 5 for all diacritics$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 5 =500 \\$aThis is a test of diacritics like the uppercase Polish L in ¡âodâz, the uppercase Scandinavia O in ¢st, the uppercase D with crossbar in £uro, the uppercase Icelandic thorn in ¤ann, the uppercase digraph AE in ¥gir, the uppercase digraph OE in ¦uvres, the soft sign in rech§, the middle dot in col¨lecciâo, the musical flat in F©, the patent mark in Frizbeeª, the plus or minus sign in «54%, the uppercase O-hook in B¬, the uppercase U-hook in X­A, the alif in mas®alah, the ayn in °arab, the lowercase Polish l in W±oc±aw, the lowercase Scandinavian o in K²benhavn, the lowercase d with crossbar in ³avola, the lowercase Icelandic thorn in ´ann, the lowercase digraph ae in vµre, the lowercase digraph oe in c¶ur, the lowercase hardsign in s·ezd, the Turkish dotless i in masal¸, the British pound sign in ¹5.95, the lowercase eth in verºur, the lowercase o-hook (with pseudo question mark) in Sà¼, the lowercase u-hook in T½ D½c, the pseudo question mark in càui, the grave accent in tráes, the acute accent in dâesirâee, the circumflex in cãote, the tilde in maänana, the macron in Tåokyo, the breve in russkiæi, the dot above in çzaba, the dieresis (umlaut) in Lèowenbrèau, the caron (hachek) in écrny, the circle above (angstrom) in êarbok, the ligature first and second halves in dëiìadëiìa, the high comma off center in rozdelíovac, the double acute in idîoszaki, the candrabindu (breve with dot above) in Aliïiev, the cedilla in ðca va comme ðca, the right hook in vietña, the dot below in teòda, the double dot below in ököhuótbah, the circle below in Saòmskôrta, the double underscore in õGhulam, the left hook in Lech Wa±÷esa, the right cedilla (comma below) in khøong, the upadhmaniya (half circle below) in ùhumantués, double tilde, first and second halves in únûgalan, high comma (centered) in gþeotermika =500 \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}; also included are new extended characters degree sign 98.6À, small script l in 45Á, the phono copyright mark in Á1994, the copyright mark in Â1955, the musical sharp in concerto in Fà major, the inverted question mark in ÅQue pasâo?, and the inverted exclamation mark in ÆAy caramba!. =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000006\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 12$aA new ultimate test record for diacritics$h[large print] /$cby Jane Deer-Doe =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 6 =500 \\$aThis is a test of diacritics like the uppercase Polish L in {Lstrok}{acute}od{acute}z, the uppercase Scandinavia O in {Ostrok}st, the uppercase D with crossbar in {Dstrok}uro, the uppercase Icelandic thorn in {THORN}ann, the uppercase digraph AE in {AElig}gir, the uppercase digraph OE in {OElig}uvres, the soft sign in rech{softsign}, the middle dot in col{middot}lecci{acute}o, the musical flat in F {flat}, the patent mark in Frizbee{reg}, the plus or minus sign in {plusmn}54%, the uppercase O-hook in B{Ohorn}, the uppercase U-hook in X{Uhorn}A, the alif in mas{mlrhring}alah, the ayn in {mllhring}arab, the lowercase Polish l in W {lstrok}oc{lstrok}aw, the lowercase Scandinavian o in K {ostrok}benhavn, the lowercase d with crossbar in {dstrok}avola, the lowercase Icelandic thorn in {thorn}ann, the lowercase digraph ae in v{aelig}re, the lowercase digraph oe in c {oelig}ur, the lowercase hardsign in s{hardsign}ezd, the Turkish dotless i in masal{inodot}, the British pound sign in {pound}5.95, the lowercase eth in ver{eth}ur, the lowercase o-hook (with pseudo question mark) in S{hooka}{ohorn}, the lowercase u-hook in T{uhorn} D{uhorn}c, the pseudo question mark in c{hooka}ui, the grave accent in tr{grave}es, the acute accent in d{acute}esir{acute}ee, the circumflex in c{circ}ote, the tilde in ma{tilde}nana, the macron in T{macr}okyo, the breve in russki{breve}i, the dot above in {dot}zaba, the dieresis (umlaut) in L{uml}owenbr{uml}au, the caron (hachek) in {caron}crny, the circle above (angstrom) in {ring}arbok, the ligature first and second halves in d{llig}i{rlig}ad{llig}i{rlig}a, the high comma off center in rozdel{rcommaa}ovac, the double acute in id{dblac}oszaki, the candrabindu (breve with dot above) in Ali{candra}iev, the cedilla in {cedil}ca va comme {cedil}ca, the right hook in viet{ogon}a, the dot below in te{dotb}da, the double dot below in {under}k{under}hu{dbldotb}tbah, the circle below in Sa{dotb}msk{ringb}rta, the double underscore in {dblunder}Ghulam, the left hook in Lech Wa{lstrok}{commab}esa, the right cedilla (comma below) in kh{rcedil}ong, the upadhmaniya (half circle below) in {breveb}humantu{caron}s, double tilde, first and second halves in {ldbltil}n{rdbltil}galan, high comma (centered) in g{commaa}eotermika =500 \\$aThis field tests the 13 new USMARC characters which include the spacing circumflex "^", the spacing underscore in "file_name", the grave "`", the spacing tilde "~", and the opening and closing curly brackets, {lcub}text{rcub}, also included are new extended characters degree sign 98.6 {deg}, small script l in 45{scriptl}, the phono copyright mark in {phono}1994, the copyright mark in {copy}1955, the musical sharp in concerto in F{sharp} major, the inverted question mark in {iquest}Que pas{acute}o?, and the inverted exclamation mark in {iexcl}Ay caramba!. =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =LDR 00000nam\\2200000\a\4500 =001 tes96000007\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 12$aA check of the processing of unrecognized mnemonic strings like {zilch} which might be encountered in the MARCMakr input file. =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 7 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}). =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =856 2\$aftp.loc.gov$d{bsol}pub{bsol}marc =LDR 00000nam\\2200000\a\4500 =001 tes96000008\ =003 ViArRB =005 19960221075055.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =020 \\$a0777000008 :$c{24}35.99 =020 \\$a0777000008 :$c{curren}35.99 =020 \\$z3777000008 (German ed.):$c{dollar}46.00 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 12$aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices). =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 8 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}). MARC-1.07/t/marc.dat100644 764 764 4500 7062775765 12511 0ustar billbbillb00901cam 2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884 enkaf 000 1 eng d aKSUcKSUdGZM aPS1305b.A1 1884 aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /cby Mark Twain (Samuel Clemens) ; with 174 illustrations. aLondon :bChatto & Windus,c1884. axvi, 438 p., [1] leaf of plates :bill. ;c20 cm. aFirst English ed. aState B; gatherings saddle-stitched with wire staples. aAdvertisements on p. [1]-32 at end. aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn. aE0bVOD01467cmm 2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau c eng d aVODcVOD aTR820b.A2 aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive aComputer image data. aState College, Pa. :bAccuweather,c1998- aMode of access: World Wide Web. aTitle from homepage. aPublished jointly by Accuweather and The Associated Press. aSubscription based access. a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource. aE0bVODMARC-1.07/t/MARCopt.pm100644 764 764 467 7062775765 12670 0ustar billbbillbpackage MARCopt; # Inheritance test for test3.t only use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = '1.04'; require Exporter; use MARC; @ISA = qw( Exporter MARC ); @EXPORT= qw(); @EXPORT_OK= @MARC::EXPORT_OK; %EXPORT_TAGS = %MARC::EXPORT_TAGS; print "MARCopt inherits from MARC\n"; 1; MARC-1.07/t/makrtest.bad100644 764 764 5410 7062775765 13400 0ustar billbbillb=LDR 00000nam\\2200000\a\4500 =001 tes96000001\ =003 ViArRB =005 199602210153555.7 =008 960221s1955\\\\dcuabcdjdbkoqu001\0deng\d =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, J.$q(Jane),$csaint,$d1355-1401,$cspirit. =245 10$aNew test record number 1 with ordinary data$h[large print] /$cby Jane Deer-Doe ; edited by Patty O'Furniture. =246 1\$aNew test record number one with ordinary data =260 \\$aWashington, DC :$bLibrary of Congress,$c1955-<1957> =300 \\$av. 1-<5>\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 1 =500 \\$aThis is a test of ordinary features like replacement of the mnemonics for currency and dollar signs and backslashes (backsolidus {bsol}) used for blanks in certain areas. =500 \\$aThis is a test for the conversion of curly braces; the opening curly brace ({lcub}) and the closing curly brace ({rcub}). =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =700 1\$aO'Furniture, Patty,$eed. =LDR 00000nam\\2200000\a\4500 =001 tes96000007\ =003 ViArRB =005 19960221165955.9 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 12$aA check of the processing of unrecognized mnemonic strings like {zilch} which might be encountered in the MARCMakr input file. =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 7 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}). =504 \\$aIncludes Bibliographies, discographies, filmographies, and reviews. =500 \\$aIncludes index. =650 \4$aTest record$xJuvenile. =600 14$aDoe, John,$d1955- $xBiography. =856 2\$aftp.loc.gov$d{bsol}pub{bsol}marc =bad 00000nam\\2200000\a\4500 =001 tes96000008\ =003 ViArRB =005 19960221195511.9 =008 960221s1955\\\\dcuabcdjdbkoqu001\0dspa\d =020 \\$a8472236579 =020 \\$a0777000008 :$c{24}35.99 =020 \\$a0777000008 :$c{curren}35.99 =020 \\$z3777000008 (German ed.):$c{dollar}46.00 =040 \\$aViArRB$cViArRB =050 \4$aPQ1234$b.T39 1955 =100 2 $aDeer-Doe, Jane,$d1957- =245 12$aA check of the processing of the dollar sign and mnemonic strings used for real dollar signs (associated with prices). =260 \\$aWashington, DC :$bLibrary of Congress,$c1955. =300 \\$a300\p.\:$bill., maps, ports., charts ;$c\cm. =440 \0$aTest record series ;$vno. 8 =500 \\$aThis is a test of mnemonic conversion, like a real backslash or back solidus, as it is sometimes called ({bsol}). MARC-1.07/t/marc4.dat100644 764 764 4500 7062775765 12575 0ustar billbbillb00901cam 2200241Ia 45e0001001300000003000600013005001700019008004100036040001800077090002100095049000900116100002900125245019000154260003800344300005400382500002200436500005900458500004000517500005300557510001500610740002200625994001200647ocm01047729 OCoLC19990808143752.0741021s1884 enkaf 000 1 eng d aKSUcKSUdGZM aPS1305b.A1 1884 aVODN1 aTwain, Mark,d1835-1910.14aThe adventures of Huckleberry Finn :b(Tom Sawyer's comrade) : scene, the Mississippi Valley : time, forty to fifty years ago /hby Mark Twain (Samuel Clemens) ; with 174 illustrations. aLondon :bChatto & Windus,c1884. axvi, 438 p., [1] leaf of plates :bill. ;c20 cm. aFirst English ed. aState B; gatherings saddle-stitched with wire staples. hAdvertisements on p. [1]-32 at end. aBound in red S cloth; stamped in black and gold.4 aBALc3414.01aHuckleberry Finn. aE0bVOD01467cmm 2200325Ka 45e0001001300000003000600013005001700019007000700036008004100043040001300084090001500097049000900112245004600121246001800167246003500185246002100220256002500241260004600266538003600312500002500348500006300373506003100436520046600467650004900933650004500982710002201027710001701049856006301066994001201129ocm40139019 OCoLC19990824212014.0cr mnu981020m19989999pau c eng d aVODcVOD aTR820b.A2 aVODN00aAccuNet/AP photo archiveh[computer file]30aPhoto archive3 aAssociated Press photo archive30aAP photo archive aComputer image data. aState College, Pa. :bAccuweather,c1998- aMode of access: World Wide Web. aTitle from homepage. aPublished jointly by Accuweather and The Associated Press. aSubscription based access. a"The Photo Archive features state, regional and national photos from North America, as well as ... international photos all available moments after they move on the AP's spot picture system. An average of 800 photos a day feed into the Photo Archive, and remain there for a minimum of one year. Specially trained indexers select the best 200 or so photos each day to save for all time, while the remainder are eliminated from the Photo Archive after 12 months." 0aPhotojournalismxComputer network resources. 0aPhotographsxComputer network resources.2 aAssociated Press.2 aAccuweather.7 uhttp://ap.accuweather.com2httpzConnect to this resource. aE0bVODMARC-1.07/README100644 764 764 14156 7100664723 11522 0ustar billbbillbMARC (manipulate MAchine Readable Cataloging) VERSION=1.07, 23 April 2000 This is a cross-platform module. All of the files except README.txt are LF-only terminations. You will need a better editor than Notepad to read them on Win32. README.txt is README with CRLF. DESCRIPTION: MARC.pm is a Perl 5 module for reading in, manipulating, and outputting bibliographic records in the USMARC format. You will need to have Perl 5.004 or greater for MARC.pm to work properly. Since it is a Perl module you use MARC.pm from one of your own Perl scripts. It handles conversions from MARC into ASCII (text), Library of Congress MARCMaker, HTML, and ISBD. Input from MARCMaker format is also supported. Individual records, fields, indicators, and subfields can be created, modified, and deleted. It can extract URLs from the 856 field into HTML. The MARC::XML module adds conversions to and from XML. The MARC::Tie module adds another way to access this data. MARC.pm can handle both single and batches of MARC records. The limit on the number of records in a batch is determined by the memory capacity of the machine you are running. If memory is an issue for you MARC.pm will allow you to read in records from a batch gradually. MARC.pm also includes a variety of tools for searching, removing, and even creating records from scratch. FILES: Changes - for history lovers Makefile.PL - the "starting point" for traditional reasons MANIFEST - file list README - this file for CPAN README.txt - this file for DOS MARC.pm - the reason you're reading this t - test directory t/marc.dat - two record data file for testing t/marc4.dat - slightly different version of t/marc.dat t/badmarc.dat - corrupt data file for testing t/test1.t - basic tests, search, update t/test2.t - MARCMaker format tests t/test3.t - Inheritance version of test1.t t/test4.t - tests for the *map* methods t/test5.t - updatefirst/deletefirst tests t/MARCopt.pm - Inheritance stub module t/makrbrkr.mrc - LoC. MARCMaker reference records t/makrtest.src - MARCMaker source for makrbrkr.mrc t/brkrtest.ref - MARCBreaker output from makrbrkr.mrc t/makrtest.bad - corrupt MARCMaker source file for testing eg - test directory eg/microlif.001 - eighteen record data file for demo eg/addlocal.pl - simple modify/write demo with comments eg/specials.001 - complex data file for fixlocal demo eg/fixlocal.pl - multi-field search and replace demo with comments and option templates eg/uclocal.pl - complex modify/write demo with extensive use of templates and tutorial comments INSTALL and TEST: On linux and Unix, this distribution uses Makefile.PL and the "standard" install sequence for CPAN modules: perl Makefile.PL make make test make install On Win32, Makefile.PL creates equivalent scripts for the "make-deprived" and follows a similar sequence. perl Makefile.PL perl test.pl perl install.pl Both sequences create install files and directories. The test uses a small sample input file and creates outputs in various formats. You can specify an optional PAUSE (0..5 seconds) between pages of output. The 'perl t/test1.pl PAUSE' form works on all OS types. The test will indicate if any unexpected errors occur (not ok). Once you have installed, you can check if Perl can find it. Change to some other directory and execute from the command line: perl -e "use MARC" No response that means everything is OK! If you get an error like * Can't locate method "use" via package MARC *, then Perl is not able to find MARC.pm--double check that the file copied it into the right place during the install. EXPERIMENTAL ELEMENTS: A number of functions were added in Version 0.92 by Derek Lane to support updating "000" and "008" fields. All of these are experimental and may be subject to changes or syntax refinements. Here are his comments: (unpack_ldr): gets an updateable version of the LDR (_unpack_ldr): This and other _ - series functions work fine on a record-by-record basis. In general all official methods in the (un)?pack.* series call corresponding _(un)?pack.* methods. The official interfaces have to specify the records. (_pack_ldr): Added in 0.95d (bib_format): returns, e.g. BOOK or SERIAL. Don't confuse this with usmarc vs XML. (_bib_format): Suitable for record-by-record access. (unpack_008): Returns updateable fixed field information. (_unpack_008): Internal record-by-record equivalent. (_pack_008): Added in 0.95d COMPATIBILITY: The length() method has been removed because it overrides a Perl builtin. Use the new marc_count() method instead. Version 0.93 adds character_set conversions to MarcMaker format reads and writes. The usmarc/ustext character maps are used by default, so existing files in that format will produce different results than earlier versions. Starting with version 1.00, the XML conversions are moved to MARC::XML. Version 1.05 no longer assumes fields with same tag are contiguous. This is required for CJK characters and may introduce other changes from earlier conversions. The addition of proper date stamp generation in the "005" field may now create different output from the same source data. NOTES: Please let us know if you run into any difficulties using MARC.pm-- e'd be happy to try to help. Also, please contact us if you notice any bugs, or if you would like to suggest an improvement/enhancement. Email addresses are listed at the bottom of this page. The module is provided in standard CPAN distribution format. Additional documentation is created during the installation (html and man formats). Download the latest version from CPAN or: http://marcpm.sourceforge.net AUTHORS: Chuck Bearden cbearden@rice.edu Bill Birthisel wcbirthisel@alum.mit.edu Charles McFadden chuck@vims.edu Ed Summers esummers@odu.edu Derek Lane dereklane@pobox.com COPYRIGHT Copyright (C) 1999, 2000 Bearden, Birthisel, Lane, McFadden, and Summers. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Portions Copyright (C) 1999, 2000 Duke University, Lane. MARC-1.07/MANIFEST100644 764 764 443 7062775765 11745 0ustar billbbillbChanges MANIFEST MARC.pm Makefile.PL README README.txt t/test1.t t/test2.t t/test3.t t/test4.t t/test5.t t/badmarc.dat t/marc.dat t/marc4.dat t/MARCopt.pm t/makrbrkr.mrc t/makrtest.src t/makrtest.bad t/brkrtest.ref eg/uclocal.pl eg/addlocal.pl eg/fixlocal.pl eg/microlif.001 eg/specials.001 MARC-1.07/eg/ 40755 764 764 0 7100722641 11103 5ustar billbbillbMARC-1.07/eg/specials.001100644 764 764 26063 7062775765 13302 0ustar billbbillb01316nam 22003498a 4500001001300000005001700013008004100030010001700071020003200088020003200120035001300152039001800165040001800183043001200201050002100213082002100234100003000255240005700285245015900342260010000501300001700601440002300618500002200641651005500663651005500718700002900773852005300802852005300855900001200908961001300920999003300933ocm12668227 19981205175323.0850913c19861985nyu 00110 eng  a 85023098  a0940450348 (v. 1) :c$27.50 a0940450356 (v. 2) :c$27.50 a431294040 a2b3c3d3e3 aDLCcDLCdWIH an-us---0 aE331b.A192 19860 a973.4/6/092421910aAdams, Henry,d1838-1918.10aHistory of the United States of America.kSelections10aHistory of the United States during the administrations of Thomas Jefferson and James Madison /cHenry Adams ; [text selection and notes by Earl Harbert].0 aNew York, N.Y. :bLiterary Classics of the United States :bdistributed by Viking Press,c1986- av. ;c20 cm. 0aLibrary of America aIncludes indexes. 0aUnited StatesxPolitics and governmenty1801-1809. 0aUnited StatesxPolitics and governmenty1809-1817.10aHarbert, Earl N.,d1934- aARCPLh823 Adap3CPL000009208.xFSC@aR@e2@gARCPL aARCPLh823 Adap3CPL0000107980xFSC@aR@e1@gARCPL a823 Ada a19920131 cwL70dAR Clinton PLf823 Ada00624nam 2200181 a 450000500170000000800410001701000150005802000240007304000080009724501320010525000120023726000580024930000120030750000200031965100450033970000220038499900360040619981203164843.0980604s19uu 000 0 eng d a 6520721 alccn 6520721c$5.00 acpl10aWe, the People :bThe Story of the United States Capitol, Its Past and Its Promise /cUnited States Capitol Historical Society. a6th ed. aWashington, DC :bNational Geographic Society,c1969. a143p. ; aIncludes index. 7aUnited States CapitolzWashington, D. C.10aAikman, Lonnelle. cwL70dAR Clinton PLf917.53 WeT00692nam 2200241Ii 4500001001300000005001700013008004100030020001500071035001300086040002400099092000600123100002500129245003800154260004400192300002100236490002000257650001700277852003900294852005900333900001200392961001300404999003300417ocm04123596 19981203165106.0780809s1968 nyu j 00011 eng d a0440435749 a22677887 aOCAcOCAdm.c.dWSD ax10aAlexander, Lloyd. 14aThe high king /cLloyd Alexander.0 aNew York :bDell Publishing Co.,c1968. a304 p. ;c19 cm.0 aA Yearling book 1aFairy tales. hJuv Alep3CPL000017304Xt1xFSC@aR aARCPLhJuv Alexanderp3CPL000004252Vt2xFSC@aR@gARCPL aJuv Ale a19920131 cwL70dAR Clinton PLfJuv Ale00715nam 2200217 a 450000500170000000800410001701000140005802000290007204000080010110000180010924500530012726000510018030000120023150400270024365000200027065000250029070000280031585200590034385200590040299900360046119981206221347.0980407s19uu 000 0 eng d a 786672 a0882661329 (pbk.)c$4.95 acpl1 aRogers, Marc.10aGrowing & Saving Vegetable Seeds /cMarc Rogers. aCharlotte, VT :bGarden Way Publishing,c1978. a140p. ; aBibliography: p. 127. 7aVegetable seed. 7aVegetable gardening.10aAlexander, Polly,eill. h635.04 Rogp3CPL000015763/t1xFSC@aR@c197908209p4.95 h635.04 Rogp3CPL0000157592t2xFSC@aR@c198206039p4.95 cwL70dAR Clinton PLf635.04 Rog00769nam 2200241 a 450000500170000000800410001701000150005802000310007304000080010410000250011224500360013726000370017330000120021044000270022250000200024970000360026970000340030570000340033985200580037385200580043190000140048999900240050319981207172555.0980326s19uu 000 0 eng d a 7295538 alccn 77085477//r872c$1.95 acpl1 aAlexander, Taylor R.10aEcology /cTaylor R. Alexander. aNew York :bGolden Press,c1974. a160p. ; 0aGolden Science Guides. aIncludes index.10aFichter, George S.,eCo-author.10aPerlman, Raymond,eCo-author.10aWebster, Vera R.,eCo-author. h574.5 Alep3CPL000016421Wt2xFSC@aR@c198706309p1.95 h574.5 Alep3CPL0000171790t1xFSC@aR@c198406309p1.95 a574.5 Ale cwL70dAR Clinton PL00870nam 2200265 a 4500001001300000003000600013005001700019008004100036020001500077040001700092082001500109100001800124245006800142250001300210260004100223300003800264440001200302500002000314504002700334520012700361521002500488650004400513650003200557900001500589 46731069 KyAlM19981203165445.0970916s1998 nyuo 001 0 eng d a0823925420 aKyAlMcKyAlM14a791.432131 aAllman, Paul.10aExploring careers in video and digital video /cby Paul Allman. aRev. ed. aNew York :bRosen Publishing,c1998. a144 p. :bill., photos. ;c23 cm. 0aCareers aIncludes index. aIncludes bibliography. aThis book describes the various careers available in television and how to acquire the necessary training and preparation.2 a9-12bMedialog, Inc.07aTelevisionxVocational guidance.2sears07aVocational guidance.2sears a791.43 All00962nam 2200277Ia 4500001001300000005001700013008004100030020001500071035001300086040001800099090002300117092001800140245010700158260007700265263000900342300002100351650003600372650003000408710003100438740002500469852004700494852007500541900001700616961001300633999003800646ocm13303035 19981203165626.0860317c19861981nyu 00010 eng d a0517490110 a42324246 aSALcSALdWEC aCS2377b.M689 1986 a929.4bModern00aModern American encyclopedia of names for your baby /ccompiled by the editors of American Baby Books.0 aNew York :bGramercy Pub. Co. :bDistributed by Crown Publishers,c1986. a8601 a174 p. ;c22 cm. 0aNames, PersonalzUnited States. 0aNames, PersonalxEnglish.20aAmerican Baby Books (Firm)01aNames for your baby. p3CPL000014664$t2xFSC@aR@c198312309p4.00 aARCPLh929.4403 Modp3CPL000009421Yt1xFSC@aR@c19871030@gARCPL9p6.95 a929.4403 Mod a19920131 cwL70dAR Clinton PLf929.4403 Mod01211pam 2200337 i 4500001001300000005001700013008004100030010001700071020003700088035001300125040002400138050001900162082001300181100002700194245012800221260004200349300003200391500002000423504003000443650002300473650002200496650001800518700005100536710004500587852006000632852007400692871006200766900001600828961001300844999001600857ocm02091677 19981205171708.0760311s1976 nyua b 00110 engm  a 76008471  a0385291434 (pbk.)c$8.95 & $5.95 a15221253 aDLCcDLCdm.c.dGZR0 aHQ772.5b.A398 a649/.12310aAmes, Louise Bates. 10aYour four-year-old :bwild and wonderful /cby Louise Bates Ames and Frances L. Ilg, Gesell Institute of Child Development.0 aNew York :bDelacorte Press,c[c1976] av, 152 p. :bill. ;c22 cm. aIncludes index. aBibliography: p. 139-146. 0aChild development. 0aChild psychology. 0aChild rearing10aIlg, Frances Lillian,d1902-ejoint author. 20aGesell Institute of Child Development  h649.124 Amep3CPL000016049 t2xFSC@aR@c199407309p5.95 aARCPLh649.124 Amep3CPL000002955$t1xFSC@aR@c19910228@gARCPL9p8.9529a aGesell Institute of Child Development, New Haven. a649.124 Ame a19920131 f649.124 Ame01267nam 2200349Ia 4500001001300000005001700013008004100030020003900071035001300110040001800123099001800141100002700159245008600186260004500272300002900317500005400346500001900400650001900419650002300438650002200461653004500483700003800528852006100566852004700627886008300674886003000757886003000787886003000817900001600847961001300863999004100876ocm16503266 19981205183627.0870817r19841976enka 00010 eng d a0385291426 (pbk.) :c$8.95 & $6.95 a50615246 aWZWcWZWdWIJ a155.423 Am37y10aAmes, Louise Bates. 10aYour three year old:bfriend or enemy /cby Louise Bates Ames and Frances L. Ilg.0 aNew York:bDell Pub., Co.,c1984, c1976. a168 p. :bill. ;c23 cm. aOriginally published: New York : Delacorte, 1976. a"A Delta book" 0aChild rearing. 0aChild development. 0aChild psychology. aChildren, 3-4 yearsaHome care - Manuals10aIlg, Frances L.q(Frances Lilian) aARCPLp3CPL000010219Vt2xFSC@aR@c19940730@gARCPL9p6.95 p3CPL000016050Ut1xFSC@aR@c199104309p8.952 2UK MARCa690b00z11030achildren, 3-4 yearsz21030ahome carez60030amanuals2 2UK MARCa691b00a32189372 2UK MARCa692b00a00068582 2UK MARCa692b00a0296805 a649.124 Ame a19920131 cwL70dAR Clinton PLf649.124 Ames,L.00336nam 2200133 a 450000500170000000800410001702000150005804000080007310000190008124500500010025000090015026000310015930000120019019981203170301.0971118s19uu 000 0 eng d a0375500316 acpl1 aAngelou, Maya,10aEven the Stars Look Lonesome /cMaya Angelou. a1st. aNew York :brandom,c1997. a145p. ;00578nam 2200193 a 450000500170000000800410001702000150005804000080007310000190008124500440010025000250014426000430016930000120021260000170022485200490024185200490029090000100033999900350034919981203170305.0971117s19uu 000 0 eng d a0553380095 acpl1 aAngelou, Maya,10aHeart of a Woman (The) /cMaya Angelou. aBantam trade edition aNew York :bBantam Books,c1997, c1981 a324p. ;17aMaya Angelou hB Angeloup3CPL000014469%t2xFSC@aR9p12.00 hB Angeloup3CPL000014465 t1xFSC@aR9p12.00 aB Ang cwL70dAR Clinton PLfB Angelou00438nam 2200157 a 450000500170000000800410001701000120005802000290007004000080009910000200010724500360012725000240016326000600018730000120024744000210025919981210154218.0981210s19uu 000 0 eng d a9325511 a0812533666 (pbk.)c$6.99 acpl1 aAnthony, Piers.10aIsle of Woman /cPiers Anthony. a1st mass market ed. aNew York :bTom Doherty Associates Books,c1994, c1993. a470p. ; 0aGeodysseyvno. 100482nam 2200169 a 450000500170000000800410001701000120005802000290007004000080009910000200010724500350012725000240016226000600018630000120024644000210025899900330027919981210154203.0981210s19uu 000 0 eng d a9421747 a0812550919 (pbk.)c$5.99 acpl1 aAnthony, Piers.10aShame of Man /cPiers Anthony. a1st mass market ed. aNew York :bTom Doherty Associates Books,c1995, c1994. a503p. ; 0aGeodysseyvno. 2 ccwL70dAR Clinton PLfSF Ant01055nam 2200301 a 4500001001300000003000600013005001700019008004100036010001700077020001500094040001700109082001500126100001900141245007400160260004100234300004200275440004200317500002000359500002300379504002700402520016900429521002500598650003000623650003500653650002600688900001500714999002400729 46730883 KyAlM19981203171438.0970613s1997 nyuo 001 0 eng d a 96035171  a0823922502 aKyAlMcKyAlM14a306.732121 aAyer, Eleanor.10aIt's okay to say no :bchoosing sexual abstinence /cby Eleanor Ayer. aNew York :bRosen Publishing,c1997. a64 p. :bill., col. photos. ;c25 cm. 4aThe Teen pregnancy prevention library aIncludes index. aIncludes glossary. aIncludes bibliography. aThis book discusses what abstinence means, the dangers of teenage sexual activity, the difficulty of choosing abstinence, and the advantages of abstaining from sex.2 a9-12bMedialog, Inc.07aSexual abstinence.2sears07aYouthxSexual behavior.2sears07aBirth control.2sears a306.73 Aye cwL70dAR Clinton PLMARC-1.07/eg/microlif.001100644 764 764 33442 7062775765 13302 0ustar billbbillb00561nam 2200205 a 4500001001300000005001700013008004100030020003100071040001900102050002600121069001300147082001600160090001200176100001900188245003400207260003600241300002100277852003800298935001900336bl 98007343 19980718022935.2980710s1998 nyu 000 1 eng d a051512317X (pbk.) :c$7.50 aNjSoBTcNjSoBT14aPS3568.O243bR57 1998 a0610107304a813/.54221 aFIC ROB1 aRoberts, Nora.10aRising tides /bNora Roberts. aNew York :bJove Books,cc1998. a339 p. ;c18 cm.1 hFIC ROBp3CPL000018270-9P7.50usd aBILL BIRTHISEL00812pam 2200253 a 4500001001300000003000400013005001700017008004100034010001700075020003200092040001800124050002600142069001300168082001600181090001200197100003300209245005700242260005300299300003500352490004300387800007000430852003900500935001900539 97033862 DLC19980718022935.2980501s1998 mnuab 000 1 eng  a 97033862  a0764220438 (pbk.) :c$10.99 aDLCcDLCdDLC00aPS3566.H492bW55 1998 a0610107300a813/.54221 aFIC PHI1 aPhillips, Michael R.,d1946-10aWild grows the heather in Devon /cMichael Phillips. aMinneapolis :bBethany House Publishers,cc1998. a447 p. :bill., maps ;c21 cm.1 aThe secrets of Heathersleigh Hall ;v11 aPhillips, Michael R.,d1946-tSecrets of Heathersleigh Hall ;v1.1 hFIC PHIp3CPL000018271.9P10.99usd aBILL BIRTHISEL00723nam 2200229 a 4500001001300000005001700013008004100030020003100071040001900102050002700121069001300148082001600161090001200177100002100189245009100210250002000301260004400321300002900365500004200394852003800436935001900474bl 99793844 19980718022935.3971028r19971996nyua 000 1 eng d a0553572377 (pbk.) :c$6.50 aNjSoBTcNjSoBT14aPS3552.R698bM89 1997b a0610107304a813/.54221 aFIC BRO1 aBrown, Rita Mae.10aMurder, she meowed /cRita Mae Brown & Sneaky Pie Brown ; illustrations by Wendy Wray. aBantam pbk. ed. aNew York :bBantam Books,c1997, c1996. a300 p. :bill. ;c18 cm. aReprint. Originally published: c1996.1 hFIC BROp3CPL000018272 9P6.50usd aBILL BIRTHISEL00937cam 2200289 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117043001200135050002500147069001300172082001600185090001200201100002900213245008400242260003400326300002600360650005100386650007000437651004000507655004200547852003900589935001900628 97051141 DLC19980718022935.3980612s1998 nyub 000 1 eng  a 97051141  a0684834545 :c$21.50 aDLCcDLCdDLC an-us-ma00aPS3553.R23bS56 1998 a0610107300a813/.54221 aFIC CRA1 aCraig, Philip R.,d1933-12aA shoot on Martha's Vineyard :ba Martha's Vineyard mystery /cPhilip R. Craig. aNew York :bScribner,cc1998. a285 p., map ;c22 cm. 0aJackson, Jeff (Fictitious character)xFiction. 0aPrivate investigatorszMassachusettszMartha's VineyardxFiction. 0aMartha's Vineyard (Mass.)xFiction. 7aDetective and mystery stories.2gsafd1 hFIC CRAp3CPL000018273$9P21.50usd aBILL BIRTHISEL00636pam 2200241 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117050002700135069001300162082001600175090001200191100001900203245003100222250001200253260004400265300002700309852003900336935001900375 98005935 DLC19980718022935.3980609s1998 nyu 000 1 eng  a 98005935  a068815090X :c$24.50 aDLCcDLCdDLC00aPS3563.E4496bD43 1998 a0610107300a813/.54221 aFIC MEL1 aMeltzer, Brad.10aDead even /cBrad Meltzer. a1st ed. aNew York :bRob Weisbach Books,cc1998. aviii, 401 p. ;c25 cm.1 hFIC MELp3CPL000018274/9P24.50usd aBILL BIRTHISEL00785nam 2200241 a 4500001001300000005001700013008004100030020003200071040003500103050002700138069001300165082001600178090001200194100002000206245007200226246002100298250002800319260005100347300002400398500006300422852003900485935001900524bl 99786831 19980718022935.3970424r19971996nyu 000 1 eng d a0060928336 (pbk.) :c$14.00 aBaker & TaylorcBaker & Taylor14aPS3573.E4937bD58 1997 a0610107304a813/.54221 aFIC WEL1 aWells, Rebecca.10aDivine secrets of the Ya-Ya Sisterhood :ba novel /cRebecca Wells.30aYa-Ya Sisterhood a1st HarperPerennial ed. aNew York, NY :bHarperPerennial,c1997, c1996. ax, 356 p. ;c21 cm. aOriginally published: New York, NY : HarperCollins, c1996.1 hFIC WELp3CPL000018275+9P14.00usd aBILL BIRTHISEL01198pam 2200325 a 4500001001600000003000400016005001700020008004100037010002000078020003100098040001800129050002200147069001300169082001400182090001200196100001800208245003900226250003100265260005700296300002100353520026100374521002800635521003300663521002400696650003700720650002300757650003500780852003800815935001900853 95008884 /ACDLC19980718022935.4970814r19951994nyu j 000 1 eng  a 95008884 /AC a0786810998 (pbk.) :c$4.95 aDLCcDLCdDLC00aPZ7.Z647bLo 1995 a0610107300a[Fic]220 aFIC ZIN1 aZindel, Paul.10aLoch :ba novel /cby Paul Zindel. a1st Hyperion Paperback ed. aNew York :bHyperion Paperbacks for Children,c1995. a209 p. ;c20 cm. aFifteen-year-old Loch and his younger sister join their father on a scientific expedition searching for enormous prehistoric creatures sighted in a Vermont lake, but soon discover that the expedition's leaders aren't interested in preserving the creatures.0 a"RL: 6"--P. 4 of cover.1 a"Ages 11-15"--P. 4 of cover.2 a7-9bBaker & Taylor 1aUnderwater explorationxFiction. 1aMonstersxFiction. 1aBrothers and sistersxFiction.1 hFIC ZINp3CPL000018276%9P4.95usd aBILL BIRTHISEL01081pam 2200301 a 4500001001600000003000400016005001700020008004100037010002000078020003100098040002900129050002200158069001300180082001400193090001200207100001800219245003500237250002600272260005700298300002100355500005800376520020600434521002400640650002300664651003500687852003800722935001900760 96003463 /ACDLC19980718022935.4960209r19961995nyu j 000 1 eng  a 96003463 /AC a0786811579 (pbk.) :c$4.95 aDLCcDLCdBaker & Taylor10aPZ7.Z647bDo 1996 a0610107300a[Fic]220 aFIC ZIN1 aZindel, Paul.14aThe doom stone /cPaul Zindel. a1st Hyperion pbk. ed. aNew York :bHyperion Paperbacks for Children,c1996. a173 p. ;c20 cm. aOriginally published: New York : HarperCollins, 1995. aWhen fifteen-year-old Jackson visits his aunt in England, he becomes caught up in a chase to capture an unknown creature who is stalking and killing people on the plains surrounding ancient Stonehenge.2 a7-9bBaker & Taylor 1aMonstersxFiction. 1aStonehenge (England)xFiction.1 hFIC ZINp3CPL00001827709P4.95usd aBILL BIRTHISEL00636nam 22002418a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001300117050002600130069001300156082001600169090001200185100002900197245005700226260003300283263000900316300001100325852003900336935001900375 98010994 DLC19980718022935.5980115s1998 nyu 000 1 eng  a 98010994  a0684850265 :c$24.50 aDLCcDLC00aPS3558.E4753bF3 1998 a0610107300a813/.54221 aFIC HEL1 aHellenga, Robert,d1941-14aThe fall of a sparrow :ba novel /cRobert Hellenga. aNew York :bScribner,c1998. a9807 ap. cm.1 hFIC HELp3CPL00001827819P24.50usd aBILL BIRTHISEL00951pam 2200313 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117043001200135050002700147069001300174082002600187090001400213100002700227245008700254250001700341260003800358300003500396600002700431650002200458650002200480650003200502650004300534852004100577935001900618 97017318 DLC19980718022935.5980306r1997 nyua 000 0aeng  a 97017318  a0679456589 :c$22.50 aDLCcDLCdDLC an-us-ca00aSF284.52.R635bA3 1997 a0610107300a636.1/0835/092aB221 aB ROBERTS1 aRoberts, Monty,d1935-14aThe man who listens to horses /cMonty Roberts ; introduction by Lawrence Scanlan. a1st U.S. ed. aNew York :bRandom House,cc1997. axxiv, 258 p. :bill. ;c25 cm.10aRoberts, Monty,d1935- 0aHorsesxBehavior. 0aHorsesxTraining. 0aHuman-animal communication. 0aHorse trainerszCaliforniaxBiography.1 hB ROBERTSp3CPL00001827929P22.50usd aBILL BIRTHISEL00727cam 2200265 a 4500001001800000003000400018005001700022008004100039010002200080020002500102040003000127050002500157069001300182082001600195090001200211100002100223245003100244250001200275260003500287300002100322650002400343655003600367852003900403935001900442 97034305 //r98DLC19980718022935.5980615s1998 nyu 000 1 eng  a 97034305 //r98 a068814179X :c$21.50 aDLCcDLCdDLCdOCoLCdDLC00aPS3552.L63bH58 1998 a0610107300a813/.54221 aFIC BLO1 aBlock, Lawrence.10aHit man /cLawrence Block. a1st ed. aNew York :bW. Morrow,cc1998. a259 p. ;c25 cm. 0aAssassinsxFiction. 7aBlack humor (Literature)2gsafd1 hFIC BLOp3CPL000018280.9P21.50usd aBILL BIRTHISEL00652cam 22002538a 4500001001300000003000400013005001700017008004100034010001700075020002500092040001800117050002600135069001300161082001600174090001200190100002200202245004100224250001200265260004300277263000900320300001100329852003900340935001900379 98014627 DLC19980718022935.6980518s1998 nyu 000 1 eng  a 98014627  a0312185863 :c$23.95 aDLCcDLCdDLC00aPS3555.V2126bF6 1998 a0610107300a813/.54221 aFIC EVA1 aEvanovich, Janet.10aFour to score /cby Janet Evanovich. a1st ed. aNew York :bSt. Martin's Press,c1998. a9808 ap. cm.1 hFIC EVAp3CPL000018281 9P23.95usd aBILL BIRTHISEL00631pam 2200229 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040002100117050002600138069001300164082001600177090001200193100003200205245004200237260004300279300002100322852003900343935001900382 98010479 DLC19980718022935.6980129s1998 nyu 000 1 eng  a 98010479  a0399143947 :c$25.95 aDLCcDLCdNjSoBT00aPS3553.O692bP57 1998 a0610107300a813/.54221 aFIC COR1 aCornwell, Patricia Daniels.10aPoint of origin /cPatricia Cornwell. aNew York :bG.P. Putnam's Sons,c1998. a356 p. ;c25 cm.1 hFIC CORp3CPL000018282$9P25.95usd aBILL BIRTHISEL00683pam 2200241 a 4500001001300000003000400013005001700017008004100034010001700075020002500092040002100117050002700138069001300165082001600178090001200194100001900206245005500225250001200280260006600292300002500358852003900383935001900422 97041124 DLC19980718022935.7971015s1998 nyu 000 1 eng  a 97041124  a0679445315 :c$21.50 aDLCcDLCdNjSoBT14aPS3573.H452bQ57 1998b a0610107300a813/.54221 aFIC WHI1 aWhite, Bailey.10aQuite a year for plums :ba novel /cBailey White. a1st ed. aNew York :bA.A. Knopf :bDistributed by Random House,c1998. aix, 220 p. ;c20 cm.1 hFIC WHIp3CPL000018283/9P21.50usd aBILL BIRTHISEL00900nam 22003018a 4500001001300000003000400013005001700017008004100034010001700075020003200092040001300124050002300137069001300160082001900173090001600192100002300208245007000231250001500301260003700316263000900353300001100362500002000373650005000393650003200443650006100475852004300536935001900579 98018543 DLC19980718022935.7980401s1998 nyu 001 0 eng  a 98018543  a0446674052 (pbk.) :c$16.99 aDLCcDLC00aRG133.5b.S55 1998 a0610107300a616.6/9206221 a616.692 SIL1 aSilber, Sherman J.10aHow to get pregnant with the new technology /cSherman J. Silber. a[Rev. ed.] aNew York :bWarner Books,c1998. a9808 ap. cm. aIncludes index. 0aHuman reproductive technologyxPopular works. 0aInfertilityxPopular works. 0aContraceptionxTechnological innovationsxPopular works.1 h616.692 SILp3CPL000018284+9P16.99usd aBILL BIRTHISEL00486nam 22001575 4500001001300000005001700013008004100030020003200071040001900103069001300122245006000135260002300195490006100218852003000279935001900309bk 03123430 19980718022935.7980718s1998 xx eng d a0671010131 (pbk.) :c$14.00 aBaker & Taylor a0610107300aAmerican Medical Association Essential Guide to Asthma.0 bPocket Booksc19980 aThe American Medical Association Essential Guides Series1 p3CPL000018285%9P14.00usd aBILL BIRTHISEL00525nam 22001815 4500001001300000005001700013008004100030020003200071040001900103069001300122100003400135245003400169260002300203300001100226490005700237852003000294935001900324bk 03123431 19980718022935.7980718s1998 xx eng d a067101014X (pbk.) :c$14.00 aBaker & Taylor a0610107310aAmerican Medical Association.10aEssential Guide to Menopause.0 bPocket Booksc1998 a253 p.0 aAmerican Medical Association Essential Guides Series1 p3CPL00001828609P14.00usd aBILL BIRTHISEL01188cam 2200325 a 4500001002000000003000400020005001700024008004100041010002400082020003100106040001800137043001200155050002100167069001300188082002600201090001700227100001700244245007600261250002600337260004500363300003500408440002500443520017800468521002400646650005400670650005400724650002200778852004300800935001900843 87014817 /AC/r94DLC19980718022935.8940930c19871980nyua j 00010 eng  a 87014817 /AC/r94 a0020432801 (pbk.) :c$5.99 aDLCcDLCdDLC anp-----10aE78.G73bG6 1987 a0610107300a398.2/08997078aE219 a398.2089 GOB10aGoble, Paul.14aThe gift of the sacred dog :bstory and illustrations /cby Paul Goble. a1st Aladdin Books ed.0 aNew York :bAladdin Books,c1987, c1980. a[32] p. :bcol. ill. ;c26 cm. 0aReading rainbow book aIn response to an Indian boy's prayer for help for his hungry people, the Great Spirit sends the gift of the Sacred Dogs, horses, which enable the tribe to hunt for buffalo.2 a2-3bBaker & Taylor 0aIndians of North AmericazGreat PlainsxFolklore. 1aIndians of North AmericazGreat PlainsxFolklore. 1aHorsesxFolklore.1 h398.2089 GOBp3CPL00001828719P5.99usd aBILL BIRTHISEL MARC-1.07/eg/uclocal.pl100644 764 764 16560 7100716727 13217 0ustar billbbillb#!/usr/bin/perl -w # The following example is an expanded version of "addlocal.pl" that # checks and fixes existing records in addition to processing new ones. # It looks for a call number subfield 'h' of each 852 field (#852.h). # It also checks #900.a and #999.f for the data. It then converts the # call number fields to upper case and confirms they are all identical. # For mismatches and missing 852 data, the records are not modified, # but an ascii version is written so the librarian can determine what # is correct. Missing 900 and 999 data is created. An ascii version of # the altered records is written for checking. This is a somewhat # contrived example. But it shows what can be done with manipulating # field data and using option templates. use MARC 0.98; use strict; my $infile = "specials.001"; my $outfile = "output.004"; # results in usmarc format my $outtext = "output5.txt"; # original input in ascii for ok callno. my $outtext2 = "output6.txt"; # changed records in ascii my $outtext3 = "output7.txt"; # invalid or mismatched records in ascii my $outtext4 = "output8.txt"; # ascii for all ok callno (change or not) unlink $outfile, $outtext, $outtext2, $outtext3, $outtext4; # This subroutine takes an array of all the call numbers found. It # returns an upper-cased version if all compare or '' if not sub check_callno { my $num1 = uc(shift); foreach (@_) { return '' unless ($num1 eq uc($_)); } return $num1; } # This subroutine does most of the dirty work. There are four required # parameters: $marc, $template, $subfield, and $value. It will return # "undef" unless all four are specified. Zero (0 or "0") is a possible # $subfield or $value. Blank ('') can be used for the $value. sub fix_subfield { my $marc = shift || return; my $template = shift || return; my $subfield = shift; my $value = shift; return unless (defined $subfield and defined $value); my $altered = 0; # If the $subfield already exists, get the data in a format suitable # for making updates. Note the use of $template. my ($found) = $marc->searchmarc($template); if (defined $found) { my @u = $marc->getupdate($template); my @f = (); my $ff; my $fixed = 0; # $fixed accounts for the situation when the call number may be present # in some of the 852 fields, but not all of them. $fixed gets set when # the $subfield is found within a single field. If processing reaches # the end of the field (the "\036" delimiter) without $fixed, then the # $subfield and $value are appended to that field. while (@u) { last unless defined ($ff = shift @u); if ($ff eq "\036") { unless ($fixed) { push @f, $subfield, $value; $altered++; } push @f, $ff; $fixed = 0; next; } push @f, $ff; # All subfields that don't match out target just get copied. unless ($subfield eq $ff) { push @f, shift @u; next; } last unless defined ($ff = shift @u); # Fix the target if necessary and set $altered if anything changed. if ($value eq $ff) { push @f, $ff; } else { $altered++; push @f, $value; } $fixed++; } # Actually fix the record if required. Again note the use of $template. if ($altered) { $marc->updaterecord ($template, @f) || warn "update failed: $template->{field}, $subfield\n"; } } # This next part is tricky. If fix_subfield is called with just the # four required parameters, you bypass the next step. The preceeding # part is run if searchmarc() finds the field specified in the # $template. But if the field does not exist, and there are optional # parameters in the call to fix_subfield, those parameters are used # as a series of subfields for an addfield(). In plain language, you # can tell fix_subfield what to add if the field doesn't exist. elsif (@_) { $marc->addfield($template, @_) || warn "addfield failed: $template->{field}, $subfield\n"; $altered++; } return $altered; } # The $template hashes for this example: my $loc852 = {record=>1, field=>'852', ordered=>'y'}; my $loc900 = {record=>1, field=>'900', ordered=>'y'}; my $loc999 = {record=>1, field=>'999', ordered=>'n'}; # The create_if_not_found field specifications: my @default900 = ('i1',' ','i2',' ','a'); my @default999 = ('i1',' ','i2',' ','c','wL70','d','AR Clinton PL','f'); my $invalid = 0; my $updated = 0; my $totalcount = 0; my $x = MARC->new; $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die; # We process records one at a time for this operation. Multiple 852 fields # are legal (for multiple copies). while ($x->nextmarc(1)) { my $change = 0; my @callno = $x->getvalue($loc852,'subfield','h'); # But multiple 900 and 999 fields are not permitted. So we force a # miscompare if we discover one. my ($from900, $dup900) = $x->getvalue($loc900,'subfield','a'); if (defined $from900) { push @callno, $from900; } if (defined $dup900) { push @callno, ''; } my ($from999, $dup999) = $x->getvalue($loc999,'subfield','f'); if (defined $from999) { push @callno, $from999; } if (defined $dup999) { push @callno, ''; } # We now have an array of all the call numbers found. The subroutine # returns an upper-cased version if all compare or '' if not. my $callno = check_callno(@callno); # Write a "good" result back to everywhere that it should be. Keep track # of which records were modified. And notice that a $template conveys # a lot of repeated information. if ($callno) { $x->output({file=>">>$outtext",'format'=>"ascii"}); # $outtext is a "before" ascii file to compare changes with the "after" # ascii file $outtext4. if (fix_subfield($x,$loc852,'h',"$callno")) { $change++; } # The 852 subfield passes just the four required parameters. Hence # nothing is added if the 852 field is missing. if (fix_subfield($x,$loc900,'a',"$callno",@default900,"$callno")) { $change++; } # The 900 and 999 fields are created with default values if they # do not already exist. if (fix_subfield($x,$loc999,'f',"$callno",@default999,"$callno")) { $change++; } $x->output({file=>">>$outfile",'format'=>"usmarc"}); $x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change; $x->output({file=>">>$outtext4",'format'=>"ascii"}); $updated++ if $change; } # Write the records with invalid or mismatched call numbers. In this # example, they go into the same usmarc format file $outfile. else { $x->output({file=>">>$outfile",'format'=>"usmarc"}); $x->output({file=>">>$outtext3",'format'=>"ascii"}); $invalid++; } $x->deletemarc(); #empty the object for reading in another $totalcount++; } # We write all the records to the output file in MARC format. The ascii # output in $outtext3 gives the librarian both a list of records # requiring manual call number assignment/resolution and all the Title, # Author, Publication and related data needed to assign location based # on standard references. For checking, we write all the modified # records to $outtext2. print "\nprocessed $totalcount records\n"; print "$updated had call numbers which were changed\n"; print "$invalid had missing or invalid call numbers\n"; MARC-1.07/eg/fixlocal.pl100644 764 764 10034 7100716720 13355 0ustar billbbillb#!/usr/bin/perl # The following example is an expanded version of "addlocal.pl" that # checks and fixes existing records in addition to processing new ones. # It first looks for a call number subfield 'h' of the 852 field (#852.h). # If missing, it then checks #900.a and #999.f for the data. It puts the # call number found into all of these locations including any repeated # fields. It will create the locations if necessary. use MARC 0.95; my $infile = "specials.001"; my $outfile = "output.003"; my $outtext = "output3.txt"; my $outtext2 = "output4.txt"; unlink $outfile, $outtext, $outtext2; sub fix_update { my $subfield = shift; my $value = shift; my @f = (); my $ff; my $altered = 0; my $fixed = 0; while (@_) { last unless defined ($ff = shift); if ($ff eq "\036") { unless ($fixed) { push @f, $subfield, $value; $altered++; } push @f, $ff; $fixed = 0; next; } push @f, $ff; unless ($subfield eq $ff) { push @f, shift; next; } last unless defined ($ff = shift); push @f, $value; $fixed++; if ($value ne $ff) { $altered++; } } return ($altered,@f); } my $loc852 = {record=>1, field=>'852', ordered=>'y'}; my $loc900 = {record=>1, field=>'900', ordered=>'y'}; my $loc999 = {record=>1, field=>'999', ordered=>'n'}; $x = MARC->new; $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die; # We process records one at a time for this operation. Multiple 852 fields # are legal (for multiple copies) - the 'h' subfield should be the same. # But a few percent of incoming materials do not include this subfield. while ($x->nextmarc(1)) { my $from999 = ""; my $from900 = ""; my ($callno) = $x->getvalue($loc852,'subfield','h'); my $from852 = (1 == scalar $x->getvalue($loc852)) ? $callno : ""; unless ($callno) { # "" and '0' are not legal call numbers $callno = ""; ($from900) = $x->getvalue($loc900,'subfield','a'); if ($from900) { $callno = $from900; } else { ($from999) = $x->getvalue($loc999,'subfield','f'); if ($from999) { $callno = $from999; } } } my $change = 0; my ($found) = $x->searchmarc($loc999); if (defined $found) { my @m999 = $x->getupdate($loc999); my @f999 = fix_update('f', $callno, @m999); if (shift @f999) { $change++; $x->updaterecord ($loc999, @f999) || warn "999 update failed\n"; } } else { $x->addfield($loc999,'i1',' ','i2',' ', 'c','wL70','d','AR Clinton PL','f',"$callno"); $change++; } ($found) = $x->searchmarc($loc900); if (defined $found) { my @m900 = $x->getupdate($loc900); my @f900 = fix_update('a', $callno, @m900); if (shift @f900) { $change++; $x->updaterecord ($loc900, @f900) || warn "900 update failed\n"; } } else { $x->addfield($loc900,'i1',' ','i2',' ','a',"$callno"); $change++; } if ($callno && not $from852) { ($found) = $x->searchmarc($loc852); if (defined $found) { my @m852 = $x->getupdate($loc852); my @f852 = fix_update('h', $callno, @m852); if (shift @f852) { $change++; $x->updaterecord ($loc852, @f852) || warn "852 update failed\n"; } } else { $x->addfield($loc852,'i1','1','i2',' ','h',"$callno"); $change++; } } $x->output({file=>">>$outfile",'format'=>"usmarc"}); $x->output({file=>">>$outtext",'format'=>"ascii"}) unless $callno; $x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change; $x->deletemarc(); #empty the object for reading in another } # We write all the records to the output file in MARC format. Even the # incomplete ones at least have added the fixed data. The ascii output # in $outtext gives the librarian both a list of records requiring manual # call number assignment and all the Title, Author, Publication and # related data needed to assign location based on standard references. # For checking, we write all the modified records to $outtext2. MARC-1.07/eg/addlocal.pl100644 764 764 10537 7100716707 13334 0ustar billbbillb#!/usr/bin/perl # The following example automates a simple but time-consuming task for # a librarian. Booksellers commonly include a disk containing standard # bibliographical and catalogging data with their shipments to libraries. # The data is in MAchine Readable Catalog (MARC) format. The MARC.pm # module creates, reads, updates, and writes that data. Most library # databases also import from and export into MARC format. But a library # often must add to the data provided by the booksellers. We are going to # add the Wisconsin inter-library loan code for the Clinton Public Library # and the local call number to each MARC record (each catalog item). # A record consists of a number of tags (data types) and each tag can have # one or more subfields (data elements). Tags are designated by 3-digit # identifiers (000-999) corresponding to specific data types (i.e. the 245 # tag is the Title Statement). In this example, we care about the 852 tag # (Location) subfield 'h' (Dewey or similar Recommended Call Number) and # the 900 and 999 tags (reserved for "local" use). We plan to append a 999 # field to each record based in part on the 852 tag subfield 'h'. We will # also print a text listing of any records missing this subfield so the # librarian can update those manually. Finally, we will insert the call # number as a 900 tag. use MARC 0.93; my $infile = "microlif.001"; my $outfile = "output.002"; my $outfile2 = "output2.txt"; my $outtext = "output.txt"; unlink $outfile, $outtext, $outfile2; # Your filenames will vary. You probably want absolute pathnames. # In Clinton, WI, we have a shortcut to the newbooks.d directory and # use these: # my $infile = "a:\\microlif.001"; # floppy from vendor # my $outfile = "d:\\microlif.002"; # file to import # my $outfile2 = "d:\\newbooks.d\\updated.txt"; # ascii to check # my $outtext = "d:\\newbooks.d\\missing.txt"; # needs attention my $count = 0; my $missing = 0; $x = MARC->new; $x->openmarc({file=>$infile,'format'=>"usmarc"}) || die; # You may want a more informative failure routine if run from a GUI # We process records one at a time for this operation. Multiple 852 fields # are legal (for multiple copies) - the 'h' subfield should be the same. # But a few percent of incoming materials do not include this subfield. while ($x->nextmarc(1)) { my ($callno) = $x->getvalue({record=>'1',field=>'852',subfield=>'h'}); $callno = "|" unless (defined $callno); # A single 'fill character' ("|" eq 0x7c) is used for none. # Some vendors don't like "empty" subfields $x->addfield({record=>1, field=>"999", ordered=>"n", i1=>" ", i2=>" ", value=>[c=>"wL70",d=>"AR Clinton PL",f=>"$callno"]}); # Tag 999 subfield 'f' gets the Call Number. The others are constant in this # example. Tag 999 is the last legal choice, so a simple append is fine. $x->addfield({record=>1, field=>"900", ordered=>"y", i1=>" ", i2=>" ", value=>[a=>"$callno"]}); # Tag 900 subfield 'a' gets the Call Number. Since some records already # have 9xx tags (e.g. 935), we want 'ordered' (which is also the default). $x->output({file=>">>$outfile",'format'=>"usmarc"}); if ($callno eq "|") { $x->output({file=>">>$outtext",'format'=>"ascii", lineterm=>"\r\n"}); $missing++; } $x->output({file=>">>$outfile2",'format'=>"ascii", lineterm=>"\r\n"}); $x->deletemarc(); #empty the object for reading in another $count++; } # We write all the records to the output file in MARC format. Even the # incomplete ones at least have added the fixed data. The ascii output # in $outtext gives the librarian both a list of records requiring manual # attention and all the Title, Author, Publication and related data needed # to assign location based on standard references. This demo also writes # an ascii version of its output as $outfile2 so the final MARC records # can be viewed with the changes. Since Clinton runs on NT, we specify # a Notepad-compatible line termination. print "\nprocessed $count records\n"; print "$missing had missing call numbers\n\n"; print "press to continue\n"; my $junk = <>; # Allow results to be seen even when run from a GUI. MARC-1.07/Changes100644 764 764 25764 7100720012 12124 0ustar billbbillb0.3 Mon Aug 23 19:39:00 1999 0.4 Sun Sep 5 13:49:00 1999 0.5 Sun Sep 5 19:45:00 1999 0.6 Mon Sep 6 18:17:00 1999 - consolidate into single file ------------------------------------------------------------- Revision history for Perl extension MARC. 0.01 Tue Sep 7 10:48:10 1999 - original version; created by h2xs 1.18 - linux command: h2xs -A -X -n MARC 0.61 Tue Sep 7 12:56:23 CDT 1999 - convert version 0.6 into CPAN format (lots of little changes) 0.62 Fri Sep 10 05:18:00 1999 - revised datastructure to hash of tags plus non-tag elements like 'array' which serve as structured views into data 0.63 Sun Sep 12 20:38:00 1999 - permit incremental processing to reduce memory footprint 0.65 Fri Sep 17 08:07:42 1999 - add openmarc,nextmarc,closemarc,deletemarc 0.7 Sun Sep 21 07:15:00 1999 - major upgrade: revise new for incremental reads and tag maps - add selectmarc,searchmarc, createrecord, _joinfield, addfield - add error processing and use Carp - add header/body/footer outputs - revise documentation 0.71 Wed Sep 22 15:50:31 1999 - compute @tags once in _marc2html, fix $outputall detection - add Win32 test and install - t/test1.t uses new output file spec, tests append & $var 0.72 Fri Sep 24 07:42:00 1999 - add getvalue - add doc example: xml_header, xml_body, xml_footer - add doc example: createrecord, addfield 0.80 Sun Oct 3 17:14:00 1999 - add isbd and unimarc 0.81 Mon Oct 4 22:25:17 CDT 1999 - update CPAN doc files: Changes, README, Makefile.PL - add isbd to t/test1.t 0.82 Wed Oct 6 13:30:22 CDT 1999 - Win32 Makefile.PL improvements including automatic html install - Added single quotes to hash keys in MARC.pm and t/test1.t to eliminate nuisance warnings from Perl 5.004. 0.83 Mon Oct 11 22:22:00 EST 1999 - Updated MARC.pm line 108 to store scalar references instead of scalars. This will hopefully cut down on duplication of data in the MARC object. - Also, updated the getvalue(), searchmarc() and addfield() methods to reflect the change in the way subfield data is stored. - Added line 220 to return '0 but true' instead of 0 when no records were read in. This will allow for statements like $x->openmarc("test.mrc") || die; 0.84 Tue Oct 12 22:07:18 CDT 1999 - more Win32 Makefile.PL tweaks after TPJ technical review - add binmode for marc file read/write - unspecified 'increment' defaults to 0 - fix repeated subfield in field bug in addfield 0.85 Wed Oct 13 21:19:00 EST 1999 - modified addfield to push scalar references instead of scalars when adding subfield data to the $x->[record]{field}{subfield} data member on line 859. - updated closemarc to return 1, to allow constructs like $x->closemarc() || die; 0.9 Sun Oct 17 19:48:00 EST 1999 - modified deletemarc() to support deleting specified fields and subfields - modified addfield() to support adding fields in tag order 0.91 Tue Oct 19 18:01:43 CDT 1999 - add demo addlocal.pl, microlif.001, and directory eg - closemarc() returns results of close() - filter '\r' and '\cZ' from binary input stream - fix "delete all records" bug 0.911 Wed Oct 20 21:49:02 CDT 1999 - add "exists" tests to getvalue() - use scalar $callno in addlocal.pl 0.92 Sat Oct 23 00:00:00 CDT 1999 - initialize loop counter in getvalue() to avoid warnings - add methods for manipulating "000" and "008" fields: unpack_ldr, bib_format, unpack_008 - add internal subroutines supporting those methods: _unpack_ldr, _bib_format, _unpack_008, - add internal update subroutines: _pack_ldr, _pack_008 0.93 Wed Oct 27 21:30:17 CDT 1999 - deprecate length(), use marc_count() instead - new: bless earlier so _readxxx can use methods - add error checks to file open/close, use binmode - add lineterm for _readmarcmaker and default to DOS - always store header in $record->{'000'} tag position - fix bugs in 'i12' subfield structure - add usmarc_default, ustext_default, MARCMaker charset encode/decode - use createrecord, addfield in _readmarcmaker - fix fieldnotvalue in searchmarc - extensive changes to getvalue to cover '000' tag and indicators - use getvalue in unpack_008 - return undef instead of die in _unpack_008 - allow lineterm option in output, 'format' defaults to 'marc', lineterm to '\n' except MARCMaker (CRLF) - add nolinebreak option for MARCBreaker output - 'html_header' outputs "Content-type...", 'html_start' does "" - _writemarc also updates '000' size data in structure - warnings off in addfield - update copyright - add test2.t and test3.t plus supporting files: makrbrkr.mrc, brkrtest.ref, makrtest.src - add filestring and out_cmp test utilities, MARCopt.pm stub - add MARCMaker/Breaker, getvalue, and searchmarc tests 0.94 Thu Oct 28 20:23:57 CDT 1999 - added numerous "exists" tests for hash queries - add 'title' parameter to html_start - extra error checking: addfield - new getupdate() method - add tests for searchmarc, deletemarc, addfield, getupdate, html_xxx formats - fix test3.t to use MARCopt everywhere 0.95 Tue Nov 02 20:49:09 CST 1999 - clean up the Win32 "make clean" implementation in Makefile.PL - add tests for selectmarc - add 'title' option for URLs output - terminate addfield if $subfield_id eq "\036" from getupdate() - pod updates: SYNOPSIS, Option Template, various typos - add updaterecord() - template extensions for deletemarc(), searchmarc(), getvalue() - add eg/fixlocal.pl demo and eq/specials.001 0.95d Wed Nov 03 17:00:01 EST 1999 - Removed FF_ prefix from @LDR_FIELDS. Left package globals for fixed fields and leaders as globals: this should facilitate anybody who wants to subclass for MFHL, community, records. - Added pack_008 and pack_ldr. Added get_hash_008 and get_hash_ldr for future tied interface. Fixed bugs. (FF_ prefixes in hash keys.) - Added and updated docs for the new functions. - Added comment on how to renumber tests. - Added tests of pack_008 and pack_ldr. Fixed some test bugs with FF_ prefixes and non-existent functions. 0.96 Wed Nov 3 23:04:31 CST 1999 - fix typos in pod2man and pod2html output - fix test3.t like test1.t 0.97 Fri Nov 5 17:44:15 CST 1999 - replace '%$' construct (4 places) which designates pseudo-hash in 5.005 and fails in 5.004. Detected by CPAN-Testers - Add tests for deletemarc() subfield to t/test2.t 0.98 Fri Nov 12 21:13:39 CST 1999 - fix addfield reorder bug (new tag > existing) - improved eg/addlocal.pl and added eg/uclocal.pl - moved binmode from _readmarc* to openmarc() and new() to get around unwanted seek on binmode in Win32 5.00402. 0.99 Sun Nov 14 21:59:00 EST 1999 - created MARC::XML subclass to handle MARC<->XML conversions - moved _marc2xml() from MARC.pm into MARC::XML 0.991 Sun Nov 21 18:49:00 EST 1999 - removed MARC::XML specific pod from MARC.pm and added to MARC::XML 1.00 Mon Nov 22 22:22:32 CST 1999 - add warnings for unsupported output formats - return undef for output failure, test in place of XML 1.01 Sun Dec 05 23:14:15 CST 1999 - add invalid size checks to _readmarc() - add header check to _readmarcmaker() - delete length() method and CORE::length() overrides - add $TEST; replace carp with mycarp 1.02u Mon Dec 20 06:52:00 EST 1999 - added *map* series; supports a data-index view of marc. - added deletefirst and updatefirst to support ties - added getmatch and insertpos to support update or insert of subfields. - added getfields/updatefields for fine-grained access to the {array} structures. Allows "in-place" update of fields. - changed add_fields to use add_map. Lets subclasses have a policy of how they want their indices to look. - changed _readmarc and _readmarcmaker to use add_map. Good for testing. - Added simple tests for *first and *map* series as test4.t More complex and complete tests are in MARC::Tie. - Added docs for *map*, getmatch,*fields*,getmatch and insertpos. 1.03 Mon Jan 17 15:21:54 CST 2000 - Use fill char "|" for "none" in eg/addlocal.pl - integrate "102u" changes into CPAN format - fix bug in addfield where add_map not called if ($tag<10) 1.04 Mon Jan 24 22:31:26 CST 2000 - oops, had to fix the Win32 5.00402 binmode again (c.f 0.98) - added quotes to 'rebuild_map' used as hash key (5.004 warnings) - add docs for "keys" in hash returned by 'unpack_ldr' - add xml format error messages 1.05 Sat Jan 29 22:59:03 EST 2000 - Removed unnecessary quotes in various potentially tainted variables. - Removed bad references to FF_* in docs. - Updatefields() no longer assumes that fields with the same tag are contiguous (e.g. cjk). - Getfields() no longer assumes that fields with the same tag are contiguous (again, cjk). - Docs updated to reflect the relaxed assumption. - Extensive quoting of keys for a more warning-free experience. Sun Jan 30 14:34:02 EST 2000 - Created add_005s(), _make_005(). - Inserted add_005s into output so now we are correctly datestamped. - Docs added for 005 functionality. Mon Jan 31 12:55:52 EST 2000 - Fixed $args->{'record'} complaint if $args does not exist. - Now we return "19960221075055.7" when in $TEST mode for 005. - Fixed and updated test2.t and test files makrbrkr.mrc and makrtest.src. (now have all canonical 005's; makrtest had a 17 digit time, not 16 in the first record). 1.06 Sun Feb 27 22:00:00 EST 2000 - Added getfirstvalue to avoid dependency on index for Ties. - Added from_string and as_string; mainly for Tie but also has promise for searchmarc. Added option to rebuild map. - Created MARC::Rec and started moving functions to it. Thu Mar 9 22:00:00 EST 2000 - Finished the bulk of ::Rec-ising. - Normalised {records}-{record} handling and %params creation (_records and _params). - Updated searchmarc and deletemarc to more idiomatic Perl; fixed bugs. (Deletemarc was not updating {$tag}{$field}{subfield} information correctly; it does now since it uses rebuild_map). - Fixed one potential problem in _urls (looked at indicators when it should have only been looking at subfields). Sat Mar 11 22:00:00 EST 2000 - Checked that a subclass of MARC(:Btrieve) works even in the presence of MARC::Rec dependencies. - Tested Tie::MARC and Tie::MARC::Btrieve against 1.06 - Fixed bugs. All tests pass. - Updated Docs to reflect pervasive MARC::Rec presence and (few) additional functions. Sun Mar 12 14:39:27 EST 2000 - Configured shipping script for MARC. - Fixed numbering in test5.t. All tests pass. - Added option to read from a string for MARC::Rec. (nextmarc()) 1.07 Sun Apr 23 16:41:46 CDT 2000A - convert all usage to $MARC::TEST, $MARC::DEBUG. Clean up other "use vars" variables only needed in one package. Sync $VERSION. - Perl 5.6.0 warns on "join (//,", use "join (''," instead. - fixes to $naptime and $testfile in t/test5.t - openmarc did not set 'handle' and 'format' for MARC::Rec MARC-1.07/Makefile.PL100644 764 764 7661 7100671563 12577 0ustar billbbillbuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. require 5.004; unless ($^O =~ /Win/i) { WriteMakefile( 'NAME' => 'MARC', 'VERSION_FROM' => 'MARC.pm', # finds $VERSION 'SKIP' => [qw(tool_autosplit)], 'clean' => {FILES => "*/output* output*"}, ); exit; } # On Windows, create substitute scripts for the "make deprived" use File::Copy; use File::Path; use Pod::Html; use File::Find; # clean up test and example result files find(\&wanted, "."); sub wanted { return unless (/^output/); unlink ($_); } my $version = simple_version("MARC.pm"); my $INST_LIBDIR = "./lib"; my $INST_HTMLDIR = "./html"; my $INST_FILES = "MARC.pm"; my $INST_NAME = "MARC"; my @HTML_FILES = "MARC"; print < $dfile") or die "Can't create $dfile: $!\n"; print DEFAULT <<"TEST4"; # double quotes - need interpolation # Created by Makefile.PL # $INST_NAME Version $version TEST4 print DEFAULT <<'TEST4'; # single quotes - minimize chaacter quoting use Test::Harness; runtests ("t/test1.t","t/test2.t","t/test3.t","t/test4.t","t/test5.t"); print "\nTo run individual tests, type:\n"; print " C:\\> perl t/test?.t Page_Pause_Time (0..5)\n"; print "See README and other documentation for additional information.\n\n"; TEST4 close DEFAULT; unless (-d $INST_LIBDIR) { File::Path::mkpath([ "$INST_LIBDIR" ],1,0777) or die "ERROR creating directories: ($!)\n"; } unless (-d $INST_HTMLDIR) { File::Path::mkpath([ "$INST_HTMLDIR" ],1,0777) or die "ERROR creating directories: ($!)\n"; } File::Copy::copy($INST_FILES,$INST_LIBDIR) or die "ERROR copying files: ($!)\n"; foreach $source (@HTML_FILES) { pod2html( "--norecurse", "--infile=$source.pm", "--outfile=$INST_HTMLDIR/$source.html" ); } $dfile = "install.pl"; unlink $dfile, "pod2html-itemcache","pod2html-dircache"; print "Creating new $dfile\n"; open (DEFAULT, "> $dfile") or die "Can't create $dfile: $!\n"; print DEFAULT <<"INST5"; # Created by Makefile.PL # $INST_NAME Version $version INST5 my $template = <<'INST5'; use Config qw(%Config); use strict; use ExtUtils::Install qw( install ); my $FULLEXT = "%s"; # $INST_NAME my $INST_LIB = "./lib"; my $HTML_LIB = "./html"; my $html_dest = ""; # edit real html base here if autodetect fails if (exists $Config{installhtmldir} ) { $html_dest = "$Config{installhtmldir}"; } elsif (exists $Config{installprivlib} ) { $html_dest = "$Config{installprivlib}"; $html_dest =~ s%\\lib%\\html%; } if ( length ($html_dest) ) { $html_dest .= '\lib\site'; } else { die "Can't find html base directory. Edit install.pl manually.\n"; } install({ read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist", write => "$Config{installsitearch}/auto/$FULLEXT/.packlist", $INST_LIB => "$Config{installsitelib}", $HTML_LIB => "$html_dest" },1,0); __END__ INST5 printf DEFAULT $template, $INST_NAME; close DEFAULT; # a low-fat version of parse_version from ExtUtils::MM_Unix. sub simple_version { my $parsefile = shift; my $result; open(FH,$parsefile) or die "Could not open '$parsefile': $!"; my $inpod = 0; while () { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod; chop; next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/; my $eval = qq{ package ExtUtils::MakeMaker::_version; no strict; local $1$2; \$$2=undef; do { $_ }; \$$2 }; local($^W) = 0; $result = eval($eval); die "Could not eval '$eval' in $parsefile: $@" if $@; $result = "undef" unless defined $result; last; } close FH; return $result; } MARC-1.07/MARC.pm100644 764 764 440667 7100722415 11745 0ustar billbbillbpackage MARC; use Carp; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG $TEST); $VERSION = '1.07'; $MARC::DEBUG = 0; $MARC::TEST = 0; require Exporter; require 5.004; @ISA = qw(Exporter); @EXPORT= qw(); @EXPORT_OK= qw(); #### Not using these yet #### %EXPORT_TAGS = (USTEXT => [qw( marc2ustext )]); #### Exporter::export_ok_tags('USTEXT'); #### $EXPORT_TAGS{ALL} = \@EXPORT_OK; # Preloaded methods go here. sub mycarp { # rec Carp::carp (@_) unless $MARC::TEST; } #################################################################### # This is the constructor method that creates the MARC object. It # # will call the appropriate read using the file and format # # parameters that are passed. # #################################################################### sub new { # rec my $proto = shift; my $class = ref($proto) || $proto; my $file = shift; my $marc = []; my $totalrecord; $marc->[0]{'increment'}=-1; #store the default increment in the object my $proto_rec; # print STDERR "foo\n"; { # We are going to look for related classes in Perl's # symbol table. This is a little tricky. # Shoot me. no strict 'refs'; # Next, we set up a symbolic reference. my $g = $ {$class.'::Rec::VERSION'}; # space for emacs. # That was a sample of Perl reflection. Yup, what Smalltalk # does with Class and MetaClass, Perl does with strings. # Not much structure, but also not much fuss. my $rec_class = $class."::Rec" if $g; # Now we will use the related Rec class if it exists. $rec_class ||= "MARC::Rec"; $proto_rec = $rec_class->new(); } $marc->[0]{'proto_rec'}=$proto_rec; # Used for future manipulations. bless ($marc, $class); # bless early so _readxxx can use methods #if file isn't defined then just return the empty MARC object if ($file) { unless (-e $file) {mycarp "File $file doesn't exist"; return} #if the file doesn't exist return an error my $format = shift || "usmarc"; # $format defaults to USMARC if undefined open(*file, $file) or mycarp "Open Error: $file, $!"; binmode *file; $marc->[0]{'handle'}=\*file; $proto_rec->{'handle'} = $marc->[0]{'handle'}; $proto_rec->{'format'} = lc $format; if ($format =~ /usmarc$/io) { $marc->[0]{'format'}='usmarc'; $totalrecord = _readmarc($marc); close *file or mycarp "Close Error: $file, $!"; } elsif ($format =~ /unimarc$/io) { $marc->[0]{'format'}='unimarc'; $totalrecord = _readmarc($marc); close *file or mycarp "Close Error: $file, $!"; } elsif ($format =~ /marcmaker$/io) { $marc->[0]{'lineterm'}="\015\012"; # MS-DOS default for MARCMaker $totalrecord = _readmarcmaker($marc); close *file or mycarp "Close Error: $file, $!"; } elsif ($format =~ /xml/oi) { mycarp "XML formats are now handled by MARC::XML"; return; } else { mycarp "I don't recognize format $format"; return; } } print "read in $totalrecord records\n" if $MARC::DEBUG; return $marc; } #################################################################### # clone returns a new MARC object with copies of the data. # Admin information remains linked to original. #################################################################### sub clone { my $marc = shift; my $class = shift || ref $marc; my $ans = $marc->new; bless $ans, $class; $ans->[0] = $marc->[0]; foreach my $i (1..$#$marc) { my $rec = $marc->[$i]; my $newrec = $rec->clone(); bless $newrec, $class."::Rec"; push @$ans, $newrec; } return $ans; } ################################################################### # _readmarc() reads in a MARC file into the $marc object # ################################################################### sub _readmarc { # also rec my $marc = shift; my $handle = $marc->[0]{'handle'}; my $proto_rec = $marc->[0]{'proto_rec'}; my $increment = $marc->[0]{'increment'}; #pick out increment from the object my $recordcount = 0; while ($increment==-1 || $recordcount<$increment) { my ($rec,$status)=$proto_rec->_readmarc(); last unless $status; if ($status == -1) { mycarp "Invalid record, size does not match leader"; return unless $recordcount; # undef if first return -$recordcount; # if some are valid } if ($status == -2) { mycarp "Invalid record, leader size not numeric"; return unless $recordcount; # undef if first return -$recordcount; # if some are valid } push @$marc, $rec; $recordcount++; } #end processing this record return $recordcount; } ################################################################### # readmarcmaker() reads a marcmaker file into the MARC object # ################################################################### sub _readmarcmaker { # rec my $marc = shift; my $handle = $marc->[0]{'handle'}; my $proto_rec = $marc->[0]{'proto_rec'}; my $increment = $marc->[0]{'increment'}; #pick out increment from the object unless (exists $marc->[0]{'makerchar'}) { $marc->[0]{'makerchar'} = usmarc_default(); # hash ref $proto_rec->{'makerchar'} = $marc->[0]{'makerchar'}; } my $recordcount = 0; while ($increment==-1 or $recordcount<$increment) { my ($rec,$status) = $proto_rec->_readmarcmaker(); last unless $status; if ($status == -1) { mycarp 'Invalid record, prefix "=LDR " not found'; return unless $recordcount; # undef if first return -$recordcount; # if some are valid } push @$marc, $rec; $recordcount++; } #end reading this record return $recordcount; } sub _maker2char { # rec return MARC::Rec::_maker2char(@_); } sub usmarc_default { # rec return MARC::Rec::usmarc_default(@_); } #################################################################### # marc_count() returns the number of records in a # # particular MARC object # #################################################################### sub marc_count { my $marc=shift; return $#$marc; } #################################################################### # openmarc() is a method for reading in a MARC file. It takes # # several parameters: file (name of the marc file) ; format, ie. # # usmarc ; and increment which defines how many records to read in # #################################################################### sub openmarc { my $marc=shift; my $params=shift; my $file=$params->{'file'}; if (not(-e $file)) {mycarp "File \"$file\" doesn't exist"; return} $marc->[0]{'format'}=$params->{'format'}; #store format in object my $totalrecord; $marc->[0]{'increment'}=$params->{'increment'} || 0; #store increment in the object, default is 0 unless ($marc->[0]{'format'}) {$marc->[0]{'format'}="usmarc"}; #default to usmarc open(*file, $file) or mycarp "Open Error: $file, $!"; binmode *file; $marc->[0]{'handle'}=\*file; #store filehandle in object my $proto_rec = $marc->[0]{'proto_rec'}; $proto_rec->{'handle'} = $marc->[0]{'handle'}; $proto_rec->{'format'} = lc $marc->[0]{'format'}; if ($marc->[0]{'format'} =~ /usmarc/oi) { $totalrecord = _readmarc($marc); } elsif ($marc->[0]{'format'} =~ /marcmaker/oi) { if (exists $params->{'charset'}) { $marc->[0]{makerchar} = $params->{'charset'}; # hash ref } else { unless (exists $marc->[0]{'makerchar'}) { $marc->[0]{makerchar} = usmarc_default(); # hash ref } } $marc->[0]{'lineterm'} = $params->{'lineterm'} || "\015\012"; $totalrecord = _readmarcmaker($marc); } else { close *file; if ($params->{'format'} =~ /xml/oi) { mycarp "XML formats are now handled by MARC::XML"; } else { mycarp "Unrecognized format $marc->[0]{'format'}"; } return; } print "read in $totalrecord records\n" if $MARC::DEBUG; if ($totalrecord==0) {$totalrecord="0 but true"} return $totalrecord; } #################################################################### # closemarc() will close a file-handle that was opened with # # openmarc() # #################################################################### sub closemarc { my $marc = shift; $marc->[0]{'increment'}=0; if (not($marc->[0]{'handle'})) { mycarp "There isn't a MARC file to close"; return; } my $ok = close $marc->[0]{'handle'}; $marc->[0]{'handle'}=undef; return $ok; } #################################################################### # nextmarc() will read in more records from a file that has # # already been opened with openmarc(). the increment can be # # adjusted if necessary by passing a new value as a parameter. the # # new records will be APPENDED to the MARC object # #################################################################### sub nextmarc { my $marc=shift; my $increment=shift; my $totalrecord; if (not($marc->[0]{'handle'})) { mycarp "There isn't a MARC file open"; return; } if ($increment) {$marc->[0]{'increment'}=$increment} if ($marc->[0]{'format'} =~ /usmarc/oi) { $totalrecord = _readmarc($marc); } elsif ($marc->[0]{'format'} =~ /marcmaker/oi) { $totalrecord = _readmarcmaker($marc); } else {return} return $totalrecord; } #################################################################### # add_map() takes a recnum and a ref to a field in ($tag, # $i1,$i2,a=>"bar",...) or ($tag, $field) formats and will append to # the various indices that we have hanging off that record. It is # intended for use in creating records de novo and as a component for # rebuild_map(). It carefully does not copy subfield values or entire # fields, maintaining some reference relationships. What this means # for indices created with add_map that you can directly edit # subfield values in $marc->[recnum]{array} and the index will adjust # automatically. Vice-versa, if you edit subfield values in # $marc->{recnum}{tag}{subfield_code} the fields in # $marc->[recnum]{array} will adjust. If you change structural # information in the array with such an index, you must rebuild the # part of the index related to the current tag (and possibly the old # tag if you change the tag). #################################################################### sub add_map { # rec my $marc=shift; my $recnum = shift; my $rafield = shift; $marc->[$recnum]->add_map($rafield); } #################################################################### # rebuild_map() takes a recnum and a tag and will synchronize the # index with all elements in the [recnum]{array} with that tag. #################################################################### sub rebuild_map { # rec my $marc=shift; my $recnum = shift; my $tag = shift; return undef if $tag eq '000'; #currently ldr is different... $marc->[$recnum]->rebuild_map($tag); } #################################################################### # rebuild_map_all() takes a recnum and will synchronize the # index with all elements in the [recnum]{array} #################################################################### sub rebuild_map_all { # rec my $marc=shift; my $recnum = shift; $marc->[$recnum]->rebuild_map_all(); } #################################################################### # deletemarc() will delete entire records, specific fields, as # # well as specific subfields depending on what parameters are # # passed to it # #################################################################### sub deletemarc { my $marc=shift; my $template=shift; my $params = _params($template,@_); my @delrecords= _records($marc,$params); my %delrecords= map {$_=>1} @delrecords; #if records parameter not passed set to all records in MARC object my $field=$params->{field}; my $subfield=$params->{subfield}; my $deletecount=0; my @keepers = grep {!$delrecords{$_}} (0..$#$marc); #delete entire records if (not($field) and not($subfield)) { my $class = ref $marc; my @newmarc = @$marc[@keepers]; # array slice, look it up. @$marc=@newmarc; bless $marc,$class; return @delrecords; } #delete fields and/or subfields. deletefirst takes care of the details. # This may be slow. If so write a loop using deletesubfield, etc. foreach my $i (1..$#$marc) { next unless $delrecords{$i}; my $rec=$marc->[$i]; my @newfields =(); while (1) { my $has_subfield = $rec->deletefirst($template); last unless $has_subfield; $deletecount++; } $rec->rebuild_map($field); } return $deletecount; } #################################################################### # selectmarc() performs the opposite function of deletemarc(). It # # will select specified elements of a MARC object and return them # # as a MARC object. So if you wanted to select records 1-10 and 15 # # of a MARC object you could say $x=$x->selectmarc(["1-10","15"]); # #################################################################### sub selectmarc { my $marc=shift; my $selarray=shift; my @keepers=(0); # so we have admin information. foreach my $selelement (@$selarray) { if ($selelement=~/(\d+)-(\d+)/) { push @keepers,($1..$2); } else { push @keepers, $selelement; } } if (not($selarray)) {@{$selarray}= (1..$#$marc)} my $class = ref $marc; my @newmarc = @$marc[@keepers]; # array slice, look it up. @$marc=@newmarc; bless $marc,$class; return scalar(@keepers) -1; # minus off the $marc->[0] } #################################################################### # searchmarc() is method for searching a MARC object for specific # # values. It will return an array which contains the record # # numbers that matched. # #################################################################### sub searchmarc { my $marc=shift; my $template=shift; return unless (ref($template) eq "HASH"); my $params = _params($template,@_); my $field=$params->{field} || return; my $subfield=$params->{subfield}; my $regex=$params->{regex}; my $notregex=$params->{notregex}; my @results; my $searchtype; #determine the type of search if ($field and not($subfield) and not($regex) and not($notregex)) { $searchtype="fieldpresence"} elsif ($field and $subfield and not($regex) and not($notregex)) { $searchtype="subfieldpresence"} elsif ($field and not($subfield) and $regex) { $searchtype="fieldvalue"} elsif ($field and $subfield and $regex) { $searchtype="subfieldvalue"} elsif ($field and not($subfield) and $notregex) { $searchtype="fieldnotvalue"} elsif ($field and $subfield and $notregex) { $searchtype="subfieldnotvalue"} #do the search by cycling through each record for (my $i=1; $i<=$#$marc; $i++) { my $flag=0; if ($searchtype eq "fieldpresence") { next unless exists $marc->[$i]{$field}; push(@results,$i); } elsif ($searchtype eq "subfieldpresence") { next unless exists $marc->[$i]{$field}; next unless exists $marc->[$i]{$field}{$subfield}; push(@results,$i); } elsif ($searchtype eq "fieldvalue") { next unless exists $marc->[$i]{$field}; next unless exists $marc->[$i]{$field}{field}; my $x=$marc->[$i]{$field}{field}; foreach my $y (@$x) { my $z=_joinfield($y,$field); if (eval qq("$z" =~ $regex)) {$flag=1} } if ($flag) {push (@results,$i)} } elsif ($searchtype eq "subfieldvalue") { next unless exists $marc->[$i]{$field}; next unless exists $marc->[$i]{$field}{$subfield}; my $x=$marc->[$i]{$field}{$subfield}; foreach my $y (@$x) { if (eval qq("$$y" =~ $regex)) {$flag=1} } if ($flag) {push (@results,$i)} } elsif ($searchtype eq "fieldnotvalue" ) { next unless exists $marc->[$i]{$field}; next unless exists $marc->[$i]{$field}{field}; my $x=$marc->[$i]{$field}{field}; if (not($x)) {push(@results,$i); next} foreach my $y (@$x) { my $z=_joinfield($y,$field); if (eval qq("$z" =~ $notregex)) {$flag=1} } if (not($flag)) {push (@results,$i)} } elsif ($searchtype eq "subfieldnotvalue") { next unless exists $marc->[$i]{$field}; next unless exists $marc->[$i]{$field}{$subfield}; my $x=$marc->[$i]{$field}{$subfield}; if (not($x)) {push (@results,$i); next} foreach my $y (@$x) { if (eval qq("$$y" =~ $notregex)) {$flag=1} } if (not($flag)) {push (@results,$i)} } } return @results; } #################################################################### # getfirstvalue() will return the first value of a field or subfield # or indicator or i12 in a particular record found in the MARC # object. It does not depend on the index being up to date. #################################################################### sub getfirstvalue { # rec my $marc= shift; my $template=shift; return unless (ref($template) eq "HASH"); my $record = $template->{record}; if (not($record)) {mycarp "You must specify a record"; return} if ($record > $#{$marc}) {mycarp "Invalid record specified"; return} my $marcrec = $marc->[$record]; return $marcrec->getfirstvalue($template); } #################################################################### # getvalue() will return the value of a field or subfield in a # # particular record found in the MARC object # #################################################################### sub getvalue { # rec my $marc = shift; my $template=shift; return unless (ref($template) eq "HASH"); my $params = _params($template,@_); my $record = $params->{record}; if (not($record)) {mycarp "You must specify a record"; return} if ($record > $#{$marc}) {mycarp "Invalid record specified"; return} return $marc->[$record]->getvalue($params); } #################################################################### #Returns LDR at $record. # #################################################################### sub ldr { # rec my ($self,$record)=@_; return $self->[$record]->ldr(); } #################################################################### #Takes a record number and returns a hash of fields. # #Needed to determine the format (BOOK, VIS, etc) of # #the record. # #Folk also like to know what Ctrl, Desc etc are. # #################################################################### sub unpack_ldr { # rec my ($self,$record) = @_; return $self->[$record]->unpack_ldr(); } sub _unpack_ldr { # rec my ($self,$ldr)=@_; return $self->[0]{proto_rec}->unpack_ldr($ldr); } #################################################################### #Takes a record number. # #Returns the unpacked ldr as a ref to hash from the ref in $self. # #Does not overwrite hash from ldr. # #################################################################### sub get_hash_ldr { # rec my ($self,$record)=@_; return $self->[$record]->get_hash_ldr(); } #################################################################### # Takes a record number and updates the corresponding ldr if there # is a hashed form. Returns undef unless there is a hash. Else # returns $ldr. #################################################################### sub pack_ldr { # rec my ($self,$record)=@_; return $self->[$record]->pack_ldr(); } #################################################################### #Takes a ref to hash version of the LDR and returns a string # # version # #################################################################### sub _pack_ldr { # rec my ($self,$rhldr) = @_; return $self->[0]{proto_rec}->_pack_ldr($rhldr); } #################################################################### #Takes a string record number. # #Returns a the format necessary to pack/unpack 008 fields correctly# #################################################################### sub bib_format { # rec my ($self,$record)=@_; return $self->[$record]->bib_format(); } sub _bib_format { # rec my ($self,$ldr)=@_; return $self->[0]{proto_rec}->_bib_format($ldr); } #################################################################### #Takes a record number. # #Returns the unpacked 008 as a ref to hash. Installs ref in $self. # #################################################################### sub unpack_008 { # rec my ($self,$record) = @_; return $self->[$record]->unpack_008(); } sub _unpack_008 { # rec my ($self,$ff_string,$bib_format) = @_; return $self->[0]{proto_rec}->_unpack_008($ff_string,$bib_format); } #################################################################### #Takes a record number. # #Returns the unpacked 008 as a ref to hash from the ref in $self. # #Does not overwrite hash from 008 field. # #################################################################### sub get_hash_008 { # rec my ($self,$record)=@_; return $self->[$record]->get_hash_008(); } #################################################################### #Takes a record number. Flushes hashes to 008 and ldr. # #Updates the 008 field from an installed fixed field hash. #Returns undef unless there is a hash, else returns the 008 field # #################################################################### sub pack_008 { # rec my ($self,$record) = @_; return $self->[$record]->pack_008(); } #################################################################### #Takes LDR and ref to hash of unpacked 008 # #Returns string version of 008 *without* newlines. # #################################################################### sub _pack_008 { # rec my ($self,$ldr,$rhff) = @_; return $self->[0]{proto_rec}->_pack_008($ldr,$rhff); } #################################################################### # _joinfield() is an internal subroutine for creating a string out # # of an array of subfields. It takes an optional delimiter # # parameter which will print out subfields if defined # #################################################################### sub _joinfield { # rec return MARC::Rec->_joinfield(@_); } #################################################################### # _make_005 is a function: it returns the time formatted for the 005 # field. #################################################################### sub _make_005 { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); # 1. Official specs for 005 are at # lcweb.loc.gov/marc/bibliographic/ecbdcntr.html # They refer to X3.30 ansi; a copy of that would be of interest. # 2. Checked out some examples for existing practice. $year += 1900; $mon++; #$mon is counted from 1 when talking to humans. return "19960221075055.7" if $MARC::TEST; return sprintf("%0.4d%0.2d%0.2d%0.2d%0.2d%0.2d.0",$year,$mon,$mday,$hour,$min,$sec); } #################################################################### # add_005s takes a template and adds current 005s to the elements of # $marc mentioned in $template->{records} #################################################################### sub add_005s { my $marc=shift; my $args = shift; my @records; @records= (1..$#$marc); if ($args && $args->{'records'} ) { @records =@{$args->{'records'}}; } my $time = MARC::_make_005() ; foreach my $i (@records) { $marc->[$i]->add_005($time); } } #################################################################### # output() will call the appropriate output method using the marc # # object and desired format parameters. # #################################################################### sub output { my $marc=shift; my $args=shift; my $output = ""; my $newline = $args->{'lineterm'} || "\n"; $marc->add_005s($args) if ($args->{'file'} or $args->{'add_005s'}); unless (exists $args->{'format'}) { # everything to string $args->{'format'} = "marc"; $args->{'lineterm'} = $newline; } if ($args->{'format'} =~ /marc$/oi) { $output = _writemarc($marc,$args); } elsif ($args->{'format'} =~ /marcmaker$/oi) { $output = _marcmaker($marc,$args); } elsif ($args->{'format'} =~ /ascii$/oi) { $output = _marc2ascii($marc,$args); } elsif ($args->{'format'} =~ /html$/oi) { $output .= ""; $output .= _marc2html($marc,$args); $output .="$newline$newline"; } elsif ($args->{'format'} =~ /html_header$/oi) { $output = "Content-type: text/html\015\012\015\012"; } elsif ($args->{'format'} =~ /html_start$/oi) { if ($args->{'title'}) { $output = "$args->{'title'}"; $output .= "$newline"; } else { $output = ""; } } elsif ($args->{'format'} =~ /html_body$/oi) { $output =_marc2html($marc,$args); } elsif ($args->{'format'} =~ /html_footer$/oi) { $output = "$newline$newline"; } elsif ($args->{'format'} =~ /urls$/oi) { my $title = $args->{'title'} || "Untitled URLs"; $output .= "$title$newline$newline"; $output .= _urls($marc,$args); $output .=""; } elsif ($args->{'format'} =~ /isbd$/oi) { $output = _isbd($marc,$args); } elsif ($args->{'format'} =~ /xml/oi) { mycarp "XML formats are now handled by MARC::XML" if ($^W); return; } if ($args->{'file'}) { if ($args->{'file'} !~ /^>/) { mycarp "Don't forget to use > or >> with output file name"; return; } open (OUT, "$args->{file}") || mycarp "Couldn't open file: $!"; #above quote is bad if {file} is tainted. Is probably unecessary.dgl. binmode OUT; print OUT $output; close OUT || mycarp "Couldn't close file: $!"; return 1; } #if no filename was specified return the output so it can be grabbed else { return $output; } } #################################################################### # _records unpacks it hashref arg or defaults to the entire list #################################################################### sub _records { my ($marc,$args)=@_; my $trecs =[]; my @records = (); $trecs= [$args->{record}] if exists($args->{record}); $trecs= $args->{records} if $args->{records}; @records = @$trecs if @$trecs; @records = (1..$#$marc) unless @$trecs; return @records; } #################################################################### # params takes a hashref and does a one level deep copy of it. # It uses the rest of the args to override elements of the hashref. # Returns a hashref so that caller does'nt have to worry about # crypto-context. #################################################################### sub _params { return MARC::Rec::_params(@_); } #################################################################### # _writemarc() takes a MARC object as its input and returns the # # the USMARC equivalent of the object as a string # #################################################################### sub _writemarc { #rec my $marc=shift; my $args=shift; #Read in each individual MARC record in the file my @records = _records($marc,$args); my $marcrecord=""; foreach my $i (@records) { my $record = $marc->[$i]; $marcrecord .= $record->_writemarc($args); } return $marcrecord; } #################################################################### # _marc2ascii() takes a MARC object as its input and returns the # # ASCII equivalent of the object (field names, indicators, field # # values and line-breaks) # #################################################################### sub _marc2ascii { # rec my $marc=shift; my $args=shift; my @records = _records($marc,$args); $args->{'lineterm'} ||= "\n"; my $output = ""; for my $i (@records) { #cycle through each record my $record=$marc->[$i]; $output .= $record->_marc2ascii($args); } return $output; } #################################################################### # _marcmaker() takes a MARC object as its input and converts it # # into MARCMaker format, which is returned as a string # #################################################################### sub _marcmaker { # rec my @output = (); my $marc=shift; my $args=shift; $args->{'proto_rec'} = $marc->[0]{'proto_rec'}; my @records = _records($marc,$args); local $^W = 0; # no warnings my $breaker = ""; for my $i (@records) { #cycle through each record my $record=$marc->[$i]; $breaker .= $record->_marcmaker($args); } return $breaker; } sub _char2maker { # rec return MARC::Rec::_char2maker(@_); } sub ustext_default { # rec return MARC::Rec::ustext_default(@_); } #################################################################### # _marc2html takes a MARC object as its input and converts it into # # HTML. It is possible to specify which field you want to output # # as well as field labels to be used instead of the MARC codes. # # The HTML is returned as a string # #################################################################### sub _marc2html { my $marc = shift; my $args = shift; my $newline = $args->{'lineterm'} || "\n"; my @records = _records($marc,$args); my $output = ""; foreach my $i (@records) { my $marcrec=$marc->[$i]; $output.= $marcrec->_marc2html($args); } return $output; } #################################################################### # _urls() takes a MARC object as its input, and then extracts the # # control# (MARC 001) and URLs (MARC 856) and outputs them as # # hypertext links in an HTML page. This could then be used with a # # link checker to determine what URLs are broken. # #################################################################### sub _urls { # rec my $marc = shift; my $args = shift; my $output = ""; my @records = _records($marc,$args); local $^W = 0; # no warnings foreach my $i (@records) { my $marcrec=$marc->[$i]; $output .= $marcrec->_urls($args); } return $output; } #################################################################### # isbd() attempts to create a quasi ISBD output format # #################################################################### sub _isbd { # rec my $marc=shift; my $args=shift; my $newline = $args->{'lineterm'} || "\n"; my @records = _records($marc,$args); my $output =""; for my $i (@records) { #cycle through each record my $record=$marc->[$i]; $output .= $record->_isbd($args); } return $output; } #################################################################### # createrecord() appends a new record to the MARC object # # and initializes the '000' field # #################################################################### sub createrecord { # rec my $marc=shift; local $^W = 0; # no warnings my $params=shift; my $leader=$params->{'leader'} || "00000nam 2200000 a 4500"; #default leader see MARC documentation http://lcweb.loc.gov/marc my $number=$#$marc + 1; my $marcrec = $marc->[0]{'proto_rec'}->createrecord($leader); push @$marc, $marcrec; return $number; } #################################################################### # addfield() appends/inserts a new field into an existing record # #################################################################### sub addfield { my $marc=shift; my $params=shift; local $^W = 0; # no warnings my $record=$params->{'record'}; unless ($record) {mycarp "You must specify a record"; return} if ($record > $#{$marc}) {mycarp "Invalid record specified"; return} my $field = $params->{'field'}; unless ($field) {mycarp "You must specify a field"; return} unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return} my $i1=$params->{'i1'}; $i1 = ' ' unless (defined $i1); my $i2=$params->{'i2'}; $i2 = ' ' unless (defined $i2); my @value=$params->{'value'} || @_; if (ref($params->{'value'}) eq "ARRAY") { @value = @{$params->{'value'}}; } unless (defined $value[0]) {mycarp "No value specified"; return} if ($field >= 10) { if ($value[0] eq 'i1') { shift @value; $i1 = shift @value; } unless (1 == length($i1)) { mycarp "invalid \'i1\' specified"; return; } if ($value[0] eq 'i2') { shift @value; $i2 = shift @value; } unless (1 == length($i2)) { mycarp "invalid \'i2\' specified"; return; } } my $ordered=$params->{'ordered'} || "y"; my $insertorder = $#{$marc->[$record]{array}} + 1; #if necessary figure out the insert order to preserve tag order if ($ordered=~/y/i) { for (my $i=0; $i<=$#{$marc->[$record]{array}}; $i++) { if ($marc->[$record]{array}[$i][0] > $field) { $insertorder=$i; last; } if ($insertorder==0) {$insertorder=1} } } my @field; if ($field<10) { push (@field, $field, $value[0]); if ($ordered=~/y/i) { splice @{$marc->[$record]{array}},$insertorder,0,\@field; } else { push (@{$marc->[$record]{array}},\@field); } } else { push (@field, $field, $i1, $i2); my ($sub_id, $subfield); while ($sub_id = shift @value) { last if ($sub_id eq "\036"); $subfield = shift @value; push (@field, $sub_id, $subfield); } if ($ordered=~/y/i) { splice @{$marc->[$record]{array}},$insertorder,0,\@field; } else { push (@{$marc->[$record]{array}},\@field); } } $marc->add_map($record,\@field); } #################################################################### # getfields() takes a template and returns an array of fieldrefs from # $marc->[$recnum]{'array'} including all with the appropriate tag # and having the property that they are a contiguous group. (So may # include fields with other tags.) #################################################################### sub getfields { # rec my $marc=shift; my $params=shift; my $record=$params->{'record'}; unless ($record) {mycarp "You must specify a record"; return} if ($record > $#{$marc}) {mycarp "Invalid record specified"; return} return $marc->[$record]->getfields($params); } #################################################################### # getupdate() returns an array of key,value pairs formatted to # # pass to addfield(). For repeated tags, a "\036" element is used # # to delimit data for separate addfield() commands # #################################################################### sub getupdate { my @output; my $marc=shift; my $params=shift; my $record=$params->{'record'}; unless ($record) {mycarp "You must specify a record"; return} if ($record > $#{$marc}) {mycarp "Invalid record specified"; return} my $field = $params->{'field'}; unless ($field) {mycarp "You must specify a field"; return} unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return} foreach my $fields (@{$marc->[$record]{array}}) { #cycle each field next unless ($field eq $fields->[0]); if ($field<10) { push @output,$fields->[1]; } else { push @output,'i1',$fields->[1],'i2',$fields->[2]; my @subfields = @{$fields}[3..$#{$fields}]; while (@subfields) { #cycle through subfields incl. refs my $subfield = shift @subfields; last unless defined $subfield; if (ref($subfield) eq "ARRAY") { foreach my $subsub (@{$subfield}) { push @output, $subsub; } } else { push @output, $subfield; } } #finish cycling through subfields } #finish tag test < 10 push @output,"\036"; } return @output; } #################################################################### # deletefirst() takes a template and a boolean $do_rebuild_map to # rebuild the map. It deletes the field data for a first match, using # the template and leaves the rest alone. If the template has a # subfield element it deletes based on the subfield information in the # template. If the last subfield of a field is deleted, deletefirst() # also deletes the field. It complains about attempts to delete # indicators. If there is no match, it does nothing. Deletefirst also # rebuilds the map if $do_rebuild_map. Deletefirst returns the number # of matches deleted (that would be 0 or 1), or undef if it feels # grumpy (i.e. carps). #################################################################### sub deletefirst { # rec my $marc = shift || return; my $template = shift; my $recnum = $template->{'record'}; if (!$recnum) {mycarp "Need a record to confine my destructive tendencies"; return undef} return $marc->[$recnum]->deletefirst($template); } #################################################################### # field_is_empty takes a ref to an array formatted like # an element of $marc->[$recnum]{array}. It returns 1 if there are # no "significant" elements of the array (e.g. nothing but indicators # if $tag>10), else 0. Override this if you want to delete fields # that have "insignificant" subfields inside deletefirst. #################################################################### sub field_is_empty { # rec my ($marc,$rfield) = @_; return $marc->[0]{proto_rec}->field_is_empty($rfield); } #################################################################### # field_updatehook takes a ref to an array formatted like # $marc->[$recnum]{'array'}. It is there so that # subclasses can override it to do something before calling # addfield(), e.g. store field-specific information in the affected # field or log information in an external file/database. One notes that # since this is a method, it can ignore its arguments and log global # information about $marc, e.g. order information in $marc->[$rnum]{'array'} #################################################################### sub field_updatehook { # rec my ($marc,$rfield)=@_; $marc->[0]{'proto_rec'}->field_updatehook($rfield); } #################################################################### # updatefirst() takes a template, a request to rebuild the index, and # an array from $marc->[recnum]{array}. It replaces/creates the field # data for a first match, using the template, and leaves the rest # alone. If the template has a subfield element, (this includes # indicators) it ignores all other information in the array and only # updates/creates based on the subfield information in the array. If # the template has no subfield information then indicators are left # untouched unless a new field needs to be created, in which case they # are left blank. #################################################################### sub updatefirst { # rec my $marc = shift || return; my $template = shift; return unless (ref($template) eq "HASH"); return unless (@_); return if (defined $template->{'value'}); my $recnum = $template->{'record'}; if (!$recnum) {mycarp "Need a record to confine my changing needs."; return undef} return $marc->[$recnum]->updatefirst($template,@_); } #################################################################### # updatefields() takes a template which specifies recnum, a # $do_rebuild_map and a field (needs the field in case $rafields->[0] # is empty). It also takes a ref to an array of fieldrefs formatted # like the output of getfields(), and replaces/creates the field # data. It assumes that it should remove the fields with the first tag # in the fieldrefs. It calls rebuild_map() if $do_rebuild_map. #################################################################### sub updatefields { # rec my $marc = shift || return; my $template = shift; my $rafieldrefs = shift; my $recnum = $template->{'record'}; return $marc->[$recnum]->updatefields($template,$rafieldrefs); } #################################################################### # getmatch() takes a subfield code (can be an indicator) and a fieldref # Returns 0 or a ref to the value to be updated. #################################################################### sub getmatch { # rec my $marc = shift || return; return $marc->[0]{proto_rec}->getmatch(@_); } #################################################################### # deletesubfield() takes a subfield code (can not be an indicator) and a # fieldref. Deletes the subfield code and its value in the fieldref at # the first match on subfield code. Assumes there is an exact # subfield match in $fieldref. #################################################################### sub deletesubfield { # rec my $marc = shift || return; return $marc->[0]{proto_rec}->deletesubfield(@_); } #################################################################### # insertpos() takes a subfield code (can not be an indicator), a # value, and a fieldref. Updates the fieldref with the first # place that the fieldref can match. Assumes there is no exact # subfield match in $fieldref. #################################################################### sub insertpos { # rec my $marc = shift || return; return $marc->[0]{proto_rec}->insertpos(@_); } #################################################################### # updaterecord() takes an array of key/value pairs, formatted like # # the output of getupdate(), and replaces/creates the field data. # # For repeated tags, a "\036" element is used to delimit data into # # separate addfield() commands. # #################################################################### sub updaterecord { my $marc = shift || return; my $template = shift; return unless (ref($template) eq "HASH"); return unless (@_); return if (defined $template->{'value'}); my $count = 0; my @records = (); unless ($marc->deletemarc($template)) {mycarp "not deleted\n"; return;} foreach my $y1 (@_) { unless ($y1 eq "\036") { push @records, $y1; next; } unless ($marc->addfield($template, @records)) { mycarp "not added\n"; return; } @records = (); $count++; } return $count; } #################################################################### # _offset is an internal subroutine used by writemarc to offset # # number ie. making "34" into "00034". # #################################################################### sub _offset{ return MARC::Rec::_offset(@_); } #################################################################### # MARC::Rec is responsible for the methods and representation of # a single MARC record. Its protocol is very close to that of MARC: # in fact, most MARC methods have been moved here without the record # number and re-implemented in standard form by delegation. #################################################################### package MARC::Rec; use Carp; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS @LDR_FIELDS $LDR_TEMPLATE %FF_FIELDS %FF_TEMPLATE ); $VERSION = $MARC::VERSION; @ISA = qw(Exporter); @EXPORT= qw(); @EXPORT_OK= qw(); #### Not using these yet #### %EXPORT_TAGS = (USTEXT => [qw( marc2ustext )]); #### Exporter::export_ok_tags('USTEXT'); #### $EXPORT_TAGS{ALL} = \@EXPORT_OK; # gotta know where to find leader information.... @LDR_FIELDS = qw(rec_len RecStat Type BLvl Ctrl Undefldr base_addr ELvl Desc ln_rec len_len_field len_start_char len_impl Undef2ldr); $LDR_TEMPLATE = "a5aaaaa3a5aaaaaaa"; #...And the 008 field has a special place in Librarians' hearts. %FF_FIELDS = ( BOOKS => [qw(Entered DtSt Date1 Date2 Ctry Ills Audn Form Cont GPub Conf Fest Indx Undef1 Fict Biog Lang MRec Srce)], COMPUTER_FILES => [qw(Entered DtSt Date1 Date2 Ctry Undef1 Audn Undef2 File Undef3 GPub Undef4 Lang MRec Srce)], MAPS => [qw(Entered DtSt Date1 Date2 Ctry Relf Proj Prme CrTp Undef1 GPub Undef2 Indx Undef3 SpFm Lang MRec Srce)], MUSIC => [qw(Entered DtSt Date1 Date2 Ctry Comp FMus Undef1 Audn Form AccM LTxt Undef2 Lang MRec Srce)], SERIALS => [qw(Entered DtSt Date1 Date2 Ctry Freq Regl ISSN SrTp Orig Form EntW Cont GPub Conf Undef1 Alph S_L Lang MRec Srce)], VIS => [qw(Entered DtSt Date1 Date2 Ctry Time Undef1 Audn AccM GPub Undef2 TMat Tech Lang MRec Srce)], MIX => [qw(Entered DtSt Date1 Date2 Ctry Undef1 Form Undef2 Lang MRec Srce)] ); %FF_TEMPLATE = ( BOOKS => "a6a1a4a4a3a4a1a1a4a1a1a1a1a1a1a1a3a1a1", COMPUTER_FILES => "a6a1a4a4a3a4a1a3a1a1a1a6a3a1a1", MAPS => "a6a1a4a4a3a4a2a1a1a2a1a2a1a1a2a3a1a1", MUSIC => "a6a1a4a4a3a2a1a1a1a1a6a2a3a3a1a1", SERIALS => "a6a1a4a4a3a1a1a1a1a1a1a1a3a1a1a3a1a1a3a1a1", VIS => "a6a1a4a4a3a3a1a1a5a1a4a1a1a3a1a1", MIX => "a6a1a4a4a3a5a1a11a3a1a1" ); # Preloaded methods go here. #################################################################### # _offset is an internal subroutine used by writemarc to offset # # number ie. making "34" into "00034". # #################################################################### sub _offset{ my $value=shift; my $digits=shift; print "DEBUG: _offset value = $value, digits = $digits\n" if $MARC::DEBUG; my $x=length($value); $x=$digits-$x; $x="0"x$x."$value"; } sub mycarp { # rec Carp::carp (@_) unless $MARC::TEST; } #################################################################### # This is the constructor method that creates the MARC::Rec object. It # sets up references and gets out. Any file it knows about will be an # already opened filehandle: do error checking and binmode on the file # outside MARC::Rec. #################################################################### sub new { # rec my $proto = shift; my $class = ref($proto) || $proto; my $filehandle = shift; my $marcrec = {}; bless ($marcrec, $class); my $format = shift || "usmarc"; $marcrec->{'handle'} ||= \*filehandle; $marcrec->{'format'}=$format; $marcrec->{'lineterm'}="\015\012" if $format eq 'marcmaker'; # MS-DOS default for MARCMaker return $marcrec; } #################################################################### # Copy_struct returns a copy of the marcrec ($proto) without # {array} and map information. The copy shares references to # {handle} by design. #################################################################### sub copy_struct { my $proto = shift; my $class = ref($proto); my $newrec; for (keys %$proto) { $newrec->{$_} = $proto->{$_} if /^(handle|format|proto_rec)$/; } return bless $newrec,$class; } #################################################################### # clone returns a new MARC::Rec object with copies of the data. # Admin information remains linked to original. #################################################################### sub clone { my $marcrec=shift; my $ldr = $marcrec->ldr(); my $ans = $marcrec->createrecord($ldr); for (@{$marcrec->{array}}) { next if $_->[0] eq '000'; my @field = @$_; my $rfield = \@field; push @{$ans->{array}}, $rfield; $ans->add_map($rfield); } return $ans; } #################################################################### # field_is_empty takes a ref to an array formatted like # an element of $marc->[$recnum]{array}. It returns 1 if there are # no "significant" elements of the array (e.g. nothing but indicators # if $tag>10), else 0. Override this if you want to delete fields # that have "insignificant" subfields inside deletefirst. #################################################################### sub field_is_empty { # rec my ($marcrec,$rfield) = @_; my $tag = $rfield->[0]; my @field = @$rfield; return 1 if ($tag > 10 and !defined($field[3])); return 1 if ($tag < 10 and !defined($field[1]) ); return 0; } #################################################################### # field_updatehook echos the version in MARC without the recordnum. #################################################################### sub field_updatehook { # rec # nothing. Subclass may want to handle this. } #################################################################### # getfields() takes a template and returns an array of fieldrefs from # $marc->[$recnum]{'array'} including all with the appropriate tag # and having the property that they are a contiguous group. (So may # include fields with other tags.) #################################################################### sub getfields { # rec my $marcrec=shift; my $params=shift; my $field = $params->{'field'}; unless ($field) {mycarp "You must specify a field"; return} unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return} my @ans=(); my $first = undef; my $last = $first; my $pos = 0; for (@{$marcrec->{'array'}}) { $first = $pos if ($_->[0] eq $field && !defined($first)) ; $last = $pos if $_->[0] eq $field; $pos++; } return () unless defined($first); return @{$marcrec->{'array'}}[$first..$last]; # array slice. Look it up. } #################################################################### # deletefirst() takes a template and a boolean $do_rebuild_map to # rebuild the map. It deletes the field data for a first match, using # the template and leaves the rest alone. If the template has a # subfield element it deletes based on the subfield information in the # template. If the last subfield of a field is deleted, deletefirst() # also deletes the field. It complains about attempts to delete # indicators. If there is no match, it does nothing. Deletefirst also # rebuilds the map if $do_rebuild_map. Deletefirst returns the number # of matches deleted (that would be 0 or 1), or undef if it feels # grumpy (i.e. carps). #################################################################### sub deletefirst { # rec my $marcrec = shift || return; my $template = shift; return unless (ref($template) eq "HASH"); return if (defined $template->{'value'}); my $field = $template->{'field'}; my $subfield = $template->{'subfield'}; my $do_rebuild_map = $template->{'rebuild_map'}; if (defined($subfield) and $subfield =~/^i[12]$/) {mycarp "Cannot delete indicators"; return undef} #I know that $marc->{$field}{field} is this information #But I don't want to depend on the map being up-to-date allways. my @fieldrefs = $marcrec->getfields($template); #helps with cjk. return 0 unless scalar(@fieldrefs); if ($field and not($subfield)) { shift @fieldrefs; $marcrec->updatefields($template,\@fieldrefs); $marcrec->rebuild_map($field) if $do_rebuild_map; return 1; } #Linear search for the field where deletion happens and the position #in that field. my $rvictim=0; my $fieldnum = 0; foreach my $fieldref (@fieldrefs) { if ($marcrec->getmatch($subfield,$fieldref)){ $rvictim=$fieldref; last; } $fieldnum++; } if (!$rvictim) { $marcrec->rebuild_map($field) if $do_rebuild_map; return 0; } #Now we know that we have a field and subfield with a match. #Find the first one and kill it. Kill the enclosing field #if it is the last one. $marcrec->deletesubfield($subfield,$rvictim); $marcrec->field_updatehook($rvictim); if ($marcrec->field_is_empty($rvictim)) { splice @fieldrefs,$fieldnum,1; $marcrec->updatefields($template,\@fieldrefs); } #here we don't need to directly touch $marc->{array} # since we are not changing its structure. $marcrec->rebuild_map($field) if $do_rebuild_map; return 1; } sub _params { my $template =shift; return {} unless ref $template eq 'HASH'; my %params = %$template; %params = (%params,@_); return \%params; } #################################################################### # _writemarc() takes a MARC object as its input and returns the # # the USMARC equivalent of the object as a string # #################################################################### sub _writemarc { # rec my $marcrec=shift; my $args=shift; my (@record, $fieldbase, $fielddata, $fieldlength, $fieldposition, $marcrecord, $recordlength); my $record = $marcrec; #Reset variables my $position=0; my $directory=""; my $fieldstream=""; my $leader=$record->{'000'}[1]; foreach my $field (@{$record->{'array'}}) { my $tag = $field->[0]; if ($tag eq '000') {next}; #don't output the directory! my $fielddata=""; if ($tag < 10) { $fielddata=$field->[1]; } else { $fielddata.=$field->[1].$field->[2]; #add on indicators my @subfields=@{$field}[3..$#{$field}]; while (@subfields) { $fielddata.="\037".shift(@subfields); #shift off subfield delimiter $fielddata.=shift(@subfields); #shift off subfield value } } $fielddata.="\036"; $fieldlength=_offset(length($fielddata),4); $fieldposition=_offset($position,5); $directory.=$tag.$fieldlength.$fieldposition; $position+=$fieldlength; $fieldstream.=$fielddata; } $directory.="\036"; $fieldstream.="\035"; $fieldbase=24+length($directory); $fieldbase=_offset($fieldbase,5); $recordlength=24+length($directory)+length($fieldstream); $recordlength=_offset($recordlength,5); $leader=~s/^.{5}(.{7}).{5}(.{7})/$recordlength$1$fieldbase$2/; $marcrecord ="$leader$directory$fieldstream"; $record->{'000'}[1] = $leader; # save recomputed version return $marcrecord; } #################################################################### # _marc2ascii() takes a MARC object as its input and returns the # # ASCII equivalent of the object (field names, indicators, field # # values and line-breaks) # #################################################################### sub _marc2ascii { my $marcrec=shift; my $args=shift; my $newline = $args->{'lineterm'} || "\n"; my $output = ""; my $record=$marcrec; foreach my $fields (@{$record->{'array'}}) { #cycle each field my $tag=$fields->[0]; print "ASCII: tag = $tag\n" if $MARC::DEBUG; if ($tag<10) { $output.="$fields->[0] $fields->[1]"; } else { $output.="$tag $fields->[1]$fields->[2] "; my @subfields = @{$fields}[3..$#{$fields}]; while (@subfields) { #cycle through subfields $output .= "\$".shift(@subfields).shift(@subfields); } #finish cycling through subfields } #finish tag test < 10 $output .= $newline; #put a newline at the end of the field } $output.=$newline; #put an extra newline to separate records return $output; } #################################################################### # _marcmaker() takes a MARC object as its input and converts it # # into MARCMaker format, which is returned as a string # #################################################################### sub _marcmaker { # rec my @output = (); my $marcrec=shift; my $args=shift; my $proto_rec=$args->{'proto_rec'}; unless (exists $args->{'charset'}) { unless (exists $proto_rec->{'brkrchar'}) { $proto_rec->{'brkrchar'} = ustext_default(); # hash ref } $args->{'charset'} = $proto_rec->{'brkrchar'}; $proto_rec->{'charset'} = $proto_rec->{'brkrchar'}; } local $^W = 0; # no warnings my $record=$marcrec; foreach my $fields (@{$record->{'array'}}) { #cycle each field my $tag=$fields->[0]; print "OUT: tag = $tag\n" if $MARC::DEBUG; if ($tag eq '000') { my $value=$fields->[1]; $value=~s/ /\\/go; push @output, "=LDR $value"; } elsif ($tag<10) { my $value = _char2maker($fields->[1], $args->{'charset'}); $value=~s/ /\\/go; push @output, "=$tag $value"; } else { my $indicator1=$fields->[1]; $indicator1=~s/ /\\/; my $indicator2=$fields->[2]; $indicator2=~s/ /\\/; my $output="=$tag $indicator1$indicator2"; my @subfields = @{$fields}[3..$#{$fields}]; while (@subfields) { #cycle through subfields my $subfield_id = shift(@subfields); my $subfield = _char2maker( shift(@subfields), $args->{'charset'} ); $output .= "\$$subfield_id$subfield"; } #finish cycling through subfields push @output, $output; } #finish tag test < 10 } push @output,""; #put an extra blank line to separate records my $newline = $args->{'lineterm'} || "\015\012"; if ($args->{'nolinebreak'}) { my $breaker1 = join ($newline, @output) . $newline; return $breaker1; } # linebreak on by default my @output2 = (); foreach my $outline (@output) { if (length($outline) < 66) { push @output2, $outline; next; } else { my @words = split (/\s{1,1}/, $outline); my $outline2 = shift @words; foreach my $word (@words) { if (length($outline2) + length($word) < 66) { $outline2 .= " $word"; } else { push @output2, $outline2; $outline2 = " $word"; } } push @output2, $outline2; } } my $breaker = join ($newline, @output2); return $breaker; } sub _char2maker { my @marc_string = split (//, shift); my $charmap = shift; my $maker_string = join ('', map { ${$charmap}{$_} } @marc_string); while ($maker_string =~ s/(&)([^ ]{1,7}?)(;)/{$2}/o) {} return $maker_string; } sub ustext_default { my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb, 0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff); my %outchar = map {chr($_), sprintf ("{%2.2X}",int $_)} @hexchar; my @ascchar = map {chr($_)} (0x20..0x23,0x25..0x7a,0x7c,0x7e); foreach my $asc (@ascchar) { $outchar{$asc} = $asc; } $outchar{chr(0x1b)} = '{esc}'; # escape $outchar{chr(0x24)} = '{dollar}'; # dollar sign $outchar{chr(0x5c)} = '{bsol}'; # back slash (reverse solidus) $outchar{chr(0x7b)} = '{lcub}'; # opening curly brace $outchar{chr(0x7d)} = '{rcub}'; # closing curly brace $outchar{chr(0x8d)} = '{joiner}'; # zero width joiner $outchar{chr(0x8e)} = '{nonjoin}'; # zero width non-joiner $outchar{chr(0xa1)} = '{Lstrok}'; # latin capital letter l with stroke $outchar{chr(0xa2)} = '{Ostrok}'; # latin capital letter o with stroke $outchar{chr(0xa3)} = '{Dstrok}'; # latin capital letter d with stroke $outchar{chr(0xa4)} = '{THORN}'; # latin capital letter thorn (icelandic) $outchar{chr(0xa5)} = '{AElig}'; # latin capital letter AE $outchar{chr(0xa6)} = '{OElig}'; # latin capital letter OE $outchar{chr(0xa7)} = '{softsign}'; # modifier letter soft sign $outchar{chr(0xa8)} = '{middot}'; # middle dot $outchar{chr(0xa9)} = '{flat}'; # musical flat sign $outchar{chr(0xaa)} = '{reg}'; # registered sign $outchar{chr(0xab)} = '{plusmn}'; # plus-minus sign $outchar{chr(0xac)} = '{Ohorn}'; # latin capital letter o with horn $outchar{chr(0xad)} = '{Uhorn}'; # latin capital letter u with horn $outchar{chr(0xae)} = '{mlrhring}'; # modifier letter right half ring (alif) $outchar{chr(0xb0)} = '{mllhring}'; # modifier letter left half ring (ayn) $outchar{chr(0xb1)} = '{lstrok}'; # latin small letter l with stroke $outchar{chr(0xb2)} = '{ostrok}'; # latin small letter o with stroke $outchar{chr(0xb3)} = '{dstrok}'; # latin small letter d with stroke $outchar{chr(0xb4)} = '{thorn}'; # latin small letter thorn (icelandic) $outchar{chr(0xb5)} = '{aelig}'; # latin small letter ae $outchar{chr(0xb6)} = '{oelig}'; # latin small letter oe $outchar{chr(0xb7)} = '{hardsign}'; # modifier letter hard sign $outchar{chr(0xb8)} = '{inodot}'; # latin small letter dotless i $outchar{chr(0xb9)} = '{pound}'; # pound sign $outchar{chr(0xba)} = '{eth}'; # latin small letter eth $outchar{chr(0xbc)} = '{ohorn}'; # latin small letter o with horn $outchar{chr(0xbd)} = '{uhorn}'; # latin small letter u with horn $outchar{chr(0xc0)} = '{deg}'; # degree sign $outchar{chr(0xc1)} = '{scriptl}'; # latin small letter script l $outchar{chr(0xc2)} = '{phono}'; # sound recording copyright $outchar{chr(0xc3)} = '{copy}'; # copyright sign $outchar{chr(0xc4)} = '{sharp}'; # sharp $outchar{chr(0xc5)} = '{iquest}'; # inverted question mark $outchar{chr(0xc6)} = '{iexcl}'; # inverted exclamation mark $outchar{chr(0xe0)} = '{hooka}'; # combining hook above $outchar{chr(0xe1)} = '{grave}'; # combining grave $outchar{chr(0xe2)} = '{acute}'; # combining acute $outchar{chr(0xe3)} = '{circ}'; # combining circumflex $outchar{chr(0xe4)} = '{tilde}'; # combining tilde $outchar{chr(0xe5)} = '{macr}'; # combining macron $outchar{chr(0xe6)} = '{breve}'; # combining breve $outchar{chr(0xe7)} = '{dot}'; # combining dot above $outchar{chr(0xe8)} = '{uml}'; # combining diaeresis (umlaut) $outchar{chr(0xe9)} = '{caron}'; # combining hacek $outchar{chr(0xea)} = '{ring}'; # combining ring above $outchar{chr(0xeb)} = '{llig}'; # combining ligature left half $outchar{chr(0xec)} = '{rlig}'; # combining ligature right half $outchar{chr(0xed)} = '{rcommaa}'; # combining comma above right $outchar{chr(0xee)} = '{dblac}'; # combining double acute $outchar{chr(0xef)} = '{candra}'; # combining candrabindu $outchar{chr(0xf0)} = '{cedil}'; # combining cedilla $outchar{chr(0xf1)} = '{ogon}'; # combining ogonek $outchar{chr(0xf2)} = '{dotb}'; # combining dot below $outchar{chr(0xf3)} = '{dbldotb}'; # combining double dot below $outchar{chr(0xf4)} = '{ringb}'; # combining ring below $outchar{chr(0xf5)} = '{dblunder}'; # combining double underscore $outchar{chr(0xf6)} = '{under}'; # combining underscore $outchar{chr(0xf7)} = '{commab}'; # combining comma below $outchar{chr(0xf8)} = '{rcedil}'; # combining right cedilla $outchar{chr(0xf9)} = '{breveb}'; # combining breve below $outchar{chr(0xfa)} = '{ldbltil}'; # combining double tilde left half $outchar{chr(0xfb)} = '{rdbltil}'; # combining double tilde right half $outchar{chr(0xfe)} = '{commaa}'; # combining comma above if ($MARC::DEBUG) { foreach my $num (sort keys %outchar) { printf "%x = %s\n", ord($num), $outchar{$num}; } } return \%outchar; } #################################################################### # _marc2html takes a MARC object as its input and converts it into # # HTML. It is possible to specify which field you want to output # # as well as field labels to be used instead of the MARC codes. # # The HTML is returned as a string # #################################################################### sub _marc2html { # rec my $marcrec = shift; my $args = shift; my $newline = $args->{'lineterm'} || "\n"; my $output = ""; my $outputall = 1; my @tags =(); @tags = grep /^[0-9]/, sort(keys(%{$args})); $outputall = 0 if (scalar(@tags)); if (defined $args->{'fields'}) { if ($args->{'fields'} =~ /all$/oi) {$outputall=1} ## still needed ????? } my %tags =(); %tags = map {$_=>1} @tags; %tags = map {$_->[0]=>1} @{$marcrec->{'array'}} if $outputall; #if 'all' fields are specified then set $outputall flag to yes local $^W = 0; # no warnings my $j=$marcrec; $output.= $newline."

"; foreach my $rfield (@{$j->{'array'}}) { $output.= $rfield->[0]." ".$j->_joinfield($rfield,$rfield->[0])."
".$newline if $tags{$rfield->[0]}; } $output.="

"; return $output; } #################################################################### # _urls() takes a MARC object as its input, and then extracts the # # control# (MARC 001) and URLs (MARC 856) and outputs them as # # hypertext links in an HTML page. This could then be used with a # # link checker to determine what URLs are broken. # #################################################################### sub _urls { my $marcrec = shift; my $args = shift; my $newline = $args->{'lineterm'} || "\n"; my $output = ""; my $controlnum=undef; foreach my $rfield (@{$marcrec->{'array'}}) { if ($rfield->[0] eq "001") { $controlnum= $rfield->[1]; } elsif ($rfield->[0] eq "856") { for (my $k=3; $k< $#$rfield; $k++) { if ($rfield->[$k] eq "u") { $output.=qq{$controlnum :}. qq{$rfield->[$k+1]
$newline}; } } } } return $output; } #################################################################### # isbd() attempts to create a quasi ISBD output format # #################################################################### sub _isbd { # rec my $marcrec=shift; my $args=shift; my $output = ""; my $newline = $args->{'lineterm'} || "\n"; my @reporting_fields = grep {$_->[0] =~/020|245|250|260|300|440|490|5../} @{$marcrec->{'array'}}; # optimization. my %tagfields = (); # This will allow random access to fields based on tags foreach my $rfield (@reporting_fields) { push @{$tagfields{$rfield->[0]}},$rfield; } $output .= $marcrec->_joinfield($tagfields{245}[0],"245"); for (qw/250 260 300/) { $output .= " -- ". $marcrec->_joinfield($tagfields{$_}[0],$_) if $tagfields{$_}; } if ($tagfields{'440'}) { $output .= " -- "; foreach my $rfield (@{$tagfields{'440'}}) { $output .= "(".$marcrec->_joinfield($rfield,"440").") "; } } if ($tagfields{'490'}) { $output .= " -- " unless $tagfields{'440'}; foreach my $rfield (@{$tagfields{'490'}}) { $output .= "(".$marcrec->_joinfield($rfield,"490").") "; } } my @f500s = grep {$_->[0] =~/5../} @reporting_fields; foreach my $rfield (@f500s) { $output .= $newline.$marcrec->_joinfield($rfield,$rfield->[0]); } if ($tagfields{'020'}) { $output .= $newline.$marcrec->_joinfield($tagfields{'020'}[0]); } $output .= $newline.$newline; return $output; } #################################################################### # createrecord takes a string leader and returns a new record with # leader information at the appropriate place. #################################################################### sub createrecord { # rec my $marcrec = shift; local $^W = 0; # no warnings my $leader=shift || "00000nam 2200000 a 4500"; my $newrec = $marcrec->copy_struct(); #default leader see MARC documentation http://lcweb.loc.gov/marc my @ldrfield = ('000',$leader); $newrec->field_updatehook(\@ldrfield); push (@{$newrec->{'000'}},@ldrfield); #create map push(@{$newrec->{'array'}},$newrec->{'000'}); return $newrec; } #################################################################### # nextrec() will read in a record from a filehandle # already been opened with openmarc(). the increment can be # # adjusted if necessary by passing a new value as a parameter. the # # new records will be APPENDED to the MARC object # #################################################################### sub nextrec { my $marcrec=shift; if (not($marcrec->{'handle'})) { mycarp "There isn't a MARC file open"; return; } if ($marcrec->{'format'} =~ /usmarc/oi) { return _readmarc($marcrec); } elsif ($marcrec->{'format'} =~ /marcmaker/oi) { return _readmarcmaker($marcrec); } else {return (undef,-3)} } #################################################################### # Add_map is the rec equivalent of MARC::add_map (as usual, without # the record number). #################################################################### sub add_map { # rec my $marcrec=shift; my $rafield = shift; my $tag = $rafield->[0]; return undef if $tag eq '000'; #currently handle ldr yourself... my @tmp = @$rafield; my $field_len = $#tmp; my $record = $marcrec; if ($tag > 10 ) { my $i1 = $rafield->[1]; my $i2 = $rafield->[2]; my $i12 = $i1.$i2; for(my $i=3;$i<$field_len;$i+=2) { my $subf_code = $rafield->[$i]; push(@{$record->{$tag}{$subf_code}}, \$rafield->[$i+1]); } push(@{$record->{$tag}{'i1'}{$i1}},$rafield); push(@{$record->{$tag}{'i2'}{$i2}},$rafield); push(@{$record->{$tag}{'i12'}{$i12}},$rafield); } push(@{$record->{$tag}{field}},$rafield); } #################################################################### # rebuild_map() is the ::Rec version of MARC::rebuild_map(). #################################################################### sub rebuild_map { # rec my $marcrec=shift; my $tag = shift; return undef if $tag eq '000'; #currently ldr is different... my @tagrefs = grep {$_->[0] eq $tag} @{$marcrec->{'array'}}; delete $marcrec->{$tag}; for (@tagrefs) {$marcrec->add_map($_)}; } #################################################################### # rebuild_map_all() is the ::Rec version of MARC::rebuild_map_all() #################################################################### sub rebuild_map_all { # rec my $marcrec=shift; my %tags=(); map {$tags{$_->[0]}++} @{$marcrec->{'array'}}; foreach my $tag (keys %tags) {$marcrec->rebuild_map($tag)}; } #################################################################### # Reads the next record out of the handle. Returns a pair (new # record,status). Status is 1 in the generic case. Status is -1 if # lengths do not match -2 if leader size is not numeric, undef if at # the last record. New record is undef if there is an error or at the # last record. #################################################################### sub _readmarc { # rec my $marcrec = shift; my $handle = $marcrec->{'handle'}; my $string = shift; local $/ = "\035"; # cf. TPJ #14 local $^W = 0; # no warnings my $line; $line = $string if $string; $line = <$handle> if $handle and !defined($string); my $recordlength = substr($line,0,5); my $octets = length ($line); $line=~s/[\n\r\cZ]//og; return (undef,undef) unless $line; if ($recordlength =~ /\d{5}/o) { print "recordlength = $recordlength, length = $octets\n" if $MARC::DEBUG; return (undef,-1) unless $recordlength == $octets; } else { return (undef,-2); } my @d = (); $line=~/^(.{24})([^\036]*)\036(.*)/o; my $leader=$1; my $dir=$2; my $data=$3; my $record = $marcrec->createrecord($leader); @d=$dir=~/(.{12})/go; for my $d(@d) { my @field=(); my $tag=substr($d,0,3); chop(my $field=substr($data,substr($d,7,5),substr($d,3,4))); if ($tag<10) { @field=($tag,$field); } else { my ($indi1, $indi2, $field_data) = unpack ("a1a1a*", $field); push (@field, $tag, $indi1, $indi2); my @subfields = split(/\037/,$field_data); foreach (@subfields) { my $delim = substr($_,0,1); next unless $delim; my $subfield_data = substr($_,1); push(@field, $delim, $subfield_data); } #end parsing subfields } #end testing tag number push(@{$record->{'array'}},\@field); $record-> add_map(\@field); } #end processing this field return ($record,1); } ################################################################### # readmarcmaker() reads a marcmaker file into the MARC object # ################################################################### sub _readmarcmaker { # rec my $marcrec = shift; my $handle = $marcrec->{'handle'}; my $string = shift; my $record; unless (exists $marcrec->{'makerchar'}) { $marcrec->{'makerchar'} = usmarc_default(); # hash ref } my $charset = $marcrec->{makerchar}; my $lineterm = $marcrec->{'lineterm'} || "\015\012"; # MS-DOS file default for MARCMaker #Set the file input separator to "\r\n\r\n", which is the same as #a blank line. A single blank line separates individual MARC records #in the MARCMakr format. local $/ = "$lineterm$lineterm"; # cf. TPJ #14 local $^W = 0; # no warnings $record = $string if $string; $record = <$handle> if $handle and !defined($string); return (undef,undef) unless $record; #Split each record on the "\n=" into the @fields array my @lines=split "$lineterm=",$record; my $leader = shift @lines; unless ($leader =~ /^=LDR /o) { return (undef, -1); } $leader=~s/^=LDR //o; #Remove "=LDR " $leader=~s/[\n\r]//og; $leader=~s/\\/ /go; # substitute " " for \ my $rec = $marcrec->createrecord($leader); foreach my $line (@lines) { #Remove newlines from @fields ; and also substitute " " for \ $line=~s/[\n\r]//og; $line=~s/\\/ /go; #get the tag name my $tag = substr($line,0,3); my @field=(); #this will be added to $marcrec and the map updated. #if the tag is less than 010 (has no indicators or subfields) #then push the data into @$field if ($tag < 10) { my $value = _maker2char (substr($line,5), $charset); @field=($tag,$value); } else { #elseif the tag is greater than 010 (has indicators and #subfields then add the data to the $marc object my $field_data=substr($line,7); my $i1=substr($line,5,1); my $i2=substr($line,6,1); @field = ($tag,$i1,$i2); my @subfields=split /\$/, $field_data; #get the subfields foreach my $subfield (@subfields) { my $delim=substr($subfield,0,1); #extract subfield delimiter next unless $delim; my $subfield_data= MARC::_maker2char (substr($subfield,1), $charset); #extract subfield value push (@field, $delim, $subfield_data); } #end parsing subfields } #end tag>10 print "DEBUG: tag = $tag\n" if $MARC::DEBUG; push @{$rec->{'array'}},\@field; $rec -> add_map(\@field); } #end reading this line return ($rec,1); } #end reading this record sub _maker2char { # rec my $marc_string = shift; my $charmap = shift; while ($marc_string =~ /{(\w{1,8}?)}/o) { if (exists ${$charmap}{$1}) { $marc_string = join ('', $`, ${$charmap}{$1}, $'); } else { $marc_string = join ('', $`, '&', $1, ';', $'); } } # closing curly brace - part 2, permits {lcub}text{rcub} in input $marc_string =~ s/\}/\x7d/go; return $marc_string; } sub usmarc_default { # rec my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb, 0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff); my %inchar = map {sprintf ("%2.2X",int $_), chr($_)} @hexchar; $inchar{esc} = chr(0x1b); # escape $inchar{dollar} = chr(0x24); # dollar sign $inchar{curren} = chr(0x24); # dollar sign - alternate $inchar{24} = chr(0x24); # dollar sign - alternate $inchar{bsol} = chr(0x5c); # back slash (reverse solidus) $inchar{lcub} = chr(0x7b); # opening curly brace $inchar{rcub} = "}"; # closing curly brace - part 1 $inchar{joiner} = chr(0x8d); # zero width joiner $inchar{nonjoin} = chr(0x8e); # zero width non-joiner $inchar{Lstrok} = chr(0xa1); # latin capital letter l with stroke $inchar{Ostrok} = chr(0xa2); # latin capital letter o with stroke $inchar{Dstrok} = chr(0xa3); # latin capital letter d with stroke $inchar{THORN} = chr(0xa4); # latin capital letter thorn (icelandic) $inchar{AElig} = chr(0xa5); # latin capital letter AE $inchar{OElig} = chr(0xa6); # latin capital letter OE $inchar{softsign} = chr(0xa7); # modifier letter soft sign $inchar{middot} = chr(0xa8); # middle dot $inchar{flat} = chr(0xa9); # musical flat sign $inchar{reg} = chr(0xaa); # registered sign $inchar{plusmn} = chr(0xab); # plus-minus sign $inchar{Ohorn} = chr(0xac); # latin capital letter o with horn $inchar{Uhorn} = chr(0xad); # latin capital letter u with horn $inchar{mlrhring} = chr(0xae); # modifier letter right half ring (alif) $inchar{mllhring} = chr(0xb0); # modifier letter left half ring (ayn) $inchar{lstrok} = chr(0xb1); # latin small letter l with stroke $inchar{ostrok} = chr(0xb2); # latin small letter o with stroke $inchar{dstrok} = chr(0xb3); # latin small letter d with stroke $inchar{thorn} = chr(0xb4); # latin small letter thorn (icelandic) $inchar{aelig} = chr(0xb5); # latin small letter ae $inchar{oelig} = chr(0xb6); # latin small letter oe $inchar{hardsign} = chr(0xb7); # modifier letter hard sign $inchar{inodot} = chr(0xb8); # latin small letter dotless i $inchar{pound} = chr(0xb9); # pound sign $inchar{eth} = chr(0xba); # latin small letter eth $inchar{ohorn} = chr(0xbc); # latin small letter o with horn $inchar{uhorn} = chr(0xbd); # latin small letter u with horn $inchar{deg} = chr(0xc0); # degree sign $inchar{scriptl} = chr(0xc1); # latin small letter script l $inchar{phono} = chr(0xc2); # sound recording copyright $inchar{copy} = chr(0xc3); # copyright sign $inchar{sharp} = chr(0xc4); # sharp $inchar{iquest} = chr(0xc5); # inverted question mark $inchar{iexcl} = chr(0xc6); # inverted exclamation mark $inchar{hooka} = chr(0xe0); # combining hook above $inchar{grave} = chr(0xe1); # combining grave $inchar{acute} = chr(0xe2); # combining acute $inchar{circ} = chr(0xe3); # combining circumflex $inchar{tilde} = chr(0xe4); # combining tilde $inchar{macr} = chr(0xe5); # combining macron $inchar{breve} = chr(0xe6); # combining breve $inchar{dot} = chr(0xe7); # combining dot above $inchar{diaer} = chr(0xe8); # combining diaeresis $inchar{uml} = chr(0xe8); # combining umlaut $inchar{caron} = chr(0xe9); # combining hacek $inchar{ring} = chr(0xea); # combining ring above $inchar{llig} = chr(0xeb); # combining ligature left half $inchar{rlig} = chr(0xec); # combining ligature right half $inchar{rcommaa} = chr(0xed); # combining comma above right $inchar{dblac} = chr(0xee); # combining double acute $inchar{candra} = chr(0xef); # combining candrabindu $inchar{cedil} = chr(0xf0); # combining cedilla $inchar{ogon} = chr(0xf1); # combining ogonek $inchar{dotb} = chr(0xf2); # combining dot below $inchar{dbldotb} = chr(0xf3); # combining double dot below $inchar{ringb} = chr(0xf4); # combining ring below $inchar{dblunder} = chr(0xf5); # combining double underscore $inchar{under} = chr(0xf6); # combining underscore $inchar{commab} = chr(0xf7); # combining comma below $inchar{rcedil} = chr(0xf8); # combining right cedilla $inchar{breveb} = chr(0xf9); # combining breve below $inchar{ldbltil} = chr(0xfa); # combining double tilde left half $inchar{rdbltil} = chr(0xfb); # combining double tilde right half $inchar{commaa} = chr(0xfe); # combining comma above if ($MARC::DEBUG) { foreach my $str (sort keys %inchar) { printf "%s = %x\n", $str, ord($inchar{$str}); } } return \%inchar; } #################################################################### # updatefirst() takes a template, a request to rebuild the index, and # an array from $marc->[recnum]{array}. It replaces/creates the field # data for a first match, using the template, and leaves the rest # alone. If the template has a subfield element, (this includes # indicators) it ignores all other information in the array and only # updates/creates based on the subfield information in the array. If # the template has no subfield information then indicators are left # untouched unless a new field needs to be created, in which case they # are left blank. #################################################################### sub updatefirst { # rec my $marcrec = shift || return; my $template = shift; return unless (ref($template) eq "HASH"); return unless (@_); return if (defined $template->{'value'}); my @ufield = @_; my $field = $template->{'field'}; my $subfield = $template->{'subfield'}; my $do_rebuild_map = $template->{'rebuild_map'}; $ufield[0]= $field; my $ufield_lt_10_value = $ufield[1]; my $ftemplate = {field=>$field}; if (!$field) {mycarp "Need a field to configure my changing needs."; return undef} my @fieldrefs = $marcrec->getfields($template); # An invariant is that at most one element of @fieldrefs is affected. if ($field and not($subfield)) { #save the indicators! Yes! Yes! my ($i1,$i2) = (" "," "); if (defined($fieldrefs[0])) { $i1 = $fieldrefs[0][1]; $i2 = $fieldrefs[0][2]; } $ufield[1]=$i1; $ufield[2]=$i2; if ($field <10) {@ufield = ($field,$ufield_lt_10_value)} my $rafieldrefs = \@fieldrefs; $marcrec->field_updatehook(\@ufield); $rafieldrefs->[0] = \@ufield; if (!scalar(@fieldrefs)) { $marcrec->updatefields($template,$rafieldrefs); return; } $fieldrefs[0]=\@ufield; #There is no issue with $fieldrefs being taken over by the splice in updatefields. # in current testing. Perl may change its behavior later... $marcrec->updatefields($template,\@fieldrefs); return; } #end field. # The case of adding first subfields is hard. (Not too bad with # indicators since every non-control field has them.) # OK, we have field, and subfield. if ($field and $subfield) { if ($field <10) {croak "Cannot update subfields of control fields"; return undef} my $rvictim=0; my $fieldnum = 0; my $rval = 0; foreach my $fieldref (@fieldrefs) { $rval = $marcrec->getmatch($subfield,$fieldref); if ($rval){ $rvictim=$fieldref; last; } $fieldnum++; } # At this stage we have the number of the field $fieldnum, # whether there is a match, $rvictim, # and what to update if there is, $rval. if (!$rvictim and $subfield =~/^i[12]$/) { mycarp "Field $field does not exist. Can only add indicator $subfield to existing fields."; return undef; } #Now we need to find first match in @ufield. my $usub = undef; $usub=$ufield[1] if $subfield eq 'i1'; $usub=$ufield[2] if $subfield eq 'i2'; for(my $i=3;$i<@ufield;$i = $i+2) { my $sub = $ufield[$i]; if ($sub eq $subfield) { $usub = $ufield[$i+1]; last; } } mycarp( "Did not find $subfield in spec (". join " ",@ufield . ")" ) if !defined($usub); if (!scalar(@fieldrefs)) { my @newfield = ($field, ' ',' ', $subfield =>$usub); my $rafields; $marcrec->field_updatehook(\@newfield); $rafields->[0] = \@newfield; return $marcrec->updatefields($template,$rafields); } #The general insert case. if (!$rvictim and scalar(@fieldrefs)) { $rvictim = $fieldrefs[0]; $marcrec->insertpos($subfield,$usub,$rvictim); $marcrec->field_updatehook($rvictim); $marcrec->rebuild_map($field) if $do_rebuild_map; return 1; # $rvictim is now defined, so can't depend on future # control logic. } #The general replace case. if ($rvictim) { $$rval = $usub; $marcrec->field_updatehook($rvictim); # The following line is unecessary for this class: # everything updates due to hard-coded ref # relationships in the index. Left so that subclasses # can do their thing with less over-ruling. $marcrec->rebuild_map($field) if $do_rebuild_map; return 1; } } #end $field and $subfield } #################################################################### # updatefields() takes a template which specifies a # $do_rebuild_map and a field (needs the field in case $rafields->[0] # is empty). It also takes a ref to an array of fieldrefs formatted # like the output of getfields(), and replaces/creates the field # data. It assumes that it should remove the fields with the first tag # in the fieldrefs. It calls rebuild_map() if $do_rebuild_map. #################################################################### sub updatefields { # rec my $marcrec = shift || return; my $template = shift; my $do_rebuild_map = $template->{'rebuild_map'}; my $tag = $template->{'field'}; my $rafieldrefs = shift; my @fieldrefs = @$rafieldrefs; my $pos = 0; my $first=undef; my $last = $first; # Should be "Let the first be last". Misbegotten Perl syntax. my $firstpast = undef; my $len = 0; my @mfields = @{$marcrec->{'array'}}; my $insertpos = undef; for (@mfields) { $first = $pos if ($_->[0] eq $tag and !defined($first)) ; $last = $pos if $_->[0] eq $tag; $firstpast = $pos if ($_->[0] >= $tag and !defined($firstpast)) ; $pos++; } $len = $last - $first +1 if defined($first); $insertpos = scalar(@mfields) if !defined($firstpast); $insertpos = $first if (defined($first)); $insertpos = $firstpast unless $insertpos; splice @{$marcrec->{'array'}},$insertpos,$len,@fieldrefs; $marcrec->rebuild_map($tag) if $do_rebuild_map; } #################################################################### # output() will call the appropriate output method using the marc # # object and desired format parameters. # #################################################################### sub output { my $marcrec=shift; my $args=shift; my $output = ""; my $newline = $args->{'lineterm'} || "\n"; $marcrec->add_005($args) if ($args->{'file'} or $args->{'add_005s'}); unless (exists $args->{'format'}) { # everything to string $args->{'format'} = "usmarc"; $args->{'lineterm'} = $newline; } if ($args->{'format'} =~ /marc$/oi) { $output = _writemarc($marcrec,$args); } elsif ($args->{'format'} =~ /marcmaker$/oi) { $output = _marcmaker($marcrec,$args); } elsif ($args->{'format'} =~ /ascii$/oi) { $output = _marc2ascii($marcrec,$args); } elsif ($args->{'format'} =~ /html$/oi) { $output .= _marc2html($marcrec,$args); } elsif ($args->{'format'} =~ /html_header$/oi) { $output = "Content-type: text/html\015\012\015\012"; } elsif ($args->{'format'} =~ /html_start$/oi) { if ($args->{'title'}) { $output = "$args->{'title'}"; $output .= "$newline"; } else { $output = ""; } } elsif ($args->{'format'} =~ /html_body$/oi) { $output =_marc2html($marcrec,$args); } elsif ($args->{'format'} =~ /html_footer$/oi) { $output = "$newline$newline"; } elsif ($args->{'format'} =~ /urls$/oi) { $output .= _urls($marcrec,$args); } elsif ($args->{'format'} =~ /isbd$/oi) { $output = _isbd($marcrec,$args); } elsif ($args->{'format'} =~ /xml/oi) { mycarp "XML formats are now handled by MARC::XML" if ($^W); return; } if ($args->{'file'}) { if ($args->{'file'} !~ /^>/) { mycarp "Don't forget to use > or >> with output file name"; return; } open (OUT, $args->{file}) || mycarp "Couldn't open file: $!"; #above quote is bad if {file} is tainted. Is probably unecessary.dgl. binmode OUT; print OUT $output; close OUT || mycarp "Couldn't close file: $!"; return 1; } #if no filename was specified return the output so it can be grabbed else { return $output; } } #################################################################### # add_005s takes a template and adds current 005s to the elements of # $marc mentioned in $template->{records} #################################################################### sub add_005 { my $marcrec=shift; my $time = shift; my @m005 = ('005', $time ); $marcrec->updatefirst({field=>'005'},@m005); } ############################################################## sub _joinfield { # rec my $marcrec=shift; my ($rfield,$field,$delim)=@_; my $result; return $rfield->[1] if $field<10; if ($delim) { foreach (my $i=3; $i<$#$rfield; $i+=2) { $result.=$delim.$rfield->[$i].$rfield->[$i+1]; } return $result; } for (my $i=4; $i<=$#$rfield; $i=$i+2) { $result.=$rfield->[$i]; $result.=" " unless $result=~/ $/; } return $result; } #################################################################### # getmatch() takes a subfield code (can be an indicator) and a fieldref # Returns 0 or a ref to the value to be updated. #################################################################### sub getmatch { # rec my $marcrec = shift || return; my $subf = shift; my $rfield = shift; my $tag = $rfield->[0]; if ($tag < 10) {mycarp "can't find subfields or indicators for control fields"; return undef} return \$rfield->[1] if $subf eq 'i1'; return \$rfield->[2] if $subf eq 'i2'; for (my $i=3;$i<@$rfield;$i+=2) { return \$rfield->[$i+1] if $rfield->[$i] eq $subf; } return 0; } #################################################################### # deletesubfield() takes a subfield code (can not be an indicator) and a # fieldref. Deletes the subfield code and its value in the fieldref at # the first match on subfield code. Assumes there is an exact # subfield match in $fieldref. #################################################################### sub deletesubfield { # rec my $marcrec = shift || return; my $subf = shift; my $rfield = shift; my $tag = $rfield->[0]; if ($tag < 10) {mycarp "Can't use subfields or indicators for control fields"; return undef} if ($subf =~/i[12]/) {mycarp "Can't delete an indicator."; return undef} my $i=3; for ($i=3;$i<@$rfield;$i+=2) { last if $rfield->[$i] eq $subf; } splice @$rfield,$i,2; } #################################################################### # insertpos() takes a subfield code (can not be an indicator), a # value, and a fieldref. Updates the fieldref with the first # place that the fieldref can match. Assumes there is no exact # subfield match in $fieldref. #################################################################### sub insertpos { # rec my $marcrec = shift || return; my $subf = shift; my $value = shift; my $rfield = shift; my $tag = $rfield->[0]; if ($tag < 10) {mycarp "Can't use subfields or indicators for control fields"; return undef} if ($subf =~/i[12]/) {mycarp "Can't insert past an indicator."; return undef} my $i=3; for ($i=3;$i<@$rfield;$i+=2) { last if $rfield->[$i] gt $subf; } splice @$rfield,$i,0,$subf,$value; } #################################################################### # getfirstvalue() will return the first value of a field or subfield # or indicator or i12 in a particular record found in the MARC # object. It does not depend on the index being up to date. #################################################################### sub getfirstvalue { # rec my $marcrec= shift; my $template=shift; return unless (ref($template) eq "HASH"); my $field = $template->{'field'}; my $delim = $template->{'delimiter'}; my $subfield; $subfield = $template->{'subfield'} if $template->{'subfield'}; if (not($field)) {mycarp "You must specify a field"; return} unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return} my @fieldrefs = grep {$_->[0] eq $field} @{$marcrec->{'array'}}; return unless @fieldrefs; if ($field and not $subfield) { return $marcrec->_joinfield($fieldrefs[0],$field,$delim); } elsif ($field and $subfield) { if ($field <10) {mycarp "There are no subfields or indicators for control fields";return} return $fieldrefs[0][1].$fieldrefs[0][2] if $subfield eq 'i12'; my $rsubf = undef; foreach my $fieldref (@fieldrefs) { $rsubf =$marcrec->getmatch($subfield,$fieldref); return $$rsubf if $rsubf; } return undef unless $rsubf; } } #################################################################### # getvalue() will return the value of a field or subfield in a # # particular record found in the MARC object # #################################################################### sub getvalue { # rec my $marcrec = shift; my $template=shift; return unless (ref($template) eq "HASH"); my $params = _params($template,@_); my $field = $params->{field}; if (not($field)) {mycarp "You must specify a field"; return} unless ($field =~ /^\d{3}$/) {mycarp "Invalid field specified"; return} my $subfield = $params->{subfield}; my $delim = $params->{delimiter}; my @values; if ($field and not($subfield)) { return unless exists $marcrec->{$field}; if ($field eq '000') { return $marcrec->{'000'}[1] }; foreach my $rfield (@{$marcrec->{$field}{field}}) { push @values, $marcrec->_joinfield($rfield,$field,$delim); } return @values; } elsif ($field and $subfield) { return unless exists $marcrec->{$field}; return unless exists $marcrec->{$field}{$subfield}; if ($subfield eq "i1" || $subfield eq "i2" || $subfield eq "i12") { my @shortone = @{$marcrec->{$field}{field}}; foreach my $rfield (@shortone) { if ($subfield eq 'i1') { push @values, $rfield->[1]; } elsif ($subfield eq 'i2') { push @values, $rfield->[2]; } else { push @values, $rfield->[1].$rfield->[2]; } } return @values; } foreach my $rval (@{$marcrec->{$field}{$subfield}}) { push @values, $$rval; } return @values; } } #################################################################### #Returns LDR at $record. # #################################################################### sub ldr { # rec my $marcrec = shift; return $marcrec->{array}[0][1]; } #################################################################### #Takes a record number and returns a hash of fields. # #Needed to determine the format (BOOK, VIS, etc) of # #the record. # #Folk also like to know what Ctrl, Desc etc are. # #################################################################### sub unpack_ldr { # rec my $marcrec = shift; my $ldr = $marcrec->ldr(); my $rhldr = $marcrec->_unpack_ldr($ldr); $marcrec->{unp_ldr}=$rhldr; return $rhldr; } sub _unpack_ldr { # rec my ($marcrec,$ldr) = @_; my %ans=(); my @fields=unpack($LDR_TEMPLATE,$ldr); for (@LDR_FIELDS) { $ans{$_}=shift @fields; } return \%ans; } #################################################################### #Takes a record number. # #Returns the unpacked ldr as a ref to hash from the ref in $self. # #Does not overwrite hash from ldr. # #################################################################### sub get_hash_ldr { # rec my $marcrec = shift; return undef unless exists($marcrec->{unp_ldr}); return $marcrec->{unp_ldr}; } #################################################################### # Takes a record number and updates the corresponding ldr if there # is a hashed form. Returns undef unless there is a hash. Else # returns $ldr. #################################################################### sub pack_ldr { # rec my $marcrec = shift; return undef unless exists($marcrec->{unp_ldr}); my $rhldr = $marcrec->{unp_ldr}; my $ldr = $marcrec -> _pack_ldr($rhldr); $marcrec->{array}[0][1] = $ldr; return $ldr; } #################################################################### #Takes a ref to hash version of the LDR and returns a string # # version # #################################################################### sub _pack_ldr { # rec my ($marcrec,$rhldr) = @_; my @fields=(); for (@LDR_FIELDS) { push @fields,$rhldr->{$_}; } my $ans = pack($LDR_TEMPLATE,@fields); return $ans; } #################################################################### #Takes a string record number. # #Returns a the format necessary to pack/unpack 008 fields correctly# #################################################################### sub bib_format { # rec my ($marcrec)=@_; $marcrec->pack_ldr(); my $ldr = $marcrec->ldr(); return $marcrec->_bib_format($ldr); } sub _bib_format { # rec my ($marcrec,$ldr)=@_; my $rldr=$marcrec->_unpack_ldr($ldr); my ($type,$bib_lvl) = ($rldr->{'Type'},$rldr->{'BLvl'}); return "UNKNOWN (Type $type Bib_Lvl $bib_lvl)" unless ($type=~/[abcdefgijkmprot]/ && (($bib_lvl eq "") or $bib_lvl=~/[abcdms]/) ); return "BOOKS" if ( ( ($type eq "a") && !($bib_lvl =~/[bs]/) ) or $type eq "t" or $type eq "b" ); #$type b is obsolete, 'tho. return "SERIALS" if ( ($type eq "a") && ($bib_lvl =~/[bs]/) ); return "COMPUTER_FILES" if ($type =~/m/); return "MAPS" if ($type =~/[ef]/); return "MUSIC" if ($type =~/[cdij]/); return "VIS" if ($type =~/[gkro]/); return "MIX" if ($type =~/p/); return "UNKNOWN (Type $type Bib_Lvl $bib_lvl) ??"; # Shouldn't happen } #################################################################### #Takes a record number. # #Returns the unpacked 008 as a ref to hash. Installs ref in $self. # #################################################################### sub unpack_008 { # rec my ($marcrec) = @_; my ($ff_string) = $marcrec->getfirstvalue({field=>'008'}); my $bib_format = $marcrec->bib_format(); my $rh008= $marcrec->_unpack_008($ff_string,$bib_format); $marcrec->{unp_008}=$rh008; return $rh008; } sub _unpack_008 { # rec my ($marcrec,$ff_string,$bib_format) = @_; my %ans=(); my $ff_templ=$FF_TEMPLATE{$bib_format}; my $raff_fields=$FF_FIELDS{$bib_format}; if ($bib_format =~/UNKNOWN/) { mycarp "Format is $bib_format"; return; } my @fields=unpack($ff_templ,$ff_string); for (@{$raff_fields}) { $ans{$_}=shift @fields; } return \%ans; } #################################################################### #Takes a record number. # #Returns the unpacked 008 as a ref to hash from the ref in $self. # #Does not overwrite hash from 008 field. # #################################################################### sub get_hash_008 { # rec my ($marcrec)=@_; return undef unless exists($marcrec->{unp_008}); return $marcrec->{unp_008}; } #################################################################### #Takes a record number. Flushes hashes to 008 and ldr. # #Updates the 008 field from an installed fixed field hash. #Returns undef unless there is a hash, else returns the 008 field # #################################################################### sub pack_008 { # rec my ($marcrec) = @_; $marcrec->pack_ldr(); my $ldr = $marcrec->ldr(); my $rhff = $marcrec->get_hash_008(); return undef unless $rhff; my $ff_string = $marcrec->_pack_008($ldr,$rhff); $marcrec->updatefirst({field=>'008'},$ff_string); return $ff_string; } #################################################################### #Takes LDR and ref to hash of unpacked 008 # #Returns string version of 008 *without* newlines. # #################################################################### sub _pack_008 { # rec my ($marcrec,$ldr,$rhff) = @_; my $bib_format = $marcrec->_bib_format($ldr); my $ans = ""; my @fields = (); for (@{$FF_FIELDS{$bib_format}}) { push @fields, $rhff->{$_}; } $ans = pack($FF_TEMPLATE{$bib_format},@fields); return $ans; } #################################################################### # as_string returns a newline-\c^ separated version of the record. # Subclasses may need to override this. If so, to make Tie happy, # they should override from_string. 000 is ldr. #################################################################### sub as_string { my $marcrec=shift; my $SEP = "\cJ"; #unix newline my $ans = ""; for (@{$marcrec->{'array'}}) { my $tag = $_->[0]; if ($tag < 10) { $ans .= "$tag $_->[1]$SEP"; next; } $ans .= "$tag $_->[1]$_->[2] "; foreach (my $i=3; $i<$#$_; $i+=2) { $ans .="\c_$_->[$i]$_->[$i+1]"; } $ans .=$SEP; } return $ans; } #################################################################### # from_string takes a newline-\c^ separated version of the record # and replaces the {array} information from that information. # Subclasses may need to override this. If so, to make Tie happy, # they should override as_string. 000 is ldr. #################################################################### sub from_string { my $marcrec=shift; my $string = shift; my $do_rebuild_map = shift; my $SEP = "\cJ"; #unix newline my @lines = split /$SEP/,$string; @{$marcrec->{'array'}}=(); for (@lines) { next if /^\s*$/; my $tag = substr($_,0,3); if ($tag < 10) { my $contents = substr($_,4); push @{$marcrec->{'array'}}, [$tag, $contents]; next; } my ($i1,$i2,$sub_string) = (substr($_,4,1),substr($_,5,1),substr($_,7)); my @field = ($tag,$i1,$i2); my @subfields = split /\c_(.)/,$sub_string; shift @subfields if $subfields[0] eq ''; # feature of split. push @field,@subfields; push @{$marcrec->{'array'}}, [@field]; } $marcrec->rebuild_map_all() if $do_rebuild_map; } 1; # so the require or use succeeds __END__ #################################################################### # D O C U M E N T A T I O N # #################################################################### =pod =head1 NAME MARC.pm - Perl extension to manipulate MAchine Readable Cataloging records. =head1 SYNOPSIS use MARC; # constructors $x=MARC->new(); $x=MARC->new("filename","fileformat"); $x->openmarc({file=>"makrbrkr.mrc",'format'=>"marcmaker", increment=>"5", lineterm=>"\n", charset=>\%char_hash}); $record_num=$x->createrecord({leader=>"00000nmm 2200000 a 4500"}); # input/output operations $y=$x->nextmarc(10); # increment $x->closemarc(); print $x->marc_count(); $x->deletemarc({record=>'2',field=>'110'}); $y=$x->selectmarc(['4','21-50','60']); # character translation my %inc = %{$x->usmarc_default()}; # MARCMaker input charset my %outc = %{$x->ustext_default()}; # MARCBreaker output charset # data queries @records = $x->searchmarc({field=>"245"}); @records = $x->searchmarc({field=>"260",subfield=>"c", regex=>"/19../"}); @records = $x->searchmarc({field=>"245",notregex=>"/huckleberry/i"}); @results = $x->getvalue({record=>'12',field=>'856',subfield=>'u'}); # header and control field operations $rldr = $x->unpack_ldr($record); print "Desc is $rldr->{Desc}"; next if ($x->bib_format($record) eq 'SERIALS'); $rff = $x->unpack_008($record); last if ($rff->{'Date1'}=~/00/ or $rff->{'Date2'}=~/00/); # data modifications $x->addfield({record=>"2", field=>"245", i1=>"1", i2=>"4", ordered=>'y', value=> [a=>"The adventures of Huckleberry Finn /", c=>"Mark Twain ; illustrated by E.W. Kemble."]}); my $update245 = {field=>'245',record=>2,ordered=>'y'}; my @u245 = $x->getupdate($update245); $x->deletemarc($update245); $x->addfield($update245, @u245_modified); # outputs $y = $x->output({'format'=>"marcmaker", charset=>\%outc}); $x->output({file=>">>my_text.txt",'format'=>"ascii",record=>2}); $x->output({file=>">my_marcmaker.mkr",'format'=>"marcmaker", nolinebreak=>'y',lineterm=>'\n'}); $x->output({file=>">titles.html",'format'=>"html", 245=>"Title: "}); # manipulation of individual marc records. @recs = $x[1..$#$x]; grep {$_->unpack_ldr() && 0} @recs; @LCs = grep {$_->unp_ldr{Desc} eq 'a' && $_->getvalue({field=>'040'}) =~/DLC\c_.DLC/} @recs; foreach my $rec (@LCs) { print $rec->output({format=>'usmarc'}); } # manipulation as strings. foreach my $rec (@LCs) { my $stringvar = $rec->as_string(); $stringvar=~s[^( 100\s # main entries of this stripe.. ..\s # (don't care about indicators) \c_.\s* )(\S) # take the first letter.. ] [ ${1}uc($2) # and upcase it. All authors have # upcase first letters in my library. ]xm; # x means 'ignore whitespace and allow # embedded comments'. $rec->from_string($stringvar); my ($i2,$article) = $stringvar =~/245 .(.) \c_.(.{0,9})/; $article = substr($article,0,$i2) if $i2=~/\d/; print "article $article is not common" unless $COMMON_ARTS{$article}; } =head1 DESCRIPTION MARC.pm is a Perl 5 module for reading in, manipulating, and outputting bibliographic records in the I format. You will need to have Perl 5.004 or greater for MARC.pm to work properly. Since it is a Perl module you use MARC.pm from one of your own Perl scripts. To see what sorts of conversions are possible you can try out a web interface to MARC.pm which will allow you to upload MARC files and retrieve the results (for details see the section below entitled "Web Interface"). However, to get the full functionality you will probably want to install MARC.pm on your server or PC. MARC.pm can handle both single and batches of MARC records. The limit on the number of records in a batch is determined by the memory capacity of the machine you are running. If memory is an issue for you MARC.pm will allow you to read in records from a batch gradually. MARC.pm also includes a variety of tools for searching, removing, and even creating records from scratch. =head2 Types of Conversions: =over 4 =item * MARC -> ASCII : separates the MARC fields out into separate lines =item * MARC <-> MARCMaker : The MARCMaker format is a format that was developed by the I for use with their DOS based I and I utilities. This format is particularly useful for making global changes (ie. with a text editor's search and replace) and then converting back to MARC (MARC.pm will read properly formatted MARCMaker records). For more information about the MARCMaker format see http://lcweb.loc.gov/marc/marcsoft.html =item * MARC -> HTML : The MARC to HTML conversion creates an HTML file from the fields and field labels that you supply. You could possibly use this to create HTML bibliographies from a batch of MARC records. =item * MARC E-E XML : XML support is handled by MARC::XML which is a subclass of MARC.pm and is also available for download from the CPAN. =item * MARC -> URLS : This conversion will extract URLs from a batch of MARC records. The URLs are found in the 856 field, subfield u. The HTML page that is generated can then be used with link-checking software to determine which URLs need to be repaired. Hopefully library system vendors will soon support this activity soon and make this conversion unecessary! =back =head2 Downloading and Installing =over 4 =item Download The module is provided in standard CPAN distribution format. It will extract into a directory MARC-version with any necessary subdirectories. Change into the MARC top directory. Download the latest version from http://www.cpan.org/modules/by-module/MARC/ =item Unix perl Makefile.PL make make test make install =item Win9x/WinNT/Win2000 perl Makefile.PL perl test.pl perl install.pl =item Test Once you have installed, you can check if Perl can find it. Change to some other directory and execute from the command line: perl -e "use MARC" If you do not get any response that means everything is OK! If you get an error like I. then Perl is not able to find MARC.pm--double check that the file copied it into the right place during the install. =back =head2 Todo =over 4 =item * Support for other MARC formats (UKMARC, FINMARC, etc). =item * Create a map and instructions for using and extending the MARC.pm data structure. =item * Develop better error catching mechanisms. =item * Support for MARC E-E Unicode character conversions. =item * MARC E-E EAD (Encoded Archival Description) conversion? =item * MARC E-E DC/RDF (Dublin Core Metadata encoded in the Resource Description Framework)? =back =head2 Web Interface A web interface to MARC.pm is available at http://libstaff.lib.odu.edu/cgi-bin/marc.cgi where you can upload records and observe the results. If you'd like to check out the cgi script take a look at http://libstaff.lib.odu.edu/depts/systems/iii/scripts/MARCpm/marc-cgi.txt However, to get the full functionality you will want to install MARC.pm on your server or PC. =head2 Option Templates A MARC record is a complex structure. Hence, most of the methods have a number of options. Since a series of operations frequently uses many the same options for each method, you can create a single variable that forms a "template" for the desired options. The variable points to a hash - and the hash keys have been selected so the same hash works for all of the related methods. my $loc852 = {record=>1, field=>'852', ordered=>'y'}; my ($found) = $x->searchmarc($loc852); if (defined $found) { my @m852 = $x->getupdate($loc852); $x->deletemarc($loc852); # change @m852 as desired $x->updaterecord($loc852, @m852fix); } else { $x->addfield($loc852, @m852new); } The following methods are specifically designed to work together using I