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
  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 #------------------
  22 # Constants
  23
  24 # HTML colors for alternating lines
  25 my $lc1='#dddddd';
  26 my $lc2='#ddaaaa';
  27
  28 my %tagtext = (
  29     '001' => 'Control number',
  30     '003' => 'Control number identifier',
  31     '005' => 'Date and time of latest transaction',
  32     '006' => 'Fixed-length data elements -- additional material characteristics',
  33     '007' => 'Physical description fixed field',
  34     '008' => 'Fixed length data elements',
  35     '010' => 'LCCN',
  36     '015' => 'LCCN Cdn',
  37     '020' => 'ISBN',
  38     '022' => 'ISSN',
  39     '037' => 'Source of acquisition',
  40     '040' => 'Cataloging source',
  41     '041' => 'Language code',
  42     '043' => 'Geographic area code',
  43     '050' => 'Library of Congress call number',
  44     '060' => 'National Library of Medicine call number',
  45     '082' => 'Dewey decimal call number',
  46     '100' => 'Main entry -- Personal name',
  47     '110' => 'Main entry -- Corporate name',
  48     '130' => 'Main entry -- Uniform title',
  49     '240' => 'Uniform title',
  50     '245' => 'Title statement',
  51     '246' => 'Varying form of title',
  52     '250' => 'Edition statement',
  53     '256' => 'Computer file characteristics',
  54     '260' => 'Publication, distribution, etc.',
  55     '263' => 'Projected publication date',
  56     '300' => 'Physical description',
  57     '306' => 'Playing time',
  58     '440' => 'Series statement / Added entry -- Title',
  59     '490' => 'Series statement',
  60     '500' => 'General note',
  61     '504' => 'Bibliography, etc. note',
  62     '505' => 'Formatted contents note',
  63     '508' => 'Creation/production credits note',
  64     '510' => 'Citation/references note',
  65     '511' => 'Participant or performer note',
  66     '520' => 'Summary, etc. note',
  67     '521' => 'Target audience note (ie age)',
  68     '530' => 'Additional physical form available note',
  69     '538' => 'System details note',
  70     '586' => 'Awards note',
  71     '600' => 'Subject added entry -- Personal name',
  72     '610' => 'Subject added entry -- Corporate name',
  73     '650' => 'Subject added entry -- Topical term',
  74     '651' => 'Subject added entry -- Geographic name',
  75     '656' => 'Index term -- Occupation',
  76     '700' => 'Added entry -- Personal name',
  77     '710' => 'Added entry -- Corporate name',
  78     '730' => 'Added entry -- Uniform title',
  79     '740' => 'Added entry -- Uncontrolled related/analytical title',
  80     '800' => 'Series added entry -- Personal name',
  81     '830' => 'Series added entry -- Uniform title',
  82     '852' => 'Location',
  83     '856' => 'Electronic location and access',
  84 );
  85
  86 #-------------
  87 # Initialize
  88
  89 my $userid=$ENV{'REMOTE_USER'};
  90
  91 my $input = new CGI;
  92 my $dbh=C4Connect;
  93
  94 #-------------
  95 # Display output
  96 print $input->header;
  97 print startpage();
  98 print startmenu('acquisitions');
  99
 100 #-------------
 101 # Process input parameters
 102 my $file=$input->param('file');
 103
 104 if ($input->param('z3950queue')) {
 105     my $query=$input->param('query');
 106
 107     my @serverlist;
 108
 109     my $isbngood=1;
 110     if ($input->param('type') eq 'isbn') {
 111         $isbngood=CheckIsbn($query);
 112     }
 113     if ($isbngood) {
 114         foreach ($input->param) {
 115           if (/S-(.*)/) {
 116             my $server=$1;
 117             if ($server eq 'MAN') {
 118                 push @serverlist, "MAN/".$input->param('manualz3950server')."//"
 119 ;
 120             } else {
 121                 push @serverlist, $server;
 122             }
 123           }
 124         }
 125
 126         Addz3950queue($input->param('query'), $input->param('type'),
 127                 $input->param('rand'), @serverlist);
 128     } else {
 129         print "<font color=red size=+1>$query is not a valid ISBN
 130         Number</font><p>\n";
 131     }
 132 }
 133
 134 sub Addz3950queue {
 135     use strict;
 136     my (
 137         $query,         # value to look up
 138         $type,          # type of value ("isbn", "lccn", etc).
 139         $requestid,
 140         @z3950list,     # list of z3950 servers to query
 141     )=@_;
 142
 143     my (
 144         @serverlist,
 145         $server,
 146         $failed,
 147     );
 148
 149         # list of servers: entry can be a fully qualified URL-type entry
 150         #   or simply just a server ID number.
 151
 152         my $sth=$dbh->prepare("select host,port,db,userid,password
 153           from z3950servers
 154           where id=? ");
 155         foreach $server (@z3950list) {
 156             if ($server =~ /:/ ) {
 157                 push @serverlist, $server;
 158             } else {
 159                 $sth->execute($server);
 160                 my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
 161                 push @serverlist, "$server/$host\:$port/$db/$userid/$password";
 162             }
 163         }
 164
 165         my $serverlist='';
 166         foreach (@serverlist) {
 167             $serverlist.="$_ ";
 168         }
 169         chop $serverlist;
 170
 171         # Don't allow reinsertion of the same request number.
 172         my $sth=$dbh->prepare("select identifier from z3950queue
 173                 where identifier=?");
 174         $sth->execute($requestid);
 175         unless ($sth->rows) {
 176             $sth=$dbh->prepare("insert into z3950queue
 177                 (term,type,servers, identifier)
 178                 values (?, ?, ?, ?)");
 179             $sth->execute($query, $type, $serverlist, $requestid);
 180         }
 181 } # sub
 182
 183 #--------------------------------------
 184 sub CheckIsbn {
 185         my ($q)=@_ ;
 186
 187         my $isbngood = 0;
 188
 189         $q=~s/[^X\d]//g;
 190         $q=~s/X.//g;
 191         if (length($q)==10) {
 192             my $checksum=substr($q,9,1);
 193             my $isbn=substr($q,0,9);
 194             my $i;
 195             my $c=0;
 196             for ($i=0; $i<9; $i++) {
 197                 my $digit=substr($q,$i,1);
 198                 $c+=$digit*(10-$i);
 199             }
 200             $c=int(11-($c/11-int($c/11))*11+.1);
 201             ($c==10) && ($c='X');
 202             if ($c eq $checksum) {
 203                 $isbngood=1;
 204             } else {
 205                 $isbngood=0;
 206             }
 207         } else {
 208             $isbngood=0;
 209         }
 210
 211         return $isbngood;
 212
 213 } # sub CheckIsbn
 214
 215
 216
 217 if (my $data=$input->param('uploadmarc')) {
 218     my $name=$input->param('name');
 219     ($name) || ($name=$data);
 220     my $marcrecord='';
 221     if (length($data)>0) {
 222         while (<$data>) {
 223             $marcrecord.=$_;
 224         }
 225     }
 226     my $q_marcrecord=$dbh->quote($marcrecord);
 227     my $q_name=$dbh->quote($name);
 228     my $sth=$dbh->prepare("insert into uploadedmarc (marc,name) values ($q_marcrecord, $q_name)");
 229     $sth->execute;
 230 }
 231
 232
 233 if ($input->param('insertnewrecord')) {
 234     my $isbn=$input->param('isbn');
 235     my $issn=$input->param('issn');
 236     my $lccn=$input->param('lccn');
 237     my $q_origisbn=$dbh->quote($input->param('origisbn'));
 238     my $q_origissn=$dbh->quote($input->param('origissn'));
 239     my $q_origlccn=$dbh->quote($input->param('origlccn'));
 240     my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
 241     my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
 242     my $q_issn=$dbh->quote((($issn) || ('NIL')));
 243     my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
 244     my $sth=$dbh->prepare("insert into marcrecorddone values ($q_origisbn, $q_origissn, $q_origlccn, $q_origcontrolnumber)");
 245     $sth->execute;
 246     my $sth=$dbh->prepare("select biblionumber,biblioitemnumber from biblioitems where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
 247     $sth->execute;
 248     my $biblionumber=0;
 249     my $biblioitemnumber=0;
 250     print "<center>\n";
 251     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n";
 252     if ($sth->rows) {
 253         ($biblionumber, $biblioitemnumber) = $sth->fetchrow;
 254         my $title=$input->param('title');
 255         print << "EOF";
 256         <table border=0 width=50% cellpadding=10 cellspacing=0>
 257         <tr><th bgcolor=black><font color=white>Record already in database</font></th></tr>
 258         <tr><td bgcolor=#dddddd>$title is already in the database with biblionumber $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
 259         </table>
 260         <p>
 261 EOF
 262     } else {
 263         use strict;
 264
 265         # It doesn't exist; add it.
 266
 267         $biblionumber=GetOrAddBiblio($dbh,
 268                 { title         =>$input->param('title'),
 269                  author         =>$input->param('author'),
 270                  copyright      =>$input->param('copyrightdate'),
 271                  seriestitle    =>$input->param('seriestitle'),
 272                  notes          =>$input->param('notes'),
 273                  abstract       =>$input->param('abstract'),
 274                  subtitle       =>$input->param('subtitle'),
 275                 }
 276         );
 277
 278         $sth=$dbh->prepare("select max(biblioitemnumber) from biblioitems");
 279         $sth->execute;
 280         ($biblioitemnumber) = $sth->fetchrow;
 281         $biblioitemnumber++;
 282         my $q_isbn=$dbh->quote($isbn);
 283         my $q_issn=$dbh->quote($issn);
 284         my $q_lccn=$dbh->quote($lccn);
 285         my $q_volume=$dbh->quote($input->param('volume'));
 286         my $q_number=$dbh->quote($input->param('number'));
 287         my $q_itemtype=$dbh->quote($input->param('itemtype'));
 288         my $q_dewey=$dbh->quote($input->param('dewey'));
 289         my $q_subclass=$dbh->quote($input->param('subclass'));
 290         my $q_publicationyear=$dbh->quote($input->param('publicationyear'));
 291         my $q_publishercode=$dbh->quote($input->param('publishercode'));
 292         my $q_volumedate=$dbh->quote($input->param('volumedate'));
 293         my $q_volumeddesc=$dbh->quote($input->param('volumeddesc'));
 294         my $q_illus=$dbh->quote($input->param('illustrator'));
 295         my $q_pages=$dbh->quote($input->param('pages'));
 296         my $q_notes=$dbh->quote($input->param('note'));
 297         my $q_size=$dbh->quote($input->param('size'));
 298         my $q_place=$dbh->quote($input->param('place'));
 299         my $q_marc=$dbh->quote($input->param('marc'));
 300
 301         $sth=$dbh->prepare("insert into biblioitems (biblioitemnumber, biblionumber, volume, number, itemtype, isbn, issn, dewey, subclass, publicationyear, publishercode, volumedate, volumeddesc, illus, pages, notes, size, place, lccn, marc) values ($biblioitemnumber, $biblionumber, $q_volume, $q_number, $q_itemtype, $q_isbn, $q_issn, $q_dewey, $q_subclass, $q_publicationyear, $q_publishercode, $q_volumedate, $q_volumeddesc, $q_illus, $q_pages, $q_notes, $q_size, $q_place, $q_lccn, $q_marc)");
 302         $sth->execute;
 303         my $subjectheadings=$input->param('subject');
 304         my $additionalauthors=$input->param('additionalauthors');
 305         my @subjectheadings=split(/\n/,$subjectheadings);
 306         my $subjectheading;
 307         foreach $subjectheading (@subjectheadings) {
 308             # remove any line ending characters (Ctrl-J or M)
 309             $subjectheading=~s/\013//g;
 310             $subjectheading=~s/\010//g;
 311             # convert to upper case
 312             $subjectheading=uc($subjectheading);
 313             chomp ($subjectheading);
 314             while (ord(substr($subjectheading, length($subjectheading)-1, 1))<14) {
 315                 chop $subjectheading;
 316             }
 317             # quote value
 318             my $q_subjectheading=$dbh->quote($subjectheading);
 319             $sth=$dbh->prepare("insert into bibliosubject (biblionumber,subject)
 320                 values ($biblionumber, $q_subjectheading)");
 321             $sth->execute;
 322         }
 323         my @additionalauthors=split(/\n/,$additionalauthors);
 324         my $additionalauthor;
 325         foreach $additionalauthor (@additionalauthors) {
 326             # remove any line ending characters (Ctrl-L or Ctrl-M)
 327             $additionalauthor=~s/\013//g;
 328             $additionalauthor=~s/\010//g;
 329             # convert to upper case
 330             $additionalauthor=uc($additionalauthor);
 331             # quote value
 332             my $q_additionalauthor=$dbh->quote($additionalauthor);
 333             $sth=$dbh->prepare("insert into additionalauthors (biblionumber,author) values ($biblionumber, $q_additionalauthor)");
 334             $sth->execute;
 335         }
 336
 337         my $title=$input->param('title');
 338         print << "EOF";
 339         <table cellpadding=10 cellspacing=0 border=0 width=50%>
 340         <tr><th bgcolor=black><font color=white>Record entered into database</font></th></tr>
 341         <tr><td bgcolor=#dddddd>$title has been entered into the database with biblionumber
 342         $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
 343         </table>
 344 EOF
 345     }
 346     my $title=$input->param('title');
 347
 348     # Get next barcode, or pick random one if none exist yet
 349     $sth=$dbh->prepare("select max(barcode) from items");
 350     $sth->execute;
 351     my ($barcode) = $sth->fetchrow;
 352     $barcode++;
 353     if ($barcode==1) {
 354         $barcode=int(rand()*1000000);
 355     }
 356
 357     my $branchselect=GetKeyTableSelectOptions(
 358                 $dbh, 'branches', 'branchcode', 'branchname', 0);
 359
 360     print << "EOF";
 361     <table border=0 cellpadding=10 cellspacing=0>
 362     <tr><th bgcolor=black><font color=white>
 363 Add a New Item for $title
 364 </font>
 365 </th></tr>
 366 <tr><td bgcolor=#dddddd>
 367 <form>
 368 <input type=hidden name=newitem value=1>
 369 <input type=hidden name=biblionumber value=$biblionumber>
 370 <input type=hidden name=biblioitemnumber value=$biblioitemnumber>
 371 <input type=hidden name=file value=$file>
 372 <table border=0>
 373 <tr><td>BARCODE</td><td><input name=barcode size=10 value=$barcode>
 374
 375 Home Branch: <select name=homebranch> $branchselect </select></td></tr>
 376
 377 </tr><td>Replacement Price:</td><td><input name=replacementprice size=10></td></tr>
 378 <tr><td>Notes</td><td><textarea name=notes rows=4 cols=40
 379 wrap=physical></textarea></td></tr>
 380 </table>
 381 </td></tr>
 382 </table>
 383 <p>
 384 <input type=submit value="Add Item">
 385 </form>
 386 EOF
 387 print endmenu();
 388 print endpage();
 389
 390 exit;
 391 }
 392
 393 #---------------------------------------
 394 # Find a biblio entry, or create a new one if it doesn't exist.
 395 sub GetOrAddBiblio {
 396         use strict;             # in here until rest cleaned up
 397         # input params
 398         my (
 399           $dbh,         # db handle
 400           $biblio,      # hash ref to fields
 401         )=@_;
 402
 403         # return
 404         my $biblionumber;
 405
 406         my $sth;
 407
 408         #-----
 409         $sth=$dbh->prepare("select biblionumber
 410                 from biblio
 411                 where title=? and author=?
 412                   and copyrightdate=? and seriestitle=?");
 413         $sth->execute(
 414                 $biblio->{title}, $biblio->{author},
 415                 $biblio->{copyright}, $biblio->{seriestitle} );
 416         if ($sth->rows) {
 417             ($biblionumber) = $sth->fetchrow;
 418         } else {
 419             # Doesn't exist.  Add new one.
 420             $biblionumber=&newbiblio($biblio);
 421             &newsubtitle($biblionumber,$biblio->{subtitle} );
 422         }
 423
 424         return $biblionumber;
 425
 426 } # sub GetOrAddBiblio
 427 #---------------------------------------
 428
 429 if ($input->param('newitem')) {
 430     use strict;
 431     my $error;
 432     my $barcode=$input->param('barcode');
 433     my $replacementprice=($input->param('replacementprice') || 0);
 434
 435     my $sth=$dbh->prepare("select barcode
 436         from items
 437         where barcode=?");
 438     $sth->execute($barcode);
 439     if ($sth->rows) {
 440         print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n";
 441     } else {
 442            # Insert new item into database
 443            $error=&newitems(
 444                 { biblionumber=> $input->param('biblionumber'),
 445                   biblioitemnumber=> $input->param('biblioitemnumber'),
 446                   itemnotes=> $input->param('notes'),
 447                   homebranch=> $input->param('homebranch'),
 448                   replacementprice=> $replacementprice,
 449                 },
 450                 $barcode
 451             );
 452             if ( $error ) {
 453                 print "<font color=red>Error: $error </font><p>\n";
 454             } else {
 455
 456                 print "<font color=green>Item added with barcode $barcode
 457                         </font><P>\n";
 458             } # if error
 459     } # if barcode exists
 460 }
 461
 462
 463 my $menu = $input->param('menu');
 464 if ($file) {
 465     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 466     my $qisbn=$input->param('isbn');
 467     my $qissn=$input->param('issn');
 468     my $qlccn=$input->param('lccn');
 469     my $qcontrolnumber=$input->param('controlnumber');
 470     if ($qisbn || $qissn || $qlccn || $qcontrolnumber) {
 471         print "<a href=$ENV{'SCRIPT_NAME'}>New File</a><hr>\n";
 472         #open (F, "$file");
 473         #my $data=<F>;
 474         my $data;
 475         if ($file=~/Z-(\d+)/) {
 476             my $id=$1;
 477             my $resultsid=$input->param('resultsid');
 478             my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
 479             $sth->execute;
 480             ($data) = $sth->fetchrow;
 481         } else {
 482             my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
 483             $sth->execute;
 484             ($data) = $sth->fetchrow;
 485         }
 486
 487         $splitchar=chr(29);
 488         my @records;
 489         foreach $record (split(/$splitchar/, $data)) {
 490             my $marctext="<table border=0 cellspacing=0>\n";
 491             $marctext.="<tr><th colspan=3 bgcolor=black><font color=white>MARC RECORD</font></th></tr>\n";
 492             $leader=substr($record,0,24);
 493             $marctext.="<tr><td>Leader:</td><td colspan=2>$leader</td></tr>\n";
 494             $record=substr($record,24);
 495             $splitchar2=chr(30);
 496             my $directory=0;
 497             my $tagcounter=0;
 498             my %tag;
 499             my @record;
 500             foreach $field (split(/$splitchar2/, $record)) {
 501                 my %field;
 502                 ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
 503                 unless ($directory) {
 504                     $directory=$field;
 505                     my $itemcounter=1;
 506                     $counter=0;
 507                     while ($item=substr($directory,0,12)) {
 508                         $tag=substr($directory,0,3);
 509                         $length=substr($directory,3,4);
 510                         $start=substr($directory,7,6);
 511                         $directory=substr($directory,12);
 512                         $tag{$counter}=$tag;
 513                         $counter++;
 514                     }
 515                     $directory=1;
 516                     next;
 517                 }
 518                 $tag=$tag{$tagcounter};
 519                 $tagcounter++;
 520                 $field{'tag'}=$tag;
 521                 $marctext.="<tr><td bgcolor=$color valign=top>$tagtext{$tag}</td><td bgcolor=$color valign=top>$tag</td>";
 522                 $splitchar3=chr(31);
 523                 my @subfields=split(/$splitchar3/, $field);
 524                 $indicator=$subfields[0];
 525                 $field{'indicator'}=$indicator;
 526                 my $firstline=1;
 527                 if ($#subfields==0) {
 528                     $marctext.="<td bgcolor=$color valign=top>$indicator</td></tr>";
 529                 } else {
 530                     my %subfields;
 531                     $marctext.="<td bgcolor=$color valign=top><table border=0 cellspacing=0>\n";
 532                     my $color2=$color;
 533                     for ($i=1; $i<=$#subfields; $i++) {
 534                         ($color2 eq $lc1) ? ($color2=$lc2) : ($color2=$lc1);
 535                         my $text=$subfields[$i];
 536                         my $subfieldcode=substr($text,0,1);
 537                         my $subfield=substr($text,1);
 538                         $marctext.="<tr><td colour=$color2><table border=0 cellpadding=0 cellspacing=0><tr><td>$subfieldcode </td></tr></table></td><td colour=$color2>$subfield</td></tr>\n";
 539                         if ($subfields{$subfieldcode}) {
 540                             my $subfieldlist=$subfields{$subfieldcode};
 541                             my @subfieldlist=@$subfieldlist;
 542                             if ($#subfieldlist>=0) {
 543                                 push (@subfieldlist, $subfield);
 544                             } else {
 545                                 @subfieldlist=($subfields{$subfieldcode}, $subfield);
 546                             }
 547                             $subfields{$subfieldcode}=\@subfieldlist;
 548                         } else {
 549                             $subfields{$subfieldcode}=$subfield;
 550                         }
 551                     }
 552                     $marctext.="</table></td></tr>\n";
 553                     $field{'subfields'}=\%subfields;
 554                 }
 555                 push (@record, \%field);
 556             }
 557             $marctext.="</table>\n";
 558             $marctext{\@record}=$marctext;
 559             $marc{\@record}=$record;
 560             push (@records, \@record);
 561             $counter++;
 562         }
 563 RECORD:
 564         foreach $record (@records) {
 565             my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $additionalauthors, $illustrator, $copyrightdate, $seriestitle);
 566             my $marctext=$marctext{$record};
 567             my $marc=$marc{$record};
 568             foreach $field (@$record) {
 569                 if ($field->{'tag'} eq '001') {
 570                     $controlnumber=$field->{'indicator'};
 571                 }
 572                 if ($field->{'tag'} eq '010') {
 573                     $lccn=$field->{'subfields'}->{'a'};
 574                     $lccn=~s/^\s*//;
 575                     ($lccn) = (split(/\s+/, $lccn))[0];
 576                 }
 577                 if ($field->{'tag'} eq '015') {
 578                     $lccn=$field->{'subfields'}->{'a'};
 579                     $lccn=~s/^\s*//;
 580                     $lccn=~s/^C//;
 581                     ($lccn) = (split(/\s+/, $lccn))[0];
 582                 }
 583                 if ($field->{'tag'} eq '020') {
 584                     $isbn=$field->{'subfields'}->{'a'};
 585                     ($isbn=~/^ARRAY/) && ($isbn=$$isbn[0]);
 586                     $isbn=~s/[^\d]*//g;
 587                 }
 588                 if ($field->{'tag'} eq '022') {
 589                     $issn=$field->{'subfields'}->{'a'};
 590                     $issn=~s/^\s*//;
 591                     ($issn) = (split(/\s+/, $issn))[0];
 592                 }
 593                 if ($field->{'tag'} eq '082') {
 594                     $dewey=$field->{'subfields'}->{'a'};
 595                     $dewey=~s/\///g;
 596                     if (@$dewey) {
 597                         $dewey=$$dewey[0];
 598                     }
 599                     #$dewey=~s/\///g;
 600                 }
 601                 if ($field->{'tag'} eq '100') {
 602                     $author=$field->{'subfields'}->{'a'};
 603                 }
 604                 if ($field->{'tag'} eq '245') {
 605                     $title=$field->{'subfields'}->{'a'};
 606                     $title=~s/ \/$//;
 607                     $subtitle=$field->{'subfields'}->{'b'};
 608                     $subtitle=~s/ \/$//;
 609                 }
 610                 if ($field->{'tag'} eq '260') {
 611                     $place=$field->{'subfields'}->{'a'};
 612                     if (@$place) {
 613                         $place=$$place[0];
 614                     }
 615                     $place=~s/\s*:$//g;
 616                     $publisher=$field->{'subfields'}->{'b'};
 617                     if (@$publisher) {
 618                         $publisher=$$publisher[0];
 619                     }
 620                     $publisher=~s/\s*:$//g;
 621                     $publicationyear=$field->{'subfields'}->{'c'};
 622                     if ($publicationyear=~/c(\d\d\d\d)/) {
 623                         $copyrightdate=$1;
 624                     }
 625                     if ($publicationyear=~/[^c](\d\d\d\d)/) {
 626                         $publicationyear=$1;
 627                     } elsif ($copyrightdate) {
 628                         $publicationyear=$copyrightdate;
 629                     } else {
 630                         $publicationyear=~/(\d\d\d\d)/;
 631                         $publicationyear=$1;
 632                     }
 633                 }
 634                 if ($field->{'tag'} eq '300') {
 635                     $pages=$field->{'subfields'}->{'a'};
 636                     $pages=~s/ \;$//;
 637                     $size=$field->{'subfields'}->{'c'};
 638                     $pages=~s/\s*:$//g;
 639                     $size=~s/\s*:$//g;
 640                 }
 641                 if ($field->{'tag'} eq '362') {
 642                     if ($field->{'subfields'}->{'a'}=~/(\d+).*(\d+)/) {
 643                         $volume=$1;
 644                         $number=$2;
 645                     }
 646                 }
 647                 if ($field->{'tag'} eq '440') {
 648                     $seriestitle=$field->{'subfields'}->{'a'};
 649                     if ($field->{'subfields'}->{'v'}=~/(\d+).*(\d+)/) {
 650                         $volume=$1;
 651                         $number=$2;
 652                     }
 653                 }
 654                 if ($field->{'tag'} eq '700') {
 655                     my $name=$field->{'subfields'}->{'a'};
 656                     if ($field->{'subfields'}->{'c'}=~/ill/) {
 657                         $additionalauthors.="$name\n";
 658                     } else {
 659                         $illustrator=$name;
 660                     }
 661                 }
 662                 if ($field->{'tag'} =~/^5/) {
 663                     $note.="$field->{'subfields'}->{'a'}\n";
 664                 }
 665                 if ($field->{'tag'} =~/65\d/) {
 666                     my $subject=$field->{'subfields'}->{'a'};
 667                     $subject=~s/\.$//;
 668                     if ($gensubdivision=$field->{'subfields'}->{'x'}) {
 669                         my @sub=@$gensubdivision;
 670                         if ($#sub>=0) {
 671                             foreach $s (@sub) {
 672                                 $s=~s/\.$//;
 673                                 $subject.=" -- $s";
 674                             }
 675                         } else {
 676                             $gensubdivision=~s/\.$//;
 677                             $subject.=" -- $gensubdivision";
 678                         }
 679                     }
 680                     if ($chronsubdivision=$field->{'subfields'}->{'y'}) {
 681                         my @sub=@$chronsubdivision;
 682                         if ($#sub>=0) {
 683                             foreach $s (@sub) {
 684                                 $s=~s/\.$//;
 685                                 $subject.=" -- $s";
 686                             }
 687                         } else {
 688                             $chronsubdivision=~s/\.$//;
 689                             $subject.=" -- $chronsubdivision";
 690                         }
 691                     }
 692                     if ($geosubdivision=$field->{'subfields'}->{'z'}) {
 693                         my @sub=@$geosubdivision;
 694                         if ($#sub>=0) {
 695                             foreach $s (@sub) {
 696                                 $s=~s/\.$//;
 697                                 $subject.=" -- $s";
 698                             }
 699                         } else {
 700                             $geosubdivision=~s/\.$//;
 701                             $subject.=" -- $geosubdivision";
 702                         }
 703                     }
 704                     push @subjects, $subject;
 705                 }
 706             }
 707             $titleinput=$input->textfield(-name=>'title', -default=>$title, -size=>40);
 708             $marcinput=$input->hidden(-name=>'marc', -default=>$marc);
 709             $subtitleinput=$input->textfield(-name=>'subtitle', -default=>$subtitle, -size=>40);
 710             $authorinput=$input->textfield(-name=>'author', -default=>$author);
 711             $illustratorinput=$input->textfield(-name=>'illustrator', -default=>$illustrator);
 712             $additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
 713             my $subject='';
 714             foreach (@subjects) {
 715                 $subject.="$_\n";
 716             }
 717             $subjectinput=$input->textarea(-name=>'subject', -default=>$subject, -rows=>4, -cols=>40);
 718             $noteinput=$input->textarea(-name=>'note', -default=>$note, -rows=>4, -cols=>40, -wrap=>'physical');
 719             $copyrightinput=$input->textfield(-name=>'copyrightdate', -default=>$copyrightdate);
 720             $seriestitleinput=$input->textfield(-name=>'seriestitle', -default=>$seriestitle);
 721             $volumeinput=$input->textfield(-name=>'volume', -default=>$volume);
 722             $volumedateinput=$input->textfield(-name=>'volumedate', -default=>$volumedate);
 723             $volumeddescinput=$input->textfield(-name=>'volumeddesc', -default=>$volumeddesc);
 724             $numberinput=$input->textfield(-name=>'number', -default=>$number);
 725             $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
 726             $issninput=$input->textfield(-name=>'issn', -default=>$issn);
 727             $lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
 728             $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
 729             $deweyinput=$input->textfield(-name=>'dewey', -default=>$dewey);
 730             $cleanauthor=$author;
 731             $cleanauthor=~s/[^A-Za-z]//g;
 732             $subclassinput=$input->textfield(-name=>'subclass', -default=>uc(substr($cleanauthor,0,3)));
 733             $publisherinput=$input->textfield(-name=>'publishercode', -default=>$publisher);
 734             $pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
 735             $placeinput=$input->textfield(-name=>'place', -default=>$place);
 736             $pagesinput=$input->textfield(-name=>'pages', -default=>$pages);
 737             $sizeinput=$input->textfield(-name=>'size', -default=>$size);
 738             $fileinput=$input->hidden(-name=>'file', -default=>$file);
 739             $origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
 740             $origissn=$input->hidden(-name=>'origissn', -default=>$issn);
 741             $origlccn=$input->hidden(-name=>'origlccn', -default=>$lccn);
 742             $origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
 743
 744             #print "<PRE>getting itemtypeselect</PRE>\n";
 745             $itemtypeselect=&GetKeyTableSelectOptions(
 746                 $dbh, 'itemtypes', 'itemtype', 'description', 1);
 747             #print "<PRE>it=$itemtypeselect</PRE>\n";
 748
 749             ($qissn) || ($qissn='NIL');
 750             ($qlccn) || ($qlccn='NIL');
 751             ($qisbn) || ($qisbn='NIL');
 752             ($qcontrolnumber) || ($qcontrolnumber='NIL');
 753             $controlnumber=~s/\s+//g;
 754
 755             unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) {
 756                 #print "<PRE>Skip record $isbn $issn $lccn </PRE>\n";
 757                 next RECORD;
 758             }
 759
 760             print << "EOF";
 761             <center>
 762             <h1>New Record</h1>
 763             Full MARC Record available at bottom
 764             <form method=post>
 765             <table border=1>
 766             <tr><td>Title</td><td>$titleinput</td></tr>
 767             <tr><td>Subtitle</td><td>$subtitleinput</td></tr>
 768             <tr><td>Author</td><td>$authorinput</td></tr>
 769             <tr><td>Additional Authors</td><td>$additionalauthorsinput</td></tr>
 770             <tr><td>Illustrator</td><td>$illustratorinput</td></tr>
 771             <tr><td>Copyright</td><td>$copyrightinput</td></tr>
 772             <tr><td>Series Title</td><td>$seriestitleinput</td></tr>
 773             <tr><td>Volume</td><td>$volumeinput</td></tr>
 774             <tr><td>Number</td><td>$numberinput</td></tr>
 775             <tr><td>Volume Date</td><td>$volumedateinput</td></tr>
 776             <tr><td>Volume Description</td><td>$volumeddescinput</td></tr>
 777             <tr><td>Subject</td><td>$subjectinput</td></tr>
 778             <tr><td>Notes</td><td>$noteinput</td></tr>
 779             <tr><td>Item Type</td><td><select name=itemtype>$itemtypeselect</select></td></tr>
 780             <tr><td>ISBN</td><td>$isbninput</td></tr>
 781             <tr><td>ISSN</td><td>$issninput</td></tr>
 782             <tr><td>LCCN</td><td>$lccninput</td></tr>
 783             <tr><td>Dewey</td><td>$deweyinput</td></tr>
 784             <tr><td>Subclass</td><td>$subclassinput</td></tr>
 785             <tr><td>Publication Year</td><td>$pubyearinput</td></tr>
 786             <tr><td>Publisher</td><td>$publisherinput</td></tr>
 787             <tr><td>Place</td><td>$placeinput</td></tr>
 788             <tr><td>Pages</td><td>$pagesinput</td></tr>
 789             <tr><td>Size</td><td>$sizeinput</td></tr>
 790             </table>
 791             <input type=submit>
 792             <input type=hidden name=insertnewrecord value=1>
 793             $fileinput
 794             $marcinput
 795             $origisbn
 796             $origissn
 797             $origlccn
 798             $origcontrolnumber
 799             </form>
 800             $marctext
 801 EOF
 802         }
 803     } else {
 804         #open (F, "$file");
 805         #my $data=<F>;
 806         my $data;
 807         my $name;
 808         my $z3950=0;
 809         if ($file=~/Z-(\d+)/) {
 810             print << "EOF";
 811 <center>
 812 <p>
 813 <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
 814 <p>
 815 <table border=0 cellpadding=10 cellspacing=0>
 816 <tr><th bgcolor=black><font color=white>Select a Record to Import</font></th></tr>
 817 <tr><td bgcolor=#dddddd>
 818 EOF
 819             my $id=$1;
 820             my $sth=$dbh->prepare("select servers from z3950queue where id=$id");
 821             $sth->execute;
 822             my ($servers) = $sth->fetchrow;
 823             my $serverstring;
 824             my $starttimer=time();
 825             foreach $serverstring (split(/\s+/, $servers)) {
 826                 my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4);
 827                 if ($name eq 'MAN') {
 828                     print "$server/$database<br>\n";
 829                 } else {
 830                     my $sti=$dbh->prepare("select name from
 831                     z3950servers where id=$name");
 832                     $sti->execute;
 833                     my ($longname)=$sti->fetchrow;
 834                     print "<a name=SERVER-$name></a>\n";
 835                     if ($longname) {
 836                         print "$longname \n";
 837                     } else {
 838                         print "$server/$database \n";
 839                     }
 840                 }
 841                 my $q_server=$dbh->quote($serverstring);
 842                 my $startrecord=$input->param("ST-$name");
 843                 ($startrecord) || ($startrecord='0');
 844                 my $sti=$dbh->prepare("select numrecords,id,results,startdate,enddate from z3950results where queryid=$id and server=$q_server");
 845                 $sti->execute;
 846                 ($numrecords,$resultsid,$data,$startdate,$enddate) = $sti->fetchrow;
 847                 my $serverplaceholder='';
 848                 foreach ($input->param) {
 849                     (next) unless (/ST-(.+)/);
 850                     my $serverid=$1;
 851                     (next) if ($serverid eq $name);
 852                     my $place=$input->param("ST-$serverid");
 853                     $serverplaceholder.="\&ST-$serverid=$place";
 854                 }
 855                 if ($numrecords) {
 856                     my $previous='';
 857                     my $next='';
 858                     if ($startrecord>0) {
 859                         $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$name=".($startrecord-10)."#SERVER-$name>Previous</a>";
 860                     }
 861                     my $highest;
 862                     $highest=$startrecord+10;
 863                     ($highest>$numrecords) && ($highest=$numrecords);
 864                     if ($numrecords>$startrecord+10) {
 865                         $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$name=$highest#SERVER-$name>Next</a>";
 866                     }
 867                     print "<font size=-1>[Viewing ".($startrecord+1)." to ".$highest." of $numrecords records]  $previous | $next </font><br>\n";
 868                 } else {
 869                     print "<br>\n";
 870                 }
 871                 print "<ul>\n";
 872                 my $stj=$dbh->prepare("update z3950results set highestseen=".($startrecord+10)." where id=$resultsid");
 873                 $stj->execute;
 874                 if ($sti->rows == 0) {
 875                     print "pending...";
 876                 } elsif ($enddate == 0) {
 877                     my $now=time();
 878                     my $elapsed=$now-$startdate;
 879                     my $elapsedtime='';
 880                     if ($elapsed>60) {
 881                         $elapsedtime=sprintf "%d minutes",($elapsed/60);
 882                     } else {
 883                         $elapsedtime=sprintf "%d seconds",$elapsed;
 884                     }
 885                     print "<font color=red>processing... ($elapsedtime)</font>";
 886                 } elsif ($numrecords) {
 887                     my $splitchar=chr(29);
 888                     my @records=split(/$splitchar/, $data);
 889                     $data='';
 890                     for ($i=$startrecord; $i<$startrecord+10; $i++) {
 891                         $data.=$records[$i].$splitchar;
 892                     }
 893                     @records=parsemarcdata($data);
 894                     my $counter=0;
 895                     foreach $record (@records) {
 896                         $counter++;
 897                         #(next) unless ($counter>=$startrecord && $counter<=$startrecord+10);
 898                         my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber);
 899                         foreach $field (@$record) {
 900                             if ($field->{'tag'} eq '001') {
 901                                 $controlnumber=$field->{'indicator'};
 902                             }
 903                             if ($field->{'tag'} eq '010') {
 904                                 $lccn=$field->{'subfields'}->{'a'};
 905                                 $lccn=~s/^\s*//;
 906                                 ($lccn) = (split(/\s+/, $lccn))[0];
 907                             }
 908                             if ($field->{'tag'} eq '015') {
 909                                 $lccn=$field->{'subfields'}->{'a'};
 910                                 $lccn=~s/^\s*//;
 911                                 $lccn=~s/^C//;
 912                                 ($lccn) = (split(/\s+/, $lccn))[0];
 913                             }
 914                             if ($field->{'tag'} eq '020') {
 915                                 $isbn=$field->{'subfields'}->{'a'};
 916                                 ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
 917                                 $isbn=~s/[^\d]*//g;
 918                             }
 919                             if ($field->{'tag'} eq '022') {
 920                                 $issn=$field->{'subfields'}->{'a'};
 921                                 $issn=~s/^\s*//;
 922                                 ($issn) = (split(/\s+/, $issn))[0];
 923                             }
 924                             if ($field->{'tag'} eq '100') {
 925                                 $author=$field->{'subfields'}->{'a'};
 926                             }
 927                             if ($field->{'tag'} eq '245') {
 928                                 $title=$field->{'subfields'}->{'a'};
 929                                 $title=~s/ \/$//;
 930                                 $subtitle=$field->{'subfields'}->{'b'};
 931                                 $subtitle=~s/ \/$//;
 932                             }
 933                         }
 934                         my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
 935                         my $q_issn=$dbh->quote((($issn) || ('NIL')));
 936                         my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
 937                         my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
 938                         my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
 939                         $sth->execute;
 940                         my $donetext='';
 941                         if ($sth->rows) {
 942                             $donetext="DONE";
 943                         }
 944                         $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
 945                         $sth->execute;
 946                         if ($sth->rows) {
 947                             $donetext="DONE";
 948                         }
 949                         ($author) && ($author="by $author");
 950                         if ($isbn) {
 951                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&isbn=$isbn>$title $subtitle $author</a> $donetext<br>\n";
 952                         } elsif ($lccn) {
 953                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&lccn=$lccn>$title $subtitle $author</a> $donetext<br>\n";
 954                         } elsif ($issn) {
 955                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&issn=$issn>$title $subtitle $author</a><br> $donetext\n";
 956                         } elsif ($controlnumber) {
 957                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&controlnumber=$controlnumber>$title $subtitle $author</a><br> $donetext\n";
 958                         } else {
 959                             print "Error: Contact steve regarding $title by $author<br>\n";
 960                         }
 961                     }
 962                     print "<p>\n";
 963                 } else {
 964                     print "No records returned.<p>\n";
 965                 }
 966                 print "</ul>\n";
 967             }
 968             my $elapsed=time()-$starttimer;
 969             print "<hr>It took $elapsed seconds to process this page.\n";
 970         } else {
 971             my $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
 972             $sth->execute;
 973             ($data, $name) = $sth->fetchrow;
 974             print << "EOF";
 975 <center>
 976 <p>
 977 <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
 978 <p>
 979 <table border=0 cellpadding=10 cellspacing=0>
 980 <tr><th bgcolor=black><font color=white>Select a Record to Import<br>from $name</font></th></tr>
 981 <tr><td bgcolor=#dddddd>
 982 EOF
 983
 984             my @records=parsemarcdata($data);
 985             foreach $record (@records) {
 986                 my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber);
 987                 foreach $field (@$record) {
 988                     if ($field->{'tag'} eq '001') {
 989                         $controlnumber=$field->{'indicator'};
 990                     }
 991                     if ($field->{'tag'} eq '010') {
 992                         $lccn=$field->{'subfields'}->{'a'};
 993                         $lccn=~s/^\s*//;
 994                         ($lccn) = (split(/\s+/, $lccn))[0];
 995                     }
 996                     if ($field->{'tag'} eq '015') {
 997                         $lccn=$field->{'subfields'}->{'a'};
 998                         $lccn=~s/^\s*//;
 999                         $lccn=~s/^C//;
1000                         ($lccn) = (split(/\s+/, $lccn))[0];
1001                     }
1002                     if ($field->{'tag'} eq '020') {
1003                         $isbn=$field->{'subfields'}->{'a'};
1004                         ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
1005                         $isbn=~s/[^\d]*//g;
1006                     }
1007                     if ($field->{'tag'} eq '022') {
1008                         $issn=$field->{'subfields'}->{'a'};
1009                         $issn=~s/^\s*//;
1010                         ($issn) = (split(/\s+/, $issn))[0];
1011                     }
1012                     if ($field->{'tag'} eq '100') {
1013                         $author=$field->{'subfields'}->{'a'};
1014                     }
1015                     if ($field->{'tag'} eq '245') {
1016                         $title=$field->{'subfields'}->{'a'};
1017                         $title=~s/ \/$//;
1018                         $subtitle=$field->{'subfields'}->{'b'};
1019                         $subtitle=~s/ \/$//;
1020                     }
1021                 }
1022                 my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
1023                 my $q_issn=$dbh->quote((($issn) || ('NIL')));
1024                 my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
1025                 my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
1026                 my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
1027                 $sth->execute;
1028                 my $donetext='';
1029                 if ($sth->rows) {
1030                     $donetext="DONE";
1031                 }
1032                 $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
1033                 $sth->execute;
1034                 if ($sth->rows) {
1035                     $donetext="DONE";
1036                 }
1037                 ($author) && ($author="by $author");
1038                 if ($isbn) {
1039                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&isbn=$isbn>$title$subtitle $author</a> $donetext<br>\n";
1040                 } elsif ($lccn) {
1041                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&lccn=$lccn>$title$subtitle $author</a> $donetext<br>\n";
1042                 } elsif ($issn) {
1043                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&issn=$issn>$title$subtitle $author</a><br> $donetext\n";
1044                 } elsif ($controlnumber) {
1045                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&controlnumber=$controlnumber>$title by $author</a><br> $donetext\n";
1046                 } else {
1047                     print "Error: Contact steve regarding $title by $author<br>\n";
1048                 }
1049             }
1050         }
1051         print "</td></tr></table>\n";
1052     }
1053 } else {
1054
1055 SWITCH:
1056     {
1057         if ($menu eq 'z3950') { z3950(); last SWITCH; }
1058         if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; }
1059         if ($menu eq 'manual') { manual(); last SWITCH; }
1060         mainmenu();
1061     }
1062
1063 }
1064
1065
1066 sub z3950 {
1067     my $sth=$dbh->prepare("select id,term,type,done,numrecords,length(results),startdate,enddate,servers from z3950queue order by id desc limit 20");
1068     $sth->execute;
1069     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
1070     print "<table border=0><tr><td valign=top>\n";
1071     print "<h2>Results of Z39.50 searches</h2>\n";
1072     print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n<ul>\n";
1073     while (my ($id, $term, $type, $done, $numrecords, $length, $startdate, $enddate, $servers) = $sth->fetchrow) {
1074         $type=uc($type);
1075         $term=~s/</&lt;/g;
1076         $term=~s/>/&gt;/g;
1077         my $sti=$dbh->prepare("select id,server,startdate,enddate,numrecords from z3950results where queryid=$id");
1078         $sti->execute;
1079         if ($sti->rows) {
1080             my $processing=0;
1081             my $realenddate=0;
1082             my $totalrecords=0;
1083             while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords) = $sti->fetchrow) {
1084                 if ($r_enddate==0) {
1085                     $processing=1;
1086                 } else {
1087                     if ($r_enddate>$realenddate) {
1088                         $realenddate=$r_enddate;
1089                     }
1090                 }
1091
1092                 $totalrecords+=$r_numrecords;
1093             }
1094             if ($processing) {
1095                 my $elapsed=time()-$startdate;
1096                 my $elapsedtime='';
1097                 if ($elapsed>60) {
1098                     $elapsedtime=sprintf "%d minutes",($elapsed/60);
1099                 } else {
1100                     $elapsedtime=sprintf "%d seconds",$elapsed;
1101                 }
1102                 if ($totalrecords) {
1103                     $totalrecords="$totalrecords found.";
1104                 } else {
1105                     $totalrecords='';
1106                 }
1107                 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1 color=red>Processing... $totalrecords ($elapsedtime)</font><br>\n";
1108             } else {
1109                 my $elapsed=$realenddate-$startdate;
1110                 my $elapsedtime='';
1111                 if ($elapsed>60) {
1112                     $elapsedtime=sprintf "%d minutes",($elapsed/60);
1113                 } else {
1114                     $elapsedtime=sprintf "%d seconds",$elapsed;
1115                 }
1116                 if ($totalrecords) {
1117                     $totalrecords="$totalrecords found.";
1118                 } else {
1119                     $totalrecords='';
1120                 }
1121                 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Done. $totalrecords ($elapsedtime)</font><br>\n";
1122             }
1123         } else {
1124             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Pending</font><br>\n";
1125         }
1126     }
1127     print "</ul>\n";
1128     print "</td><td valign=top width=30%>\n";
1129     my $sth=$dbh->prepare("select id,name,checked from z3950servers order by rank");
1130     $sth->execute;
1131     my $serverlist='';
1132     while (my ($id, $name, $checked) = $sth->fetchrow) {
1133         ($checked) ? ($checked='checked') : ($checked='');
1134         $serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n";
1135     }
1136     $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n";
1137
1138     my $rand=rand(1000000000);
1139 print << "EOF";
1140     <form action=$ENV{'SCRIPT_NAME'} method=GET>
1141     <input type=hidden name=z3950queue value=1>
1142     <input type=hidden name=menu value=$menu>
1143     <p>
1144     <input type=hidden name=test value=testvalue>
1145     <input type=hidden name=rand value=$rand>
1146     <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr>
1147     <tr><td>Query Term</td><td><input name=query></td></tr>
1148     <tr><td colspan=2 align=center><input type=radio name=type value=isbn checked>&nbsp;ISBN <input type=radio name=type value=lccn>&nbsp;LCCN<br><input type=radio name=type value=author>&nbsp;Author <input type=radio name=type value=title>&nbsp;Title <input type=radio name=type value=keyword>&nbsp;Keyword</td></tr>
1149     <tr><td colspan=2>
1150     $serverlist
1151     </td></tr>
1152     <tr><td colspan=2 align=center>
1153     <input type=submit>
1154     </td></tr>
1155     </table>
1156
1157     </form>
1158 EOF
1159 print "</td></tr></table>\n";
1160 }
1161
1162 sub uploadmarc {
1163     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
1164     my $sth=$dbh->prepare("select id,name from uploadedmarc");
1165     $sth->execute;
1166     print "<h2>Select a set of MARC records</h2>\n<ul>";
1167     while (my ($id, $name) = $sth->fetchrow) {
1168         print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
1169     }
1170     print "</ul>\n";
1171     print "<p>\n";
1172     print "<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb
1173     colspan=2>Upload a set of MARC records</th></tr>\n";
1174     print "<tr><td>Upload a set of MARC records:</td><td>";
1175     print $input->start_multipart_form();
1176     print $input->filefield('uploadmarc');
1177     print << "EOF";
1178     </td></tr>
1179     <tr><td>
1180     <input type=hidden name=menu value=$menu>
1181     Name this set of MARC records:</td><td><input type=text
1182     name=name></td></tr>
1183     <tr><td colspan=2 align=center>
1184     <input type=submit>
1185     </td></tr>
1186     </table>
1187     </form>
1188 EOF
1189 }
1190
1191 sub manual {
1192 }
1193
1194
1195 sub mainmenu {
1196     print << "EOF";
1197 <h1>Main Menu</h1>
1198 <ul>
1199 <li><a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Z39.50 Search</a>
1200 <li><a href=$ENV{'SCRIPT_NAME'}?menu=uploadmarc>Upload MARC Records</a>
1201 </ul>
1202 EOF
1203 }
1204
1205 sub skip {
1206
1207     #opendir(D, "/home/$userid/");
1208     #my @dirlist=readdir D;
1209     #foreach $file (@dirlist) {
1210 #       (next) if ($file=~/^\./);
1211 #       (next) if ($file=~/^nsmail$/);
1212 #       (next) if ($file=~/^public_html$/);
1213 #       ($file=~/\.mrc/) || ($filelist.="$file<br>\n");
1214 #       (next) unless ($file=~/\.mrc$/);
1215 #       $file=~s/ /\%20/g;
1216 #       print "<a href=$ENV{'SCRIPT_NAME'}?file=/home/$userid/$file>$file</a><br>\n";
1217 #    }
1218
1219
1220     #<form action=$ENV{'SCRIPT_NAME'} method=POST enctype=multipart/form-data>
1221
1222 }
1223 print endmenu();
1224 print endpage();
1225
1226 sub parsemarcdata {
1227     my $data=shift;
1228     my $splitchar=chr(29);
1229     my @records;
1230     my $record;
1231     foreach $record (split(/$splitchar/, $data)) {
1232         my $leader=substr($record,0,24);
1233         #print "<tr><td>Leader:</td><td>$leader</td></tr>\n";
1234         $record=substr($record,24);
1235         my $splitchar2=chr(30);
1236         my $directory=0;
1237         my $tagcounter=0;
1238         my %tag;
1239         my @record;
1240         my $field;
1241         foreach $field (split(/$splitchar2/, $record)) {
1242             my %field;
1243             ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
1244             unless ($directory) {
1245                 $directory=$field;
1246                 my $itemcounter=1;
1247                 $counter=0;
1248                 while ($item=substr($directory,0,12)) {
1249                     $tag=substr($directory,0,3);
1250                     $length=substr($directory,3,4);
1251                     $start=substr($directory,7,6);
1252                     $directory=substr($directory,12);
1253                     $tag{$counter}=$tag;
1254                     $counter++;
1255                 }
1256                 $directory=1;
1257                 next;
1258             }
1259             $tag=$tag{$tagcounter};
1260             $tagcounter++;
1261             $field{'tag'}=$tag;
1262             $splitchar3=chr(31);
1263             my @subfields=split(/$splitchar3/, $field);
1264             $indicator=$subfields[0];
1265             $field{'indicator'}=$indicator;
1266             my $firstline=1;
1267             unless ($#subfields==0) {
1268                 my %subfields;
1269                 for ($i=1; $i<=$#subfields; $i++) {
1270                     my $text=$subfields[$i];
1271                     my $subfieldcode=substr($text,0,1);
1272                     my $subfield=substr($text,1);
1273                     if ($subfields{$subfieldcode}) {
1274                         my $subfieldlist=$subfields{$subfieldcode};
1275                         my @subfieldlist=@$subfieldlist;
1276                         if ($#subfieldlist>=0) {
1277 #                       print "$tag Adding to array $subfieldcode -- $subfield<br>\n";
1278                             push (@subfieldlist, $subfield);
1279                         } else {
1280 #                       print "$tag Arraying $subfieldcode -- $subfield<br>\n";
1281                             @subfieldlist=($subfields{$subfieldcode}, $subfield);
1282                         }
1283                         $subfields{$subfieldcode}=\@subfieldlist;
1284                     } else {
1285                         $subfields{$subfieldcode}=$subfield;
1286                     }
1287                 }
1288                 $field{'subfields'}=\%subfields;
1289             }
1290             push (@record, \%field);
1291         }
1292         push (@records, \@record);
1293         $counter++;
1294     }
1295     return @records;
1296 }
1297
1298 #---------------
1299 # Create an HTML option list for a <SELECT> form tag by using
1300 #    values from a DB file
1301 sub GetKeyTableSelectOptions {
1302         # inputs
1303         my (
1304                 $dbh,           # DBI handle
1305                 $tablename,     # name of table containing list of choices
1306                 $keyfieldname,  # column name of code to use in option list
1307                 $descfieldname, # column name of descriptive field
1308                 $showkey,       # flag to show key in description
1309         )=@_;
1310         my $selectclause;       # return value
1311
1312         my (
1313                 $sth, $query,
1314                 $key, $desc, $orderfieldname,
1315         );
1316         my $debug=0;
1317
1318         if ( $showkey ) {
1319                 $orderfieldname=$keyfieldname;
1320         } else {
1321                 $orderfieldname=$descfieldname;
1322         }
1323         $query= "select $keyfieldname,$descfieldname
1324                 from $tablename
1325                 order by $orderfieldname ";
1326         print "<PRE>Query=$query </PRE>\n" if $debug;
1327         $sth=$dbh->prepare($query);
1328         $sth->execute;
1329         while ( ($key, $desc) = $sth->fetchrow) {
1330             if ($showkey) { $desc="$key - $desc"; }
1331             $selectclause.="<option value='$key'>$desc\n";
1332             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1333         }
1334         return $selectclause;
1335 } # sub GetKeyTableSelectOptions