koha-dev.rot13.org Git - koha_fer/blob - acqui.simple/marcimport.pl

   1 #!/usr/bin/perl
   2
   3 # $Id$
   4
   5 # Script for handling import of MARC data into Koha db
   6 #   and Z39.50 lookups
   7
   8 # Koha library project  www.koha.org
   9
  10 # Licensed under the GPL
  11
  12
  13 # Copyright 2000-2002 Katipo Communications
  14 #
  15 # This file is part of Koha.
  16 #
  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
  20 # version.
  21 #
  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.
  25 #
  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
  29
  30 use strict;
  31
  32 # standard or CPAN modules used
  33 use CGI;
  34 use DBI;
  35
  36 # Koha modules used
  37 use C4::Context;
  38 #use C4::Database;
  39 use C4::Acquisitions;
  40 use C4::Output;
  41 use C4::Input;
  42 use C4::Biblio;
  43 #use C4::SimpleMarc;
  44 #use C4::Z3950;
  45 use MARC::File::USMARC;
  46 use HTML::Template;
  47
  48 #------------------
  49 # Constants
  50
  51 my $includes = C4::Context->config('includes') ||
  52         "/usr/local/www/hdl/htdocs/includes";
  53
  54 # HTML colors for alternating lines
  55 my $lc1='#dddddd';
  56 my $lc2='#ddaaaa';
  57
  58 #-------------
  59 #-------------
  60 # Initialize
  61
  62 my $userid=$ENV{'REMOTE_USER'};
  63
  64 my $input = new CGI;
  65 my $dbh = C4::Context->dbh;
  66
  67 my $uploadmarc=$input->param('uploadmarc');
  68 my $overwrite_biblio = $input->param('overwrite_biblio');
  69 my $filename = $input->param('filename');
  70
  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) {
  75         my $marcrecord='';
  76         while (<$uploadmarc>) {
  77                 $marcrecord.=$_;
  78         }
  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
  86         my $imported=0;
  87         my $alreadyindb = 0;
  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) {
  93                         $notmarcrecord++;
  94                 } else {
  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
  99                                 my $biblioitemnumber;
 100                                 if ($oldbiblio->{isbn}) {
 101                                         $searchisbn->execute($oldbiblio->{isbn});
 102                                         ($biblioitemnumber) = $searchisbn->fetchrow;
 103                                 } else {
 104                                         $searchissn->execute($oldbiblio->{issn});
 105                                         ($biblioitemnumber) = $searchissn->fetchrow;
 106                                 }
 107                                 if ($biblioitemnumber) {
 108                                         $alreadyindb++;
 109                                 } else {
 110                                 # search in breeding farm
 111                                 my $breedingresult;
 112                                         if ($oldbiblio->{isbn}) {
 113                                                 $searchbreeding->execute($oldbiblio->{isbn});
 114                                                 ($breedingresult) = $searchbreeding->fetchrow;
 115                                         } else {
 116                                                 $searchbreeding->execute($oldbiblio->{issn});
 117                                                 ($breedingresult) = $searchbreeding->fetchrow;
 118                                         }
 119                                         if (!$breedingresult || $overwrite_biblio) {
 120                                                 $insertsql ->execute($filename,$oldbiblio->{isbn}.$oldbiblio->{issn},$marcarray[$i]."\x1D')");
 121                                                 $imported++;
 122                                         } else {
 123                                                 $alreadyinfarm++;
 124                                         }
 125                                 }
 126                         } else {
 127                                 $notmarcrecord++;
 128                         }
 129                 }
 130         }
 131         $template->param(imported => $imported,
 132                                                         alreadyindb => $alreadyindb,
 133                                                         alreadyinfarm => $alreadyinfarm,
 134                                                         notmarcrecord => $notmarcrecord,
 135                                                         total => $imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
 136                                                         );
 137
 138 }
 139
 140 print "Content-Type: text/html\n\n",$template->output;
 141 my $menu;
 142 my $file;
 143
 144 # Process a MARC file : show list of records, of 1 record detail, if numrecord exists
 145 sub ProcessFile {
 146     # A MARC file has been specified; process it for review form
 147     use strict;
 148     # Input params
 149     my (
 150         $input,
 151     )=@_;
 152
 153     # local vars
 154     my (
 155         $sth,
 156         $record,
 157     );
 158
 159     my $debug=0;
 160
 161     # See if a particular result item was specified
 162     my $numrecord = $input->param('numrecord');
 163     if ($numrecord) {
 164         ProcessRecord($dbh,$input,$numrecord);
 165     } else {
 166         # No result item specified, list results
 167         ListFileRecords($dbh,$input);
 168     } # if
 169 } # sub ProcessFile
 170
 171 # show 1 record from the MARC file
 172 sub ProcessRecord {
 173     my ($dbh, $input,$numrecord) = @_;
 174     # local vars
 175     my (
 176         $sth,
 177         $record,
 178         $data,
 179     );
 180
 181     if ($file=~/Z-(\d+)/) {
 182         my $id=$1;
 183         my $resultsid=$input->param('resultsid');
 184         my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
 185         $sth->execute;
 186         ($data) = $sth->fetchrow;
 187     } else {
 188         my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
 189         $sth->execute;
 190         ($data) = $sth->fetchrow;
 191     }
 192
 193     my $file=MARC::File::USMARC->indata ($data);
 194     my $oldkoha;
 195     for (my $i=1;$i<$numrecord;$i++) {
 196         $record = $file->next;
 197     }
 198     if ($record) {
 199         $oldkoha=MARCmarc2koha($dbh,$record);
 200     }
 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
 206     my @loop = ();
 207     my $tagmeaning = &MARCgettagslib($dbh,1);
 208     my @fields = $record->fields();
 209     my $color=0;
 210     my $lasttag="";
 211     foreach my $field (@fields) {
 212         my @subfields=$field->subfields();
 213         foreach my $subfieldcount (0..$#subfields) {
 214             my %row_data;
 215             if ($lasttag== $field->tag()) {
 216                 $row_data{tagid}   = "";
 217             } else {
 218                 $row_data{tagid}   = $field->tag();
 219             }
 220             $row_data{subfield} = $subfields[$subfieldcount][0];
 221             $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]};
 222             $row_data{tagvalue}= $subfields[$subfieldcount][1];
 223             if ($color ==0) {
 224                 $color=1;
 225                 $row_data{color} = $lc1;
 226             } else {
 227                 $color=0;
 228                 $row_data{color} = $lc2;
 229             }
 230             push(@loop,\%row_data);
 231             $lasttag=$field->tag();
 232         }
 233     }
 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;
 238 }
 239
 240 # lists all records from the MARC file
 241 sub ListFileRecords {
 242     use strict;
 243
 244     # Input parameters
 245     my (
 246         $dbh,           # FIXME - Unused argument
 247         $input,
 248     )=@_;
 249
 250     my (
 251         $sth, $sti,
 252         $field,
 253         $data,          # records in MARC file format
 254         $name,
 255         $srvid,
 256         %servernames,
 257         $serverdb,
 258     );
 259
 260     my $z3950=0;
 261     my $recordsource;
 262     my $record;
 263     my ($numrecords,$resultsid,$data,$startdate,$enddate);
 264                 # FIXME - there's already a $data a few lines above.
 265
 266     $dbh = C4::Context->dbh;
 267
 268     my $template=gettemplate('marcimport/ListFileRecords.tmpl');
 269     # File can be z3950 search query or uploaded MARC data
 270
 271     # if z3950 results
 272     if (not $file=~/Z-(\d+)/) {
 273         # This is a Marc upload
 274         $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
 275         $sth->execute;
 276         ($data, $name) = $sth->fetchrow;
 277         $template->param(IS_MARC => 1);
 278         $template->param(recordsource => $name);
 279     }
 280
 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
 285         my $serverstring;
 286         my $starttimer=time();
 287
 288         $sth=$dbh->prepare("
 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=?
 294                 order by server
 295             ");
 296         $sth->execute($id);
 297         if ( $sth->rows ) {
 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);
 302                 if ( $server ) {
 303                         my $srvname=&z3950servername($dbh,$srvid,"$server/$database");
 304                         $template->param(srvid => $srvid);
 305                         $template->param(srvname => $srvname);
 306                 } # if $server
 307                 my $startrecord=$input->param("ST-$srvid");
 308                 ($startrecord) || ($startrecord='0');
 309                 my $serverplaceholder='';
 310                 foreach ($input->param) {
 311                     (next) unless (/ST-(.+)/);
 312                     my $serverid=$1;
 313                     (next) if ($serverid eq $srvid);
 314                     my $place=$input->param("ST-$serverid");
 315                     $serverplaceholder.="\&ST-$serverid=$place";
 316                 }
 317                 if ($numrecords) {
 318                     $template->param(HAS_NUMRECORDS => 1);
 319                     my $previous='';
 320                     my $next='';
 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>";
 323                     }
 324                     my $highest;
 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>";
 329                     }
 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);
 338                 }
 339
 340                 if (! $server ) {
 341                     $template->param(PENDING => 1);
 342                 } elsif ($enddate == 0) {
 343                     my $now=time();
 344                     my $elapsed=$now-$startdate;
 345                     my $elapsedtime='';
 346                     if ($elapsed>60) {
 347                         $elapsedtime=sprintf "%d minutes",($elapsed/60);
 348                     } else {
 349                         $elapsedtime=sprintf "%d seconds",$elapsed;
 350                     }
 351                     $template->param(elapsedtime => $elapsedtime);
 352                 } elsif ($numrecords) {
 353                     my @loop = ();
 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);
 358                         push(@loop,\%row);
 359                     }
 360                     $template->param(LINES => \@loop);
 361                 } else {
 362                 }
 363 #               print "</ul>\n";
 364             } # foreach server
 365             my $elapsed=time()-$starttimer;
 366 #           print "<hr>It took $elapsed seconds to process this page.\n";
 367             } else {
 368                 $template->param(NO_RECORDS =>1);
 369                 $template->param(id => $id);
 370             } # if rows
 371
 372         } else {
 373 #
 374 # This is an uploaded Marc record
 375 #
 376             my @loop = ();
 377             my $MARCfile = MARC::File::USMARC->indata($data);
 378             my $num = 0;
 379             while (my $record=$MARCfile->next) {
 380                 $num++;
 381                 my $oldkoha = MARCmarc2koha($dbh,$record);
 382                 my %row = ResultRecordLink($dbh,$oldkoha,'',$num);
 383                 push(@loop,\%row);
 384             }
 385             $template->param(LINES => \@loop);
 386         } # if z3950 or marc upload
 387         print "Content-Type: text/html\n\n", $template->output;
 388 } # sub ListFileRecords
 389
 390 #--------------
 391
 392 sub ResultRecordLink {
 393     use strict;
 394     my ($dbh,$oldkoha,$resultsid, $num)=@_;     # input
 395                 # FIXME - $dbh as argument is no longer used
 396     my (
 397         $sth,
 398         $bib,   # hash ref to named fields
 399         $searchfield, $searchvalue,
 400         $donetext,
 401         $fieldname,
 402         );
 403     my %row = ();
 404
 405     $dbh = C4::Context->dbh;
 406
 407 #    $bib=extractmarcfields($record);
 408
 409     $sth=$dbh->prepare("select *
 410           from biblioitems
 411           where (isbn=? and isbn!='')  or (issn=? and issn!='')  or (lccn=? and lccn!='') ");
 412     $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
 413     if ($sth->rows) {
 414         $donetext="DONE";
 415     } else {
 416         $donetext="";
 417     }
 418     ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}");
 419
 420     $searchfield="";
 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
 426     } # foreach
 427     if ( $searchfield ) {
 428         $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'};
 429         $row{donetext}    = $donetext;
 430         $row{file}        = $file;
 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};
 437     } else {
 438         $row{title} = "Error: Problem with <br>$bib->{title} $bib->{author}<br>";
 439     } # if searchfield
 440     return %row;
 441 } # sub PrintResultRecordLink
 442
 443 #---------------------------------
 444
 445
 446 sub uploadmarc {
 447     use strict;
 448     my ($dbh)=@_;               # FIXME - Unused argument
 449
 450     $dbh = C4::Context->dbh;
 451
 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");
 456     $sth->execute;
 457 #    print "<h2>Select a set of MARC records</h2>\n<ul>";
 458     my @marc_loop = ();
 459     while (my ($id, $name) = $sth->fetchrow) {
 460         my %row;
 461         $row{id} = $id;
 462         $row{name} = $name;
 463         push(@marc_loop, \%row);
 464 #       print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
 465     }
 466     $template->param(marc => \@marc_loop);
 467     print "Content-Type: text/html\n\n", $template->output;
 468
 469 }
 470
 471 sub manual {
 472 }
 473
 474
 475 sub mainmenu {
 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;
 479 } # sub mainmenu
 480
 481 #---------------------------------------------
 482 sub AcceptMarcUpload {
 483     use strict;
 484     my (
 485         $dbh,           # DBI handle
 486                         # FIXME - Unused argument
 487         $input,         # CGI parms
 488     )=@_;
 489
 490     $dbh = C4::Context->dbh;
 491
 492     my $name=$input->param('name');
 493     my $data=$input->param('uploadmarc');
 494     my $marcrecord='';
 495
 496     ($name) || ($name=$data);
 497     if (length($data)>0) {
 498         while (<$data>) {
 499             $marcrecord.=$_;
 500         }
 501     }
 502     my $q_marcrecord=$dbh->quote($marcrecord);
 503     my $q_name=$dbh->quote($name);
 504     my $sth=$dbh->prepare("insert into uploadedmarc
 505                 (marc,name)
 506         values ($q_marcrecord, $q_name)");
 507     $sth->execute;
 508 } # sub AcceptMarcUpload
 509
 510 #-------------------------------------------
 511 sub AcceptBiblioitem {
 512     use strict;
 513     my (
 514         $dbh,                   # FIXME - Unused argument
 515         $input,
 516     )=@_;
 517
 518     my $biblionumber=0;
 519     my $biblioitemnumber=0;
 520     my $sth;
 521     my $record;
 522
 523     $dbh = C4::Context->dbh;
 524
 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');
 533
 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');
 539     if ($numrecord) {
 540         for (my $i=1;$i<$numrecord;$i++) {
 541             $record=$file->next;
 542         }
 543     } else {
 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";
 546     }
 547     my $template=gettemplate('marcimport/AcceptBiblioitem.tmpl');
 548
 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
 553         from biblioitems
 554         where isbn=? or issn=? or lccn=?");
 555     $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
 556     if ($sth->rows) {
 557         # Already exists
 558
 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);
 564
 565     } else {
 566         # It doesn't exist; add it.
 567
 568         my $error;
 569         my %biblio;
 570         my %biblioitem;
 571
 572         # convert to upper case and split on lines
 573         my $subjectheadings=$input->param('subject');
 574         my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
 575
 576         my $additionalauthors=$input->param('additionalauthors');
 577         my @additionalauthors=split(/[\r\n]+|\|/,uc($additionalauthors));
 578
 579         # Use individual assignments to hash buckets, in case
 580         #  any of the input parameters are empty or don't exist
 581         $biblio{title}          =$input->param('title');
 582         $biblio{author}         =$input->param('author');
 583         $biblio{copyright}      =$input->param('copyrightdate');
 584         $biblio{seriestitle}    =$input->param('seriestitle');
 585         $biblio{notes}          =$input->param('notes');
 586         $biblio{abstract}       =$input->param('abstract');
 587         $biblio{subtitle}       =$input->param('subtitle');
 588
 589         $biblioitem{volume}             =$input->param('volume');
 590         $biblioitem{number}             =$input->param('number');
 591         $biblioitem{itemtype}           =$input->param('itemtype');
 592         $biblioitem{isbn}               =$input->param('isbn');
 593         $biblioitem{issn}               =$input->param('issn');
 594         $biblioitem{dewey}              =$input->param('dewey');
 595         $biblioitem{subclass}           =$input->param('subclass');
 596         $biblioitem{publicationyear}    =$input->param('publicationyear');
 597         $biblioitem{publishercode}      =$input->param('publishercode');
 598         $biblioitem{volumedate}         =$input->param('volumedate');
 599         $biblioitem{volumeddesc}        =$input->param('volumeddesc');
 600         $biblioitem{illus}              =$input->param('illustrator');
 601         $biblioitem{pages}              =$input->param('pages');
 602         $biblioitem{notes}              =$input->param('notes');
 603         $biblioitem{size}               =$input->param('size');
 604         $biblioitem{place}              =$input->param('place');
 605         $biblioitem{lccn}               =$input->param('lccn');
 606         $biblioitem{marc}               =$input->param('marc');
 607 #       print STDERR $record->as_formatted();
 608 #       die;
 609         ($biblionumber, $biblioitemnumber, $error)=
 610             ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
 611 #           (1,2,0);
 612 #         newcompletebiblioitem($dbh,
 613 #               \%biblio,
 614 #               \%biblioitem,
 615 #               \@subjectheadings,
 616 #               \@additionalauthors
 617 #       );
 618
 619         if ( $error ) {
 620             print "<H2>Error adding biblio item</H2> $error\n";
 621         } else {
 622             $template->param(title => $title);
 623             $template->param(biblionumber => $biblionumber);
 624             $template->param(biblioitemnumber => $biblioitemnumber);
 625             $template->param(BIBLIO_CREATE => 1);
 626         } # if error
 627     } # if new record
 628     my $barcode;
 629
 630     # Get next barcode, or pick random one if none exist yet
 631     $sth=$dbh->prepare("select max(barcode) from items");
 632     $sth->execute;
 633     ($barcode) = $sth->fetchrow;
 634     $barcode++;
 635     if ($barcode==1) {
 636         $barcode=int(rand()*1000000);
 637     }
 638     my $branchselect=getkeytableselectoptions(
 639                 $dbh, 'branches', 'branchcode', 'branchname', 0);
 640     $template->param(barcode => $barcode);
 641     $template->param(branchselect => $branchselect);
 642     print "Content-Type: text/html\n\n", $template->output;
 643
 644 } # sub ItemCopyForm
 645
 646 #---------------------------------------
 647 # Accept form data to add an item copy
 648 sub AcceptItemCopy {
 649     use strict;
 650     my ( $dbh, $input )=@_;
 651                         # FIXME - $dbh argument unused
 652
 653     my $template=gettemplate('marcimport/AcceptItemCopy.tmpl');
 654
 655     my $error;
 656
 657     $dbh = C4::Context->dbh;
 658
 659     my $barcode=$input->param('barcode');
 660     my $replacementprice=($input->param('replacementprice') || 0);
 661
 662     my $sth=$dbh->prepare("select barcode
 663         from items
 664         where barcode=?");
 665     $sth->execute($barcode);
 666     if ($sth->rows) {
 667         $template->param(BARCODE_EXISTS => 1);
 668         $template->param(barcode => $barcode);
 669     } else {
 670            # Insert new item into database
 671            $error=&ALLnewitem($dbh,
 672                                { biblionumber=> $input->param('biblionumber'),
 673                                  biblioitemnumber=> $input->param('biblioitemnumber'),
 674                                  itemnotes=> $input->param('notes'),
 675                                  homebranch=> $input->param('homebranch'),
 676                                  replacementprice=> $replacementprice,
 677                                  barcode => $barcode
 678                                  }
 679                                );
 680             if ( $error ) {
 681                 $template->param(ITEM_ERROR => 1);
 682                 $template->param(error => $error);
 683             } else {
 684                 $template->param(ITEM_CREATED => 1);
 685                 $template->param(barcode => $barcode);
 686             } # if error
 687     } # if barcode exists
 688     print "Content-Type: text/html\n\n", $template->output;
 689 } # sub AcceptItemCopy
 690
 691 #---------------------------------------
 692 sub FormatMarcText {
 693     use strict;
 694
 695     # Input
 696     my (
 697         $fields,        # list ref to MARC fields
 698     )=@_;
 699     # Return
 700     my $marctext;
 701
 702     my (
 703         $color,
 704         $field,
 705         $tag,
 706         $label,
 707         $indicator,
 708         $subfieldcode,$subfieldvalue,
 709         @values, $value
 710     );
 711     my $debug=0;
 712
 713     #-----------------------------------------
 714
 715     $marctext="<table border=0 cellspacing=1>
 716         <tr><th colspan=4 background=/images/background-acq.gif>
 717                 MARC RECORD
 718         </th></tr>\n";
 719
 720     foreach $field ( @$fields ) {
 721
 722         # Swap colors on alternating lines
 723         ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
 724
 725         $tag=$field->{'tag'};
 726         $label=taglabel($tag);
 727
 728         if ( $tag eq 'LDR' ) {
 729                 $tag='';
 730                 $label="Leader:";
 731         }
 732         print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
 733
 734         $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
 735                 "<td bgcolor=$color valign=top>$tag</td> \n";
 736
 737         $indicator=$field->{'indicator'};
 738         $indicator=~s/ +$//;    # drop trailing blanks
 739
 740         # Third table column has indicator if it is short.
 741         # Fourth column has embedded table of subfields, and indicator
 742         #  if it is long (leader or fixed-position fields)
 743
 744         print "<pre>Format indicator=$indicator" .
 745                 " length=" . length( $indicator ) .  "</pre>\n" if $debug;
 746         if ( length( $indicator <= 3 ) ) {
 747             $marctext.="<td bgcolor=$color valign=top><pre>" .
 748                 "$indicator</pre></td>" .
 749                 "<td bgcolor=$color valign=top>" ;
 750         } else {
 751             $marctext.="<td bgcolor=$color valign=top></td>" .
 752                 "<td bgcolor=$color valign=top>" .
 753                 "$indicator ";
 754         } # if length
 755
 756         # Subfields
 757         if ( $field->{'subfields'} )  {
 758             # start another table for subfields
 759             $marctext.= "<table border=0 cellspacing=2>\n";
 760             foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} }   )) {
 761                 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
 762                 if (ref($subfieldvalue) eq 'ARRAY' ) {
 763                     # if it's a pointer to array, get all the values
 764                     @values=@{$subfieldvalue};
 765                 } else {
 766                     # otherwise get the one value
 767                     @values=( $subfieldvalue );
 768                 } # if subfield array
 769                 foreach $value ( @values ) {
 770                   $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
 771                     "<td>$value</td></tr>\n";
 772                 } # foreach value
 773             } # foreach subfield
 774             $marctext.="</table>\n";
 775         } # if subfields
 776         # End of indicator and subfields column
 777         $marctext.="</td>\n";
 778
 779         # End of columns
 780         $marctext.="</tr>\n";
 781
 782     } # foreach field
 783
 784     $marctext.="</table>\n";
 785
 786     return $marctext;
 787
 788 } # sub FormatMarcText
 789
 790
 791 #---------------
 792 # log cleared, as marcimport is (almost) rewritten from scratch.
 793 # $Log$
 794 # Revision 1.19  2002/10/15 10:14:44  tipaul
 795 # road to 1.3.2. Full rewrite of marcimport.pl.
 796 # The acquisition system in MARC version will work like this :
 797 # * marcimport will put marc records into a "breeding farm" table.
 798 # * 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.
 799 #
 800 # This commit :
 801 # * modify acqui.simple home page  (addbooks.pl)
 802 # * adds import into breeding farm
 803 #
 804 # Please note that :
 805 # * z3950 functionnality is dropped from "marcimport" will be added somewhere else.
 806 # * templates are in a new acqui.simple sub directory, and the marcimport template directory will become obsolete soon.I think this is more logic
 807 #