1708 lines
50 KiB
Perl
Executable file
1708 lines
50 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# Script for handling import of MARC data into Koha db
|
|
# and Z39.50 lookups
|
|
|
|
# Koha library project www.koha.org
|
|
|
|
# Licensed under the GPL
|
|
use strict;
|
|
#use strict;
|
|
|
|
# standard or CPAN modules used
|
|
use CGI;
|
|
use DBI;
|
|
|
|
# Koha modules used
|
|
use C4::Database;
|
|
use C4::Acquisitions;
|
|
use C4::Output;
|
|
|
|
use C4::Input;
|
|
use C4::Biblio;
|
|
|
|
#------------------
|
|
# Constants
|
|
|
|
# HTML colors for alternating lines
|
|
my $lc1='#dddddd';
|
|
my $lc2='#ddaaaa';
|
|
|
|
my %tagtext = (
|
|
'001' => 'Control number',
|
|
'003' => 'Control number identifier',
|
|
'005' => 'Date and time of latest transaction',
|
|
'006' => 'Fixed-length data elements -- additional material characteristics',
|
|
'007' => 'Physical description fixed field',
|
|
'008' => 'Fixed length data elements',
|
|
'010' => 'LCCN',
|
|
'015' => 'LCCN Cdn',
|
|
'020' => 'ISBN',
|
|
'022' => 'ISSN',
|
|
'037' => 'Source of acquisition',
|
|
'040' => 'Cataloging source',
|
|
'041' => 'Language code',
|
|
'043' => 'Geographic area code',
|
|
'050' => 'Library of Congress call number',
|
|
'060' => 'National Library of Medicine call number',
|
|
'082' => 'Dewey decimal call number',
|
|
'100' => 'Main entry -- Personal name',
|
|
'110' => 'Main entry -- Corporate name',
|
|
'130' => 'Main entry -- Uniform title',
|
|
'240' => 'Uniform title',
|
|
'245' => 'Title statement',
|
|
'246' => 'Varying form of title',
|
|
'250' => 'Edition statement',
|
|
'256' => 'Computer file characteristics',
|
|
'260' => 'Publication, distribution, etc.',
|
|
'263' => 'Projected publication date',
|
|
'300' => 'Physical description',
|
|
'306' => 'Playing time',
|
|
'440' => 'Series statement / Added entry -- Title',
|
|
'490' => 'Series statement',
|
|
'500' => 'General note',
|
|
'504' => 'Bibliography, etc. note',
|
|
'505' => 'Formatted contents note',
|
|
'508' => 'Creation/production credits note',
|
|
'510' => 'Citation/references note',
|
|
'511' => 'Participant or performer note',
|
|
'520' => 'Summary, etc. note',
|
|
'521' => 'Target audience note (ie age)',
|
|
'530' => 'Additional physical form available note',
|
|
'538' => 'System details note',
|
|
'586' => 'Awards note',
|
|
'600' => 'Subject added entry -- Personal name',
|
|
'610' => 'Subject added entry -- Corporate name',
|
|
'650' => 'Subject added entry -- Topical term',
|
|
'651' => 'Subject added entry -- Geographic name',
|
|
'656' => 'Index term -- Occupation',
|
|
'700' => 'Added entry -- Personal name',
|
|
'710' => 'Added entry -- Corporate name',
|
|
'730' => 'Added entry -- Uniform title',
|
|
'740' => 'Added entry -- Uncontrolled related/analytical title',
|
|
'800' => 'Series added entry -- Personal name',
|
|
'830' => 'Series added entry -- Uniform title',
|
|
'852' => 'Location',
|
|
'856' => 'Electronic location and access',
|
|
);
|
|
|
|
# tag, subfield, field name, repeats, striptrailingchars
|
|
my %tagmap=(
|
|
'010'=>{'a'=>{name=> 'lccn', rpt=>0 }},
|
|
'015'=>{'a'=>{name=> 'lccn', rpt=>0 }},
|
|
'020'=>{'a'=>{name=> 'isbn', rpt=>0 }},
|
|
'022'=>{'a'=>{name=> 'issn', rpt=>0 }},
|
|
'082'=>{'a'=>{name=> 'dewey', rpt=>0 }},
|
|
'100'=>{'a'=>{name=> 'author', rpt=>0, striptrail=>',:;/-' }},
|
|
'245'=>{'a'=>{name=> 'title', rpt=>0, striptrail=>',:;/' },
|
|
'b'=>{name=> 'subtitle', rpt=>0, striptrail=>',:;/' }},
|
|
'260'=>{'a'=>{name=> 'place', rpt=>0, striptrail=>',:;/-' },
|
|
'b'=>{name=> 'publisher', rpt=>0, striptrail=>',:;/-' },
|
|
'c'=>{name=> 'year' , rpt=>0, striptrail=>'.,:;/-' }},
|
|
'300'=>{'a'=>{name=> 'pages', rpt=>0, striptrail=>',:;/-' },
|
|
'c'=>{name=> 'size', rpt=>0, striptrail=>',:;/-' }},
|
|
'362'=>{'a'=>{name=> 'volume-number', rpt=>0 }},
|
|
'440'=>{'a'=>{name=> 'seriestitle', rpt=>0, striptrail=>',:;/' },
|
|
'v'=>{name=> 'volume-number',rpt=>0 }},
|
|
'490'=>{'a'=>{name=> 'seriestitle', rpt=>0, striptrail=>',:;/' },
|
|
'v'=>{name=> 'volume-number',rpt=>0 }},
|
|
'700'=>{'a'=>{name=> 'addtional-author-illus',rpt=>1, striptrail=>',:;/' }},
|
|
'5xx'=>{'a'=>{name=> 'notes', rpt=>1 }},
|
|
'65x'=>{'a'=>{name=> 'subject', rpt=>1, striptrail=>'.,:;/-' }},
|
|
);
|
|
|
|
#-------------
|
|
#-------------
|
|
# Initialize
|
|
|
|
my $userid=$ENV{'REMOTE_USER'};
|
|
|
|
my $input = new CGI;
|
|
my $dbh=C4Connect;
|
|
|
|
#-------------
|
|
# Display output
|
|
print $input->header;
|
|
print startpage();
|
|
print startmenu('acquisitions');
|
|
#-------------
|
|
# Process input parameters
|
|
my $file=$input->param('file');
|
|
my $menu = $input->param('menu');
|
|
|
|
if ($input->param('z3950queue')) {
|
|
AcceptZ3950Queue($dbh,$input);
|
|
}
|
|
|
|
if ($input->param('uploadmarc')) {
|
|
AcceptMarcUpload($dbh,$input)
|
|
}
|
|
|
|
if ($input->param('insertnewrecord')) {
|
|
# Add biblio item, and set up menu for adding item copies
|
|
my ($biblionumber,$biblioitemnumber)=AcceptBiblioitem($dbh,$input);
|
|
ItemCopyForm($dbh,$input,$biblionumber,$biblioitemnumber);
|
|
print endmenu();
|
|
print endpage();
|
|
exit;
|
|
}
|
|
|
|
|
|
if ($input->param('newitem')) {
|
|
# Add item copy
|
|
&AcceptItemCopy($dbh,$input);
|
|
} # if newitem
|
|
|
|
if ($file) {
|
|
ProcessFile($dbh,$input);
|
|
} else {
|
|
SWITCH:
|
|
{
|
|
if ($menu eq 'z3950') { z3950menu($dbh,$input); last SWITCH; }
|
|
if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; }
|
|
if ($menu eq 'manual') { manual(); last SWITCH; }
|
|
mainmenu();
|
|
}
|
|
|
|
}
|
|
print endmenu();
|
|
print endpage();
|
|
|
|
|
|
sub ProcessFile {
|
|
# A MARC file has been specified; process it for review form
|
|
use strict;
|
|
|
|
# Input params
|
|
my (
|
|
$dbh,
|
|
$input,
|
|
)=@_;
|
|
|
|
# local vars
|
|
my (
|
|
$sth,
|
|
$record,
|
|
);
|
|
|
|
my $debug=0;
|
|
my $splitchar=chr(29);
|
|
|
|
requireDBI($dbh,"ProcessFile");
|
|
|
|
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
|
|
my $qisbn=$input->param('isbn');
|
|
my $qissn=$input->param('issn');
|
|
my $qlccn=$input->param('lccn');
|
|
my $qcontrolnumber=$input->param('controlnumber');
|
|
|
|
# See if a particular result item was specified
|
|
if ($qisbn || $qissn || $qlccn || $qcontrolnumber) {
|
|
print "<a href=$ENV{'SCRIPT_NAME'}>New File</a><hr>\n";
|
|
#open (F, "$file");
|
|
#my $data=<F>;
|
|
my $data;
|
|
|
|
if ($file=~/Z-(\d+)/) {
|
|
my $id=$1;
|
|
my $resultsid=$input->param('resultsid');
|
|
my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
|
|
$sth->execute;
|
|
($data) = $sth->fetchrow;
|
|
} else {
|
|
my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
|
|
$sth->execute;
|
|
($data) = $sth->fetchrow;
|
|
}
|
|
|
|
my @records;
|
|
|
|
RECORD:
|
|
foreach $record (split(/$splitchar/, $data)) {
|
|
|
|
my (
|
|
$bib, # hash ref to named fields
|
|
$fieldlist, # list ref
|
|
$lccn, $isbn, $issn, $dewey,
|
|
$publisher, $publicationyear, $volume,
|
|
$number, @subjects, $notes, $additionalauthors,
|
|
$copyrightdate, $seriestitle,
|
|
$origisbn, $origissn, $origlccn, $origcontrolnumber,
|
|
$subtitle,
|
|
$controlnumber,
|
|
$cleanauthor,
|
|
$subject,
|
|
$volumedate,
|
|
$volumeddesc,
|
|
$itemtypeselect,
|
|
);
|
|
my ($lccninput, $isbninput, $issninput, $deweyinput, $authorinput, $titleinput,
|
|
$placeinput, $publisherinput, $publicationyearinput, $volumeinput,
|
|
$numberinput, $notesinput, $additionalauthorsinput,
|
|
$illustratorinput, $copyrightdateinput, $seriestitleinput,
|
|
$subtitleinput,
|
|
$copyrightinput,
|
|
$volumedateinput,
|
|
$volumeddescinput,
|
|
$subjectinput,
|
|
$noteinput,
|
|
$subclassinput,
|
|
$pubyearinput,
|
|
$pagesinput,
|
|
$sizeinput,
|
|
$marcinput,
|
|
$fileinput,
|
|
);
|
|
|
|
|
|
my $marctext;
|
|
|
|
my $marc=$record;
|
|
|
|
($fieldlist)=parsemarcfileformat($record );
|
|
|
|
$bib=extractmarcfields($fieldlist );
|
|
|
|
print "Title=$bib->{title}\n" if $debug;
|
|
|
|
$marctext=FormatMarcText($fieldlist);
|
|
|
|
$controlnumber =$bib->{controlnumber};
|
|
$lccn =$bib->{lccn};
|
|
$isbn =$bib->{isbn};
|
|
$issn =$bib->{issn};
|
|
$publisher =$bib->{publisher};
|
|
$publicationyear =$bib->{publicationyear};
|
|
$copyrightdate =$bib->{copyrightdate};
|
|
|
|
$volume =$bib->{volume};
|
|
$number =$bib->{number};
|
|
$seriestitle =$bib->{seriestitle};
|
|
$additionalauthors =$bib->{additionalauthors};
|
|
$notes =$bib->{notes};
|
|
|
|
$titleinput=$input->textfield(-name=>'title', -default=>$bib->{title}, -size=>40);
|
|
$marcinput=$input->hidden(-name=>'marc', -default=>$marc);
|
|
$subtitleinput=$input->textfield(-name=>'subtitle', -default=>$bib->{subtitle}, -size=>40);
|
|
$authorinput=$input->textfield(-name=>'author', -default=>$bib->{author});
|
|
$illustratorinput=$input->textfield(-name=>'illustrator',
|
|
-default=>$bib->{illustrator});
|
|
$additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
|
|
|
|
my $subject='';
|
|
foreach ( @{$bib->{subject} } ) {
|
|
$subject.="$_\n";
|
|
print "<PRE>form subject=$subject</PRE>\n" if $debug;
|
|
}
|
|
$subjectinput=$input->textarea(-name=>'subject',
|
|
-default=>$subject, -rows=>4, -cols=>40);
|
|
|
|
$noteinput=$input->textarea(-name=>'notes',
|
|
-default=>$notes, -rows=>4, -cols=>40, -wrap=>'physical');
|
|
$copyrightinput=$input->textfield(-name=>'copyrightdate', -default=>$copyrightdate);
|
|
$seriestitleinput=$input->textfield(-name=>'seriestitle', -default=>$seriestitle);
|
|
$volumeinput=$input->textfield(-name=>'volume', -default=>$volume);
|
|
$volumedateinput=$input->textfield(-name=>'volumedate', -default=>$volumedate);
|
|
$volumeddescinput=$input->textfield(-name=>'volumeddesc', -default=>$volumeddesc);
|
|
$numberinput=$input->textfield(-name=>'number', -default=>$number);
|
|
$isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
|
|
$issninput=$input->textfield(-name=>'issn', -default=>$issn);
|
|
$lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
|
|
$isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
|
|
$deweyinput=$input->textfield(-name=>'dewey', -default=>$bib->{dewey});
|
|
$cleanauthor=$bib->{author};
|
|
$cleanauthor=~s/[^A-Za-z]//g;
|
|
$subclassinput=$input->textfield(-name=>'subclass', -default=>uc(substr($cleanauthor,0,3)));
|
|
$publisherinput=$input->textfield(-name=>'publishercode', -default=>$publisher);
|
|
$pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
|
|
$placeinput=$input->textfield(-name=>'place', -default=>$bib->{place});
|
|
$pagesinput=$input->textfield(-name=>'pages', -default=>$bib->{pages});
|
|
$sizeinput=$input->textfield(-name=>'size', -default=>$bib->{size});
|
|
$fileinput=$input->hidden(-name=>'file', -default=>$file);
|
|
$origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
|
|
$origissn=$input->hidden(-name=>'origissn', -default=>$issn);
|
|
$origlccn=$input->hidden(-name=>'origlccn', -default=>$lccn);
|
|
$origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
|
|
|
|
#print "<PRE>getting itemtypeselect</PRE>\n";
|
|
$itemtypeselect=&getkeytableselectoptions(
|
|
$dbh, 'itemtypes', 'itemtype', 'description', 1);
|
|
#print "<PRE>it=$itemtypeselect</PRE>\n";
|
|
|
|
($qissn) || ($qissn='NIL');
|
|
($qlccn) || ($qlccn='NIL');
|
|
($qisbn) || ($qisbn='NIL');
|
|
($qcontrolnumber) || ($qcontrolnumber='NIL');
|
|
$controlnumber=~s/\s+//g;
|
|
|
|
unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) {
|
|
#print "<PRE>Skip record $isbn $issn $lccn </PRE>\n";
|
|
next RECORD;
|
|
}
|
|
|
|
print << "EOF";
|
|
<center>
|
|
<h1>New Record</h1>
|
|
Full MARC Record available at bottom
|
|
<form method=post>
|
|
<table border=1>
|
|
<tr><td>Title</td><td>$titleinput</td></tr>
|
|
<tr><td>Subtitle</td><td>$subtitleinput</td></tr>
|
|
<tr><td>Author</td><td>$authorinput</td></tr>
|
|
<tr><td>Additional Authors</td><td>$additionalauthorsinput</td></tr>
|
|
<tr><td>Illustrator</td><td>$illustratorinput</td></tr>
|
|
<tr><td>Copyright</td><td>$copyrightinput</td></tr>
|
|
<tr><td>Series Title</td><td>$seriestitleinput</td></tr>
|
|
<tr><td>Volume</td><td>$volumeinput</td></tr>
|
|
<tr><td>Number</td><td>$numberinput</td></tr>
|
|
<tr><td>Volume Date</td><td>$volumedateinput</td></tr>
|
|
<tr><td>Volume Description</td><td>$volumeddescinput</td></tr>
|
|
<tr><td>Subject</td><td>$subjectinput</td></tr>
|
|
<tr><td>Notes</td><td>$noteinput</td></tr>
|
|
<tr><td>Item Type</td><td><select name=itemtype>$itemtypeselect</select></td></tr>
|
|
<tr><td>ISBN</td><td>$isbninput</td></tr>
|
|
<tr><td>ISSN</td><td>$issninput</td></tr>
|
|
<tr><td>LCCN</td><td>$lccninput</td></tr>
|
|
<tr><td>Dewey</td><td>$deweyinput</td></tr>
|
|
<tr><td>Subclass</td><td>$subclassinput</td></tr>
|
|
<tr><td>Publication Year</td><td>$pubyearinput</td></tr>
|
|
<tr><td>Publisher</td><td>$publisherinput</td></tr>
|
|
<tr><td>Place</td><td>$placeinput</td></tr>
|
|
<tr><td>Pages</td><td>$pagesinput</td></tr>
|
|
<tr><td>Size</td><td>$sizeinput</td></tr>
|
|
</table>
|
|
<input type=submit>
|
|
<input type=hidden name=insertnewrecord value=1>
|
|
$fileinput
|
|
$marcinput
|
|
$origisbn
|
|
$origissn
|
|
$origlccn
|
|
$origcontrolnumber
|
|
</form>
|
|
$marctext
|
|
EOF
|
|
} # foreach record
|
|
} else {
|
|
# No result item specified, list results
|
|
ListFileRecords($dbh,$input);
|
|
} # if
|
|
} # sub ProcessFile
|
|
|
|
sub ListFileRecords {
|
|
use strict;
|
|
|
|
# Input parameters
|
|
my (
|
|
$dbh,
|
|
$input,
|
|
)=@_;
|
|
|
|
my (
|
|
$sth, $sti,
|
|
$field,
|
|
$data, # records in MARC file format
|
|
$name,
|
|
$srvid,
|
|
%servernames,
|
|
$serverdb,
|
|
);
|
|
|
|
my $z3950=0;
|
|
my $recordsource;
|
|
my $record;
|
|
my ($numrecords,$resultsid,$data,$startdate,$enddate);
|
|
|
|
requireDBI($dbh,"ListFileRecords");
|
|
|
|
# File can be z3950 search query or uploaded MARC data
|
|
|
|
# if z3950 results
|
|
if ($file=~/Z-(\d+)/) {
|
|
# This is a z3950 search
|
|
$recordsource='';
|
|
} else {
|
|
# This is a Marc upload
|
|
$sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
|
|
$sth->execute;
|
|
($data, $name) = $sth->fetchrow;
|
|
$recordsource="from $name";
|
|
}
|
|
|
|
print << "EOF";
|
|
<center>
|
|
<p>
|
|
<a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
|
|
<p>
|
|
<table border=0 cellpadding=10 cellspacing=0>
|
|
<tr><th bgcolor=black>
|
|
<font color=white>Select a Record to Import $recordsource</font>
|
|
</th></tr>
|
|
<tr><td bgcolor=#dddddd>
|
|
EOF
|
|
|
|
if ($file=~/Z-(\d+)/) {
|
|
# This is a z3950 search
|
|
|
|
my $id=$1; # search query id number
|
|
my $serverstring;
|
|
my $starttimer=time();
|
|
|
|
$sth=$dbh->prepare("
|
|
select z3950results.numrecords,z3950results.id,z3950results.results,
|
|
z3950results.startdate,z3950results.enddate,server
|
|
from z3950queue left outer join z3950results
|
|
on z3950queue.id=z3950results.queryid
|
|
where z3950queue.id=?
|
|
order by server
|
|
");
|
|
$sth->execute($id);
|
|
if ( $sth->rows ) {
|
|
# loop through all servers in search results
|
|
while ( ($numrecords,$resultsid,$data,
|
|
$startdate,$enddate,$serverstring) = $sth->fetchrow ) {
|
|
my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
|
|
#print "server=$serverstring\n";
|
|
if ( $server ) {
|
|
print "<a name=SERVER-$srvid></a> " .
|
|
&z3950servername($dbh,$srvid,"$server/$database") . "\n";
|
|
} # if $server
|
|
my $startrecord=$input->param("ST-$srvid");
|
|
($startrecord) || ($startrecord='0');
|
|
my $serverplaceholder='';
|
|
foreach ($input->param) {
|
|
(next) unless (/ST-(.+)/);
|
|
my $serverid=$1;
|
|
(next) if ($serverid eq $srvid);
|
|
my $place=$input->param("ST-$serverid");
|
|
$serverplaceholder.="\&ST-$serverid=$place";
|
|
}
|
|
if ($numrecords) {
|
|
my $previous='';
|
|
my $next='';
|
|
if ($startrecord>0) {
|
|
$previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
|
|
}
|
|
my $highest;
|
|
$highest=$startrecord+10;
|
|
($highest>$numrecords) && ($highest=$numrecords);
|
|
if ($numrecords>$startrecord+10) {
|
|
$next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
|
|
}
|
|
print "<font size=-1>[Viewing ".($startrecord+1)." to ".$highest." of $numrecords records] $previous | $next </font><br>\n";
|
|
my $stj=$dbh->prepare("update z3950results
|
|
set highestseen=? where id=?");
|
|
$stj->execute($startrecord+10,$resultsid);
|
|
} else {
|
|
print "<br>\n";
|
|
}
|
|
print "<ul>\n";
|
|
|
|
if (! $server ) {
|
|
print "<font color=red>Search still pending...</font>";
|
|
} elsif ($enddate == 0) {
|
|
my $now=time();
|
|
my $elapsed=$now-$startdate;
|
|
my $elapsedtime='';
|
|
if ($elapsed>60) {
|
|
$elapsedtime=sprintf "%d minutes",($elapsed/60);
|
|
} else {
|
|
$elapsedtime=sprintf "%d seconds",$elapsed;
|
|
}
|
|
print "<font color=red>processing... ($elapsedtime)</font>";
|
|
} elsif ($numrecords) {
|
|
my @records=parsemarcfileformat($data);
|
|
my $i;
|
|
for ($i=$startrecord; $i<$startrecord+10; $i++) {
|
|
$data.=$records[$i].$splitchar;
|
|
}
|
|
@records=parsemarcdata($data);
|
|
my $counter=0;
|
|
foreach $record (@records) {
|
|
$counter++;
|
|
#(next) unless ($counter>=$startrecord && $counter<=$startrecord+10);
|
|
my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $controlnumber);
|
|
foreach $field (@$record) {
|
|
if ($field->{'tag'} eq '001') {
|
|
$controlnumber=$field->{'indicator'};
|
|
}
|
|
if ($field->{'tag'} eq '010') {
|
|
$lccn=$field->{'subfields'}->{'a'};
|
|
$lccn=~s/^\s*//;
|
|
($lccn) = (split(/\s+/, $lccn))[0];
|
|
}
|
|
if ($field->{'tag'} eq '015') {
|
|
$lccn=$field->{'subfields'}->{'a'};
|
|
$lccn=~s/^\s*//;
|
|
$lccn=~s/^C//;
|
|
($lccn) = (split(/\s+/, $lccn))[0];
|
|
}
|
|
if ($field->{'tag'} eq '020') {
|
|
$isbn=$field->{'subfields'}->{'a'};
|
|
($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
|
|
$isbn=~s/[^\d]*//g;
|
|
}
|
|
if ($field->{'tag'} eq '022') {
|
|
$issn=$field->{'subfields'}->{'a'};
|
|
$issn=~s/^\s*//;
|
|
($issn) = (split(/\s+/, $issn))[0];
|
|
}
|
|
if ($field->{'tag'} eq '100') {
|
|
$author=$field->{'subfields'}->{'a'};
|
|
}
|
|
if ($field->{'tag'} eq '245') {
|
|
$title=$field->{'subfields'}->{'a'};
|
|
$title=~s/ \/$//;
|
|
$subtitle=$field->{'subfields'}->{'b'};
|
|
$subtitle=~s/ \/$//;
|
|
}
|
|
}
|
|
my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
|
|
my $q_issn=$dbh->quote((($issn) || ('NIL')));
|
|
my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
|
|
my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
|
|
my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
|
|
$sth->execute;
|
|
my $donetext='';
|
|
if ($sth->rows) {
|
|
$donetext="DONE";
|
|
}
|
|
$sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
|
|
$sth->execute;
|
|
if ($sth->rows) {
|
|
$donetext="DONE";
|
|
}
|
|
($author) && ($author="by $author");
|
|
if ($isbn) {
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&isbn=$isbn>$title $subtitle $author</a> $donetext<br>\n";
|
|
} elsif ($lccn) {
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&lccn=$lccn>$title $subtitle $author</a> $donetext<br>\n";
|
|
} elsif ($issn) {
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&issn=$issn>$title $subtitle $author</a><br> $donetext\n";
|
|
} elsif ($controlnumber) {
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&controlnumber=$controlnumber>$title $subtitle $author</a><br> $donetext\n";
|
|
} else {
|
|
print "Error: Contact steve regarding $title by $author<br>\n";
|
|
}
|
|
}
|
|
print "<p>\n";
|
|
} else {
|
|
if ( $records[$i] ) {
|
|
&PrintResultRecordLink($dbh,$records[$i],$resultsid);
|
|
} # if record
|
|
} # for records
|
|
print "<p>\n";
|
|
} else {
|
|
print "No records returned.<p>\n";
|
|
}
|
|
print "</ul>\n";
|
|
} # foreach server
|
|
my $elapsed=time()-$starttimer;
|
|
print "<hr>It took $elapsed seconds to process this page.\n";
|
|
} else {
|
|
print "<b>No results found for query $id</b>\n";
|
|
} # if rows
|
|
} else {
|
|
# This is an uploaded Marc record
|
|
|
|
my @records=parsemarcfileformat($data);
|
|
foreach $record (@records) {
|
|
&PrintResultRecordLink($dbh,$record,'');
|
|
} # foreach record
|
|
} # if z3950 or marc upload
|
|
print "</td></tr></table>\n";
|
|
} # sub ListFileRecords
|
|
|
|
#--------------
|
|
sub z3950servername {
|
|
# inputs
|
|
my (
|
|
$dbh,
|
|
$srvid, # server id number
|
|
$default,
|
|
)=@_;
|
|
# return
|
|
my $longname;
|
|
#----
|
|
|
|
requireDBI($dbh,"z3950servername");
|
|
|
|
my $sti=$dbh->prepare("select name
|
|
from z3950servers
|
|
where id=?");
|
|
$sti->execute($srvid);
|
|
if ( ! $sti->err ) {
|
|
($longname)=$sti->fetchrow;
|
|
}
|
|
if (! $longname) {
|
|
$longname="$default";
|
|
}
|
|
return $longname;
|
|
} # sub z3950servername
|
|
|
|
sub PrintResultRecordLink {
|
|
use strict;
|
|
my ($dbh,$record,$resultsid)=@_; # input
|
|
|
|
my (
|
|
$sth,
|
|
$bib, # hash ref to named fields
|
|
$searchfield, $searchvalue,
|
|
$donetext,
|
|
$fieldname,
|
|
);
|
|
|
|
requireDBI($dbh,"PrintResultRecordLink");
|
|
|
|
$bib=extractmarcfields($record);
|
|
|
|
$sth=$dbh->prepare("select *
|
|
from biblioitems
|
|
where isbn=? or issn=? or lccn=? ");
|
|
$sth->execute($bib->{isbn},$bib->{issn},$bib->{lccn});
|
|
if ($sth->rows) {
|
|
$donetext="DONE";
|
|
} else {
|
|
$donetext="";
|
|
}
|
|
($bib->{author}) && ($bib->{author}="by $bib->{author}");
|
|
|
|
$searchfield="";
|
|
foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
|
|
if ( defined $bib->{$fieldname} ) {
|
|
$searchfield=$fieldname;
|
|
$searchvalue=$bib->{$fieldname};
|
|
} # if defined fieldname
|
|
} # foreach
|
|
|
|
if ( $searchfield ) {
|
|
print "<a href=$ENV{'SCRIPT_NAME'}?file=$file" .
|
|
"&resultsid=$resultsid" .
|
|
"&$searchfield=$searchvalue" .
|
|
"&searchfield=$searchfield" .
|
|
"&searchvalue=$searchvalue" .
|
|
">$bib->{title} $bib->{author}</a>" .
|
|
" $donetext <BR>\n";
|
|
} else {
|
|
print "Error: Problem with $bib->{title} $bib->{author}<br>\n";
|
|
} # if searchfield
|
|
} # sub PrintResultRecordLink
|
|
|
|
#------------------
|
|
sub extractmarcfields {
|
|
use strict;
|
|
# input
|
|
my (
|
|
$record, # pointer to list of MARC field hashes.
|
|
# Example: $record->[0]->{'tag'} = '100' # Author
|
|
# $record->[0]->{'subfields'}->{'a'} = subfieldvalue
|
|
)=@_;
|
|
|
|
# return
|
|
my $bib; # pointer to hash of named output fields
|
|
# Example: $bib->{'author'} = "Twain, Mark";
|
|
|
|
my $debug=0;
|
|
|
|
my (
|
|
$field, # hash ref
|
|
$value,
|
|
$subfield, # Marc subfield [a-z]
|
|
$fieldname, # name of field "author", "title", etc.
|
|
$strip, # chars to remove from end of field
|
|
$stripregex, # reg exp pattern
|
|
);
|
|
my ($lccn, $isbn, $issn,
|
|
$publicationyear, @subjects, $subject,
|
|
$controlnumber,
|
|
$notes, $additionalauthors, $illustrator, $copyrightdate,
|
|
$s, $subdivision, $subjectsubfield,
|
|
);
|
|
|
|
print "<PRE>\n" if $debug;
|
|
|
|
if ( ref($record) eq "ARRAY" ) {
|
|
foreach $field (@$record) {
|
|
|
|
# Check each subfield in field
|
|
foreach $subfield ( keys %{$field->{subfields}} ) {
|
|
# see if it is defined in our Marc to koha mapping table
|
|
if ( $fieldname=$tagmap{ $field->{'tag'} }->{$subfield}->{name} ) {
|
|
# Yes, so keep the value
|
|
if ( ref($field->{'subfields'}->{$subfield} ) eq 'ARRAY' ) {
|
|
# if it was an array, just keep first element.
|
|
$bib->{$fieldname}=$field->{'subfields'}->{$subfield}[0];
|
|
} else {
|
|
$bib->{$fieldname}=$field->{'subfields'}->{$subfield};
|
|
} # if array
|
|
print "$field->{'tag'} $subfield $fieldname=$bib->{$fieldname}\n" if $debug;
|
|
# see if this field should have trailing chars dropped
|
|
if ($strip=$tagmap{ $field->{'tag'} }->{$subfield}->{striptrail} ) {
|
|
$strip=~s//\\/; # backquote each char
|
|
$stripregex='[ ' . $strip . ']+$'; # remove trailing spaces also
|
|
$bib->{$fieldname}=~s/$stripregex//;
|
|
} # if strip
|
|
print "Found subfield $field->{'tag'} $subfield " .
|
|
"$fieldname = $bib->{$fieldname}\n" if $debug;
|
|
} # if tagmap exists
|
|
|
|
} # foreach subfield
|
|
|
|
|
|
if ($field->{'tag'} eq '001') {
|
|
$bib->{controlnumber}=$field->{'indicator'};
|
|
}
|
|
if ($field->{'tag'} eq '015') {
|
|
$bib->{lccn}=$field->{'subfields'}->{'a'};
|
|
$bib->{lccn}=~s/^\s*//;
|
|
$bib->{lccn}=~s/^C//;
|
|
($bib->{lccn}) = (split(/\s+/, $bib->{lccn}))[0];
|
|
}
|
|
|
|
|
|
if ($field->{'tag'} eq '260') {
|
|
|
|
$publicationyear=$field->{'subfields'}->{'c'};
|
|
if ($publicationyear=~/c(\d\d\d\d)/) {
|
|
$copyrightdate=$1;
|
|
}
|
|
if ($publicationyear=~/[^c](\d\d\d\d)/) {
|
|
$publicationyear=$1;
|
|
} elsif ($copyrightdate) {
|
|
$publicationyear=$copyrightdate;
|
|
} else {
|
|
$publicationyear=~/(\d\d\d\d)/;
|
|
$publicationyear=$1;
|
|
}
|
|
}
|
|
if ($field->{'tag'} eq '700') {
|
|
my $name=$field->{'subfields'}->{'a'};
|
|
if ($field->{'subfields'}->{'e'}!~/ill/) {
|
|
$additionalauthors.="$name\n";
|
|
} else {
|
|
$illustrator=$name;
|
|
}
|
|
}
|
|
if ($field->{'tag'} =~/^5/) {
|
|
$notes.="$field->{'subfields'}->{'a'}\n";
|
|
}
|
|
if ($field->{'tag'} =~/65\d/) {
|
|
my $sub;
|
|
my $subject=$field->{'subfields'}->{'a'};
|
|
$subject=~s/\.$//;
|
|
print "Subject=$subject\n" if $debug;
|
|
foreach $subjectsubfield ( 'x','y','z' ) {
|
|
if ($subdivision=$field->{'subfields'}->{$subjectsubfield}) {
|
|
if ( ref($subdivision) eq 'ARRAY' ) {
|
|
foreach $s (@$subdivision) {
|
|
$s=~s/\.$//;
|
|
$subject.=" -- $s";
|
|
} # foreach subdivision
|
|
} else {
|
|
$subdivision=~s/\.$//;
|
|
$subject.=" -- $subdivision";
|
|
} # if array
|
|
} # if subfield exists
|
|
} # foreach subfield
|
|
print "Subject=$subject\n" if $debug;
|
|
push @subjects, $subject;
|
|
} # if tag 65x
|
|
|
|
|
|
} # foreach field
|
|
($publicationyear ) && ($bib->{publicationyear}=$publicationyear );
|
|
($copyrightdate ) && ($bib->{copyrightdate}=$copyrightdate );
|
|
($additionalauthors ) && ($bib->{additionalauthors}=$additionalauthors );
|
|
($illustrator ) && ($bib->{illustrator}=$illustrator );
|
|
($notes ) && ($bib->{notes}=$notes );
|
|
($#subjects ) && ($bib->{subject}=\@subjects );
|
|
|
|
# Misc cleanup
|
|
$bib->{dewey}=~s/\///g; # drop any slashes
|
|
|
|
($bib->{lccn}) = (split(/\s+/, $bib->{lccn}))[0]; # only keep first word
|
|
|
|
$bib->{isbn}=~s/[^\d]*//g; # drop non-digits
|
|
|
|
$bib->{issn}=~s/^\s*//;
|
|
($bib->{issn}) = (split(/\s+/, $bib->{issn}))[0];
|
|
|
|
if ( $bib->{'volume-number'} ) {
|
|
if ($bib->{'volume-number'}=~/(\d+).*(\d+)/ ) {
|
|
$bib->{'volume'}=$1;
|
|
$bib->{'number'}=$2;
|
|
} else {
|
|
$bib->{volume}=$bib->{'volume-number'};
|
|
}
|
|
delete $bib->{'volume-number'};
|
|
} # if volume-number
|
|
|
|
} else {
|
|
print "Error: extractmarcfields: input ref $record is " .
|
|
ref($record) . " not ARRAY. Contact sysadmin.\n";
|
|
}
|
|
print "</PRE>\n" if $debug;
|
|
|
|
return $bib;
|
|
|
|
} # sub extractmarcfields
|
|
#---------------------------------
|
|
|
|
sub z3950menu {
|
|
use strict;
|
|
my (
|
|
$dbh,
|
|
$input,
|
|
)=@_;
|
|
|
|
my (
|
|
$sth, $sti,
|
|
$processing,
|
|
$realenddate,
|
|
$totalrecords,
|
|
$elapsed,
|
|
$elapsedtime,
|
|
$resultstatus, $statuscolor,
|
|
$id, $term, $type, $done,
|
|
$startdate, $enddate, $servers,
|
|
$record,$bib,$title,
|
|
);
|
|
|
|
requireDBI($dbh,"z3950menu");
|
|
|
|
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
|
|
print "<table border=0><tr><td valign=top>\n";
|
|
print "<h2>Results of Z39.50 searches</h2>\n";
|
|
print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n" .
|
|
"<ul>\n";
|
|
|
|
# Check queued queries
|
|
$sth=$dbh->prepare("select id,term,type,done,
|
|
startdate,enddate,servers
|
|
from z3950queue
|
|
order by id desc
|
|
limit 20 ");
|
|
$sth->execute;
|
|
while ( ($id, $term, $type, $done,
|
|
$startdate, $enddate, $servers) = $sth->fetchrow) {
|
|
$type=uc($type);
|
|
$term=~s/</</g;
|
|
$term=~s/>/>/g;
|
|
|
|
$title="";
|
|
# See if query produced results
|
|
$sti=$dbh->prepare("select id,server,startdate,enddate,numrecords,results
|
|
from z3950results
|
|
where queryid=?");
|
|
$sti->execute($id);
|
|
if ($sti->rows) {
|
|
$processing=0;
|
|
$realenddate=0;
|
|
$totalrecords=0;
|
|
while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords,$r_marcdata)
|
|
= $sti->fetchrow) {
|
|
if ($r_enddate==0) {
|
|
# It hasn't finished yet
|
|
$processing=1;
|
|
} else {
|
|
# It finished, see how long it took.
|
|
if ($r_enddate>$realenddate) {
|
|
$realenddate=$r_enddate;
|
|
}
|
|
# Snag any title from the results if there were any
|
|
if ( ! $title && $r_marcdata ) {
|
|
($record)=parsemarcfileformat($r_marcdata);
|
|
$bib=extractmarcfields($record);
|
|
if ( $bib->{title} ) { $title=$bib->{title} };
|
|
} # if no title yet
|
|
} # if finished
|
|
|
|
$totalrecords+=$r_numrecords;
|
|
} # while results
|
|
|
|
if ($processing) {
|
|
$elapsed=time()-$startdate;
|
|
$resultstatus="Processing...";
|
|
$statuscolor="red";
|
|
} else {
|
|
$elapsed=$realenddate-$startdate;
|
|
$resultstatus="Done.";
|
|
$statuscolor="black";
|
|
}
|
|
|
|
if ($elapsed>60) {
|
|
$elapsedtime=sprintf "%d minutes",($elapsed/60);
|
|
} else {
|
|
$elapsedtime=sprintf "%d seconds",$elapsed;
|
|
}
|
|
if ($totalrecords) {
|
|
$totalrecords="$totalrecords found.";
|
|
} else {
|
|
$totalrecords='';
|
|
}
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>".
|
|
"$type=$term</a>" .
|
|
"<font size=-1 color=$statuscolor>$resultstatus $totalrecords " .
|
|
"($elapsedtime) $title </font><br>\n";
|
|
} else {
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>
|
|
$type=$term</a> <font size=-1>Pending</font><br>\n";
|
|
} # if results done
|
|
} # while queries
|
|
print "</ul> </td>\n";
|
|
# End of query listing
|
|
|
|
#------------------------------
|
|
# Search input form
|
|
print "<td valign=top width=30%>\n";
|
|
|
|
my $sth=$dbh->prepare("select id,name,checked
|
|
from z3950servers
|
|
order by rank");
|
|
$sth->execute;
|
|
my $serverlist='';
|
|
while (my ($id, $name, $checked) = $sth->fetchrow) {
|
|
($checked) ? ($checked='checked') : ($checked='');
|
|
$serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n";
|
|
}
|
|
$serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n";
|
|
|
|
my $rand=rand(1000000000);
|
|
print << "EOF";
|
|
<form action=$ENV{'SCRIPT_NAME'} method=GET>
|
|
<input type=hidden name=z3950queue value=1>
|
|
<input type=hidden name=menu value=$menu>
|
|
<p>
|
|
<input type=hidden name=test value=testvalue>
|
|
<input type=hidden name=rand value=$rand>
|
|
<table border=1 bgcolor=#dddddd>
|
|
<tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr>
|
|
<tr><td>Query Term</td><td><input name=query></td></tr>
|
|
<tr><td colspan=2 align=center>
|
|
<input type=radio name=type value=isbn checked> ISBN
|
|
<input type=radio name=type value=lccn > LCCN<br>
|
|
<input type=radio name=type value=author > Author
|
|
<input type=radio name=type value=title > Title
|
|
<input type=radio name=type value=keyword > Keyword</td></tr>
|
|
<tr><td colspan=2> $serverlist </td></tr>
|
|
<tr><td colspan=2 align=center> <input type=submit> </td></tr>
|
|
</table>
|
|
|
|
</form>
|
|
EOF
|
|
print "</td></tr></table>\n";
|
|
} # sub z3950menu
|
|
#---------------------------------
|
|
|
|
sub uploadmarc {
|
|
use strict;
|
|
my ($dbh)=@_;
|
|
|
|
requireDBI($dbh,"uploadmarc");
|
|
|
|
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
|
|
my $sth=$dbh->prepare("select id,name from uploadedmarc");
|
|
$sth->execute;
|
|
print "<h2>Select a set of MARC records</h2>\n<ul>";
|
|
while (my ($id, $name) = $sth->fetchrow) {
|
|
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
|
|
}
|
|
print "</ul>\n";
|
|
print "<p>\n";
|
|
print "<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb
|
|
colspan=2>Upload a set of MARC records</th></tr>\n";
|
|
print "<tr><td>Upload a set of MARC records:</td><td>";
|
|
print $input->start_multipart_form();
|
|
print $input->filefield('uploadmarc');
|
|
print << "EOF";
|
|
</td></tr>
|
|
<tr><td>
|
|
<input type=hidden name=menu value=$menu>
|
|
Name this set of MARC records:</td><td><input type=text
|
|
name=name></td></tr>
|
|
<tr><td colspan=2 align=center>
|
|
<input type=submit>
|
|
</td></tr>
|
|
</table>
|
|
</form>
|
|
EOF
|
|
}
|
|
|
|
sub manual {
|
|
}
|
|
|
|
|
|
sub mainmenu {
|
|
print << "EOF";
|
|
<h1>Main Menu</h1>
|
|
<ul>
|
|
<li><a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Z39.50 Search</a>
|
|
<li><a href=$ENV{'SCRIPT_NAME'}?menu=uploadmarc>Upload MARC Records</a>
|
|
</ul>
|
|
EOF
|
|
} # sub mainmenu
|
|
|
|
|
|
#--------------------------
|
|
# Parse MARC data in file format with control-character separators
|
|
# May be multiple records.
|
|
sub parsemarcfileformat {
|
|
use strict;
|
|
# Input is one big text string
|
|
my $data=shift;
|
|
# Output is list of records. Each record is list of field hashes
|
|
my @records;
|
|
|
|
my $splitchar=chr(29);
|
|
my $splitchar2=chr(30);
|
|
my $splitchar3=chr(31);
|
|
my $debug=0;
|
|
my $record;
|
|
foreach $record (split(/$splitchar/, $data)) {
|
|
my @record;
|
|
my $directory=0;
|
|
my $tagcounter=0;
|
|
my %tag;
|
|
my $field;
|
|
|
|
my $leader=substr($record,0,24);
|
|
print "<tr><td>Leader:</td><td>$leader</td></tr>\n" if $debug;
|
|
push (@record, {
|
|
'tag' => 'Leader',
|
|
'indicator' => $leader ,
|
|
} );
|
|
|
|
$record=substr($record,24);
|
|
foreach $field (split(/$splitchar2/, $record)) {
|
|
my %field;
|
|
my $tag;
|
|
my $indicator;
|
|
unless ($directory) {
|
|
$directory=$field;
|
|
my $itemcounter=1;
|
|
my $counter2=0;
|
|
my $item;
|
|
my $length;
|
|
my $start;
|
|
while ($item=substr($directory,0,12)) {
|
|
$tag=substr($directory,0,3);
|
|
$length=substr($directory,3,4);
|
|
$start=substr($directory,7,6);
|
|
$directory=substr($directory,12);
|
|
$tag{$counter2}=$tag;
|
|
$counter2++;
|
|
}
|
|
$directory=1;
|
|
next;
|
|
}
|
|
$tag=$tag{$tagcounter};
|
|
$tagcounter++;
|
|
$field{'tag'}=$tag;
|
|
my @subfields=split(/$splitchar3/, $field);
|
|
$indicator=$subfields[0];
|
|
$field{'indicator'}=$indicator;
|
|
my $firstline=1;
|
|
unless ($#subfields==0) {
|
|
my %subfields;
|
|
my @subfieldlist;
|
|
my $i;
|
|
for ($i=1; $i<=$#subfields; $i++) {
|
|
my $text=$subfields[$i];
|
|
my $subfieldcode=substr($text,0,1);
|
|
my $subfield=substr($text,1);
|
|
# if this subfield already exists, do array
|
|
if ($subfields{$subfieldcode}) {
|
|
my $subfieldlist=$subfields{$subfieldcode};
|
|
if ( ref($subfieldlist) eq 'ARRAY' ) {
|
|
# Already an array, add on to it
|
|
print "$tag Adding to array $subfieldcode -- $subfield<br>\n" if $debug;
|
|
@subfieldlist=@$subfieldlist;
|
|
push (@subfieldlist, $subfield);
|
|
} else {
|
|
# Change simple value to array
|
|
print "$tag Arraying $subfieldcode -- $subfield<br>\n" if $debug;
|
|
@subfieldlist=($subfields{$subfieldcode}, $subfield);
|
|
}
|
|
# keep new array
|
|
$subfields{$subfieldcode}=\@subfieldlist;
|
|
} else {
|
|
# subfield doesn't exist yet, keep simple value
|
|
$subfields{$subfieldcode}=$subfield;
|
|
}
|
|
}
|
|
$field{'subfields'}=\%subfields;
|
|
}
|
|
push (@record, \%field);
|
|
} # foreach field in record
|
|
push (@records, \@record);
|
|
# $counter++;
|
|
}
|
|
print "</pre>" if $debug;
|
|
return @records;
|
|
} # sub parsemarcfileformat
|
|
|
|
#----------------------------
|
|
# Accept form results to add query to z3950 queue
|
|
sub AcceptZ3950Queue {
|
|
use strict;
|
|
|
|
# input parameters
|
|
my (
|
|
$dbh, # DBI handle
|
|
$input, # CGI parms
|
|
)=@_;
|
|
|
|
my @serverlist;
|
|
|
|
requireDBI($dbh,"AcceptZ3950Queue");
|
|
|
|
my $query=$input->param('query');
|
|
|
|
my $isbngood=1;
|
|
if ($input->param('type') eq 'isbn') {
|
|
$isbngood=checkvalidisbn($query);
|
|
}
|
|
if ($isbngood) {
|
|
foreach ($input->param) {
|
|
if (/S-(.*)/) {
|
|
my $server=$1;
|
|
if ($server eq 'MAN') {
|
|
push @serverlist, "MAN/".$input->param('manualz3950server')."//"
|
|
;
|
|
} else {
|
|
push @serverlist, $server;
|
|
}
|
|
}
|
|
}
|
|
|
|
addz3950queue($dbh,$input->param('query'), $input->param('type'),
|
|
$input->param('rand'), @serverlist);
|
|
} else {
|
|
print "<font color=red size=+1>$query is not a valid ISBN
|
|
Number</font><p>\n";
|
|
}
|
|
} # sub AcceptZ3950Queue
|
|
|
|
#---------------------------------------------
|
|
sub AcceptMarcUpload {
|
|
use strict;
|
|
my (
|
|
$dbh, # DBI handle
|
|
$input, # CGI parms
|
|
)=@_;
|
|
|
|
requireDBI($dbh,"AcceptMarcUpload");
|
|
|
|
my $name=$input->param('name');
|
|
my $data=$input->param('uploadmarc');
|
|
my $marcrecord='';
|
|
|
|
($name) || ($name=$data);
|
|
if (length($data)>0) {
|
|
while (<$data>) {
|
|
$marcrecord.=$_;
|
|
}
|
|
}
|
|
my $q_marcrecord=$dbh->quote($marcrecord);
|
|
my $q_name=$dbh->quote($name);
|
|
my $sth=$dbh->prepare("insert into uploadedmarc
|
|
(marc,name)
|
|
values ($q_marcrecord, $q_name)");
|
|
$sth->execute;
|
|
} # sub AcceptMarcUpload
|
|
|
|
#-------------------------------------------
|
|
sub AcceptBiblioitem {
|
|
use strict;
|
|
my (
|
|
$dbh,
|
|
$input,
|
|
)=@_;
|
|
|
|
my $biblionumber=0;
|
|
my $biblioitemnumber=0;
|
|
my $sth;
|
|
|
|
requireDBI($dbh,"AcceptBiblioitem");
|
|
|
|
my $isbn=$input->param('isbn');
|
|
my $issn=$input->param('issn');
|
|
my $lccn=$input->param('lccn');
|
|
my $q_origisbn=$dbh->quote($input->param('origisbn'));
|
|
my $q_origissn=$dbh->quote($input->param('origissn'));
|
|
my $q_origlccn=$dbh->quote($input->param('origlccn'));
|
|
my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
|
|
my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
|
|
my $q_issn=$dbh->quote((($issn) || ('NIL')));
|
|
my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
|
|
my $file=$input->param('file');
|
|
|
|
#my $sth=$dbh->prepare("insert into marcrecorddone values ($q_origisbn, $q_origissn, $q_origlccn, $q_origcontrolnumber)");
|
|
#$sth->execute;
|
|
|
|
print "<center>\n";
|
|
print "<a href=$ENV{'SCRIPT_NAME'}?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n";
|
|
|
|
# See if it already exists
|
|
my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
|
|
from biblioitems
|
|
where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
|
|
$sth->execute;
|
|
if ($sth->rows) {
|
|
# Already exists
|
|
($biblionumber, $biblioitemnumber) = $sth->fetchrow;
|
|
my $title=$input->param('title');
|
|
print << "EOF";
|
|
<table border=0 width=50% cellpadding=10 cellspacing=0>
|
|
<tr><th bgcolor=black><font color=white>Record already in database</font>
|
|
</th></tr>
|
|
<tr><td bgcolor=#dddddd>$title is already in the database with
|
|
biblionumber $biblionumber and biblioitemnumber $biblioitemnumber
|
|
</td></tr>
|
|
</table>
|
|
<p>
|
|
EOF
|
|
} else {
|
|
|
|
# It doesn't exist; add it.
|
|
|
|
my $error;
|
|
my %biblio;
|
|
my %biblioitem;
|
|
|
|
# convert to upper case and split on lines
|
|
my $subjectheadings=$input->param('subject');
|
|
my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
|
|
|
|
my $additionalauthors=$input->param('additionalauthors');
|
|
my @additionalauthors=split(/[\r\n]+/,uc($additionalauthors));
|
|
|
|
# Use individual assignments to hash buckets, in case
|
|
# any of the input parameters are empty or don't exist
|
|
$biblio{title} =$input->param('title');
|
|
$biblio{author} =$input->param('author');
|
|
$biblio{copyright} =$input->param('copyrightdate');
|
|
$biblio{seriestitle} =$input->param('seriestitle');
|
|
$biblio{notes} =$input->param('notes');
|
|
$biblio{abstract} =$input->param('abstract');
|
|
$biblio{subtitle} =$input->param('subtitle');
|
|
|
|
$biblioitem{volume} =$input->param('volume');
|
|
$biblioitem{number} =$input->param('number');
|
|
$biblioitem{itemtype} =$input->param('itemtype');
|
|
$biblioitem{isbn} =$input->param('isbn');
|
|
$biblioitem{issn} =$input->param('issn');
|
|
$biblioitem{dewey} =$input->param('dewey');
|
|
$biblioitem{subclass} =$input->param('subclass');
|
|
$biblioitem{publicationyear} =$input->param('publicationyear');
|
|
$biblioitem{publishercode} =$input->param('publishercode');
|
|
$biblioitem{volumedate} =$input->param('volumedate');
|
|
$biblioitem{volumeddesc} =$input->param('volumeddesc');
|
|
$biblioitem{illus} =$input->param('illustrator');
|
|
$biblioitem{pages} =$input->param('pages');
|
|
$biblioitem{notes} =$input->param('notes');
|
|
$biblioitem{size} =$input->param('size');
|
|
$biblioitem{place} =$input->param('place');
|
|
$biblioitem{lccn} =$input->param('lccn');
|
|
$biblioitem{marc} =$input->param('marc');
|
|
|
|
#print "<PRE>subjects=@subjectheadings</PRE>\n";
|
|
#print "<PRE>auth=@additionalauthors</PRE>\n";
|
|
|
|
($biblionumber, $biblioitemnumber, $error)=
|
|
newcompletebiblioitem($dbh,
|
|
\%biblio,
|
|
\%biblioitem,
|
|
\@subjectheadings,
|
|
\@additionalauthors
|
|
);
|
|
|
|
if ( $error ) {
|
|
print "<H2>Error adding biblio item</H2> $error\n";
|
|
} else {
|
|
|
|
my $title=$input->param('title');
|
|
print << "EOF";
|
|
<table cellpadding=10 cellspacing=0 border=0 width=50%>
|
|
<tr><th bgcolor=black><font color=white>Record entered into database</font></th></tr>
|
|
<tr><td bgcolor=#dddddd>$title has been entered into the database with biblionumber
|
|
$biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
|
|
</table>
|
|
EOF
|
|
} # if error
|
|
} # if new record
|
|
|
|
return $biblionumber,$biblioitemnumber;
|
|
} # sub AcceptBiblioitem
|
|
|
|
sub ItemCopyForm {
|
|
use strict;
|
|
my (
|
|
$dbh,
|
|
$input, # CGI input object
|
|
$biblionumber,
|
|
$biblioitemnumber,
|
|
)=@_;
|
|
|
|
my $sth;
|
|
my $barcode;
|
|
requireDBI($dbh,"ItemCopyForm");
|
|
|
|
my $title=$input->param('title');
|
|
my $file=$input->param('file');
|
|
|
|
# Get next barcode, or pick random one if none exist yet
|
|
$sth=$dbh->prepare("select max(barcode) from items");
|
|
$sth->execute;
|
|
($barcode) = $sth->fetchrow;
|
|
$barcode++;
|
|
if ($barcode==1) {
|
|
$barcode=int(rand()*1000000);
|
|
}
|
|
|
|
my $branchselect=getkeytableselectoptions(
|
|
$dbh, 'branches', 'branchcode', 'branchname', 0);
|
|
|
|
print << "EOF";
|
|
<table border=0 cellpadding=10 cellspacing=0>
|
|
<tr><th bgcolor=black>
|
|
<font color=white> Add a New Item for $title </font>
|
|
</th></tr>
|
|
<tr><td bgcolor=#dddddd>
|
|
<form>
|
|
<input type=hidden name=newitem value=1>
|
|
<input type=hidden name=biblionumber value=$biblionumber>
|
|
<input type=hidden name=biblioitemnumber value=$biblioitemnumber>
|
|
<input type=hidden name=file value=$file>
|
|
<table border=0>
|
|
<tr><td>BARCODE</td><td><input name=barcode size=10 value=$barcode>
|
|
Home Branch: <select name=homebranch> $branchselect </select>
|
|
</td></tr>
|
|
<tr><td>Replacement Price:</td>
|
|
<td><input name=replacementprice size=10></td></tr>
|
|
<tr><td>Notes</td>
|
|
<td><textarea name=notes rows=4 cols=40 wrap=physical></textarea>
|
|
</td></tr>
|
|
</table>
|
|
<p>
|
|
<input type=submit value="Add Item">
|
|
</form>
|
|
</td></tr>
|
|
</table>
|
|
EOF
|
|
|
|
} # sub ItemCopyForm
|
|
|
|
#---------------------------------------
|
|
# Accept form data to add an item copy
|
|
sub AcceptItemCopy {
|
|
use strict;
|
|
my ( $dbh, $input )=@_;
|
|
|
|
my $error;
|
|
|
|
requireDBI($dbh,"AcceptItemCopy");
|
|
|
|
my $barcode=$input->param('barcode');
|
|
my $replacementprice=($input->param('replacementprice') || 0);
|
|
|
|
my $sth=$dbh->prepare("select barcode
|
|
from items
|
|
where barcode=?");
|
|
$sth->execute($barcode);
|
|
if ($sth->rows) {
|
|
print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n";
|
|
} else {
|
|
# Insert new item into database
|
|
$error=&newitems(
|
|
{ biblionumber=> $input->param('biblionumber'),
|
|
biblioitemnumber=> $input->param('biblioitemnumber'),
|
|
itemnotes=> $input->param('notes'),
|
|
homebranch=> $input->param('homebranch'),
|
|
replacementprice=> $replacementprice,
|
|
},
|
|
$barcode
|
|
);
|
|
if ( $error ) {
|
|
print "<font color=red>Error: $error </font><p>\n";
|
|
} else {
|
|
|
|
print "<table border=1 align=center cellpadding=10>
|
|
<tr><td bgcolor=yellow>
|
|
Item added with barcode $barcode
|
|
</td></tr></table>\n";
|
|
} # if error
|
|
} # if barcode exists
|
|
} # sub AcceptItemCopy
|
|
|
|
#---------------
|
|
# Create an HTML option list for a <SELECT> form tag by using
|
|
# values from a DB file
|
|
sub getkeytableselectoptions {
|
|
use strict;
|
|
# inputs
|
|
my (
|
|
$dbh, # DBI handle
|
|
$tablename, # name of table containing list of choices
|
|
$keyfieldname, # column name of code to use in option list
|
|
$descfieldname, # column name of descriptive field
|
|
$showkey, # flag to show key in description
|
|
)=@_;
|
|
my $selectclause; # return value
|
|
|
|
my (
|
|
$sth, $query,
|
|
$key, $desc, $orderfieldname,
|
|
);
|
|
my $debug=0;
|
|
|
|
requireDBI($dbh,"getkeytableselectoptions");
|
|
|
|
if ( $showkey ) {
|
|
$orderfieldname=$keyfieldname;
|
|
} else {
|
|
$orderfieldname=$descfieldname;
|
|
}
|
|
$query= "select $keyfieldname,$descfieldname
|
|
from $tablename
|
|
order by $orderfieldname ";
|
|
print "<PRE>Query=$query </PRE>\n" if $debug;
|
|
$sth=$dbh->prepare($query);
|
|
$sth->execute;
|
|
while ( ($key, $desc) = $sth->fetchrow) {
|
|
if ($showkey) { $desc="$key - $desc"; }
|
|
$selectclause.="<option value='$key'>$desc\n";
|
|
print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
|
|
}
|
|
return $selectclause;
|
|
} # sub getkeytableselectoptions
|
|
|
|
#---------------------------------
|
|
# Add a biblioitem and related data
|
|
sub newcompletebiblioitem {
|
|
use strict;
|
|
|
|
my ( $dbh, # DBI handle
|
|
$biblio, # hash ref to biblio record
|
|
$biblioitem, # hash ref to biblioitem record
|
|
$subjects, # list ref of subjects
|
|
$addlauthors, # list ref of additional authors
|
|
)=@_ ;
|
|
|
|
my ( $biblionumber, $biblioitemnumber, $error); # return values
|
|
|
|
my $debug=0;
|
|
my $sth;
|
|
my $subjectheading;
|
|
my $additionalauthor;
|
|
|
|
#--------
|
|
requireDBI($dbh,"newcompletebiblioitem");
|
|
|
|
print "<PRE>Trying to add biblio item Title=$biblio->{title} " .
|
|
"ISBN=$biblioitem->{isbn} </PRE>\n" if $debug;
|
|
|
|
# Make sure master biblio entry exists
|
|
($biblionumber,$error)=getoraddbiblio($dbh, $biblio);
|
|
|
|
if ( ! $error ) {
|
|
|
|
$biblioitem->{biblionumber}=$biblionumber;
|
|
$biblioitemnumber=newbiblioitem($biblioitem);
|
|
|
|
$sth=$dbh->prepare("insert into bibliosubject
|
|
(biblionumber,subject)
|
|
values (?, ? )" );
|
|
foreach $subjectheading (@{$subjects} ) {
|
|
$sth->execute($biblionumber, $subjectheading)
|
|
or $error.=$sth->errstr ;
|
|
|
|
} # foreach subject
|
|
|
|
$sth=$dbh->prepare("insert into additionalauthors
|
|
(biblionumber,author)
|
|
values (?, ? )");
|
|
foreach $additionalauthor (@{$addlauthors} ) {
|
|
$sth->execute($biblionumber, $additionalauthor)
|
|
or $error.=$sth->errstr ;
|
|
} # foreach author
|
|
|
|
} else {
|
|
# couldn't get biblio
|
|
$biblionumber='';
|
|
$biblioitemnumber='';
|
|
|
|
} # if no biblio error
|
|
|
|
return ( $biblionumber, $biblioitemnumber, $error);
|
|
|
|
} # sub newcompletebiblioitem
|
|
#---------------------------------------
|
|
# Find a biblio entry, or create a new one if it doesn't exist.
|
|
sub getoraddbiblio {
|
|
use strict; # in here until rest cleaned up
|
|
# input params
|
|
my (
|
|
$dbh, # db handle
|
|
$biblio, # hash ref to fields
|
|
)=@_;
|
|
|
|
# return
|
|
my $biblionumber;
|
|
|
|
my $debug=0;
|
|
my $sth;
|
|
my $error;
|
|
|
|
#-----
|
|
requireDBI($dbh,"getoraddbiblio");
|
|
|
|
print "<PRE>Looking for biblio </PRE>\n" if $debug;
|
|
$sth=$dbh->prepare("select biblionumber
|
|
from biblio
|
|
where title=? and author=?
|
|
and copyrightdate=? and seriestitle=?");
|
|
$sth->execute(
|
|
$biblio->{title}, $biblio->{author},
|
|
$biblio->{copyright}, $biblio->{seriestitle} );
|
|
if ($sth->rows) {
|
|
($biblionumber) = $sth->fetchrow;
|
|
print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
|
|
} else {
|
|
# Doesn't exist. Add new one.
|
|
print "<PRE>Adding biblio</PRE>\n" if $debug;
|
|
($biblionumber,$error)=&newbiblio($biblio);
|
|
if ( $biblionumber ) {
|
|
print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
|
|
if ( $biblio->{subtitle} ) {
|
|
&newsubtitle($biblionumber,$biblio->{subtitle} );
|
|
} # if subtitle
|
|
} else {
|
|
print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
|
|
} # if added
|
|
}
|
|
|
|
return $biblionumber,$error;
|
|
|
|
} # sub getoraddbiblio
|
|
#---------------------------------------
|
|
sub addz3950queue {
|
|
use strict;
|
|
# input
|
|
my (
|
|
$dbh, # DBI handle
|
|
$query, # value to look up
|
|
$type, # type of value ("isbn", "lccn", etc).
|
|
$requestid,
|
|
@z3950list, # list of z3950 servers to query
|
|
)=@_;
|
|
|
|
my (
|
|
@serverlist,
|
|
$server,
|
|
$failed,
|
|
);
|
|
|
|
requireDBI($dbh,"addz3950queue");
|
|
|
|
# list of servers: entry can be a fully qualified URL-type entry
|
|
# or simply just a server ID number.
|
|
|
|
my $sth=$dbh->prepare("select host,port,db,userid,password
|
|
from z3950servers
|
|
where id=? ");
|
|
foreach $server (@z3950list) {
|
|
if ($server =~ /:/ ) {
|
|
push @serverlist, $server;
|
|
} else {
|
|
$sth->execute($server);
|
|
my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
|
|
push @serverlist, "$server/$host\:$port/$db/$userid/$password";
|
|
}
|
|
}
|
|
|
|
my $serverlist='';
|
|
foreach (@serverlist) {
|
|
$serverlist.="$_ ";
|
|
} # foreach
|
|
chop $serverlist;
|
|
|
|
# Don't allow reinsertion of the same request number.
|
|
my $sth=$dbh->prepare("select identifier from z3950queue
|
|
where identifier=?");
|
|
$sth->execute($requestid);
|
|
unless ($sth->rows) {
|
|
$sth=$dbh->prepare("insert into z3950queue
|
|
(term,type,servers, identifier)
|
|
values (?, ?, ?, ?)");
|
|
$sth->execute($query, $type, $serverlist, $requestid);
|
|
}
|
|
} # sub addz3950queue
|
|
|
|
#--------------------------------------
|
|
sub FormatMarcText {
|
|
use strict;
|
|
|
|
# Input
|
|
my (
|
|
$fields, # list ref to MARC fields
|
|
)=@_;
|
|
# Return
|
|
|
|
my (
|
|
$marctext,
|
|
$color,
|
|
$field,
|
|
$tag,
|
|
$label,
|
|
$subfieldcode,$subfieldvalue,
|
|
@values, $value
|
|
);
|
|
|
|
#return "MARC text here";
|
|
|
|
$marctext="<table border=0 cellspacing=0>
|
|
<tr><th colspan=3 bgcolor=black>
|
|
<font color=white>MARC RECORD</font>
|
|
</th></tr>\n";
|
|
|
|
foreach $field ( @$fields ) {
|
|
($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
|
|
$tag=$field->{'tag'};
|
|
$label=$tagtext{$tag};
|
|
if ( $tag eq 'Leader' ) {
|
|
$tag='';
|
|
$label="Leader:";
|
|
}
|
|
$marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
|
|
"<td bgcolor=$color valign=top>$tag</td> \n";
|
|
if ( ! $field->{'subfields'} ) {
|
|
$marctext.="<td bgcolor=$color valign=top>$field->{'indicator'}</td>";
|
|
} else {
|
|
# start another table for subfields
|
|
$marctext.="<td bgcolor=$color valign=top>\n " .
|
|
" <table border=0 cellspacing=0>\n";
|
|
foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
|
|
$subfieldvalue=$field->{'subfields'}->{$subfieldcode};
|
|
if (ref($subfieldvalue) eq 'ARRAY' ) {
|
|
# if it's a pointer to array, get the values
|
|
@values=@{$subfieldvalue};
|
|
} else {
|
|
@values=( $subfieldvalue );
|
|
} # if subfield array
|
|
foreach $value ( @values ) {
|
|
$marctext.="<tr><td>$subfieldcode </td>" .
|
|
"<td>$value</td></tr>\n";
|
|
} # foreach value
|
|
} # foreach subfield
|
|
$marctext.="</table></td>\n";
|
|
} # if subfields
|
|
$marctext.="</tr>\n";
|
|
|
|
} # foreach field
|
|
|
|
$marctext.="</table>\n";
|
|
|
|
return $marctext;
|
|
|
|
} # sub FormatMarcText
|