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