koha-dev.rot13.org Git - koha_fer/blob - acqui.simple/marcimport.pl

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