convert Aleph mab *.m21 format to ISO marc
[webpac2] / scripts / mab2marc.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 open(my $m21, '<', 'agram-3.m21');
10 open(my $out, '>:encoding(utf-8)', 'agram-3.marc');
11
12 my $last_id;
13 my @fields;
14 my $marc;
15
16 sub new_marc {
17         $marc = new MARC::Record;
18         $marc->encoding('utf-8');
19         return $marc;
20 }
21
22 $marc = new_marc();
23
24 while (<$m21>) {
25         chomp;
26         my ( $id, $rest ) = split(/\s/, $_, 2);
27         my ( $fffii, $sf ) = split(/\s+L\s+/,$rest,2);
28
29         warn "## ",dump( $id, $fffii, $sf );
30
31         $last_id = $id if ! defined $last_id;
32         if ( $id != $last_id ) {
33                 print $out $marc->as_usmarc;
34                 print "XXX $id\n";
35                 print $marc->as_formatted();
36                 print "\n";
37                 $marc = new_marc();
38                 $last_id = $id;
39         }
40
41         if ( $fffii eq 'LDR' ) {
42                 $sf =~ s/\^/ /g;
43                 $marc->leader( $sf );
44         } elsif ( $fffii =~ m/^00/ ) {
45                 my $field = MARC::Field->new( $fffii, $sf );
46                 $marc->append_fields( $field );
47         } else {
48                 my $f = $1 if $fffii =~ s/^(...)//;
49                 my $i1 = $1 if $fffii =~ s/^(.)//;
50                 my $i2 = $1 if $fffii =~ s/^(.)//;
51                 $i1 ||= ' ';
52                 $i2 ||= ' ';
53
54                 warn "# $id $fffii -> ", dump($f,$i1,$i2), " [$sf]\n";
55
56                 my @f = ( $f, $i1, $i2 );
57
58                 while ( $sf =~ s/^\$\$(\w)([^\$]+)// ) {
59                         push @f, $1, decode('iso-8859-1', $2);
60                 }
61                 warn "### ",dump( @f );
62                 my $field = MARC::Field->new( @f );
63                 $marc->append_fields( $field );
64         }
65 }
66         
67