use HTML::Template;
use C4::Output;
use C4::Auth;
+use C4::Breeding;
#------------------
# Constants
while (<$uploadmarc>) {
$marcrecord.=$_;
}
- my @marcarray = split /\x1D/, $marcrecord;
- my $dbh = C4::Context->dbh;
- my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
- my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
- my $searchbreeding = $dbh->prepare("select id from marc_breeding where isbn=?");
- my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc) values(?,?,?,?,?)");
- my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=? where id=?");
- # fields used for import results
- my $imported=0;
- my $alreadyindb = 0;
- my $alreadyinfarm = 0;
- my $notmarcrecord = 0;
- for (my $i=0;$i<=$#marcarray;$i++) {
- my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D");
- if (ref($marcrecord) eq undef) {
- $notmarcrecord++;
- } else {
- my $oldbiblio = MARCmarc2koha($dbh,$marcrecord);
- $oldbiblio->{title} = char_decode($oldbiblio->{title});
- $oldbiblio->{author} = char_decode($oldbiblio->{author});
- # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
- # drop every "special" char : spaces, - ...
- $oldbiblio->{isbn} =~ s/ |-|\.//g,
- # search if biblio exists
- my $biblioitemnumber;
- if ($oldbiblio->{isbn}) {
- $searchisbn->execute($oldbiblio->{isbn});
- ($biblioitemnumber) = $searchisbn->fetchrow;
- } else {
- $searchissn->execute($oldbiblio->{issn});
- ($biblioitemnumber) = $searchissn->fetchrow;
- }
- if ($biblioitemnumber) {
- $alreadyindb++;
- } else {
- # search in breeding farm
- my $breedingid;
- if ($oldbiblio->{isbn}) {
- $searchbreeding->execute($oldbiblio->{isbn});
- ($breedingid) = $searchbreeding->fetchrow;
- } else {
- $searchbreeding->execute($oldbiblio->{issn});
- ($breedingid) = $searchbreeding->fetchrow;
- }
- if (!$breedingid || $overwrite_biblio) {
- my $recoded;
- $recoded = $marcrecord->as_usmarc();
- if ($breedingid) {
- $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$breedingid);
- } else {
- $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded);
- }
- $imported++;
- } else {
- $alreadyinfarm++;
- }
- }
- }
- }
+ my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported) = ImportBreeding($marcrecord,$overwrite_biblio,$filename);
+
$template->param(imported => $imported,
alreadyindb => $alreadyindb,
alreadyinfarm => $alreadyinfarm,
my $menu;
my $file;
-# 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 (
- $input,
- )=@_;
-
- # local vars
- my (
- $sth,
- $record,
- );
-
- my $debug=0;
-
- # 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=$resultsid");
- $sth->execute;
- ($data) = $sth->fetchrow;
- } else {
- my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
- $sth->execute;
- ($data) = $sth->fetchrow;
- }
-
- my $file=MARC::File::USMARC->indata ($data);
- my $oldkoha;
- 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=$file");
- $sth->execute;
- ($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="<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>";
- }
- $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 "</ul>\n";
- } # foreach server
- my $elapsed=time()-$starttimer;
-# print "<hr>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 <br>$bib->{title} $bib->{author}<br>";
- } # if searchfield
- return %row;
-} # sub PrintResultRecordLink
-
-#---------------------------------
-
-
-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 "<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>";
- my @marc_loop = ();
- while (my ($id, $name) = $sth->fetchrow) {
- my %row;
- $row{id} = $id;
- $row{name} = $name;
- push(@marc_loop, \%row);
-# print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
- }
- $template->param(marc => \@marc_loop);
- print "Content-Type: text/html\n\n", $template->output;
-
-}
-
-sub manual {
-}
-
-
-sub mainmenu {
- my $template=gettemplate('marcimport/mainmenu.tmpl');
- $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
- print "Content-Type: text/html\n\n", $template->output;
-} # sub mainmenu
-
-#---------------------------------------------
-sub AcceptMarcUpload {
- use strict;
- my (
- $dbh, # DBI handle
- # FIXME - Unused argument
- $input, # CGI parms
- )=@_;
-
- $dbh = C4::Context->dbh;
-
- 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, # FIXME - Unused argument
- $input,
- )=@_;
-
- my $biblionumber=0;
- my $biblioitemnumber=0;
- my $sth;
- my $record;
-
- $dbh = C4::Context->dbh;
-
-# 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 $title=$input->param('title');
-
-# my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
-# my $q_issn=$dbh->quote((($issn) || ('NIL')));
-# my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
- my $file= MARC::File::USMARC->indata($input->param('file'));
- my $numrecord = $input->param('numrecord');
- if ($numrecord) {
- for (my $i=1;$i<$numrecord;$i++) {
- $record=$file->next;
- }
- } else {
- print STDERR "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined\n";
- print "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined : contact administrator\n";
- }
- my $template=gettemplate('marcimport/AcceptBiblioitem.tmpl');
-
- my $oldkoha = MARCmarc2koha($dbh,$record);
- # See if it already exists
- # FIXME - There's already a $sth in this context.
- my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
- from biblioitems
- where isbn=? or issn=? or lccn=?");
- $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
- if ($sth->rows) {
- # Already exists
-
- ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
- $template->param(title => $title);
- $template->param(biblionumber => $biblionumber);
- $template->param(biblioitemnumber => $biblioitemnumber);
- $template->param(BIBLIO_EXISTS => 1);
-
- } 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));
- # FIXME - WTF are the additional authors
- # converted to upper case?
-
- # 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 STDERR $record->as_formatted();
-# die;
- ($biblionumber, $biblioitemnumber, $error)=
- ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
-# (1,2,0);
-# newcompletebiblioitem($dbh,
-# \%biblio,
-# \%biblioitem,
-# \@subjectheadings,
-# \@additionalauthors
-# );
-
- if ( $error ) {
- print "<H2>Error adding biblio item</H2> $error\n";
- } else {
- $template->param(title => $title);
- $template->param(biblionumber => $biblionumber);
- $template->param(biblioitemnumber => $biblioitemnumber);
- $template->param(BIBLIO_CREATE => 1);
- } # if error
- } # if new record
- my $barcode;
-
- # 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);
- $template->param(barcode => $barcode);
- $template->param(branchselect => $branchselect);
- print "Content-Type: text/html\n\n", $template->output;
-
-} # sub ItemCopyForm
-
-#---------------------------------------
-# Accept form data to add an item copy
-sub AcceptItemCopy {
- use strict;
- my ( $dbh, $input )=@_;
- # FIXME - $dbh argument unused
-
- my $template=gettemplate('marcimport/AcceptItemCopy.tmpl');
-
- my $error;
-
- $dbh = C4::Context->dbh;
-
- 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) {
- $template->param(BARCODE_EXISTS => 1);
- $template->param(barcode => $barcode);
- } else {
- # Insert new item into database
- $error=&ALLnewitem($dbh,
- { biblionumber=> $input->param('biblionumber'),
- biblioitemnumber=> $input->param('biblioitemnumber'),
- itemnotes=> $input->param('notes'),
- homebranch=> $input->param('homebranch'),
- replacementprice=> $replacementprice,
- barcode => $barcode
- }
- );
- if ( $error ) {
- $template->param(ITEM_ERROR => 1);
- $template->param(error => $error);
- } else {
- $template->param(ITEM_CREATED => 1);
- $template->param(barcode => $barcode);
- } # if error
- } # if barcode exists
- print "Content-Type: text/html\n\n", $template->output;
-} # sub AcceptItemCopy
-
-#---------------------------------------
-sub FormatMarcText {
- use strict;
-
- # Input
- my (
- $fields, # list ref to MARC fields
- )=@_;
- # Return
- my $marctext;
-
- my (
- $color,
- $field,
- $tag,
- $label,
- $indicator,
- $subfieldcode,$subfieldvalue,
- @values, $value
- );
- my $debug=0;
-
- #-----------------------------------------
-
- $marctext="<table border=0 cellspacing=1>
- <tr><th colspan=4 background=/images/background-acq.gif>
- MARC RECORD
- </th></tr>\n";
-
- foreach $field ( @$fields ) {
-
- # Swap colors on alternating lines
- ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
-
- $tag=$field->{'tag'};
- $label=taglabel($tag);
-
- if ( $tag eq 'LDR' ) {
- $tag='';
- $label="Leader:";
- }
- print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
-
- $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
- "<td bgcolor=$color valign=top>$tag</td> \n";
-
- $indicator=$field->{'indicator'};
- $indicator=~s/ +$//; # drop trailing blanks
-
- # Third table column has indicator if it is short.
- # Fourth column has embedded table of subfields, and indicator
- # if it is long (leader or fixed-position fields)
-
- print "<pre>Format indicator=$indicator" .
- " length=" . length( $indicator ) . "</pre>\n" if $debug;
- if ( length( $indicator <= 3 ) ) {
- $marctext.="<td bgcolor=$color valign=top><pre>" .
- "$indicator</pre></td>" .
- "<td bgcolor=$color valign=top>" ;
- } else {
- $marctext.="<td bgcolor=$color valign=top></td>" .
- "<td bgcolor=$color valign=top>" .
- "$indicator ";
- } # if length
-
- # Subfields
- if ( $field->{'subfields'} ) {
- # start another table for subfields
- $marctext.= "<table border=0 cellspacing=2>\n";
- foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
- $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
- if (ref($subfieldvalue) eq 'ARRAY' ) {
- # if it's a pointer to array, get all the values
- @values=@{$subfieldvalue};
- } else {
- # otherwise get the one value
- @values=( $subfieldvalue );
- } # if subfield array
- foreach $value ( @values ) {
- $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
- "<td>$value</td></tr>\n";
- } # foreach value
- } # foreach subfield
- $marctext.="</table>\n";
- } # if subfields
- # End of indicator and subfields column
- $marctext.="</td>\n";
-
- # End of columns
- $marctext.="</tr>\n";
-
- } # foreach field
-
- $marctext.="</table>\n";
-
- return $marctext;
-
-} # sub FormatMarcText
-
#---------------
# log cleared, as marcimport is (almost) rewritten from scratch.
# $Log$
+# Revision 1.32 2003/04/22 12:22:54 tipaul
+# 1st draft for z3950 client import.
+# moving Breeding farm script to a perl package C4/Breeding.pm
+#
# Revision 1.31 2003/02/19 01:01:07 wolfpac444
# Removed the unecessary $dbh argument from being passed.
# Resolved a few minor FIXMEs.
use C4::Context;
use DBI;
#use strict;
-use C4::Acquisitions;
use C4::Biblio;
use C4::Output;
+use C4::Breeding;
use Net::Z3950;
my $pid=$$;
my $lastrun=0;
while (1) {
- if ((time-$lastrun)>5) {
- if ($checkqueue) {
- $checkqueue=0;
- my $sth=$dbh->prepare("select id,term,type,servers from z3950queue order by id");
- $sth->execute;
- while (my ($id, $term, $type, $servers) = $sth->fetchrow) {
- if ($forkcounter<12) {
- my $now=time();
- $stk=$dbh->prepare("select id,server,startdate,enddate,numrecords,active from z3950results where queryid=$id");
- ($stk->execute) || (next);
- my %serverdone;
- unless ($stk->rows) {
- my $sti=$dbh->prepare("update z3950queue set done=-1,startdate=$now where id=$id");
- $sti->execute;
- }
- while (my ($r_id, $r_server,$r_startdate,$r_enddate,$r_numrecords,$active) = $stk->fetchrow) {
- if ($r_enddate >0) {
- $serverdone{$r_server}=1;
- } elsif ($active) {
- $serverdone{$r_server}=1;
- } else {
- $serverdone{$r_server}=-1;
- }
- }
+ if ((time-$lastrun)>5) {
+ print "starting loop\n";
+ if ($checkqueue) {
+ print "checkqueue=1\n";
+ $checkqueue=0;
+ my $sth=$dbh->prepare("select id,term,type,servers from z3950queue order by id");
+ $sth->execute;
+ while (my ($id, $term, $type, $servers) = $sth->fetchrow) {
+ if ($forkcounter<12) {
+ my $now=time();
+ $stk=$dbh->prepare("select id,server,startdate,enddate,numrecords,active from z3950results where queryid=$id");
+ ($stk->execute) || (next);
+ my %serverdone;
+ unless ($stk->rows) {
+ my $sti=$dbh->prepare("update z3950queue set done=-1,startdate=$now where id=$id");
+ $sti->execute;
+ }
+ while (my ($r_id, $r_server,$r_startdate,$r_enddate,$r_numrecords,$active) = $stk->fetchrow) {
+ if ($r_enddate >0) {
+ $serverdone{$r_server}=1;
+ } elsif ($active) {
+ $serverdone{$r_server}=1;
+ } else {
+ $serverdone{$r_server}=-1;
+ }
+ }
- $stk->finish;
- my $attr='';
- if ($type eq 'isbn') {
- $attr='1=7';
- } elsif ($type eq 'title') {
- $attr='1=4';
- } elsif ($type eq 'author') {
- $attr='1=1003';
- } elsif ($type eq 'lccn') {
- $attr='1=9';
- } elsif ($type eq 'keyword') {
- $attr='1=1016';
- }
- $term='"'.$term.'"';
- $query="\@attr $attr $term";
- my $totalrecords=0;
- my $serverinfo;
- my $stillprocessing=0;
- foreach $serverinfo (split(/\s+/, $servers)) {
- (next) if ($serverdone{$serverinfo} == 1);
- my $stillprocessing=1;
- if (my $pid=fork()) {
- $forkcounter++;
- } else {
- #$sth->finish;
- #$sti->finish;
- #$dbh->disconnect;
- my $dbi = C4::Context->dbh;
- my ($name, $server, $database, $user, $password) = split(/\//, $serverinfo, 5);
- $server=~/(.*)\:(\d+)/;
- my $servername=$1;
- my $port=$2;
- print "Processing $type=$term at $name $server $database (".($forkcounter+1)." forks)\n";
- $now=time();
- my $q_serverinfo=$dbi->quote($serverinfo);
- my $resultsid;
- if ($serverdone{$serverinfo}==-1) {
- my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id");
- $stj->execute;
- ($resultsid) = $stj->fetchrow;
- } else {
- my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id");
- $stj->execute;
- ($resultsid) = $stj->fetchrow;
- unless ($resultsid) {
- my $stj=$dbi->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)");
- $stj->execute;
- $resultsid=$dbi->{'mysql_insertid'};
- }
- }
- my $stj=$dbh->prepare("update z3950results set active=1 where id=$resultsid");
- $stj->execute;
- my $conn;
- my $noconnection=0;
- my $error=0;
- if ($user) {
- eval { $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database, user => $user, password => $password); };
- if ($@) {
- $noconnection=1;
- } else {
- $error=pe();
- }
- } else {
- eval { $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database); };
- if ($@) {
- $noconnection=1;
- } else {
- $error=pe();
- }
- }
- if ($noconnection || $error) {
- } else {
- print "Q: $query\n";
- my $rs=$conn->search($query);
- pe();
- eval { $rs->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);};
- if ($@) {
- print "ERROR: $@\n";
- } else {
- pe();
- my $numresults=$rs->size();
- pe();
- my $i;
- my $result='';
- my $scantimerstart=time();
- for ($i=1; $i<=(($numresults<80) ? ($numresults) : (80)); $i++) {
- my $rec=$rs->record($i);
- my $marcdata=$rec->rawdata();
- $result.=$marcdata;
- }
- my $scantimerend=time();
- my $numrecords;
- ($numresults<80) ? ($numrecords=$numresults) : ($numrecords=80);
- my $elapsed=$scantimerend-$scantimerstart;
- if ($elapsed) {
- my $speed=int($numresults/$elapsed*100)/100;
- print " SPEED: $speed $server done $numrecords\n";
- }
+ $stk->finish;
+ my $attr='';
+ if ($type eq 'isbn') {
+ $attr='1=7';
+ } elsif ($type eq 'title') {
+ $attr='1=4';
+ } elsif ($type eq 'author') {
+ $attr='1=1003';
+ } elsif ($type eq 'lccn') {
+ $attr='1=9';
+ } elsif ($type eq 'keyword') {
+ $attr='1=1016';
+ }
+ $term='"'.$term.'"';
+ $query="\@attr $attr $term";
+ my $totalrecords=0;
+ my $serverinfo;
+ my $stillprocessing=0;
+ foreach $serverinfo (split(/\s+/, $servers)) {
+ (next) if ($serverdone{$serverinfo} == 1);
+ my $stillprocessing=1;
+ if (my $pid=fork()) {
+ $forkcounter++;
+ } else {
+ #$sth->finish;
+ #$sti->finish;
+ #$dbh->disconnect;
+ my $dbi = C4::Context->dbh;
+ my ($name, $server, $database, $user, $password) = split(/\//, $serverinfo, 5);
+ $server=~/(.*)\:(\d+)/;
+ my $servername=$1;
+ my $port=$2;
+ print "Processing $type=$term at $name $server $database (".($forkcounter+1)." forks)\n";
+ $now=time();
+ my $q_serverinfo=$dbi->quote($serverinfo);
+ my $resultsid;
+ if ($serverdone{$serverinfo}==-1) {
+ my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id");
+ $stj->execute;
+ ($resultsid) = $stj->fetchrow;
+ } else {
+ my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id");
+ $stj->execute;
+ ($resultsid) = $stj->fetchrow;
+ unless ($resultsid) {
+ my $stj=$dbi->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)");
+ $stj->execute;
+ $resultsid=$dbi->{'mysql_insertid'};
+ }
+ }
+ my $stj=$dbh->prepare("update z3950results set active=1 where id=$resultsid");
+ $stj->execute;
+ my $conn;
+ my $noconnection=0;
+ my $error=0;
+ if ($user) {
+ eval { $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database, user => $user, password => $password); };
+ if ($@) {
+ $noconnection=1;
+ } else {
+ $error=pe();
+ }
+ } else {
+ eval { $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database); };
+ if ($@) {
+ $noconnection=1;
+ } else {
+ $error=pe();
+ }
+ }
+ if ($noconnection || $error) {
+ } else {
+ eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);};
+ if ($@) {
+ print "ERROR: $@\n";
+ } else {
+ print "Q: $query\n";
+ my $rs=$conn->search($query);
+ pe();
+ my $numresults=$rs->size();
+ pe();
+ my $i;
+ my $result='';
+ my $scantimerstart=time();
+ for ($i=1; $i<=(($numresults<80) ? ($numresults) : (80)); $i++) {
+ my $rec=$rs->record($i);
+ my $marcdata=$rec->rawdata();
+ $result.=$marcdata;
+ }
+ my $scantimerend=time();
+ my $numrecords;
+ ($numresults<80) ? ($numrecords=$numresults) : ($numrecords=80);
+ my $elapsed=$scantimerend-$scantimerstart;
+ if ($elapsed) {
+ my $speed=int($numresults/$elapsed*100)/100;
+ print " SPEED: $speed $server done $numrecords\n";
+ }
- my $q_result=$dbi->quote($result);
- ($q_result) || ($q_result='""');
- $now=time();
- my $task="update z3950results set numrecords=$numresults,numdownloaded=$numrecords,highestseen=0,results=$q_result,enddate=$now where id=$resultsid";
- my $stj=$dbi->prepare($task);
- $stj->execute;
- my $counter=0;
- while ($counter<60 && $numrecords<$numresults) {
- $counter++;
- my $stj=$dbi->prepare("select highestseen from z3950results where id=$resultsid");
- $stj->execute;
- my ($highestseen) = $stj->fetchrow;
- if ($highestseen>($numrecords-30)) {
- $counter=0;
- print " $server rescanning\n";
- my $scantimerstart=time();
- for ($i=$numrecords+1; $i<=(($numresults<($numrecords+40)) ? ($numresults) : ($numrecords+40)); $i++) {
- my $rec=$rs->record($i);
- my $marcdata=$rec->rawdata();
- $result.=$marcdata;
- }
- my $scantimerend=time();
- ($numresults<$numrecords+40) ? ($numrecords=$numresults) : ($numrecords += 40);
- my $elapsed=$scantimerend-$scantimerstart;
- if ($elapsed) {
- my $speed=int($numresults/$elapsed*100)/100;
- print " SPEED: $speed $server done $numrecords\n";
- }
+ my $q_result=$dbi->quote($result);
+ ($q_result) || ($q_result='""');
+ $now=time();
+ my $task="update z3950results set numrecords=$numresults,numdownloaded=$numrecords,highestseen=0,results=$q_result,enddate=$now where id=$resultsid";
+ my $stj=$dbi->prepare($task);
+ $stj->execute;
+ ImportBreeding($q_result,1,"Z3950");
+ my $counter=0;
+ while ($counter<60 && $numrecords<$numresults) {
+ $counter++;
+ my $stj=$dbi->prepare("select highestseen from z3950results where id=$resultsid");
+ $stj->execute;
+ my ($highestseen) = $stj->fetchrow;
+ if ($highestseen>($numrecords-30)) {
+ $counter=0;
+ print " $server rescanning\n";
+ my $scantimerstart=time();
+ for ($i=$numrecords+1; $i<=(($numresults<($numrecords+40)) ? ($numresults) : ($numrecords+40)); $i++) {
+ my $rec=$rs->record($i);
+ my $marcdata=$rec->rawdata();
+ $result.=$marcdata;
+ }
+ my $scantimerend=time();
+ ($numresults<$numrecords+40) ? ($numrecords=$numresults) : ($numrecords += 40);
+ my $elapsed=$scantimerend-$scantimerstart;
+ if ($elapsed) {
+ my $speed=int($numresults/$elapsed*100)/100;
+ print " SPEED: $speed $server done $numrecords\n";
+ }
- my $q_result=$dbi->quote($result);
- ($q_result) || ($q_result='""');
- $now=time();
- my $task="update z3950results set numdownloaded=$numrecords,results=$q_result where id=$resultsid";
- my $stj=$dbi->prepare($task);
- $stj->execute;
- }
- sleep 5;
- }
- }
- }
- # FIXME - There's already a $stj in this scope
- my $stj=$dbi->prepare("update z3950results set active=0 where id=$resultsid");
- $stj->execute;
- eval {$stj->finish};
- print " $server done.\n";
- exit;
- sub pe {
- return 0;
- my $code=$conn->errcode();
- my $msg=$conn->errmsg();
- my $ai=$conn->addinfo();
- print << "EOF";
+ my $q_result=$dbi->quote($result);
+ ($q_result) || ($q_result='""');
+ $now=time();
+ my $task="update z3950results set numdownloaded=$numrecords,results=$q_result where id=$resultsid";
+ my $stj=$dbi->prepare($task);
+ $stj->execute;
+ }
+ sleep 5;
+ }
+ }
+ }
+ # FIXME - There's already a $stj in this scope
+ my $stj=$dbi->prepare("update z3950results set active=0 where id=$resultsid");
+ $stj->execute;
+ eval {$stj->finish};
+ print " $server done.\n";
+ exit;
+sub pe {
+ return 0;
+ my $code=$conn->errcode();
+ my $msg=$conn->errmsg();
+ my $ai=$conn->addinfo();
+ print << "EOF";
CODE: $code
MSG: $msg
ADDTL: $ai
-
EOF
- return 0;
- }
+ return 0;
+ }
+ }
+ }
+ unless ($stillprocessing) {
+ #my $sti=$dbh->prepare("select enddate from z3950queue where id=$id");
+ #$sti->execute;
+ #my ($enddate) = $sti->fetchrow;
+ #unless ($enddate) {
+ }
+ } else {
+ }
}
- } unless ($stillprocessing) {
- #my $sti=$dbh->prepare("select enddate from z3950queue where id=$id");
- #$sti->execute;
- #my ($enddate) = $sti->fetchrow;
- #unless ($enddate) {
- }
- } else {
+ $lastrun=time();
}
- }
- $lastrun=time();
+ sleep 10;
}
- sleep 10;
- }
}
-sub getrecord {
- my $server=shift;
- my $base=shift;
- my $query=shift;
- my $auth=shift;
- my $id=shift;
- open (M, "|yaz-client -m yaz-$id.mrc >>yaz.out 2>>yaz.err");
- select M;
- $|=1;
- select STDOUT;
- ($auth) && ($auth="authentication $auth\n");
- print M << "EOF";
-$auth\open $server
-base $base
-setnames
-$query
-s
-s
-s
-s
-s
-s
-s
-s
-s
-s
-quit
-EOF
- close M;
-}
+# sub getrecord {
+# my $server=shift;
+# my $base=shift;
+# my $query=shift;
+# my $auth=shift;
+# my $id=shift;
+# open (M, "|yaz-client -m yaz-$id.mrc >>yaz.out 2>>yaz.err");
+# select M;
+# $|=1;
+# select STDOUT;
+# ($auth) && ($auth="authentication $auth\n");
+# print M << "EOF";
+# $auth\open $server
+# base $base
+# setnames
+# $query
+# s
+# s
+# s
+# s
+# s
+# s
+# s
+# s
+# s
+# s
+# quit
+# EOF
+# close M;
+# }
sub reap {
$forkcounter--;
wait;
projects / koha.git / commitdiff