[Koha-cvs] CVS: koha/acqui.simple marcimport.pl,1.6.2.12,1.6.2.13
Alan Millar
amillar at users.sourceforge.net
Thu Jun 6 09:32:23 CEST 2002
Update of /cvsroot/koha/koha/acqui.simple
In directory usw-pr-cvs1:/tmp/cvs-serv10607
Modified Files:
Tag: rel-1-2
marcimport.pl
Log Message:
All MARC file format decoding isolated to single subroutine.
Entire script now works correctly with "use strict".
Index: marcimport.pl
===================================================================
RCS file: /cvsroot/koha/koha/acqui.simple/marcimport.pl,v
retrieving revision 1.6.2.12
retrieving revision 1.6.2.13
diff -C2 -r1.6.2.12 -r1.6.2.13
*** marcimport.pl 5 Jun 2002 19:20:10 -0000 1.6.2.12
--- marcimport.pl 6 Jun 2002 07:32:20 -0000 1.6.2.13
***************
*** 8,12 ****
# Licensed under the GPL
! #use strict;
# standard or CPAN modules used
--- 8,12 ----
# Licensed under the GPL
! use strict;
# standard or CPAN modules used
***************
*** 134,138 ****
if ($input->param('z3950queue')) {
! PostToZ3950Queue($dbh,$input);
}
--- 134,138 ----
if ($input->param('z3950queue')) {
! AcceptZ3950Queue($dbh,$input);
}
***************
*** 143,147 ****
if ($input->param('insertnewrecord')) {
# Add biblio item, and set up menu for adding item copies
! ($biblionumber,$biblioitemnumber)=AcceptBiblioitem($dbh,$input);
ItemCopyForm($dbh,$input,$biblionumber,$biblioitemnumber);
print endmenu();
--- 143,147 ----
if ($input->param('insertnewrecord')) {
# Add biblio item, and set up menu for adding item copies
! my ($biblionumber,$biblioitemnumber)=AcceptBiblioitem($dbh,$input);
ItemCopyForm($dbh,$input,$biblionumber,$biblioitemnumber);
print endmenu();
***************
*** 176,180 ****
--- 176,182 ----
sub ProcessFile {
# A MARC file has been specified; process it for review form
+ use strict;
+ # Input params
my (
$dbh,
***************
*** 182,188 ****
)=@_;
! my $debug=1;
- my $sth;
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
my $qisbn=$input->param('isbn');
--- 184,196 ----
)=@_;
! # local vars
! my (
! $sth,
! $record,
! );
!
! my $debug=0;
! my $splitchar=chr(29);
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
my $qisbn=$input->param('isbn');
***************
*** 197,200 ****
--- 205,209 ----
#my $data=<F>;
my $data;
+
if ($file=~/Z-(\d+)/) {
my $id=$1;
***************
*** 209,295 ****
}
- $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};
! $bib=extractmarcfields($record);
$controlnumber =$bib->{controlnumber};
--- 218,272 ----
}
my @records;
!
RECORD:
! foreach $record (split(/$splitchar/, $data)) {
!
! my (
! $bib, # hash ref to named fields
! $fieldlist, # list ref
! $lccn, $isbn, $issn, $dewey, $author,
! $place, $publisher, $publicationyear, $volume,
! $number, @subjects, $notes, $additionalauthors,
! $copyrightdate, $seriestitle,
! $origisbn, $origissn, $origlccn, $origcontrolnumber,
! $subtitle,
! $controlnumber,
! $cleanauthor,
! $subject,
! $volumedate,
! $volumeddesc,
! $itemtypeselect,
! );
! my ($lccninput, $isbninput, $issninput, $deweyinput, $authorinput, $titleinput,
! $placeinput, $publisherinput, $publicationyearinput, $volumeinput,
! $numberinput, $notesinput, $additionalauthorsinput,
! $illustratorinput, $copyrightdateinput, $seriestitleinput,
! $subtitleinput,
! $copyrightinput,
! $volumedateinput,
! $volumeddescinput,
! $subjectinput,
! $noteinput,
! $subclassinput,
! $pubyearinput,
! $pagesinput,
! $sizeinput,
! $marcinput,
! $fileinput,
! );
!
!
! my $marctext;
!
! my $marc=$record;
!
! ($fieldlist)=parsemarcfileformat($record );
!
! $bib=extractmarcfields($fieldlist );
! print "Title=$bib->{title}\n" if $debug;
!
! $marctext=FormatMarcText($fieldlist);
$controlnumber =$bib->{controlnumber};
***************
*** 298,322 ****
$issn =$bib->{issn};
$author =$bib->{author};
- $title =$bib->{title};
- $subtitle =$bib->{subtitle};
- $dewey =$bib->{dewey};
$place =$bib->{place};
$publisher =$bib->{publisher};
$publicationyear =$bib->{publicationyear};
$copyrightdate =$bib->{copyrightdate};
! $pages =$bib->{pages};
! $size =$bib->{size};
$volume =$bib->{volume};
$number =$bib->{number};
$seriestitle =$bib->{seriestitle};
$additionalauthors =$bib->{additionalauthors};
- $illustrator =$bib->{illustrator};
$notes =$bib->{notes};
! $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);
--- 275,295 ----
$issn =$bib->{issn};
$author =$bib->{author};
$place =$bib->{place};
$publisher =$bib->{publisher};
$publicationyear =$bib->{publicationyear};
$copyrightdate =$bib->{copyrightdate};
!
$volume =$bib->{volume};
$number =$bib->{number};
$seriestitle =$bib->{seriestitle};
$additionalauthors =$bib->{additionalauthors};
$notes =$bib->{notes};
! $titleinput=$input->textfield(-name=>'title', -default=>$bib->{title}, -size=>40);
$marcinput=$input->hidden(-name=>'marc', -default=>$marc);
! $subtitleinput=$input->textfield(-name=>'subtitle', -default=>$bib->{subtitle}, -size=>40);
$authorinput=$input->textfield(-name=>'author', -default=>$author);
! $illustratorinput=$input->textfield(-name=>'illustrator',
! -default=>$bib->{illustrator});
$additionalauthorsinput=$input->textarea(-name=>'additionalauthors', -default=>$additionalauthors, -rows=>4, -cols=>20);
***************
*** 341,345 ****
$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;
--- 314,318 ----
$lccninput=$input->textfield(-name=>'lccn', -default=>$lccn);
$isbninput=$input->textfield(-name=>'isbn', -default=>$isbn);
! $deweyinput=$input->textfield(-name=>'dewey', -default=>$bib->{dewey});
$cleanauthor=$author;
$cleanauthor=~s/[^A-Za-z]//g;
***************
*** 348,353 ****
$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);
--- 321,326 ----
$pubyearinput=$input->textfield(-name=>'publicationyear', -default=>$publicationyear);
$placeinput=$input->textfield(-name=>'place', -default=>$place);
! $pagesinput=$input->textfield(-name=>'pages', -default=>$bib->{pages});
! $sizeinput=$input->textfield(-name=>'size', -default=>$bib->{size});
$fileinput=$input->hidden(-name=>'file', -default=>$file);
$origisbn=$input->hidden(-name=>'origisbn', -default=>$isbn);
***************
*** 422,426 ****
sub ListSearchResults {
! #use strict;
# Input parameters
--- 395,399 ----
sub ListSearchResults {
! use strict;
# Input parameters
***************
*** 439,442 ****
--- 412,416 ----
my $recordsource;
my $record;
+ my ($numrecords,$resultsid,$data,$startdate,$enddate);
# File can be results of z3950 search or uploaded MARC data
***************
*** 571,578 ****
sub PrintResultRecordLink {
my ($record,$resultsid)=@_; # input
! my $bib; # hash ref to named fields
! my $searchfield, $searchvalue;
--- 545,558 ----
sub PrintResultRecordLink {
+ use strict;
my ($record,$resultsid)=@_; # input
! my (
! $sth,
! $bib, # hash ref to named fields
! $searchfield, $searchvalue,
! $donetext,
! $fieldname,
! );
***************
*** 604,611 ****
"&searchfield=$searchfield" .
"&searchvalue=$searchvalue" .
! ">$bib->{title} by $bib->{author}</a>" .
" $donetext <BR>\n";
} else {
! print "Error: Problem with $title by $bib->{author}<br>\n";
} # if searchfield
} # sub PrintResultRecordLink
--- 584,591 ----
"&searchfield=$searchfield" .
"&searchvalue=$searchvalue" .
! ">$bib->{title} $bib->{author}</a>" .
" $donetext <BR>\n";
} else {
! print "Error: Problem with $bib->{title} $bib->{author}<br>\n";
} # if searchfield
} # sub PrintResultRecordLink
***************
*** 616,624 ****
# input
my (
! $record, # list ref
)=@_;
# return
! my $bib; # hash of named fields
my $debug=0;
--- 596,606 ----
# input
my (
! $record, # pointer to list of MARC field hashes.
! # Example: $record->[0]->{'tag'} = '100' # Author
! # $record->[0]->{'subfields'}->{'a'} = subfieldvalue
)=@_;
# return
! my $bib; # pointer to hash of named output fields
my $debug=0;
***************
*** 636,640 ****
print "<PRE>\n" if $debug;
! foreach $field (@$record) {
if ($field->{'tag'} eq '001') {
$bib->{controlnumber}=$field->{'indicator'};
--- 618,623 ----
print "<PRE>\n" if $debug;
! if ( ref($record) eq "ARRAY" ) {
! foreach $field (@$record) {
if ($field->{'tag'} eq '001') {
$bib->{controlnumber}=$field->{'indicator'};
***************
*** 768,772 ****
! } # foreach field
print "</PRE>\n" if $debug;
--- 751,759 ----
! } # foreach field
! } else {
! print "Error: extractmarcfields: input ref $record is " .
! ref($record) . " not ARRAY. Contact sysadmin.\n";
! }
print "</PRE>\n" if $debug;
***************
*** 835,840 ****
$realenddate=$r_enddate;
}
! # Snag any title from the results
! if ( ! $title ) {
($record)=parsemarcfileformat($r_marcdata);
$bib=extractmarcfields($record);
--- 822,827 ----
$realenddate=$r_enddate;
}
! # Snag any title from the results if there were any
! if ( ! $title && $r_marcdata ) {
($record)=parsemarcfileformat($r_marcdata);
$bib=extractmarcfields($record);
***************
*** 916,923 ****
</form>
EOF
! print "</td></tr></table>\n";
! } # sub z3950
sub uploadmarc {
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
my $sth=$dbh->prepare("select id,name from uploadedmarc");
--- 903,911 ----
</form>
EOF
! print "</td></tr></table>\n";
! } # sub z3950menu
sub uploadmarc {
+ use strict;
print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
my $sth=$dbh->prepare("select id,name from uploadedmarc");
***************
*** 960,1002 ****
</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>
-
- }
sub parsemarcfileformat {
! #use strict;
my $data=shift;
my $splitchar=chr(29);
my $splitchar2=chr(30);
my $splitchar3=chr(31);
! my $debug=1;
! 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 $directory=0;
my $tagcounter=0;
my %tag;
- my @record;
my $field;
foreach $field (split(/$splitchar2/, $record)) {
my %field;
--- 948,984 ----
</ul>
EOF
! } # sub mainmenu
+ #--------------------------
+ # Parse MARC data in file format with control-character separators
+ # May be multiple records.
sub parsemarcfileformat {
! use strict;
! # Input is one big text string
my $data=shift;
+ # Output is list of records. Each record is list of field hashes
+ my @records;
+
my $splitchar=chr(29);
my $splitchar2=chr(30);
my $splitchar3=chr(31);
! my $debug=0;
my $record;
foreach $record (split(/$splitchar/, $data)) {
! my @record;
my $directory=0;
my $tagcounter=0;
my %tag;
my $field;
+
+ my $leader=substr($record,0,24);
+ print "<tr><td>Leader:</td><td>$leader</td></tr>\n" if $debug;
+ push (@record, {
+ 'tag' => 'Leader',
+ 'indicator' => $leader ,
+ } );
+
+ $record=substr($record,24);
foreach $field (split(/$splitchar2/, $record)) {
my %field;
***************
*** 1030,1033 ****
--- 1012,1016 ----
unless ($#subfields==0) {
my %subfields;
+ my @subfieldlist;
my $i;
for ($i=1; $i<=$#subfields; $i++) {
***************
*** 1035,1050 ****
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;
}
--- 1018,1038 ----
my $subfieldcode=substr($text,0,1);
my $subfield=substr($text,1);
+ # if this subfield already exists, do array
if ($subfields{$subfieldcode}) {
my $subfieldlist=$subfields{$subfieldcode};
! if ( ref($subfieldlist) eq 'ARRAY' ) {
! # Already an array, add on to it
! print "$tag Adding to array $subfieldcode -- $subfield<br>\n" if $debug;
! @subfieldlist=@$subfieldlist;
push (@subfieldlist, $subfield);
} else {
! # Change simple value to array
! print "$tag Arraying $subfieldcode -- $subfield<br>\n" if $debug;
@subfieldlist=($subfields{$subfieldcode}, $subfield);
}
+ # keep new array
$subfields{$subfieldcode}=\@subfieldlist;
} else {
+ # subfield doesn't exist yet, keep simple value
$subfields{$subfieldcode}=$subfield;
}
***************
*** 1063,1067 ****
#----------------------------
# Accept form results to add query to z3950 queue
! sub PostToZ3950Queue {
use strict;
--- 1051,1055 ----
#----------------------------
# Accept form results to add query to z3950 queue
! sub AcceptZ3950Queue {
use strict;
***************
*** 1099,1106 ****
Number</font><p>\n";
}
! } # sub PostToZ3950Queue
#---------------------------------------------
sub AcceptMarcUpload {
my (
$dbh, # DBI handle
--- 1087,1095 ----
Number</font><p>\n";
}
! } # sub AcceptZ3950Queue
#---------------------------------------------
sub AcceptMarcUpload {
+ use strict;
my (
$dbh, # DBI handle
***************
*** 1349,1352 ****
--- 1338,1342 ----
# values from a DB file
sub GetKeyTableSelectOptions {
+ use strict;
# inputs
my (
***************
*** 1591,1598 ****
--- 1581,1590 ----
#--------------------------------------
sub checkvalidisbn {
+ use strict;
my ($q)=@_ ;
my $isbngood = 0;
+ $q=~s/x$/X/g; # upshift lower case X
$q=~s/[^X\d]//g;
$q=~s/X.//g;
***************
*** 1643,1644 ****
--- 1635,1693 ----
} # sub BuildTagMap
#-------------------------
+ sub FormatMarcText {
+ use strict;
+
+ # Input
+ my (
+ $fields, # list ref to MARC fields
+ )=@_;
+ # Return
+
+ my (
+ $marctext,
+ $color,
+ $field,
+ $tag,
+ $label,
+ $subfieldcode,$subfieldvalue,
+ );
+
+ #return "MARC text here";
+
+ $marctext="<table border=0 cellspacing=0>
+ <tr><th colspan=3 bgcolor=black>
+ <font color=white>MARC RECORD</font>
+ </th></tr>\n";
+
+ foreach $field ( @$fields ) {
+ ($color eq $lc1) ? ($color=$lc2) : ($color=$lc1);
+ $tag=$field->{'tag'};
+ $label=$tagtext{$tag};
+ if ( $tag eq 'Leader' ) {
+ $tag='';
+ $label="Leader:";
+ }
+ $marctext.="<tr><td bgcolor=$color valign=top>$label</td> \n" .
+ "<td bgcolor=$color valign=top>$tag</td> \n";
+ if ( ! $field->{'subfields'} ) {
+ $marctext.="<td bgcolor=$color valign=top>$field->{'indicator'}</td>";
+ } else {
+ # start another table for subfields
+ $marctext.="<td bgcolor=$color valign=top>\n " .
+ " <table border=0 cellspacing=0>\n";
+ foreach $subfieldcode ( sort( keys %{ $field->{'subfields'} } )) {
+ $subfieldvalue=$field->{'subfields'}->{$subfieldcode};
+ $marctext.="<tr><td>$subfieldcode </td>" .
+ "<td>$subfieldvalue</td></tr>\n";
+ } # foreach subfield
+ $marctext.="</table></td>\n";
+ } # if subfields
+ $marctext.="</tr>\n";
+
+ } # foreach field
+
+ $marctext.="</table>\n";
+
+ return $marctext;
+
+ } # sub FormatMarcText
More information about the Koha-cvs
mailing list