7b8df6b452eeba7204856b70992913002977a6b6
[webpac2] / 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 open(my $m21, '<', $source);
14 open(my $out, '>:encoding(utf-8)', $dest);
15
16 warn "# convert $source => $dest\n";
17
18 my $last_id;
19 my @fields;
20 my $marc;
21
22 sub new_marc {
23         $marc = new MARC::Record;
24         $marc->encoding('utf-8');
25         return $marc;
26 }
27
28 $marc = new_marc();
29
30 while (<$m21>) {
31         chomp;
32         my ( $id, $rest ) = split(/\s/, $_, 2);
33         my ( $fffii, $sf ) = split(/\s+L\s+/,$rest,2);
34
35         warn "## ",dump( $id, $fffii, $sf );
36
37         $last_id = $id if ! defined $last_id;
38         if ( $id != $last_id ) {
39                 print $out $marc->as_usmarc;
40                 print "XXX $id\n";
41                 print $marc->as_formatted();
42                 print "\n";
43                 $marc = new_marc();
44                 $last_id = $id;
45         }
46
47         if ( $fffii eq 'LDR' ) {
48                 $sf =~ s/\^/ /g;
49                 $marc->leader( $sf );
50         } elsif ( $fffii =~ m/^00/ ) {
51                 warn "# $id clean $fffii" if $fffii =~ s/[a-z]//g;
52                 my $field = MARC::Field->new( $fffii, $sf );
53                 $marc->append_fields( $field );
54         } else {
55                 my $f = $1 if $fffii =~ s/^(...)//;
56                 my $i1 = $1 if $fffii =~ s/^(.)//;
57                 my $i2 = $1 if $fffii =~ s/^(.)//;
58                 $i1 ||= ' ';
59                 $i2 ||= ' ';
60
61                 warn "# $id $fffii -> ", dump($f,$i1,$i2), " [$sf]\n";
62
63                 my @f = ( $f, $i1, $i2 );
64
65                 while ( $sf =~ s/^\$\$(\w)([^\$]+)// ) {
66                         push @f, $1, decode('iso-8859-1', $2);
67                 }
68                 warn "### ",dump( @f );
69                 my $field;
70 again:
71                 eval { $field = MARC::Field->new( @f ) };
72                 if ( $@ ) {
73                         if ( $@ =~ m/must have indicators/ ) {
74                                 push @f, ' ', ' ';
75                                 goto again;
76                         }
77                         die $@;
78                 }
79                 $marc->append_fields( $field );
80         }
81 }
82         
83