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
39 #use C4::Acquisitions;
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 # drop every "special" char : spaces, - ...
99 $oldbiblio->{isbn} =~ s/ |-|\.//g,
100 # search if biblio exists
101 my $biblioitemnumber;
102 if ($oldbiblio->{isbn}) {
103 $searchisbn->execute($oldbiblio->{isbn});
104 ($biblioitemnumber) = $searchisbn->fetchrow;
106 $searchissn->execute($oldbiblio->{issn});
107 ($biblioitemnumber) = $searchissn->fetchrow;
109 if ($biblioitemnumber) {
112 # search in breeding farm
114 if ($oldbiblio->{isbn}) {
115 $searchbreeding->execute($oldbiblio->{isbn});
116 ($breedingresult) = $searchbreeding->fetchrow;
118 $searchbreeding->execute($oldbiblio->{issn});
119 ($breedingresult) = $searchbreeding->fetchrow;
121 if (!$breedingresult || $overwrite_biblio) {
123 warn "IMPORT => $marcarray[$i]\x1D')";
124 $recoded = $marcrecord->as_usmarc(); #MARC::File::USMARC::encode($marcrecord);
125 warn "RECODED : $recoded";
126 $insertsql ->execute($filename,$oldbiblio->{isbn}.$oldbiblio->{issn},$recoded);
137 $template->param(imported => $imported,
138 alreadyindb => $alreadyindb,
139 alreadyinfarm => $alreadyinfarm,
140 notmarcrecord => $notmarcrecord,
141 total => $imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
146 print "Content-Type: text/html\n\n",$template->output;
150 # Process a MARC file : show list of records, of 1 record detail, if numrecord exists
152 # A MARC file has been specified; process it for review form
167 # See if a particular result item was specified
168 my $numrecord = $input->param('numrecord');
170 ProcessRecord($dbh,$input,$numrecord);
172 # No result item specified, list results
173 ListFileRecords($dbh,$input);
177 # show 1 record from the MARC file
179 my ($dbh, $input,$numrecord) = @_;
187 if ($file=~/Z-(\d+)/) {
189 my $resultsid=$input->param('resultsid');
190 my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
192 ($data) = $sth->fetchrow;
194 my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
196 ($data) = $sth->fetchrow;
199 my $file=MARC::File::USMARC->indata ($data);
201 for (my $i=1;$i<$numrecord;$i++) {
202 $record = $file->next;
205 $oldkoha=MARCmarc2koha($dbh,$record);
207 my $template=gettemplate('marcimport/marcimportdetail.tmpl');
208 $oldkoha->{additionalauthors} =~ s/ \| /\n/g;
209 $oldkoha =~ s/\|/\n/g;
210 $template->param($oldkoha);
211 #---- build MARC array for template
213 my $tagmeaning = &MARCgettagslib($dbh,1);
214 my @fields = $record->fields();
217 foreach my $field (@fields) {
218 my @subfields=$field->subfields();
219 foreach my $subfieldcount (0..$#subfields) {
221 if ($lasttag== $field->tag()) {
222 $row_data{tagid} = "";
224 $row_data{tagid} = $field->tag();
226 $row_data{subfield} = $subfields[$subfieldcount][0];
227 $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]};
228 $row_data{tagvalue}= $subfields[$subfieldcount][1];
231 $row_data{color} = $lc1;
234 $row_data{color} = $lc2;
236 push(@loop,\%row_data);
237 $lasttag=$field->tag();
240 $template->param(MARC => \@loop);
241 $template->param(numrecord => $numrecord);
242 $template->param(file => $data);
243 print "Content-Type: text/html\n\n", $template->output;
246 # lists all records from the MARC file
247 sub ListFileRecords {
252 $dbh, # FIXME - Unused argument
259 $data, # records in MARC file format
269 my ($numrecords,$resultsid,$data,$startdate,$enddate);
270 # FIXME - there's already a $data a few lines above.
272 $dbh = C4::Context->dbh;
274 my $template=gettemplate('marcimport/ListFileRecords.tmpl');
275 # File can be z3950 search query or uploaded MARC data
278 if (not $file=~/Z-(\d+)/) {
279 # This is a Marc upload
280 $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
282 ($data, $name) = $sth->fetchrow;
283 $template->param(IS_MARC => 1);
284 $template->param(recordsource => $name);
287 if ($file=~/Z-(\d+)/) {
288 # This is a z3950 search
289 $template->param(IS_Z3950 =>1);
290 my $id=$1; # search query id number
292 my $starttimer=time();
295 select z3950results.numrecords,z3950results.id,z3950results.results,
296 z3950results.startdate,z3950results.enddate,server
297 from z3950queue left outer join z3950results
298 on z3950queue.id=z3950results.queryid
299 where z3950queue.id=?
304 # loop through all servers in search results
305 while ( ($numrecords,$resultsid,$data,
306 $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
307 my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
309 my $srvname=&z3950servername($dbh,$srvid,"$server/$database");
310 $template->param(srvid => $srvid);
311 $template->param(srvname => $srvname);
313 my $startrecord=$input->param("ST-$srvid");
314 ($startrecord) || ($startrecord='0');
315 my $serverplaceholder='';
316 foreach ($input->param) {
317 (next) unless (/ST-(.+)/);
319 (next) if ($serverid eq $srvid);
320 my $place=$input->param("ST-$serverid");
321 $serverplaceholder.="\&ST-$serverid=$place";
324 $template->param(HAS_NUMRECORDS => 1);
327 if ($startrecord>0) {
328 $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
331 $highest=$startrecord+10;
332 ($highest>$numrecords) && ($highest=$numrecords);
333 if ($numrecords>$startrecord+10) {
334 $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
336 $template->param(startrecord => $startrecord+1);
337 $template->param(highest => $highest);
338 $template->param(numrecords => $numrecords);
339 $template->param(previous => $previous);
340 $template->param(next => $next);
341 my $stj=$dbh->prepare("update z3950results
342 set highestseen=? where id=?");
343 $stj->execute($startrecord+10,$resultsid);
347 $template->param(PENDING => 1);
348 } elsif ($enddate == 0) {
350 my $elapsed=$now-$startdate;
353 $elapsedtime=sprintf "%d minutes",($elapsed/60);
355 $elapsedtime=sprintf "%d seconds",$elapsed;
357 $template->param(elapsedtime => $elapsedtime);
358 } elsif ($numrecords) {
360 my $z3950file=MARC::File::USMARC->indata ($data);
361 while (my $record=$z3950file->next) {
362 my $oldkoha = MARCmarc2koha($dbh,$record);
363 my %row = ResultRecordLink($dbh,$oldkoha,$resultsid);
366 $template->param(LINES => \@loop);
371 my $elapsed=time()-$starttimer;
372 # print "<hr>It took $elapsed seconds to process this page.\n";
374 $template->param(NO_RECORDS =>1);
375 $template->param(id => $id);
380 # This is an uploaded Marc record
383 my $MARCfile = MARC::File::USMARC->indata($data);
385 while (my $record=$MARCfile->next) {
387 my $oldkoha = MARCmarc2koha($dbh,$record);
388 my %row = ResultRecordLink($dbh,$oldkoha,'',$num);
391 $template->param(LINES => \@loop);
392 } # if z3950 or marc upload
393 print "Content-Type: text/html\n\n", $template->output;
394 } # sub ListFileRecords
398 sub ResultRecordLink {
400 my ($dbh,$oldkoha,$resultsid, $num)=@_; # input
401 # FIXME - $dbh as argument is no longer used
404 $bib, # hash ref to named fields
405 $searchfield, $searchvalue,
411 $dbh = C4::Context->dbh;
413 # $bib=extractmarcfields($record);
415 $sth=$dbh->prepare("select *
417 where (isbn=? and isbn!='') or (issn=? and issn!='') or (lccn=? and lccn!='') ");
418 $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
424 ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}");
427 foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
428 if ( defined $oldkoha->{$fieldname} && $oldkoha->{$fieldname} ) {
429 $searchfield=$fieldname;
430 $searchvalue=$oldkoha->{$fieldname};
431 } # if defined fieldname
433 if ( $searchfield ) {
434 $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'};
435 $row{donetext} = $donetext;
437 # $row{resultsid} = $resultsid;
438 # $row{searchfield} = $searchfield;
439 # $row{searchvalue} = $searchvalue;
440 $row{numrecord} = $num;
441 $row{title} = $oldkoha->{title};
442 $row{author} = $oldkoha->{author};
444 $row{title} = "Error: Problem with <br>$bib->{title} $bib->{author}<br>";
447 } # sub PrintResultRecordLink
449 #---------------------------------
454 my ($dbh)=@_; # FIXME - Unused argument
456 $dbh = C4::Context->dbh;
458 my $template=gettemplate('marcimport/uploadmarc.tmpl');
459 $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
460 # print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
461 my $sth=$dbh->prepare("select id,name from uploadedmarc");
463 # print "<h2>Select a set of MARC records</h2>\n<ul>";
465 while (my ($id, $name) = $sth->fetchrow) {
469 push(@marc_loop, \%row);
470 # print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
472 $template->param(marc => \@marc_loop);
473 print "Content-Type: text/html\n\n", $template->output;
482 my $template=gettemplate('marcimport/mainmenu.tmpl');
483 $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
484 print "Content-Type: text/html\n\n", $template->output;
487 #---------------------------------------------
488 sub AcceptMarcUpload {
492 # FIXME - Unused argument
496 $dbh = C4::Context->dbh;
498 my $name=$input->param('name');
499 my $data=$input->param('uploadmarc');
502 ($name) || ($name=$data);
503 if (length($data)>0) {
508 my $q_marcrecord=$dbh->quote($marcrecord);
509 my $q_name=$dbh->quote($name);
510 my $sth=$dbh->prepare("insert into uploadedmarc
512 values ($q_marcrecord, $q_name)");
514 } # sub AcceptMarcUpload
516 #-------------------------------------------
517 sub AcceptBiblioitem {
520 $dbh, # FIXME - Unused argument
525 my $biblioitemnumber=0;
529 $dbh = C4::Context->dbh;
531 # my $isbn=$input->param('isbn');
532 # my $issn=$input->param('issn');
533 # my $lccn=$input->param('lccn');
534 # my $q_origisbn=$dbh->quote($input->param('origisbn'));
535 # my $q_origissn=$dbh->quote($input->param('origissn'));
536 # my $q_origlccn=$dbh->quote($input->param('origlccn'));
537 # my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
538 my $title=$input->param('title');
540 # my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
541 # my $q_issn=$dbh->quote((($issn) || ('NIL')));
542 # my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
543 my $file= MARC::File::USMARC->indata($input->param('file'));
544 my $numrecord = $input->param('numrecord');
546 for (my $i=1;$i<$numrecord;$i++) {
550 print STDERR "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined\n";
551 print "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined : contact administrator\n";
553 my $template=gettemplate('marcimport/AcceptBiblioitem.tmpl');
555 my $oldkoha = MARCmarc2koha($dbh,$record);
556 # See if it already exists
557 # FIXME - There's already a $sth in this context.
558 my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
560 where isbn=? or issn=? or lccn=?");
561 $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
565 ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
566 $template->param(title => $title);
567 $template->param(biblionumber => $biblionumber);
568 $template->param(biblioitemnumber => $biblioitemnumber);
569 $template->param(BIBLIO_EXISTS => 1);
572 # It doesn't exist; add it.
578 # convert to upper case and split on lines
579 my $subjectheadings=$input->param('subject');
580 my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
582 my $additionalauthors=$input->param('additionalauthors');
583 my @additionalauthors=split(/[\r\n]+|\|/,uc($additionalauthors));
584 # FIXME - WTF are the additional authors
585 # converted to upper case?
587 # Use individual assignments to hash buckets, in case
588 # any of the input parameters are empty or don't exist
589 $biblio{title} =$input->param('title');
590 $biblio{author} =$input->param('author');
591 $biblio{copyright} =$input->param('copyrightdate');
592 $biblio{seriestitle} =$input->param('seriestitle');
593 $biblio{notes} =$input->param('notes');
594 $biblio{abstract} =$input->param('abstract');
595 $biblio{subtitle} =$input->param('subtitle');
597 $biblioitem{volume} =$input->param('volume');
598 $biblioitem{number} =$input->param('number');
599 $biblioitem{itemtype} =$input->param('itemtype');
600 $biblioitem{isbn} =$input->param('isbn');
601 $biblioitem{issn} =$input->param('issn');
602 $biblioitem{dewey} =$input->param('dewey');
603 $biblioitem{subclass} =$input->param('subclass');
604 $biblioitem{publicationyear} =$input->param('publicationyear');
605 $biblioitem{publishercode} =$input->param('publishercode');
606 $biblioitem{volumedate} =$input->param('volumedate');
607 $biblioitem{volumeddesc} =$input->param('volumeddesc');
608 $biblioitem{illus} =$input->param('illustrator');
609 $biblioitem{pages} =$input->param('pages');
610 $biblioitem{notes} =$input->param('notes');
611 $biblioitem{size} =$input->param('size');
612 $biblioitem{place} =$input->param('place');
613 $biblioitem{lccn} =$input->param('lccn');
614 $biblioitem{marc} =$input->param('marc');
615 # print STDERR $record->as_formatted();
617 ($biblionumber, $biblioitemnumber, $error)=
618 ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
620 # newcompletebiblioitem($dbh,
624 # \@additionalauthors
628 print "<H2>Error adding biblio item</H2> $error\n";
630 $template->param(title => $title);
631 $template->param(biblionumber => $biblionumber);
632 $template->param(biblioitemnumber => $biblioitemnumber);
633 $template->param(BIBLIO_CREATE => 1);
638 # Get next barcode, or pick random one if none exist yet
639 $sth=$dbh->prepare("select max(barcode) from items");
641 ($barcode) = $sth->fetchrow;
644 $barcode=int(rand()*1000000);
646 my $branchselect=getkeytableselectoptions(
647 $dbh, 'branches', 'branchcode', 'branchname', 0);
648 $template->param(barcode => $barcode);
649 $template->param(branchselect => $branchselect);
650 print "Content-Type: text/html\n\n", $template->output;
654 #---------------------------------------
655 # Accept form data to add an item copy
658 my ( $dbh, $input )=@_;
659 # FIXME - $dbh argument unused
661 my $template=gettemplate('marcimport/AcceptItemCopy.tmpl');
665 $dbh = C4::Context->dbh;
667 my $barcode=$input->param('barcode');
668 my $replacementprice=($input->param('replacementprice') || 0);
670 my $sth=$dbh->prepare("select barcode
673 $sth->execute($barcode);
675 $template->param(BARCODE_EXISTS => 1);
676 $template->param(barcode => $barcode);
678 # Insert new item into database
679 $error=&ALLnewitem($dbh,
680 { biblionumber=> $input->param('biblionumber'),
681 biblioitemnumber=> $input->param('biblioitemnumber'),
682 itemnotes=> $input->param('notes'),
683 homebranch=> $input->param('homebranch'),
684 replacementprice=> $replacementprice,
689 $template->param(ITEM_ERROR => 1);
690 $template->param(error => $error);
692 $template->param(ITEM_CREATED => 1);
693 $template->param(barcode => $barcode);
695 } # if barcode exists
696 print "Content-Type: text/html\n\n", $template->output;
697 } # sub AcceptItemCopy
699 #---------------------------------------
705 $fields, # list ref to MARC fields
716 $subfieldcode,$subfieldvalue,
721 #-----------------------------------------
723 $marctext="<table border=0 cellspacing=1>
724 <tr><th colspan=4 background=/images/background-acq.gif>
728 foreach $field ( @$fields ) {
730 # Swap colors on alternating lines
731 ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
733 $tag=$field->{'tag'};
734 $label=taglabel($tag);
736 if ( $tag eq 'LDR' ) {
740 print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
742 $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
743 "<td bgcolor=$color valign=top>$tag</td> \n";
745 $indicator=$field->{'indicator'};
746 $indicator=~s/ +$//; # drop trailing blanks
748 # Third table column has indicator if it is short.
749 # Fourth column has embedded table of subfields, and indicator
750 # if it is long (leader or fixed-position fields)
752 print "<pre>Format indicator=$indicator" .
753 " length=" . length( $indicator ) . "</pre>\n" if $debug;
754 if ( length( $indicator <= 3 ) ) {
755 $marctext.="<td bgcolor=$color valign=top><pre>" .
756 "$indicator</pre></td>" .
757 "<td bgcolor=$color valign=top>" ;
759 $marctext.="<td bgcolor=$color valign=top></td>" .
760 "<td bgcolor=$color valign=top>" .
765 if ( $field->{'subfields'} ) {
766 # start another table for subfields
767 $marctext.= "<table border=0 cellspacing=2>\n";
768 foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
769 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
770 if (ref($subfieldvalue) eq 'ARRAY' ) {
771 # if it's a pointer to array, get all the values
772 @values=@{$subfieldvalue};
774 # otherwise get the one value
775 @values=( $subfieldvalue );
776 } # if subfield array
777 foreach $value ( @values ) {
778 $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
779 "<td>$value</td></tr>\n";
782 $marctext.="</table>\n";
784 # End of indicator and subfields column
785 $marctext.="</td>\n";
788 $marctext.="</tr>\n";
792 $marctext.="</table>\n";
796 } # sub FormatMarcText
800 # log cleared, as marcimport is (almost) rewritten from scratch.
802 # Revision 1.22 2002/11/12 15:58:43 tipaul
805 # * adding value_builder : you can map a subfield in the marc_subfield_structure to a sub stored in "value_builder" directory. In this directory you can create screen used to build values with any method. In this commit is a 1st draft of the builder for 100$a unimarc french subfield, which is composed of 35 digits, with 12 differents values (only the 4th first are provided for instance)
807 # Revision 1.21 2002/10/22 15:50:23 tipaul
808 # road to 1.3.2 : adding a biblio in MARC format.
809 # seems to work a few.
811 # * manage html checks (mandatory subfields...)
812 # * add list of acceptable values (authorities)
813 # * manage ## in MARC format
814 # * manage correctly repeatable fields
815 # and probably a LOT of bugfixes
817 # Revision 1.20 2002/10/16 12:46:19 arensb
818 # Added a FIXME comment.
820 # Revision 1.19 2002/10/15 10:14:44 tipaul
821 # road to 1.3.2. Full rewrite of marcimport.pl.
822 # The acquisition system in MARC version will work like this :
823 # * marcimport will put marc records into a "breeding farm" table.
824 # * 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.
827 # * modify acqui.simple home page (addbooks.pl)
828 # * adds import into breeding farm
831 # * z3950 functionnality is dropped from "marcimport" will be added somewhere else.
832 # * templates are in a new acqui.simple sub directory, and the marcimport template directory will become obsolete soon.I think this is more logic