#!/usr/bin/perl # $Id$ # Script for handling import of MARC data into Koha db # and Z39.50 lookups # Koha library project www.koha.org # Licensed under the GPL # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # Koha is distributed in the hope that it will be useful, but WITHOUT ANY # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along with # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA use strict; # standard or CPAN modules used use CGI; use DBI; # Koha modules used use C4::Context; use C4::Database; use C4::Acquisitions; use C4::Output; use C4::Input; use C4::Biblio; use C4::SimpleMarc; use C4::Z3950; use C4::Breeding; use MARC::File::USMARC; use HTML::Template; #------------------ # Constants my $includes = C4::Context->config('includes') || "/usr/local/www/hdl/htdocs/includes"; # HTML colors for alternating lines my $lc1='#dddddd'; my $lc2='#ddaaaa'; #------------- #------------- # Initialize my $userid=$ENV{'REMOTE_USER'}; my $input = new CGI; my $dbh = C4::Context->dbh; #------------- # Display output #print $input->header; #print startpage(); #print startmenu('acquisitions'); #------------- # Process input parameters my $file=$input->param('file'); my $menu = $input->param('menu'); # # # TODO : parameter decoding and function call is quite dirty. # should be rewritten... # # 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); exit; } if ($input->param('newitem')) { # Add item copy &AcceptItemCopy($dbh,$input); exit; } # if newitem if ($file) { ProcessFile($dbh,$input); } else { SWITCH: { if ($menu eq 'z3950') { z3950menu($dbh,$input); last SWITCH; } if ($menu eq 'uploadmarc') { uploadmarc($dbh); last SWITCH; } if ($menu eq 'manual') { manual(); last SWITCH; } mainmenu(); } } #print endmenu(); #print endpage(); # Process a MARC file : show list of records, of 1 record detail, if numrecord exists sub ProcessFile { # A MARC file has been specified; process it for review form use strict; # Input params my ( $dbh, # FIXME - Unused argument $input, )=@_; # local vars my ( $sth, $record, ); my $debug=0; $dbh = C4::Context->dbh; # See if a particular result item was specified my $numrecord = $input->param('numrecord'); if ($numrecord) { ProcessRecord($dbh,$input,$numrecord); } else { # No result item specified, list results ListFileRecords($dbh,$input); } # if } # sub ProcessFile # show 1 record from the MARC file sub ProcessRecord { my ($dbh, $input,$numrecord) = @_; # local vars my ( $sth, $record, $data, ); if ($file=~/Z-(\d+)/) { my $id=$1; my $resultsid=$input->param('resultsid'); my $sth=$dbh->prepare("select results from z3950results where id=?"); $sth->execute($resultsid); ($data) = $sth->fetchrow; } else { my $sth=$dbh->prepare("select marc from uploadedmarc where id=?"); $sth->execute($file); ($data) = $sth->fetchrow; } my $file=MARC::File::USMARC->indata ($data); my $oldkoha; # FIXME - This "==" should be "=", right? for (my $i==1;$i<$numrecord;$i++) { $record = $file->next; } if ($record) { $oldkoha=MARCmarc2koha($dbh,$record); } my $template=gettemplate('marcimport/marcimportdetail.tmpl'); $oldkoha->{additionalauthors} =~ s/ \| /\n/g; $oldkoha =~ s/\|/\n/g; $template->param($oldkoha); #---- build MARC array for template my @loop = (); my $tagmeaning = &MARCgettagslib($dbh,1); my @fields = $record->fields(); my $color=0; my $lasttag=""; foreach my $field (@fields) { my @subfields=$field->subfields(); foreach my $subfieldcount (0..$#subfields) { my %row_data; if ($lasttag== $field->tag()) { $row_data{tagid} = ""; } else { $row_data{tagid} = $field->tag(); } $row_data{subfield} = $subfields[$subfieldcount][0]; $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]}; $row_data{tagvalue}= $subfields[$subfieldcount][1]; if ($color ==0) { $color=1; $row_data{color} = $lc1; } else { $color=0; $row_data{color} = $lc2; } push(@loop,\%row_data); $lasttag=$field->tag(); } } $template->param(MARC => \@loop); $template->param(numrecord => $numrecord); $template->param(file => $data); print "Content-Type: text/html\n\n", $template->output; } # lists all records from the MARC file sub ListFileRecords { use strict; # Input parameters my ( $dbh, # FIXME - Unused argument $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); # FIXME - there's already a $data a few lines above. $dbh = C4::Context->dbh; my $template=gettemplate('marcimport/ListFileRecords.tmpl'); # File can be z3950 search query or uploaded MARC data # if z3950 results if (not $file=~/Z-(\d+)/) { # This is a Marc upload $sth=$dbh->prepare("select marc,name from uploadedmarc where id=?"); $sth->execute($file); ($data, $name) = $sth->fetchrow; $template->param(IS_MARC => 1); $template->param(recordsource => $name); } if ($file=~/Z-(\d+)/) { # This is a z3950 search $template->param(IS_Z3950 =>1); 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); if ( $server ) { my $srvname=&z3950servername($srvid,"$server/$database"); $template->param(srvid => $srvid); $template->param(srvname => $srvname); } # 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) { $template->param(HAS_NUMRECORDS => 1); my $previous=''; my $next=''; if ($startrecord>0) { $previous="Previous"; } my $highest; $highest=$startrecord+10; ($highest>$numrecords) && ($highest=$numrecords); if ($numrecords>$startrecord+10) { $next="Next"; } $template->param(startrecord => $startrecord+1); $template->param(highest => $highest); $template->param(numrecords => $numrecords); $template->param(previous => $previous); $template->param(next => $next); my $stj=$dbh->prepare("update z3950results set highestseen=? where id=?"); $stj->execute($startrecord+10,$resultsid); } if (! $server ) { $template->param(PENDING => 1); } 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; } $template->param(elapsedtime => $elapsedtime); } elsif ($numrecords) { my @loop = (); my $z3950file=MARC::File::USMARC->indata ($data); while (my $record=$z3950file->next) { my $oldkoha = MARCmarc2koha($dbh,$record); my %row = ResultRecordLink($dbh,$oldkoha,$resultsid); push(@loop,\%row); } $template->param(LINES => \@loop); } else { } # print "\n"; } # foreach server my $elapsed=time()-$starttimer; # print "
It took $elapsed seconds to process this page.\n"; } else { $template->param(NO_RECORDS =>1); $template->param(id => $id); } # if rows } else { # # This is an uploaded Marc record # my @loop = (); my $MARCfile = MARC::File::USMARC->indata($data); my $num = 0; while (my $record=$MARCfile->next) { $num++; my $oldkoha = MARCmarc2koha($dbh,$record); my %row = ResultRecordLink($dbh,$oldkoha,'',$num); push(@loop,\%row); } $template->param(LINES => \@loop); } # if z3950 or marc upload print "Content-Type: text/html\n\n", $template->output; } # sub ListFileRecords #-------------- sub ResultRecordLink { use strict; my ($dbh,$oldkoha,$resultsid, $num)=@_; # input # FIXME - $dbh as argument is no longer used my ( $sth, $bib, # hash ref to named fields $searchfield, $searchvalue, $donetext, $fieldname, ); my %row = (); $dbh = C4::Context->dbh; # $bib=extractmarcfields($record); $sth=$dbh->prepare("select * from biblioitems where (isbn=? and isbn!='') or (issn=? and issn!='') or (lccn=? and lccn!='') "); $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn}); if ($sth->rows) { $donetext="DONE"; } else { $donetext=""; } ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}"); $searchfield=""; foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") { if ( defined $oldkoha->{$fieldname} && $oldkoha->{$fieldname} ) { $searchfield=$fieldname; $searchvalue=$oldkoha->{$fieldname}; } # if defined fieldname } # foreach if ( $searchfield ) { $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'}; $row{donetext} = $donetext; $row{file} = $file; # $row{resultsid} = $resultsid; # $row{searchfield} = $searchfield; # $row{searchvalue} = $searchvalue; $row{numrecord} = $num; $row{title} = $oldkoha->{title}; $row{author} = $oldkoha->{author}; } else { $row{title} = "Error: Problem with
$bib->{title} $bib->{author}
"; } # if searchfield return %row; } # sub PrintResultRecordLink #--------------------------------- sub z3950menu { use strict; my ( $dbh, # FIXME - Unused argument $input, )=@_; my ( $sth, $sti, $processing, $realenddate, $totalrecords, $elapsed, $elapsedtime, $resultstatus, $statuscolor, $id, $term, $type, $done, $startdate, $enddate, $servers, $record,$bib,$title, ); $dbh = C4::Context->dbh; # FIXME - This print statement doesn't belong here. It's just here # so the script will display SOMEthing. But this section really # ought to be properly templated. print < EOT print "Main Menu
\n"; print "\n"; # End of query listing #------------------------------ # Search input form print "
\n"; print "

Results of Z39.50 searches

\n"; print "Refresh
\n" . "
    \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; $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 "
  • ". "$type=$term" . "$resultstatus $totalrecords " . "($elapsedtime) $title
    \n"; } else { print "
  • $type=$term Pending
    \n"; } # if results done } # while queries print "
\n"; my $sth=$dbh->prepare("select id,name,checked from z3950servers order by rank"); # FIXME - There's already a $sth in this function. $sth->execute; my $serverlist=''; while (my ($id, $name, $checked) = $sth->fetchrow) { ($checked) ? ($checked='checked') : ($checked=''); $serverlist.=" $name
\n"; } $serverlist.=" \n"; my $rand=rand(1000000000); print << "EOF";

Search for MARC records
Query Term
 ISBN  LCCN
 Author  Title  Keyword
$serverlist

EOF print "
\n"; } # sub z3950menu #--------------------------------- sub uploadmarc { use strict; my ($dbh)=@_; # FIXME - Unused argument $dbh = C4::Context->dbh; my $template=gettemplate('marcimport/uploadmarc.tmpl'); $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'}); # print "Main Menu
\n"; my $sth=$dbh->prepare("select id,name from uploadedmarc"); $sth->execute; # print "

Select a set of MARC records

\n