Added Z39.50 searching capability, and MARC file uploading from workstation
using HTML forms. Z39.50 functionality requires the YAZ toolkit.
This commit is contained in:
tonnesen
parent
d89391dbd8
commit
dc7619a111
|
|
@ -80,6 +80,81 @@ print startpage();
|
|||
print startmenu('acquisitions');
|
||||
my $file=$input->param('file');
|
||||
|
||||
if ($input->param('z3950queue')) {
|
||||
my $query=$input->param('query');
|
||||
my $type=$input->param('type');
|
||||
my @serverlist;
|
||||
foreach ($input->param) {
|
||||
if (/S-(.*)/) {
|
||||
my $server=$1;
|
||||
if ($server eq 'LOC') {
|
||||
push @serverlist, "LOC/z3950.loc.gov:7090/voyager//";
|
||||
}
|
||||
if ($server eq 'NLC') {
|
||||
push @serverlist, "NLC/amicus.nlc-bnc.ca:210/AMICUS/bccms1/hawk5fad";
|
||||
}
|
||||
if ($server eq 'MAN') {
|
||||
push @serverlist, "MAN/".$input->param('manualz3950server')."//";
|
||||
}
|
||||
}
|
||||
}
|
||||
my $isbnfailed=0;
|
||||
if ($type eq 'isbn') {
|
||||
my $q=$query;
|
||||
$q=~s/[^X\d]//g;
|
||||
$q=~s/X.//g;
|
||||
if (length($q)==10) {
|
||||
my $checksum=substr($q,9,1);
|
||||
my $isbn=substr($q,0,9);
|
||||
my $i;
|
||||
my $c=0;
|
||||
for ($i=0; $i<9; $i++) {
|
||||
my $digit=substr($q,$i,1);
|
||||
$c+=$digit*(10-$i);
|
||||
}
|
||||
$c=int(11-($c/11-int($c/11))*11+.1);
|
||||
($c==10) && ($c='X');
|
||||
if ($c eq $checksum) {
|
||||
} else {
|
||||
print "<font color=red size=+1>$query is not a valid ISBN
|
||||
Number</font><p>\n";
|
||||
$isbnfailed=1;
|
||||
}
|
||||
} else {
|
||||
print "<font color=red size=+1>$query is not a valid ISBN
|
||||
Number</font><p>\n";
|
||||
$isbnfailed=1;
|
||||
}
|
||||
}
|
||||
unless ($isbnfailed) {
|
||||
my $q_term=$dbh->quote($query);
|
||||
my $serverlist='';
|
||||
foreach (@serverlist) {
|
||||
$serverlist.="$_ ";
|
||||
}
|
||||
chop $serverlist;
|
||||
my $q_serverlist=$dbh->quote($serverlist);
|
||||
my $sth=$dbh->prepare("insert into z3950queue (term,type,servers) values ($q_term, '$type', $q_serverlist)");
|
||||
$sth->execute;
|
||||
}
|
||||
}
|
||||
|
||||
if (my $data=$input->param('uploadmarc')) {
|
||||
my $name=$input->param('name');
|
||||
($name) || ($name=$data);
|
||||
my $marcrecord='';
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
if ($input->param('insertnewrecord')) {
|
||||
my $isbn=$input->param('isbn');
|
||||
my $issn=$input->param('issn');
|
||||
|
|
@ -98,7 +173,7 @@ if ($input->param('insertnewrecord')) {
|
|||
my $biblionumber=0;
|
||||
my $biblioitemnumber=0;
|
||||
print "<center>\n";
|
||||
print "<a href=marcimport.pl?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n";
|
||||
print "<a href=$ENV{'SCRIPT_NAME'}?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n";
|
||||
if ($sth->rows) {
|
||||
($biblionumber, $biblioitemnumber) = $sth->fetchrow;
|
||||
my $title=$input->param('title');
|
||||
|
|
@ -251,15 +326,29 @@ if ($input->param('newitem')) {
|
|||
}
|
||||
|
||||
|
||||
my $menu = $input->param('menu');
|
||||
if ($file) {
|
||||
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');
|
||||
if ($qisbn || $qissn || $qlccn || $qcontrolnumber) {
|
||||
print "<a href=marcimport.pl>New File</a><hr>\n";
|
||||
open (F, "$file");
|
||||
my $data=<F>;
|
||||
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;
|
||||
}
|
||||
|
||||
$splitchar=chr(29);
|
||||
my @records;
|
||||
|
|
@ -528,6 +617,7 @@ RECORD:
|
|||
($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)) {
|
||||
next RECORD;
|
||||
}
|
||||
|
|
@ -576,273 +666,416 @@ RECORD:
|
|||
EOF
|
||||
}
|
||||
} else {
|
||||
open (F, "$file");
|
||||
my $data=<F>;
|
||||
|
||||
$splitchar=chr(29);
|
||||
my @records;
|
||||
foreach $record (split(/$splitchar/, $data)) {
|
||||
$leader=substr($record,0,24);
|
||||
#print "<tr><td>Leader:</td><td>$leader</td></tr>\n";
|
||||
$record=substr($record,24);
|
||||
$splitchar2=chr(30);
|
||||
my $directory=0;
|
||||
my $tagcounter=0;
|
||||
my %tag;
|
||||
my @record;
|
||||
foreach $field (split(/$splitchar2/, $record)) {
|
||||
my %field;
|
||||
($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
|
||||
unless ($directory) {
|
||||
$directory=$field;
|
||||
my $itemcounter=1;
|
||||
$counter=0;
|
||||
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{$counter}=$tag;
|
||||
$counter++;
|
||||
}
|
||||
$directory=1;
|
||||
next;
|
||||
}
|
||||
$tag=$tag{$tagcounter};
|
||||
$tagcounter++;
|
||||
$field{'tag'}=$tag;
|
||||
$splitchar3=chr(31);
|
||||
my @subfields=split(/$splitchar3/, $field);
|
||||
$indicator=$subfields[0];
|
||||
$field{'indicator'}=$indicator;
|
||||
my $firstline=1;
|
||||
unless ($#subfields==0) {
|
||||
my %subfields;
|
||||
for ($i=1; $i<=$#subfields; $i++) {
|
||||
my $text=$subfields[$i];
|
||||
my $subfieldcode=substr($text,0,1);
|
||||
my $subfield=substr($text,1);
|
||||
if ($subfields{$subfieldcode}) {
|
||||
my $subfieldlist=$subfields{$subfieldcode};
|
||||
my @subfieldlist=@$subfieldlist;
|
||||
if ($#subfieldlist>=0) {
|
||||
# print "$tag Adding to array $subfieldcode -- $subfield<br>\n";
|
||||
push (@subfieldlist, $subfield);
|
||||
} else {
|
||||
# print "$tag Arraying $subfieldcode -- $subfield<br>\n";
|
||||
@subfieldlist=($subfields{$subfieldcode}, $subfield);
|
||||
}
|
||||
$subfields{$subfieldcode}=\@subfieldlist;
|
||||
} else {
|
||||
$subfields{$subfieldcode}=$subfield;
|
||||
}
|
||||
}
|
||||
$field{'subfields'}=\%subfields;
|
||||
}
|
||||
push (@record, \%field);
|
||||
}
|
||||
push (@records, \@record);
|
||||
$counter++;
|
||||
}
|
||||
print << "EOF";
|
||||
<center>
|
||||
<p>
|
||||
<a href=marcimport.pl>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</font></th></tr>
|
||||
<tr><td bgcolor=#dddddd>
|
||||
#open (F, "$file");
|
||||
#my $data=<F>;
|
||||
my $data;
|
||||
my $name;
|
||||
my $z3950=0;
|
||||
if ($file=~/Z-(\d+)/) {
|
||||
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</font></th></tr>
|
||||
<tr><td bgcolor=#dddddd>
|
||||
EOF
|
||||
my $text='';
|
||||
foreach $record (@records) {
|
||||
my @subjects=();
|
||||
my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber);
|
||||
foreach $field (@$record) {
|
||||
$text.=$field->{'tag'}."\n";
|
||||
foreach (keys %{$field->{'subfields'}}) {
|
||||
my $value=$field->{'subfields'}->{$_};
|
||||
$text.=" $_: $value\n";
|
||||
my $id=$1;
|
||||
my $sth=$dbh->prepare("select servers from z3950queue where id=$id");
|
||||
$sth->execute;
|
||||
my ($servers) = $sth->fetchrow;
|
||||
my $serverstring;
|
||||
foreach $serverstring (split(/\s+/, $servers)) {
|
||||
my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4);
|
||||
if ($name eq 'LOC') {
|
||||
print "Library of Congress<br>\n";
|
||||
} elsif ($name eq 'NLC') {
|
||||
print "National Library of Canada<br>\n";
|
||||
} else {
|
||||
print "$server/$database<br>\n";
|
||||
}
|
||||
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 '082') {
|
||||
$dewey=$field->{'subfields'}->{'a'};
|
||||
$dewey=~s/\///g;
|
||||
if (@$dewey) {
|
||||
$dewey=$$dewey[0];
|
||||
}
|
||||
#$dewey=~s/\///g;
|
||||
}
|
||||
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/ \/$//;
|
||||
}
|
||||
if ($field->{'tag'} eq '260') {
|
||||
$place=$field->{'subfields'}->{'a'};
|
||||
if (@$place) {
|
||||
$place=$$place[0];
|
||||
}
|
||||
$place=~s/\s*:$//g;
|
||||
$publisher=$field->{'subfields'}->{'b'};
|
||||
if (@$publisher) {
|
||||
$publisher=$$publisher[0];
|
||||
}
|
||||
$publisher=~s/\s*:$//g;
|
||||
$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;
|
||||
print "<ul>\n";
|
||||
my $q_server=$dbh->quote($serverstring);
|
||||
my $sti=$dbh->prepare("select numrecords,id,results,startdate,enddate from z3950results where queryid=$id and server=$q_server");
|
||||
$sti->execute;
|
||||
($numrecords,$resultsid,$data,$startdate,$enddate) = $sti->fetchrow;
|
||||
if ($sti->rows == 0) {
|
||||
print "pending...";
|
||||
} elsif ($enddate == 0) {
|
||||
my $now=time();
|
||||
my $elapsed=$now-$startdate;
|
||||
my $elapsedtime='';
|
||||
if ($elapsed>60) {
|
||||
$elapsedtime=sprintf "%d minutes",($elapsed/60);
|
||||
} else {
|
||||
$publicationyear=~/(\d\d\d\d)/;
|
||||
$publicationyear=$1;
|
||||
$elapsedtime=sprintf "%d seconds",$elapsed;
|
||||
}
|
||||
}
|
||||
if ($field->{'tag'} eq '300') {
|
||||
$pages=$field->{'subfields'}->{'a'};
|
||||
$pages=~s/ \;$//;
|
||||
$size=$field->{'subfields'}->{'c'};
|
||||
$pages=~s/\s*:$//g;
|
||||
$size=~s/\s*:$//g;
|
||||
}
|
||||
if ($field->{'tag'} eq '362') {
|
||||
if ($field->{'subfields'}->{'a'}=~/(\d+).*(\d+)/) {
|
||||
$volume=$1;
|
||||
$number=$2;
|
||||
}
|
||||
}
|
||||
if ($field->{'tag'} eq '440') {
|
||||
$seriestitle=$field->{'subfields'}->{'a'};
|
||||
if ($field->{'subfields'}->{'v'}=~/(\d+).*(\d+)/) {
|
||||
$volume=$1;
|
||||
$number=$2;
|
||||
}
|
||||
}
|
||||
if ($field->{'tag'} =~/^5/) {
|
||||
$note.="$field->{'subfields'}->{'a'}\n";
|
||||
}
|
||||
if ($field->{'tag'} =~/65\d/) {
|
||||
my $subject=$field->{'subfields'}->{'a'};
|
||||
$subject=~s/\.$//;
|
||||
if ($gensubdivision=$field->{'subfields'}->{'x'}) {
|
||||
my @sub=@$gensubdivision;
|
||||
if ($#sub>=0) {
|
||||
foreach $s (@sub) {
|
||||
$s=~s/\.$//;
|
||||
$subject.=" -- $s";
|
||||
print "<font color=red>processing... ($elapsedtime)</font>";
|
||||
} elsif ($numrecords) {
|
||||
my @records=parsemarcdata($data);
|
||||
foreach $record (@records) {
|
||||
my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $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 $author</a><br> $donetext\n";
|
||||
} else {
|
||||
$gensubdivision=~s/\.$//;
|
||||
$subject.=" -- $gensubdivision";
|
||||
print "Error: Contact steve regarding $title by $author<br>\n";
|
||||
}
|
||||
}
|
||||
if ($chronsubdivision=$field->{'subfields'}->{'y'}) {
|
||||
my @sub=@$chronsubdivision;
|
||||
if ($#sub>=0) {
|
||||
foreach $s (@sub) {
|
||||
$s=~s/\.$//;
|
||||
$subject.=" -- $s";
|
||||
}
|
||||
} else {
|
||||
$chronsubdivision=~s/\.$//;
|
||||
$subject.=" -- $chronsubdivision";
|
||||
}
|
||||
}
|
||||
if ($geosubdivision=$field->{'subfields'}->{'z'}) {
|
||||
my @sub=@$geosubdivision;
|
||||
if ($#sub>=0) {
|
||||
foreach $s (@sub) {
|
||||
$s=~s/\.$//;
|
||||
$subject.=" -- $s";
|
||||
}
|
||||
} else {
|
||||
$geosubdivision=~s/\.$//;
|
||||
$subject.=" -- $geosubdivision";
|
||||
}
|
||||
}
|
||||
push @subjects, $subject;
|
||||
print "<p>\n";
|
||||
} else {
|
||||
print "No records returned.<p>\n";
|
||||
}
|
||||
print "</ul>\n";
|
||||
}
|
||||
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");
|
||||
} else {
|
||||
my $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
|
||||
$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";
|
||||
}
|
||||
if ($isbn) {
|
||||
print "<a href=marcimport.pl?file=$file&isbn=$isbn>$title by $author</a> $donetext<br>\n";
|
||||
} elsif ($lccn) {
|
||||
print "<a href=marcimport.pl?file=$file&lccn=$lccn>$title by $author</a> $donetext<br>\n";
|
||||
} elsif ($issn) {
|
||||
print "<a href=marcimport.pl?file=$file&issn=$issn>$title by $author</a><br> $donetext\n";
|
||||
} elsif ($controlnumber) {
|
||||
print "<a href=marcimport.pl?file=$file&controlnumber=$controlnumber>$title by $author</a><br> $donetext\n";
|
||||
} else {
|
||||
print "Error: Contact steve regarding $title by $author<br>\n";
|
||||
($data, $name) = $sth->fetchrow;
|
||||
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<br>from $name</font></th></tr>
|
||||
<tr><td bgcolor=#dddddd>
|
||||
EOF
|
||||
|
||||
my @records=parsemarcdata($data);
|
||||
foreach $record (@records) {
|
||||
my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $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 "<a href=$ENV{'SCRIPT_NAME'}?file=$file&isbn=$isbn>$title$subtitle $author</a> $donetext<br>\n";
|
||||
} elsif ($lccn) {
|
||||
print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&lccn=$lccn>$title$subtitle $author</a> $donetext<br>\n";
|
||||
} elsif ($issn) {
|
||||
print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&issn=$issn>$title$subtitle $author</a><br> $donetext\n";
|
||||
} elsif ($controlnumber) {
|
||||
print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&controlnumber=$controlnumber>$title by $author</a><br> $donetext\n";
|
||||
} else {
|
||||
print "Error: Contact steve regarding $title by $author<br>\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
print "</td></tr></table>\n";
|
||||
}
|
||||
} else {
|
||||
opendir(D, "/home/$userid/");
|
||||
my @dirlist=readdir D;
|
||||
foreach $file (@dirlist) {
|
||||
(next) if ($file=~/^\./);
|
||||
(next) if ($file=~/^nsmail$/);
|
||||
(next) if ($file=~/^public_html$/);
|
||||
($file=~/\.mrc/) || ($filelist.="$file<br>\n");
|
||||
(next) unless ($file=~/\.mrc$/);
|
||||
$file=~s/ /\%20/g;
|
||||
print "<a href=marcimport.pl?file=/home/$userid/$file>$file</a><br>\n";
|
||||
|
||||
SWITCH:
|
||||
{
|
||||
if ($menu eq 'z3950') { z3950(); last SWITCH; }
|
||||
if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; }
|
||||
if ($menu eq 'manual') { manual(); last SWITCH; }
|
||||
mainmenu();
|
||||
}
|
||||
print << "EOF";
|
||||
<form method=get>
|
||||
File to read MARC records from: <input name=file size=30>
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub z3950 {
|
||||
$sth=$dbh->prepare("select id,term,type,done,numrecords,length(results),startdate,enddate,servers from z3950queue order by id desc limit 20");
|
||||
$sth->execute;
|
||||
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
|
||||
print "<table border=0><tr><td valign=top>\n";
|
||||
print "<h2>Results of Z3950 searches</h2>\n";
|
||||
print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n<ul>\n";
|
||||
while (my ($id, $term, $type, $done, $numrecords, $length, $startdate, $enddate, $servers) = $sth->fetchrow) {
|
||||
$type=uc($type);
|
||||
$term=~s/</</g;
|
||||
$term=~s/>/>/g;
|
||||
if ($done == 1) {
|
||||
my $elapsed=$enddate-$startdate;
|
||||
my $elapsedtime='';
|
||||
if ($elapsed>60) {
|
||||
$elapsedtime=sprintf "%d minutes",($elapsed/60);
|
||||
} else {
|
||||
$elapsedtime=sprintf "%d seconds",$elapsed;
|
||||
}
|
||||
if ($numrecords) {
|
||||
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Done. $numrecords records found in $elapsedtime.</font><br>\n";
|
||||
} else {
|
||||
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Done. No records found. Search took $elapsedtime.</font><br>\n";
|
||||
}
|
||||
} elsif ($done == -1) {
|
||||
my $elapsed=time()-$startdate;
|
||||
my $elapsedtime='';
|
||||
if ($elapsed>60) {
|
||||
$elapsedtime=sprintf "%d minutes",($elapsed/60);
|
||||
} else {
|
||||
$elapsedtime=sprintf "%d seconds",$elapsed;
|
||||
}
|
||||
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font color=red size=-1>Processing ($elapsedtime)</font><br>\n";
|
||||
} else {
|
||||
print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> $done <font size=-1>Pending</font><br>\n";
|
||||
}
|
||||
}
|
||||
print "</ul>\n";
|
||||
print "</td><td valign=top width=30%>\n";
|
||||
print << "EOF";
|
||||
<form action=$ENV{'SCRIPT_NAME'} method=GET>
|
||||
<input type=hidden name=z3950queue value=1>
|
||||
<input type=hidden name=menu value=$menu>
|
||||
<p>
|
||||
Other files in home directory:<p>
|
||||
$filelist
|
||||
<input type=hidden name=test value=testvalue>
|
||||
<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records<br>LOC and NLC</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 <input type=radio name=type value=title> Title</td></tr>
|
||||
<tr><td colspan=2>
|
||||
<input type=checkbox name=S-LOC checked> Library of Congress<br>
|
||||
<input type=checkbox name=S-NLC checked> National Library of Canada<br>
|
||||
<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>
|
||||
</td></tr>
|
||||
<tr><td colspan=2 align=center>
|
||||
<input type=submit>
|
||||
</td></tr>
|
||||
</table>
|
||||
|
||||
</form>
|
||||
EOF
|
||||
print "</td></tr></table>\n";
|
||||
}
|
||||
|
||||
sub 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 skip {
|
||||
|
||||
#opendir(D, "/home/$userid/");
|
||||
#my @dirlist=readdir D;
|
||||
#foreach $file (@dirlist) {
|
||||
# (next) if ($file=~/^\./);
|
||||
# (next) if ($file=~/^nsmail$/);
|
||||
# (next) if ($file=~/^public_html$/);
|
||||
# ($file=~/\.mrc/) || ($filelist.="$file<br>\n");
|
||||
# (next) unless ($file=~/\.mrc$/);
|
||||
# $file=~s/ /\%20/g;
|
||||
# print "<a href=$ENV{'SCRIPT_NAME'}?file=/home/$userid/$file>$file</a><br>\n";
|
||||
# }
|
||||
|
||||
|
||||
#<form action=$ENV{'SCRIPT_NAME'} method=POST enctype=multipart/form-data>
|
||||
|
||||
}
|
||||
print endmenu();
|
||||
print endpage();
|
||||
|
||||
sub parsemarcdata {
|
||||
my $data=shift;
|
||||
my $splitchar=chr(29);
|
||||
my @records;
|
||||
my $record;
|
||||
foreach $record (split(/$splitchar/, $data)) {
|
||||
my $leader=substr($record,0,24);
|
||||
#print "<tr><td>Leader:</td><td>$leader</td></tr>\n";
|
||||
$record=substr($record,24);
|
||||
my $splitchar2=chr(30);
|
||||
my $directory=0;
|
||||
my $tagcounter=0;
|
||||
my %tag;
|
||||
my @record;
|
||||
my $field;
|
||||
foreach $field (split(/$splitchar2/, $record)) {
|
||||
my %field;
|
||||
($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
|
||||
unless ($directory) {
|
||||
$directory=$field;
|
||||
my $itemcounter=1;
|
||||
$counter=0;
|
||||
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{$counter}=$tag;
|
||||
$counter++;
|
||||
}
|
||||
$directory=1;
|
||||
next;
|
||||
}
|
||||
$tag=$tag{$tagcounter};
|
||||
$tagcounter++;
|
||||
$field{'tag'}=$tag;
|
||||
$splitchar3=chr(31);
|
||||
my @subfields=split(/$splitchar3/, $field);
|
||||
$indicator=$subfields[0];
|
||||
$field{'indicator'}=$indicator;
|
||||
my $firstline=1;
|
||||
unless ($#subfields==0) {
|
||||
my %subfields;
|
||||
for ($i=1; $i<=$#subfields; $i++) {
|
||||
my $text=$subfields[$i];
|
||||
my $subfieldcode=substr($text,0,1);
|
||||
my $subfield=substr($text,1);
|
||||
if ($subfields{$subfieldcode}) {
|
||||
my $subfieldlist=$subfields{$subfieldcode};
|
||||
my @subfieldlist=@$subfieldlist;
|
||||
if ($#subfieldlist>=0) {
|
||||
# print "$tag Adding to array $subfieldcode -- $subfield<br>\n";
|
||||
push (@subfieldlist, $subfield);
|
||||
} else {
|
||||
# print "$tag Arraying $subfieldcode -- $subfield<br>\n";
|
||||
@subfieldlist=($subfields{$subfieldcode}, $subfield);
|
||||
}
|
||||
$subfields{$subfieldcode}=\@subfieldlist;
|
||||
} else {
|
||||
$subfields{$subfieldcode}=$subfield;
|
||||
}
|
||||
}
|
||||
$field{'subfields'}=\%subfields;
|
||||
}
|
||||
push (@record, \%field);
|
||||
}
|
||||
push (@records, \@record);
|
||||
$counter++;
|
||||
}
|
||||
return @records;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue