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