Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/testlib.pm

   1 package testlib;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base 'Exporter';
   7
   8 our @EXPORT_OK = qw(load_MARC_rec);
   9
  10 use Data::Dumper;
  11
  12 use MARC::Record;
  13
  14 sub load_MARC_rec {
  15     my $fh = shift;
  16     my $testno = shift;
  17     my $rec;
  18     my $line;
  19     my $marc = undef;
  20
  21     # skim to beginning of record (a non-blank, non comment line)
  22     while ($line = <$fh>) {
  23         chomp $line;
  24         last if (!($line =~ /^\s*$/) && !($line =~ /^#/));
  25     }
  26
  27     return undef if !$line;
  28
  29     $marc = MARC::Record->new();
  30     carp('No record created!') unless $marc;
  31
  32     $marc->leader('01119nas  22003134a 4500');
  33     $marc->append_fields(
  34         MARC::Field->new('008', '970701c18439999enkwr p       0   a0eng  '));
  35     $marc->append_fields(
  36         MARC::Field->new('035', '', '', a => sprintf('%04d', $testno)));
  37
  38     while ($line) {
  39         next if $line =~ /^#/;    # allow embedded comments
  40
  41         return $marc if $line =~ /^\s*$/;
  42
  43         my ($fieldno, $indicators, $rest) = split(/ /, $line, 3);
  44         my @inds = unpack('aa', $indicators);
  45         my $field;
  46         my @subfields;
  47
  48         @subfields = ();
  49         foreach my $subfield (split(/\$/, $rest)) {
  50             next unless $subfield;
  51
  52             my ($key, $val) = unpack('aa*', $subfield);
  53             push @subfields, $key, $val;
  54         }
  55
  56         $field = MARC::Field->new(
  57             $fieldno, $inds[0], $inds[1],
  58             @subfields
  59         );
  60
  61         $marc->append_fields($field);
  62
  63         $line = <$fh>;
  64         chomp $line if $line;
  65     }
  66     return $marc;
  67 }
  68
  69 1;