acqui.simple/marcimport.pl

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