5 # Script for handling import of MARC data into Koha db
8 # Koha library project www.koha.org
10 # Licensed under the GPL
13 # Copyright 2000-2002 Katipo Communications
15 # This file is part of Koha.
17 # Koha is free software; you can redistribute it and/or modify it under the
18 # terms of the GNU General Public License as published by the Free Software
19 # Foundation; either version 2 of the License, or (at your option) any later
22 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
23 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
24 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License along with
27 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
28 # Suite 330, Boston, MA 02111-1307 USA
32 # standard or CPAN modules used
45 use MARC::File::USMARC;
51 my $includes = C4::Context->config('includes') ||
52 "/usr/local/www/hdl/htdocs/includes";
54 # HTML colors for alternating lines
62 my $userid=$ENV{'REMOTE_USER'};
65 my $dbh = C4::Context->dbh;
67 my $uploadmarc=$input->param('uploadmarc');
68 my $overwrite_biblio = $input->param('overwrite_biblio');
69 my $filename = $input->param('filename');
71 my $template = gettemplate("acqui.simple/marcimport.tmpl");
72 $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'},
73 uploadmarc => $uploadmarc);
74 if ($uploadmarc && length($uploadmarc)>0) {
76 while (<$uploadmarc>) {
79 my @marcarray = split /\x1D/, $marcrecord;
80 my $dbh = C4::Context->dbh;
81 my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
82 my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
83 my $searchbreeding = $dbh->prepare("select isbn from marc_breeding where isbn=?");
84 my $insertsql = $dbh->prepare("replace into marc_breeding (file,isbn,marc) values(?,?,?)");
85 # fields used for import results
88 my $alreadyinfarm = 0;
89 my $notmarcrecord = 0;
90 for (my $i=0;$i<=$#marcarray;$i++) {
91 my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D");
92 if (ref($marcrecord) eq undef) {
95 my $oldbiblio = MARCmarc2koha($dbh,$marcrecord);
96 # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
97 if ($oldbiblio->{isbn} || $oldbiblio->{issn}) {
98 # search if biblio exists
100 if ($oldbiblio->{isbn}) {
101 $searchisbn->execute($oldbiblio->{isbn});
102 ($biblioitemnumber) = $searchisbn->fetchrow;
104 $searchissn->execute($oldbiblio->{issn});
105 ($biblioitemnumber) = $searchissn->fetchrow;
107 if ($biblioitemnumber) {
110 # search in breeding farm
112 if ($oldbiblio->{isbn}) {
113 $searchbreeding->execute($oldbiblio->{isbn});
114 ($breedingresult) = $searchbreeding->fetchrow;
116 $searchbreeding->execute($oldbiblio->{issn});
117 ($breedingresult) = $searchbreeding->fetchrow;
119 if (!$breedingresult || $overwrite_biblio) {
120 $insertsql ->execute($filename,$oldbiblio->{isbn}.$oldbiblio->{issn},$marcarray[$i]."\x1D')");
131 $template->param(imported => $imported,
132 alreadyindb => $alreadyindb,
133 alreadyinfarm => $alreadyinfarm,
134 notmarcrecord => $notmarcrecord,
135 total => $imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
140 print "Content-Type: text/html\n\n",$template->output;
144 # Process a MARC file : show list of records, of 1 record detail, if numrecord exists
146 # A MARC file has been specified; process it for review form
161 # See if a particular result item was specified
162 my $numrecord = $input->param('numrecord');
164 ProcessRecord($dbh,$input,$numrecord);
166 # No result item specified, list results
167 ListFileRecords($dbh,$input);
171 # show 1 record from the MARC file
173 my ($dbh, $input,$numrecord) = @_;
181 if ($file=~/Z-(\d+)/) {
183 my $resultsid=$input->param('resultsid');
184 my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
186 ($data) = $sth->fetchrow;
188 my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
190 ($data) = $sth->fetchrow;
193 my $file=MARC::File::USMARC->indata ($data);
195 for (my $i=1;$i<$numrecord;$i++) {
196 $record = $file->next;
199 $oldkoha=MARCmarc2koha($dbh,$record);
201 my $template=gettemplate('marcimport/marcimportdetail.tmpl');
202 $oldkoha->{additionalauthors} =~ s/ \| /\n/g;
203 $oldkoha =~ s/\|/\n/g;
204 $template->param($oldkoha);
205 #---- build MARC array for template
207 my $tagmeaning = &MARCgettagslib($dbh,1);
208 my @fields = $record->fields();
211 foreach my $field (@fields) {
212 my @subfields=$field->subfields();
213 foreach my $subfieldcount (0..$#subfields) {
215 if ($lasttag== $field->tag()) {
216 $row_data{tagid} = "";
218 $row_data{tagid} = $field->tag();
220 $row_data{subfield} = $subfields[$subfieldcount][0];
221 $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]};
222 $row_data{tagvalue}= $subfields[$subfieldcount][1];
225 $row_data{color} = $lc1;
228 $row_data{color} = $lc2;
230 push(@loop,\%row_data);
231 $lasttag=$field->tag();
234 $template->param(MARC => \@loop);
235 $template->param(numrecord => $numrecord);
236 $template->param(file => $data);
237 print "Content-Type: text/html\n\n", $template->output;
240 # lists all records from the MARC file
241 sub ListFileRecords {
246 $dbh, # FIXME - Unused argument
253 $data, # records in MARC file format
263 my ($numrecords,$resultsid,$data,$startdate,$enddate);
264 # FIXME - there's already a $data a few lines above.
266 $dbh = C4::Context->dbh;
268 my $template=gettemplate('marcimport/ListFileRecords.tmpl');
269 # File can be z3950 search query or uploaded MARC data
272 if (not $file=~/Z-(\d+)/) {
273 # This is a Marc upload
274 $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
276 ($data, $name) = $sth->fetchrow;
277 $template->param(IS_MARC => 1);
278 $template->param(recordsource => $name);
281 if ($file=~/Z-(\d+)/) {
282 # This is a z3950 search
283 $template->param(IS_Z3950 =>1);
284 my $id=$1; # search query id number
286 my $starttimer=time();
289 select z3950results.numrecords,z3950results.id,z3950results.results,
290 z3950results.startdate,z3950results.enddate,server
291 from z3950queue left outer join z3950results
292 on z3950queue.id=z3950results.queryid
293 where z3950queue.id=?
298 # loop through all servers in search results
299 while ( ($numrecords,$resultsid,$data,
300 $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
301 my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
303 my $srvname=&z3950servername($dbh,$srvid,"$server/$database");
304 $template->param(srvid => $srvid);
305 $template->param(srvname => $srvname);
307 my $startrecord=$input->param("ST-$srvid");
308 ($startrecord) || ($startrecord='0');
309 my $serverplaceholder='';
310 foreach ($input->param) {
311 (next) unless (/ST-(.+)/);
313 (next) if ($serverid eq $srvid);
314 my $place=$input->param("ST-$serverid");
315 $serverplaceholder.="\&ST-$serverid=$place";
318 $template->param(HAS_NUMRECORDS => 1);
321 if ($startrecord>0) {
322 $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
325 $highest=$startrecord+10;
326 ($highest>$numrecords) && ($highest=$numrecords);
327 if ($numrecords>$startrecord+10) {
328 $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
330 $template->param(startrecord => $startrecord+1);
331 $template->param(highest => $highest);
332 $template->param(numrecords => $numrecords);
333 $template->param(previous => $previous);
334 $template->param(next => $next);
335 my $stj=$dbh->prepare("update z3950results
336 set highestseen=? where id=?");
337 $stj->execute($startrecord+10,$resultsid);
341 $template->param(PENDING => 1);
342 } elsif ($enddate == 0) {
344 my $elapsed=$now-$startdate;
347 $elapsedtime=sprintf "%d minutes",($elapsed/60);
349 $elapsedtime=sprintf "%d seconds",$elapsed;
351 $template->param(elapsedtime => $elapsedtime);
352 } elsif ($numrecords) {
354 my $z3950file=MARC::File::USMARC->indata ($data);
355 while (my $record=$z3950file->next) {
356 my $oldkoha = MARCmarc2koha($dbh,$record);
357 my %row = ResultRecordLink($dbh,$oldkoha,$resultsid);
360 $template->param(LINES => \@loop);
365 my $elapsed=time()-$starttimer;
366 # print "<hr>It took $elapsed seconds to process this page.\n";
368 $template->param(NO_RECORDS =>1);
369 $template->param(id => $id);
374 # This is an uploaded Marc record
377 my $MARCfile = MARC::File::USMARC->indata($data);
379 while (my $record=$MARCfile->next) {
381 my $oldkoha = MARCmarc2koha($dbh,$record);
382 my %row = ResultRecordLink($dbh,$oldkoha,'',$num);
385 $template->param(LINES => \@loop);
386 } # if z3950 or marc upload
387 print "Content-Type: text/html\n\n", $template->output;
388 } # sub ListFileRecords
392 sub ResultRecordLink {
394 my ($dbh,$oldkoha,$resultsid, $num)=@_; # input
395 # FIXME - $dbh as argument is no longer used
398 $bib, # hash ref to named fields
399 $searchfield, $searchvalue,
405 $dbh = C4::Context->dbh;
407 # $bib=extractmarcfields($record);
409 $sth=$dbh->prepare("select *
411 where (isbn=? and isbn!='') or (issn=? and issn!='') or (lccn=? and lccn!='') ");
412 $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
418 ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}");
421 foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
422 if ( defined $oldkoha->{$fieldname} && $oldkoha->{$fieldname} ) {
423 $searchfield=$fieldname;
424 $searchvalue=$oldkoha->{$fieldname};
425 } # if defined fieldname
427 if ( $searchfield ) {
428 $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'};
429 $row{donetext} = $donetext;
431 # $row{resultsid} = $resultsid;
432 # $row{searchfield} = $searchfield;
433 # $row{searchvalue} = $searchvalue;
434 $row{numrecord} = $num;
435 $row{title} = $oldkoha->{title};
436 $row{author} = $oldkoha->{author};
438 $row{title} = "Error: Problem with <br>$bib->{title} $bib->{author}<br>";
441 } # sub PrintResultRecordLink
443 #---------------------------------
448 my ($dbh)=@_; # FIXME - Unused argument
450 $dbh = C4::Context->dbh;
452 my $template=gettemplate('marcimport/uploadmarc.tmpl');
453 $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
454 # print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
455 my $sth=$dbh->prepare("select id,name from uploadedmarc");
457 # print "<h2>Select a set of MARC records</h2>\n<ul>";
459 while (my ($id, $name) = $sth->fetchrow) {
463 push(@marc_loop, \%row);
464 # print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
466 $template->param(marc => \@marc_loop);
467 print "Content-Type: text/html\n\n", $template->output;
476 my $template=gettemplate('marcimport/mainmenu.tmpl');
477 $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
478 print "Content-Type: text/html\n\n", $template->output;
481 #---------------------------------------------
482 sub AcceptMarcUpload {
486 # FIXME - Unused argument
490 $dbh = C4::Context->dbh;
492 my $name=$input->param('name');
493 my $data=$input->param('uploadmarc');
496 ($name) || ($name=$data);
497 if (length($data)>0) {
502 my $q_marcrecord=$dbh->quote($marcrecord);
503 my $q_name=$dbh->quote($name);
504 my $sth=$dbh->prepare("insert into uploadedmarc
506 values ($q_marcrecord, $q_name)");
508 } # sub AcceptMarcUpload
510 #-------------------------------------------
511 sub AcceptBiblioitem {
514 $dbh, # FIXME - Unused argument
519 my $biblioitemnumber=0;
523 $dbh = C4::Context->dbh;
525 # my $isbn=$input->param('isbn');
526 # my $issn=$input->param('issn');
527 # my $lccn=$input->param('lccn');
528 # my $q_origisbn=$dbh->quote($input->param('origisbn'));
529 # my $q_origissn=$dbh->quote($input->param('origissn'));
530 # my $q_origlccn=$dbh->quote($input->param('origlccn'));
531 # my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
532 my $title=$input->param('title');
534 # my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
535 # my $q_issn=$dbh->quote((($issn) || ('NIL')));
536 # my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
537 my $file= MARC::File::USMARC->indata($input->param('file'));
538 my $numrecord = $input->param('numrecord');
540 for (my $i=1;$i<$numrecord;$i++) {
544 print STDERR "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined\n";
545 print "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined : contact administrator\n";
547 my $template=gettemplate('marcimport/AcceptBiblioitem.tmpl');
549 my $oldkoha = MARCmarc2koha($dbh,$record);
550 # See if it already exists
551 # FIXME - There's already a $sth in this context.
552 my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
554 where isbn=? or issn=? or lccn=?");
555 $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
559 ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
560 $template->param(title => $title);
561 $template->param(biblionumber => $biblionumber);
562 $template->param(biblioitemnumber => $biblioitemnumber);
563 $template->param(BIBLIO_EXISTS => 1);
566 # It doesn't exist; add it.
572 # convert to upper case and split on lines
573 my $subjectheadings=$input->param('subject');
574 my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
576 my $additionalauthors=$input->param('additionalauthors');
577 my @additionalauthors=split(/[\r\n]+|\|/,uc($additionalauthors));
578 # FIXME - WTF are the additional authors
579 # converted to upper case?
581 # Use individual assignments to hash buckets, in case
582 # any of the input parameters are empty or don't exist
583 $biblio{title} =$input->param('title');
584 $biblio{author} =$input->param('author');
585 $biblio{copyright} =$input->param('copyrightdate');
586 $biblio{seriestitle} =$input->param('seriestitle');
587 $biblio{notes} =$input->param('notes');
588 $biblio{abstract} =$input->param('abstract');
589 $biblio{subtitle} =$input->param('subtitle');
591 $biblioitem{volume} =$input->param('volume');
592 $biblioitem{number} =$input->param('number');
593 $biblioitem{itemtype} =$input->param('itemtype');
594 $biblioitem{isbn} =$input->param('isbn');
595 $biblioitem{issn} =$input->param('issn');
596 $biblioitem{dewey} =$input->param('dewey');
597 $biblioitem{subclass} =$input->param('subclass');
598 $biblioitem{publicationyear} =$input->param('publicationyear');
599 $biblioitem{publishercode} =$input->param('publishercode');
600 $biblioitem{volumedate} =$input->param('volumedate');
601 $biblioitem{volumeddesc} =$input->param('volumeddesc');
602 $biblioitem{illus} =$input->param('illustrator');
603 $biblioitem{pages} =$input->param('pages');
604 $biblioitem{notes} =$input->param('notes');
605 $biblioitem{size} =$input->param('size');
606 $biblioitem{place} =$input->param('place');
607 $biblioitem{lccn} =$input->param('lccn');
608 $biblioitem{marc} =$input->param('marc');
609 # print STDERR $record->as_formatted();
611 ($biblionumber, $biblioitemnumber, $error)=
612 ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
614 # newcompletebiblioitem($dbh,
618 # \@additionalauthors
622 print "<H2>Error adding biblio item</H2> $error\n";
624 $template->param(title => $title);
625 $template->param(biblionumber => $biblionumber);
626 $template->param(biblioitemnumber => $biblioitemnumber);
627 $template->param(BIBLIO_CREATE => 1);
632 # Get next barcode, or pick random one if none exist yet
633 $sth=$dbh->prepare("select max(barcode) from items");
635 ($barcode) = $sth->fetchrow;
638 $barcode=int(rand()*1000000);
640 my $branchselect=getkeytableselectoptions(
641 $dbh, 'branches', 'branchcode', 'branchname', 0);
642 $template->param(barcode => $barcode);
643 $template->param(branchselect => $branchselect);
644 print "Content-Type: text/html\n\n", $template->output;
648 #---------------------------------------
649 # Accept form data to add an item copy
652 my ( $dbh, $input )=@_;
653 # FIXME - $dbh argument unused
655 my $template=gettemplate('marcimport/AcceptItemCopy.tmpl');
659 $dbh = C4::Context->dbh;
661 my $barcode=$input->param('barcode');
662 my $replacementprice=($input->param('replacementprice') || 0);
664 my $sth=$dbh->prepare("select barcode
667 $sth->execute($barcode);
669 $template->param(BARCODE_EXISTS => 1);
670 $template->param(barcode => $barcode);
672 # Insert new item into database
673 $error=&ALLnewitem($dbh,
674 { biblionumber=> $input->param('biblionumber'),
675 biblioitemnumber=> $input->param('biblioitemnumber'),
676 itemnotes=> $input->param('notes'),
677 homebranch=> $input->param('homebranch'),
678 replacementprice=> $replacementprice,
683 $template->param(ITEM_ERROR => 1);
684 $template->param(error => $error);
686 $template->param(ITEM_CREATED => 1);
687 $template->param(barcode => $barcode);
689 } # if barcode exists
690 print "Content-Type: text/html\n\n", $template->output;
691 } # sub AcceptItemCopy
693 #---------------------------------------
699 $fields, # list ref to MARC fields
710 $subfieldcode,$subfieldvalue,
715 #-----------------------------------------
717 $marctext="<table border=0 cellspacing=1>
718 <tr><th colspan=4 background=/images/background-acq.gif>
722 foreach $field ( @$fields ) {
724 # Swap colors on alternating lines
725 ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
727 $tag=$field->{'tag'};
728 $label=taglabel($tag);
730 if ( $tag eq 'LDR' ) {
734 print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
736 $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
737 "<td bgcolor=$color valign=top>$tag</td> \n";
739 $indicator=$field->{'indicator'};
740 $indicator=~s/ +$//; # drop trailing blanks
742 # Third table column has indicator if it is short.
743 # Fourth column has embedded table of subfields, and indicator
744 # if it is long (leader or fixed-position fields)
746 print "<pre>Format indicator=$indicator" .
747 " length=" . length( $indicator ) . "</pre>\n" if $debug;
748 if ( length( $indicator <= 3 ) ) {
749 $marctext.="<td bgcolor=$color valign=top><pre>" .
750 "$indicator</pre></td>" .
751 "<td bgcolor=$color valign=top>" ;
753 $marctext.="<td bgcolor=$color valign=top></td>" .
754 "<td bgcolor=$color valign=top>" .
759 if ( $field->{'subfields'} ) {
760 # start another table for subfields
761 $marctext.= "<table border=0 cellspacing=2>\n";
762 foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
763 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
764 if (ref($subfieldvalue) eq 'ARRAY' ) {
765 # if it's a pointer to array, get all the values
766 @values=@{$subfieldvalue};
768 # otherwise get the one value
769 @values=( $subfieldvalue );
770 } # if subfield array
771 foreach $value ( @values ) {
772 $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
773 "<td>$value</td></tr>\n";
776 $marctext.="</table>\n";
778 # End of indicator and subfields column
779 $marctext.="</td>\n";
782 $marctext.="</tr>\n";
786 $marctext.="</table>\n";
790 } # sub FormatMarcText
794 # log cleared, as marcimport is (almost) rewritten from scratch.
796 # Revision 1.20 2002/10/16 12:46:19 arensb
797 # Added a FIXME comment.
799 # Revision 1.19 2002/10/15 10:14:44 tipaul
800 # road to 1.3.2. Full rewrite of marcimport.pl.
801 # The acquisition system in MARC version will work like this :
802 # * marcimport will put marc records into a "breeding farm" table.
803 # * when the user want to add a biblio, he enters first the ISBN/ISSN of the biblio. koha searches into breeding farm and if the record exists, it is shown to the user to help him adding the biblio. When the biblio is added, it's deleted from the breeding farm.
806 # * modify acqui.simple home page (addbooks.pl)
807 # * adds import into breeding farm
810 # * z3950 functionnality is dropped from "marcimport" will be added somewhere else.
811 # * templates are in a new acqui.simple sub directory, and the marcimport template directory will become obsolete soon.I think this is more logic