[Koha-cvs] CVS: koha/acqui.simple marcimport.pl,1.6,1.6.2.1
Alan Millar
amillar at users.sourceforge.net
Mon May 27 06:33:08 CEST 2002
Update of /cvsroot/koha/koha/acqui.simple
In directory usw-pr-cvs1:/tmp/cvs-serv9877
Modified Files:
Tag: rel-1-2
marcimport.pl
Log Message:
Some code cleanup. Created subroutines for ISBN checksum,
z3950 queue insert, and table-based form option selects
for item type and branch code (branch code select no longer
hard-coded).
Index: marcimport.pl
===================================================================
RCS file: /cvsroot/koha/koha/acqui.simple/marcimport.pl,v
retrieving revision 1.6
retrieving revision 1.6.2.1
diff -C2 -r1.6 -r1.6.2.1
*** marcimport.pl 1 Feb 2002 18:00:28 -0000 1.6
--- marcimport.pl 27 May 2002 04:33:05 -0000 1.6.2.1
***************
*** 1,18 ****
#!/usr/bin/perl
! my $lc1='#dddddd';
! my $lc2='#ddaaaa';
! use C4::Database;
use CGI;
use DBI;
! #use strict;
use C4::Acquisitions;
use C4::Output;
! my $dbh=C4Connect;
! my $userid=$ENV{'REMOTE_USER'};
! %tagtext = (
'001' => 'Control number',
'003' => 'Control number identifier',
--- 1,30 ----
#!/usr/bin/perl
+ # Script for handling import of MARC data into Koha db
+ # and Z39.50 lookups
! # Koha library project www.koha.org
+ # Licensed under the GPL
! #use strict;
!
! # standard or CPAN modules used
use CGI;
use DBI;
!
! # Koha modules used
! use C4::Database;
use C4::Acquisitions;
use C4::Output;
!
! #------------------
! # Constants
!
! # HTML colors for alternating lines
! my $lc1='#dddddd';
! my $lc2='#ddaaaa';
!
! my %tagtext = (
'001' => 'Control number',
'003' => 'Control number identifier',
***************
*** 72,104 ****
);
my $input = new CGI;
my $dbh=C4Connect;
print $input->header;
print startpage();
print startmenu('acquisitions');
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 '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";
}
}
}
! my $isbnfailed=0;
! if ($type eq 'isbn') {
! my $q=$query;
$q=~s/[^X\d]//g;
$q=~s/X.//g;
--- 84,190 ----
);
+ #-------------
+ # Initialize
+
+ my $userid=$ENV{'REMOTE_USER'};
my $input = new CGI;
my $dbh=C4Connect;
+ #-------------
+ # Display output
print $input->header;
print startpage();
print startmenu('acquisitions');
+
+ #-------------
+ # Process input parameters
my $file=$input->param('file');
if ($input->param('z3950queue')) {
my $query=$input->param('query');
!
my @serverlist;
+
+ my $isbngood=1;
+ if ($input->param('type') eq 'isbn') {
+ $isbngood=CheckIsbn($query);
+ }
+ if ($isbngood) {
foreach ($input->param) {
if (/S-(.*)/) {
my $server=$1;
if ($server eq 'MAN') {
! push @serverlist, "MAN/".$input->param('manualz3950server')."//"
! ;
} else {
! push @serverlist, $server;
! }
! }
! }
!
! Addz3950queue($input->param('query'), $input->param('type'),
! $input->param('rand'), @serverlist);
! } else {
! print "<font color=red size=+1>$query is not a valid ISBN
! Number</font><p>\n";
! }
! }
!
! sub Addz3950queue {
! use strict;
! my (
! $query, # value to look up
! $type, # type of value ("isbn", "lccn", etc).
! $requestid,
! @z3950list, # list of z3950 servers to query
! )=@_;
!
! my (
! @serverlist,
! $server,
! $failed,
! );
!
! # list of servers: entry can be a fully qualified URL-type entry
! # or simply just a server ID number.
!
! my $sth=$dbh->prepare("select host,port,db,userid,password
! from z3950servers
! where id=? ");
! foreach $server (@z3950list) {
! if ($server =~ /:/ ) {
! push @serverlist, $server;
! } else {
! $sth->execute($server);
my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
push @serverlist, "$server/$host\:$port/$db/$userid/$password";
}
}
+
+ my $serverlist='';
+ foreach (@serverlist) {
+ $serverlist.="$_ ";
}
! chop $serverlist;
!
! # Don't allow reinsertion of the same request number.
! my $sth=$dbh->prepare("select identifier from z3950queue
! where identifier=?");
! $sth->execute($requestid);
! unless ($sth->rows) {
! $sth=$dbh->prepare("insert into z3950queue
! (term,type,servers, identifier)
! values (?, ?, ?, ?)");
! $sth->execute($query, $type, $serverlist, $requestid);
! }
! } # sub
!
! #--------------------------------------
! sub CheckIsbn {
! my ($q)=@_ ;
!
! my $isbngood = 0;
!
$q=~s/[^X\d]//g;
$q=~s/X.//g;
***************
*** 115,148 ****
($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 $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;
! }
! }
}
if (my $data=$input->param('uploadmarc')) {
my $name=$input->param('name');
--- 201,218 ----
($c==10) && ($c='X');
if ($c eq $checksum) {
+ $isbngood=1;
} else {
! $isbngood=0;
}
} else {
! $isbngood=0;
}
+ return $isbngood;
+
+ } # sub CheckIsbn
+
+
+
if (my $data=$input->param('uploadmarc')) {
my $name=$input->param('name');
***************
*** 172,176 ****
my $q_issn=$dbh->quote((($issn) || ('NIL')));
my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
! $sth=$dbh->prepare("insert into marcrecorddone values ($q_origisbn, $q_origissn, $q_origlccn, $q_origcontrolnumber)");
$sth->execute;
my $sth=$dbh->prepare("select biblionumber,biblioitemnumber from biblioitems where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
--- 242,246 ----
my $q_issn=$dbh->quote((($issn) || ('NIL')));
my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
! my $sth=$dbh->prepare("insert into marcrecorddone values ($q_origisbn, $q_origissn, $q_origlccn, $q_origcontrolnumber)");
$sth->execute;
my $sth=$dbh->prepare("select biblionumber,biblioitemnumber from biblioitems where issn=$q_issn or isbn=$q_isbn or lccn=$q_lccn");
***************
*** 279,282 ****
--- 349,354 ----
}
my $title=$input->param('title');
+
+ # Get next barcode, or pick random one if none exist yet
$sth=$dbh->prepare("select max(barcode) from items");
$sth->execute;
***************
*** 286,289 ****
--- 358,365 ----
$barcode=int(rand()*1000000);
}
+
+ my $branchselect=GetKeyTableSelectOptions(
+ $dbh, 'branches', 'branchcode', 'branchname', 0);
+
print << "EOF";
<table border=0 cellpadding=10 cellspacing=0>
***************
*** 299,303 ****
<input type=hidden name=file value=$file>
<table border=0>
! <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>
</tr><td>Replacement Price:</td><td><input name=replacementprice size=10></td></tr>
<tr><td>Notes</td><td><textarea name=notes rows=4 cols=40
--- 375,382 ----
<input type=hidden name=file value=$file>
<table border=0>
! <tr><td>BARCODE</td><td><input name=barcode size=10 value=$barcode>
!
! Home Branch: <select name=homebranch> $branchselect </select></td></tr>
!
</tr><td>Replacement Price:</td><td><input name=replacementprice size=10></td></tr>
<tr><td>Notes</td><td><textarea name=notes rows=4 cols=40
***************
*** 623,632 ****
$origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
! 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";
! }
($qissn) || ($qissn='NIL');
($qlccn) || ($qlccn='NIL');
--- 702,710 ----
$origcontrolnumber=$input->hidden(-name=>'origcontrolnumber', -default=>$controlnumber);
! #print "<PRE>getting itemtypeselect</PRE>\n";
! $itemtypeselect=&GetKeyTableSelectOptions(
! $dbh, 'itemtypes', 'itemtype', 'description', 1);
! #print "<PRE>it=$itemtypeselect</PRE>\n";
!
($qissn) || ($qissn='NIL');
($qlccn) || ($qlccn='NIL');
***************
*** 634,638 ****
--- 712,718 ----
($qcontrolnumber) || ($qcontrolnumber='NIL');
$controlnumber=~s/\s+//g;
+
unless (($isbn eq $qisbn) || ($issn eq $qissn) || ($lccn eq $qlccn) || ($controlnumber eq $qcontrolnumber)) {
+ #print "<PRE>Skip record $isbn $issn $lccn </PRE>\n";
next RECORD;
}
***************
*** 945,949 ****
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";
--- 1025,1029 ----
sub z3950 {
! my $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";
***************
*** 1175,1176 ****
--- 1255,1295 ----
return @records;
}
+
+ #---------------
+ # Create an HTML option list for a <SELECT> form tag by using
+ # values from a DB file
+ sub GetKeyTableSelectOptions {
+ # inputs
+ my (
+ $dbh, # DBI handle
+ $tablename, # name of table containing list of choices
+ $keyfieldname, # column name of code to use in option list
+ $descfieldname, # column name of descriptive field
+ $showkey, # flag to show key in description
+ )=@_;
+ my $selectclause; # return value
+
+ my (
+ $sth, $query,
+ $key, $desc, $orderfieldname,
+ );
+ my $debug=0;
+
+ if ( $showkey ) {
+ $orderfieldname=$keyfieldname;
+ } else {
+ $orderfieldname=$descfieldname;
+ }
+ $query= "select $keyfieldname,$descfieldname
+ from $tablename
+ order by $orderfieldname ";
+ print "<PRE>Query=$query </PRE>\n" if $debug;
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ while ( ($key, $desc) = $sth->fetchrow) {
+ if ($showkey) { $desc="$key - $desc"; }
+ $selectclause.="<option value='$key'>$desc\n";
+ print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
+ }
+ return $selectclause;
+ } # sub GetKeyTableSelectOptions
More information about the Koha-cvs
mailing list