z3950/z3950import.pl

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