3 # Script for handling import of MARC data into Koha db
6 # Koha library project www.koha.org
8 # Licensed under the GPL
12 # standard or CPAN modules used
27 # HTML colors for alternating lines
32 '001' => 'Control number',
33 '003' => 'Control number identifier',
34 '005' => 'Date and time of latest transaction',
35 '006' => 'Fixed-length data elements -- additional material characteristics',
36 '007' => 'Physical description fixed field',
37 '008' => 'Fixed length data elements',
42 '037' => 'Source of acquisition',
43 '040' => 'Cataloging source',
44 '041' => 'Language code',
45 '043' => 'Geographic area code',
46 '050' => 'Library of Congress call number',
47 '060' => 'National Library of Medicine call number',
48 '082' => 'Dewey decimal call number',
49 '100' => 'Main entry -- Personal name',
50 '110' => 'Main entry -- Corporate name',
51 '130' => 'Main entry -- Uniform title',
52 '240' => 'Uniform title',
53 '245' => 'Title statement',
54 '246' => 'Varying form of title',
55 '250' => 'Edition statement',
56 '256' => 'Computer file characteristics',
57 '260' => 'Publication, distribution, etc.',
58 '263' => 'Projected publication date',
59 '300' => 'Physical description',
60 '306' => 'Playing time',
61 '440' => 'Series statement / Added entry -- Title',
62 '490' => 'Series statement',
63 '500' => 'General note',
64 '504' => 'Bibliography, etc. note',
65 '505' => 'Formatted contents note',
66 '508' => 'Creation/production credits note',
67 '510' => 'Citation/references note',
68 '511' => 'Participant or performer note',
69 '520' => 'Summary, etc. note',
70 '521' => 'Target audience note (ie age)',
71 '530' => 'Additional physical form available note',
72 '538' => 'System details note',
73 '586' => 'Awards note',
74 '600' => 'Subject added entry -- Personal name',
75 '610' => 'Subject added entry -- Corporate name',
76 '650' => 'Subject added entry -- Topical term',
77 '651' => 'Subject added entry -- Geographic name',
78 '656' => 'Index term -- Occupation',
79 '700' => 'Added entry -- Personal name',
80 '710' => 'Added entry -- Corporate name',
81 '730' => 'Added entry -- Uniform title',
82 '740' => 'Added entry -- Uncontrolled related/analytical title',
83 '800' => 'Series added entry -- Personal name',
84 '830' => 'Series added entry -- Uniform title',
86 '856' => 'Electronic location and access',
89 # tag, subfield, field name, repeats, striptrailingchars
91 '010'=>{'a'=>{name=> 'lccn', rpt=>0 }},
92 '015'=>{'a'=>{name=> 'lccn', rpt=>0 }},
93 '020'=>{'a'=>{name=> 'isbn', rpt=>0 }},
94 '022'=>{'a'=>{name=> 'issn', rpt=>0 }},
95 '082'=>{'a'=>{name=> 'dewey', rpt=>0 }},
96 '100'=>{'a'=>{name=> 'author', rpt=>0, striptrail=>',:;/-' }},
97 '245'=>{'a'=>{name=> 'title', rpt=>0, striptrail=>',:;/' },
98 'b'=>{name=> 'subtitle', rpt=>0, striptrail=>',:;/' }},
99 '260'=>{'a'=>{name=> 'place', rpt=>0, striptrail=>',:;/-' },
100 'b'=>{name=> 'publisher', rpt=>0, striptrail=>',:;/-' },
101 'c'=>{name=> 'year' , rpt=>0, striptrail=>'.,:;/-' }},
102 '300'=>{'a'=>{name=> 'pages', rpt=>0, striptrail=>',:;/-' },
103 'c'=>{name=> 'size', rpt=>0, striptrail=>',:;/-' }},
104 '362'=>{'a'=>{name=> 'volume-number', rpt=>0 }},
105 '440'=>{'a'=>{name=> 'seriestitle', rpt=>0, striptrail=>',:;/' },
106 'v'=>{name=> 'volume-number',rpt=>0 }},
107 '490'=>{'a'=>{name=> 'seriestitle', rpt=>0, striptrail=>',:;/' },
108 'v'=>{name=> 'volume-number',rpt=>0 }},
109 '700'=>{'a'=>{name=> 'addtional-author-illus',rpt=>1, striptrail=>',:;/' }},
110 '5xx'=>{'a'=>{name=> 'notes', rpt=>1 }},
111 '65x'=>{'a'=>{name=> 'subject', rpt=>1, striptrail=>'.,:;/-' }},
118 my $userid=$ENV{'REMOTE_USER'};
125 print $input->header;
127 print startmenu('acquisitions');
129 # Process input parameters
130 my $file=$input->param('file');
131 my $menu = $input->param('menu');
133 if ($input->param('z3950queue')) {
134 AcceptZ3950Queue($dbh,$input);
137 if ($input->param('uploadmarc')) {
138 AcceptMarcUpload($dbh,$input)
141 if ($input->param('insertnewrecord')) {
142 # Add biblio item, and set up menu for adding item copies
143 my ($biblionumber,$biblioitemnumber)=AcceptBiblioitem($dbh,$input);
144 ItemCopyForm($dbh,$input,$biblionumber,$biblioitemnumber);
151 if ($input->param('newitem')) {
153 &AcceptItemCopy($dbh,$input);
157 ProcessFile($dbh,$input);
161 if ($menu eq 'z3950') { z3950menu($dbh,$input); last SWITCH; }
162 if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; }
163 if ($menu eq 'manual') { manual(); last SWITCH; }
173 # A MARC file has been specified; process it for review form
189 my $splitchar=chr(29);
191 requireDBI($dbh,"ProcessFile");
193 print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
194 my $qisbn=$input->param('isbn');
195 my $qissn=$input->param('issn');
196 my $qlccn=$input->param('lccn');
197 my $qcontrolnumber=$input->param('controlnumber');
199 # See if a particular result item was specified
200 if ($qisbn || $qissn || $qlccn || $qcontrolnumber) {
201 print "<a href=$ENV{'SCRIPT_NAME'}>New File</a><hr>\n";
206 if ($file=~/Z-(\d+)/) {
208 my $resultsid=$input->param('resultsid');
209 my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
211 ($data) = $sth->fetchrow;
213 my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
215 ($data) = $sth->fetchrow;
221 foreach $record (split(/$splitchar/, $data)) {
224 $bib, # hash ref to named fields
225 $fieldlist, # list ref
226 $lccn, $isbn, $issn, $dewey,
227 $publisher, $publicationyear, $volume,
228 $number, @subjects, $notes, $additionalauthors,
229 $copyrightdate, $seriestitle,
230 $origisbn, $origissn, $origlccn, $origcontrolnumber,
239 my ($lccninput, $isbninput, $issninput, $deweyinput, $authorinput, $titleinput,
240 $placeinput, $publisherinput, $publicationyearinput, $volumeinput,
241 $numberinput, $notesinput, $additionalauthorsinput,
242 $illustratorinput, $copyrightdateinput, $seriestitleinput,
262 ($fieldlist)=parsemarcfileformat($record );
264 $bib=extractmarcfields($fieldlist );
266 print "Title=$bib->{title}\n" if $debug;
268 $marctext=FormatMarcText($fieldlist);
270 $controlnumber =$bib->{controlnumber};
274 $publisher =$bib->{publisher};
275 $publicationyear =$bib->{publicationyear};
276 $copyrightdate =$bib->{copyrightdate};
278 $volume =$bib->{volume};
279 $number =$bib->{number};
280 $seriestitle =$bib->{seriestitle};
281 $additionalauthors =$bib->{additionalauthors};
282 $notes =$bib->{notes};
284 $titleinput=$input->textfield(-name=>'title', -default=>$bib->{title}, -size=>40);
285 $marcinput=$input->hidden(-name=>'marc', -default=>$marc);
286 $subtitleinput=$input->textfield(-name=>'subtitle', -default=>$bib->{subtitle}, -size=>40);
287 $authorinput=$input->textfield(-name=>'author', -default=>$bib->{author});
288 $illustratorinput=$input->textfield(-name=>'illustrator',
289 -default=>$bib->{illustrator});
290 $additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
293 foreach ( @{$bib->{subject} } ) {
295 print "<PRE>form subject=$subject</PRE>\n" if $debug;
297 $subjectinput=$input->textarea(-name=>'subject',
298 -default=>$subject, -rows=>4, -cols=>40);
300 $noteinput=$input->textarea(-name=>'notes',
301 -default=>$notes, -rows=>4, -cols=>40, -wrap=>'physical');
302 $copyrightinput=$input->textfield(-name=>'copyrightdate', -default=>$copyrightdate);
303 $seriestitleinput=$input->textfield(-name=>'seriestitle', -default=>$seriestitle);
304 $volumeinput=$input->textfield(-name=>'volume', -default=>$volume);
305 $volumedateinput=$input->textfield(-name=>'volumedate', -default=>$volumedate);
306 $volumeddescinput=$input->textfield(-name=>'volumeddesc', -default=>$volumeddesc);
307 $numberinput=$input->textfield(-name=>'number', -default=>$number);
308 $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
309 $issninput=$input->textfield(-name=>'issn', -default=>$issn);
310 $lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
311 $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
312 $deweyinput=$input->textfield(-name=>'dewey', -default=>$bib->{dewey});
313 $cleanauthor=$bib->{author};
314 $cleanauthor=~s/[^A-Za-z]//g;
315 $subclassinput=$input->textfield(-name=>'subclass', -default=>uc(substr($cleanauthor,0,3)));
316 $publisherinput=$input->textfield(-name=>'publishercode', -default=>$publisher);
317 $pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
318 $placeinput=$input->textfield(-name=>'place', -default=>$bib->{place});
319 $pagesinput=$input->textfield(-name=>'pages', -default=>$bib->{pages});
320 $sizeinput=$input->textfield(-name=>'size', -default=>$bib->{size});
321 $fileinput=$input->hidden(-name=>'file', -default=>$file);
322 $origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
323 $origissn=$input->hidden(-name=>'origissn', -default=>$issn);
324 $origlccn=$input->hidden(-name=>'origlccn', -default=>$lccn);
325 $origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
327 #print "<PRE>getting itemtypeselect</PRE>\n";
328 $itemtypeselect=&getkeytableselectoptions(
329 $dbh, 'itemtypes', 'itemtype', 'description', 1);
330 #print "<PRE>it=$itemtypeselect</PRE>\n";
332 ($qissn) || ($qissn='NIL');
333 ($qlccn) || ($qlccn='NIL');
334 ($qisbn) || ($qisbn='NIL');
335 ($qcontrolnumber) || ($qcontrolnumber='NIL');
336 $controlnumber=~s/\s+//g;
338 unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) {
339 #print "<PRE>Skip record $isbn $issn $lccn </PRE>\n";
346 Full MARC Record available at bottom
349 <tr><td>Title</td><td>$titleinput</td></tr>
350 <tr><td>Subtitle</td><td>$subtitleinput</td></tr>
351 <tr><td>Author</td><td>$authorinput</td></tr>
352 <tr><td>Additional Authors</td><td>$additionalauthorsinput</td></tr>
353 <tr><td>Illustrator</td><td>$illustratorinput</td></tr>
354 <tr><td>Copyright</td><td>$copyrightinput</td></tr>
355 <tr><td>Series Title</td><td>$seriestitleinput</td></tr>
356 <tr><td>Volume</td><td>$volumeinput</td></tr>
357 <tr><td>Number</td><td>$numberinput</td></tr>
358 <tr><td>Volume Date</td><td>$volumedateinput</td></tr>
359 <tr><td>Volume Description</td><td>$volumeddescinput</td></tr>
360 <tr><td>Subject</td><td>$subjectinput</td></tr>
361 <tr><td>Notes</td><td>$noteinput</td></tr>
362 <tr><td>Item Type</td><td><select name=itemtype>$itemtypeselect</select></td></tr>
363 <tr><td>ISBN</td><td>$isbninput</td></tr>
364 <tr><td>ISSN</td><td>$issninput</td></tr>
365 <tr><td>LCCN</td><td>$lccninput</td></tr>
366 <tr><td>Dewey</td><td>$deweyinput</td></tr>
367 <tr><td>Subclass</td><td>$subclassinput</td></tr>
368 <tr><td>Publication Year</td><td>$pubyearinput</td></tr>
369 <tr><td>Publisher</td><td>$publisherinput</td></tr>
370 <tr><td>Place</td><td>$placeinput</td></tr>
371 <tr><td>Pages</td><td>$pagesinput</td></tr>
372 <tr><td>Size</td><td>$sizeinput</td></tr>
375 <input type=hidden name=insertnewrecord value=1>
387 # No result item specified, list results
388 ListFileRecords($dbh,$input);
392 sub ListFileRecords {
404 $data, # records in MARC file format
414 my ($numrecords,$resultsid,$data,$startdate,$enddate);
416 requireDBI($dbh,"ListFileRecords");
418 # File can be z3950 search query or uploaded MARC data
421 if ($file=~/Z-(\d+)/) {
422 # This is a z3950 search
425 # This is a Marc upload
426 $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
428 ($data, $name) = $sth->fetchrow;
429 $recordsource="from $name";
435 <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
437 <table border=0 cellpadding=10 cellspacing=0>
438 <tr><th bgcolor=black>
439 <font color=white>Select a Record to Import $recordsource</font>
441 <tr><td bgcolor=#dddddd>
444 if ($file=~/Z-(\d+)/) {
445 # This is a z3950 search
447 my $id=$1; # search query id number
449 my $starttimer=time();
452 select z3950results.numrecords,z3950results.id,z3950results.results,
453 z3950results.startdate,z3950results.enddate,server
454 from z3950queue left outer join z3950results
455 on z3950queue.id=z3950results.queryid
456 where z3950queue.id=?
461 # loop through all servers in search results
462 while ( ($numrecords,$resultsid,$data,
463 $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
464 my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
465 #print "server=$serverstring\n";
467 print "<a name=SERVER-$srvid></a> " .
468 &z3950servername($dbh,$srvid,"$server/$database") . "\n";
470 my $startrecord=$input->param("ST-$srvid");
471 ($startrecord) || ($startrecord='0');
472 my $serverplaceholder='';
473 foreach ($input->param) {
474 (next) unless (/ST-(.+)/);
476 (next) if ($serverid eq $srvid);
477 my $place=$input->param("ST-$serverid");
478 $serverplaceholder.="\&ST-$serverid=$place";
483 if ($startrecord>0) {
484 $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
487 $highest=$startrecord+10;
488 ($highest>$numrecords) && ($highest=$numrecords);
489 if ($numrecords>$startrecord+10) {
490 $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
492 print "<font size=-1>[Viewing ".($startrecord+1)." to ".$highest." of $numrecords records] $previous | $next </font><br>\n";
493 my $stj=$dbh->prepare("update z3950results
494 set highestseen=? where id=?");
495 $stj->execute($startrecord+10,$resultsid);
502 print "<font color=red>Search still pending...</font>";
503 } elsif ($enddate == 0) {
505 my $elapsed=$now-$startdate;
508 $elapsedtime=sprintf "%d minutes",($elapsed/60);
510 $elapsedtime=sprintf "%d seconds",$elapsed;
512 print "<font color=red>processing... ($elapsedtime)</font>";
513 } elsif ($numrecords) {
514 my @records=parsemarcfileformat($data);
516 for ($i=$startrecord; $i<$startrecord+10; $i++) {
517 $data.=$records[$i].$splitchar;
519 @records=parsemarcdata($data);
521 foreach $record (@records) {
523 #(next) unless ($counter>=$startrecord && $counter<=$startrecord+10);
524 my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $controlnumber);
525 foreach $field (@$record) {
526 if ($field->{'tag'} eq '001') {
527 $controlnumber=$field->{'indicator'};
529 if ($field->{'tag'} eq '010') {
530 $lccn=$field->{'subfields'}->{'a'};
532 ($lccn) = (split(/\s+/, $lccn))[0];
534 if ($field->{'tag'} eq '015') {
535 $lccn=$field->{'subfields'}->{'a'};
538 ($lccn) = (split(/\s+/, $lccn))[0];
540 if ($field->{'tag'} eq '020') {
541 $isbn=$field->{'subfields'}->{'a'};
542 ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
545 if ($field->{'tag'} eq '022') {
546 $issn=$field->{'subfields'}->{'a'};
548 ($issn) = (split(/\s+/, $issn))[0];
550 if ($field->{'tag'} eq '100') {
551 $author=$field->{'subfields'}->{'a'};
553 if ($field->{'tag'} eq '245') {
554 $title=$field->{'subfields'}->{'a'};
556 $subtitle=$field->{'subfields'}->{'b'};
560 my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
561 my $q_issn=$dbh->quote((($issn) || ('NIL')));
562 my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
563 my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
564 my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
570 $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
575 ($author) && ($author="by $author");
577 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&isbn=$isbn>$title $subtitle $author</a> $donetext<br>\n";
579 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&lccn=$lccn>$title $subtitle $author</a> $donetext<br>\n";
581 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&issn=$issn>$title $subtitle $author</a><br> $donetext\n";
582 } elsif ($controlnumber) {
583 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&controlnumber=$controlnumber>$title $subtitle $author</a><br> $donetext\n";
585 print "Error: Contact steve regarding $title by $author<br>\n";
590 if ( $records[$i] ) {
591 &PrintResultRecordLink($dbh,$records[$i],$resultsid);
596 print "No records returned.<p>\n";
600 my $elapsed=time()-$starttimer;
601 print "<hr>It took $elapsed seconds to process this page.\n";
603 print "<b>No results found for query $id</b>\n";
606 # This is an uploaded Marc record
608 my @records=parsemarcfileformat($data);
609 foreach $record (@records) {
610 &PrintResultRecordLink($dbh,$record,'');
612 } # if z3950 or marc upload
613 print "</td></tr></table>\n";
614 } # sub ListFileRecords
617 sub z3950servername {
621 $srvid, # server id number
628 requireDBI($dbh,"z3950servername");
630 my $sti=$dbh->prepare("select name
633 $sti->execute($srvid);
635 ($longname)=$sti->fetchrow;
638 $longname="$default";
641 } # sub z3950servername
643 sub PrintResultRecordLink {
645 my ($dbh,$record,$resultsid)=@_; # input
649 $bib, # hash ref to named fields
650 $searchfield, $searchvalue,
655 requireDBI($dbh,"PrintResultRecordLink");
657 $bib=extractmarcfields($record);
659 $sth=$dbh->prepare("select *
661 where isbn=? or issn=? or lccn=? ");
662 $sth->execute($bib->{isbn},$bib->{issn},$bib->{lccn});
668 ($bib->{author}) && ($bib->{author}="by $bib->{author}");
671 foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
672 if ( defined $bib->{$fieldname} ) {
673 $searchfield=$fieldname;
674 $searchvalue=$bib->{$fieldname};
675 } # if defined fieldname
678 if ( $searchfield ) {
679 print "<a href=$ENV{'SCRIPT_NAME'}?file=$file" .
680 "&resultsid=$resultsid" .
681 "&$searchfield=$searchvalue" .
682 "&searchfield=$searchfield" .
683 "&searchvalue=$searchvalue" .
684 ">$bib->{title} $bib->{author}</a>" .
687 print "Error: Problem with $bib->{title} $bib->{author}<br>\n";
689 } # sub PrintResultRecordLink
692 sub extractmarcfields {
696 $record, # pointer to list of MARC field hashes.
697 # Example: $record->[0]->{'tag'} = '100' # Author
698 # $record->[0]->{'subfields'}->{'a'} = subfieldvalue
702 my $bib; # pointer to hash of named output fields
703 # Example: $bib->{'author'} = "Twain, Mark";
710 $subfield, # Marc subfield [a-z]
711 $fieldname, # name of field "author", "title", etc.
712 $strip, # chars to remove from end of field
713 $stripregex, # reg exp pattern
715 my ($lccn, $isbn, $issn,
716 $publicationyear, @subjects, $subject,
718 $notes, $additionalauthors, $illustrator, $copyrightdate,
719 $s, $subdivision, $subjectsubfield,
722 print "<PRE>\n" if $debug;
724 if ( ref($record) eq "ARRAY" ) {
725 foreach $field (@$record) {
727 # Check each subfield in field
728 foreach $subfield ( keys %{$field->{subfields}} ) {
729 # see if it is defined in our Marc to koha mapping table
730 if ( $fieldname=$tagmap{ $field->{'tag'} }->{$subfield}->{name} ) {
731 # Yes, so keep the value
732 if ( ref($field->{'subfields'}->{$subfield} ) eq 'ARRAY' ) {
733 # if it was an array, just keep first element.
734 $bib->{$fieldname}=$field->{'subfields'}->{$subfield}[0];
736 $bib->{$fieldname}=$field->{'subfields'}->{$subfield};
738 print "$field->{'tag'} $subfield $fieldname=$bib->{$fieldname}\n" if $debug;
739 # see if this field should have trailing chars dropped
740 if ($strip=$tagmap{ $field->{'tag'} }->{$subfield}->{striptrail} ) {
741 $strip=~s//\\/; # backquote each char
742 $stripregex='[ ' . $strip . ']+$'; # remove trailing spaces also
743 $bib->{$fieldname}=~s/$stripregex//;
745 print "Found subfield $field->{'tag'} $subfield " .
746 "$fieldname = $bib->{$fieldname}\n" if $debug;
752 if ($field->{'tag'} eq '001') {
753 $bib->{controlnumber}=$field->{'indicator'};
755 if ($field->{'tag'} eq '015') {
756 $bib->{lccn}=$field->{'subfields'}->{'a'};
757 $bib->{lccn}=~s/^\s*//;
758 $bib->{lccn}=~s/^C//;
759 ($bib->{lccn}) = (split(/\s+/, $bib->{lccn}))[0];
763 if ($field->{'tag'} eq '260') {
765 $publicationyear=$field->{'subfields'}->{'c'};
766 if ($publicationyear=~/c(\d\d\d\d)/) {
769 if ($publicationyear=~/[^c](\d\d\d\d)/) {
771 } elsif ($copyrightdate) {
772 $publicationyear=$copyrightdate;
774 $publicationyear=~/(\d\d\d\d)/;
778 if ($field->{'tag'} eq '700') {
779 my $name=$field->{'subfields'}->{'a'};
780 if ($field->{'subfields'}->{'e'}!~/ill/) {
781 $additionalauthors.="$name\n";
786 if ($field->{'tag'} =~/^5/) {
787 $notes.="$field->{'subfields'}->{'a'}\n";
789 if ($field->{'tag'} =~/65\d/) {
791 my $subject=$field->{'subfields'}->{'a'};
793 print "Subject=$subject\n" if $debug;
794 foreach $subjectsubfield ( 'x','y','z' ) {
795 if ($subdivision=$field->{'subfields'}->{$subjectsubfield}) {
796 if ( ref($subdivision) eq 'ARRAY' ) {
797 foreach $s (@$subdivision) {
800 } # foreach subdivision
802 $subdivision=~s/\.$//;
803 $subject.=" -- $subdivision";
805 } # if subfield exists
807 print "Subject=$subject\n" if $debug;
808 push @subjects, $subject;
813 ($publicationyear ) && ($bib->{publicationyear}=$publicationyear );
814 ($copyrightdate ) && ($bib->{copyrightdate}=$copyrightdate );
815 ($additionalauthors ) && ($bib->{additionalauthors}=$additionalauthors );
816 ($illustrator ) && ($bib->{illustrator}=$illustrator );
817 ($notes ) && ($bib->{notes}=$notes );
818 ($#subjects ) && ($bib->{subject}=\@subjects );
821 $bib->{dewey}=~s/\///g; # drop any slashes
823 ($bib->{lccn}) = (split(/\s+/, $bib->{lccn}))[0]; # only keep first word
825 $bib->{isbn}=~s/[^\d]*//g; # drop non-digits
827 $bib->{issn}=~s/^\s*//;
828 ($bib->{issn}) = (split(/\s+/, $bib->{issn}))[0];
830 if ( $bib->{'volume-number'} ) {
831 if ($bib->{'volume-number'}=~/(\d+).*(\d+)/ ) {
835 $bib->{volume}=$bib->{'volume-number'};
837 delete $bib->{'volume-number'};
841 print "Error: extractmarcfields: input ref $record is " .
842 ref($record) . " not ARRAY. Contact sysadmin.\n";
844 print "</PRE>\n" if $debug;
848 } # sub extractmarcfields
849 #---------------------------------
865 $resultstatus, $statuscolor,
866 $id, $term, $type, $done,
867 $startdate, $enddate, $servers,
871 requireDBI($dbh,"z3950menu");
873 print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
874 print "<table border=0><tr><td valign=top>\n";
875 print "<h2>Results of Z39.50 searches</h2>\n";
876 print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n" .
879 # Check queued queries
880 $sth=$dbh->prepare("select id,term,type,done,
881 startdate,enddate,servers
886 while ( ($id, $term, $type, $done,
887 $startdate, $enddate, $servers) = $sth->fetchrow) {
893 # See if query produced results
894 $sti=$dbh->prepare("select id,server,startdate,enddate,numrecords,results
902 while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords,$r_marcdata)
905 # It hasn't finished yet
908 # It finished, see how long it took.
909 if ($r_enddate>$realenddate) {
910 $realenddate=$r_enddate;
912 # Snag any title from the results if there were any
913 if ( ! $title && $r_marcdata ) {
914 ($record)=parsemarcfileformat($r_marcdata);
915 $bib=extractmarcfields($record);
916 if ( $bib->{title} ) { $title=$bib->{title} };
920 $totalrecords+=$r_numrecords;
924 $elapsed=time()-$startdate;
925 $resultstatus="Processing...";
928 $elapsed=$realenddate-$startdate;
929 $resultstatus="Done.";
930 $statuscolor="black";
934 $elapsedtime=sprintf "%d minutes",($elapsed/60);
936 $elapsedtime=sprintf "%d seconds",$elapsed;
939 $totalrecords="$totalrecords found.";
943 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>".
945 "<font size=-1 color=$statuscolor>$resultstatus $totalrecords " .
946 "($elapsedtime) $title </font><br>\n";
948 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>
949 $type=$term</a> <font size=-1>Pending</font><br>\n";
952 print "</ul> </td>\n";
953 # End of query listing
955 #------------------------------
957 print "<td valign=top width=30%>\n";
959 my $sth=$dbh->prepare("select id,name,checked
964 while (my ($id, $name, $checked) = $sth->fetchrow) {
965 ($checked) ? ($checked='checked') : ($checked='');
966 $serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n";
968 $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n";
970 my $rand=rand(1000000000);
972 <form action=$ENV{'SCRIPT_NAME'} method=GET>
973 <input type=hidden name=z3950queue value=1>
974 <input type=hidden name=menu value=$menu>
976 <input type=hidden name=test value=testvalue>
977 <input type=hidden name=rand value=$rand>
978 <table border=1 bgcolor=#dddddd>
979 <tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr>
980 <tr><td>Query Term</td><td><input name=query></td></tr>
981 <tr><td colspan=2 align=center>
982 <input type=radio name=type value=isbn checked> ISBN
983 <input type=radio name=type value=lccn > LCCN<br>
984 <input type=radio name=type value=author > Author
985 <input type=radio name=type value=title > Title
986 <input type=radio name=type value=keyword > Keyword</td></tr>
987 <tr><td colspan=2> $serverlist </td></tr>
988 <tr><td colspan=2 align=center> <input type=submit> </td></tr>
993 print "</td></tr></table>\n";
995 #---------------------------------
1001 requireDBI($dbh,"uploadmarc");
1003 print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
1004 my $sth=$dbh->prepare("select id,name from uploadedmarc");
1006 print "<h2>Select a set of MARC records</h2>\n<ul>";
1007 while (my ($id, $name) = $sth->fetchrow) {
1008 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
1012 print "<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb
1013 colspan=2>Upload a set of MARC records</th></tr>\n";
1014 print "<tr><td>Upload a set of MARC records:</td><td>";
1015 print $input->start_multipart_form();
1016 print $input->filefield('uploadmarc');
1020 <input type=hidden name=menu value=$menu>
1021 Name this set of MARC records:</td><td><input type=text
1022 name=name></td></tr>
1023 <tr><td colspan=2 align=center>
1039 <li><a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Z39.50 Search</a>
1040 <li><a href=$ENV{'SCRIPT_NAME'}?menu=uploadmarc>Upload MARC Records</a>
1046 #--------------------------
1047 # Parse MARC data in file format with control-character separators
1048 # May be multiple records.
1049 sub parsemarcfileformat {
1051 # Input is one big text string
1053 # Output is list of records. Each record is list of field hashes
1056 my $splitchar=chr(29);
1057 my $splitchar2=chr(30);
1058 my $splitchar3=chr(31);
1061 foreach $record (split(/$splitchar/, $data)) {
1068 my $leader=substr($record,0,24);
1069 print "<tr><td>Leader:</td><td>$leader</td></tr>\n" if $debug;
1072 'indicator' => $leader ,
1075 $record=substr($record,24);
1076 foreach $field (split(/$splitchar2/, $record)) {
1080 unless ($directory) {
1087 while ($item=substr($directory,0,12)) {
1088 $tag=substr($directory,0,3);
1089 $length=substr($directory,3,4);
1090 $start=substr($directory,7,6);
1091 $directory=substr($directory,12);
1092 $tag{$counter2}=$tag;
1098 $tag=$tag{$tagcounter};
1101 my @subfields=split(/$splitchar3/, $field);
1102 $indicator=$subfields[0];
1103 $field{'indicator'}=$indicator;
1105 unless ($#subfields==0) {
1109 for ($i=1; $i<=$#subfields; $i++) {
1110 my $text=$subfields[$i];
1111 my $subfieldcode=substr($text,0,1);
1112 my $subfield=substr($text,1);
1113 # if this subfield already exists, do array
1114 if ($subfields{$subfieldcode}) {
1115 my $subfieldlist=$subfields{$subfieldcode};
1116 if ( ref($subfieldlist) eq 'ARRAY' ) {
1117 # Already an array, add on to it
1118 print "$tag Adding to array $subfieldcode -- $subfield<br>\n" if $debug;
1119 @subfieldlist=@$subfieldlist;
1120 push (@subfieldlist, $subfield);
1122 # Change simple value to array
1123 print "$tag Arraying $subfieldcode -- $subfield<br>\n" if $debug;
1124 @subfieldlist=($subfields{$subfieldcode}, $subfield);
1127 $subfields{$subfieldcode}=\@subfieldlist;
1129 # subfield doesn't exist yet, keep simple value
1130 $subfields{$subfieldcode}=$subfield;
1133 $field{'subfields'}=\%subfields;
1135 push (@record, \%field);
1136 } # foreach field in record
1137 push (@records, \@record);
1140 print "</pre>" if $debug;
1142 } # sub parsemarcfileformat
1144 #----------------------------
1145 # Accept form results to add query to z3950 queue
1146 sub AcceptZ3950Queue {
1157 requireDBI($dbh,"AcceptZ3950Queue");
1159 my $query=$input->param('query');
1162 if ($input->param('type') eq 'isbn') {
1163 $isbngood=checkvalidisbn($query);
1166 foreach ($input->param) {
1169 if ($server eq 'MAN') {
1170 push @serverlist, "MAN/".$input->param('manualz3950server')."//"
1173 push @serverlist, $server;
1178 addz3950queue($dbh,$input->param('query'), $input->param('type'),
1179 $input->param('rand'), @serverlist);
1181 print "<font color=red size=+1>$query is not a valid ISBN
1182 Number</font><p>\n";
1184 } # sub AcceptZ3950Queue
1186 #---------------------------------------------
1187 sub AcceptMarcUpload {
1194 requireDBI($dbh,"AcceptMarcUpload");
1196 my $name=$input->param('name');
1197 my $data=$input->param('uploadmarc');
1200 ($name) || ($name=$data);
1201 if (length($data)>0) {
1206 my $q_marcrecord=$dbh->quote($marcrecord);
1207 my $q_name=$dbh->quote($name);
1208 my $sth=$dbh->prepare("insert into uploadedmarc
1210 values ($q_marcrecord, $q_name)");
1212 } # sub AcceptMarcUpload
1214 #-------------------------------------------
1215 sub AcceptBiblioitem {
1223 my $biblioitemnumber=0;
1226 requireDBI($dbh,"AcceptBiblioitem");
1228 my $isbn=$input->param('isbn');
1229 my $issn=$input->param('issn');
1230 my $lccn=$input->param('lccn');
1231 my $q_origisbn=$dbh->quote($input->param('origisbn'));
1232 my $q_origissn=$dbh->quote($input->param('origissn'));
1233 my $q_origlccn=$dbh->quote($input->param('origlccn'));
1234 my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
1235 my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
1236 my $q_issn=$dbh->quote((($issn) || ('NIL')));
1237 my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
1238 my $file=$input->param('file');
1240 #my $sth=$dbh->prepare("insert into marcrecorddone values ($q_origisbn, $q_origissn, $q_origlccn, $q_origcontrolnumber)");
1244 print "<a href=$ENV{'SCRIPT_NAME'}?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n";
1246 # See if it already exists
1247 my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
1249 where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
1253 ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
1254 my $title=$input->param('title');
1256 <table border=0 width=50% cellpadding=10 cellspacing=0>
1257 <tr><th bgcolor=black><font color=white>Record already in database</font>
1259 <tr><td bgcolor=#dddddd>$title is already in the database with
1260 biblionumber $biblionumber and biblioitemnumber $biblioitemnumber
1267 # It doesn't exist; add it.
1273 # convert to upper case and split on lines
1274 my $subjectheadings=$input->param('subject');
1275 my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
1277 my $additionalauthors=$input->param('additionalauthors');
1278 my @additionalauthors=split(/[\r\n]+/,uc($additionalauthors));
1280 # Use individual assignments to hash buckets, in case
1281 # any of the input parameters are empty or don't exist
1282 $biblio{title} =$input->param('title');
1283 $biblio{author} =$input->param('author');
1284 $biblio{copyright} =$input->param('copyrightdate');
1285 $biblio{seriestitle} =$input->param('seriestitle');
1286 $biblio{notes} =$input->param('notes');
1287 $biblio{abstract} =$input->param('abstract');
1288 $biblio{subtitle} =$input->param('subtitle');
1290 $biblioitem{volume} =$input->param('volume');
1291 $biblioitem{number} =$input->param('number');
1292 $biblioitem{itemtype} =$input->param('itemtype');
1293 $biblioitem{isbn} =$input->param('isbn');
1294 $biblioitem{issn} =$input->param('issn');
1295 $biblioitem{dewey} =$input->param('dewey');
1296 $biblioitem{subclass} =$input->param('subclass');
1297 $biblioitem{publicationyear} =$input->param('publicationyear');
1298 $biblioitem{publishercode} =$input->param('publishercode');
1299 $biblioitem{volumedate} =$input->param('volumedate');
1300 $biblioitem{volumeddesc} =$input->param('volumeddesc');
1301 $biblioitem{illus} =$input->param('illustrator');
1302 $biblioitem{pages} =$input->param('pages');
1303 $biblioitem{notes} =$input->param('notes');
1304 $biblioitem{size} =$input->param('size');
1305 $biblioitem{place} =$input->param('place');
1306 $biblioitem{lccn} =$input->param('lccn');
1307 $biblioitem{marc} =$input->param('marc');
1309 #print "<PRE>subjects=@subjectheadings</PRE>\n";
1310 #print "<PRE>auth=@additionalauthors</PRE>\n";
1312 ($biblionumber, $biblioitemnumber, $error)=
1313 newcompletebiblioitem($dbh,
1321 print "<H2>Error adding biblio item</H2> $error\n";
1324 my $title=$input->param('title');
1326 <table cellpadding=10 cellspacing=0 border=0 width=50%>
1327 <tr><th bgcolor=black><font color=white>Record entered into database</font></th></tr>
1328 <tr><td bgcolor=#dddddd>$title has been entered into the database with biblionumber
1329 $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
1335 return $biblionumber,$biblioitemnumber;
1336 } # sub AcceptBiblioitem
1342 $input, # CGI input object
1349 requireDBI($dbh,"ItemCopyForm");
1351 my $title=$input->param('title');
1352 my $file=$input->param('file');
1354 # Get next barcode, or pick random one if none exist yet
1355 $sth=$dbh->prepare("select max(barcode) from items");
1357 ($barcode) = $sth->fetchrow;
1360 $barcode=int(rand()*1000000);
1363 my $branchselect=getkeytableselectoptions(
1364 $dbh, 'branches', 'branchcode', 'branchname', 0);
1367 <table border=0 cellpadding=10 cellspacing=0>
1368 <tr><th bgcolor=black>
1369 <font color=white> Add a New Item for $title </font>
1371 <tr><td bgcolor=#dddddd>
1373 <input type=hidden name=newitem value=1>
1374 <input type=hidden name=biblionumber value=$biblionumber>
1375 <input type=hidden name=biblioitemnumber value=$biblioitemnumber>
1376 <input type=hidden name=file value=$file>
1378 <tr><td>BARCODE</td><td><input name=barcode size=10 value=$barcode>
1379 Home Branch: <select name=homebranch> $branchselect </select>
1381 <tr><td>Replacement Price:</td>
1382 <td><input name=replacementprice size=10></td></tr>
1384 <td><textarea name=notes rows=4 cols=40 wrap=physical></textarea>
1388 <input type=submit value="Add Item">
1394 } # sub ItemCopyForm
1396 #---------------------------------------
1397 # Accept form data to add an item copy
1398 sub AcceptItemCopy {
1400 my ( $dbh, $input )=@_;
1404 requireDBI($dbh,"AcceptItemCopy");
1406 my $barcode=$input->param('barcode');
1407 my $replacementprice=($input->param('replacementprice') || 0);
1409 my $sth=$dbh->prepare("select barcode
1412 $sth->execute($barcode);
1414 print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n";
1416 # Insert new item into database
1418 { biblionumber=> $input->param('biblionumber'),
1419 biblioitemnumber=> $input->param('biblioitemnumber'),
1420 itemnotes=> $input->param('notes'),
1421 homebranch=> $input->param('homebranch'),
1422 replacementprice=> $replacementprice,
1427 print "<font color=red>Error: $error </font><p>\n";
1430 print "<table border=1 align=center cellpadding=10>
1431 <tr><td bgcolor=yellow>
1432 Item added with barcode $barcode
1433 </td></tr></table>\n";
1435 } # if barcode exists
1436 } # sub AcceptItemCopy
1439 # Create an HTML option list for a <SELECT> form tag by using
1440 # values from a DB file
1441 sub getkeytableselectoptions {
1446 $tablename, # name of table containing list of choices
1447 $keyfieldname, # column name of code to use in option list
1448 $descfieldname, # column name of descriptive field
1449 $showkey, # flag to show key in description
1451 my $selectclause; # return value
1455 $key, $desc, $orderfieldname,
1459 requireDBI($dbh,"getkeytableselectoptions");
1462 $orderfieldname=$keyfieldname;
1464 $orderfieldname=$descfieldname;
1466 $query= "select $keyfieldname,$descfieldname
1468 order by $orderfieldname ";
1469 print "<PRE>Query=$query </PRE>\n" if $debug;
1470 $sth=$dbh->prepare($query);
1472 while ( ($key, $desc) = $sth->fetchrow) {
1473 if ($showkey) { $desc="$key - $desc"; }
1474 $selectclause.="<option value='$key'>$desc\n";
1475 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1477 return $selectclause;
1478 } # sub getkeytableselectoptions
1480 #---------------------------------
1481 # Add a biblioitem and related data
1482 sub newcompletebiblioitem {
1485 my ( $dbh, # DBI handle
1486 $biblio, # hash ref to biblio record
1487 $biblioitem, # hash ref to biblioitem record
1488 $subjects, # list ref of subjects
1489 $addlauthors, # list ref of additional authors
1492 my ( $biblionumber, $biblioitemnumber, $error); # return values
1497 my $additionalauthor;
1500 requireDBI($dbh,"newcompletebiblioitem");
1502 print "<PRE>Trying to add biblio item Title=$biblio->{title} " .
1503 "ISBN=$biblioitem->{isbn} </PRE>\n" if $debug;
1505 # Make sure master biblio entry exists
1506 ($biblionumber,$error)=getoraddbiblio($dbh, $biblio);
1510 $biblioitem->{biblionumber}=$biblionumber;
1511 $biblioitemnumber=newbiblioitem($biblioitem);
1513 $sth=$dbh->prepare("insert into bibliosubject
1514 (biblionumber,subject)
1516 foreach $subjectheading (@{$subjects} ) {
1517 $sth->execute($biblionumber, $subjectheading)
1518 or $error.=$sth->errstr ;
1522 $sth=$dbh->prepare("insert into additionalauthors
1523 (biblionumber,author)
1525 foreach $additionalauthor (@{$addlauthors} ) {
1526 $sth->execute($biblionumber, $additionalauthor)
1527 or $error.=$sth->errstr ;
1531 # couldn't get biblio
1533 $biblioitemnumber='';
1535 } # if no biblio error
1537 return ( $biblionumber, $biblioitemnumber, $error);
1539 } # sub newcompletebiblioitem
1540 #---------------------------------------
1541 # Find a biblio entry, or create a new one if it doesn't exist.
1542 sub getoraddbiblio {
1543 use strict; # in here until rest cleaned up
1547 $biblio, # hash ref to fields
1558 requireDBI($dbh,"getoraddbiblio");
1560 print "<PRE>Looking for biblio </PRE>\n" if $debug;
1561 $sth=$dbh->prepare("select biblionumber
1563 where title=? and author=?
1564 and copyrightdate=? and seriestitle=?");
1566 $biblio->{title}, $biblio->{author},
1567 $biblio->{copyright}, $biblio->{seriestitle} );
1569 ($biblionumber) = $sth->fetchrow;
1570 print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
1572 # Doesn't exist. Add new one.
1573 print "<PRE>Adding biblio</PRE>\n" if $debug;
1574 ($biblionumber,$error)=&newbiblio($biblio);
1575 if ( $biblionumber ) {
1576 print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
1577 if ( $biblio->{subtitle} ) {
1578 &newsubtitle($biblionumber,$biblio->{subtitle} );
1581 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
1585 return $biblionumber,$error;
1587 } # sub getoraddbiblio
1588 #---------------------------------------
1594 $query, # value to look up
1595 $type, # type of value ("isbn", "lccn", etc).
1597 @z3950list, # list of z3950 servers to query
1606 requireDBI($dbh,"addz3950queue");
1608 # list of servers: entry can be a fully qualified URL-type entry
1609 # or simply just a server ID number.
1611 my $sth=$dbh->prepare("select host,port,db,userid,password
1614 foreach $server (@z3950list) {
1615 if ($server =~ /:/ ) {
1616 push @serverlist, $server;
1618 $sth->execute($server);
1619 my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
1620 push @serverlist, "$server/$host\:$port/$db/$userid/$password";
1625 foreach (@serverlist) {
1630 # Don't allow reinsertion of the same request number.
1631 my $sth=$dbh->prepare("select identifier from z3950queue
1632 where identifier=?");
1633 $sth->execute($requestid);
1634 unless ($sth->rows) {
1635 $sth=$dbh->prepare("insert into z3950queue
1636 (term,type,servers, identifier)
1637 values (?, ?, ?, ?)");
1638 $sth->execute($query, $type, $serverlist, $requestid);
1640 } # sub addz3950queue
1642 #--------------------------------------
1643 sub FormatMarcText {
1648 $fields, # list ref to MARC fields
1658 $subfieldcode,$subfieldvalue,
1662 #return "MARC text here";
1664 $marctext="<table border=0 cellspacing=0>
1665 <tr><th colspan=3 bgcolor=black>
1666 <font color=white>MARC RECORD</font>
1669 foreach $field ( @$fields ) {
1670 ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
1671 $tag=$field->{'tag'};
1672 $label=$tagtext{$tag};
1673 if ( $tag eq 'Leader' ) {
1677 $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
1678 "<td bgcolor=$color valign=top>$tag</td> \n";
1679 if ( ! $field->{'subfields'} ) {
1680 $marctext.="<td bgcolor=$color valign=top>$field->{'indicator'}</td>";
1682 # start another table for subfields
1683 $marctext.="<td bgcolor=$color valign=top>\n " .
1684 " <table border=0 cellspacing=0>\n";
1685 foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
1686 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
1687 if (ref($subfieldvalue) eq 'ARRAY' ) {
1688 # if it's a pointer to array, get the values
1689 @values=@{$subfieldvalue};
1691 @values=( $subfieldvalue );
1692 } # if subfield array
1693 foreach $value ( @values ) {
1694 $marctext.="<tr><td>$subfieldcode </td>" .
1695 "<td>$value</td></tr>\n";
1697 } # foreach subfield
1698 $marctext.="</table></td>\n";
1700 $marctext.="</tr>\n";
1704 $marctext.="</table>\n";
1708 } # sub FormatMarcText