git.rot13.org Git - webpac2/blob - scripts/aleph2iso.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use autodie;
   5 use MARC::Record;
   6 use Encode;
   7 use Data::Dump qw(dump);
   8
   9 my $source = shift @ARGV || die "usage: $0 file.m21\n";
  10 my $dest = $source;
  11 $dest .= '.iso';
  12
  13 close(STDERR) unless $ENV{DEBUG};
  14
  15 open(my $m21, '<:encoding(utf-8)', $source);
  16 open(my $out, '>:encoding(utf-8)', $dest);
  17
  18 warn "# convert $source => $dest\n";
  19
  20 my $last_id;
  21 my @fields;
  22 my $marc;
  23
  24 sub new_marc {
  25         $marc = new MARC::Record;
  26         $marc->encoding('utf-8');
  27         return $marc;
  28 }
  29
  30 $marc = new_marc();
  31
  32 while (<$m21>) {
  33         chomp;
  34         s/\xC2\x98/<</g;
  35         s/\xC2\x9C/>>/g;
  36         s/\x98/<</g;
  37         s/\x9C/>>/g;
  38         my ( $id, $rest ) = split(/\s/, $_, 2);
  39         my ( $fffii, $sf ) = split(/\s+L\s+/,$rest,2);
  40
  41         warn "## ",dump( $id, $fffii, $sf );
  42
  43         $last_id = $id if ! defined $last_id;
  44         if ( $id != $last_id ) {
  45                 print $out $marc->as_usmarc;
  46                 print "XXX $id\n";
  47                 print $marc->as_formatted();
  48                 print "\n";
  49                 $marc = new_marc();
  50                 $last_id = $id;
  51         }
  52
  53         if ( $fffii eq 'LDR' ) {
  54                 $sf =~ s/\^/ /g;
  55                 $marc->leader( $sf );
  56         } elsif ( $fffii =~ m/^00/ ) {
  57                 warn "# $id clean $fffii" if $fffii =~ s/[a-z]//g;
  58                 my $field = MARC::Field->new( $fffii, $sf );
  59                 $marc->append_fields( $field );
  60         } else {
  61                 my $f = $1 if $fffii =~ s/^(...)//;
  62                 my $i1 = $1 if $fffii =~ s/^(.)//;
  63                 my $i2 = $1 if $fffii =~ s/^(.)//;
  64                 $i1 ||= ' ';
  65                 $i2 ||= ' ';
  66
  67                 warn "# $id $fffii -> ", dump($f,$i1,$i2), " [$sf]\n";
  68
  69                 my @f = ( $f, $i1, $i2 );
  70
  71                 while ( $sf =~ s/^\$\$(\w)([^\$]+)// ) {
  72 #                       push @f, $1, decode('iso-8859-1', $2);
  73                         push @f, $1, $2;
  74                 }
  75                 warn "### ",dump( @f );
  76                 my $field;
  77 again:
  78                 eval { $field = MARC::Field->new( @f ) };
  79                 if ( $@ ) {
  80                         if ( $@ =~ m/must have indicators/ ) {
  81                                 push @f, ' ', ' ';
  82                                 goto again;
  83                         }
  84                         die $@;
  85                 }
  86                 $marc->append_fields( $field );
  87         }
  88 }
  89
  90