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