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::Output;
  39 use C4::Charset;
  40 use C4::Input;
  41 use C4::Biblio;
  42 use MARC::File::USMARC;
  43 use HTML::Template;
  44 use C4::Output;
  45 use C4::Auth;
  46
  47 #------------------
  48 # Constants
  49
  50 my $includes = C4::Context->config('includes') ||
  51         "/usr/local/www/hdl/htdocs/includes";
  52
  53 # HTML colors for alternating lines
  54 my $lc1='#dddddd';
  55 my $lc2='#ddaaaa';
  56
  57 #-------------
  58 #-------------
  59 # Initialize
  60
  61 my $userid=$ENV{'REMOTE_USER'};
  62
  63 my $input = new CGI;
  64 my $dbh = C4::Context->dbh;
  65
  66 my $uploadmarc=$input->param('uploadmarc');
  67 my $overwrite_biblio = $input->param('overwrite_biblio');
  68 my $filename = $input->param('filename');
  69 my ($template, $loggedinuser, $cookie)
  70         = get_template_and_user({template_name => "acqui.simple/marcimport.tmpl",
  71                                         query => $input,
  72                                         type => "intranet",
  73                                         authnotrequired => 0,
  74                                         flagsrequired => {parameters => 1},
  75                                         debug => 1,
  76                                         });
  77
  78 $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'},
  79                                                 uploadmarc => $uploadmarc);
  80 if ($uploadmarc && length($uploadmarc)>0) {
  81         my $marcrecord='';
  82         while (<$uploadmarc>) {
  83                 $marcrecord.=$_;
  84         }
  85         my @marcarray = split /\x1D/, $marcrecord;
  86         my $dbh = C4::Context->dbh;
  87         my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
  88         my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
  89         my $searchbreeding = $dbh->prepare("select id from marc_breeding where isbn=?");
  90         my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc) values(?,?,?,?,?)");
  91         my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=? where id=?");
  92         # fields used for import results
  93         my $imported=0;
  94         my $alreadyindb = 0;
  95         my $alreadyinfarm = 0;
  96         my $notmarcrecord = 0;
  97         for (my $i=0;$i<=$#marcarray;$i++) {
  98                 my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D");
  99                 if (ref($marcrecord) eq undef) {
 100                         $notmarcrecord++;
 101                 } else {
 102                         my $oldbiblio = MARCmarc2koha($dbh,$marcrecord);
 103                         $oldbiblio->{title} = char_decode($oldbiblio->{title});
 104                         $oldbiblio->{author} = char_decode($oldbiblio->{author});
 105                         # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
 106                         # drop every "special" char : spaces, - ...
 107                         $oldbiblio->{isbn} =~ s/ |-|\.//g,
 108                         # search if biblio exists
 109                         my $biblioitemnumber;
 110                         if ($oldbiblio->{isbn}) {
 111                                 $searchisbn->execute($oldbiblio->{isbn});
 112                                 ($biblioitemnumber) = $searchisbn->fetchrow;
 113                         } else {
 114                                 $searchissn->execute($oldbiblio->{issn});
 115                                 ($biblioitemnumber) = $searchissn->fetchrow;
 116                         }
 117                         if ($biblioitemnumber) {
 118                                 $alreadyindb++;
 119                         } else {
 120                                 # search in breeding farm
 121                                 my $breedingid;
 122                                 if ($oldbiblio->{isbn}) {
 123                                         $searchbreeding->execute($oldbiblio->{isbn});
 124                                         ($breedingid) = $searchbreeding->fetchrow;
 125                                 } else {
 126                                         $searchbreeding->execute($oldbiblio->{issn});
 127                                         ($breedingid) = $searchbreeding->fetchrow;
 128                                 }
 129                                 if (!$breedingid || $overwrite_biblio) {
 130                                         my $recoded;
 131                                         $recoded = $marcrecord->as_usmarc();
 132                                                 if ($breedingid) {
 133                                                         $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$breedingid);
 134                                                 } else {
 135                                                         $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded);
 136                                                 }
 137                                         $imported++;
 138                                 } else {
 139                                         $alreadyinfarm++;
 140                                 }
 141                         }
 142                 }
 143         }
 144         $template->param(imported => $imported,
 145                                                         alreadyindb => $alreadyindb,
 146                                                         alreadyinfarm => $alreadyinfarm,
 147                                                         notmarcrecord => $notmarcrecord,
 148                                                         total => $imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
 149                                                         );
 150
 151 }
 152
 153 print $input->header(
 154     -type => guesstype($template->output),
 155     -cookie => $cookie
 156 ),$template->output;
 157 my $menu;
 158 my $file;
 159
 160 # Process a MARC file : show list of records, of 1 record detail, if numrecord exists
 161 sub ProcessFile {
 162     # A MARC file has been specified; process it for review form
 163     use strict;
 164     # Input params
 165     my (
 166         $input,
 167     )=@_;
 168
 169     # local vars
 170     my (
 171         $sth,
 172         $record,
 173     );
 174
 175     my $debug=0;
 176
 177     # See if a particular result item was specified
 178     my $numrecord = $input->param('numrecord');
 179     if ($numrecord) {
 180         ProcessRecord($dbh,$input,$numrecord);
 181     } else {
 182         # No result item specified, list results
 183         ListFileRecords($dbh,$input);
 184     } # if
 185 } # sub ProcessFile
 186
 187 # show 1 record from the MARC file
 188 sub ProcessRecord {
 189     my ($dbh, $input,$numrecord) = @_;
 190     # local vars
 191     my (
 192         $sth,
 193         $record,
 194         $data,
 195     );
 196
 197     if ($file=~/Z-(\d+)/) {
 198         my $id=$1;
 199         my $resultsid=$input->param('resultsid');
 200         my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
 201         $sth->execute;
 202         ($data) = $sth->fetchrow;
 203     } else {
 204         my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
 205         $sth->execute;
 206         ($data) = $sth->fetchrow;
 207     }
 208
 209     my $file=MARC::File::USMARC->indata ($data);
 210     my $oldkoha;
 211     for (my $i=1;$i<$numrecord;$i++) {
 212         $record = $file->next;
 213     }
 214     if ($record) {
 215         $oldkoha=MARCmarc2koha($dbh,$record);
 216     }
 217     my $template=gettemplate('marcimport/marcimportdetail.tmpl');
 218     $oldkoha->{additionalauthors} =~ s/ \| /\n/g;
 219     $oldkoha =~ s/\|/\n/g;
 220     $template->param($oldkoha);
 221 #---- build MARC array for template
 222     my @loop = ();
 223     my $tagmeaning = &MARCgettagslib($dbh,1);
 224     my @fields = $record->fields();
 225     my $color=0;
 226     my $lasttag="";
 227     foreach my $field (@fields) {
 228         my @subfields=$field->subfields();
 229         foreach my $subfieldcount (0..$#subfields) {
 230             my %row_data;
 231             if ($lasttag== $field->tag()) {
 232                 $row_data{tagid}   = "";
 233             } else {
 234                 $row_data{tagid}   = $field->tag();
 235             }
 236             $row_data{subfield} = $subfields[$subfieldcount][0];
 237             $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]};
 238             $row_data{tagvalue}= $subfields[$subfieldcount][1];
 239             if ($color ==0) {
 240                 $color=1;
 241                 $row_data{color} = $lc1;
 242             } else {
 243                 $color=0;
 244                 $row_data{color} = $lc2;
 245             }
 246             push(@loop,\%row_data);
 247             $lasttag=$field->tag();
 248         }
 249     }
 250     $template->param(MARC => \@loop);
 251     $template->param(numrecord => $numrecord);
 252     $template->param(file => $data);
 253     print "Content-Type: text/html\n\n", $template->output;
 254 }
 255
 256 # lists all records from the MARC file
 257 sub ListFileRecords {
 258     use strict;
 259
 260     # Input parameters
 261     my (
 262         $dbh,           # FIXME - Unused argument
 263         $input,
 264     )=@_;
 265
 266     my (
 267         $sth, $sti,
 268         $field,
 269         $data,          # records in MARC file format
 270         $name,
 271         $srvid,
 272         %servernames,
 273         $serverdb,
 274     );
 275
 276     my $z3950=0;
 277     my $recordsource;
 278     my $record;
 279     my ($numrecords,$resultsid,$data,$startdate,$enddate);
 280                 # FIXME - there's already a $data a few lines above.
 281
 282     $dbh = C4::Context->dbh;
 283
 284     my $template=gettemplate('marcimport/ListFileRecords.tmpl');
 285     # File can be z3950 search query or uploaded MARC data
 286
 287     # if z3950 results
 288     if (not $file=~/Z-(\d+)/) {
 289         # This is a Marc upload
 290         $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
 291         $sth->execute;
 292         ($data, $name) = $sth->fetchrow;
 293         $template->param(IS_MARC => 1);
 294         $template->param(recordsource => $name);
 295     }
 296
 297     if ($file=~/Z-(\d+)/) {
 298         # This is a z3950 search
 299         $template->param(IS_Z3950 =>1);
 300         my $id=$1;              # search query id number
 301         my $serverstring;
 302         my $starttimer=time();
 303
 304         $sth=$dbh->prepare("
 305                 select z3950results.numrecords,z3950results.id,z3950results.results,
 306                         z3950results.startdate,z3950results.enddate,server
 307                 from z3950queue left outer join z3950results
 308                      on z3950queue.id=z3950results.queryid
 309                 where z3950queue.id=?
 310                 order by server
 311             ");
 312         $sth->execute($id);
 313         if ( $sth->rows ) {
 314             # loop through all servers in search results
 315             while ( ($numrecords,$resultsid,$data,
 316                      $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
 317                 my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
 318                 if ( $server ) {
 319                         my $srvname=&z3950servername($dbh,$srvid,"$server/$database");
 320                         $template->param(srvid => $srvid);
 321                         $template->param(srvname => $srvname);
 322                 } # if $server
 323                 my $startrecord=$input->param("ST-$srvid");
 324                 ($startrecord) || ($startrecord='0');
 325                 my $serverplaceholder='';
 326                 foreach ($input->param) {
 327                     (next) unless (/ST-(.+)/);
 328                     my $serverid=$1;
 329                     (next) if ($serverid eq $srvid);
 330                     my $place=$input->param("ST-$serverid");
 331                     $serverplaceholder.="\&ST-$serverid=$place";
 332                 }
 333                 if ($numrecords) {
 334                     $template->param(HAS_NUMRECORDS => 1);
 335                     my $previous='';
 336                     my $next='';
 337                     if ($startrecord>0) {
 338                         $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
 339                     }
 340                     my $highest;
 341                     $highest=$startrecord+10;
 342                     ($highest>$numrecords) && ($highest=$numrecords);
 343                     if ($numrecords>$startrecord+10) {
 344                         $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
 345                     }
 346                     $template->param(startrecord => $startrecord+1);
 347                     $template->param(highest => $highest);
 348                     $template->param(numrecords => $numrecords);
 349                     $template->param(previous => $previous);
 350                     $template->param(next => $next);
 351                     my $stj=$dbh->prepare("update z3950results
 352                         set highestseen=? where id=?");
 353                     $stj->execute($startrecord+10,$resultsid);
 354                 }
 355
 356                 if (! $server ) {
 357                     $template->param(PENDING => 1);
 358                 } elsif ($enddate == 0) {
 359                     my $now=time();
 360                     my $elapsed=$now-$startdate;
 361                     my $elapsedtime='';
 362                     if ($elapsed>60) {
 363                         $elapsedtime=sprintf "%d minutes",($elapsed/60);
 364                     } else {
 365                         $elapsedtime=sprintf "%d seconds",$elapsed;
 366                     }
 367                     $template->param(elapsedtime => $elapsedtime);
 368                 } elsif ($numrecords) {
 369                     my @loop = ();
 370                     my $z3950file=MARC::File::USMARC->indata ($data);
 371                     while (my $record=$z3950file->next) {
 372                         my $oldkoha = MARCmarc2koha($dbh,$record);
 373                         my %row = ResultRecordLink($dbh,$oldkoha,$resultsid);
 374                         push(@loop,\%row);
 375                     }
 376                     $template->param(LINES => \@loop);
 377                 } else {
 378                 }
 379 #               print "</ul>\n";
 380             } # foreach server
 381             my $elapsed=time()-$starttimer;
 382 #           print "<hr>It took $elapsed seconds to process this page.\n";
 383             } else {
 384                 $template->param(NO_RECORDS =>1);
 385                 $template->param(id => $id);
 386             } # if rows
 387
 388         } else {
 389 #
 390 # This is an uploaded Marc record
 391 #
 392             my @loop = ();
 393             my $MARCfile = MARC::File::USMARC->indata($data);
 394             my $num = 0;
 395             while (my $record=$MARCfile->next) {
 396                 $num++;
 397                 my $oldkoha = MARCmarc2koha($dbh,$record);
 398                 my %row = ResultRecordLink($dbh,$oldkoha,'',$num);
 399                 push(@loop,\%row);
 400             }
 401             $template->param(LINES => \@loop);
 402         } # if z3950 or marc upload
 403         print "Content-Type: text/html\n\n", $template->output;
 404 } # sub ListFileRecords
 405
 406 #--------------
 407
 408 sub ResultRecordLink {
 409     use strict;
 410     my ($dbh,$oldkoha,$resultsid, $num)=@_;     # input
 411                 # FIXME - $dbh as argument is no longer used
 412     my (
 413         $sth,
 414         $bib,   # hash ref to named fields
 415         $searchfield, $searchvalue,
 416         $donetext,
 417         $fieldname,
 418         );
 419     my %row = ();
 420
 421     $dbh = C4::Context->dbh;
 422
 423 #    $bib=extractmarcfields($record);
 424
 425     $sth=$dbh->prepare("select *
 426           from biblioitems
 427           where (isbn=? and isbn!='')  or (issn=? and issn!='')  or (lccn=? and lccn!='') ");
 428     $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
 429     if ($sth->rows) {
 430         $donetext="DONE";
 431     } else {
 432         $donetext="";
 433     }
 434     ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}");
 435
 436     $searchfield="";
 437     foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
 438         if ( defined $oldkoha->{$fieldname} && $oldkoha->{$fieldname} ) {
 439             $searchfield=$fieldname;
 440             $searchvalue=$oldkoha->{$fieldname};
 441         } # if defined fieldname
 442     } # foreach
 443     if ( $searchfield ) {
 444         $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'};
 445         $row{donetext}    = $donetext;
 446         $row{file}        = $file;
 447 #       $row{resultsid}   = $resultsid;
 448 #       $row{searchfield} = $searchfield;
 449 #       $row{searchvalue} = $searchvalue;
 450         $row{numrecord}   = $num;
 451         $row{title}       = $oldkoha->{title};
 452         $row{author}      = $oldkoha->{author};
 453     } else {
 454         $row{title} = "Error: Problem with <br>$bib->{title} $bib->{author}<br>";
 455     } # if searchfield
 456     return %row;
 457 } # sub PrintResultRecordLink
 458
 459 #---------------------------------
 460
 461
 462 sub uploadmarc {
 463     use strict;
 464     my ($dbh)=@_;               # FIXME - Unused argument
 465
 466     $dbh = C4::Context->dbh;
 467
 468     my $template=gettemplate('marcimport/uploadmarc.tmpl');
 469     $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
 470 #    print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 471     my $sth=$dbh->prepare("select id,name from uploadedmarc");
 472     $sth->execute;
 473 #    print "<h2>Select a set of MARC records</h2>\n<ul>";
 474     my @marc_loop = ();
 475     while (my ($id, $name) = $sth->fetchrow) {
 476         my %row;
 477         $row{id} = $id;
 478         $row{name} = $name;
 479         push(@marc_loop, \%row);
 480 #       print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
 481     }
 482     $template->param(marc => \@marc_loop);
 483     print "Content-Type: text/html\n\n", $template->output;
 484
 485 }
 486
 487 sub manual {
 488 }
 489
 490
 491 sub mainmenu {
 492         my $template=gettemplate('marcimport/mainmenu.tmpl');
 493         $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
 494         print "Content-Type: text/html\n\n", $template->output;
 495 } # sub mainmenu
 496
 497 #---------------------------------------------
 498 sub AcceptMarcUpload {
 499     use strict;
 500     my (
 501         $dbh,           # DBI handle
 502                         # FIXME - Unused argument
 503         $input,         # CGI parms
 504     )=@_;
 505
 506     $dbh = C4::Context->dbh;
 507
 508     my $name=$input->param('name');
 509     my $data=$input->param('uploadmarc');
 510     my $marcrecord='';
 511
 512     ($name) || ($name=$data);
 513     if (length($data)>0) {
 514         while (<$data>) {
 515             $marcrecord.=$_;
 516         }
 517     }
 518     my $q_marcrecord=$dbh->quote($marcrecord);
 519     my $q_name=$dbh->quote($name);
 520     my $sth=$dbh->prepare("insert into uploadedmarc
 521                 (marc,name)
 522         values ($q_marcrecord, $q_name)");
 523     $sth->execute;
 524 } # sub AcceptMarcUpload
 525
 526 #-------------------------------------------
 527 sub AcceptBiblioitem {
 528     use strict;
 529     my (
 530         $dbh,                   # FIXME - Unused argument
 531         $input,
 532     )=@_;
 533
 534     my $biblionumber=0;
 535     my $biblioitemnumber=0;
 536     my $sth;
 537     my $record;
 538
 539     $dbh = C4::Context->dbh;
 540
 541 #    my $isbn=$input->param('isbn');
 542 #    my $issn=$input->param('issn');
 543 #    my $lccn=$input->param('lccn');
 544 #    my $q_origisbn=$dbh->quote($input->param('origisbn'));
 545 #    my $q_origissn=$dbh->quote($input->param('origissn'));
 546 #    my $q_origlccn=$dbh->quote($input->param('origlccn'));
 547 #    my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
 548     my $title=$input->param('title');
 549
 550 #    my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
 551 #    my $q_issn=$dbh->quote((($issn) || ('NIL')));
 552 #    my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
 553     my $file= MARC::File::USMARC->indata($input->param('file'));
 554     my $numrecord = $input->param('numrecord');
 555     if ($numrecord) {
 556         for (my $i=1;$i<$numrecord;$i++) {
 557             $record=$file->next;
 558         }
 559     } else {
 560         print STDERR "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined\n";
 561         print "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined : contact administrator\n";
 562     }
 563     my $template=gettemplate('marcimport/AcceptBiblioitem.tmpl');
 564
 565     my $oldkoha = MARCmarc2koha($dbh,$record);
 566     # See if it already exists
 567     # FIXME - There's already a $sth in this context.
 568     my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
 569         from biblioitems
 570         where isbn=? or issn=? or lccn=?");
 571     $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
 572     if ($sth->rows) {
 573         # Already exists
 574
 575         ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
 576         $template->param(title => $title);
 577         $template->param(biblionumber => $biblionumber);
 578         $template->param(biblioitemnumber => $biblioitemnumber);
 579         $template->param(BIBLIO_EXISTS => 1);
 580
 581     } else {
 582         # It doesn't exist; add it.
 583
 584         my $error;
 585         my %biblio;
 586         my %biblioitem;
 587
 588         # convert to upper case and split on lines
 589         my $subjectheadings=$input->param('subject');
 590         my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
 591
 592         my $additionalauthors=$input->param('additionalauthors');
 593         my @additionalauthors=split(/[\r\n]+|\|/,uc($additionalauthors));
 594                         # FIXME - WTF are the additional authors
 595                         # converted to upper case?
 596
 597         # Use individual assignments to hash buckets, in case
 598         #  any of the input parameters are empty or don't exist
 599         $biblio{title}          =$input->param('title');
 600         $biblio{author}         =$input->param('author');
 601         $biblio{copyright}      =$input->param('copyrightdate');
 602         $biblio{seriestitle}    =$input->param('seriestitle');
 603         $biblio{notes}          =$input->param('notes');
 604         $biblio{abstract}       =$input->param('abstract');
 605         $biblio{subtitle}       =$input->param('subtitle');
 606
 607         $biblioitem{volume}             =$input->param('volume');
 608         $biblioitem{number}             =$input->param('number');
 609         $biblioitem{itemtype}           =$input->param('itemtype');
 610         $biblioitem{isbn}               =$input->param('isbn');
 611         $biblioitem{issn}               =$input->param('issn');
 612         $biblioitem{dewey}              =$input->param('dewey');
 613         $biblioitem{subclass}           =$input->param('subclass');
 614         $biblioitem{publicationyear}    =$input->param('publicationyear');
 615         $biblioitem{publishercode}      =$input->param('publishercode');
 616         $biblioitem{volumedate}         =$input->param('volumedate');
 617         $biblioitem{volumeddesc}        =$input->param('volumeddesc');
 618         $biblioitem{illus}              =$input->param('illustrator');
 619         $biblioitem{pages}              =$input->param('pages');
 620         $biblioitem{notes}              =$input->param('notes');
 621         $biblioitem{size}               =$input->param('size');
 622         $biblioitem{place}              =$input->param('place');
 623         $biblioitem{lccn}               =$input->param('lccn');
 624         $biblioitem{marc}               =$input->param('marc');
 625 #       print STDERR $record->as_formatted();
 626 #       die;
 627         ($biblionumber, $biblioitemnumber, $error)=
 628             ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
 629 #           (1,2,0);
 630 #         newcompletebiblioitem($dbh,
 631 #               \%biblio,
 632 #               \%biblioitem,
 633 #               \@subjectheadings,
 634 #               \@additionalauthors
 635 #       );
 636
 637         if ( $error ) {
 638             print "<H2>Error adding biblio item</H2> $error\n";
 639         } else {
 640             $template->param(title => $title);
 641             $template->param(biblionumber => $biblionumber);
 642             $template->param(biblioitemnumber => $biblioitemnumber);
 643             $template->param(BIBLIO_CREATE => 1);
 644         } # if error
 645     } # if new record
 646     my $barcode;
 647
 648     # Get next barcode, or pick random one if none exist yet
 649     $sth=$dbh->prepare("select max(barcode) from items");
 650     $sth->execute;
 651     ($barcode) = $sth->fetchrow;
 652     $barcode++;
 653     if ($barcode==1) {
 654         $barcode=int(rand()*1000000);
 655     }
 656     my $branchselect=getkeytableselectoptions(
 657                 $dbh, 'branches', 'branchcode', 'branchname', 0);
 658     $template->param(barcode => $barcode);
 659     $template->param(branchselect => $branchselect);
 660     print "Content-Type: text/html\n\n", $template->output;
 661
 662 } # sub ItemCopyForm
 663
 664 #---------------------------------------
 665 # Accept form data to add an item copy
 666 sub AcceptItemCopy {
 667     use strict;
 668     my ( $dbh, $input )=@_;
 669                         # FIXME - $dbh argument unused
 670
 671     my $template=gettemplate('marcimport/AcceptItemCopy.tmpl');
 672
 673     my $error;
 674
 675     $dbh = C4::Context->dbh;
 676
 677     my $barcode=$input->param('barcode');
 678     my $replacementprice=($input->param('replacementprice') || 0);
 679
 680     my $sth=$dbh->prepare("select barcode
 681         from items
 682         where barcode=?");
 683     $sth->execute($barcode);
 684     if ($sth->rows) {
 685         $template->param(BARCODE_EXISTS => 1);
 686         $template->param(barcode => $barcode);
 687     } else {
 688            # Insert new item into database
 689            $error=&ALLnewitem($dbh,
 690                                { biblionumber=> $input->param('biblionumber'),
 691                                  biblioitemnumber=> $input->param('biblioitemnumber'),
 692                                  itemnotes=> $input->param('notes'),
 693                                  homebranch=> $input->param('homebranch'),
 694                                  replacementprice=> $replacementprice,
 695                                  barcode => $barcode
 696                                  }
 697                                );
 698             if ( $error ) {
 699                 $template->param(ITEM_ERROR => 1);
 700                 $template->param(error => $error);
 701             } else {
 702                 $template->param(ITEM_CREATED => 1);
 703                 $template->param(barcode => $barcode);
 704             } # if error
 705     } # if barcode exists
 706     print "Content-Type: text/html\n\n", $template->output;
 707 } # sub AcceptItemCopy
 708
 709 #---------------------------------------
 710 sub FormatMarcText {
 711     use strict;
 712
 713     # Input
 714     my (
 715         $fields,        # list ref to MARC fields
 716     )=@_;
 717     # Return
 718     my $marctext;
 719
 720     my (
 721         $color,
 722         $field,
 723         $tag,
 724         $label,
 725         $indicator,
 726         $subfieldcode,$subfieldvalue,
 727         @values, $value
 728     );
 729     my $debug=0;
 730
 731     #-----------------------------------------
 732
 733     $marctext="<table border=0 cellspacing=1>
 734         <tr><th colspan=4 background=/images/background-acq.gif>
 735                 MARC RECORD
 736         </th></tr>\n";
 737
 738     foreach $field ( @$fields ) {
 739
 740         # Swap colors on alternating lines
 741         ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
 742
 743         $tag=$field->{'tag'};
 744         $label=taglabel($tag);
 745
 746         if ( $tag eq 'LDR' ) {
 747                 $tag='';
 748                 $label="Leader:";
 749         }
 750         print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
 751
 752         $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
 753                 "<td bgcolor=$color valign=top>$tag</td> \n";
 754
 755         $indicator=$field->{'indicator'};
 756         $indicator=~s/ +$//;    # drop trailing blanks
 757
 758         # Third table column has indicator if it is short.
 759         # Fourth column has embedded table of subfields, and indicator
 760         #  if it is long (leader or fixed-position fields)
 761
 762         print "<pre>Format indicator=$indicator" .
 763                 " length=" . length( $indicator ) .  "</pre>\n" if $debug;
 764         if ( length( $indicator <= 3 ) ) {
 765             $marctext.="<td bgcolor=$color valign=top><pre>" .
 766                 "$indicator</pre></td>" .
 767                 "<td bgcolor=$color valign=top>" ;
 768         } else {
 769             $marctext.="<td bgcolor=$color valign=top></td>" .
 770                 "<td bgcolor=$color valign=top>" .
 771                 "$indicator ";
 772         } # if length
 773
 774         # Subfields
 775         if ( $field->{'subfields'} )  {
 776             # start another table for subfields
 777             $marctext.= "<table border=0 cellspacing=2>\n";
 778             foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} }   )) {
 779                 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
 780                 if (ref($subfieldvalue) eq 'ARRAY' ) {
 781                     # if it's a pointer to array, get all the values
 782                     @values=@{$subfieldvalue};
 783                 } else {
 784                     # otherwise get the one value
 785                     @values=( $subfieldvalue );
 786                 } # if subfield array
 787                 foreach $value ( @values ) {
 788                   $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
 789                     "<td>$value</td></tr>\n";
 790                 } # foreach value
 791             } # foreach subfield
 792             $marctext.="</table>\n";
 793         } # if subfields
 794         # End of indicator and subfields column
 795         $marctext.="</td>\n";
 796
 797         # End of columns
 798         $marctext.="</tr>\n";
 799
 800     } # foreach field
 801
 802     $marctext.="</table>\n";
 803
 804     return $marctext;
 805
 806 } # sub FormatMarcText
 807
 808
 809 #---------------
 810 # log cleared, as marcimport is (almost) rewritten from scratch.
 811 # $Log$
 812 # Revision 1.29  2003/01/28 15:28:31  tipaul
 813 # removing use MARC::Charset
 814 # Was a buggy test
 815 #
 816 # Revision 1.28  2003/01/28 15:00:31  tipaul
 817 # user can now search in breeding farm with isbn/issn or title. Title/name are stored in breeding farm and showed when a search is done
 818 #
 819 # Revision 1.27  2003/01/26 23:21:49  acli
 820 # Handle non-latin1 charsets
 821 #
 822 # Revision 1.26  2003/01/23 12:26:41  tipaul
 823 # upgrading import in breeding farm (you can now search on ISBN or on title) AND character encoding.
 824 #
 825 # Revision 1.25  2003/01/21 08:13:50  tipaul
 826 # character encoding ISO646 => 8859-1, first draft
 827 #
 828 # Revision 1.24  2003/01/14 16:41:17  tipaul
 829 # bugfix : use gettemplate_and_user instead of gettemplate.
 830 # fix a blank screen in 1.3.3 in "import in breeding farm"
 831 #
 832 # Revision 1.23  2003/01/06 13:06:28  tipaul
 833 # removing trailing #
 834 #
 835 # Revision 1.22  2002/11/12 15:58:43  tipaul
 836 # road to 1.3.2 :
 837 # * many bugfixes
 838 # * 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)
 839 #
 840 # Revision 1.21  2002/10/22 15:50:23  tipaul
 841 # road to 1.3.2 : adding a biblio in MARC format.
 842 # seems to work a few.
 843 # still to do :
 844 # * manage html checks (mandatory subfields...)
 845 # * add list of acceptable values (authorities)
 846 # * manage ## in MARC format
 847 # * manage correctly repeatable fields
 848 # and probably a LOT of bugfixes
 849 #
 850 # Revision 1.20  2002/10/16 12:46:19  arensb
 851 # Added a FIXME comment.
 852 #
 853 # Revision 1.19  2002/10/15 10:14:44  tipaul
 854 # road to 1.3.2. Full rewrite of marcimport.pl.
 855 # The acquisition system in MARC version will work like this :
 856 # * marcimport will put marc records into a "breeding farm" table.
 857 # * 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.
 858 #
 859 # This commit :
 860 # * modify acqui.simple home page  (addbooks.pl)
 861 # * adds import into breeding farm
 862 #
 863 # Please note that :
 864 # * z3950 functionnality is dropped from "marcimport" will be added somewhere else.
 865 # * templates are in a new acqui.simple sub directory, and the marcimport template directory will become obsolete soon.I think this is more logic
 866 #