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