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