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::Database;
  38 use C4::Acquisitions;
  39 use C4::Output;
  40 use C4::Input;
  41 use C4::Biblio;
  42 use C4::SimpleMarc;
  43 use C4::Z3950;
  44 use MARC::File::USMARC;
  45 use HTML::Template;
  46
  47 #------------------
  48 # Constants
  49
  50 my %configfile;
  51 open (KC, "/etc/koha.conf");
  52 while (<KC>) {
  53  chomp;
  54  (next) if (/^\s*#/);
  55  if (/(.*)\s*=\s*(.*)/) {
  56    my $variable=$1;
  57    my $value=$2;
  58    # Clean up white space at beginning and end
  59    $variable=~s/^\s*//g;
  60    $variable=~s/\s*$//g;
  61    $value=~s/^\s*//g;
  62    $value=~s/\s*$//g;
  63    $configfile{$variable}=$value;
  64  }
  65 }
  66 my $includes=$configfile{'includes'};
  67 ($includes) || ($includes="/usr/local/www/hdl/htdocs/includes");
  68
  69 # HTML colors for alternating lines
  70 my $lc1='#dddddd';
  71 my $lc2='#ddaaaa';
  72
  73 #-------------
  74 #-------------
  75 # Initialize
  76
  77 my $userid=$ENV{'REMOTE_USER'};
  78
  79 my $input = new CGI;
  80 my $dbh=C4Connect;
  81
  82 #-------------
  83 # Display output
  84 #print $input->header;
  85 #print startpage();
  86 #print startmenu('acquisitions');
  87
  88 #-------------
  89 # Process input parameters
  90
  91 my $file=$input->param('file');
  92 my $menu = $input->param('menu');
  93
  94 #
  95 #
  96 # TODO : parameter decoding and function call is quite dirty.
  97 # should be rewritten...
  98 #
  99 #
 100 if ($input->param('z3950queue')) {
 101         AcceptZ3950Queue($dbh,$input);
 102 }
 103
 104 if ($input->param('uploadmarc')) {
 105         AcceptMarcUpload($dbh,$input)
 106 }
 107
 108 if ($input->param('insertnewrecord')) {
 109     # Add biblio item, and set up menu for adding item copies
 110     my ($biblionumber,$biblioitemnumber)=AcceptBiblioitem($dbh,$input);
 111     exit;
 112 }
 113
 114 if ($input->param('newitem')) {
 115     # Add item copy
 116     &AcceptItemCopy($dbh,$input);
 117     exit;
 118 } # if newitem
 119
 120
 121 if ($file) {
 122     ProcessFile($dbh,$input);
 123 } else {
 124   SWITCH:
 125     {
 126         if ($menu eq 'z3950') { z3950menu($dbh,$input); last SWITCH; }
 127         if ($menu eq 'uploadmarc') { uploadmarc($dbh); last SWITCH; }
 128         if ($menu eq 'manual') { manual(); last SWITCH; }
 129         mainmenu();
 130     }
 131 }
 132 #print endmenu();
 133 #print endpage();
 134
 135
 136 # Process a MARC file : show list of records, of 1 record detail, if numrecord exists
 137 sub ProcessFile {
 138     # A MARC file has been specified; process it for review form
 139     use strict;
 140     # Input params
 141     my (
 142         $dbh,
 143         $input,
 144     )=@_;
 145
 146     # local vars
 147     my (
 148         $sth,
 149         $record,
 150     );
 151
 152     my $debug=0;
 153
 154     requireDBI($dbh,"ProcessFile");
 155
 156     # See if a particular result item was specified
 157     my $numrecord = $input->param('numrecord');
 158     if ($numrecord) {
 159         ProcessRecord($dbh,$input,$numrecord);
 160     } else {
 161         # No result item specified, list results
 162         ListFileRecords($dbh,$input);
 163     } # if
 164 } # sub ProcessFile
 165
 166 # show 1 record from the MARC file
 167 sub ProcessRecord {
 168     my ($dbh, $input,$numrecord) = @_;
 169     # local vars
 170     my (
 171         $sth,
 172         $record,
 173         $data,
 174     );
 175
 176     if ($file=~/Z-(\d+)/) {
 177         my $id=$1;
 178         my $resultsid=$input->param('resultsid');
 179         my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
 180         $sth->execute;
 181         ($data) = $sth->fetchrow;
 182     } else {
 183         my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
 184         $sth->execute;
 185         ($data) = $sth->fetchrow;
 186     }
 187
 188     my $file=MARC::File::USMARC->indata ($data);
 189     my $oldkoha;
 190     for (my $i==1;$i<$numrecord;$i++) {
 191         $record = $file->next;
 192     }
 193     if ($record) {
 194         $oldkoha=MARCmarc2koha($dbh,$record);
 195     }
 196     my $templatebase="marcimport/marcimportdetail.tmpl";
 197     my $theme=picktemplate($includes, $templatebase);
 198     my $template = HTML::Template->new(filename => "$includes/templates/$theme/$templatebase", die_on_bad_params => 0, path => [$includes]);
 199     $oldkoha->{additionalauthors} =~ s/ \| /\n/g;
 200     $oldkoha =~ s/\|/\n/g;
 201     $template->param($oldkoha);
 202 #---- build MARC array for template
 203     my @loop = ();
 204     my $tagmeaning = &MARCgettagslib($dbh,1);
 205     my @fields = $record->fields();
 206     my $color=0;
 207     my $lasttag="";
 208     foreach my $field (@fields) {
 209         my @subfields=$field->subfields();
 210         foreach my $subfieldcount (0..$#subfields) {
 211             my %row_data;
 212             if ($lasttag== $field->tag()) {
 213                 $row_data{tagid}   = "";
 214             } else {
 215                 $row_data{tagid}   = $field->tag();
 216             }
 217             $row_data{subfield} = $subfields[$subfieldcount][0];
 218             $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]};
 219             $row_data{tagvalue}= $subfields[$subfieldcount][1];
 220             if ($color ==0) {
 221                 $color=1;
 222                 $row_data{color} = $lc1;
 223             } else {
 224                 $color=0;
 225                 $row_data{color} = $lc2;
 226             }
 227             push(@loop,\%row_data);
 228             $lasttag=$field->tag();
 229         }
 230     }
 231     $template->param(MARC => \@loop);
 232     $template->param(numrecord => $numrecord);
 233     $template->param(file => $data);
 234     print "Content-Type: text/html\n\n", $template->output;
 235 }
 236
 237 # lists all records from the MARC file
 238 sub ListFileRecords {
 239     use strict;
 240
 241     # Input parameters
 242     my (
 243         $dbh,
 244         $input,
 245     )=@_;
 246
 247     my (
 248         $sth, $sti,
 249         $field,
 250         $data,          # records in MARC file format
 251         $name,
 252         $srvid,
 253         %servernames,
 254         $serverdb,
 255     );
 256
 257     my $z3950=0;
 258     my $recordsource;
 259     my $record;
 260     my ($numrecords,$resultsid,$data,$startdate,$enddate);
 261
 262     requireDBI($dbh,"ListFileRecords");
 263
 264     my $templatebase="marcimport/ListFileRecords.tmpl";
 265     my $theme=picktemplate($includes, $templatebase);
 266     my $template = HTML::Template->new(filename => "$includes/templates/$theme/$templatebase", die_on_bad_params => 0, path => [$includes]);
 267
 268     # File can be z3950 search query or uploaded MARC data
 269
 270     # if z3950 results
 271     if (not $file=~/Z-(\d+)/) {
 272         # This is a Marc upload
 273         $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
 274         $sth->execute;
 275         ($data, $name) = $sth->fetchrow;
 276         $template->param(IS_MARC => 1);
 277         $template->param(recordsource => $name);
 278     }
 279
 280     if ($file=~/Z-(\d+)/) {
 281         # This is a z3950 search
 282         $template->param(IS_Z3950 =>1);
 283         my $id=$1;              # search query id number
 284         my $serverstring;
 285         my $starttimer=time();
 286
 287         $sth=$dbh->prepare("
 288                 select z3950results.numrecords,z3950results.id,z3950results.results,
 289                         z3950results.startdate,z3950results.enddate,server
 290                 from z3950queue left outer join z3950results
 291                      on z3950queue.id=z3950results.queryid
 292                 where z3950queue.id=?
 293                 order by server
 294             ");
 295         $sth->execute($id);
 296         if ( $sth->rows ) {
 297             # loop through all servers in search results
 298             while ( ($numrecords,$resultsid,$data,
 299                      $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
 300                 my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
 301                 if ( $server ) {
 302                         my $srvname=&z3950servername($dbh,$srvid,"$server/$database");
 303                         $template->parram(srvid => $srvid);
 304                         $template->param(srvname => $srvname);
 305                 } # if $server
 306                 my $startrecord=$input->param("ST-$srvid");
 307                 ($startrecord) || ($startrecord='0');
 308                 my $serverplaceholder='';
 309                 foreach ($input->param) {
 310                     (next) unless (/ST-(.+)/);
 311                     my $serverid=$1;
 312                     (next) if ($serverid eq $srvid);
 313                     my $place=$input->param("ST-$serverid");
 314                     $serverplaceholder.="\&ST-$serverid=$place";
 315                 }
 316                 if ($numrecords) {
 317                     $template->param(HAS_NUMRECORDS => 1);
 318                     my $previous='';
 319                     my $next='';
 320                     if ($startrecord>0) {
 321                         $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
 322                     }
 323                     my $highest;
 324                     $highest=$startrecord+10;
 325                     ($highest>$numrecords) && ($highest=$numrecords);
 326                     if ($numrecords>$startrecord+10) {
 327                         $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
 328                     }
 329                     $template->param(startrecord => $startrecord+1);
 330                     $template->param(highest => $highest);
 331                     $template->param(numrecords => $numrecords);
 332                     $template->param(previous => $previous);
 333                     $template->param(next => $next);
 334                     my $stj=$dbh->prepare("update z3950results
 335                         set highestseen=? where id=?");
 336                     $stj->execute($startrecord+10,$resultsid);
 337                 }
 338
 339                 if (! $server ) {
 340                     $template->param(PENDING => 1);
 341                 } elsif ($enddate == 0) {
 342                     my $now=time();
 343                     my $elapsed=$now-$startdate;
 344                     my $elapsedtime='';
 345                     if ($elapsed>60) {
 346                         $elapsedtime=sprintf "%d minutes",($elapsed/60);
 347                     } else {
 348                         $elapsedtime=sprintf "%d seconds",$elapsed;
 349                     }
 350                     $template->param(elapsedtime => $elapsedtime);
 351                 } elsif ($numrecords) {
 352                     my @loop = ();
 353                     my $z3950file=MARC::File::USMARC->indata ($data);
 354                     while (my $record=$z3950file->next) {
 355                         my $oldkoha = MARCmarc2koha($dbh,$record);
 356                         my %row = ResultRecordLink($dbh,$oldkoha,$resultsid);
 357                         push(@loop,\%row);
 358                     }
 359                     $template->param(LINES => \@loop);
 360                 } else {
 361                 }
 362 #               print "</ul>\n";
 363             } # foreach server
 364             my $elapsed=time()-$starttimer;
 365 #           print "<hr>It took $elapsed seconds to process this page.\n";
 366             } else {
 367                 $template->param(NO_RECORDS =>1);
 368                 $template->param(id => $id);
 369             } # if rows
 370
 371         } else {
 372 #
 373 # This is an uploaded Marc record
 374 #
 375             my @loop = ();
 376             my $MARCfile = MARC::File::USMARC->indata($data);
 377             my $num = 0;
 378             while (my $record=$MARCfile->next) {
 379                 $num++;
 380                 my $oldkoha = MARCmarc2koha($dbh,$record);
 381                 my %row = ResultRecordLink($dbh,$oldkoha,'',$num);
 382                 push(@loop,\%row);
 383             }
 384             $template->param(LINES => \@loop);
 385         } # if z3950 or marc upload
 386         print "Content-Type: text/html\n\n", $template->output;
 387 } # sub ListFileRecords
 388
 389 #--------------
 390
 391 sub ResultRecordLink {
 392     use strict;
 393     my ($dbh,$oldkoha,$resultsid, $num)=@_;     # input
 394     my (
 395         $sth,
 396         $bib,   # hash ref to named fields
 397         $searchfield, $searchvalue,
 398         $donetext,
 399         $fieldname,
 400         );
 401     my %row = ();
 402     requireDBI($dbh,"PrintResultRecordLink");
 403
 404 #    $bib=extractmarcfields($record);
 405
 406     $sth=$dbh->prepare("select *
 407           from biblioitems
 408           where (isbn=? and isbn!='')  or (issn=? and issn!='')  or (lccn=? and lccn!='') ");
 409     $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
 410     if ($sth->rows) {
 411         $donetext="DONE";
 412     } else {
 413         $donetext="";
 414     }
 415     ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}");
 416
 417     $searchfield="";
 418     foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
 419         if ( defined $oldkoha->{$fieldname} && $oldkoha->{$fieldname} ) {
 420             $searchfield=$fieldname;
 421             $searchvalue=$oldkoha->{$fieldname};
 422         } # if defined fieldname
 423     } # foreach
 424     if ( $searchfield ) {
 425         $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'};
 426         $row{donetext}    = $donetext;
 427         $row{file}        = $file;
 428 #       $row{resultsid}   = $resultsid;
 429 #       $row{searchfield} = $searchfield;
 430 #       $row{searchvalue} = $searchvalue;
 431         $row{numrecord}   = $num;
 432         $row{title}       = $oldkoha->{title};
 433         $row{author}      = $oldkoha->{author};
 434     } else {
 435         $row{title} = "Error: Problem with <br>$bib->{title} $bib->{author}<br>";
 436     } # if searchfield
 437     return %row;
 438 } # sub PrintResultRecordLink
 439
 440 #---------------------------------
 441
 442 sub z3950menu {
 443     use strict;
 444     my (
 445         $dbh,
 446         $input,
 447     )=@_;
 448
 449     my (
 450         $sth, $sti,
 451         $processing,
 452         $realenddate,
 453         $totalrecords,
 454         $elapsed,
 455         $elapsedtime,
 456         $resultstatus, $statuscolor,
 457         $id, $term, $type, $done,
 458         $startdate, $enddate, $servers,
 459         $record,$bib,$title,
 460     );
 461
 462     requireDBI($dbh,"z3950menu");
 463
 464     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 465     print "<table border=0><tr><td valign=top>\n";
 466     print "<h2>Results of Z39.50 searches</h2>\n";
 467     print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n" .
 468           "<ul>\n";
 469
 470     # Check queued queries
 471     $sth=$dbh->prepare("select id,term,type,done,
 472                 startdate,enddate,servers
 473         from z3950queue
 474         order by id desc
 475         limit 20 ");
 476     $sth->execute;
 477     while ( ($id, $term, $type, $done,
 478                 $startdate, $enddate, $servers) = $sth->fetchrow) {
 479         $type=uc($type);
 480         $term=~s/</&lt;/g;
 481         $term=~s/>/&gt;/g;
 482
 483         $title="";
 484         # See if query produced results
 485         $sti=$dbh->prepare("select id,server,startdate,enddate,numrecords,results
 486                 from z3950results
 487                 where queryid=?");
 488         $sti->execute($id);
 489         if ($sti->rows) {
 490             $processing=0;
 491             $realenddate=0;
 492             $totalrecords=0;
 493             while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords,$r_marcdata)
 494                 = $sti->fetchrow) {
 495                 if ($r_enddate==0) {
 496                     # It hasn't finished yet
 497                     $processing=1;
 498                 } else {
 499                     # It finished, see how long it took.
 500                     if ($r_enddate>$realenddate) {
 501                         $realenddate=$r_enddate;
 502                     }
 503                     # Snag any title from the results if there were any
 504                     if ( ! $title && $r_marcdata ) {
 505                         ($record)=parsemarcfileformat($r_marcdata);
 506                         $bib=extractmarcfields($record);
 507                         if ( $bib->{title} ) { $title=$bib->{title} };
 508                     } # if no title yet
 509                 } # if finished
 510
 511                 $totalrecords+=$r_numrecords;
 512             } # while results
 513
 514             if ($processing) {
 515                 $elapsed=time()-$startdate;
 516                 $resultstatus="Processing...";
 517                 $statuscolor="red";
 518             } else {
 519                 $elapsed=$realenddate-$startdate;
 520                 $resultstatus="Done.";
 521                 $statuscolor="black";
 522                 }
 523
 524                 if ($elapsed>60) {
 525                     $elapsedtime=sprintf "%d minutes",($elapsed/60);
 526                 } else {
 527                     $elapsedtime=sprintf "%d seconds",$elapsed;
 528                 }
 529                 if ($totalrecords) {
 530                     $totalrecords="$totalrecords found.";
 531                 } else {
 532                     $totalrecords='';
 533                 }
 534                 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>".
 535                 "$type=$term</a>" .
 536                 "<font size=-1 color=$statuscolor>$resultstatus $totalrecords " .
 537                 "($elapsedtime) $title </font><br>\n";
 538         } else {
 539             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>
 540                 $type=$term</a> <font size=-1>Pending</font><br>\n";
 541         } # if results done
 542     } # while queries
 543     print "</ul> </td>\n";
 544     # End of query listing
 545
 546     #------------------------------
 547     # Search input form
 548     print "<td valign=top width=30%>\n";
 549
 550     my $sth=$dbh->prepare("select id,name,checked
 551         from z3950servers
 552         order by rank");
 553     $sth->execute;
 554     my $serverlist='';
 555     while (my ($id, $name, $checked) = $sth->fetchrow) {
 556         ($checked) ? ($checked='checked') : ($checked='');
 557         $serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n";
 558     }
 559     $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n";
 560
 561     my $rand=rand(1000000000);
 562 print << "EOF";
 563     <form action=$ENV{'SCRIPT_NAME'} method=GET>
 564     <input type=hidden name=z3950queue value=1>
 565     <input type=hidden name=menu value=$menu>
 566     <p>
 567     <input type=hidden name=test value=testvalue>
 568     <input type=hidden name=rand value=$rand>
 569         <table border=1 bgcolor=#dddddd>
 570             <tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr>
 571     <tr><td>Query Term</td><td><input name=query></td></tr>
 572     <tr><td colspan=2 align=center>
 573                 <input type=radio name=type value=isbn checked>&nbsp;ISBN
 574                 <input type=radio name=type value=lccn        >&nbsp;LCCN<br>
 575                 <input type=radio name=type value=author      >&nbsp;Author
 576                 <input type=radio name=type value=title       >&nbsp;Title
 577                 <input type=radio name=type value=keyword     >&nbsp;Keyword</td></tr>
 578             <tr><td colspan=2> $serverlist </td></tr>
 579             <tr><td colspan=2 align=center> <input type=submit> </td></tr>
 580     </table>
 581
 582     </form>
 583 EOF
 584     print "</td></tr></table>\n";
 585 } # sub z3950menu
 586 #---------------------------------
 587
 588 sub uploadmarc {
 589     use strict;
 590     my ($dbh)=@_;
 591
 592     requireDBI($dbh,"uploadmarc");
 593
 594     my $templatebase="marcimport/uploadmarc.tmpl";
 595     my $theme=picktemplate($includes, $templatebase);
 596     my $template = HTML::Template->new(filename => "$includes/templates/$theme/$templatebase", die_on_bad_params => 0, path => [$includes]);
 597     $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
 598 #    print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 599     my $sth=$dbh->prepare("select id,name from uploadedmarc");
 600     $sth->execute;
 601 #    print "<h2>Select a set of MARC records</h2>\n<ul>";
 602     my @marc_loop = ();
 603     while (my ($id, $name) = $sth->fetchrow) {
 604         my %row;
 605         $row{id} = $id;
 606         $row{name} = $name;
 607         push(@marc_loop, \%row);
 608 #       print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
 609     }
 610     $template->param(marc => \@marc_loop);
 611     print "Content-Type: text/html\n\n", $template->output;
 612
 613 }
 614
 615 sub manual {
 616 }
 617
 618
 619 sub mainmenu {
 620         my $templatebase="marcimport/mainmenu.tmpl";
 621         my $theme=picktemplate($includes, $templatebase);
 622         my $template = HTML::Template->new(filename => "$includes/templates/$theme/$templatebase", die_on_bad_params => 0, path => [$includes]);
 623         $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
 624         print "Content-Type: text/html\n\n", $template->output;
 625 } # sub mainmenu
 626
 627 #----------------------------
 628 # Accept form results to add query to z3950 queue
 629 sub AcceptZ3950Queue {
 630     use strict;
 631
 632     # input parameters
 633     my (
 634         $dbh,           # DBI handle
 635         $input,         # CGI parms
 636     )=@_;
 637
 638     my @serverlist;
 639     my $error;
 640
 641     requireDBI($dbh,"AcceptZ3950Queue");
 642
 643     my $query=$input->param('query');
 644
 645     my $isbngood=1;
 646     if ($input->param('type') eq 'isbn') {
 647         $isbngood=checkvalidisbn($query);
 648     }
 649     if ($isbngood) {
 650     foreach ($input->param) {
 651         if (/S-(.*)/) {
 652             my $server=$1;
 653             if ($server eq 'MAN') {
 654                 push @serverlist, "MAN/".$input->param('manualz3950server')."//"
 655 ;
 656             } else {
 657                 push @serverlist, $server;
 658             }
 659           }
 660         }
 661
 662         $error=addz3950queue($dbh,$input->param('query'), $input->param('type'),
 663                 $input->param('rand'), @serverlist);
 664         if ( $error ) {
 665             print qq|
 666 <table border=1 cellpadding=5 cellspacing=0 align=center>
 667 <tr><td bgcolor=#99cc33 background=/images/background-acq.gif colspan=2><font color=red><b>Error</b></font></td></tr>
 668 <tr><td colspan=2>
 669 <b>$error</b><p>
 670 |;
 671             if ( $error =~ /daemon/i ) {
 672                 print qq|
 673 There is a launcher for the Z39.50 client daemon in your intranet installation<br>
 674 directory under <b>./scripts/z3950daemon/z3950-daemon-launch.sh</b>.  This<br>
 675 script should be run as root, and it will start up the program running with the<br>
 676 privileges of your apache user.  Ideally, this script should be started from a<br>
 677 system init directory so that is running after the machine starts up.
 678 |;
 679
 680             } # if daemon
 681             print qq|
 682 </td></tr>
 683 </table>
 684
 685 <table border
 686
 687 |;
 688         } # if error
 689     } else {
 690         print "<font color=red size=+1>$query is not a valid ISBN
 691         Number</font><p>\n";
 692     }
 693 } # sub AcceptZ3950Queue
 694
 695 #---------------------------------------------
 696 sub AcceptMarcUpload {
 697     use strict;
 698     my (
 699         $dbh,           # DBI handle
 700         $input,         # CGI parms
 701     )=@_;
 702
 703     requireDBI($dbh,"AcceptMarcUpload");
 704
 705     my $name=$input->param('name');
 706     my $data=$input->param('uploadmarc');
 707     my $marcrecord='';
 708
 709     ($name) || ($name=$data);
 710     if (length($data)>0) {
 711         while (<$data>) {
 712             $marcrecord.=$_;
 713         }
 714     }
 715     my $q_marcrecord=$dbh->quote($marcrecord);
 716     my $q_name=$dbh->quote($name);
 717     my $sth=$dbh->prepare("insert into uploadedmarc
 718                 (marc,name)
 719         values ($q_marcrecord, $q_name)");
 720     $sth->execute;
 721 } # sub AcceptMarcUpload
 722
 723 #-------------------------------------------
 724 sub AcceptBiblioitem {
 725     use strict;
 726     my (
 727         $dbh,
 728         $input,
 729     )=@_;
 730
 731     my $biblionumber=0;
 732     my $biblioitemnumber=0;
 733     my $sth;
 734     my $record;
 735
 736     requireDBI($dbh,"AcceptBiblioitem");
 737
 738 #    my $isbn=$input->param('isbn');
 739 #    my $issn=$input->param('issn');
 740 #    my $lccn=$input->param('lccn');
 741 #    my $q_origisbn=$dbh->quote($input->param('origisbn'));
 742 #    my $q_origissn=$dbh->quote($input->param('origissn'));
 743 #    my $q_origlccn=$dbh->quote($input->param('origlccn'));
 744 #    my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
 745     my $title=$input->param('title');
 746
 747 #    my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
 748 #    my $q_issn=$dbh->quote((($issn) || ('NIL')));
 749 #    my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
 750     my $file= MARC::File::USMARC->indata($input->param('file'));
 751     my $numrecord = $input->param('numrecord');
 752     if ($numrecord) {
 753         for (my $i==1;$i<$numrecord;$i++) {
 754             $record=$file->next;
 755         }
 756     } else {
 757         print STDERR "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined\n";
 758         print "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined : contact administrator\n";
 759     }
 760     my $templatebase="marcimport/AcceptBiblioitem.tmpl";
 761     my $theme=picktemplate($includes, $templatebase);
 762     my $template = HTML::Template->new(filename => "$includes/templates/$theme/$templatebase", die_on_bad_params => 0, path => [$includes]);
 763
 764     my $oldkoha = MARCmarc2koha($dbh,$record);
 765     # See if it already exists
 766     my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
 767         from biblioitems
 768         where isbn=? or issn=? or lccn=?");
 769     $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
 770     if ($sth->rows) {
 771         # Already exists
 772
 773         ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
 774         $template->param(title => $title);
 775         $template->param(biblionumber => $biblionumber);
 776         $template->param(biblioitemnumber => $biblioitemnumber);
 777         $template->param(BIBLIO_EXISTS => 1);
 778
 779     } else {
 780         # It doesn't exist; add it.
 781
 782         my $error;
 783         my %biblio;
 784         my %biblioitem;
 785
 786         # convert to upper case and split on lines
 787         my $subjectheadings=$input->param('subject');
 788         my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
 789
 790         my $additionalauthors=$input->param('additionalauthors');
 791         my @additionalauthors=split(/[\r\n]+|\|/,uc($additionalauthors));
 792
 793         # Use individual assignments to hash buckets, in case
 794         #  any of the input parameters are empty or don't exist
 795         $biblio{title}          =$input->param('title');
 796         $biblio{author}         =$input->param('author');
 797         $biblio{copyright}      =$input->param('copyrightdate');
 798         $biblio{seriestitle}    =$input->param('seriestitle');
 799         $biblio{notes}          =$input->param('notes');
 800         $biblio{abstract}       =$input->param('abstract');
 801         $biblio{subtitle}       =$input->param('subtitle');
 802
 803         $biblioitem{volume}             =$input->param('volume');
 804         $biblioitem{number}             =$input->param('number');
 805         $biblioitem{itemtype}           =$input->param('itemtype');
 806         $biblioitem{isbn}               =$input->param('isbn');
 807         $biblioitem{issn}               =$input->param('issn');
 808         $biblioitem{dewey}              =$input->param('dewey');
 809         $biblioitem{subclass}           =$input->param('subclass');
 810         $biblioitem{publicationyear}    =$input->param('publicationyear');
 811         $biblioitem{publishercode}      =$input->param('publishercode');
 812         $biblioitem{volumedate}         =$input->param('volumedate');
 813         $biblioitem{volumeddesc}        =$input->param('volumeddesc');
 814         $biblioitem{illus}              =$input->param('illustrator');
 815         $biblioitem{pages}              =$input->param('pages');
 816         $biblioitem{notes}              =$input->param('notes');
 817         $biblioitem{size}               =$input->param('size');
 818         $biblioitem{place}              =$input->param('place');
 819         $biblioitem{lccn}               =$input->param('lccn');
 820         $biblioitem{marc}               =$input->param('marc');
 821 #       print STDERR $record->as_formatted();
 822 #       die;
 823         ($biblionumber, $biblioitemnumber, $error)=
 824             ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
 825 #           (1,2,0);
 826 #         newcompletebiblioitem($dbh,
 827 #               \%biblio,
 828 #               \%biblioitem,
 829 #               \@subjectheadings,
 830 #               \@additionalauthors
 831 #       );
 832
 833         if ( $error ) {
 834             print "<H2>Error adding biblio item</H2> $error\n";
 835         } else {
 836             $template->param(title => $title);
 837             $template->param(biblionumber => $biblionumber);
 838             $template->param(biblioitemnumber => $biblioitemnumber);
 839             $template->param(BIBLIO_CREATE => 1);
 840         } # if error
 841     } # if new record
 842     my $barcode;
 843
 844     # Get next barcode, or pick random one if none exist yet
 845     $sth=$dbh->prepare("select max(barcode) from items");
 846     $sth->execute;
 847     ($barcode) = $sth->fetchrow;
 848     $barcode++;
 849     if ($barcode==1) {
 850         $barcode=int(rand()*1000000);
 851     }
 852     my $branchselect=getkeytableselectoptions(
 853                 $dbh, 'branches', 'branchcode', 'branchname', 0);
 854     $template->param(barcode => $barcode);
 855     $template->param(branchselect => $branchselect);
 856     print "Content-Type: text/html\n\n", $template->output;
 857
 858 } # sub ItemCopyForm
 859
 860 #---------------------------------------
 861 # Accept form data to add an item copy
 862 sub AcceptItemCopy {
 863     use strict;
 864     my ( $dbh, $input )=@_;
 865
 866     my $templatebase="marcimport/AcceptItemCopy.tmpl";
 867     my $theme=picktemplate($includes, $templatebase);
 868     my $template = HTML::Template->new(filename => "$includes/templates/$theme/$templatebase", die_on_bad_params => 0, path => [$includes]);
 869
 870     my $error;
 871
 872     requireDBI($dbh,"AcceptItemCopy");
 873
 874     my $barcode=$input->param('barcode');
 875     my $replacementprice=($input->param('replacementprice') || 0);
 876
 877     my $sth=$dbh->prepare("select barcode
 878         from items
 879         where barcode=?");
 880     $sth->execute($barcode);
 881     if ($sth->rows) {
 882         $template->param(BARCODE_EXISTS => 1);
 883         $template->param(barcode => $barcode);
 884     } else {
 885            # Insert new item into database
 886            $error=&ALLnewitem($dbh,
 887                                { biblionumber=> $input->param('biblionumber'),
 888                                  biblioitemnumber=> $input->param('biblioitemnumber'),
 889                                  itemnotes=> $input->param('notes'),
 890                                  homebranch=> $input->param('homebranch'),
 891                                  replacementprice=> $replacementprice,
 892                                  barcode => $barcode
 893                                  }
 894                                );
 895             if ( $error ) {
 896                 $template->param(ITEM_ERROR => 1);
 897                 $template->param(error => $error);
 898             } else {
 899                 $template->param(ITEM_CREATED => 1);
 900                 $template->param(barcode => $barcode);
 901             } # if error
 902     } # if barcode exists
 903     print "Content-Type: text/html\n\n", $template->output;
 904 } # sub AcceptItemCopy
 905
 906 #---------------------------------------
 907 sub FormatMarcText {
 908     use strict;
 909
 910     # Input
 911     my (
 912         $fields,        # list ref to MARC fields
 913     )=@_;
 914     # Return
 915     my $marctext;
 916
 917     my (
 918         $color,
 919         $field,
 920         $tag,
 921         $label,
 922         $indicator,
 923         $subfieldcode,$subfieldvalue,
 924         @values, $value
 925     );
 926     my $debug=0;
 927
 928     #-----------------------------------------
 929
 930     $marctext="<table border=0 cellspacing=1>
 931         <tr><th colspan=4 background=/images/background-acq.gif>
 932                 MARC RECORD
 933         </th></tr>\n";
 934
 935     foreach $field ( @$fields ) {
 936
 937         # Swap colors on alternating lines
 938         ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
 939
 940         $tag=$field->{'tag'};
 941         $label=taglabel($tag);
 942
 943         if ( $tag eq 'LDR' ) {
 944                 $tag='';
 945                 $label="Leader:";
 946         }
 947         print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
 948
 949         $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
 950                 "<td bgcolor=$color valign=top>$tag</td> \n";
 951
 952         $indicator=$field->{'indicator'};
 953         $indicator=~s/ +$//;    # drop trailing blanks
 954
 955         # Third table column has indicator if it is short.
 956         # Fourth column has embedded table of subfields, and indicator
 957         #  if it is long (leader or fixed-position fields)
 958
 959         print "<pre>Format indicator=$indicator" .
 960                 " length=" . length( $indicator ) .  "</pre>\n" if $debug;
 961         if ( length( $indicator <= 3 ) ) {
 962             $marctext.="<td bgcolor=$color valign=top><pre>" .
 963                 "$indicator</pre></td>" .
 964                 "<td bgcolor=$color valign=top>" ;
 965         } else {
 966             $marctext.="<td bgcolor=$color valign=top></td>" .
 967                 "<td bgcolor=$color valign=top>" .
 968                 "$indicator ";
 969         } # if length
 970
 971         # Subfields
 972         if ( $field->{'subfields'} )  {
 973             # start another table for subfields
 974             $marctext.= "<table border=0 cellspacing=2>\n";
 975             foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} }   )) {
 976                 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
 977                 if (ref($subfieldvalue) eq 'ARRAY' ) {
 978                     # if it's a pointer to array, get all the values
 979                     @values=@{$subfieldvalue};
 980                 } else {
 981                     # otherwise get the one value
 982                     @values=( $subfieldvalue );
 983                 } # if subfield array
 984                 foreach $value ( @values ) {
 985                   $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
 986                     "<td>$value</td></tr>\n";
 987                 } # foreach value
 988             } # foreach subfield
 989             $marctext.="</table>\n";
 990         } # if subfields
 991         # End of indicator and subfields column
 992         $marctext.="</td>\n";
 993
 994         # End of columns
 995         $marctext.="</tr>\n";
 996
 997     } # foreach field
 998
 999     $marctext.="</table>\n";
1000
1001     return $marctext;
1002
1003 } # sub FormatMarcText
1004
1005
1006 #---------------
1007 # $Log$
1008 # Revision 1.13  2002/08/14 18:12:52  tonnesen
1009 # Added copyright statement to all .pl and .pm files
1010 #
1011 # Revision 1.12  2002/07/24 16:24:20  tipaul
1012 # Now, the acqui.simple system...
1013 # marcimport.pl has been almost completly rewritten, so LOT OF BUGS TO COME !!! You've been warned. It seems to work, but...
1014 #
1015 # As with my former messages, nothing seems to have been changed... but ...
1016 # * marcimport now uses HTML::Template.
1017 # * marcimport now uses MARC::Record. that means that when you import a record, the old-DB is populated with the data as in version 1.2, but the MARC-DB part is filled with full MARC::Record.
1018 #
1019 # <IMPORTANT NOTE>
1020 # to get correct response times, you MUST add an index on isbn, issn and lccn rows in biblioitem table. Note this should be done in 1.2 too...
1021 # </IMPORTANT NOTE>
1022 #
1023 # <IMPORTANT NOTE2>
1024 # acqui.simple manage biblio, biblioitems and items tables quite properly. Normal acquisition system manages biblio, biblioitems BUT NOT items. That will be done in the near future...
1025 # </IMPORTANT NOTE2>
1026 #
1027 # what's next now ?
1028 # * bug tracking, of course... Surely a dozen of dozens...
1029 # * LOT of developpments, i'll surely write a mail to koha-devel tomorrow (as it's time for dinner in France, and i plan to play NeverwinterNights after dinner ;-) ...
1030 #
1031 # Revision 1.6.2.32  2002/06/29 17:33:47  amillar
1032 # Allow DEFAULT as input to addz3950search.
1033 # Check for existence of pid file (cat crashed otherwise).
1034 # Return error messages in addz3950search.
1035 #
1036 # Revision 1.6.2.31  2002/06/28 18:50:46  tonnesen
1037 # Got rid of white text on black, replaced with black on background-acq.gif
1038 #
1039 # Revision 1.6.2.30  2002/06/28 18:07:27  tonnesen
1040 # marcimport.pl will print an error message if it can not signal the
1041 # processz3950queue program.  The message contains instructions for starting the
1042 # daemon.
1043 #
1044 # Revision 1.6.2.29  2002/06/27 18:35:01  tonnesen
1045 # $deweyinput was always defined (it's an HTML input field).  Check against
1046 # $bib->{dewey} instead.
1047 #
1048 # Revision 1.6.2.28  2002/06/27 17:41:26  tonnesen
1049 # Applying patch from Matt Kraai to pick F or NF based on presense of a dewey
1050 # number when adding a book via marcimport.pl
1051 #
1052 # Revision 1.6.2.27  2002/06/26 15:52:55  amillar
1053 # Fix display of marc tag labels and indicators
1054 #
1055 # Revision 1.6.2.26  2002/06/26 14:28:35  amillar
1056 # Removed subroutines now existing in modules: extractmarcfields,
1057 #  parsemarcfileformat, addz3950queue, getkeytableselectoptions
1058 #