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