[Koha-cvs] CVS: koha/acqui.simple marcimport.pl,1.6.2.12,1.6.2.13

[Alan Millar]

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 ****
      )address@hidden;
  
!     my $debug=1;
  
-     my $sth;
      print "<a href=$ENV{'SCRIPT_NAME'}>Main Menu</a><hr>\n";
      my $qisbn=$input->param('isbn');
--- 184,196 ----
      )address@hidden;
  
!     # 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 @address@hidden;
!                           if ($#subfieldlist>=0) {
!                               push (@subfieldlist, $subfield);
!                           } else {
!                               @subfieldlist=($subfields{$subfieldcode}, 
$subfield);
!                           }
!                           address@hidden;
!                       } else {
!                           $subfields{$subfieldcode}=$subfield;
!                       }
!                   }
!                   $marctext.="</table></td></tr>\n";
!                   $field{'subfields'}=\%subfields;
!               }
!               push (@record, \%field);
!           }
!           $marctext.="</table>\n";
!           address@hidden;
!           address@hidden;
!           push (@records, address@hidden);
!           $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)address@hidden;    # input
  
!       my $bib;        # hash ref to named fields
!       my $searchfield, $searchvalue;
        
  
--- 545,558 ----
  
  sub PrintResultRecordLink {
+     use strict;
      my ($record,$resultsid)address@hidden;    # 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
      )address@hidden;
  
      # 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
      )address@hidden;
  
      # 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 @address@hidden;
!                       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);
                        }
                        address@hidden;
                    } 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;
!                           @address@hidden;
                            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
                        address@hidden;
                    } 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)address@hidden ;
  
        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
+     )address@hidden;
+     # 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