November 2001 - Koha-devel - lists.koha-community.org

CVS: koha/C4 Catalogue.pm,1.10,1.11
by Steve Tonnesen 06 Nov '01

06 Nov '01

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv7968 Modified Files: Catalogue.pm Log Message: Working out problems with MARC record support. Index: Catalogue.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Catalogue.pm,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -r1.10 -r1.11 *** Catalogue.pm 2001/11/03 07:29:36 1.10 --- Catalogue.pm 2001/11/06 18:15:34 1.11 *************** *** 137,141 **** } elsif ($Subfield_ID) { # Subfield_ID does not make the record unique. Could be multiple ! # records with the same mark. This is a bad situatoin. my $sth=$dbh->prepare("select Subfield_Key, Subfield_Value from $firstdigit\XX_Subfield_Table where Subfield_Mark='$Subfield_Mark' and Subfield_ID=$Subfield_ID"); $sth->execute; --- 137,141 ---- } elsif ($Subfield_ID) { # Subfield_ID does not make the record unique. Could be multiple ! # records with the same mark. This is a bad situation. my $sth=$dbh->prepare("select Subfield_Key, Subfield_Value from $firstdigit\XX_Subfield_Table where Subfield_Mark='$Subfield_Mark' and Subfield_ID=$Subfield_ID"); $sth->execute; *************** *** 191,195 **** $origadditionalauthors->{$author}=1; } ! $sth=$dbh->prepare("select subject from bibliosubjects where biblionumber=$biblionumber"); $sth->execute; my $origsubjects; --- 191,195 ---- $origadditionalauthors->{$author}=1; } ! $sth=$dbh->prepare("select subject from bibliosubject where biblionumber=$biblionumber"); $sth->execute; my $origsubjects; *************** *** 294,298 **** } else { my $q_newsubject=$dbh->quote($newsubject); ! my $sth=$dbh->prepare("insert into bibliosubjects (subject,biblionumber) values ($q_newsubject, $biblionumber)"); $sth->execute; logchange('kohadb', 'add', 'biblio', 'subject', $newsubject); --- 294,298 ---- } else { my $q_newsubject=$dbh->quote($newsubject); ! my $sth=$dbh->prepare("insert into bibliosubject (subject,biblionumber) values ($q_newsubject, $biblionumber)"); $sth->execute; logchange('kohadb', 'add', 'biblio', 'subject', $newsubject); *************** *** 313,321 **** my $q_origsubject=$dbh->quote($origsubject); logchange('kohadb', 'delete', 'biblio', '$biblionumber', 'subject', $origsubject); ! my $sth=$dbh->prepare("delete from bibliosubjects where biblionumber=$biblionumber and subject=$q_origsubject"); $sth->execute; } } $dbh->disconnect; } --- 313,359 ---- my $q_origsubject=$dbh->quote($origsubject); logchange('kohadb', 'delete', 'biblio', '$biblionumber', 'subject', $origsubject); ! my $sth=$dbh->prepare("delete from bibliosubject where biblionumber=$biblionumber and subject=$q_origsubject"); $sth->execute; } } + sub skip { + # At the moment this is just a straight copy of the subject code. Needs heavy + # modification to work for additional authors, obviously. + # Check for additional author changes + + my $newadditionalauthor=''; + my $additionalauthors; + foreach $newadditionalauthor (@{$biblio->{'additionalauthor'}}) { + $additionalauthors->{$newadditionalauthor}=1; + if ($origadditionalauthors->{$newadditionalauthor}) { + $additionalauthors->{$newadditionalauthor}=2; + } else { + my $q_newadditionalauthor=$dbh->quote($newadditionalauthor); + my $sth=$dbh->prepare("insert into biblioadditionalauthors (additionalauthor,biblionumber) values ($q_newadditionalauthor, $biblionumber)"); + $sth->execute; + logchange('kohadb', 'add', 'biblio', 'additionalauthor', $newadditionalauthor); + my $subfields; + $subfields->{1}->{'Subfield_Mark'}='a'; + $subfields->{1}->{'Subfield_Value'}=$newadditionalauthor; + my $tag='650'; + my $Record_ID; + foreach $Record_ID (@marcrecords) { + addTag($env, $Record_ID, $tag, ' ', ' ', $subfields); + logchange('marc', 'add', $Record_ID, '650', 'a', $newadditionalauthor); + } + } + } + my $origadditionalauthor; + foreach $origadditionalauthor (keys %$origadditionalauthors) { + if ($additionalauthors->{$origadditionalauthor} == 1) { + my $q_origadditionalauthor=$dbh->quote($origadditionalauthor); + logchange('kohadb', 'delete', 'biblio', '$biblionumber', 'additionalauthor', $origadditionalauthor); + my $sth=$dbh->prepare("delete from biblioadditionalauthors where biblionumber=$biblionumber and additionalauthor=$q_origadditionalauthor"); + $sth->execute; + } + } + + } $dbh->disconnect; } *************** *** 330,334 **** my $original=shift; my $new=shift; ! print "KOHA: $type $section $item $original $new\n"; } elsif ($database eq 'marc') { my $type=shift; --- 368,372 ---- my $original=shift; my $new=shift; ! print STDERR "KOHA: $type $section $item $original $new\n"; } elsif ($database eq 'marc') { my $type=shift; *************** *** 339,343 **** my $original=shift; my $new=shift; ! print "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n"; } } --- 377,381 ---- my $original=shift; my $new=shift; ! print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n"; } }

1 0

CVS: koha/acqui.simple addbookslccn.pl,NONE,1.1
by Steve Tonnesen 06 Nov '01

06 Nov '01

Update of /cvsroot/koha/koha/acqui.simple In directory usw-pr-cvs1:/tmp/cvs-serv7658 Added Files: addbookslccn.pl Log Message: Modified version of addbooks.pl that uses LCCN as base identifier instead of ISBN. Should probably be merged with addbooks.pl so that the user can enter either and ISBN _or_ and LCCN from the same form. --- NEW FILE --- #!/usr/bin/perl # # TODO # # Add info on biblioitems and items already entered as you enter new ones # use C4::Database; use CGI; use strict; use C4::Acquisitions; use C4::Output; my $input = new CGI; my $dbh=C4Connect; my $lccn=$input->param('lccn'); my $q_lccn=$dbh->quote($lccn); my $biblioitemnumber; print $input->header; print startpage(); print startmenu('acquisitions'); ($input->param('checkforbiblio')) && (checkforbiblio()); ($input->param('newbiblioitem')) && (newbiblioitem()); ($input->param('newitem')) && (newitem()); sub checkforbiblio { my $title=$input->param('title'); my $q_title=$dbh->quote($title); my $author=$input->param('author'); my $q_author=$dbh->quote($author); my $seriestitle=$input->param('seriestitle'); my $serial=0; ($seriestitle) && ($serial=1); my $q_seriestitle=$dbh->quote($seriestitle); my $copyrightdate=$input->param('copyrightdate'); my $q_copyrightdate=$dbh->quote($copyrightdate); my $notes=$input->param('notes'); my $q_notes=$dbh->quote($notes); my $subtitle=$input->param('subtitle'); my $q_subtitle=$dbh->quote($subtitle); my $sth=$dbh->prepare("select biblionumber from biblio where title=$q_title and author=$q_author and copyrightdate=$q_copyrightdate"); $sth->execute; my $biblionumber=0; if ($sth->rows) { ($biblionumber) = $sth->fetchrow; } else { print "Adding new biblio for <i>$title</i> by $author<br>\n"; my $sth=$dbh->prepare("select max(biblionumber) from biblio"); $sth->execute; ($biblionumber) = $sth->fetchrow; $biblionumber++; $sth=$dbh->prepare("insert into biblio (biblionumber, title, author, serial, seriestitle, copyrightdate, notes) values ($biblionumber, $q_title, $q_author, $serial, $q_seriestitle, $q_copyrightdate, $q_notes)"); $sth->execute; $sth=$dbh->prepare("insert into bibliosubtitle (subtitle, biblionumber) values ($q_subtitle, $biblionumber)"); $sth->execute; } my $itemtypeselect=''; $sth=$dbh->prepare("select itemtype,description from itemtypes"); $sth->execute; while (my ($itemtype, $description) = $sth->fetchrow) { $itemtypeselect.="<option value=$itemtype>$itemtype - $description\n"; } my $authortext="by $author"; ($author) || ($authortext=''); sectioninfo(); $sth=$dbh->prepare("select BI.isbn,IT.description,BI.volume,BI.number,BI.volumeddesc,BI.dewey,BI.subclass from biblioitems BI, itemtypes IT where BI.itemtype=IT.itemtype and biblionumber=$biblionumber"); $sth->execute; my $biblioitemdata=''; while (my ($isbn, $itemtype, $volume, $number, $volumeddesc, $dewey, $subclass) = $sth->fetchrow) { my $volumeinfo=''; if ($volume) { if ($number) { $volumeinfo="V$volume, N$number"; } else { $volumeinfo="Vol $volume"; } } if ($volumeddesc) { $volumeinfo.=" $volumeddesc"; } $dewey=~s/0*$//; $biblioitemdata.="<tr><td>$isbn</td><td align=center>$itemtype</td><td align=center>$volumeinfo</td><td align=center>$dewey$subclass</td></tr>\n"; } if ($biblioitemdata) { print << "EOF"; <center> <p> <table border=1 bgcolor=#dddddd> <tr> <th colspan=4>Existing entries using Biblio number $biblionumber</th> </tr> <tr> <th>ISBN</th><th>Item Type</th><th>Volume</th><th>Classification</th></tr> $biblioitemdata </table> </center> EOF } print << "EOF"; <center> <form> <table border=1 bgcolor=#dddddd> <tr><th colspan=4>Section Two: Publication Information for<br><i>$title</i> $authortext</th></tr> <tr><td align=right>Publisher</td><td colspan=3><input name=publishercode size=30></td></tr> <tr><td align=right>Publication Year</td><td><input name=publicationyear size=10></td> <td align=right>Place of Publication</td><td><input name=place size=20></td></tr> <tr><td align=right>Illustrator</td><td colspan=3><input name=illus size=20></td></tr> <tr><td align=right>Additional Authors<br>(One author per line)</td><td colspan=3><textarea name=additionalauthors rows=4 cols=30></textarea></td></tr> <tr><td align=right>Subject Headings<br>(One subject per line)</td><td colspan=3><textarea name=subjectheadings rows=4 cols=30></textarea></td></tr> <tr><td align=right>Item Type</td><td colspan=3><select name=itemtype>$itemtypeselect</select></td></tr> <tr><td align=right>Dewey</td><td><input name=dewey size=10></td> <td align=right>Dewey Subclass</td><td><input name=subclass size=10></td></tr> <tr><td align=right>ISSN</td><td colspan=3><input name=issn size=10></td></tr> <tr><td align=right>ISBN</td><td colspan=3><input name=isbn size=10></td></tr> <tr><td align=right>Volume</td><td><input name=volume size=10></td> <td align=right>Number</td><td><input name=number size=10></td></tr> <tr><td align=right>Volume Description</td><td colspan=3><input name=volumeddesc size=40></td></tr> <tr><td align=right>Pages</td><td><input name=pages size=10></td> <td align=right>Size</td><td><input name=size size=10></td></tr> <tr><td align=right>Notes</td><td colspan=3><textarea name=notes rows=4 cols=50 wrap=physical></textarea></td></tr> </table> <input type=submit value="Add New Bibliography Item"> </center> <input type=hidden name=biblionumber value=$biblionumber> <input type=hidden name=lccn value=$lccn> <input type=hidden name=newbiblioitem value=1> </form> EOF print endmenu(); print endpage(); exit; } sub newbiblioitem { my $biblionumber=$input->param('biblionumber'); my $volume=$input->param('volume'); my $q_volume=$dbh->quote($volume); my $number=$input->param('number'); my $q_number=$dbh->quote($number); my $classification=$input->param('classification'); my $q_classification=$dbh->quote($classification); my $itemtype=$input->param('itemtype'); my $q_itemtype=$dbh->quote($itemtype); my $issn=$input->param('issn'); my $q_issn=$dbh->quote($issn); my $isbn=$input->param('isbn'); my $q_isbn=$dbh->quote($isbn); my $dewey=$input->param('dewey'); my $q_dewey=$dbh->quote($dewey); my $subclass=$input->param('subclass'); my $q_subclass=$dbh->quote($subclass); my $publicationyear=$input->param('publicationyear'); my $q_publicationyear=$dbh->quote($publicationyear); my $publishercode=$input->param('publishercode'); my $q_publishercode=$dbh->quote($publishercode); my $volumedate=$input->param('volumedate'); my $q_volumedate=$dbh->quote($volumedate); my $volumeddesc=$input->param('volumeddesc'); my $q_volumeddesc=$dbh->quote($volumeddesc); my $illus=$input->param('illus'); my $q_illus=$dbh->quote($illus); my $pages=$input->param('pages'); my $q_pages=$dbh->quote($pages); my $notes=$input->param('notes'); my $q_notes=$dbh->quote($notes); my $size=$input->param('size'); my $q_size=$dbh->quote($size); my $place=$input->param('place'); my $q_place=$dbh->quote($place); my $subjectheadings=$input->param('subjectheadings'); my $additionalauthors=$input->param('additionalauthors'); my $sth=$dbh->prepare("select max(biblioitemnumber) from biblioitems"); $sth->execute; ($biblioitemnumber) = $sth->fetchrow; $biblioitemnumber++; ($q_lccn='') if ($q_lccn eq 'NULL'); $sth=$dbh->prepare("insert into biblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype, isbn, issn, lccn, dewey, subclass, publicationyear, publishercode, volumedate, volumeddesc, illus, pages, notes, size, place) values ($biblioitemnumber, $biblionumber, $q_volume, $q_number, $q_classification, $q_itemtype, $q_isbn, $q_issn, $q_lccn, $q_dewey, $q_subclass, $q_publicationyear, $q_publishercode, $q_volumedate, $q_volumeddesc, $q_illus, $q_pages, $q_notes, $q_size, $q_place)"); $sth->execute; my @subjectheadings=split(/\n/,$subjectheadings); my $subjectheading; foreach $subjectheading (@subjectheadings) { # remove any line ending characters (Ctrl-J or M) $subjectheading=~s/\013//g; $subjectheading=~s/\010//g; # convert to upper case $subjectheading=uc($subjectheading); print STDERR "S: $biblionumber, $subjectheading "; chomp ($subjectheading); print STDERR "B: ".ord(substr($subjectheading, length($subjectheading)-1, 1))." "; while (ord(substr($subjectheading, length($subjectheading)-1, 1))<14) { chop $subjectheading; } print STDERR "A: ".ord(substr($subjectheading, length($subjectheading)-1, 1))."\n"; # quote value my $q_subjectheading=$dbh->quote($subjectheading); $sth=$dbh->prepare("insert into bibliosubject (biblionumber,subject) values ($biblionumber, $q_subjectheading)"); $sth->execute; } my @additionalauthors=split(/\n/,$additionalauthors); my $additionalauthor; foreach $additionalauthor (@additionalauthors) { # remove any line ending characters (Ctrl-L or Ctrl-M) $additionalauthor=~s/\013//g; $additionalauthor=~s/\010//g; # convert to upper case $additionalauthor=uc($additionalauthor); # quote value my $q_additionalauthor=$dbh->quote($additionalauthor); $sth=$dbh->prepare("insert into additionalauthors (biblionumber,author) values ($biblionumber, $q_additionalauthor)"); $sth->execute; } } sub newitem { my $biblionumber=$input->param('biblionumber'); my $biblioitemnumber=$input->param('biblioitemnumber'); my $barcode=$input->param('barcode'); my $itemnotes=$input->param('notes'); my $q_itemnotes=$dbh->quote($itemnotes); my $replacementprice=$input->param('replacementprice'); ($replacementprice) || ($replacementprice=0); my $sth=$dbh->prepare("select max(itemnumber) from items"); $sth->execute; my ($itemnumber) = $sth->fetchrow; $itemnumber++; my @datearr=localtime(time); my $date=(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; my $q_homebranch=$dbh->quote($input->param('homebranch')); $sth=$dbh->prepare("insert into items (itemnumber, biblionumber, biblioitemnumber,barcode, itemnotes, holdingbranch, homebranch, dateaccessioned, replacementprice) values ($itemnumber, $biblionumber, $biblioitemnumber, $barcode, $q_itemnotes, 'STWE', $q_homebranch, '$date', $replacementprice)"); $sth->execute; } if ($lccn) { my $sth; if ($lccn eq 'NULL') { $sth=$dbh->prepare("select biblionumber,biblioitemnumber from biblioitems where biblioitemnumber=$biblioitemnumber"); } else { $sth=$dbh->prepare("select biblionumber,biblioitemnumber from biblioitems where lccn=$q_lccn"); } $sth->execute; if (my ($biblionumber, $biblioitemnumber) = $sth->fetchrow) { sectioninfo(); $sth=$dbh->prepare("select I.barcode,I.itemnotes,B.title,B.author from items I, biblio B where B.biblionumber=I.biblionumber and biblioitemnumber=$biblioitemnumber"); $sth->execute; my $itemdata=''; while (my ($barcode, $itemnotes, $title, $author) = $sth->fetchrow) { $itemdata.="<tr><td align=center>$barcode</td><td><u>$title</u></td><td>$author</td><td>$itemnotes</td></tr>\n"; } if ($itemdata) { print << "EOF"; <center> <p> <table border=1 bgcolor=#dddddd> <tr> <th colspan=4>Existing Items with LCCN $lccn</th> </tr> <tr> <th>Barcode</th><th>Title</th><th>Author</th><th>Notes</th></tr> $itemdata </table> </center> EOF } my $sth=$dbh->prepare("select max(barcode) from items"); $sth->execute; my ($maxbarcode) = $sth->fetchrow; $maxbarcode++; print << "EOF"; <center> <h2>Section Three: Specific Item Information</h2> <form> <input type=hidden name=newitem value=1> <input type=hidden name=biblionumber value=$biblionumber> <input type=hidden name=biblioitemnumber value=$biblioitemnumber> <table> <tr><td>BARCODE</td><td><input name=barcode size=10 value=$maxbarcode> Home Branch: <select name=homebranch><option value='STWE'>Stewart Elementary<option value='MEZ'>Meziadin Elementary</select></td></tr> </tr><td colspan=2>Replacement Price: <input name=replacementprice size=10></td></tr> <tr><td>Notes</td><td><textarea name=notes rows=4 cols=40 wrap=physical></textarea></td></tr> </table> <input type=submit value="Add Item"> </form> <h3>LCCN $lccn Information</h3> </center> EOF } else { sectioninfo(); print << "EOF"; <center> <form> <input type=hidden name=lccn value='$lccn'> <input type=hidden name=checkforbiblio value=1> <table border=0> <tr><th colspan=2>Section One: Copyright Information</th></tr> <tr><td>Title</td><td><input name=title size=40></td></tr> <tr><td>Subtitle</td><td><input name=subtitle size=40></td></tr> <tr><td>Author</td><td><input name=author size=40></td></tr> <tr><td>Series Title<br>(if applicable)</td><td><input name=seriestitle size=40></td></tr> <tr><td>Copyright Date</td><td><input name=copyrightdate size=10></td></tr> <tr><td>Notes</td><td><textarea name=notes rows=4 cols=40 wrap=physical></textarea></td></tr> </table> <input type=submit value="Add new Bibliography"> </center> EOF } } else { print << "EOF"; <h2>Adding new items to the Library Inventory</h2> To add a new item, scan or type the LCCN number: <br> <form> LCCN: <input name=lccn> </form> <p> <a href=addbooks.pl?lccn=NULL>Enter book with no LCCN</a> <hr> Or use the <a href=marcimport.pl>MARC Importing tool</a> EOF } print endmenu(); print endpage(); sub sectioninfo { print << "EOF"; <center> <table border=1 width=70% bgcolor=#bbddbb> <tr> <td> <center> Koha stores data in three sections. </center> <ol> <li>The first section records bibliographic data such as title, author and copyright for a particular work. <li>The second records bibliographic data for a particular publication of that work, such as ISBN number, physical description, publisher information, etc. <li>The third section holds specific item information, such as the bar code number. </ul> </td> </tr> </table> </center> EOF }

1 0

CVS: koha/acqui.simple marcimport.pl,1.4,1.5 processz3950queue,1.1,1.2
by Steve Tonnesen 06 Nov '01

06 Nov '01

Update of /cvsroot/koha/koha/acqui.simple In directory usw-pr-cvs1:/tmp/cvs-serv6588 Modified Files: marcimport.pl processz3950queue Log Message: Continuing work on Z39.50 search tool. Daemon now forks up to 12 processes to do Z39.50 searches. Daemon will also wait to see if the user looks beyond the first couple of pages of results, and will download more results if necessary. Index: marcimport.pl =================================================================== RCS file: /cvsroot/koha/koha/acqui.simple/marcimport.pl,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -r1.4 -r1.5 *** marcimport.pl 2001/11/03 07:28:20 1.4 --- marcimport.pl 2001/11/06 18:13:59 1.5 *************** *** 134,139 **** chop $serverlist; my $q_serverlist=$dbh->quote($serverlist); ! my $sth=$dbh->prepare("insert into z3950queue (term,type,servers) values ($q_term, '$type', $q_serverlist)"); $sth->execute; } } --- 134,145 ---- chop $serverlist; my $q_serverlist=$dbh->quote($serverlist); ! my $rand=$input->param('rand'); ! my $sth=$dbh->prepare("select identifier from z3950queue where ! identifier=$rand"); $sth->execute; + unless ($sth->rows) { + $sth=$dbh->prepare("insert into z3950queue (term,type,servers, identifier) values ($q_term, '$type', $q_serverlist, '$rand')"); + $sth->execute; + } } } *************** *** 696,707 **** my ($servers) = $sth->fetchrow; my $serverstring; foreach $serverstring (split(/\s+/, $servers)) { my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4); if ($name eq 'MAN') { print "$server/$database<br>\n"; - } elsif ($name eq 'LOC') { - print "Library of Congress<br>\n"; - } elsif ($name eq 'NLC') { - print "National Library of Canada<br>\n"; } else { my $sti=$dbh->prepare("select name from --- 702,710 ---- my ($servers) = $sth->fetchrow; my $serverstring; + my $starttimer=time(); foreach $serverstring (split(/\s+/, $servers)) { my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4); if ($name eq 'MAN') { print "$server/$database<br>\n"; } else { my $sti=$dbh->prepare("select name from *************** *** 709,719 **** $sti->execute; my ($longname)=$sti->fetchrow; ! print "$longname<br>\n"; } - print "<ul>\n"; my $q_server=$dbh->quote($serverstring); my $sti=$dbh->prepare("select numrecords,id,results,startdate,enddate from z3950results where queryid=$id and server=$q_server"); $sti->execute; ($numrecords,$resultsid,$data,$startdate,$enddate) = $sti->fetchrow; if ($sti->rows == 0) { print "pending..."; --- 712,755 ---- $sti->execute; my ($longname)=$sti->fetchrow; ! print "<a name=SERVER-$name></a>\n"; ! if ($longname) { ! print "$longname \n"; ! } else { ! print "$server/$database \n"; ! } } my $q_server=$dbh->quote($serverstring); + my $startrecord=$input->param("ST-$name"); + ($startrecord) || ($startrecord='0'); my $sti=$dbh->prepare("select numrecords,id,results,startdate,enddate from z3950results where queryid=$id and server=$q_server"); $sti->execute; ($numrecords,$resultsid,$data,$startdate,$enddate) = $sti->fetchrow; + my $serverplaceholder=''; + foreach ($input->param) { + (next) unless (/ST-(.+)/); + my $serverid=$1; + (next) if ($serverid eq $name); + my $place=$input->param("ST-$serverid"); + $serverplaceholder.="\&ST-$serverid=$place"; + } + if ($numrecords) { + my $previous=''; + my $next=''; + if ($startrecord>0) { + $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$name=".($startrecord-10)."#SERVER-$name>Previous</a>"; + } + my $highest; + $highest=$startrecord+10; + ($highest>$numrecords) && ($highest=$numrecords); + if ($numrecords>$startrecord+10) { + $next="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$name=$highest#SERVER-$name>Next</a>"; + } + print "<font size=-1>[Viewing ".($startrecord+1)." to ".$highest." of $numrecords records] $previous | $next </font><br>\n"; + } else { + print "<br>\n"; + } + print "<ul>\n"; + my $stj=$dbh->prepare("update z3950results set highestseen=".($startrecord+10)." where id=$resultsid"); + $stj->execute; if ($sti->rows == 0) { print "pending..."; *************** *** 729,734 **** print "<font color=red>processing... ($elapsedtime)</font>"; } elsif ($numrecords) { ! my @records=parsemarcdata($data); foreach $record (@records) { my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber); foreach $field (@$record) { --- 765,779 ---- print "<font color=red>processing... ($elapsedtime)</font>"; } elsif ($numrecords) { ! my $splitchar=chr(29); ! my @records=split(/$splitchar/, $data); ! $data=''; ! for ($i=$startrecord; $i<$startrecord+10; $i++) { ! $data.=$records[$i].$splitchar; ! } ! @records=parsemarcdata($data); ! my $counter=0; foreach $record (@records) { + $counter++; + #(next) unless ($counter>=$startrecord && $counter<=$startrecord+10); my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber); foreach $field (@$record) { *************** *** 801,804 **** --- 846,851 ---- print "</ul>\n"; } + my $elapsed=time()-$starttimer; + print "<hr>It took $elapsed seconds to process this page.\n"; } else { my $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file"); *************** *** 908,935 **** $term=~s/</</g; $term=~s/>/>/g; ! if ($done == 1) { ! my $elapsed=$enddate-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); ! } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; ! } ! if ($numrecords) { ! 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"; ! } else { ! 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"; } ! } elsif ($done == -1) { ! my $elapsed=time()-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; } - 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"; } else { ! print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> $done <font size=-1>Pending</font><br>\n"; } } --- 955,1006 ---- $term=~s/</</g; $term=~s/>/>/g; ! my $sti=$dbh->prepare("select id,server,startdate,enddate,numrecords from z3950results where queryid=$id"); ! $sti->execute; ! if ($sti->rows) { ! my $processing=0; ! my $realenddate=0; ! my $totalrecords=0; ! while (my ($r_id,$r_server,$r_startdate,$r_enddate,$r_numrecords) = $sti->fetchrow) { ! if ($r_enddate==0) { ! $processing=1; ! } else { ! if ($r_enddate>$realenddate) { ! $realenddate=$r_enddate; ! } ! } ! ! $totalrecords+=$r_numrecords; } ! if ($processing) { ! my $elapsed=time()-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); ! } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; ! } ! if ($totalrecords) { ! $totalrecords="$totalrecords found."; ! } else { ! $totalrecords=''; ! } ! 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"; } else { ! my $elapsed=$realenddate-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); ! } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; ! } ! if ($totalrecords) { ! $totalrecords="$totalrecords found."; ! } else { ! $totalrecords=''; ! } ! print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Done. $totalrecords ($elapsedtime)</font><br>\n"; } } else { ! print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> <font size=-1>Pending</font><br>\n"; } } *************** *** 945,948 **** --- 1016,1020 ---- $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n"; + my $rand=rand(1000000000); print << "EOF"; <form action=$ENV{'SCRIPT_NAME'} method=GET> *************** *** 951,957 **** <p> <input type=hidden name=test value=testvalue> <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr> <tr><td>Query Term</td><td><input name=query></td></tr> ! <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> <tr><td colspan=2> $serverlist --- 1023,1030 ---- <p> <input type=hidden name=test value=testvalue> + <input type=hidden name=rand value=$rand> <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr> <tr><td>Query Term</td><td><input name=query></td></tr> ! <tr><td colspan=2 align=center><input type=radio name=type value=isbn checked> ISBN <input type=radio name=type value=lccn> LCCN<br><input type=radio name=type value=author> Author <input type=radio name=type value=title> Title <input type=radio name=type value=keyword> Keyword</td></tr> <tr><td colspan=2> $serverlist Index: processz3950queue =================================================================== RCS file: /cvsroot/koha/koha/acqui.simple/processz3950queue,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** processz3950queue 2001/11/02 21:40:01 1.1 --- processz3950queue 2001/11/06 18:13:59 1.2 *************** *** 5,58 **** use C4::Acquisitions; use C4::Output; my $dbh=C4Connect; ! while (1) { ! my $sth=$dbh->prepare("select id,term,type,servers from z3950queue where ! isnull(done) || done=-1"); ! $sth->execute; ! while (my ($id, $term, $type, $servers) = $sth->fetchrow) { ! my $now=time(); ! my $sti=$dbh->prepare("update z3950queue set done=-1,startdate=$now where id=$id"); ! $sti->execute; ! my $attr=''; ! if ($type eq 'isbn') { ! $attr='1=7'; ! } elsif ($type eq 'title') { ! $attr='1=4'; ! } elsif ($type eq 'lccn') { ! $attr='1=9'; ! } ! $term='"'.$term.'"'; ! $query="f \@attr $attr $term"; ! my $totalrecords=0; ! my $serverinfo; ! foreach $serverinfo (split(/\s+/, $servers)) { ! my ($name, $server, $database, $auth) = split(/\//, $serverinfo, 4); ! ($auth eq '/') && ($auth=''); ! print "Processing $type=$term at $name $server $database $auth\n"; ! $now=time(); ! my $q_serverinfo=$dbh->quote($serverinfo); ! my $sti=$dbh->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)"); ! $sti->execute; ! my $resultsid=$dbh->{'mysql_insertid'}; ! getrecord($server, $database, $query, $auth); ! my $result=`cat yaz.mrc`; ! unlink ('yaz.mrc'); ! my $splitchar=chr(29); ! my @records=split(/$splitchar/, $result); ! my $numrecords=$#records+1; ! $totalrecords+=$numrecords; ! my $q_result=$dbh->quote($result); ! ($q_result) || ($q_result='""'); ! $now=time(); ! $sti=$dbh->prepare("update z3950results set numrecords=$numrecords,results=$q_result,enddate=$now where id=$resultsid"); ! $sti->execute; } ! $sti=$dbh->prepare("update z3950queue set done=1,numrecords=$totalrecords,enddate=$now where id=$id"); ! $sti->execute; } ! sleep 15; } --- 5,208 ---- use C4::Acquisitions; use C4::Output; + use Net::Z3950; my $dbh=C4Connect; + my $sth=$dbh->prepare("update z3950results set active=0"); + $sth->execute; + $sth->finish; + $SIG{CHLD}='reap'; ! my $reapcounter=0; ! my $forkcounter=0; ! my $pid=$$; ! my $lastrun=0; while (1) { ! if ((time-$lastrun)>5) { ! my $sth=$dbh->prepare("select id,term,type,servers from z3950queue order by id"); ! $sth->execute; ! while (my ($id, $term, $type, $servers) = $sth->fetchrow) { ! if ($forkcounter<12) { ! my $now=time(); ! $stk=$dbh->prepare("select id,server,startdate,enddate,numrecords,active from z3950results where queryid=$id"); ! $stk->execute; ! my %serverdone; ! unless ($stk->rows) { ! my $sti=$dbh->prepare("update z3950queue set done=-1,startdate=$now where id=$id"); ! $sti->execute; ! } ! while (my ($r_id, $r_server,$r_startdate,$r_enddate,$r_numrecords,$active) = $stk->fetchrow) { ! if ($r_enddate >0) { ! $serverdone{$r_server}=1; ! } elsif ($active) { ! $serverdone{$r_server}=1; ! } else { ! $serverdone{$r_server}=-1; ! } ! } ! ! $stk->finish; ! my $attr=''; ! if ($type eq 'isbn') { ! $attr='1=7'; ! } elsif ($type eq 'title') { ! $attr='1=4'; ! } elsif ($type eq 'author') { ! $attr='1=1003'; ! } elsif ($type eq 'lccn') { ! $attr='1=9'; ! } elsif ($type eq 'keyword') { ! $attr='1=1016'; ! } ! $term='"'.$term.'"'; ! $query="\@attr $attr $term"; ! my $totalrecords=0; ! my $serverinfo; ! my $stillprocessing=0; ! foreach $serverinfo (split(/\s+/, $servers)) { ! (next) if ($serverdone{$serverinfo} == 1); ! my $stillprocessing=1; ! if (my $pid=fork()) { ! $forkcounter++; ! } else { ! #$sth->finish; ! #$sti->finish; ! #$dbh->disconnect; ! my $dbi=C4Connect; ! my ($name, $server, $database, $user, $password) = split(/\//, $serverinfo, 5); ! $server=~/(.*)\:(\d+)/; ! my $servername=$1; ! my $port=$2; ! print "Processing $type=$term at $name $server $database (".($forkcounter+1)." forks)\n"; ! $now=time(); ! my $q_serverinfo=$dbi->quote($serverinfo); ! my $resultsid; ! if ($serverdone{$serverinfo}==-1) { ! my $stj=$dbi->prepare("select id from z3950results where server=$q_serverinfo and queryid=$id"); ! $stj->execute; ! ($resultsid) = $stj->fetchrow; ! } else { ! my $stj=$dbi->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)"); ! $stj->execute; ! $resultsid=$dbi->{'mysql_insertid'}; ! } ! my $stj=$dbh->prepare("update z3950results set active=1 where id=$resultsid"); ! $stj->execute; ! my $conn; ! my $noconnection=0; ! if ($user) { ! eval { $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database, user => $user, password => $password); }; ! if ($@) { ! $noconnection=1; ! } ! pe(); ! } else { ! eval { $conn= new Net::Z3950::Connection($servername, $port, databaseName => $database); }; ! if ($@) { ! $noconnection=1; ! } ! pe(); ! } ! if ($noconnection) { ! } else { ! my $rs=$conn->search($query); ! pe(); ! $rs->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC); ! pe(); ! my $numresults=$rs->size(); ! pe(); ! my $i; ! my $result=''; ! my $scantimerstart=time(); ! for ($i=1; $i<=(($numresults<80) ? ($numresults) : (80)); $i++) { ! my $rec=$rs->record($i); ! my $marcdata=$rec->rawdata(); ! $result.=$marcdata; ! } ! my $scantimerend=time(); ! my $numrecords; ! ($numresults<80) ? ($numrecords=$numresults) : ($numrecords=80); ! my $elapsed=$scantimerend-$scantimerstart; ! if ($elapsed) { ! my $speed=int($numresults/$elapsed*100)/100; ! print " SPEED: $speed $server done $numrecords\n"; ! } ! ! my $q_result=$dbi->quote($result); ! ($q_result) || ($q_result='""'); ! $now=time(); ! my $task="update z3950results set numrecords=$numresults,numdownloaded=$numrecords,highestseen=0,results=$q_result,enddate=$now where id=$resultsid"; ! my $stj=$dbi->prepare($task); ! $stj->execute; ! my $counter=0; ! while ($counter<60 && $numrecords<$numresults) { ! $counter++; ! my $stj=$dbi->prepare("select highestseen from z3950results where id=$resultsid"); ! $stj->execute; ! my ($highestseen) = $stj->fetchrow; ! if ($highestseen>($numrecords-30)) { ! $counter=0; ! print " $server rescanning\n"; ! my $scantimerstart=time(); ! for ($i=$numrecords+1; $i<=(($numresults<($numrecords+40)) ? ($numresults) : ($numrecords+40)); $i++) { ! my $rec=$rs->record($i); ! my $marcdata=$rec->rawdata(); ! $result.=$marcdata; ! } ! my $scantimerend=time(); ! ($numresults<$numrecords+40) ? ($numrecords=$numresults) : ($numrecords=$numrecords+40); ! my $elapsed=$scantimerend-$scantimerstart; ! if ($elapsed) { ! my $speed=int($numresults/$elapsed*100)/100; ! print " SPEED: $speed $server done $numrecords\n"; ! } ! ! my $q_result=$dbi->quote($result); ! ($q_result) || ($q_result='""'); ! $now=time(); ! my $task="update z3950results set numdownloaded=$numrecords,results=$q_result where id=$resultsid"; ! my $stj=$dbi->prepare($task); ! $stj->execute; ! } ! sleep 5; ! } ! } ! my $stj=$dbi->prepare("update z3950results set active=0 where id=$resultsid"); ! $stj->execute; ! eval {$stj->finish}; ! $dbi->disconnect; ! print " $server done.\n"; ! exit; ! sub pe { ! (return) unless ($code); ! my $code=$conn->errcode(); ! my $msg=$conn->errmsg(); ! my $ai=$conn->addinfo(); ! print << "EOF"; ! CODE: $code ! MSG: $msg ! ADDTL: $ai ! ! EOF ! } ! } ! } unless ($stillprocessing) { ! #my $sti=$dbh->prepare("select enddate from z3950queue where id=$id"); ! #$sti->execute; ! #my ($enddate) = $sti->fetchrow; ! #unless ($enddate) { ! # my $now=time; ! # $sti=$dbh->prepare("update z3950queue set done=1,numrecords=$totalrecords,enddate=$now where id=$id"); ! # $sti->execute; ! # } ! } ! } else { ! # my $q_serverinfo=$dbh->quote($serverinfo); ! # my $stj=$dbh->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, 0)"); ! # $stj->execute; ! } } ! $lastrun=time(); } ! sleep 1; } *************** *** 62,89 **** my $query=shift; my $auth=shift; ! open (M, "|yaz-client -m yaz.mrc >>yaz.out 2>>yaz.err"); select M; $|=1; select STDOUT; ($auth) && ($auth="authentication $auth\n"); - print << "EOF"; - $auth\open $server - base $base - $query - s - s - s - s - s - s - s - s - s - s - quit - EOF print M << "EOF"; $auth\open $server base $base $query s --- 212,225 ---- my $query=shift; my $auth=shift; ! my $id=shift; ! open (M, "|yaz-client -m yaz-$id.mrc >>yaz.out 2>>yaz.err"); select M; $|=1; select STDOUT; ($auth) && ($auth="authentication $auth\n"); print M << "EOF"; $auth\open $server base $base + setnames $query s *************** *** 101,102 **** --- 237,244 ---- close M; } + sub reap { + $forkcounter--; + } + + +

1 0

Z39.50 testing
by Tonnesen Steve 04 Nov '01

04 Nov '01

To those of you who have been testing the Z39.50 interface on 142.28.224.14, you should know that some other Koha features on that machine are badly broken at the moment. I'm working on integrating full MARC record support on that machine, so things like editing records are in a sad state. In particular, I know that Modifying a biblio record will result in an internal server error, although it will successfully modify the biblio record and the underlying MARC record before returning the error. :) I've changed the z39.50 querying daemon so that it will fork up to 20 separate processes for doing queries. This speeds up the results considerably. I've also set up a new database table so that additional Z39.50 servers can be added for different Koha installations quite easily. Thanks to everyone who's been testing this and pointing out my obvious mistakes. :) Steve.

1 0

CVS: koha/C4 Catalogue.pm,1.9,1.10
by Steve Tonnesen 03 Nov '01

03 Nov '01

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv17101 Modified Files: Catalogue.pm Log Message: Minor cleanups. Needs testing. Starting to think about modifying updatebiblio.pl to use this API. Index: Catalogue.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Catalogue.pm,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -r1.9 -r1.10 *** Catalogue.pm 2001/10/05 20:13:20 1.9 --- Catalogue.pm 2001/11/03 07:29:36 1.10 *************** *** 3,6 **** --- 3,11 ---- # Continue working on updateItem!!!!!! # + # updateItem is looking not bad. Need to add addSubfield and deleteSubfield + # functions + # + # Trying to track down $dbh's that aren't disconnected.... + # *************** *** 155,158 **** --- 160,164 ---- } } + $dbh->disconnect; return($Subfield_ID, $Subfield_Key); } *************** *** 167,172 **** # to the existing record and _LOG ALL CHANGES MADE_ in some way. I'd like for # this logging feature to be usable to undo changes easily. - # - # Need to add support for bibliosubject, additionalauthors, bibliosubtitle tables my ($env, $biblio) = @_; --- 173,176 ---- *************** *** 176,180 **** $sth->execute; my $origbiblio=$sth->fetchrow_hashref; ! $sth=$dbh->prepare("select subtitle from bibliosubtitle where biblionumber=$biblionumber"): $sth->execute; my ($subtitle)=$sth->fetchrow; --- 180,184 ---- $sth->execute; my $origbiblio=$sth->fetchrow_hashref; ! $sth=$dbh->prepare("select subtitle from bibliosubtitle where biblionumber=$biblionumber"); $sth->execute; my ($subtitle)=$sth->fetchrow; *************** *** 185,189 **** while (my ($author) = $sth->fetchrow) { push (@{$origbiblio->{'additionalauthors'}}, $author); ! $origadditionalauthors->{$subject}=1; } $sth=$dbh->prepare("select subject from bibliosubjects where biblionumber=$biblionumber"); --- 189,193 ---- while (my ($author) = $sth->fetchrow) { push (@{$origbiblio->{'additionalauthors'}}, $author); ! $origadditionalauthors->{$author}=1; } $sth=$dbh->prepare("select subject from bibliosubjects where biblionumber=$biblionumber"); *************** *** 283,286 **** --- 287,291 ---- my $newsubject=''; + my $subjects; foreach $newsubject (@{$biblio->{'subject'}}) { $subjects->{$newsubject}=1; *************** *** 303,306 **** --- 308,312 ---- } } + my $origsubject; foreach $origsubject (keys %$origsubjects) { if ($subjects->{$origsubject} == 1) { *************** *** 312,315 **** --- 318,322 ---- } + $dbh->disconnect; } *************** *** 323,329 **** my $original=shift; my $new=shift; ! print "KOHA: $section $item $original $new\n"; } elsif ($database eq 'marc') { my $type=shift; my $tag=shift; my $mark=shift; --- 330,337 ---- my $original=shift; my $new=shift; ! print "KOHA: $type $section $item $original $new\n"; } elsif ($database eq 'marc') { my $type=shift; + my $Record_ID=shift; my $tag=shift; my $mark=shift; *************** *** 331,335 **** my $original=shift; my $new=shift; ! print "MARC: $tag $mark $subfield_ID $original $new\n"; } } --- 339,343 ---- my $original=shift; my $new=shift; ! print "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n"; } } *************** *** 770,773 **** --- 778,783 ---- changeSubfield($Record_ID, '010', 'a', $obi->{'lccn'}, $biblioitem->{'lccn'}); } + $sth->finish; + $dbh->disconnect; } *************** *** 1015,1018 **** --- 1025,1030 ---- } } + $sth->finish; + $dbh->disconnect; }

1 0

CVS: koha/acqui.simple marcimport.pl,1.3,1.4
by Steve Tonnesen 03 Nov '01

03 Nov '01

Update of /cvsroot/koha/koha/acqui.simple In directory usw-pr-cvs1:/tmp/cvs-serv16947 Modified Files: marcimport.pl Log Message: Z39.50 now stores list of servers to query in a database table. Index: marcimport.pl =================================================================== RCS file: /cvsroot/koha/koha/acqui.simple/marcimport.pl,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -r1.3 -r1.4 *** marcimport.pl 2001/11/02 21:21:25 1.3 --- marcimport.pl 2001/11/03 07:28:20 1.4 *************** *** 88,99 **** if (/S-(.*)/) { my $server=$1; - if ($server eq 'LOC') { - push @serverlist, "LOC/z3950.loc.gov:7090/voyager//"; - } - if ($server eq 'NLC') { - push @serverlist, "NLC/amicus.nlc-bnc.ca:210/AMICUS/bccms1/hawk5fad"; - } if ($server eq 'MAN') { push @serverlist, "MAN/".$input->param('manualz3950server')."//"; } } --- 88,98 ---- if (/S-(.*)/) { my $server=$1; if ($server eq 'MAN') { push @serverlist, "MAN/".$input->param('manualz3950server')."//"; + } else { + my $sth=$dbh->prepare("select host,port,db,userid,password from z3950servers where id=$server"); + $sth->execute; + my ($host, $port, $db, $userid, $password) = $sth->fetchrow; + push @serverlist, "$server/$host\:$port/$db/$userid/$password"; } } *************** *** 278,281 **** --- 277,283 ---- my ($barcode) = $sth->fetchrow; $barcode++; + if ($barcode==1) { + $barcode=int(rand()*1000000); + } print << "EOF"; <table border=0 cellpadding=10 cellspacing=0> *************** *** 316,327 **** my $biblioitemnumber=$input->param('biblioitemnumber'); my $replacementprice=($input->param('replacementprice') || 0); ! my $sth=$dbh->prepare("select max(itemnumber) from items"); ! $sth->execute; ! my ($itemnumber) = $sth->fetchrow; ! $itemnumber++; ! my @datearr=localtime(time); ! my $date=(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; ! $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)"); $sth->execute; } --- 318,336 ---- my $biblioitemnumber=$input->param('biblioitemnumber'); my $replacementprice=($input->param('replacementprice') || 0); ! my $sth=$dbh->prepare("select barcode from items where ! barcode=$q_barcode"); $sth->execute; + if ($sth->rows) { + print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n"; + } else { + $sth=$dbh->prepare("select max(itemnumber) from items"); + $sth->execute; + my ($itemnumber) = $sth->fetchrow; + $itemnumber++; + my @datearr=localtime(time); + my $date=(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + $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)"); + $sth->execute; + } } *************** *** 689,698 **** foreach $serverstring (split(/\s+/, $servers)) { my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4); ! if ($name eq 'LOC') { print "Library of Congress<br>\n"; } elsif ($name eq 'NLC') { print "National Library of Canada<br>\n"; } else { ! print "$server/$database<br>\n"; } print "<ul>\n"; --- 698,713 ---- foreach $serverstring (split(/\s+/, $servers)) { my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4); ! if ($name eq 'MAN') { ! print "$server/$database<br>\n"; ! } elsif ($name eq 'LOC') { print "Library of Congress<br>\n"; } elsif ($name eq 'NLC') { print "National Library of Canada<br>\n"; } else { ! my $sti=$dbh->prepare("select name from ! z3950servers where id=$name"); ! $sti->execute; ! my ($longname)=$sti->fetchrow; ! print "$longname<br>\n"; } print "<ul>\n"; *************** *** 887,891 **** print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n"; print "<table border=0><tr><td valign=top>\n"; ! print "<h2>Results of Z3950 searches</h2>\n"; print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n<ul>\n"; while (my ($id, $term, $type, $done, $numrecords, $length, $startdate, $enddate, $servers) = $sth->fetchrow) { --- 902,906 ---- print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n"; print "<table border=0><tr><td valign=top>\n"; ! print "<h2>Results of Z39.50 searches</h2>\n"; print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n<ul>\n"; while (my ($id, $term, $type, $done, $numrecords, $length, $startdate, $enddate, $servers) = $sth->fetchrow) { *************** *** 921,924 **** --- 936,948 ---- print "</ul>\n"; print "</td><td valign=top width=30%>\n"; + my $sth=$dbh->prepare("select id,name,checked from z3950servers order by rank"); + $sth->execute; + my $serverlist=''; + while (my ($id, $name, $checked) = $sth->fetchrow) { + ($checked) ? ($checked='checked') : ($checked=''); + $serverlist.="<input type=checkbox name=S-$id $checked> $name<br>\n"; + } + $serverlist.="<input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE>\n"; + print << "EOF"; <form action=$ENV{'SCRIPT_NAME'} method=GET> *************** *** 927,937 **** <p> <input type=hidden name=test value=testvalue> ! <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records<br>LOC and NLC</th></tr> <tr><td>Query Term</td><td><input name=query></td></tr> <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> <tr><td colspan=2> ! <input type=checkbox name=S-LOC checked> Library of Congress<br> ! <input type=checkbox name=S-NLC checked> National Library of Canada<br> ! <input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE> </td></tr> <tr><td colspan=2 align=center> --- 951,959 ---- <p> <input type=hidden name=test value=testvalue> ! <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records</th></tr> <tr><td>Query Term</td><td><input name=query></td></tr> <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> <tr><td colspan=2> ! $serverlist </td></tr> <tr><td colspan=2 align=center>

1 0

CVS: koha-html/intranet-html/includes aquisitions-top.inc,1.2,1.3
by Steve Tonnesen 02 Nov '01

02 Nov '01

Update of /cvsroot/koha/koha-html/intranet-html/includes In directory usw-pr-cvs1:/tmp/cvs-serv19055 Modified Files: aquisitions-top.inc Log Message: Spelling correction. Index: aquisitions-top.inc =================================================================== RCS file: /cvsroot/koha/koha-html/intranet-html/includes/aquisitions-top.inc,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -r1.2 -r1.3 *** aquisitions-top.inc 2001/02/05 18:54:58 1.2 --- aquisitions-top.inc 2001/11/02 21:55:24 1.3 *************** *** 6,10 **** <html> <head> ! <title>KOHA: INTRANET: Aquisitions</title> --- 6,10 ---- <html> <head> ! <title>KOHA: INTRANET: Acquisitions</title>

1 0

CVS: koha/acqui.simple processz3950queue,NONE,1.1
by Steve Tonnesen 02 Nov '01

02 Nov '01

Update of /cvsroot/koha/koha/acqui.simple In directory usw-pr-cvs1:/tmp/cvs-serv14787 Added Files: processz3950queue Log Message: Daemon to process the queue of pending Z39.50 searches. I still need to come up with a way for this process to get launched. Looks like Koha might need its first init script. :) --- NEW FILE --- #!/usr/bin/perl use C4::Database; use DBI; #use strict; use C4::Acquisitions; use C4::Output; my $dbh=C4Connect; while (1) { my $sth=$dbh->prepare("select id,term,type,servers from z3950queue where isnull(done) || done=-1"); $sth->execute; while (my ($id, $term, $type, $servers) = $sth->fetchrow) { my $now=time(); my $sti=$dbh->prepare("update z3950queue set done=-1,startdate=$now where id=$id"); $sti->execute; my $attr=''; if ($type eq 'isbn') { $attr='1=7'; } elsif ($type eq 'title') { $attr='1=4'; } elsif ($type eq 'lccn') { $attr='1=9'; } $term='"'.$term.'"'; $query="f \@attr $attr $term"; my $totalrecords=0; my $serverinfo; foreach $serverinfo (split(/\s+/, $servers)) { my ($name, $server, $database, $auth) = split(/\//, $serverinfo, 4); ($auth eq '/') && ($auth=''); print "Processing $type=$term at $name $server $database $auth\n"; $now=time(); my $q_serverinfo=$dbh->quote($serverinfo); my $sti=$dbh->prepare("insert into z3950results (server, queryid, startdate) values ($q_serverinfo, $id, $now)"); $sti->execute; my $resultsid=$dbh->{'mysql_insertid'}; getrecord($server, $database, $query, $auth); my $result=`cat yaz.mrc`; unlink ('yaz.mrc'); my $splitchar=chr(29); my @records=split(/$splitchar/, $result); my $numrecords=$#records+1; $totalrecords+=$numrecords; my $q_result=$dbh->quote($result); ($q_result) || ($q_result='""'); $now=time(); $sti=$dbh->prepare("update z3950results set numrecords=$numrecords,results=$q_result,enddate=$now where id=$resultsid"); $sti->execute; } $sti=$dbh->prepare("update z3950queue set done=1,numrecords=$totalrecords,enddate=$now where id=$id"); $sti->execute; } sleep 15; } sub getrecord { my $server=shift; my $base=shift; my $query=shift; my $auth=shift; open (M, "|yaz-client -m yaz.mrc >>yaz.out 2>>yaz.err"); select M; $|=1; select STDOUT; ($auth) && ($auth="authentication $auth\n"); print << "EOF"; $auth\open $server base $base $query s s s s s s s s s s quit EOF print M << "EOF"; $auth\open $server base $base $query s s s s s s s s s s quit EOF close M; }

1 0

CVS: koha/acqui.simple marcimport.pl,1.2,1.3
by Steve Tonnesen 02 Nov '01

02 Nov '01

Update of /cvsroot/koha/koha/acqui.simple In directory usw-pr-cvs1:/tmp/cvs-serv9216 Modified Files: marcimport.pl Log Message: Added Z39.50 searching capability, and MARC file uploading from workstation using HTML forms. Z39.50 functionality requires the YAZ toolkit. Index: marcimport.pl =================================================================== RCS file: /cvsroot/koha/koha/acqui.simple/marcimport.pl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -r1.2 -r1.3 *** marcimport.pl 2001/11/01 05:00:41 1.2 --- marcimport.pl 2001/11/02 21:21:25 1.3 *************** *** 81,84 **** --- 81,159 ---- my $file=$input->param('file'); + if ($input->param('z3950queue')) { + my $query=$input->param('query'); + my $type=$input->param('type'); + my @serverlist; + foreach ($input->param) { + if (/S-(.*)/) { + my $server=$1; + if ($server eq 'LOC') { + push @serverlist, "LOC/z3950.loc.gov:7090/voyager//"; + } + if ($server eq 'NLC') { + push @serverlist, "NLC/amicus.nlc-bnc.ca:210/AMICUS/bccms1/hawk5fad"; + } + if ($server eq 'MAN') { + push @serverlist, "MAN/".$input->param('manualz3950server')."//"; + } + } + } + my $isbnfailed=0; + if ($type eq 'isbn') { + my $q=$query; + $q=~s/[^X\d]//g; + $q=~s/X.//g; + if (length($q)==10) { + my $checksum=substr($q,9,1); + my $isbn=substr($q,0,9); + my $i; + my $c=0; + for ($i=0; $i<9; $i++) { + my $digit=substr($q,$i,1); + $c+=$digit*(10-$i); + } + $c=int(11-($c/11-int($c/11))*11+.1); + ($c==10) && ($c='X'); + if ($c eq $checksum) { + } else { + print "<font color=red size=+1>$query is not a valid ISBN + Number</font><p>\n"; + $isbnfailed=1; + } + } else { + print "<font color=red size=+1>$query is not a valid ISBN + Number</font><p>\n"; + $isbnfailed=1; + } + } + unless ($isbnfailed) { + my $q_term=$dbh->quote($query); + my $serverlist=''; + foreach (@serverlist) { + $serverlist.="$_ "; + } + chop $serverlist; + my $q_serverlist=$dbh->quote($serverlist); + my $sth=$dbh->prepare("insert into z3950queue (term,type,servers) values ($q_term, '$type', $q_serverlist)"); + $sth->execute; + } + } + + if (my $data=$input->param('uploadmarc')) { + my $name=$input->param('name'); + ($name) || ($name=$data); + my $marcrecord=''; + if (length($data)>0) { + while (<$data>) { + $marcrecord.=$_; + } + } + my $q_marcrecord=$dbh->quote($marcrecord); + my $q_name=$dbh->quote($name); + my $sth=$dbh->prepare("insert into uploadedmarc (marc,name) values ($q_marcrecord, $q_name)"); + $sth->execute; + } + + if ($input->param('insertnewrecord')) { my $isbn=$input->param('isbn'); *************** *** 99,103 **** my $biblioitemnumber=0; print "<center>\n"; ! print "<a href=marcimport.pl?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n"; if ($sth->rows) { ($biblionumber, $biblioitemnumber) = $sth->fetchrow; --- 174,178 ---- my $biblioitemnumber=0; print "<center>\n"; ! print "<a href=$ENV{'SCRIPT_NAME'}?file=$file>New Record</a> | <a href=marcimport.pl>New File</a><br>\n"; if ($sth->rows) { ($biblionumber, $biblioitemnumber) = $sth->fetchrow; *************** *** 252,256 **** --- 327,333 ---- + my $menu = $input->param('menu'); if ($file) { + print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n"; my $qisbn=$input->param('isbn'); my $qissn=$input->param('issn'); *************** *** 258,264 **** my $qcontrolnumber=$input->param('controlnumber'); if ($qisbn || $qissn || $qlccn || $qcontrolnumber) { ! print "<a href=marcimport.pl>New File</a><hr>\n"; ! open (F, "$file"); ! my $data=<F>; $splitchar=chr(29); --- 335,353 ---- my $qcontrolnumber=$input->param('controlnumber'); if ($qisbn || $qissn || $qlccn || $qcontrolnumber) { ! print "<a href=$ENV{'SCRIPT_NAME'}>New File</a><hr>\n"; ! #open (F, "$file"); ! #my $data=<F>; ! my $data; ! if ($file=~/Z-(\d+)/) { ! my $id=$1; ! my $resultsid=$input->param('resultsid'); ! my $sth=$dbh->prepare("select results from z3950results where id=$resultsid"); ! $sth->execute; ! ($data) = $sth->fetchrow; ! } else { ! my $sth=$dbh->prepare("select marc from uploadedmarc where id=$file"); ! $sth->execute; ! ($data) = $sth->fetchrow; ! } $splitchar=chr(29); *************** *** 529,532 **** --- 618,622 ---- ($qisbn) || ($qisbn='NIL'); ($qcontrolnumber) || ($qcontrolnumber='NIL'); + $controlnumber=~s/\s+//g; unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) { next RECORD; *************** *** 577,848 **** } } else { ! open (F, "$file"); ! my $data=<F>; ! ! $splitchar=chr(29); ! my @records; ! foreach $record (split(/$splitchar/, $data)) { ! $leader=substr($record,0,24); ! #print "<tr><td>Leader:</td><td>$leader</td></tr>\n"; ! $record=substr($record,24); ! $splitchar2=chr(30); ! my $directory=0; ! my $tagcounter=0; ! my %tag; ! my @record; ! foreach $field (split(/$splitchar2/, $record)) { ! my %field; ! ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1); ! unless ($directory) { ! $directory=$field; ! my $itemcounter=1; ! $counter=0; ! while ($item=substr($directory,0,12)) { ! $tag=substr($directory,0,3); ! $length=substr($directory,3,4); ! $start=substr($directory,7,6); ! $directory=substr($directory,12); ! $tag{$counter}=$tag; ! $counter++; ! } ! $directory=1; ! next; ! } ! $tag=$tag{$tagcounter}; ! $tagcounter++; ! $field{'tag'}=$tag; ! $splitchar3=chr(31); ! my @subfields=split(/$splitchar3/, $field); ! $indicator=$subfields[0]; ! $field{'indicator'}=$indicator; ! my $firstline=1; ! unless ($#subfields==0) { ! my %subfields; ! for ($i=1; $i<=$#subfields; $i++) { ! my $text=$subfields[$i]; ! my $subfieldcode=substr($text,0,1); ! my $subfield=substr($text,1); ! if ($subfields{$subfieldcode}) { ! my $subfieldlist=$subfields{$subfieldcode}; ! my @subfieldlist=@$subfieldlist; ! if ($#subfieldlist>=0) { ! # print "$tag Adding to array $subfieldcode -- $subfield<br>\n"; ! push (@subfieldlist, $subfield); ! } else { ! # print "$tag Arraying $subfieldcode -- $subfield<br>\n"; ! @subfieldlist=($subfields{$subfieldcode}, $subfield); ! } ! $subfields{$subfieldcode}=\@subfieldlist; ! } else { ! $subfields{$subfieldcode}=$subfield; ! } ! } ! $field{'subfields'}=\%subfields; ! } ! push (@record, \%field); ! } ! push (@records, \@record); ! $counter++; ! } ! print << "EOF"; ! <center> ! <p> ! <a href=marcimport.pl>Select a New File</a> ! <p> ! <table border=0 cellpadding=10 cellspacing=0> ! <tr><th bgcolor=black><font color=white>Select a Record to Import</font></th></tr> ! <tr><td bgcolor=#dddddd> EOF ! my $text=''; ! foreach $record (@records) { ! my @subjects=(); ! my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber); ! foreach $field (@$record) { ! $text.=$field->{'tag'}."\n"; ! foreach (keys %{$field->{'subfields'}}) { ! my $value=$field->{'subfields'}->{$_}; ! $text.=" $_: $value\n"; ! } ! if ($field->{'tag'} eq '001') { ! $controlnumber=$field->{'indicator'}; ! } ! if ($field->{'tag'} eq '010') { ! $lccn=$field->{'subfields'}->{'a'}; ! $lccn=~s/^\s*//; ! ($lccn) = (split(/\s+/, $lccn))[0]; ! } ! if ($field->{'tag'} eq '015') { ! $lccn=$field->{'subfields'}->{'a'}; ! $lccn=~s/^\s*//; ! $lccn=~s/^C//; ! ($lccn) = (split(/\s+/, $lccn))[0]; ! } ! if ($field->{'tag'} eq '020') { ! $isbn=$field->{'subfields'}->{'a'}; ! ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]); ! $isbn=~s/[^\d]*//g; ! } ! if ($field->{'tag'} eq '022') { ! $issn=$field->{'subfields'}->{'a'}; ! $issn=~s/^\s*//; ! ($issn) = (split(/\s+/, $issn))[0]; ! } ! if ($field->{'tag'} eq '082') { ! $dewey=$field->{'subfields'}->{'a'}; ! $dewey=~s/\///g; ! if (@$dewey) { ! $dewey=$$dewey[0]; ! } ! #$dewey=~s/\///g; ! } ! if ($field->{'tag'} eq '100') { ! $author=$field->{'subfields'}->{'a'}; ! } ! if ($field->{'tag'} eq '245') { ! $title=$field->{'subfields'}->{'a'}; ! $title=~s/ \/$//; ! $subtitle=$field->{'subfields'}->{'b'}; ! $subtitle=~s/ \/$//; } ! if ($field->{'tag'} eq '260') { ! $place=$field->{'subfields'}->{'a'}; ! if (@$place) { ! $place=$$place[0]; ! } ! $place=~s/\s*:$//g; ! $publisher=$field->{'subfields'}->{'b'}; ! if (@$publisher) { ! $publisher=$$publisher[0]; ! } ! $publisher=~s/\s*:$//g; ! $publicationyear=$field->{'subfields'}->{'c'}; ! if ($publicationyear=~/c(\d\d\d\d)/) { ! $copyrightdate=$1; ! } ! if ($publicationyear=~/[^c](\d\d\d\d)/) { ! $publicationyear=$1; ! } elsif ($copyrightdate) { ! $publicationyear=$copyrightdate; } else { ! $publicationyear=~/(\d\d\d\d)/; ! $publicationyear=$1; } ! } ! if ($field->{'tag'} eq '300') { ! $pages=$field->{'subfields'}->{'a'}; ! $pages=~s/ \;$//; ! $size=$field->{'subfields'}->{'c'}; ! $pages=~s/\s*:$//g; ! $size=~s/\s*:$//g; ! } ! if ($field->{'tag'} eq '362') { ! if ($field->{'subfields'}->{'a'}=~/(\d+).*(\d+)/) { ! $volume=$1; ! $number=$2; ! } ! } ! if ($field->{'tag'} eq '440') { ! $seriestitle=$field->{'subfields'}->{'a'}; ! if ($field->{'subfields'}->{'v'}=~/(\d+).*(\d+)/) { ! $volume=$1; ! $number=$2; ! } ! } ! if ($field->{'tag'} =~/^5/) { ! $note.="$field->{'subfields'}->{'a'}\n"; ! } ! if ($field->{'tag'} =~/65\d/) { ! my $subject=$field->{'subfields'}->{'a'}; ! $subject=~s/\.$//; ! if ($gensubdivision=$field->{'subfields'}->{'x'}) { ! my @sub=@$gensubdivision; ! if ($#sub>=0) { ! foreach $s (@sub) { ! $s=~s/\.$//; ! $subject.=" -- $s"; } ! } else { ! $gensubdivision=~s/\.$//; ! $subject.=" -- $gensubdivision"; ! } ! } ! if ($chronsubdivision=$field->{'subfields'}->{'y'}) { ! my @sub=@$chronsubdivision; ! if ($#sub>=0) { ! foreach $s (@sub) { ! $s=~s/\.$//; ! $subject.=" -- $s"; } ! } else { ! $chronsubdivision=~s/\.$//; ! $subject.=" -- $chronsubdivision"; ! } ! } ! if ($geosubdivision=$field->{'subfields'}->{'z'}) { ! my @sub=@$geosubdivision; ! if ($#sub>=0) { ! foreach $s (@sub) { ! $s=~s/\.$//; ! $subject.=" -- $s"; } } else { ! $geosubdivision=~s/\.$//; ! $subject.=" -- $geosubdivision"; } } ! push @subjects, $subject; } } ! my $q_isbn=$dbh->quote((($isbn) || ('NIL'))); ! my $q_issn=$dbh->quote((($issn) || ('NIL'))); ! my $q_lccn=$dbh->quote((($lccn) || ('NIL'))); ! my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL'))); ! my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber"); $sth->execute; ! my $donetext=''; ! if ($sth->rows) { ! $donetext="DONE"; } ! $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn"); ! $sth->execute; ! if ($sth->rows) { ! $donetext="DONE"; } ! if ($isbn) { ! print "<a href=marcimport.pl?file=$file&isbn=$isbn>$title by $author</a> $donetext<br>\n"; ! } elsif ($lccn) { ! print "<a href=marcimport.pl?file=$file&lccn=$lccn>$title by $author</a> $donetext<br>\n"; ! } elsif ($issn) { ! print "<a href=marcimport.pl?file=$file&issn=$issn>$title by $author</a><br> $donetext\n"; ! } elsif ($controlnumber) { ! print "<a href=marcimport.pl?file=$file&controlnumber=$controlnumber>$title by $author</a><br> $donetext\n"; } else { ! print "Error: Contact steve regarding $title by $author<br>\n"; } } - print "</td></tr></table>\n"; } ! } else { ! opendir(D, "/home/$userid/"); ! my @dirlist=readdir D; ! foreach $file (@dirlist) { ! (next) if ($file=~/^\./); ! (next) if ($file=~/^nsmail$/); ! (next) if ($file=~/^public_html$/); ! ($file=~/\.mrc/) || ($filelist.="$file<br>\n"); ! (next) unless ($file=~/\.mrc$/); ! $file=~s/ /\%20/g; ! print "<a href=marcimport.pl?file=/home/$userid/$file>$file</a><br>\n"; } print << "EOF"; ! <form method=get> ! File to read MARC records from: <input name=file size=30> ! <p> ! Other files in home directory:<p> ! $filelist </form> EOF } print endmenu(); print endpage(); --- 667,1081 ---- } } else { ! #open (F, "$file"); ! #my $data=<F>; ! my $data; ! my $name; ! my $z3950=0; ! if ($file=~/Z-(\d+)/) { ! print << "EOF"; ! <center> ! <p> ! <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a> ! <p> ! <table border=0 cellpadding=10 cellspacing=0> ! <tr><th bgcolor=black><font color=white>Select a Record to Import</font></th></tr> ! <tr><td bgcolor=#dddddd> EOF ! my $id=$1; ! my $sth=$dbh->prepare("select servers from z3950queue where id=$id"); ! $sth->execute; ! my ($servers) = $sth->fetchrow; ! my $serverstring; ! foreach $serverstring (split(/\s+/, $servers)) { ! my ($name, $server, $database, $auth) = split(/\//, $serverstring, 4); ! if ($name eq 'LOC') { ! print "Library of Congress<br>\n"; ! } elsif ($name eq 'NLC') { ! print "National Library of Canada<br>\n"; ! } else { ! print "$server/$database<br>\n"; } ! print "<ul>\n"; ! my $q_server=$dbh->quote($serverstring); ! my $sti=$dbh->prepare("select numrecords,id,results,startdate,enddate from z3950results where queryid=$id and server=$q_server"); ! $sti->execute; ! ($numrecords,$resultsid,$data,$startdate,$enddate) = $sti->fetchrow; ! if ($sti->rows == 0) { ! print "pending..."; ! } elsif ($enddate == 0) { ! my $now=time(); ! my $elapsed=$now-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; } ! print "<font color=red>processing... ($elapsedtime)</font>"; ! } elsif ($numrecords) { ! my @records=parsemarcdata($data); ! foreach $record (@records) { ! my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber); ! foreach $field (@$record) { ! if ($field->{'tag'} eq '001') { ! $controlnumber=$field->{'indicator'}; } ! if ($field->{'tag'} eq '010') { ! $lccn=$field->{'subfields'}->{'a'}; ! $lccn=~s/^\s*//; ! ($lccn) = (split(/\s+/, $lccn))[0]; } ! if ($field->{'tag'} eq '015') { ! $lccn=$field->{'subfields'}->{'a'}; ! $lccn=~s/^\s*//; ! $lccn=~s/^C//; ! ($lccn) = (split(/\s+/, $lccn))[0]; ! } ! if ($field->{'tag'} eq '020') { ! $isbn=$field->{'subfields'}->{'a'}; ! ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]); ! $isbn=~s/[^\d]*//g; ! } ! if ($field->{'tag'} eq '022') { ! $issn=$field->{'subfields'}->{'a'}; ! $issn=~s/^\s*//; ! ($issn) = (split(/\s+/, $issn))[0]; ! } ! if ($field->{'tag'} eq '100') { ! $author=$field->{'subfields'}->{'a'}; } + if ($field->{'tag'} eq '245') { + $title=$field->{'subfields'}->{'a'}; + $title=~s/ \/$//; + $subtitle=$field->{'subfields'}->{'b'}; + $subtitle=~s/ \/$//; + } + } + my $q_isbn=$dbh->quote((($isbn) || ('NIL'))); + my $q_issn=$dbh->quote((($issn) || ('NIL'))); + my $q_lccn=$dbh->quote((($lccn) || ('NIL'))); + my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL'))); + my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber"); + $sth->execute; + my $donetext=''; + if ($sth->rows) { + $donetext="DONE"; + } + $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn"); + $sth->execute; + if ($sth->rows) { + $donetext="DONE"; + } + ($author) && ($author="by $author"); + if ($isbn) { + print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&isbn=$isbn>$title$subtitle $author</a> $donetext<br>\n"; + } elsif ($lccn) { + print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&lccn=$lccn>$title$subtitle $author</a> $donetext<br>\n"; + } elsif ($issn) { + print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&issn=$issn>$title$subtitle $author</a><br> $donetext\n"; + } elsif ($controlnumber) { + print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$file&resultsid=$resultsid&controlnumber=$controlnumber>$title $author</a><br> $donetext\n"; } else { ! print "Error: Contact steve regarding $title by $author<br>\n"; } } ! print "<p>\n"; ! } else { ! print "No records returned.<p>\n"; } + print "</ul>\n"; } ! } else { ! my $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file"); $sth->execute; ! ($data, $name) = $sth->fetchrow; ! print << "EOF"; ! <center> ! <p> ! <a href=$ENV{'SCRIPT_NAME'}?menu=$menu>Select a New File</a> ! <p> ! <table border=0 cellpadding=10 cellspacing=0> ! <tr><th bgcolor=black><font color=white>Select a Record to Import<br>from $name</font></th></tr> ! <tr><td bgcolor=#dddddd> ! EOF ! ! my @records=parsemarcdata($data); ! foreach $record (@records) { ! my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $note, $controlnumber); ! foreach $field (@$record) { ! if ($field->{'tag'} eq '001') { ! $controlnumber=$field->{'indicator'}; ! } ! if ($field->{'tag'} eq '010') { ! $lccn=$field->{'subfields'}->{'a'}; ! $lccn=~s/^\s*//; ! ($lccn) = (split(/\s+/, $lccn))[0]; ! } ! if ($field->{'tag'} eq '015') { ! $lccn=$field->{'subfields'}->{'a'}; ! $lccn=~s/^\s*//; ! $lccn=~s/^C//; ! ($lccn) = (split(/\s+/, $lccn))[0]; ! } ! if ($field->{'tag'} eq '020') { ! $isbn=$field->{'subfields'}->{'a'}; ! ($isbn=~/ARRAY/) && ($isbn=$$isbn[0]); ! $isbn=~s/[^\d]*//g; ! } ! if ($field->{'tag'} eq '022') { ! $issn=$field->{'subfields'}->{'a'}; ! $issn=~s/^\s*//; ! ($issn) = (split(/\s+/, $issn))[0]; ! } ! if ($field->{'tag'} eq '100') { ! $author=$field->{'subfields'}->{'a'}; ! } ! if ($field->{'tag'} eq '245') { ! $title=$field->{'subfields'}->{'a'}; ! $title=~s/ \/$//; ! $subtitle=$field->{'subfields'}->{'b'}; ! $subtitle=~s/ \/$//; ! } ! } ! my $q_isbn=$dbh->quote((($isbn) || ('NIL'))); ! my $q_issn=$dbh->quote((($issn) || ('NIL'))); ! my $q_lccn=$dbh->quote((($lccn) || ('NIL'))); ! my $q_controlnumber=$dbh->quote((($controlnumber) || ('NIL'))); ! my $sth=$dbh->prepare("select * from marcrecorddone where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn or controlnumber=$q_controlnumber"); ! $sth->execute; ! my $donetext=''; ! if ($sth->rows) { ! $donetext="DONE"; ! } ! $sth=$dbh->prepare("select * from biblioitems where isbn=$q_isbn or issn=$q_issn or lccn=$q_lccn"); ! $sth->execute; ! if ($sth->rows) { ! $donetext="DONE"; ! } ! ($author) && ($author="by $author"); ! if ($isbn) { ! print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&isbn=$isbn>$title$subtitle $author</a> $donetext<br>\n"; ! } elsif ($lccn) { ! print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&lccn=$lccn>$title$subtitle $author</a> $donetext<br>\n"; ! } elsif ($issn) { ! print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&issn=$issn>$title$subtitle $author</a><br> $donetext\n"; ! } elsif ($controlnumber) { ! print "<a href=$ENV{'SCRIPT_NAME'}?file=$file&controlnumber=$controlnumber>$title by $author</a><br> $donetext\n"; ! } else { ! print "Error: Contact steve regarding $title by $author<br>\n"; ! } } ! } ! print "</td></tr></table>\n"; ! } ! } else { ! ! SWITCH: ! { ! if ($menu eq 'z3950') { z3950(); last SWITCH; } ! if ($menu eq 'uploadmarc') { uploadmarc(); last SWITCH; } ! if ($menu eq 'manual') { manual(); last SWITCH; } ! mainmenu(); ! } ! ! } ! ! ! sub z3950 { ! $sth=$dbh->prepare("select id,term,type,done,numrecords,length(results),startdate,enddate,servers from z3950queue order by id desc limit 20"); ! $sth->execute; ! print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n"; ! print "<table border=0><tr><td valign=top>\n"; ! print "<h2>Results of Z3950 searches</h2>\n"; ! print "<a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Refresh</a><br>\n<ul>\n"; ! while (my ($id, $term, $type, $done, $numrecords, $length, $startdate, $enddate, $servers) = $sth->fetchrow) { ! $type=uc($type); ! $term=~s/</</g; ! $term=~s/>/>/g; ! if ($done == 1) { ! my $elapsed=$enddate-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); ! } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; ! } ! if ($numrecords) { ! 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"; ! } else { ! 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"; } ! } elsif ($done == -1) { ! my $elapsed=time()-$startdate; ! my $elapsedtime=''; ! if ($elapsed>60) { ! $elapsedtime=sprintf "%d minutes",($elapsed/60); } else { ! $elapsedtime=sprintf "%d seconds",$elapsed; } + 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"; + } else { + print "<li><a href=$ENV{'SCRIPT_NAME'}?file=Z-$id&menu=$menu>$type=$term</a> $done <font size=-1>Pending</font><br>\n"; } } ! print "</ul>\n"; ! print "</td><td valign=top width=30%>\n"; ! print << "EOF"; ! <form action=$ENV{'SCRIPT_NAME'} method=GET> ! <input type=hidden name=z3950queue value=1> ! <input type=hidden name=menu value=$menu> ! <p> ! <input type=hidden name=test value=testvalue> ! <table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb colspan=2>Search for MARC records<br>LOC and NLC</th></tr> ! <tr><td>Query Term</td><td><input name=query></td></tr> ! <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> ! <tr><td colspan=2> ! <input type=checkbox name=S-LOC checked> Library of Congress<br> ! <input type=checkbox name=S-NLC checked> National Library of Canada<br> ! <input type=checkbox name=S-MAN> <input name=manualz3950server size=25 value=otherserver:210/DATABASE> ! </td></tr> ! <tr><td colspan=2 align=center> ! <input type=submit> ! </td></tr> ! </table> ! ! </form> ! EOF ! print "</td></tr></table>\n"; ! } ! ! sub uploadmarc { ! print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n"; ! my $sth=$dbh->prepare("select id,name from uploadedmarc"); ! $sth->execute; ! print "<h2>Select a set of MARC records</h2>\n<ul>"; ! while (my ($id, $name) = $sth->fetchrow) { ! print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n"; } + print "</ul>\n"; + print "<p>\n"; + print "<table border=1 bgcolor=#dddddd><tr><th bgcolor=#bbbbbb + colspan=2>Upload a set of MARC records</th></tr>\n"; + print "<tr><td>Upload a set of MARC records:</td><td>"; + print $input->start_multipart_form(); + print $input->filefield('uploadmarc'); print << "EOF"; ! </td></tr> ! <tr><td> ! <input type=hidden name=menu value=$menu> ! Name this set of MARC records:</td><td><input type=text ! name=name></td></tr> ! <tr><td colspan=2 align=center> ! <input type=submit> ! </td></tr> ! </table> </form> EOF } + + sub manual { + } + + + sub mainmenu { + print << "EOF"; + <h1>Main Menu</h1> + <ul> + <li><a href=$ENV{'SCRIPT_NAME'}?menu=z3950>Z39.50 Search</a> + <li><a href=$ENV{'SCRIPT_NAME'}?menu=uploadmarc>Upload MARC Records</a> + </ul> + EOF + } + + sub skip { + + #opendir(D, "/home/$userid/"); + #my @dirlist=readdir D; + #foreach $file (@dirlist) { + # (next) if ($file=~/^\./); + # (next) if ($file=~/^nsmail$/); + # (next) if ($file=~/^public_html$/); + # ($file=~/\.mrc/) || ($filelist.="$file<br>\n"); + # (next) unless ($file=~/\.mrc$/); + # $file=~s/ /\%20/g; + # print "<a href=$ENV{'SCRIPT_NAME'}?file=/home/$userid/$file>$file</a><br>\n"; + # } + + + #<form action=$ENV{'SCRIPT_NAME'} method=POST enctype=multipart/form-data> + + } print endmenu(); print endpage(); + sub parsemarcdata { + my $data=shift; + my $splitchar=chr(29); + my @records; + my $record; + foreach $record (split(/$splitchar/, $data)) { + my $leader=substr($record,0,24); + #print "<tr><td>Leader:</td><td>$leader</td></tr>\n"; + $record=substr($record,24); + my $splitchar2=chr(30); + my $directory=0; + my $tagcounter=0; + my %tag; + my @record; + my $field; + foreach $field (split(/$splitchar2/, $record)) { + my %field; + ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1); + unless ($directory) { + $directory=$field; + my $itemcounter=1; + $counter=0; + while ($item=substr($directory,0,12)) { + $tag=substr($directory,0,3); + $length=substr($directory,3,4); + $start=substr($directory,7,6); + $directory=substr($directory,12); + $tag{$counter}=$tag; + $counter++; + } + $directory=1; + next; + } + $tag=$tag{$tagcounter}; + $tagcounter++; + $field{'tag'}=$tag; + $splitchar3=chr(31); + my @subfields=split(/$splitchar3/, $field); + $indicator=$subfields[0]; + $field{'indicator'}=$indicator; + my $firstline=1; + unless ($#subfields==0) { + my %subfields; + for ($i=1; $i<=$#subfields; $i++) { + my $text=$subfields[$i]; + my $subfieldcode=substr($text,0,1); + my $subfield=substr($text,1); + if ($subfields{$subfieldcode}) { + my $subfieldlist=$subfields{$subfieldcode}; + my @subfieldlist=@$subfieldlist; + if ($#subfieldlist>=0) { + # print "$tag Adding to array $subfieldcode -- $subfield<br>\n"; + push (@subfieldlist, $subfield); + } else { + # print "$tag Arraying $subfieldcode -- $subfield<br>\n"; + @subfieldlist=($subfields{$subfieldcode}, $subfield); + } + $subfields{$subfieldcode}=\@subfieldlist; + } else { + $subfields{$subfieldcode}=$subfield; + } + } + $field{'subfields'}=\%subfields; + } + push (@record, \%field); + } + push (@records, \@record); + $counter++; + } + return @records; + }

1 0

Z39.50
by Tonnesen Steve 02 Nov '01

02 Nov '01

Just let me know if you are getting sick of my posts. :) Cleaned up the interface quite a bit. Separated out the "uploaded marcs" from the "Z39.50 Searches". You can now specify which Z39.50 servers to query. I have the LOC and the NLC hard coded in, but I'd like to make those configurable for each installation of Koha. You can also now specify an arbitrary Z39.50 server for each query. The format is: z3950.loc.gov:7090/voyager amicus.nlc-bnc.ca:210/AMICUS etc. One thing I don't like about all of this is that it requires that the YAZ libraries be installed. That adds an extra step to the installation of Koha, although I don't think the YAZ license would restrict us from distributing it directly with Koha. Steve.

1 0