acqui.simple/marcimport.pl

   1 #!/usr/bin/perl
   2
   3 # Script for handling import of MARC data into Koha db
   4 #   and Z39.50 lookups
   5
   6 # Koha library project  www.koha.org
   7
   8 # Licensed under the GPL
   9 use strict;
  10 #use strict;
  11
  12 # standard or CPAN modules used
  13 use CGI;
  14 use DBI;
  15
  16 # Koha modules used
  17 use C4::Database;
  18 use C4::Acquisitions;
  19 use C4::Output;
  20
  21 use C4::Input;
  22 use C4::Biblio;
  23
  24 #------------------
  25 # Constants
  26
  27 # HTML colors for alternating lines
  28 my $lc1='#dddddd';
  29 my $lc2='#ddaaaa';
  30
  31 my %tagtext = (
  32     '001' => 'Control number',
  33     '003' => 'Control number identifier',
  34     '005' => 'Date and time of latest transaction',
  35     '006' => 'Fixed-length data elements -- additional material characteristics',
  36     '007' => 'Physical description fixed field',
  37     '008' => 'Fixed length data elements',
  38     '010' => 'LCCN',
  39     '015' => 'LCCN Cdn',
  40     '020' => 'ISBN',
  41     '022' => 'ISSN',
  42     '037' => 'Source of acquisition',
  43     '040' => 'Cataloging source',
  44     '041' => 'Language code',
  45     '043' => 'Geographic area code',
  46     '050' => 'Library of Congress call number',
  47     '060' => 'National Library of Medicine call number',
  48     '082' => 'Dewey decimal call number',
  49     '100' => 'Main entry -- Personal name',
  50     '110' => 'Main entry -- Corporate name',
  51     '130' => 'Main entry -- Uniform title',
  52     '240' => 'Uniform title',
  53     '245' => 'Title statement',
  54     '246' => 'Varying form of title',
  55     '250' => 'Edition statement',
  56     '256' => 'Computer file characteristics',
  57     '260' => 'Publication, distribution, etc.',
  58     '263' => 'Projected publication date',
  59     '300' => 'Physical description',
  60     '306' => 'Playing time',
  61     '440' => 'Series statement / Added entry -- Title',
  62     '490' => 'Series statement',
  63     '500' => 'General note',
  64     '504' => 'Bibliography, etc. note',
  65     '505' => 'Formatted contents note',
  66     '508' => 'Creation/production credits note',
  67     '510' => 'Citation/references note',
  68     '511' => 'Participant or performer note',
  69     '520' => 'Summary, etc. note',
  70     '521' => 'Target audience note (ie age)',
  71     '530' => 'Additional physical form available note',
  72     '538' => 'System details note',
  73     '586' => 'Awards note',
  74     '600' => 'Subject added entry -- Personal name',
  75     '610' => 'Subject added entry -- Corporate name',
  76     '650' => 'Subject added entry -- Topical term',
  77     '651' => 'Subject added entry -- Geographic name',
  78     '656' => 'Index term -- Occupation',
  79     '700' => 'Added entry -- Personal name',
  80     '710' => 'Added entry -- Corporate name',
  81     '730' => 'Added entry -- Uniform title',
  82     '740' => 'Added entry -- Uncontrolled related/analytical title',
  83     '800' => 'Series added entry -- Personal name',
  84     '830' => 'Series added entry -- Uniform title',
  85     '852' => 'Location',
  86     '856' => 'Electronic location and access',
  87 );
  88
  89 # tag, subfield, field name, repeats, striptrailingchars
  90 my %tagmap=(
  91     '010'=>{'a'=>{name=> 'lccn',        rpt=>0  }},
  92     '015'=>{'a'=>{name=> 'lccn',        rpt=>0  }},
  93     '020'=>{'a'=>{name=> 'isbn',        rpt=>0  }},
  94     '022'=>{'a'=>{name=> 'issn',        rpt=>0  }},
  95     '082'=>{'a'=>{name=> 'dewey',       rpt=>0  }},
  96     '100'=>{'a'=>{name=> 'author',      rpt=>0, striptrail=>',:;/-'     }},
  97     '245'=>{'a'=>{name=> 'title',       rpt=>0, striptrail=>',:;/'      },
  98             'b'=>{name=> 'subtitle',    rpt=>0, striptrail=>',:;/'      }},
  99     '260'=>{'a'=>{name=> 'place',       rpt=>0, striptrail=>',:;/-'     },
 100             'b'=>{name=> 'publisher',   rpt=>0, striptrail=>',:;/-'     },
 101             'c'=>{name=> 'year' ,       rpt=>0, striptrail=>'.,:;/-'    }},
 102     '300'=>{'a'=>{name=> 'pages',       rpt=>0, striptrail=>',:;/-'     },
 103             'c'=>{name=> 'size',        rpt=>0, striptrail=>',:;/-'     }},
 104     '362'=>{'a'=>{name=> 'volume-number',       rpt=>0  }},
 105     '440'=>{'a'=>{name=> 'seriestitle', rpt=>0, striptrail=>',:;/'      },
 106             'v'=>{name=> 'volume-number',rpt=>0 }},
 107     '490'=>{'a'=>{name=> 'seriestitle', rpt=>0, striptrail=>',:;/'      },
 108             'v'=>{name=> 'volume-number',rpt=>0 }},
 109     '700'=>{'a'=>{name=> 'addtional-author-illus',rpt=>1, striptrail=>',:;/'    }},
 110     '5xx'=>{'a'=>{name=> 'notes',       rpt=>1  }},
 111     '65x'=>{'a'=>{name=> 'subject',     rpt=>1, striptrail=>'.,:;/-'    }},
 112 );
 113
 114 #-------------
 115 #-------------
 116 # Initialize
 117
 118 my $userid=$ENV{'REMOTE_USER'};
 119
 120 my $input = new CGI;
 121 my $dbh=C4Connect;
 122
 123 #-------------
 124 # Display output
 125 print $input->header;
 126 print startpage();
 127 print startmenu('acquisitions');
 128 #-------------
 129 # Process input parameters
 130 my $file=$input->param('file');
 131 my $menu = $input->param('menu');
 132
 133 if ($input->param('z3950queue')) {
 134         AcceptZ3950Queue($dbh,$input);
 135 }
 136
 137 if ($input->param('uploadmarc')) {
 138         AcceptMarcUpload($dbh,$input)
 139 }
 140
 141 if ($input->param('insertnewrecord')) {
 142     # Add biblio item, and set up menu for adding item copies
 143     my ($biblionumber,$biblioitemnumber)=AcceptBiblioitem($dbh,$input);
 144     ItemCopyForm($dbh,$input,$biblionumber,$biblioitemnumber);
 145     print endmenu();
 146     print endpage();
 147     exit;
 148 }
 149
 150
 151 if ($input->param('newitem')) {
 152     # Add item copy
 153     &AcceptItemCopy($dbh,$input);
 154 } # if newitem
 155
 156 if ($file) {
 157     ProcessFile($dbh,$input);
 158 } else {
 159 SWITCH:
 160     {
 161         if ($menu eq 'z3950') { z3950menu($dbh,$input); last SWITCH; }
 162         if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; }
 163         if ($menu eq 'manual') { manual(); last SWITCH; }
 164         mainmenu();
 165     }
 166
 167 }
 168 print endmenu();
 169 print endpage();
 170
 171
 172 sub ProcessFile {
 173     # A MARC file has been specified; process it for review form
 174     use strict;
 175
 176     # Input params
 177     my (
 178         $dbh,
 179         $input,
 180     )=@_;
 181
 182     # local vars
 183     my (
 184         $sth,
 185         $record,
 186     );
 187
 188     my $debug=0;
 189     my $splitchar=chr(29);
 190
 191     requireDBI($dbh,"ProcessFile");
 192
 193     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 194     my $qisbn=$input->param('isbn');
 195     my $qissn=$input->param('issn');
 196     my $qlccn=$input->param('lccn');
 197     my $qcontrolnumber=$input->param('controlnumber');
 198
 199     # See if a particular result item was specified
 200     if ($qisbn || $qissn || $qlccn || $qcontrolnumber) {
 201         print "<a href=$ENV{'SCRIPT_NAME'}>New File</a><hr>\n";
 202         #open (F, "$file");
 203         #my $data=<F>;
 204         my $data;
 205
 206         if ($file=~/Z-(\d+)/) {
 207             my $id=$1;
 208             my $resultsid=$input->param('resultsid');
 209             my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
 210             $sth->execute;
 211             ($data) = $sth->fetchrow;
 212         } else {
 213             my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
 214             $sth->execute;
 215             ($data) = $sth->fetchrow;
 216         }
 217
 218         my @records;
 219
 220 RECORD:
 221         foreach $record (split(/$splitchar/, $data)) {
 222
 223             my (
 224                 $bib,           # hash ref to named fields
 225                 $fieldlist,     # list ref
 226                 $lccn, $isbn, $issn, $dewey,
 227                 $publisher, $publicationyear, $volume,
 228                 $number, @subjects, $notes, $additionalauthors,
 229                 $copyrightdate, $seriestitle,
 230                 $origisbn, $origissn, $origlccn, $origcontrolnumber,
 231                 $subtitle,
 232                 $controlnumber,
 233                 $cleanauthor,
 234                 $subject,
 235                 $volumedate,
 236                 $volumeddesc,
 237                 $itemtypeselect,
 238             );
 239             my ($lccninput, $isbninput, $issninput, $deweyinput, $authorinput, $titleinput,
 240                 $placeinput, $publisherinput, $publicationyearinput, $volumeinput,
 241                 $numberinput, $notesinput, $additionalauthorsinput,
 242                 $illustratorinput, $copyrightdateinput, $seriestitleinput,
 243                 $subtitleinput,
 244                 $copyrightinput,
 245                 $volumedateinput,
 246                 $volumeddescinput,
 247                 $subjectinput,
 248                 $noteinput,
 249                 $subclassinput,
 250                 $pubyearinput,
 251                 $pagesinput,
 252                 $sizeinput,
 253                 $marcinput,
 254                 $fileinput,
 255             );
 256
 257
 258             my $marctext;
 259
 260             my $marc=$record;
 261
 262             ($fieldlist)=parsemarcfileformat($record );
 263
 264             $bib=extractmarcfields($fieldlist );
 265
 266             print "Title=$bib->{title}\n" if $debug;
 267
 268             $marctext=FormatMarcText($fieldlist);
 269
 270                 $controlnumber          =$bib->{controlnumber};
 271                 $lccn                   =$bib->{lccn};
 272                 $isbn                   =$bib->{isbn};
 273                 $issn                   =$bib->{issn};
 274                 $publisher              =$bib->{publisher};
 275                 $publicationyear        =$bib->{publicationyear};
 276                 $copyrightdate          =$bib->{copyrightdate};
 277
 278                 $volume                 =$bib->{volume};
 279                 $number                 =$bib->{number};
 280                 $seriestitle            =$bib->{seriestitle};
 281                 $additionalauthors      =$bib->{additionalauthors};
 282                 $notes                  =$bib->{notes};
 283
 284             $titleinput=$input->textfield(-name=>'title', -default=>$bib->{title}, -size=>40);
 285             $marcinput=$input->hidden(-name=>'marc', -default=>$marc);
 286             $subtitleinput=$input->textfield(-name=>'subtitle', -default=>$bib->{subtitle}, -size=>40);
 287             $authorinput=$input->textfield(-name=>'author', -default=>$bib->{author});
 288             $illustratorinput=$input->textfield(-name=>'illustrator',
 289                 -default=>$bib->{illustrator});
 290             $additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
 291
 292             my $subject='';
 293             foreach ( @{$bib->{subject} } ) {
 294                 $subject.="$_\n";
 295                 print "<PRE>form subject=$subject</PRE>\n" if $debug;
 296             }
 297             $subjectinput=$input->textarea(-name=>'subject',
 298                         -default=>$subject, -rows=>4, -cols=>40);
 299
 300             $noteinput=$input->textarea(-name=>'notes',
 301                         -default=>$notes, -rows=>4, -cols=>40, -wrap=>'physical');
 302             $copyrightinput=$input->textfield(-name=>'copyrightdate', -default=>$copyrightdate);
 303             $seriestitleinput=$input->textfield(-name=>'seriestitle', -default=>$seriestitle);
 304             $volumeinput=$input->textfield(-name=>'volume', -default=>$volume);
 305             $volumedateinput=$input->textfield(-name=>'volumedate', -default=>$volumedate);
 306             $volumeddescinput=$input->textfield(-name=>'volumeddesc', -default=>$volumeddesc);
 307             $numberinput=$input->textfield(-name=>'number', -default=>$number);
 308             $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
 309             $issninput=$input->textfield(-name=>'issn', -default=>$issn);
 310             $lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
 311             $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
 312             $deweyinput=$input->textfield(-name=>'dewey', -default=>$bib->{dewey});
 313             $cleanauthor=$bib->{author};
 314             $cleanauthor=~s/[^A-Za-z]//g;
 315             $subclassinput=$input->textfield(-name=>'subclass', -default=>uc(substr($cleanauthor,0,3)));
 316             $publisherinput=$input->textfield(-name=>'publishercode', -default=>$publisher);
 317             $pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
 318             $placeinput=$input->textfield(-name=>'place', -default=>$bib->{place});
 319             $pagesinput=$input->textfield(-name=>'pages', -default=>$bib->{pages});
 320             $sizeinput=$input->textfield(-name=>'size', -default=>$bib->{size});
 321             $fileinput=$input->hidden(-name=>'file', -default=>$file);
 322             $origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
 323             $origissn=$input->hidden(-name=>'origissn', -default=>$issn);
 324             $origlccn=$input->hidden(-name=>'origlccn', -default=>$lccn);
 325             $origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
 326
 327             #print "<PRE>getting itemtypeselect</PRE>\n";
 328             $itemtypeselect=&getkeytableselectoptions(
 329                 $dbh, 'itemtypes', 'itemtype', 'description', 1);
 330             #print "<PRE>it=$itemtypeselect</PRE>\n";
 331
 332             ($qissn) || ($qissn='NIL');
 333             ($qlccn) || ($qlccn='NIL');
 334             ($qisbn) || ($qisbn='NIL');
 335             ($qcontrolnumber) || ($qcontrolnumber='NIL');
 336             $controlnumber=~s/\s+//g;
 337
 338             unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) {
 339                 #print "<PRE>Skip record $isbn $issn $lccn </PRE>\n";
 340                 next RECORD;
 341             }
 342
 343             print << "EOF";
 344             <center>
 345             <h1>New Record</h1>
 346             Full MARC Record available at bottom
 347             <form method=post>
 348               <table border=1>
 349                 <tr><td>Title</td><td>$titleinput</td></tr>
 350                 <tr><td>Subtitle</td><td>$subtitleinput</td></tr>
 351                 <tr><td>Author</td><td>$authorinput</td></tr>
 352                 <tr><td>Additional Authors</td><td>$additionalauthorsinput</td></tr>
 353                 <tr><td>Illustrator</td><td>$illustratorinput</td></tr>
 354                 <tr><td>Copyright</td><td>$copyrightinput</td></tr>
 355                 <tr><td>Series Title</td><td>$seriestitleinput</td></tr>
 356                 <tr><td>Volume</td><td>$volumeinput</td></tr>
 357                 <tr><td>Number</td><td>$numberinput</td></tr>
 358                 <tr><td>Volume Date</td><td>$volumedateinput</td></tr>
 359                 <tr><td>Volume Description</td><td>$volumeddescinput</td></tr>
 360                 <tr><td>Subject</td><td>$subjectinput</td></tr>
 361                 <tr><td>Notes</td><td>$noteinput</td></tr>
 362                 <tr><td>Item Type</td><td><select name=itemtype>$itemtypeselect</select></td></tr>
 363                 <tr><td>ISBN</td><td>$isbninput</td></tr>
 364                 <tr><td>ISSN</td><td>$issninput</td></tr>
 365                 <tr><td>LCCN</td><td>$lccninput</td></tr>
 366                 <tr><td>Dewey</td><td>$deweyinput</td></tr>
 367                 <tr><td>Subclass</td><td>$subclassinput</td></tr>
 368                 <tr><td>Publication Year</td><td>$pubyearinput</td></tr>
 369                 <tr><td>Publisher</td><td>$publisherinput</td></tr>
 370                 <tr><td>Place</td><td>$placeinput</td></tr>
 371                 <tr><td>Pages</td><td>$pagesinput</td></tr>
 372                 <tr><td>Size</td><td>$sizeinput</td></tr>
 373               </table>
 374               <input type=submit>
 375               <input type=hidden name=insertnewrecord value=1>
 376               $fileinput
 377               $marcinput
 378               $origisbn
 379               $origissn
 380               $origlccn
 381               $origcontrolnumber
 382             </form>
 383             $marctext
 384 EOF
 385         } # foreach record
 386     } else {
 387         # No result item specified, list results
 388         ListFileRecords($dbh,$input);
 389     } # if
 390 } # sub ProcessFile
 391
 392 sub ListFileRecords {
 393     use strict;
 394
 395     # Input parameters
 396     my (
 397         $dbh,
 398         $input,
 399     )=@_;
 400
 401     my (
 402         $sth, $sti,
 403         $field,
 404         $data,          # records in MARC file format
 405         $name,
 406         $srvid,
 407         %servernames,
 408         $serverdb,
 409     );
 410
 411         my $z3950=0;
 412         my $recordsource;
 413         my $record;
 414         my ($numrecords,$resultsid,$data,$startdate,$enddate);
 415
 416     requireDBI($dbh,"ListFileRecords");
 417
 418         # File can be z3950 search query or uploaded MARC data
 419
 420         # if z3950 results
 421         if ($file=~/Z-(\d+)/) {
 422             # This is a z3950 search
 423             $recordsource='';
 424         } else {
 425             # This is a Marc upload
 426             $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
 427             $sth->execute;
 428             ($data, $name) = $sth->fetchrow;
 429             $recordsource="from $name";
 430         }
 431
 432         print << "EOF";
 433           <center>
 434           <p>
 435           <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
 436           <p>
 437           <table border=0 cellpadding=10 cellspacing=0>
 438           <tr><th bgcolor=black>
 439             <font color=white>Select a Record to Import $recordsource</font>
 440           </th></tr>
 441           <tr><td bgcolor=#dddddd>
 442 EOF
 443
 444         if ($file=~/Z-(\d+)/) {
 445             # This is a z3950 search
 446
 447             my $id=$1;          # search query id number
 448             my $serverstring;
 449             my $starttimer=time();
 450
 451             $sth=$dbh->prepare("
 452                 select z3950results.numrecords,z3950results.id,z3950results.results,
 453                         z3950results.startdate,z3950results.enddate,server
 454                 from z3950queue left outer join z3950results
 455                      on z3950queue.id=z3950results.queryid
 456                 where z3950queue.id=?
 457                 order by server
 458             ");
 459             $sth->execute($id);
 460             if ( $sth->rows ) {
 461               # loop through all servers in search results
 462               while ( ($numrecords,$resultsid,$data,
 463                         $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
 464                 my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
 465                 #print "server=$serverstring\n";
 466                 if ( $server ) {
 467                     print "<a name=SERVER-$srvid></a> " .
 468                         &z3950servername($dbh,$srvid,"$server/$database") . "\n";
 469                 } # if $server
 470                 my $startrecord=$input->param("ST-$srvid");
 471                 ($startrecord) || ($startrecord='0');
 472                 my $serverplaceholder='';
 473                 foreach ($input->param) {
 474                     (next) unless (/ST-(.+)/);
 475                     my $serverid=$1;
 476                     (next) if ($serverid eq $srvid);
 477                     my $place=$input->param("ST-$serverid");
 478                     $serverplaceholder.="\&ST-$serverid=$place";
 479                 }
 480                 if ($numrecords) {
 481                     my $previous='';
 482                     my $next='';
 483                     if ($startrecord>0) {
 484                         $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>Previous</a>";
 485                     }
 486                     my $highest;
 487                     $highest=$startrecord+10;
 488                     ($highest>$numrecords) && ($highest=$numrecords);
 489                     if ($numrecords>$startrecord+10) {
 490                         $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=$highest#SERVER-$srvid>Next</a>";
 491                     }
 492                     print "<font size=-1>[Viewing ".($startrecord+1)." to ".$highest." of $numrecords records]  $previous | $next </font><br>\n";
 493                     my $stj=$dbh->prepare("update z3950results
 494                         set highestseen=? where id=?");
 495                     $stj->execute($startrecord+10,$resultsid);
 496                 } else {
 497                     print "<br>\n";
 498                 }
 499                 print "<ul>\n";
 500
 501                 if (! $server ) {
 502                     print "<font color=red>Search still pending...</font>";
 503                 } elsif ($enddate == 0) {
 504                     my $now=time();
 505                     my $elapsed=$now-$startdate;
 506                     my $elapsedtime='';
 507                     if ($elapsed>60) {
 508                         $elapsedtime=sprintf "%d minutes",($elapsed/60);
 509                     } else {
 510                         $elapsedtime=sprintf "%d seconds",$elapsed;
 511                     }
 512                     print "<font color=red>processing... ($elapsedtime)</font>";
 513                 } elsif ($numrecords) {
 514                     my @records=parsemarcfileformat($data);
 515                     my $i;
 516                     for ($i=$startrecord; $i<$startrecord+10; $i++) {
 517                         $data.=$records[$i].$splitchar;
 518                     }
 519                     @records=parsemarcdata($data);
 520                     my $counter=0;
 521                     foreach $record (@records) {
 522                         $counter++;
 523                         #(next) unless ($counter>=$startrecord && $counter<=$startrecord+10);
 524                         my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $controlnumber);
 525                         foreach $field (@$record) {
 526                             if ($field->{'tag'} eq '001') {
 527                                 $controlnumber=$field->{'indicator'};
 528                             }
 529                             if ($field->{'tag'} eq '010') {
 530                                 $lccn=$field->{'subfields'}->{'a'};
 531                                 $lccn=~s/^\s*//;
 532                                 ($lccn) = (split(/\s+/, $lccn))[0];
 533                             }
 534                             if ($field->{'tag'} eq '015') {
 535                                 $lccn=$field->{'subfields'}->{'a'};
 536                                 $lccn=~s/^\s*//;
 537                                 $lccn=~s/^C//;
 538                                 ($lccn) = (split(/\s+/, $lccn))[0];
 539                             }
 540                             if ($field->{'tag'} eq '020') {
 541                                 $isbn=$field->{'subfields'}->{'a'};
 542                                 ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
 543                                 $isbn=~s/[^\d]*//g;
 544                             }
 545                             if ($field->{'tag'} eq '022') {
 546                                 $issn=$field->{'subfields'}->{'a'};
 547                                 $issn=~s/^\s*//;
 548                                 ($issn) = (split(/\s+/, $issn))[0];
 549                             }
 550                             if ($field->{'tag'} eq '100') {
 551                                 $author=$field->{'subfields'}->{'a'};
 552                             }
 553                             if ($field->{'tag'} eq '245') {
 554                                 $title=$field->{'subfields'}->{'a'};
 555                                 $title=~s/ \/$//;
 556                                 $subtitle=$field->{'subfields'}->{'b'};
 557                                 $subtitle=~s/ \/$//;
 558                             }
 559                         }
 560                         my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
 561                         my $q_issn=$dbh->quote((($issn) || ('NIL')));
 562                         my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
 563                         my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
 564                         my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
 565                         $sth->execute;
 566                         my $donetext='';
 567                         if ($sth->rows) {
 568                             $donetext="DONE";
 569                         }
 570                         $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
 571                         $sth->execute;
 572                         if ($sth->rows) {
 573                             $donetext="DONE";
 574                         }
 575                         ($author) && ($author="by $author");
 576                         if ($isbn) {
 577                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&isbn=$isbn>$title $subtitle $author</a> $donetext<br>\n";
 578                         } elsif ($lccn) {
 579                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&lccn=$lccn>$title $subtitle $author</a> $donetext<br>\n";
 580                         } elsif ($issn) {
 581                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&issn=$issn>$title $subtitle $author</a><br> $donetext\n";
 582                         } elsif ($controlnumber) {
 583                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&controlnumber=$controlnumber>$title $subtitle $author</a><br> $donetext\n";
 584                         } else {
 585                             print "Error: Contact steve regarding $title by $author<br>\n";
 586                         }
 587                     }
 588                     print "<p>\n";
 589                 } else {
 590                         if ( $records[$i] ) {
 591                           &PrintResultRecordLink($dbh,$records[$i],$resultsid);
 592                         } # if record
 593                     } # for records
 594                     print "<p>\n";
 595                 } else {
 596                     print "No records returned.<p>\n";
 597                 }
 598                 print "</ul>\n";
 599             } # foreach server
 600             my $elapsed=time()-$starttimer;
 601             print "<hr>It took $elapsed seconds to process this page.\n";
 602             } else {
 603                 print "<b>No results found for query $id</b>\n";
 604             } # if rows
 605         } else {
 606             # This is an uploaded Marc record
 607
 608             my @records=parsemarcfileformat($data);
 609             foreach $record (@records) {
 610                 &PrintResultRecordLink($dbh,$record,'');
 611             } # foreach record
 612         } # if z3950 or marc upload
 613         print "</td></tr></table>\n";
 614 } # sub ListFileRecords
 615
 616 #--------------
 617 sub z3950servername {
 618     # inputs
 619     my (
 620         $dbh,
 621         $srvid,         # server id number
 622         $default,
 623     )=@_;
 624     # return
 625     my $longname;
 626     #----
 627
 628     requireDBI($dbh,"z3950servername");
 629
 630         my $sti=$dbh->prepare("select name
 631                 from z3950servers
 632                 where id=?");
 633         $sti->execute($srvid);
 634         if ( ! $sti->err ) {
 635             ($longname)=$sti->fetchrow;
 636         }
 637         if (! $longname) {
 638             $longname="$default";
 639         }
 640         return $longname;
 641 } # sub z3950servername
 642
 643 sub PrintResultRecordLink {
 644     use strict;
 645     my ($dbh,$record,$resultsid)=@_;    # input
 646
 647     my (
 648         $sth,
 649         $bib,   # hash ref to named fields
 650         $searchfield, $searchvalue,
 651         $donetext,
 652         $fieldname,
 653     );
 654
 655     requireDBI($dbh,"PrintResultRecordLink");
 656
 657         $bib=extractmarcfields($record);
 658
 659         $sth=$dbh->prepare("select *
 660           from biblioitems
 661           where isbn=?  or issn=?  or lccn=? ");
 662         $sth->execute($bib->{isbn},$bib->{issn},$bib->{lccn});
 663         if ($sth->rows) {
 664             $donetext="DONE";
 665         } else {
 666             $donetext="";
 667         }
 668         ($bib->{author}) && ($bib->{author}="by $bib->{author}");
 669
 670         $searchfield="";
 671         foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
 672             if ( defined $bib->{$fieldname} ) {
 673                 $searchfield=$fieldname;
 674                 $searchvalue=$bib->{$fieldname};
 675             } # if defined fieldname
 676         } # foreach
 677
 678         if ( $searchfield ) {
 679             print "<a href=$ENV{'SCRIPT_NAME'}?file=$file" .
 680                 "&resultsid=$resultsid" .
 681                 "&$searchfield=$searchvalue" .
 682                 "&searchfield=$searchfield" .
 683                 "&searchvalue=$searchvalue" .
 684                 ">$bib->{title} $bib->{author}</a>" .
 685                 " $donetext <BR>\n";
 686         } else {
 687             print "Error: Problem with $bib->{title} $bib->{author}<br>\n";
 688         } # if searchfield
 689 } # sub PrintResultRecordLink
 690
 691 #------------------
 692 sub extractmarcfields {
 693     use strict;
 694     # input
 695     my (
 696         $record,        # pointer to list of MARC field hashes.
 697                         # Example: $record->[0]->{'tag'} = '100' # Author
 698                         #       $record->[0]->{'subfields'}->{'a'} = subfieldvalue
 699     )=@_;
 700
 701     # return
 702     my $bib;            # pointer to hash of named output fields
 703                         # Example: $bib->{'author'} = "Twain, Mark";
 704
 705     my $debug=0;
 706
 707     my (
 708         $field,         # hash ref
 709         $value,
 710         $subfield,      # Marc subfield [a-z]
 711         $fieldname,     # name of field "author", "title", etc.
 712         $strip,         # chars to remove from end of field
 713         $stripregex,    # reg exp pattern
 714     );
 715     my ($lccn, $isbn, $issn,
 716         $publicationyear, @subjects, $subject,
 717         $controlnumber,
 718         $notes, $additionalauthors, $illustrator, $copyrightdate,
 719         $s, $subdivision, $subjectsubfield,
 720     );
 721
 722     print "<PRE>\n" if $debug;
 723
 724     if ( ref($record) eq "ARRAY" ) {
 725         foreach $field (@$record) {
 726
 727             # Check each subfield in field
 728             foreach $subfield ( keys %{$field->{subfields}} ) {
 729                 # see if it is defined in our Marc to koha mapping table
 730                 if ( $fieldname=$tagmap{ $field->{'tag'} }->{$subfield}->{name} ) {
 731                     # Yes, so keep the value
 732                     if ( ref($field->{'subfields'}->{$subfield} ) eq 'ARRAY' ) {
 733                         # if it was an array, just keep first element.
 734                         $bib->{$fieldname}=$field->{'subfields'}->{$subfield}[0];
 735                     } else {
 736                         $bib->{$fieldname}=$field->{'subfields'}->{$subfield};
 737                     } # if array
 738                     print "$field->{'tag'} $subfield $fieldname=$bib->{$fieldname}\n" if $debug;
 739                     # see if this field should have trailing chars dropped
 740                     if ($strip=$tagmap{ $field->{'tag'} }->{$subfield}->{striptrail} ) {
 741                         $strip=~s//\\/; # backquote each char
 742                         $stripregex='[ ' . $strip . ']+$';  # remove trailing spaces also
 743                         $bib->{$fieldname}=~s/$stripregex//;
 744                     } # if strip
 745                     print "Found subfield $field->{'tag'} $subfield " .
 746                         "$fieldname = $bib->{$fieldname}\n" if $debug;
 747                 } # if tagmap exists
 748
 749             } # foreach subfield
 750
 751
 752             if ($field->{'tag'} eq '001') {
 753                 $bib->{controlnumber}=$field->{'indicator'};
 754             }
 755             if ($field->{'tag'} eq '015') {
 756                 $bib->{lccn}=$field->{'subfields'}->{'a'};
 757                 $bib->{lccn}=~s/^\s*//;
 758                 $bib->{lccn}=~s/^C//;
 759                 ($bib->{lccn}) = (split(/\s+/, $bib->{lccn}))[0];
 760             }
 761
 762
 763                 if ($field->{'tag'} eq '260') {
 764
 765                     $publicationyear=$field->{'subfields'}->{'c'};
 766                     if ($publicationyear=~/c(\d\d\d\d)/) {
 767                         $copyrightdate=$1;
 768                     }
 769                     if ($publicationyear=~/[^c](\d\d\d\d)/) {
 770                         $publicationyear=$1;
 771                     } elsif ($copyrightdate) {
 772                         $publicationyear=$copyrightdate;
 773                     } else {
 774                         $publicationyear=~/(\d\d\d\d)/;
 775                         $publicationyear=$1;
 776                     }
 777                 }
 778                 if ($field->{'tag'} eq '700') {
 779                     my $name=$field->{'subfields'}->{'a'};
 780                     if ($field->{'subfields'}->{'e'}!~/ill/) {
 781                         $additionalauthors.="$name\n";
 782                     } else {
 783                         $illustrator=$name;
 784                     }
 785                 }
 786                 if ($field->{'tag'} =~/^5/) {
 787                     $notes.="$field->{'subfields'}->{'a'}\n";
 788                 }
 789                 if ($field->{'tag'} =~/65\d/) {
 790                     my $sub;
 791                     my $subject=$field->{'subfields'}->{'a'};
 792                     $subject=~s/\.$//;
 793                     print "Subject=$subject\n" if $debug;
 794                     foreach $subjectsubfield ( 'x','y','z' ) {
 795                       if ($subdivision=$field->{'subfields'}->{$subjectsubfield}) {
 796                         if ( ref($subdivision) eq 'ARRAY' ) {
 797                             foreach $s (@$subdivision) {
 798                                 $s=~s/\.$//;
 799                                 $subject.=" -- $s";
 800                             } # foreach subdivision
 801                         } else {
 802                             $subdivision=~s/\.$//;
 803                             $subject.=" -- $subdivision";
 804                         } # if array
 805                       } # if subfield exists
 806                     } # foreach subfield
 807                     print "Subject=$subject\n" if $debug;
 808                     push @subjects, $subject;
 809                 } # if tag 65x
 810
 811
 812         } # foreach field
 813         ($publicationyear       ) && ($bib->{publicationyear}=$publicationyear  );
 814         ($copyrightdate         ) && ($bib->{copyrightdate}=$copyrightdate  );
 815         ($additionalauthors     ) && ($bib->{additionalauthors}=$additionalauthors  );
 816         ($illustrator           ) && ($bib->{illustrator}=$illustrator  );
 817         ($notes                 ) && ($bib->{notes}=$notes  );
 818         ($#subjects             ) && ($bib->{subject}=\@subjects  );
 819
 820         # Misc cleanup
 821         $bib->{dewey}=~s/\///g; # drop any slashes
 822
 823         ($bib->{lccn}) = (split(/\s+/, $bib->{lccn}))[0]; # only keep first word
 824
 825         $bib->{isbn}=~s/[^\d]*//g;      # drop non-digits
 826
 827         $bib->{issn}=~s/^\s*//;
 828         ($bib->{issn}) = (split(/\s+/, $bib->{issn}))[0];
 829
 830         if ( $bib->{'volume-number'} ) {
 831             if ($bib->{'volume-number'}=~/(\d+).*(\d+)/ ) {
 832                 $bib->{'volume'}=$1;
 833                 $bib->{'number'}=$2;
 834             } else {
 835                 $bib->{volume}=$bib->{'volume-number'};
 836             }
 837             delete $bib->{'volume-number'};
 838         } # if volume-number
 839
 840     } else {
 841         print "Error: extractmarcfields: input ref $record is " .
 842                 ref($record) . " not ARRAY. Contact sysadmin.\n";
 843     }
 844     print "</PRE>\n" if $debug;
 845
 846     return $bib;
 847
 848 } # sub extractmarcfields
 849 #---------------------------------
 850
 851 sub z3950menu {
 852     use strict;
 853     my (
 854         $dbh,
 855         $input,
 856     )=@_;
 857
 858     my (
 859         $sth, $sti,
 860         $processing,
 861         $realenddate,
 862         $totalrecords,
 863         $elapsed,
 864         $elapsedtime,
 865         $resultstatus, $statuscolor,
 866         $id, $term, $type, $done,
 867         $startdate, $enddate, $servers,
 868         $record,$bib,$title,
 869     );
 870
 871     requireDBI($dbh,"z3950menu");
 872
 873     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 874     print "<table border=0><tr><td valign=top>\n";
 875     print "<h2>Results of Z39.50 searches</h2>\n";
 876     print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n" .
 877           "<ul>\n";
 878
 879     # Check queued queries
 880     $sth=$dbh->prepare("select id,term,type,done,
 881                 startdate,enddate,servers
 882         from z3950queue
 883         order by id desc
 884         limit 20 ");
 885     $sth->execute;
 886     while ( ($id, $term, $type, $done,
 887                 $startdate, $enddate, $servers) = $sth->fetchrow) {
 888         $type=uc($type);
 889         $term=~s/</&lt;/g;
 890         $term=~s/>/&gt;/g;
 891
 892         $title="";
 893         # See if query produced results
 894         $sti=$dbh->prepare("select id,server,startdate,enddate,numrecords,results
 895                 from z3950results
 896                 where queryid=?");
 897         $sti->execute($id);
 898         if ($sti->rows) {
 899             $processing=0;
 900             $realenddate=0;
 901             $totalrecords=0;
 902             while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords,$r_marcdata)
 903                 = $sti->fetchrow) {
 904                 if ($r_enddate==0) {
 905                     # It hasn't finished yet
 906                     $processing=1;
 907                 } else {
 908                     # It finished, see how long it took.
 909                     if ($r_enddate>$realenddate) {
 910                         $realenddate=$r_enddate;
 911                     }
 912                     # Snag any title from the results if there were any
 913                     if ( ! $title && $r_marcdata ) {
 914                         ($record)=parsemarcfileformat($r_marcdata);
 915                         $bib=extractmarcfields($record);
 916                         if ( $bib->{title} ) { $title=$bib->{title} };
 917                     } # if no title yet
 918                 } # if finished
 919
 920                 $totalrecords+=$r_numrecords;
 921             } # while results
 922
 923             if ($processing) {
 924                 $elapsed=time()-$startdate;
 925                 $resultstatus="Processing...";
 926                 $statuscolor="red";
 927             } else {
 928                 $elapsed=$realenddate-$startdate;
 929                 $resultstatus="Done.";
 930                 $statuscolor="black";
 931                 }
 932
 933                 if ($elapsed>60) {
 934                     $elapsedtime=sprintf "%d minutes",($elapsed/60);
 935                 } else {
 936                     $elapsedtime=sprintf "%d seconds",$elapsed;
 937                 }
 938                 if ($totalrecords) {
 939                     $totalrecords="$totalrecords found.";
 940                 } else {
 941                     $totalrecords='';
 942                 }
 943                 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>".
 944                 "$type=$term</a>" .
 945                 "<font size=-1 color=$statuscolor>$resultstatus $totalrecords " .
 946                 "($elapsedtime) $title </font><br>\n";
 947         } else {
 948             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>
 949                 $type=$term</a> <font size=-1>Pending</font><br>\n";
 950         } # if results done
 951     } # while queries
 952     print "</ul> </td>\n";
 953     # End of query listing
 954
 955     #------------------------------
 956     # Search input form
 957     print "<td valign=top width=30%>\n";
 958
 959     my $sth=$dbh->prepare("select id,name,checked
 960         from z3950servers
 961         order by rank");
 962     $sth->execute;
 963     my $serverlist='';
 964     while (my ($id, $name, $checked) = $sth->fetchrow) {
 965         ($checked) ? ($checked='checked') : ($checked='');
 966         $serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n";
 967     }
 968     $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n";
 969
 970     my $rand=rand(1000000000);
 971 print << "EOF";
 972     <form action=$ENV{'SCRIPT_NAME'} method=GET>
 973     <input type=hidden name=z3950queue value=1>
 974     <input type=hidden name=menu value=$menu>
 975     <p>
 976     <input type=hidden name=test value=testvalue>
 977     <input type=hidden name=rand value=$rand>
 978         <table border=1 bgcolor=#dddddd>
 979             <tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr>
 980     <tr><td>Query Term</td><td><input name=query></td></tr>
 981     <tr><td colspan=2 align=center>
 982                 <input type=radio name=type value=isbn checked>&nbsp;ISBN
 983                 <input type=radio name=type value=lccn        >&nbsp;LCCN<br>
 984                 <input type=radio name=type value=author      >&nbsp;Author
 985                 <input type=radio name=type value=title       >&nbsp;Title
 986                 <input type=radio name=type value=keyword     >&nbsp;Keyword</td></tr>
 987             <tr><td colspan=2> $serverlist </td></tr>
 988             <tr><td colspan=2 align=center> <input type=submit> </td></tr>
 989     </table>
 990
 991     </form>
 992 EOF
 993     print "</td></tr></table>\n";
 994 } # sub z3950menu
 995 #---------------------------------
 996
 997 sub uploadmarc {
 998     use strict;
 999     my ($dbh)=@_;
1000
1001     requireDBI($dbh,"uploadmarc");
1002
1003     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
1004     my $sth=$dbh->prepare("select id,name from uploadedmarc");
1005     $sth->execute;
1006     print "<h2>Select a set of MARC records</h2>\n<ul>";
1007     while (my ($id, $name) = $sth->fetchrow) {
1008         print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
1009     }
1010     print "</ul>\n";
1011     print "<p>\n";
1012     print "<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb
1013     colspan=2>Upload a set of MARC records</th></tr>\n";
1014     print "<tr><td>Upload a set of MARC records:</td><td>";
1015     print $input->start_multipart_form();
1016     print $input->filefield('uploadmarc');
1017     print << "EOF";
1018     </td></tr>
1019     <tr><td>
1020     <input type=hidden name=menu value=$menu>
1021     Name this set of MARC records:</td><td><input type=text
1022     name=name></td></tr>
1023     <tr><td colspan=2 align=center>
1024     <input type=submit>
1025     </td></tr>
1026     </table>
1027     </form>
1028 EOF
1029 }
1030
1031 sub manual {
1032 }
1033
1034
1035 sub mainmenu {
1036     print << "EOF";
1037 <h1>Main Menu</h1>
1038 <ul>
1039 <li><a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Z39.50 Search</a>
1040 <li><a href=$ENV{'SCRIPT_NAME'}?menu=uploadmarc>Upload MARC Records</a>
1041 </ul>
1042 EOF
1043 } # sub mainmenu
1044
1045
1046 #--------------------------
1047 # Parse MARC data in file format with control-character separators
1048 #   May be multiple records.
1049 sub parsemarcfileformat {
1050     use strict;
1051     # Input is one big text string
1052     my $data=shift;
1053     # Output is list of records.  Each record is list of field hashes
1054     my @records;
1055
1056     my $splitchar=chr(29);
1057     my $splitchar2=chr(30);
1058     my $splitchar3=chr(31);
1059     my $debug=0;
1060     my $record;
1061     foreach $record (split(/$splitchar/, $data)) {
1062         my @record;
1063         my $directory=0;
1064         my $tagcounter=0;
1065         my %tag;
1066         my $field;
1067
1068         my $leader=substr($record,0,24);
1069         print "<tr><td>Leader:</td><td>$leader</td></tr>\n" if $debug;
1070         push (@record, {
1071                 'tag' => 'Leader',
1072                 'indicator' => $leader ,
1073         } );
1074
1075         $record=substr($record,24);
1076         foreach $field (split(/$splitchar2/, $record)) {
1077             my %field;
1078             my $tag;
1079             my $indicator;
1080             unless ($directory) {
1081                 $directory=$field;
1082                 my $itemcounter=1;
1083                 my $counter2=0;
1084                 my $item;
1085                 my $length;
1086                 my $start;
1087                 while ($item=substr($directory,0,12)) {
1088                     $tag=substr($directory,0,3);
1089                     $length=substr($directory,3,4);
1090                     $start=substr($directory,7,6);
1091                     $directory=substr($directory,12);
1092                     $tag{$counter2}=$tag;
1093                     $counter2++;
1094                 }
1095                 $directory=1;
1096                 next;
1097             }
1098             $tag=$tag{$tagcounter};
1099             $tagcounter++;
1100             $field{'tag'}=$tag;
1101             my @subfields=split(/$splitchar3/, $field);
1102             $indicator=$subfields[0];
1103             $field{'indicator'}=$indicator;
1104             my $firstline=1;
1105             unless ($#subfields==0) {
1106                 my %subfields;
1107                 my @subfieldlist;
1108                 my $i;
1109                 for ($i=1; $i<=$#subfields; $i++) {
1110                     my $text=$subfields[$i];
1111                     my $subfieldcode=substr($text,0,1);
1112                     my $subfield=substr($text,1);
1113                     # if this subfield already exists, do array
1114                     if ($subfields{$subfieldcode}) {
1115                         my $subfieldlist=$subfields{$subfieldcode};
1116                         if ( ref($subfieldlist) eq 'ARRAY' ) {
1117                             # Already an array, add on to it
1118                             print "$tag Adding to array $subfieldcode -- $subfield<br>\n" if $debug;
1119                             @subfieldlist=@$subfieldlist;
1120                             push (@subfieldlist, $subfield);
1121                         } else {
1122                             # Change simple value to array
1123                             print "$tag Arraying $subfieldcode -- $subfield<br>\n" if $debug;
1124                             @subfieldlist=($subfields{$subfieldcode}, $subfield);
1125                         }
1126                         # keep new array
1127                         $subfields{$subfieldcode}=\@subfieldlist;
1128                     } else {
1129                         # subfield doesn't exist yet, keep simple value
1130                         $subfields{$subfieldcode}=$subfield;
1131                     }
1132                 }
1133                 $field{'subfields'}=\%subfields;
1134             }
1135             push (@record, \%field);
1136         } # foreach field in record
1137         push (@records, \@record);
1138         # $counter++;
1139     }
1140     print "</pre>" if $debug;
1141     return @records;
1142 } # sub parsemarcfileformat
1143
1144 #----------------------------
1145 # Accept form results to add query to z3950 queue
1146 sub AcceptZ3950Queue {
1147     use strict;
1148
1149     # input parameters
1150     my (
1151         $dbh,           # DBI handle
1152         $input,         # CGI parms
1153     )=@_;
1154
1155     my @serverlist;
1156
1157     requireDBI($dbh,"AcceptZ3950Queue");
1158
1159     my $query=$input->param('query');
1160
1161     my $isbngood=1;
1162     if ($input->param('type') eq 'isbn') {
1163         $isbngood=checkvalidisbn($query);
1164     }
1165     if ($isbngood) {
1166     foreach ($input->param) {
1167         if (/S-(.*)/) {
1168             my $server=$1;
1169             if ($server eq 'MAN') {
1170                 push @serverlist, "MAN/".$input->param('manualz3950server')."//"
1171 ;
1172             } else {
1173                 push @serverlist, $server;
1174             }
1175           }
1176         }
1177
1178         addz3950queue($dbh,$input->param('query'), $input->param('type'),
1179                 $input->param('rand'), @serverlist);
1180     } else {
1181         print "<font color=red size=+1>$query is not a valid ISBN
1182         Number</font><p>\n";
1183     }
1184 } # sub AcceptZ3950Queue
1185
1186 #---------------------------------------------
1187 sub AcceptMarcUpload {
1188     use strict;
1189     my (
1190         $dbh,           # DBI handle
1191         $input,         # CGI parms
1192     )=@_;
1193
1194     requireDBI($dbh,"AcceptMarcUpload");
1195
1196     my $name=$input->param('name');
1197     my $data=$input->param('uploadmarc');
1198     my $marcrecord='';
1199
1200     ($name) || ($name=$data);
1201     if (length($data)>0) {
1202         while (<$data>) {
1203             $marcrecord.=$_;
1204         }
1205     }
1206     my $q_marcrecord=$dbh->quote($marcrecord);
1207     my $q_name=$dbh->quote($name);
1208     my $sth=$dbh->prepare("insert into uploadedmarc
1209                 (marc,name)
1210         values ($q_marcrecord, $q_name)");
1211     $sth->execute;
1212 } # sub AcceptMarcUpload
1213
1214 #-------------------------------------------
1215 sub AcceptBiblioitem {
1216     use strict;
1217     my (
1218         $dbh,
1219         $input,
1220     )=@_;
1221
1222     my $biblionumber=0;
1223     my $biblioitemnumber=0;
1224     my $sth;
1225
1226     requireDBI($dbh,"AcceptBiblioitem");
1227
1228     my $isbn=$input->param('isbn');
1229     my $issn=$input->param('issn');
1230     my $lccn=$input->param('lccn');
1231     my $q_origisbn=$dbh->quote($input->param('origisbn'));
1232     my $q_origissn=$dbh->quote($input->param('origissn'));
1233     my $q_origlccn=$dbh->quote($input->param('origlccn'));
1234     my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
1235     my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
1236     my $q_issn=$dbh->quote((($issn) || ('NIL')));
1237     my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
1238     my $file=$input->param('file');
1239
1240     #my $sth=$dbh->prepare("insert into marcrecorddone values ($q_origisbn, $q_origissn, $q_origlccn, $q_origcontrolnumber)");
1241     #$sth->execute;
1242
1243     print "<center>\n";
1244     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n";
1245
1246     # See if it already exists
1247     my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
1248         from biblioitems
1249         where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
1250     $sth->execute;
1251     if ($sth->rows) {
1252         # Already exists
1253         ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
1254         my $title=$input->param('title');
1255         print << "EOF";
1256         <table border=0 width=50% cellpadding=10 cellspacing=0>
1257           <tr><th bgcolor=black><font color=white>Record already in database</font>
1258           </th></tr>
1259           <tr><td bgcolor=#dddddd>$title is already in the database with
1260                 biblionumber $biblionumber and biblioitemnumber $biblioitemnumber
1261           </td></tr>
1262         </table>
1263         <p>
1264 EOF
1265     } else {
1266
1267         # It doesn't exist; add it.
1268
1269         my $error;
1270         my %biblio;
1271         my %biblioitem;
1272
1273         # convert to upper case and split on lines
1274         my $subjectheadings=$input->param('subject');
1275         my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
1276
1277         my $additionalauthors=$input->param('additionalauthors');
1278         my @additionalauthors=split(/[\r\n]+/,uc($additionalauthors));
1279
1280         # Use individual assignments to hash buckets, in case
1281         #  any of the input parameters are empty or don't exist
1282         $biblio{title}          =$input->param('title');
1283         $biblio{author}         =$input->param('author');
1284         $biblio{copyright}      =$input->param('copyrightdate');
1285         $biblio{seriestitle}    =$input->param('seriestitle');
1286         $biblio{notes}          =$input->param('notes');
1287         $biblio{abstract}       =$input->param('abstract');
1288         $biblio{subtitle}       =$input->param('subtitle');
1289
1290         $biblioitem{volume}             =$input->param('volume');
1291         $biblioitem{number}             =$input->param('number');
1292         $biblioitem{itemtype}           =$input->param('itemtype');
1293         $biblioitem{isbn}               =$input->param('isbn');
1294         $biblioitem{issn}               =$input->param('issn');
1295         $biblioitem{dewey}              =$input->param('dewey');
1296         $biblioitem{subclass}           =$input->param('subclass');
1297         $biblioitem{publicationyear}    =$input->param('publicationyear');
1298         $biblioitem{publishercode}      =$input->param('publishercode');
1299         $biblioitem{volumedate}         =$input->param('volumedate');
1300         $biblioitem{volumeddesc}        =$input->param('volumeddesc');
1301         $biblioitem{illus}              =$input->param('illustrator');
1302         $biblioitem{pages}              =$input->param('pages');
1303         $biblioitem{notes}              =$input->param('notes');
1304         $biblioitem{size}               =$input->param('size');
1305         $biblioitem{place}              =$input->param('place');
1306         $biblioitem{lccn}               =$input->param('lccn');
1307         $biblioitem{marc}               =$input->param('marc');
1308
1309         #print "<PRE>subjects=@subjectheadings</PRE>\n";
1310         #print "<PRE>auth=@additionalauthors</PRE>\n";
1311
1312         ($biblionumber, $biblioitemnumber, $error)=
1313           newcompletebiblioitem($dbh,
1314                 \%biblio,
1315                 \%biblioitem,
1316                 \@subjectheadings,
1317                 \@additionalauthors
1318         );
1319
1320         if ( $error ) {
1321             print "<H2>Error adding biblio item</H2> $error\n";
1322         } else {
1323
1324           my $title=$input->param('title');
1325           print << "EOF";
1326             <table cellpadding=10 cellspacing=0 border=0 width=50%>
1327             <tr><th bgcolor=black><font color=white>Record entered into database</font></th></tr>
1328             <tr><td bgcolor=#dddddd>$title has been entered into the database with biblionumber
1329             $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
1330           </table>
1331 EOF
1332         } # if error
1333     } # if new record
1334
1335     return $biblionumber,$biblioitemnumber;
1336 } # sub AcceptBiblioitem
1337
1338 sub ItemCopyForm {
1339     use strict;
1340     my (
1341         $dbh,
1342         $input,         # CGI input object
1343         $biblionumber,
1344         $biblioitemnumber,
1345     )=@_;
1346
1347     my $sth;
1348     my $barcode;
1349     requireDBI($dbh,"ItemCopyForm");
1350
1351     my $title=$input->param('title');
1352     my $file=$input->param('file');
1353
1354     # Get next barcode, or pick random one if none exist yet
1355     $sth=$dbh->prepare("select max(barcode) from items");
1356     $sth->execute;
1357     ($barcode) = $sth->fetchrow;
1358     $barcode++;
1359     if ($barcode==1) {
1360         $barcode=int(rand()*1000000);
1361     }
1362
1363     my $branchselect=getkeytableselectoptions(
1364                 $dbh, 'branches', 'branchcode', 'branchname', 0);
1365
1366     print << "EOF";
1367     <table border=0 cellpadding=10 cellspacing=0>
1368       <tr><th bgcolor=black>
1369         <font color=white> Add a New Item for $title </font>
1370       </th></tr>
1371       <tr><td bgcolor=#dddddd>
1372       <form>
1373         <input type=hidden name=newitem value=1>
1374         <input type=hidden name=biblionumber value=$biblionumber>
1375         <input type=hidden name=biblioitemnumber value=$biblioitemnumber>
1376         <input type=hidden name=file value=$file>
1377         <table border=0>
1378           <tr><td>BARCODE</td><td><input name=barcode size=10 value=$barcode>
1379           Home Branch: <select name=homebranch> $branchselect </select>
1380           </td></tr>
1381           <tr><td>Replacement Price:</td>
1382           <td><input name=replacementprice size=10></td></tr>
1383           <tr><td>Notes</td>
1384           <td><textarea name=notes rows=4 cols=40 wrap=physical></textarea>
1385           </td></tr>
1386         </table>
1387         <p>
1388         <input type=submit value="Add Item">
1389       </form>
1390       </td></tr>
1391     </table>
1392 EOF
1393
1394 } # sub ItemCopyForm
1395
1396 #---------------------------------------
1397 # Accept form data to add an item copy
1398 sub AcceptItemCopy {
1399     use strict;
1400     my ( $dbh, $input )=@_;
1401
1402     my $error;
1403
1404     requireDBI($dbh,"AcceptItemCopy");
1405
1406     my $barcode=$input->param('barcode');
1407     my $replacementprice=($input->param('replacementprice') || 0);
1408
1409     my $sth=$dbh->prepare("select barcode
1410         from items
1411         where barcode=?");
1412     $sth->execute($barcode);
1413     if ($sth->rows) {
1414         print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n";
1415     } else {
1416            # Insert new item into database
1417            $error=&newitems(
1418                 { biblionumber=> $input->param('biblionumber'),
1419                   biblioitemnumber=> $input->param('biblioitemnumber'),
1420                   itemnotes=> $input->param('notes'),
1421                   homebranch=> $input->param('homebranch'),
1422                   replacementprice=> $replacementprice,
1423                 },
1424                 $barcode
1425             );
1426             if ( $error ) {
1427                 print "<font color=red>Error: $error </font><p>\n";
1428             } else {
1429
1430                 print "<table border=1 align=center cellpadding=10>
1431                         <tr><td bgcolor=yellow>
1432                         Item added with barcode $barcode
1433                         </td></tr></table>\n";
1434             } # if error
1435     } # if barcode exists
1436 } # sub AcceptItemCopy
1437
1438 #---------------
1439 # Create an HTML option list for a <SELECT> form tag by using
1440 #    values from a DB file
1441 sub getkeytableselectoptions {
1442         use strict;
1443         # inputs
1444         my (
1445                 $dbh,           # DBI handle
1446                 $tablename,     # name of table containing list of choices
1447                 $keyfieldname,  # column name of code to use in option list
1448                 $descfieldname, # column name of descriptive field
1449                 $showkey,       # flag to show key in description
1450         )=@_;
1451         my $selectclause;       # return value
1452
1453         my (
1454                 $sth, $query,
1455                 $key, $desc, $orderfieldname,
1456         );
1457         my $debug=0;
1458
1459         requireDBI($dbh,"getkeytableselectoptions");
1460
1461         if ( $showkey ) {
1462                 $orderfieldname=$keyfieldname;
1463         } else {
1464                 $orderfieldname=$descfieldname;
1465         }
1466         $query= "select $keyfieldname,$descfieldname
1467                 from $tablename
1468                 order by $orderfieldname ";
1469         print "<PRE>Query=$query </PRE>\n" if $debug;
1470         $sth=$dbh->prepare($query);
1471         $sth->execute;
1472         while ( ($key, $desc) = $sth->fetchrow) {
1473             if ($showkey) { $desc="$key - $desc"; }
1474             $selectclause.="<option value='$key'>$desc\n";
1475             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1476         }
1477         return $selectclause;
1478 } # sub getkeytableselectoptions
1479
1480 #---------------------------------
1481 # Add a biblioitem and related data
1482 sub newcompletebiblioitem {
1483         use strict;
1484
1485         my ( $dbh,              # DBI handle
1486           $biblio,              # hash ref to biblio record
1487           $biblioitem,          # hash ref to biblioitem record
1488           $subjects,            # list ref of subjects
1489           $addlauthors,         # list ref of additional authors
1490         )=@_ ;
1491
1492         my ( $biblionumber, $biblioitemnumber, $error);         # return values
1493
1494         my $debug=0;
1495         my $sth;
1496         my $subjectheading;
1497         my $additionalauthor;
1498
1499         #--------
1500         requireDBI($dbh,"newcompletebiblioitem");
1501
1502         print "<PRE>Trying to add biblio item Title=$biblio->{title} " .
1503                 "ISBN=$biblioitem->{isbn} </PRE>\n" if $debug;
1504
1505         # Make sure master biblio entry exists
1506         ($biblionumber,$error)=getoraddbiblio($dbh, $biblio);
1507
1508         if ( ! $error ) {
1509
1510           $biblioitem->{biblionumber}=$biblionumber;
1511           $biblioitemnumber=newbiblioitem($biblioitem);
1512
1513           $sth=$dbh->prepare("insert into bibliosubject
1514                 (biblionumber,subject)
1515                 values (?, ? )" );
1516           foreach $subjectheading (@{$subjects} ) {
1517               $sth->execute($biblionumber, $subjectheading)
1518                         or $error.=$sth->errstr ;
1519
1520           } # foreach subject
1521
1522           $sth=$dbh->prepare("insert into additionalauthors
1523                 (biblionumber,author)
1524                 values (?, ? )");
1525           foreach $additionalauthor (@{$addlauthors} ) {
1526             $sth->execute($biblionumber, $additionalauthor)
1527                         or $error.=$sth->errstr ;
1528           } # foreach author
1529
1530         } else {
1531           # couldn't get biblio
1532           $biblionumber='';
1533           $biblioitemnumber='';
1534
1535         } # if no biblio error
1536
1537         return ( $biblionumber, $biblioitemnumber, $error);
1538
1539 } # sub newcompletebiblioitem
1540 #---------------------------------------
1541 # Find a biblio entry, or create a new one if it doesn't exist.
1542 sub getoraddbiblio {
1543         use strict;             # in here until rest cleaned up
1544         # input params
1545         my (
1546           $dbh,         # db handle
1547           $biblio,      # hash ref to fields
1548         )=@_;
1549
1550         # return
1551         my $biblionumber;
1552
1553         my $debug=0;
1554         my $sth;
1555         my $error;
1556
1557         #-----
1558         requireDBI($dbh,"getoraddbiblio");
1559
1560         print "<PRE>Looking for biblio </PRE>\n" if $debug;
1561         $sth=$dbh->prepare("select biblionumber
1562                 from biblio
1563                 where title=? and author=?
1564                   and copyrightdate=? and seriestitle=?");
1565         $sth->execute(
1566                 $biblio->{title}, $biblio->{author},
1567                 $biblio->{copyright}, $biblio->{seriestitle} );
1568         if ($sth->rows) {
1569             ($biblionumber) = $sth->fetchrow;
1570             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
1571         } else {
1572             # Doesn't exist.  Add new one.
1573             print "<PRE>Adding biblio</PRE>\n" if $debug;
1574             ($biblionumber,$error)=&newbiblio($biblio);
1575             if ( $biblionumber ) {
1576               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
1577               if ( $biblio->{subtitle} ) {
1578                 &newsubtitle($biblionumber,$biblio->{subtitle} );
1579               } # if subtitle
1580             } else {
1581                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
1582             } # if added
1583         }
1584
1585         return $biblionumber,$error;
1586
1587 } # sub getoraddbiblio
1588 #---------------------------------------
1589 sub addz3950queue {
1590     use strict;
1591     # input
1592     my (
1593         $dbh,           # DBI handle
1594         $query,         # value to look up
1595         $type,          # type of value ("isbn", "lccn", etc).
1596         $requestid,
1597         @z3950list,     # list of z3950 servers to query
1598     )=@_;
1599
1600     my (
1601         @serverlist,
1602         $server,
1603         $failed,
1604     );
1605
1606     requireDBI($dbh,"addz3950queue");
1607
1608         # list of servers: entry can be a fully qualified URL-type entry
1609         #   or simply just a server ID number.
1610
1611         my $sth=$dbh->prepare("select host,port,db,userid,password
1612           from z3950servers
1613           where id=? ");
1614         foreach $server (@z3950list) {
1615             if ($server =~ /:/ ) {
1616                 push @serverlist, $server;
1617             } else {
1618                 $sth->execute($server);
1619                 my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
1620                 push @serverlist, "$server/$host\:$port/$db/$userid/$password";
1621             }
1622         }
1623
1624         my $serverlist='';
1625         foreach (@serverlist) {
1626             $serverlist.="$_ ";
1627         } # foreach
1628         chop $serverlist;
1629
1630         # Don't allow reinsertion of the same request number.
1631         my $sth=$dbh->prepare("select identifier from z3950queue
1632                 where identifier=?");
1633         $sth->execute($requestid);
1634         unless ($sth->rows) {
1635             $sth=$dbh->prepare("insert into z3950queue
1636                 (term,type,servers, identifier)
1637                 values (?, ?, ?, ?)");
1638             $sth->execute($query, $type, $serverlist, $requestid);
1639         }
1640 } # sub addz3950queue
1641
1642 #--------------------------------------
1643 sub FormatMarcText {
1644     use strict;
1645
1646     # Input
1647     my (
1648         $fields,        # list ref to MARC fields
1649     )=@_;
1650     # Return
1651
1652     my (
1653         $marctext,
1654         $color,
1655         $field,
1656         $tag,
1657         $label,
1658         $subfieldcode,$subfieldvalue,
1659         @values, $value
1660     );
1661
1662         #return "MARC text here";
1663
1664     $marctext="<table border=0 cellspacing=0>
1665         <tr><th colspan=3 bgcolor=black>
1666                 <font color=white>MARC RECORD</font>
1667         </th></tr>\n";
1668
1669     foreach $field ( @$fields ) {
1670         ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
1671         $tag=$field->{'tag'};
1672         $label=$tagtext{$tag};
1673         if ( $tag eq 'Leader' ) {
1674                 $tag='';
1675                 $label="Leader:";
1676         }
1677         $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
1678                 "<td bgcolor=$color valign=top>$tag</td> \n";
1679         if ( ! $field->{'subfields'} )  {
1680             $marctext.="<td bgcolor=$color valign=top>$field->{'indicator'}</td>";
1681         } else {
1682             # start another table for subfields
1683             $marctext.="<td bgcolor=$color valign=top>\n " .
1684                 "  <table border=0 cellspacing=0>\n";
1685             foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} }   )) {
1686                 $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
1687                 if (ref($subfieldvalue) eq 'ARRAY' ) {
1688                     # if it's a pointer to array, get the values
1689                     @values=@{$subfieldvalue};
1690                 } else {
1691                     @values=( $subfieldvalue );
1692                 } # if subfield array
1693                 foreach $value ( @values ) {
1694                   $marctext.="<tr><td>$subfieldcode </td>" .
1695                     "<td>$value</td></tr>\n";
1696                 } # foreach value
1697             } # foreach subfield
1698             $marctext.="</table></td>\n";
1699         } # if subfields
1700         $marctext.="</tr>\n";
1701
1702     } # foreach field
1703
1704     $marctext.="</table>\n";
1705
1706     return $marctext;
1707
1708 } # sub FormatMarcText