#!/usr/bin/perl
+# $Id$
+
# Script for handling import of MARC data into Koha db
# and Z39.50 lookups
# Licensed under the GPL
-#use strict;
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
# standard or CPAN modules used
use CGI;
use DBI;
# Koha modules used
-use C4::Database;
-use C4::Acquisitions;
+use C4::Context;
+use C4::Output;
+use C4::Charset;
+use C4::Input;
+use C4::Biblio;
+use MARC::File::USMARC;
+use HTML::Template;
use C4::Output;
+use C4::Auth;
#------------------
# Constants
+my $includes = C4::Context->config('includes') ||
+ "/usr/local/www/hdl/htdocs/includes";
+
# HTML colors for alternating lines
my $lc1='#dddddd';
my $lc2='#ddaaaa';
-my %tagtext = (
- '001' => 'Control number',
- '003' => 'Control number identifier',
- '005' => 'Date and time of latest transaction',
- '006' => 'Fixed-length data elements -- additional material characteristics',
- '007' => 'Physical description fixed field',
- '008' => 'Fixed length data elements',
- '010' => 'LCCN',
- '015' => 'LCCN Cdn',
- '020' => 'ISBN',
- '022' => 'ISSN',
- '037' => 'Source of acquisition',
- '040' => 'Cataloging source',
- '041' => 'Language code',
- '043' => 'Geographic area code',
- '050' => 'Library of Congress call number',
- '060' => 'National Library of Medicine call number',
- '082' => 'Dewey decimal call number',
- '100' => 'Main entry -- Personal name',
- '110' => 'Main entry -- Corporate name',
- '130' => 'Main entry -- Uniform title',
- '240' => 'Uniform title',
- '245' => 'Title statement',
- '246' => 'Varying form of title',
- '250' => 'Edition statement',
- '256' => 'Computer file characteristics',
- '260' => 'Publication, distribution, etc.',
- '263' => 'Projected publication date',
- '300' => 'Physical description',
- '306' => 'Playing time',
- '440' => 'Series statement / Added entry -- Title',
- '490' => 'Series statement',
- '500' => 'General note',
- '504' => 'Bibliography, etc. note',
- '505' => 'Formatted contents note',
- '508' => 'Creation/production credits note',
- '510' => 'Citation/references note',
- '511' => 'Participant or performer note',
- '520' => 'Summary, etc. note',
- '521' => 'Target audience note (ie age)',
- '530' => 'Additional physical form available note',
- '538' => 'System details note',
- '586' => 'Awards note',
- '600' => 'Subject added entry -- Personal name',
- '610' => 'Subject added entry -- Corporate name',
- '650' => 'Subject added entry -- Topical term',
- '651' => 'Subject added entry -- Geographic name',
- '656' => 'Index term -- Occupation',
- '700' => 'Added entry -- Personal name',
- '710' => 'Added entry -- Corporate name',
- '730' => 'Added entry -- Uniform title',
- '740' => 'Added entry -- Uncontrolled related/analytical title',
- '800' => 'Series added entry -- Personal name',
- '830' => 'Series added entry -- Uniform title',
- '852' => 'Location',
- '856' => 'Electronic location and access',
-);
-
+#-------------
#-------------
# Initialize
my $userid=$ENV{'REMOTE_USER'};
my $input = new CGI;
-my $dbh=C4Connect;
+my $dbh = C4::Context->dbh;
+
+my $uploadmarc=$input->param('uploadmarc');
+my $overwrite_biblio = $input->param('overwrite_biblio');
+my $filename = $input->param('filename');
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "acqui.simple/marcimport.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+$template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'},
+ uploadmarc => $uploadmarc);
+if ($uploadmarc && length($uploadmarc)>0) {
+ my $marcrecord='';
+ while (<$uploadmarc>) {
+ $marcrecord.=$_;
+ }
+ my @marcarray = split /\x1D/, $marcrecord;
+ my $dbh = C4::Context->dbh;
+ my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
+ my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
+ my $searchbreeding = $dbh->prepare("select id from marc_breeding where isbn=?");
+ my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc) values(?,?,?,?,?)");
+ my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=? where id=?");
+ # fields used for import results
+ my $imported=0;
+ my $alreadyindb = 0;
+ my $alreadyinfarm = 0;
+ my $notmarcrecord = 0;
+ for (my $i=0;$i<=$#marcarray;$i++) {
+ my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D");
+ if (ref($marcrecord) eq undef) {
+ $notmarcrecord++;
+ } else {
+ my $oldbiblio = MARCmarc2koha($dbh,$marcrecord);
+ $oldbiblio->{title} = char_decode($oldbiblio->{title});
+ $oldbiblio->{author} = char_decode($oldbiblio->{author});
+ # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
+ # drop every "special" char : spaces, - ...
+ $oldbiblio->{isbn} =~ s/ |-|\.//g,
+ # search if biblio exists
+ my $biblioitemnumber;
+ if ($oldbiblio->{isbn}) {
+ $searchisbn->execute($oldbiblio->{isbn});
+ ($biblioitemnumber) = $searchisbn->fetchrow;
+ } else {
+ $searchissn->execute($oldbiblio->{issn});
+ ($biblioitemnumber) = $searchissn->fetchrow;
+ }
+ if ($biblioitemnumber) {
+ $alreadyindb++;
+ } else {
+ # search in breeding farm
+ my $breedingid;
+ if ($oldbiblio->{isbn}) {
+ $searchbreeding->execute($oldbiblio->{isbn});
+ ($breedingid) = $searchbreeding->fetchrow;
+ } else {
+ $searchbreeding->execute($oldbiblio->{issn});
+ ($breedingid) = $searchbreeding->fetchrow;
+ }
+ if (!$breedingid || $overwrite_biblio) {
+ my $recoded;
+ $recoded = $marcrecord->as_usmarc();
+ if ($breedingid) {
+ $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$breedingid);
+ } else {
+ $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded);
+ }
+ $imported++;
+ } else {
+ $alreadyinfarm++;
+ }
+ }
+ }
+ }
+ $template->param(imported => $imported,
+ alreadyindb => $alreadyindb,
+ alreadyinfarm => $alreadyinfarm,
+ notmarcrecord => $notmarcrecord,
+ total => $imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
+ );
-#-------------
-# Display output
-print $input->header;
-print startpage();
-print startmenu('acquisitions');
+}
-#-------------
-# Process input parameters
-my $file=$input->param('file');
+print $input->header(
+ -type => guesstype($template->output),
+ -cookie => $cookie
+),$template->output;
+my $menu;
+my $file;
-if ($input->param('z3950queue')) {
- my $query=$input->param('query');
-
- my @serverlist;
+# Process a MARC file : show list of records, of 1 record detail, if numrecord exists
+sub ProcessFile {
+ # A MARC file has been specified; process it for review form
+ use strict;
+ # Input params
+ my (
+ $input,
+ )=@_;
- 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);
+ # local vars
+ my (
+ $sth,
+ $record,
+ );
+
+ my $debug=0;
+
+ # See if a particular result item was specified
+ my $numrecord = $input->param('numrecord');
+ if ($numrecord) {
+ ProcessRecord($dbh,$input,$numrecord);
} else {
- print "<font color=red size=+1>$query is not a valid ISBN
- Number</font><p>\n";
+ # No result item specified, list results
+ ListFileRecords($dbh,$input);
+ } # if
+} # sub ProcessFile
+
+# show 1 record from the MARC file
+sub ProcessRecord {
+ my ($dbh, $input,$numrecord) = @_;
+ # local vars
+ my (
+ $sth,
+ $record,
+ $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;
+ }
+
+ my $file=MARC::File::USMARC->indata ($data);
+ my $oldkoha;
+ for (my $i=1;$i<$numrecord;$i++) {
+ $record = $file->next;
}
+ if ($record) {
+ $oldkoha=MARCmarc2koha($dbh,$record);
+ }
+ my $template=gettemplate('marcimport/marcimportdetail.tmpl');
+ $oldkoha->{additionalauthors} =~ s/ \| /\n/g;
+ $oldkoha =~ s/\|/\n/g;
+ $template->param($oldkoha);
+#---- build MARC array for template
+ my @loop = ();
+ my $tagmeaning = &MARCgettagslib($dbh,1);
+ my @fields = $record->fields();
+ my $color=0;
+ my $lasttag="";
+ foreach my $field (@fields) {
+ my @subfields=$field->subfields();
+ foreach my $subfieldcount (0..$#subfields) {
+ my %row_data;
+ if ($lasttag== $field->tag()) {
+ $row_data{tagid} = "";
+ } else {
+ $row_data{tagid} = $field->tag();
+ }
+ $row_data{subfield} = $subfields[$subfieldcount][0];
+ $row_data{tagmean} = $tagmeaning->{$field->tag()}->{$subfields[$subfieldcount][0]};
+ $row_data{tagvalue}= $subfields[$subfieldcount][1];
+ if ($color ==0) {
+ $color=1;
+ $row_data{color} = $lc1;
+ } else {
+ $color=0;
+ $row_data{color} = $lc2;
+ }
+ push(@loop,\%row_data);
+ $lasttag=$field->tag();
+ }
+ }
+ $template->param(MARC => \@loop);
+ $template->param(numrecord => $numrecord);
+ $template->param(file => $data);
+ print "Content-Type: text/html\n\n", $template->output;
}
-sub Addz3950queue {
+# lists all records from the MARC file
+sub ListFileRecords {
use strict;
+
+ # Input parameters
my (
- $query, # value to look up
- $type, # type of value ("isbn", "lccn", etc).
- $requestid,
- @z3950list, # list of z3950 servers to query
+ $dbh, # FIXME - Unused argument
+ $input,
)=@_;
my (
- @serverlist,
- $server,
- $failed,
+ $sth, $sti,
+ $field,
+ $data, # records in MARC file format
+ $name,
+ $srvid,
+ %servernames,
+ $serverdb,
);
- # list of servers: entry can be a fully qualified URL-type entry
- # or simply just a server ID number.
+ my $z3950=0;
+ my $recordsource;
+ my $record;
+ my ($numrecords,$resultsid,$data,$startdate,$enddate);
+ # FIXME - there's already a $data a few lines above.
- 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";
- }
- }
+ $dbh = C4::Context->dbh;
- 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;
- 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) {
- $isbngood=1;
+ my $template=gettemplate('marcimport/ListFileRecords.tmpl');
+ # File can be z3950 search query or uploaded MARC data
+
+ # if z3950 results
+ if (not $file=~/Z-(\d+)/) {
+ # This is a Marc upload
+ $sth=$dbh->prepare("select marc,name from uploadedmarc where id=$file");
+ $sth->execute;
+ ($data, $name) = $sth->fetchrow;
+ $template->param(IS_MARC => 1);
+ $template->param(recordsource => $name);
+ }
+
+ if ($file=~/Z-(\d+)/) {
+ # This is a z3950 search
+ $template->param(IS_Z3950 =>1);
+ my $id=$1; # search query id number
+ my $serverstring;
+ my $starttimer=time();
+
+ $sth=$dbh->prepare("
+ select z3950results.numrecords,z3950results.id,z3950results.results,
+ z3950results.startdate,z3950results.enddate,server
+ from z3950queue left outer join z3950results
+ on z3950queue.id=z3950results.queryid
+ where z3950queue.id=?
+ order by server
+ ");
+ $sth->execute($id);
+ if ( $sth->rows ) {
+ # loop through all servers in search results
+ while ( ($numrecords,$resultsid,$data,
+ $startdate,$enddate,$serverstring) = $sth->fetchrow ) {
+ my ($srvid, $server, $database, $auth) = split(/\//, $serverstring, 4);
+ if ( $server ) {
+ my $srvname=&z3950servername($dbh,$srvid,"$server/$database");
+ $template->param(srvid => $srvid);
+ $template->param(srvname => $srvname);
+ } # if $server
+ my $startrecord=$input->param("ST-$srvid");
+ ($startrecord) || ($startrecord='0');
+ my $serverplaceholder='';
+ foreach ($input->param) {
+ (next) unless (/ST-(.+)/);
+ my $serverid=$1;
+ (next) if ($serverid eq $srvid);
+ my $place=$input->param("ST-$serverid");
+ $serverplaceholder.="\&ST-$serverid=$place";
+ }
+ if ($numrecords) {
+ $template->param(HAS_NUMRECORDS => 1);
+ my $previous='';
+ my $next='';
+ if ($startrecord>0) {
+ $previous="<a href=".$ENV{'SCRIPT_NAME'}."?file=Z-$id&menu=z3950$serverplaceholder\&ST-$srvid=".($startrecord-10)."#SERVER-$srvid>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-$srvid=$highest#SERVER-$srvid>Next</a>";
+ }
+ $template->param(startrecord => $startrecord+1);
+ $template->param(highest => $highest);
+ $template->param(numrecords => $numrecords);
+ $template->param(previous => $previous);
+ $template->param(next => $next);
+ my $stj=$dbh->prepare("update z3950results
+ set highestseen=? where id=?");
+ $stj->execute($startrecord+10,$resultsid);
+ }
+
+ if (! $server ) {
+ $template->param(PENDING => 1);
+ } 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;
+ }
+ $template->param(elapsedtime => $elapsedtime);
+ } elsif ($numrecords) {
+ my @loop = ();
+ my $z3950file=MARC::File::USMARC->indata ($data);
+ while (my $record=$z3950file->next) {
+ my $oldkoha = MARCmarc2koha($dbh,$record);
+ my %row = ResultRecordLink($dbh,$oldkoha,$resultsid);
+ push(@loop,\%row);
+ }
+ $template->param(LINES => \@loop);
+ } else {
+ }
+# print "</ul>\n";
+ } # foreach server
+ my $elapsed=time()-$starttimer;
+# print "<hr>It took $elapsed seconds to process this page.\n";
} else {
- $isbngood=0;
- }
+ $template->param(NO_RECORDS =>1);
+ $template->param(id => $id);
+ } # if rows
+
} else {
- $isbngood=0;
- }
+#
+# This is an uploaded Marc record
+#
+ my @loop = ();
+ my $MARCfile = MARC::File::USMARC->indata($data);
+ my $num = 0;
+ while (my $record=$MARCfile->next) {
+ $num++;
+ my $oldkoha = MARCmarc2koha($dbh,$record);
+ my %row = ResultRecordLink($dbh,$oldkoha,'',$num);
+ push(@loop,\%row);
+ }
+ $template->param(LINES => \@loop);
+ } # if z3950 or marc upload
+ print "Content-Type: text/html\n\n", $template->output;
+} # sub ListFileRecords
+
+#--------------
+
+sub ResultRecordLink {
+ use strict;
+ my ($dbh,$oldkoha,$resultsid, $num)=@_; # input
+ # FIXME - $dbh as argument is no longer used
+ my (
+ $sth,
+ $bib, # hash ref to named fields
+ $searchfield, $searchvalue,
+ $donetext,
+ $fieldname,
+ );
+ my %row = ();
+
+ $dbh = C4::Context->dbh;
+
+# $bib=extractmarcfields($record);
+
+ $sth=$dbh->prepare("select *
+ from biblioitems
+ where (isbn=? and isbn!='') or (issn=? and issn!='') or (lccn=? and lccn!='') ");
+ $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
+ if ($sth->rows) {
+ $donetext="DONE";
+ } else {
+ $donetext="";
+ }
+ ($oldkoha->{author}) && ($oldkoha->{author}="by $oldkoha->{author}");
+
+ $searchfield="";
+ foreach $fieldname ( "controlnumber", "lccn", "issn", "isbn") {
+ if ( defined $oldkoha->{$fieldname} && $oldkoha->{$fieldname} ) {
+ $searchfield=$fieldname;
+ $searchvalue=$oldkoha->{$fieldname};
+ } # if defined fieldname
+ } # foreach
+ if ( $searchfield ) {
+ $row{SCRIPT_NAME} = $ENV{'SCRIPT_NAME'};
+ $row{donetext} = $donetext;
+ $row{file} = $file;
+# $row{resultsid} = $resultsid;
+# $row{searchfield} = $searchfield;
+# $row{searchvalue} = $searchvalue;
+ $row{numrecord} = $num;
+ $row{title} = $oldkoha->{title};
+ $row{author} = $oldkoha->{author};
+ } else {
+ $row{title} = "Error: Problem with <br>$bib->{title} $bib->{author}<br>";
+ } # if searchfield
+ return %row;
+} # sub PrintResultRecordLink
+
+#---------------------------------
- return $isbngood;
-} # sub CheckIsbn
+sub uploadmarc {
+ use strict;
+ my ($dbh)=@_; # FIXME - Unused argument
+ $dbh = C4::Context->dbh;
+ my $template=gettemplate('marcimport/uploadmarc.tmpl');
+ $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
+# 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>";
+ my @marc_loop = ();
+ while (my ($id, $name) = $sth->fetchrow) {
+ my %row;
+ $row{id} = $id;
+ $row{name} = $name;
+ push(@marc_loop, \%row);
+# print "<li><a href=$ENV{'SCRIPT_NAME'}?file=$id&menu=$menu>$name</a><br>\n";
+ }
+ $template->param(marc => \@marc_loop);
+ print "Content-Type: text/html\n\n", $template->output;
+
+}
+
+sub manual {
+}
+
+
+sub mainmenu {
+ my $template=gettemplate('marcimport/mainmenu.tmpl');
+ $template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'});
+ print "Content-Type: text/html\n\n", $template->output;
+} # sub mainmenu
+
+#---------------------------------------------
+sub AcceptMarcUpload {
+ use strict;
+ my (
+ $dbh, # DBI handle
+ # FIXME - Unused argument
+ $input, # CGI parms
+ )=@_;
+
+ $dbh = C4::Context->dbh;
-if (my $data=$input->param('uploadmarc')) {
my $name=$input->param('name');
- ($name) || ($name=$data);
+ my $data=$input->param('uploadmarc');
my $marcrecord='';
+
+ ($name) || ($name=$data);
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)");
+ my $sth=$dbh->prepare("insert into uploadedmarc
+ (marc,name)
+ values ($q_marcrecord, $q_name)");
$sth->execute;
-}
+} # sub AcceptMarcUpload
+#-------------------------------------------
+sub AcceptBiblioitem {
+ use strict;
+ my (
+ $dbh, # FIXME - Unused argument
+ $input,
+ )=@_;
-if ($input->param('insertnewrecord')) {
- my $isbn=$input->param('isbn');
- my $issn=$input->param('issn');
- my $lccn=$input->param('lccn');
- my $q_origisbn=$dbh->quote($input->param('origisbn'));
- my $q_origissn=$dbh->quote($input->param('origissn'));
- my $q_origlccn=$dbh->quote($input->param('origlccn'));
- my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
- my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
- 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");
- $sth->execute;
my $biblionumber=0;
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";
+ my $sth;
+ my $record;
+
+ $dbh = C4::Context->dbh;
+
+# my $isbn=$input->param('isbn');
+# my $issn=$input->param('issn');
+# my $lccn=$input->param('lccn');
+# my $q_origisbn=$dbh->quote($input->param('origisbn'));
+# my $q_origissn=$dbh->quote($input->param('origissn'));
+# my $q_origlccn=$dbh->quote($input->param('origlccn'));
+# my $q_origcontrolnumber=$dbh->quote($input->param('origcontrolnumber'));
+ my $title=$input->param('title');
+
+# my $q_isbn=$dbh->quote((($isbn) || ('NIL')));
+# my $q_issn=$dbh->quote((($issn) || ('NIL')));
+# my $q_lccn=$dbh->quote((($lccn) || ('NIL')));
+ my $file= MARC::File::USMARC->indata($input->param('file'));
+ my $numrecord = $input->param('numrecord');
+ if ($numrecord) {
+ for (my $i=1;$i<$numrecord;$i++) {
+ $record=$file->next;
+ }
+ } else {
+ print STDERR "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined\n";
+ print "Error in marcimport.pl/Acceptbiblioitem : numrecord not defined : contact administrator\n";
+ }
+ my $template=gettemplate('marcimport/AcceptBiblioitem.tmpl');
+
+ my $oldkoha = MARCmarc2koha($dbh,$record);
+ # See if it already exists
+ # FIXME - There's already a $sth in this context.
+ my $sth=$dbh->prepare("select biblionumber,biblioitemnumber
+ from biblioitems
+ where isbn=? or issn=? or lccn=?");
+ $sth->execute($oldkoha->{isbn},$oldkoha->{issn},$oldkoha->{lccn});
if ($sth->rows) {
+ # Already exists
+
($biblionumber, $biblioitemnumber) = $sth->fetchrow;
- my $title=$input->param('title');
- print << "EOF";
- <table border=0 width=50% cellpadding=10 cellspacing=0>
- <tr><th bgcolor=black><font color=white>Record already in database</font></th></tr>
- <tr><td bgcolor=#dddddd>$title is already in the database with biblionumber $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
- </table>
- <p>
-EOF
+ $template->param(title => $title);
+ $template->param(biblionumber => $biblionumber);
+ $template->param(biblioitemnumber => $biblioitemnumber);
+ $template->param(BIBLIO_EXISTS => 1);
+
} else {
- use strict;
- my $error;
- my %biblio;
- my %biblioitem;
-
- # convert to upper case and split on lines
- my $subjectheadings=$input->param('subject');
- my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
-
- my $additionalauthors=$input->param('additionalauthors');
- my @additionalauthors=split(/[\r\n]+/,uc($additionalauthors));
-
- # Use individual assignments to hash buckets, in case
- # any of the input parameters are empty or don't exist
- $biblio{title} =$input->param('title');
- $biblio{author} =$input->param('author');
- $biblio{copyright} =$input->param('copyrightdate');
- $biblio{seriestitle} =$input->param('seriestitle');
- $biblio{notes} =$input->param('notes');
- $biblio{abstract} =$input->param('abstract');
- $biblio{subtitle} =$input->param('subtitle');
-
- $biblioitem{volume} =$input->param('volume');
- $biblioitem{number} =$input->param('number');
- $biblioitem{itemtype} =$input->param('itemtype');
- $biblioitem{isbn} =$input->param('isbn');
- $biblioitem{issn} =$input->param('issn');
- $biblioitem{dewey} =$input->param('dewey');
- $biblioitem{subclass} =$input->param('subclass');
- $biblioitem{publicationyear} =$input->param('publicationyear');
- $biblioitem{publishercode} =$input->param('publishercode');
- $biblioitem{volumedate} =$input->param('volumedate');
- $biblioitem{volumeddesc} =$input->param('volumeddesc');
- $biblioitem{illus} =$input->param('illustrator');
- $biblioitem{pages} =$input->param('pages');
- $biblioitem{notes} =$input->param('notes');
+ # It doesn't exist; add it.
+
+ my $error;
+ my %biblio;
+ my %biblioitem;
+
+ # convert to upper case and split on lines
+ my $subjectheadings=$input->param('subject');
+ my @subjectheadings=split(/[\r\n]+/,$subjectheadings);
+
+ my $additionalauthors=$input->param('additionalauthors');
+ my @additionalauthors=split(/[\r\n]+|\|/,uc($additionalauthors));
+ # FIXME - WTF are the additional authors
+ # converted to upper case?
+
+ # Use individual assignments to hash buckets, in case
+ # any of the input parameters are empty or don't exist
+ $biblio{title} =$input->param('title');
+ $biblio{author} =$input->param('author');
+ $biblio{copyright} =$input->param('copyrightdate');
+ $biblio{seriestitle} =$input->param('seriestitle');
+ $biblio{notes} =$input->param('notes');
+ $biblio{abstract} =$input->param('abstract');
+ $biblio{subtitle} =$input->param('subtitle');
+
+ $biblioitem{volume} =$input->param('volume');
+ $biblioitem{number} =$input->param('number');
+ $biblioitem{itemtype} =$input->param('itemtype');
+ $biblioitem{isbn} =$input->param('isbn');
+ $biblioitem{issn} =$input->param('issn');
+ $biblioitem{dewey} =$input->param('dewey');
+ $biblioitem{subclass} =$input->param('subclass');
+ $biblioitem{publicationyear} =$input->param('publicationyear');
+ $biblioitem{publishercode} =$input->param('publishercode');
+ $biblioitem{volumedate} =$input->param('volumedate');
+ $biblioitem{volumeddesc} =$input->param('volumeddesc');
+ $biblioitem{illus} =$input->param('illustrator');
+ $biblioitem{pages} =$input->param('pages');
+ $biblioitem{notes} =$input->param('notes');
$biblioitem{size} =$input->param('size');
$biblioitem{place} =$input->param('place');
$biblioitem{lccn} =$input->param('lccn');
- $biblioitem{marc} =$input->param('marc');
-
- print "<PRE>subjects=@subjectheadings</PRE>\n";
- print "<PRE>auth=@additionalauthors</PRE>\n";
-
- ($biblionumber, $biblioitemnumber, $error)=
- NewBiblioItem($dbh,
- \%biblio,
- \%biblioitem,
- \@subjectheadings,
- \@additionalauthors
- );
-
-
- my $title=$input->param('title');
- print << "EOF";
- <table cellpadding=10 cellspacing=0 border=0 width=50%>
- <tr><th bgcolor=black><font color=white>Record entered into database</font></th></tr>
- <tr><td bgcolor=#dddddd>$title has been entered into the database with biblionumber
- $biblionumber and biblioitemnumber $biblioitemnumber</td></tr>
- </table>
-EOF
+ $biblioitem{marc} =$input->param('marc');
+# print STDERR $record->as_formatted();
+# die;
+ ($biblionumber, $biblioitemnumber, $error)=
+ ALLnewbiblio($dbh,$record,\%biblio,\%biblioitem);
+# (1,2,0);
+# newcompletebiblioitem($dbh,
+# \%biblio,
+# \%biblioitem,
+# \@subjectheadings,
+# \@additionalauthors
+# );
+
+ if ( $error ) {
+ print "<H2>Error adding biblio item</H2> $error\n";
+ } else {
+ $template->param(title => $title);
+ $template->param(biblionumber => $biblionumber);
+ $template->param(biblioitemnumber => $biblioitemnumber);
+ $template->param(BIBLIO_CREATE => 1);
+ } # if error
} # if new record
-
- my $title=$input->param('title');
+ my $barcode;
# Get next barcode, or pick random one if none exist yet
$sth=$dbh->prepare("select max(barcode) from items");
$sth->execute;
- my ($barcode) = $sth->fetchrow;
+ ($barcode) = $sth->fetchrow;
$barcode++;
if ($barcode==1) {
$barcode=int(rand()*1000000);
}
-
- my $branchselect=GetKeyTableSelectOptions(
+ my $branchselect=getkeytableselectoptions(
$dbh, 'branches', 'branchcode', 'branchname', 0);
+ $template->param(barcode => $barcode);
+ $template->param(branchselect => $branchselect);
+ print "Content-Type: text/html\n\n", $template->output;
- print << "EOF";
- <table border=0 cellpadding=10 cellspacing=0>
- <tr><th bgcolor=black><font color=white>
-Add a New Item for $title
-</font>
-</th></tr>
-<tr><td bgcolor=#dddddd>
-<form>
-<input type=hidden name=newitem value=1>
-<input type=hidden name=biblionumber value=$biblionumber>
-<input type=hidden name=biblioitemnumber value=$biblioitemnumber>
-<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
-wrap=physical></textarea></td></tr>
-</table>
-</td></tr>
-</table>
-<p>
-<input type=submit value="Add Item">
-</form>
-EOF
-print endmenu();
-print endpage();
-
-exit;
-}
-
-sub NewBiblioItem {
- use strict;
-
- my ( $dbh, # DBI handle
- $biblio, # hash ref to biblio record
- $biblioitem, # hash ref to biblioitem record
- $subjects, # list ref of subjects
- $addlauthors, # list ref of additional authors
- )=@_ ;
-
- my ( $biblionumber, $biblioitemnumber, $error); # return values
-
- my $debug=1;
- my $sth;
- my $subjectheading;
- my $additionalauthor;
-
- #--------
-
- print "<PRE>Trying to add biblio item Title=$biblio->{title} " .
- "ISBN=$biblioitem->{isbn} </PRE>\n" if $debug;
-
- # Make sure master biblio entry exists
- $biblionumber=GetOrAddBiblio($dbh, $biblio);
-
- # Get next biblioitemnumber
- $sth=$dbh->prepare("select max(biblioitemnumber) from biblioitems");
- $sth->execute;
- ($biblioitemnumber) = $sth->fetchrow;
- $biblioitemnumber++;
-
- print "<PRE>Next biblio item is $biblioitemnumber</PRE>\n" if $debug;
-
- $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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" );
-
- $sth->execute(
- $biblioitemnumber,
- $biblionumber,
- $biblioitem->{volume},
- $biblioitem->{number},
- $biblioitem->{itemtype},
- $biblioitem->{isbn},
- $biblioitem->{issn},
- $biblioitem->{dewey},
- $biblioitem->{subclass},
- $biblioitem->{publicationyear},
- $biblioitem->{publishercode},
- $biblioitem->{volumedate},
- $biblioitem->{volumeddesc},
- $biblioitem->{illus},
- $biblioitem->{pages},
- $biblioitem->{notes},
- $biblioitem->{size},
- $biblioitem->{place},
- $biblioitem->{lccn},
- $biblioitem->{marc} );
-
- $sth=$dbh->prepare("insert into bibliosubject
- (biblionumber,subject)
- values (?, ? )" );
- foreach $subjectheading (@{$subjects} ) {
- $sth->execute($biblionumber, $subjectheading);
- }
-
- $sth=$dbh->prepare("insert into additionalauthors
- (biblionumber,author)
- values (?, ? )");
- foreach $additionalauthor (@{$addlauthors} ) {
- $sth->execute($biblionumber, $additionalauthor);
- }
-
- return ( $biblionumber, $biblioitemnumber, $error);
-
-} # sub NewBiblioItem
+} # sub ItemCopyForm
#---------------------------------------
-# Find a biblio entry, or create a new one if it doesn't exist.
-sub GetOrAddBiblio {
- use strict; # in here until rest cleaned up
- # input params
- my (
- $dbh, # db handle
- $biblio, # hash ref to fields
- )=@_;
-
- # return
- my $biblionumber;
-
- my $debug=1;
- my $sth;
-
- #-----
- print "<PRE>Looking for biblio </PRE>\n" if $debug;
- $sth=$dbh->prepare("select biblionumber
- from biblio
- where title=? and author=?
- and copyrightdate=? and seriestitle=?");
- $sth->execute(
- $biblio->{title}, $biblio->{author},
- $biblio->{copyright}, $biblio->{seriestitle} );
- if ($sth->rows) {
- ($biblionumber) = $sth->fetchrow;
- print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
- } else {
- # Doesn't exist. Add new one.
- print "<PRE>Adding biblio</PRE>\n" if $debug;
- $biblionumber=&newbiblio($biblio);
- print "<PRE>Added with biblio number $biblionumber</PRE>\n" if $debug;
- &newsubtitle($biblionumber,$biblio->{subtitle} );
- }
-
- return $biblionumber;
+# Accept form data to add an item copy
+sub AcceptItemCopy {
+ use strict;
+ my ( $dbh, $input )=@_;
+ # FIXME - $dbh argument unused
-} # sub GetOrAddBiblio
-#---------------------------------------
+ my $template=gettemplate('marcimport/AcceptItemCopy.tmpl');
-if ($input->param('newitem')) {
- use strict;
my $error;
+
+ $dbh = C4::Context->dbh;
+
my $barcode=$input->param('barcode');
my $replacementprice=($input->param('replacementprice') || 0);
- my $sth=$dbh->prepare("select barcode
- from items
+ my $sth=$dbh->prepare("select barcode
+ from items
where barcode=?");
$sth->execute($barcode);
if ($sth->rows) {
- print "<font color=red>Barcode '$barcode' has already been assigned.</font><p>\n";
+ $template->param(BARCODE_EXISTS => 1);
+ $template->param(barcode => $barcode);
} else {
# Insert new item into database
- $error=&newitems(
- { biblionumber=> $input->param('biblionumber'),
- biblioitemnumber=> $input->param('biblioitemnumber'),
- itemnotes=> $input->param('notes'),
- homebranch=> $input->param('homebranch'),
- replacementprice=> $replacementprice,
- },
- $barcode
- );
+ $error=&ALLnewitem($dbh,
+ { biblionumber=> $input->param('biblionumber'),
+ biblioitemnumber=> $input->param('biblioitemnumber'),
+ itemnotes=> $input->param('notes'),
+ homebranch=> $input->param('homebranch'),
+ replacementprice=> $replacementprice,
+ barcode => $barcode
+ }
+ );
if ( $error ) {
- print "<font color=red>Error: $error </font><p>\n";
+ $template->param(ITEM_ERROR => 1);
+ $template->param(error => $error);
} else {
-
- print "<font color=green>Item added with barcode $barcode
- </font><P>\n";
+ $template->param(ITEM_CREATED => 1);
+ $template->param(barcode => $barcode);
} # if error
} # if barcode exists
-}
+ print "Content-Type: text/html\n\n", $template->output;
+} # sub AcceptItemCopy
+#---------------------------------------
+sub FormatMarcText {
+ use strict;
-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');
- my $qlccn=$input->param('lccn');
- 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;
- }
+ # Input
+ my (
+ $fields, # list ref to MARC fields
+ )=@_;
+ # Return
+ my $marctext;
- $splitchar=chr(29);
- my @records;
- foreach $record (split(/$splitchar/, $data)) {
- my $marctext="<table border=0 cellspacing=0>\n";
- $marctext.="<tr><th colspan=3 bgcolor=black><font color=white>MARC RECORD</font></th></tr>\n";
- $leader=substr($record,0,24);
- $marctext.="<tr><td>Leader:</td><td colspan=2>$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;
- $marctext.="<tr><td bgcolor=$color valign=top>$tagtext{$tag}</td><td bgcolor=$color valign=top>$tag</td>";
- $splitchar3=chr(31);
- my @subfields=split(/$splitchar3/, $field);
- $indicator=$subfields[0];
- $field{'indicator'}=$indicator;
- my $firstline=1;
- if ($#subfields==0) {
- $marctext.="<td bgcolor=$color valign=top>$indicator</td></tr>";
- } else {
- my %subfields;
- $marctext.="<td bgcolor=$color valign=top><table border=0 cellspacing=0>\n";
- my $color2=$color;
- for ($i=1; $i<=$#subfields; $i++) {
- ($color2 eq $lc1) ? ($color2=$lc2) : ($color2=$lc1);
- my $text=$subfields[$i];
- my $subfieldcode=substr($text,0,1);
- my $subfield=substr($text,1);
- $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";
- if ($subfields{$subfieldcode}) {
- my $subfieldlist=$subfields{$subfieldcode};
- my @subfieldlist=@$subfieldlist;
- if ($#subfieldlist>=0) {
- push (@subfieldlist, $subfield);
- } else {
- @subfieldlist=($subfields{$subfieldcode}, $subfield);
- }
- $subfields{$subfieldcode}=\@subfieldlist;
- } else {
- $subfields{$subfieldcode}=$subfield;
- }
- }
- $marctext.="</table></td></tr>\n";
- $field{'subfields'}=\%subfields;
- }
- push (@record, \%field);
- }
- $marctext.="</table>\n";
- $marctext{\@record}=$marctext;
- $marc{\@record}=$record;
- push (@records, \@record);
- $counter++;
- }
-RECORD:
- foreach $record (@records) {
- my ($lccn, $isbn, $issn, $dewey, $author, $title, $place, $publisher, $publicationyear, $volume, $number, @subjects, $notes, $additionalauthors, $illustrator, $copyrightdate, $seriestitle);
- my $marctext=$marctext{$record};
- my $marc=$marc{$record};
- 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 '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'} eq '700') {
- my $name=$field->{'subfields'}->{'a'};
- if ($field->{'subfields'}->{'c'}=~/ill/) {
- $additionalauthors.="$name\n";
- } else {
- $illustrator=$name;
- }
- }
- if ($field->{'tag'} =~/^5/) {
- $notes.="$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;
- }
- }
- $titleinput=$input->textfield(-name=>'title', -default=>$title, -size=>40);
- $marcinput=$input->hidden(-name=>'marc', -default=>$marc);
- $subtitleinput=$input->textfield(-name=>'subtitle', -default=>$subtitle, -size=>40);
- $authorinput=$input->textfield(-name=>'author', -default=>$author);
- $illustratorinput=$input->textfield(-name=>'illustrator', -default=>$illustrator);
- $additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
- my $subject='';
- foreach (@subjects) {
- $subject.="$_\n";
- }
- $subjectinput=$input->textarea(-name=>'subject', -default=>$subject, -rows=>4, -cols=>40);
- $noteinput=$input->textarea(-name=>'notes', -default=>$notes, -rows=>4, -cols=>40, -wrap=>'physical');
- $copyrightinput=$input->textfield(-name=>'copyrightdate', -default=>$copyrightdate);
- $seriestitleinput=$input->textfield(-name=>'seriestitle', -default=>$seriestitle);
- $volumeinput=$input->textfield(-name=>'volume', -default=>$volume);
- $volumedateinput=$input->textfield(-name=>'volumedate', -default=>$volumedate);
- $volumeddescinput=$input->textfield(-name=>'volumeddesc', -default=>$volumeddesc);
- $numberinput=$input->textfield(-name=>'number', -default=>$number);
- $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
- $issninput=$input->textfield(-name=>'issn', -default=>$issn);
- $lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
- $isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
- $deweyinput=$input->textfield(-name=>'dewey', -default=>$dewey);
- $cleanauthor=$author;
- $cleanauthor=~s/[^A-Za-z]//g;
- $subclassinput=$input->textfield(-name=>'subclass', -default=>uc(substr($cleanauthor,0,3)));
- $publisherinput=$input->textfield(-name=>'publishercode', -default=>$publisher);
- $pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
- $placeinput=$input->textfield(-name=>'place', -default=>$place);
- $pagesinput=$input->textfield(-name=>'pages', -default=>$pages);
- $sizeinput=$input->textfield(-name=>'size', -default=>$size);
- $fileinput=$input->hidden(-name=>'file', -default=>$file);
- $origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
- $origissn=$input->hidden(-name=>'origissn', -default=>$issn);
- $origlccn=$input->hidden(-name=>'origlccn', -default=>$lccn);
- $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');
- ($qisbn) || ($qisbn='NIL');
- ($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;
- }
+ my (
+ $color,
+ $field,
+ $tag,
+ $label,
+ $indicator,
+ $subfieldcode,$subfieldvalue,
+ @values, $value
+ );
+ my $debug=0;
- print << "EOF";
- <center>
- <h1>New Record</h1>
- Full MARC Record available at bottom
- <form method=post>
- <table border=1>
- <tr><td>Title</td><td>$titleinput</td></tr>
- <tr><td>Subtitle</td><td>$subtitleinput</td></tr>
- <tr><td>Author</td><td>$authorinput</td></tr>
- <tr><td>Additional Authors</td><td>$additionalauthorsinput</td></tr>
- <tr><td>Illustrator</td><td>$illustratorinput</td></tr>
- <tr><td>Copyright</td><td>$copyrightinput</td></tr>
- <tr><td>Series Title</td><td>$seriestitleinput</td></tr>
- <tr><td>Volume</td><td>$volumeinput</td></tr>
- <tr><td>Number</td><td>$numberinput</td></tr>
- <tr><td>Volume Date</td><td>$volumedateinput</td></tr>
- <tr><td>Volume Description</td><td>$volumeddescinput</td></tr>
- <tr><td>Subject</td><td>$subjectinput</td></tr>
- <tr><td>Notes</td><td>$noteinput</td></tr>
- <tr><td>Item Type</td><td><select name=itemtype>$itemtypeselect</select></td></tr>
- <tr><td>ISBN</td><td>$isbninput</td></tr>
- <tr><td>ISSN</td><td>$issninput</td></tr>
- <tr><td>LCCN</td><td>$lccninput</td></tr>
- <tr><td>Dewey</td><td>$deweyinput</td></tr>
- <tr><td>Subclass</td><td>$subclassinput</td></tr>
- <tr><td>Publication Year</td><td>$pubyearinput</td></tr>
- <tr><td>Publisher</td><td>$publisherinput</td></tr>
- <tr><td>Place</td><td>$placeinput</td></tr>
- <tr><td>Pages</td><td>$pagesinput</td></tr>
- <tr><td>Size</td><td>$sizeinput</td></tr>
- </table>
- <input type=submit>
- <input type=hidden name=insertnewrecord value=1>
- $fileinput
- $marcinput
- $origisbn
- $origissn
- $origlccn
- $origcontrolnumber
- </form>
- $marctext
-EOF
- }
- } 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;
- 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
- z3950servers where id=$name");
- $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...";
- } 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 $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, $notes, $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 $subtitle $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";
- }
- 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");
- $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, $notes, $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();
- }
+ #-----------------------------------------
-}
+ $marctext="<table border=0 cellspacing=1>
+ <tr><th colspan=4 background=/images/background-acq.gif>
+ MARC RECORD
+ </th></tr>\n";
+ foreach $field ( @$fields ) {
-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";
- 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) {
- $type=uc($type);
- $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;
- }
- }
+ # Swap colors on alternating lines
+ ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
- $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";
+ $tag=$field->{'tag'};
+ $label=taglabel($tag);
+
+ if ( $tag eq 'LDR' ) {
+ $tag='';
+ $label="Leader:";
}
- }
- 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";
-
- my $rand=rand(1000000000);
-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>
- <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
- </td></tr>
- <tr><td colspan=2 align=center>
- <input type=submit>
- </td></tr>
- </table>
-
- </form>
-EOF
-print "</td></tr></table>\n";
-}
+ print "<pre>Format tag=$tag label=$label</pre>\n" if $debug;
-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
-}
+ $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
+ "<td bgcolor=$color valign=top>$tag</td> \n";
-sub manual {
-}
+ $indicator=$field->{'indicator'};
+ $indicator=~s/ +$//; # drop trailing blanks
+ # Third table column has indicator if it is short.
+ # Fourth column has embedded table of subfields, and indicator
+ # if it is long (leader or fixed-position fields)
-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
-}
+ print "<pre>Format indicator=$indicator" .
+ " length=" . length( $indicator ) . "</pre>\n" if $debug;
+ if ( length( $indicator <= 3 ) ) {
+ $marctext.="<td bgcolor=$color valign=top><pre>" .
+ "$indicator</pre></td>" .
+ "<td bgcolor=$color valign=top>" ;
+ } else {
+ $marctext.="<td bgcolor=$color valign=top></td>" .
+ "<td bgcolor=$color valign=top>" .
+ "$indicator ";
+ } # if length
+
+ # Subfields
+ if ( $field->{'subfields'} ) {
+ # start another table for subfields
+ $marctext.= "<table border=0 cellspacing=2>\n";
+ foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
+ $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
+ if (ref($subfieldvalue) eq 'ARRAY' ) {
+ # if it's a pointer to array, get all the values
+ @values=@{$subfieldvalue};
+ } else {
+ # otherwise get the one value
+ @values=( $subfieldvalue );
+ } # if subfield array
+ foreach $value ( @values ) {
+ $marctext.="<tr><td><strong>$subfieldcode</strong></td>" .
+ "<td>$value</td></tr>\n";
+ } # foreach value
+ } # foreach subfield
+ $marctext.="</table>\n";
+ } # if subfields
+ # End of indicator and subfields column
+ $marctext.="</td>\n";
-sub skip {
+ # End of columns
+ $marctext.="</tr>\n";
- #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";
-# }
+ } # foreach field
+ $marctext.="</table>\n";
- #<form action=$ENV{'SCRIPT_NAME'} method=POST enctype=multipart/form-data>
+ return $marctext;
-}
-print endmenu();
-print endpage();
+} # sub FormatMarcText
-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;
-}
#---------------
-# 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
+# log cleared, as marcimport is (almost) rewritten from scratch.
+# $Log$
+# Revision 1.29 2003/01/28 15:28:31 tipaul
+# removing use MARC::Charset
+# Was a buggy test
+#
+# Revision 1.28 2003/01/28 15:00:31 tipaul
+# user can now search in breeding farm with isbn/issn or title. Title/name are stored in breeding farm and showed when a search is done
+#
+# Revision 1.27 2003/01/26 23:21:49 acli
+# Handle non-latin1 charsets
+#
+# Revision 1.26 2003/01/23 12:26:41 tipaul
+# upgrading import in breeding farm (you can now search on ISBN or on title) AND character encoding.
+#
+# Revision 1.25 2003/01/21 08:13:50 tipaul
+# character encoding ISO646 => 8859-1, first draft
+#
+# Revision 1.24 2003/01/14 16:41:17 tipaul
+# bugfix : use gettemplate_and_user instead of gettemplate.
+# fix a blank screen in 1.3.3 in "import in breeding farm"
+#
+# Revision 1.23 2003/01/06 13:06:28 tipaul
+# removing trailing #
+#
+# Revision 1.22 2002/11/12 15:58:43 tipaul
+# road to 1.3.2 :
+# * many bugfixes
+# * adding value_builder : you can map a subfield in the marc_subfield_structure to a sub stored in "value_builder" directory. In this directory you can create screen used to build values with any method. In this commit is a 1st draft of the builder for 100$a unimarc french subfield, which is composed of 35 digits, with 12 differents values (only the 4th first are provided for instance)
+#
+# Revision 1.21 2002/10/22 15:50:23 tipaul
+# road to 1.3.2 : adding a biblio in MARC format.
+# seems to work a few.
+# still to do :
+# * manage html checks (mandatory subfields...)
+# * add list of acceptable values (authorities)
+# * manage ## in MARC format
+# * manage correctly repeatable fields
+# and probably a LOT of bugfixes
+#
+# Revision 1.20 2002/10/16 12:46:19 arensb
+# Added a FIXME comment.
+#
+# Revision 1.19 2002/10/15 10:14:44 tipaul
+# road to 1.3.2. Full rewrite of marcimport.pl.
+# The acquisition system in MARC version will work like this :
+# * marcimport will put marc records into a "breeding farm" table.
+# * when the user want to add a biblio, he enters first the ISBN/ISSN of the biblio. koha searches into breeding farm and if the record exists, it is shown to the user to help him adding the biblio. When the biblio is added, it's deleted from the breeding farm.
+#
+# This commit :
+# * modify acqui.simple home page (addbooks.pl)
+# * adds import into breeding farm
+#
+# Please note that :
+# * z3950 functionnality is dropped from "marcimport" will be added somewhere else.
+# * templates are in a new acqui.simple sub directory, and the marcimport template directory will become obsolete soon.I think this is more logic
+#
projects / koha_fer / blobdiff