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         my $error;
 265         my %biblio;
 266         my %biblioitem;
 267
 268         # convert to upper case and split on lines
 269         my $subjectheadings=$input->param('subject');
 270         my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
 271
 272         my $additionalauthors=$input->param('additionalauthors');
 273         my @additionalauthors=split(/[\r\n]+/,uc($additionalauthors));
 274
 275         # Use individual assignments to hash buckets, in case
 276         #  any of the input parameters are empty or don't exist
 277         $biblio{title}          =$input->param('title');
 278         $biblio{author}         =$input->param('author');
 279         $biblio{copyright}      =$input->param('copyrightdate');
 280         $biblio{seriestitle}    =$input->param('seriestitle');
 281         $biblio{notes}          =$input->param('notes');
 282         $biblio{abstract}       =$input->param('abstract');
 283         $biblio{subtitle}       =$input->param('subtitle');
 284
 285         $biblioitem{volume}             =$input->param('volume');
 286         $biblioitem{number}             =$input->param('number');
 287         $biblioitem{itemtype}           =$input->param('itemtype');
 288         $biblioitem{isbn}               =$input->param('isbn');
 289         $biblioitem{issn}               =$input->param('issn');
 290         $biblioitem{dewey}              =$input->param('dewey');
 291         $biblioitem{subclass}           =$input->param('subclass');
 292         $biblioitem{publicationyear}    =$input->param('publicationyear');
 293         $biblioitem{publishercode}      =$input->param('publishercode');
 294         $biblioitem{volumedate}         =$input->param('volumedate');
 295         $biblioitem{volumeddesc}        =$input->param('volumeddesc');
 296         $biblioitem{illus}              =$input->param('illustrator');
 297         $biblioitem{pages}              =$input->param('pages');
 298         $biblioitem{notes}              =$input->param('notes');
 299         $biblioitem{size}               =$input->param('size');
 300         $biblioitem{place}              =$input->param('place');
 301         $biblioitem{lccn}               =$input->param('lccn');
 302         $biblioitem{marc}               =$input->param('marc');
 303
 304         print "<PRE>subjects=@subjectheadings</PRE>\n";
 305         print "<PRE>auth=@additionalauthors</PRE>\n";
 306
 307         ($biblionumber, $biblioitemnumber, $error)=
 308           NewBiblioItem($dbh,
 309                 \%biblio,
 310                 \%biblioitem,
 311                 \@subjectheadings,
 312                 \@additionalauthors
 313         );
 314
 315
 316         my $title=$input->param('title');
 317         print << "EOF";
 318         <table cellpadding=10 cellspacing=0 border=0 width=50%>
 319         <tr><th bgcolor=black><font color=white>Record entered into database</font></th></tr>
 320         <tr><td bgcolor=#dddddd>$title has been entered into the database with biblionumber
 321         $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
 322         </table>
 323 EOF
 324     } # if new record
 325
 326     my $title=$input->param('title');
 327
 328     # Get next barcode, or pick random one if none exist yet
 329     $sth=$dbh->prepare("select max(barcode) from items");
 330     $sth->execute;
 331     my ($barcode) = $sth->fetchrow;
 332     $barcode++;
 333     if ($barcode==1) {
 334         $barcode=int(rand()*1000000);
 335     }
 336
 337     my $branchselect=GetKeyTableSelectOptions(
 338                 $dbh, 'branches', 'branchcode', 'branchname', 0);
 339
 340     print << "EOF";
 341     <table border=0 cellpadding=10 cellspacing=0>
 342     <tr><th bgcolor=black><font color=white>
 343 Add a New Item for $title
 344 </font>
 345 </th></tr>
 346 <tr><td bgcolor=#dddddd>
 347 <form>
 348 <input type=hidden name=newitem value=1>
 349 <input type=hidden name=biblionumber value=$biblionumber>
 350 <input type=hidden name=biblioitemnumber value=$biblioitemnumber>
 351 <input type=hidden name=file value=$file>
 352 <table border=0>
 353 <tr><td>BARCODE</td><td><input name=barcode size=10 value=$barcode>
 354
 355 Home Branch: <select name=homebranch> $branchselect </select></td></tr>
 356
 357 </tr><td>Replacement Price:</td><td><input name=replacementprice size=10></td></tr>
 358 <tr><td>Notes</td><td><textarea name=notes rows=4 cols=40
 359 wrap=physical></textarea></td></tr>
 360 </table>
 361 </td></tr>
 362 </table>
 363 <p>
 364 <input type=submit value="Add Item">
 365 </form>
 366 EOF
 367 print endmenu();
 368 print endpage();
 369
 370 exit;
 371 }
 372
 373 sub NewBiblioItem {
 374         use strict;
 375
 376         my ( $dbh,              # DBI handle
 377           $biblio,              # hash ref to biblio record
 378           $biblioitem,          # hash ref to biblioitem record
 379           $subjects,            # list ref of subjects
 380           $addlauthors,         # list ref of additional authors
 381         )=@_ ;
 382
 383         my ( $biblionumber, $biblioitemnumber, $error);         # return values
 384
 385         my $debug=1;
 386         my $sth;
 387         my $subjectheading;
 388         my $additionalauthor;
 389
 390         #--------
 391
 392         print "<PRE>Trying to add biblio item Title=$biblio->{title} " .
 393                 "ISBN=$biblioitem->{isbn} </PRE>\n" if $debug;
 394
 395         # Make sure master biblio entry exists
 396         $biblionumber=GetOrAddBiblio($dbh, $biblio);
 397
 398         # Get next biblioitemnumber
 399         $sth=$dbh->prepare("select max(biblioitemnumber) from biblioitems");
 400         $sth->execute;
 401         ($biblioitemnumber) = $sth->fetchrow;
 402         $biblioitemnumber++;
 403
 404         print "<PRE>Next biblio item is $biblioitemnumber</PRE>\n" if $debug;
 405
 406         $sth=$dbh->prepare("insert into biblioitems (
 407           biblioitemnumber,
 408           biblionumber,
 409           volume,
 410           number,
 411           itemtype,
 412           isbn,
 413           issn,
 414           dewey,
 415           subclass,
 416           publicationyear,
 417           publishercode,
 418           volumedate,
 419           volumeddesc,
 420           illus,
 421           pages,
 422           notes,
 423           size,
 424           place,
 425           lccn,
 426           marc)
 427         values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" );
 428
 429         $sth->execute(
 430           $biblioitemnumber,
 431           $biblionumber,
 432           $biblioitem->{volume},
 433           $biblioitem->{number},
 434           $biblioitem->{itemtype},
 435           $biblioitem->{isbn},
 436           $biblioitem->{issn},
 437           $biblioitem->{dewey},
 438           $biblioitem->{subclass},
 439           $biblioitem->{publicationyear},
 440           $biblioitem->{publishercode},
 441           $biblioitem->{volumedate},
 442           $biblioitem->{volumeddesc},
 443           $biblioitem->{illus},
 444           $biblioitem->{pages},
 445           $biblioitem->{notes},
 446           $biblioitem->{size},
 447           $biblioitem->{place},
 448           $biblioitem->{lccn},
 449           $biblioitem->{marc} );
 450
 451         $sth=$dbh->prepare("insert into bibliosubject
 452                 (biblionumber,subject)
 453                 values (?, ? )" );
 454         foreach $subjectheading (@{$subjects} ) {
 455             $sth->execute($biblionumber, $subjectheading);
 456         }
 457
 458         $sth=$dbh->prepare("insert into additionalauthors
 459                 (biblionumber,author)
 460                 values (?, ? )");
 461         foreach $additionalauthor (@{$addlauthors} ) {
 462             $sth->execute($biblionumber, $additionalauthor);
 463         }
 464
 465         return ( $biblionumber, $biblioitemnumber, $error);
 466
 467 } # sub NewBiblioItem
 468
 469 #---------------------------------------
 470 # Find a biblio entry, or create a new one if it doesn't exist.
 471 sub GetOrAddBiblio {
 472         use strict;             # in here until rest cleaned up
 473         # input params
 474         my (
 475           $dbh,         # db handle
 476           $biblio,      # hash ref to fields
 477         )=@_;
 478
 479         # return
 480         my $biblionumber;
 481
 482         my $debug=1;
 483         my $sth;
 484
 485         #-----
 486         print "<PRE>Looking for biblio </PRE>\n" if $debug;
 487         $sth=$dbh->prepare("select biblionumber
 488                 from biblio
 489                 where title=? and author=?
 490                   and copyrightdate=? and seriestitle=?");
 491         $sth->execute(
 492                 $biblio->{title}, $biblio->{author},
 493                 $biblio->{copyright}, $biblio->{seriestitle} );
 494         if ($sth->rows) {
 495             ($biblionumber) = $sth->fetchrow;
 496             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
 497         } else {
 498             # Doesn't exist.  Add new one.
 499             print "<PRE>Adding biblio</PRE>\n" if $debug;
 500             $biblionumber=&newbiblio($biblio);
 501             print "<PRE>Added with biblio number $biblionumber</PRE>\n" if $debug;
 502             &newsubtitle($biblionumber,$biblio->{subtitle} );
 503         }
 504
 505         return $biblionumber;
 506
 507 } # sub GetOrAddBiblio
 508 #---------------------------------------
 509
 510 if ($input->param('newitem')) {
 511     use strict;
 512     my $error;
 513     my $barcode=$input->param('barcode');
 514     my $replacementprice=($input->param('replacementprice') || 0);
 515
 516     my $sth=$dbh->prepare("select barcode
 517         from items
 518         where barcode=?");
 519     $sth->execute($barcode);
 520     if ($sth->rows) {
 521         print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n";
 522     } else {
 523            # Insert new item into database
 524            $error=&newitems(
 525                 { biblionumber=> $input->param('biblionumber'),
 526                   biblioitemnumber=> $input->param('biblioitemnumber'),
 527                   itemnotes=> $input->param('notes'),
 528                   homebranch=> $input->param('homebranch'),
 529                   replacementprice=> $replacementprice,
 530                 },
 531                 $barcode
 532             );
 533             if ( $error ) {
 534                 print "<font color=red>Error: $error </font><p>\n";
 535             } else {
 536
 537                 print "<font color=green>Item added with barcode $barcode
 538                         </font><P>\n";
 539             } # if error
 540     } # if barcode exists
 541 }
 542
 543
 544 my $menu = $input->param('menu');
 545 if ($file) {
 546     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
 547     my $qisbn=$input->param('isbn');
 548     my $qissn=$input->param('issn');
 549     my $qlccn=$input->param('lccn');
 550     my $qcontrolnumber=$input->param('controlnumber');
 551     if ($qisbn || $qissn || $qlccn || $qcontrolnumber) {
 552         print "<a href=$ENV{'SCRIPT_NAME'}>New File</a><hr>\n";
 553         #open (F, "$file");
 554         #my $data=<F>;
 555         my $data;
 556         if ($file=~/Z-(\d+)/) {
 557             my $id=$1;
 558             my $resultsid=$input->param('resultsid');
 559             my $sth=$dbh->prepare("select results from z3950results where id=$resultsid");
 560             $sth->execute;
 561             ($data) = $sth->fetchrow;
 562         } else {
 563             my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file");
 564             $sth->execute;
 565             ($data) = $sth->fetchrow;
 566         }
 567
 568         $splitchar=chr(29);
 569         my @records;
 570         foreach $record (split(/$splitchar/, $data)) {
 571             my $marctext="<table border=0 cellspacing=0>\n";
 572             $marctext.="<tr><th colspan=3 bgcolor=black><font color=white>MARC RECORD</font></th></tr>\n";
 573             $leader=substr($record,0,24);
 574             $marctext.="<tr><td>Leader:</td><td colspan=2>$leader</td></tr>\n";
 575             $record=substr($record,24);
 576             $splitchar2=chr(30);
 577             my $directory=0;
 578             my $tagcounter=0;
 579             my %tag;
 580             my @record;
 581             foreach $field (split(/$splitchar2/, $record)) {
 582                 my %field;
 583                 ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
 584                 unless ($directory) {
 585                     $directory=$field;
 586                     my $itemcounter=1;
 587                     $counter=0;
 588                     while ($item=substr($directory,0,12)) {
 589                         $tag=substr($directory,0,3);
 590                         $length=substr($directory,3,4);
 591                         $start=substr($directory,7,6);
 592                         $directory=substr($directory,12);
 593                         $tag{$counter}=$tag;
 594                         $counter++;
 595                     }
 596                     $directory=1;
 597                     next;
 598                 }
 599                 $tag=$tag{$tagcounter};
 600                 $tagcounter++;
 601                 $field{'tag'}=$tag;
 602                 $marctext.="<tr><td bgcolor=$color valign=top>$tagtext{$tag}</td><td bgcolor=$color valign=top>$tag</td>";
 603                 $splitchar3=chr(31);
 604                 my @subfields=split(/$splitchar3/, $field);
 605                 $indicator=$subfields[0];
 606                 $field{'indicator'}=$indicator;
 607                 my $firstline=1;
 608                 if ($#subfields==0) {
 609                     $marctext.="<td bgcolor=$color valign=top>$indicator</td></tr>";
 610                 } else {
 611                     my %subfields;
 612                     $marctext.="<td bgcolor=$color valign=top><table border=0 cellspacing=0>\n";
 613                     my $color2=$color;
 614                     for ($i=1; $i<=$#subfields; $i++) {
 615                         ($color2 eq $lc1) ? ($color2=$lc2) : ($color2=$lc1);
 616                         my $text=$subfields[$i];
 617                         my $subfieldcode=substr($text,0,1);
 618                         my $subfield=substr($text,1);
 619                         $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";
 620                         if ($subfields{$subfieldcode}) {
 621                             my $subfieldlist=$subfields{$subfieldcode};
 622                             my @subfieldlist=@$subfieldlist;
 623                             if ($#subfieldlist>=0) {
 624                                 push (@subfieldlist, $subfield);
 625                             } else {
 626                                 @subfieldlist=($subfields{$subfieldcode}, $subfield);
 627                             }
 628                             $subfields{$subfieldcode}=\@subfieldlist;
 629                         } else {
 630                             $subfields{$subfieldcode}=$subfield;
 631                         }
 632                     }
 633                     $marctext.="</table></td></tr>\n";
 634                     $field{'subfields'}=\%subfields;
 635                 }
 636                 push (@record, \%field);
 637             }
 638             $marctext.="</table>\n";
 639             $marctext{\@record}=$marctext;
 640             $marc{\@record}=$record;
 641             push (@records, \@record);
 642             $counter++;
 643         }
 644 RECORD:
 645         foreach $record (@records) {
 646             my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $additionalauthors, $illustrator, $copyrightdate, $seriestitle);
 647             my $marctext=$marctext{$record};
 648             my $marc=$marc{$record};
 649             foreach $field (@$record) {
 650                 if ($field->{'tag'} eq '001') {
 651                     $controlnumber=$field->{'indicator'};
 652                 }
 653                 if ($field->{'tag'} eq '010') {
 654                     $lccn=$field->{'subfields'}->{'a'};
 655                     $lccn=~s/^\s*//;
 656                     ($lccn) = (split(/\s+/, $lccn))[0];
 657                 }
 658                 if ($field->{'tag'} eq '015') {
 659                     $lccn=$field->{'subfields'}->{'a'};
 660                     $lccn=~s/^\s*//;
 661                     $lccn=~s/^C//;
 662                     ($lccn) = (split(/\s+/, $lccn))[0];
 663                 }
 664                 if ($field->{'tag'} eq '020') {
 665                     $isbn=$field->{'subfields'}->{'a'};
 666                     ($isbn=~/^ARRAY/) && ($isbn=$$isbn[0]);
 667                     $isbn=~s/[^\d]*//g;
 668                 }
 669                 if ($field->{'tag'} eq '022') {
 670                     $issn=$field->{'subfields'}->{'a'};
 671                     $issn=~s/^\s*//;
 672                     ($issn) = (split(/\s+/, $issn))[0];
 673                 }
 674                 if ($field->{'tag'} eq '082') {
 675                     $dewey=$field->{'subfields'}->{'a'};
 676                     $dewey=~s/\///g;
 677                     if (@$dewey) {
 678                         $dewey=$$dewey[0];
 679                     }
 680                     #$dewey=~s/\///g;
 681                 }
 682                 if ($field->{'tag'} eq '100') {
 683                     $author=$field->{'subfields'}->{'a'};
 684                 }
 685                 if ($field->{'tag'} eq '245') {
 686                     $title=$field->{'subfields'}->{'a'};
 687                     $title=~s/ \/$//;
 688                     $subtitle=$field->{'subfields'}->{'b'};
 689                     $subtitle=~s/ \/$//;
 690                 }
 691                 if ($field->{'tag'} eq '260') {
 692                     $place=$field->{'subfields'}->{'a'};
 693                     if (@$place) {
 694                         $place=$$place[0];
 695                     }
 696                     $place=~s/\s*:$//g;
 697                     $publisher=$field->{'subfields'}->{'b'};
 698                     if (@$publisher) {
 699                         $publisher=$$publisher[0];
 700                     }
 701                     $publisher=~s/\s*:$//g;
 702                     $publicationyear=$field->{'subfields'}->{'c'};
 703                     if ($publicationyear=~/c(\d\d\d\d)/) {
 704                         $copyrightdate=$1;
 705                     }
 706                     if ($publicationyear=~/[^c](\d\d\d\d)/) {
 707                         $publicationyear=$1;
 708                     } elsif ($copyrightdate) {
 709                         $publicationyear=$copyrightdate;
 710                     } else {
 711                         $publicationyear=~/(\d\d\d\d)/;
 712                         $publicationyear=$1;
 713                     }
 714                 }
 715                 if ($field->{'tag'} eq '300') {
 716                     $pages=$field->{'subfields'}->{'a'};
 717                     $pages=~s/ \;$//;
 718                     $size=$field->{'subfields'}->{'c'};
 719                     $pages=~s/\s*:$//g;
 720                     $size=~s/\s*:$//g;
 721                 }
 722                 if ($field->{'tag'} eq '362') {
 723                     if ($field->{'subfields'}->{'a'}=~/(\d+).*(\d+)/) {
 724                         $volume=$1;
 725                         $number=$2;
 726                     }
 727                 }
 728                 if ($field->{'tag'} eq '440') {
 729                     $seriestitle=$field->{'subfields'}->{'a'};
 730                     if ($field->{'subfields'}->{'v'}=~/(\d+).*(\d+)/) {
 731                         $volume=$1;
 732                         $number=$2;
 733                     }
 734                 }
 735                 if ($field->{'tag'} eq '700') {
 736                     my $name=$field->{'subfields'}->{'a'};
 737                     if ($field->{'subfields'}->{'c'}=~/ill/) {
 738                         $additionalauthors.="$name\n";
 739                     } else {
 740                         $illustrator=$name;
 741                     }
 742                 }
 743                 if ($field->{'tag'} =~/^5/) {
 744                     $notes.="$field->{'subfields'}->{'a'}\n";
 745                 }
 746                 if ($field->{'tag'} =~/65\d/) {
 747                     my $subject=$field->{'subfields'}->{'a'};
 748                     $subject=~s/\.$//;
 749                     if ($gensubdivision=$field->{'subfields'}->{'x'}) {
 750                         my @sub=@$gensubdivision;
 751                         if ($#sub>=0) {
 752                             foreach $s (@sub) {
 753                                 $s=~s/\.$//;
 754                                 $subject.=" -- $s";
 755                             }
 756                         } else {
 757                             $gensubdivision=~s/\.$//;
 758                             $subject.=" -- $gensubdivision";
 759                         }
 760                     }
 761                     if ($chronsubdivision=$field->{'subfields'}->{'y'}) {
 762                         my @sub=@$chronsubdivision;
 763                         if ($#sub>=0) {
 764                             foreach $s (@sub) {
 765                                 $s=~s/\.$//;
 766                                 $subject.=" -- $s";
 767                             }
 768                         } else {
 769                             $chronsubdivision=~s/\.$//;
 770                             $subject.=" -- $chronsubdivision";
 771                         }
 772                     }
 773                     if ($geosubdivision=$field->{'subfields'}->{'z'}) {
 774                         my @sub=@$geosubdivision;
 775                         if ($#sub>=0) {
 776                             foreach $s (@sub) {
 777                                 $s=~s/\.$//;
 778                                 $subject.=" -- $s";
 779                             }
 780                         } else {
 781                             $geosubdivision=~s/\.$//;
 782                             $subject.=" -- $geosubdivision";
 783                         }
 784                     }
 785                     push @subjects, $subject;
 786                 }
 787             }
 788             $titleinput=$input->textfield(-name=>'title', -default=>$title, -size=>40);
 789             $marcinput=$input->hidden(-name=>'marc', -default=>$marc);
 790             $subtitleinput=$input->textfield(-name=>'subtitle', -default=>$subtitle, -size=>40);
 791             $authorinput=$input->textfield(-name=>'author', -default=>$author);
 792             $illustratorinput=$input->textfield(-name=>'illustrator', -default=>$illustrator);
 793             $additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
 794             my $subject='';
 795             foreach (@subjects) {
 796                 $subject.="$_\n";
 797             }
 798             $subjectinput=$input->textarea(-name=>'subject', -default=>$subject, -rows=>4, -cols=>40);
 799             $noteinput=$input->textarea(-name=>'notes', -default=>$notes, -rows=>4, -cols=>40, -wrap=>'physical');
 800             $copyrightinput=$input->textfield(-name=>'copyrightdate', -default=>$copyrightdate);
 801             $seriestitleinput=$input->textfield(-name=>'seriestitle', -default=>$seriestitle);
 802             $volumeinput=$input->textfield(-name=>'volume', -default=>$volume);
 803             $volumedateinput=$input->textfield(-name=>'volumedate', -default=>$volumedate);
 804             $volumeddescinput=$input->textfield(-name=>'volumeddesc', -default=>$volumeddesc);
 805             $numberinput=$input->textfield(-name=>'number', -default=>$number);
 806             $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
 807             $issninput=$input->textfield(-name=>'issn', -default=>$issn);
 808             $lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
 809             $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
 810             $deweyinput=$input->textfield(-name=>'dewey', -default=>$dewey);
 811             $cleanauthor=$author;
 812             $cleanauthor=~s/[^A-Za-z]//g;
 813             $subclassinput=$input->textfield(-name=>'subclass', -default=>uc(substr($cleanauthor,0,3)));
 814             $publisherinput=$input->textfield(-name=>'publishercode', -default=>$publisher);
 815             $pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
 816             $placeinput=$input->textfield(-name=>'place', -default=>$place);
 817             $pagesinput=$input->textfield(-name=>'pages', -default=>$pages);
 818             $sizeinput=$input->textfield(-name=>'size', -default=>$size);
 819             $fileinput=$input->hidden(-name=>'file', -default=>$file);
 820             $origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
 821             $origissn=$input->hidden(-name=>'origissn', -default=>$issn);
 822             $origlccn=$input->hidden(-name=>'origlccn', -default=>$lccn);
 823             $origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
 824
 825             #print "<PRE>getting itemtypeselect</PRE>\n";
 826             $itemtypeselect=&GetKeyTableSelectOptions(
 827                 $dbh, 'itemtypes', 'itemtype', 'description', 1);
 828             #print "<PRE>it=$itemtypeselect</PRE>\n";
 829
 830             ($qissn) || ($qissn='NIL');
 831             ($qlccn) || ($qlccn='NIL');
 832             ($qisbn) || ($qisbn='NIL');
 833             ($qcontrolnumber) || ($qcontrolnumber='NIL');
 834             $controlnumber=~s/\s+//g;
 835
 836             unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) {
 837                 #print "<PRE>Skip record $isbn $issn $lccn </PRE>\n";
 838                 next RECORD;
 839             }
 840
 841             print << "EOF";
 842             <center>
 843             <h1>New Record</h1>
 844             Full MARC Record available at bottom
 845             <form method=post>
 846             <table border=1>
 847             <tr><td>Title</td><td>$titleinput</td></tr>
 848             <tr><td>Subtitle</td><td>$subtitleinput</td></tr>
 849             <tr><td>Author</td><td>$authorinput</td></tr>
 850             <tr><td>Additional Authors</td><td>$additionalauthorsinput</td></tr>
 851             <tr><td>Illustrator</td><td>$illustratorinput</td></tr>
 852             <tr><td>Copyright</td><td>$copyrightinput</td></tr>
 853             <tr><td>Series Title</td><td>$seriestitleinput</td></tr>
 854             <tr><td>Volume</td><td>$volumeinput</td></tr>
 855             <tr><td>Number</td><td>$numberinput</td></tr>
 856             <tr><td>Volume Date</td><td>$volumedateinput</td></tr>
 857             <tr><td>Volume Description</td><td>$volumeddescinput</td></tr>
 858             <tr><td>Subject</td><td>$subjectinput</td></tr>
 859             <tr><td>Notes</td><td>$noteinput</td></tr>
 860             <tr><td>Item Type</td><td><select name=itemtype>$itemtypeselect</select></td></tr>
 861             <tr><td>ISBN</td><td>$isbninput</td></tr>
 862             <tr><td>ISSN</td><td>$issninput</td></tr>
 863             <tr><td>LCCN</td><td>$lccninput</td></tr>
 864             <tr><td>Dewey</td><td>$deweyinput</td></tr>
 865             <tr><td>Subclass</td><td>$subclassinput</td></tr>
 866             <tr><td>Publication Year</td><td>$pubyearinput</td></tr>
 867             <tr><td>Publisher</td><td>$publisherinput</td></tr>
 868             <tr><td>Place</td><td>$placeinput</td></tr>
 869             <tr><td>Pages</td><td>$pagesinput</td></tr>
 870             <tr><td>Size</td><td>$sizeinput</td></tr>
 871             </table>
 872             <input type=submit>
 873             <input type=hidden name=insertnewrecord value=1>
 874             $fileinput
 875             $marcinput
 876             $origisbn
 877             $origissn
 878             $origlccn
 879             $origcontrolnumber
 880             </form>
 881             $marctext
 882 EOF
 883         }
 884     } else {
 885         #open (F, "$file");
 886         #my $data=<F>;
 887         my $data;
 888         my $name;
 889         my $z3950=0;
 890         if ($file=~/Z-(\d+)/) {
 891             print << "EOF";
 892 <center>
 893 <p>
 894 <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
 895 <p>
 896 <table border=0 cellpadding=10 cellspacing=0>
 897 <tr><th bgcolor=black><font color=white>Select a Record to Import</font></th></tr>
 898 <tr><td bgcolor=#dddddd>
 899 EOF
 900             my $id=$1;
 901             my $sth=$dbh->prepare("select servers from z3950queue where id=$id");
 902             $sth->execute;
 903             my ($servers) = $sth->fetchrow;
 904             my $serverstring;
 905             my $starttimer=time();
 906             foreach $serverstring (split(/\s+/, $servers)) {
 907                 my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4);
 908                 if ($name eq 'MAN') {
 909                     print "$server/$database<br>\n";
 910                 } else {
 911                     my $sti=$dbh->prepare("select name from
 912                     z3950servers where id=$name");
 913                     $sti->execute;
 914                     my ($longname)=$sti->fetchrow;
 915                     print "<a name=SERVER-$name></a>\n";
 916                     if ($longname) {
 917                         print "$longname \n";
 918                     } else {
 919                         print "$server/$database \n";
 920                     }
 921                 }
 922                 my $q_server=$dbh->quote($serverstring);
 923                 my $startrecord=$input->param("ST-$name");
 924                 ($startrecord) || ($startrecord='0');
 925                 my $sti=$dbh->prepare("select numrecords,id,results,startdate,enddate from z3950results where queryid=$id and server=$q_server");
 926                 $sti->execute;
 927                 ($numrecords,$resultsid,$data,$startdate,$enddate) = $sti->fetchrow;
 928                 my $serverplaceholder='';
 929                 foreach ($input->param) {
 930                     (next) unless (/ST-(.+)/);
 931                     my $serverid=$1;
 932                     (next) if ($serverid eq $name);
 933                     my $place=$input->param("ST-$serverid");
 934                     $serverplaceholder.="\&ST-$serverid=$place";
 935                 }
 936                 if ($numrecords) {
 937                     my $previous='';
 938                     my $next='';
 939                     if ($startrecord>0) {
 940                         $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$name=".($startrecord-10)."#SERVER-$name>Previous</a>";
 941                     }
 942                     my $highest;
 943                     $highest=$startrecord+10;
 944                     ($highest>$numrecords) && ($highest=$numrecords);
 945                     if ($numrecords>$startrecord+10) {
 946                         $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$name=$highest#SERVER-$name>Next</a>";
 947                     }
 948                     print "<font size=-1>[Viewing ".($startrecord+1)." to ".$highest." of $numrecords records]  $previous | $next </font><br>\n";
 949                 } else {
 950                     print "<br>\n";
 951                 }
 952                 print "<ul>\n";
 953                 my $stj=$dbh->prepare("update z3950results set highestseen=".($startrecord+10)." where id=$resultsid");
 954                 $stj->execute;
 955                 if ($sti->rows == 0) {
 956                     print "pending...";
 957                 } elsif ($enddate == 0) {
 958                     my $now=time();
 959                     my $elapsed=$now-$startdate;
 960                     my $elapsedtime='';
 961                     if ($elapsed>60) {
 962                         $elapsedtime=sprintf "%d minutes",($elapsed/60);
 963                     } else {
 964                         $elapsedtime=sprintf "%d seconds",$elapsed;
 965                     }
 966                     print "<font color=red>processing... ($elapsedtime)</font>";
 967                 } elsif ($numrecords) {
 968                     my $splitchar=chr(29);
 969                     my @records=split(/$splitchar/, $data);
 970                     $data='';
 971                     for ($i=$startrecord; $i<$startrecord+10; $i++) {
 972                         $data.=$records[$i].$splitchar;
 973                     }
 974                     @records=parsemarcdata($data);
 975                     my $counter=0;
 976                     foreach $record (@records) {
 977                         $counter++;
 978                         #(next) unless ($counter>=$startrecord && $counter<=$startrecord+10);
 979                         my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $controlnumber);
 980                         foreach $field (@$record) {
 981                             if ($field->{'tag'} eq '001') {
 982                                 $controlnumber=$field->{'indicator'};
 983                             }
 984                             if ($field->{'tag'} eq '010') {
 985                                 $lccn=$field->{'subfields'}->{'a'};
 986                                 $lccn=~s/^\s*//;
 987                                 ($lccn) = (split(/\s+/, $lccn))[0];
 988                             }
 989                             if ($field->{'tag'} eq '015') {
 990                                 $lccn=$field->{'subfields'}->{'a'};
 991                                 $lccn=~s/^\s*//;
 992                                 $lccn=~s/^C//;
 993                                 ($lccn) = (split(/\s+/, $lccn))[0];
 994                             }
 995                             if ($field->{'tag'} eq '020') {
 996                                 $isbn=$field->{'subfields'}->{'a'};
 997                                 ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
 998                                 $isbn=~s/[^\d]*//g;
 999                             }
1000                             if ($field->{'tag'} eq '022') {
1001                                 $issn=$field->{'subfields'}->{'a'};
1002                                 $issn=~s/^\s*//;
1003                                 ($issn) = (split(/\s+/, $issn))[0];
1004                             }
1005                             if ($field->{'tag'} eq '100') {
1006                                 $author=$field->{'subfields'}->{'a'};
1007                             }
1008                             if ($field->{'tag'} eq '245') {
1009                                 $title=$field->{'subfields'}->{'a'};
1010                                 $title=~s/ \/$//;
1011                                 $subtitle=$field->{'subfields'}->{'b'};
1012                                 $subtitle=~s/ \/$//;
1013                             }
1014                         }
1015                         my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
1016                         my $q_issn=$dbh->quote((($issn) || ('NIL')));
1017                         my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
1018                         my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
1019                         my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
1020                         $sth->execute;
1021                         my $donetext='';
1022                         if ($sth->rows) {
1023                             $donetext="DONE";
1024                         }
1025                         $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
1026                         $sth->execute;
1027                         if ($sth->rows) {
1028                             $donetext="DONE";
1029                         }
1030                         ($author) && ($author="by $author");
1031                         if ($isbn) {
1032                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&isbn=$isbn>$title $subtitle $author</a> $donetext<br>\n";
1033                         } elsif ($lccn) {
1034                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&lccn=$lccn>$title $subtitle $author</a> $donetext<br>\n";
1035                         } elsif ($issn) {
1036                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&issn=$issn>$title $subtitle $author</a><br> $donetext\n";
1037                         } elsif ($controlnumber) {
1038                             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&controlnumber=$controlnumber>$title $subtitle $author</a><br> $donetext\n";
1039                         } else {
1040                             print "Error: Contact steve regarding $title by $author<br>\n";
1041                         }
1042                     }
1043                     print "<p>\n";
1044                 } else {
1045                     print "No records returned.<p>\n";
1046                 }
1047                 print "</ul>\n";
1048             }
1049             my $elapsed=time()-$starttimer;
1050             print "<hr>It took $elapsed seconds to process this page.\n";
1051         } else {
1052             my $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
1053             $sth->execute;
1054             ($data, $name) = $sth->fetchrow;
1055             print << "EOF";
1056 <center>
1057 <p>
1058 <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a>
1059 <p>
1060 <table border=0 cellpadding=10 cellspacing=0>
1061 <tr><th bgcolor=black><font color=white>Select a Record to Import<br>from $name</font></th></tr>
1062 <tr><td bgcolor=#dddddd>
1063 EOF
1064
1065             my @records=parsemarcdata($data);
1066             foreach $record (@records) {
1067                 my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $controlnumber);
1068                 foreach $field (@$record) {
1069                     if ($field->{'tag'} eq '001') {
1070                         $controlnumber=$field->{'indicator'};
1071                     }
1072                     if ($field->{'tag'} eq '010') {
1073                         $lccn=$field->{'subfields'}->{'a'};
1074                         $lccn=~s/^\s*//;
1075                         ($lccn) = (split(/\s+/, $lccn))[0];
1076                     }
1077                     if ($field->{'tag'} eq '015') {
1078                         $lccn=$field->{'subfields'}->{'a'};
1079                         $lccn=~s/^\s*//;
1080                         $lccn=~s/^C//;
1081                         ($lccn) = (split(/\s+/, $lccn))[0];
1082                     }
1083                     if ($field->{'tag'} eq '020') {
1084                         $isbn=$field->{'subfields'}->{'a'};
1085                         ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]);
1086                         $isbn=~s/[^\d]*//g;
1087                     }
1088                     if ($field->{'tag'} eq '022') {
1089                         $issn=$field->{'subfields'}->{'a'};
1090                         $issn=~s/^\s*//;
1091                         ($issn) = (split(/\s+/, $issn))[0];
1092                     }
1093                     if ($field->{'tag'} eq '100') {
1094                         $author=$field->{'subfields'}->{'a'};
1095                     }
1096                     if ($field->{'tag'} eq '245') {
1097                         $title=$field->{'subfields'}->{'a'};
1098                         $title=~s/ \/$//;
1099                         $subtitle=$field->{'subfields'}->{'b'};
1100                         $subtitle=~s/ \/$//;
1101                     }
1102                 }
1103                 my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
1104                 my $q_issn=$dbh->quote((($issn) || ('NIL')));
1105                 my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
1106                 my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL')));
1107                 my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber");
1108                 $sth->execute;
1109                 my $donetext='';
1110                 if ($sth->rows) {
1111                     $donetext="DONE";
1112                 }
1113                 $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn");
1114                 $sth->execute;
1115                 if ($sth->rows) {
1116                     $donetext="DONE";
1117                 }
1118                 ($author) && ($author="by $author");
1119                 if ($isbn) {
1120                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&isbn=$isbn>$title$subtitle $author</a> $donetext<br>\n";
1121                 } elsif ($lccn) {
1122                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&lccn=$lccn>$title$subtitle $author</a> $donetext<br>\n";
1123                 } elsif ($issn) {
1124                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&issn=$issn>$title$subtitle $author</a><br> $donetext\n";
1125                 } elsif ($controlnumber) {
1126                     print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&controlnumber=$controlnumber>$title by $author</a><br> $donetext\n";
1127                 } else {
1128                     print "Error: Contact steve regarding $title by $author<br>\n";
1129                 }
1130             }
1131         }
1132         print "</td></tr></table>\n";
1133     }
1134 } else {
1135
1136 SWITCH:
1137     {
1138         if ($menu eq 'z3950') { z3950(); last SWITCH; }
1139         if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; }
1140         if ($menu eq 'manual') { manual(); last SWITCH; }
1141         mainmenu();
1142     }
1143
1144 }
1145
1146
1147 sub z3950 {
1148     my $sth=$dbh->prepare("select id,term,type,done,numrecords,length(results),startdate,enddate,servers from z3950queue order by id desc limit 20");
1149     $sth->execute;
1150     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
1151     print "<table border=0><tr><td valign=top>\n";
1152     print "<h2>Results of Z39.50 searches</h2>\n";
1153     print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n<ul>\n";
1154     while (my ($id, $term, $type, $done, $numrecords, $length, $startdate, $enddate, $servers) = $sth->fetchrow) {
1155         $type=uc($type);
1156         $term=~s/</&lt;/g;
1157         $term=~s/>/&gt;/g;
1158         my $sti=$dbh->prepare("select id,server,startdate,enddate,numrecords from z3950results where queryid=$id");
1159         $sti->execute;
1160         if ($sti->rows) {
1161             my $processing=0;
1162             my $realenddate=0;
1163             my $totalrecords=0;
1164             while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords) = $sti->fetchrow) {
1165                 if ($r_enddate==0) {
1166                     $processing=1;
1167                 } else {
1168                     if ($r_enddate>$realenddate) {
1169                         $realenddate=$r_enddate;
1170                     }
1171                 }
1172
1173                 $totalrecords+=$r_numrecords;
1174             }
1175             if ($processing) {
1176                 my $elapsed=time()-$startdate;
1177                 my $elapsedtime='';
1178                 if ($elapsed>60) {
1179                     $elapsedtime=sprintf "%d minutes",($elapsed/60);
1180                 } else {
1181                     $elapsedtime=sprintf "%d seconds",$elapsed;
1182                 }
1183                 if ($totalrecords) {
1184                     $totalrecords="$totalrecords found.";
1185                 } else {
1186                     $totalrecords='';
1187                 }
1188                 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";
1189             } else {
1190                 my $elapsed=$realenddate-$startdate;
1191                 my $elapsedtime='';
1192                 if ($elapsed>60) {
1193                     $elapsedtime=sprintf "%d minutes",($elapsed/60);
1194                 } else {
1195                     $elapsedtime=sprintf "%d seconds",$elapsed;
1196                 }
1197                 if ($totalrecords) {
1198                     $totalrecords="$totalrecords found.";
1199                 } else {
1200                     $totalrecords='';
1201                 }
1202                 print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Done. $totalrecords ($elapsedtime)</font><br>\n";
1203             }
1204         } else {
1205             print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Pending</font><br>\n";
1206         }
1207     }
1208     print "</ul>\n";
1209     print "</td><td valign=top width=30%>\n";
1210     my $sth=$dbh->prepare("select id,name,checked from z3950servers order by rank");
1211     $sth->execute;
1212     my $serverlist='';
1213     while (my ($id, $name, $checked) = $sth->fetchrow) {
1214         ($checked) ? ($checked='checked') : ($checked='');
1215         $serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n";
1216     }
1217     $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n";
1218
1219     my $rand=rand(1000000000);
1220 print << "EOF";
1221     <form action=$ENV{'SCRIPT_NAME'} method=GET>
1222     <input type=hidden name=z3950queue value=1>
1223     <input type=hidden name=menu value=$menu>
1224     <p>
1225     <input type=hidden name=test value=testvalue>
1226     <input type=hidden name=rand value=$rand>
1227     <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr>
1228     <tr><td>Query Term</td><td><input name=query></td></tr>
1229     <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>
1230     <tr><td colspan=2>
1231     $serverlist
1232     </td></tr>
1233     <tr><td colspan=2 align=center>
1234     <input type=submit>
1235     </td></tr>
1236     </table>
1237
1238     </form>
1239 EOF
1240 print "</td></tr></table>\n";
1241 }
1242
1243 sub uploadmarc {
1244     print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
1245     my $sth=$dbh->prepare("select id,name from uploadedmarc");
1246     $sth->execute;
1247     print "<h2>Select a set of MARC records</h2>\n<ul>";
1248     while (my ($id, $name) = $sth->fetchrow) {
1249         print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
1250     }
1251     print "</ul>\n";
1252     print "<p>\n";
1253     print "<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb
1254     colspan=2>Upload a set of MARC records</th></tr>\n";
1255     print "<tr><td>Upload a set of MARC records:</td><td>";
1256     print $input->start_multipart_form();
1257     print $input->filefield('uploadmarc');
1258     print << "EOF";
1259     </td></tr>
1260     <tr><td>
1261     <input type=hidden name=menu value=$menu>
1262     Name this set of MARC records:</td><td><input type=text
1263     name=name></td></tr>
1264     <tr><td colspan=2 align=center>
1265     <input type=submit>
1266     </td></tr>
1267     </table>
1268     </form>
1269 EOF
1270 }
1271
1272 sub manual {
1273 }
1274
1275
1276 sub mainmenu {
1277     print << "EOF";
1278 <h1>Main Menu</h1>
1279 <ul>
1280 <li><a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Z39.50 Search</a>
1281 <li><a href=$ENV{'SCRIPT_NAME'}?menu=uploadmarc>Upload MARC Records</a>
1282 </ul>
1283 EOF
1284 }
1285
1286 sub skip {
1287
1288     #opendir(D, "/home/$userid/");
1289     #my @dirlist=readdir D;
1290     #foreach $file (@dirlist) {
1291 #       (next) if ($file=~/^\./);
1292 #       (next) if ($file=~/^nsmail$/);
1293 #       (next) if ($file=~/^public_html$/);
1294 #       ($file=~/\.mrc/) || ($filelist.="$file<br>\n");
1295 #       (next) unless ($file=~/\.mrc$/);
1296 #       $file=~s/ /\%20/g;
1297 #       print "<a href=$ENV{'SCRIPT_NAME'}?file=/home/$userid/$file>$file</a><br>\n";
1298 #    }
1299
1300
1301     #<form action=$ENV{'SCRIPT_NAME'} method=POST enctype=multipart/form-data>
1302
1303 }
1304 print endmenu();
1305 print endpage();
1306
1307 sub parsemarcdata {
1308     my $data=shift;
1309     my $splitchar=chr(29);
1310     my @records;
1311     my $record;
1312     foreach $record (split(/$splitchar/, $data)) {
1313         my $leader=substr($record,0,24);
1314         #print "<tr><td>Leader:</td><td>$leader</td></tr>\n";
1315         $record=substr($record,24);
1316         my $splitchar2=chr(30);
1317         my $directory=0;
1318         my $tagcounter=0;
1319         my %tag;
1320         my @record;
1321         my $field;
1322         foreach $field (split(/$splitchar2/, $record)) {
1323             my %field;
1324             ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
1325             unless ($directory) {
1326                 $directory=$field;
1327                 my $itemcounter=1;
1328                 $counter=0;
1329                 while ($item=substr($directory,0,12)) {
1330                     $tag=substr($directory,0,3);
1331                     $length=substr($directory,3,4);
1332                     $start=substr($directory,7,6);
1333                     $directory=substr($directory,12);
1334                     $tag{$counter}=$tag;
1335                     $counter++;
1336                 }
1337                 $directory=1;
1338                 next;
1339             }
1340             $tag=$tag{$tagcounter};
1341             $tagcounter++;
1342             $field{'tag'}=$tag;
1343             $splitchar3=chr(31);
1344             my @subfields=split(/$splitchar3/, $field);
1345             $indicator=$subfields[0];
1346             $field{'indicator'}=$indicator;
1347             my $firstline=1;
1348             unless ($#subfields==0) {
1349                 my %subfields;
1350                 for ($i=1; $i<=$#subfields; $i++) {
1351                     my $text=$subfields[$i];
1352                     my $subfieldcode=substr($text,0,1);
1353                     my $subfield=substr($text,1);
1354                     if ($subfields{$subfieldcode}) {
1355                         my $subfieldlist=$subfields{$subfieldcode};
1356                         my @subfieldlist=@$subfieldlist;
1357                         if ($#subfieldlist>=0) {
1358 #                       print "$tag Adding to array $subfieldcode -- $subfield<br>\n";
1359                             push (@subfieldlist, $subfield);
1360                         } else {
1361 #                       print "$tag Arraying $subfieldcode -- $subfield<br>\n";
1362                             @subfieldlist=($subfields{$subfieldcode}, $subfield);
1363                         }
1364                         $subfields{$subfieldcode}=\@subfieldlist;
1365                     } else {
1366                         $subfields{$subfieldcode}=$subfield;
1367                     }
1368                 }
1369                 $field{'subfields'}=\%subfields;
1370             }
1371             push (@record, \%field);
1372         }
1373         push (@records, \@record);
1374         $counter++;
1375     }
1376     return @records;
1377 }
1378
1379 #---------------
1380 # Create an HTML option list for a <SELECT> form tag by using
1381 #    values from a DB file
1382 sub GetKeyTableSelectOptions {
1383         # inputs
1384         my (
1385                 $dbh,           # DBI handle
1386                 $tablename,     # name of table containing list of choices
1387                 $keyfieldname,  # column name of code to use in option list
1388                 $descfieldname, # column name of descriptive field
1389                 $showkey,       # flag to show key in description
1390         )=@_;
1391         my $selectclause;       # return value
1392
1393         my (
1394                 $sth, $query,
1395                 $key, $desc, $orderfieldname,
1396         );
1397         my $debug=0;
1398
1399         if ( $showkey ) {
1400                 $orderfieldname=$keyfieldname;
1401         } else {
1402                 $orderfieldname=$descfieldname;
1403         }
1404         $query= "select $keyfieldname,$descfieldname
1405                 from $tablename
1406                 order by $orderfieldname ";
1407         print "<PRE>Query=$query </PRE>\n" if $debug;
1408         $sth=$dbh->prepare($query);
1409         $sth->execute;
1410         while ( ($key, $desc) = $sth->fetchrow) {
1411             if ($showkey) { $desc="$key - $desc"; }
1412             $selectclause.="<option value='$key'>$desc\n";
1413             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1414         }
1415         return $selectclause;
1416 } # sub GetKeyTableSelectOptions