49aa86a5d33c4c144b54743e8c0bf13fe54706ca
[crolist2marc] / crolist2marc.pl
1 #!/usr/bin/perl
2 use warnings;
3 use strict;
4 use autodie;
5
6 use MARC::Record;
7 use Data::Dump qw(dump);
8 use utf8;
9
10 my $data;
11
12 sub csv_file {
13         my ($file,$parse) = @_;
14
15         print STDERR "# reading $file ";
16         my $lines = 1;
17
18         open(my $fh, '<', $file);
19         my $h = <$fh>; # header
20         while(<$fh>) {
21                 chomp;
22                 my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = $parse->($_);
23                 $lines++;
24
25                 if ( ! $text ) {
26                         print STDERR "\nSKIP $file +$lines [$_] " if $idsl;
27                         next;
28                 }
29
30                 $tagno ||= 0;
31                 $sfino ||= 0;
32
33                 $id .= " " if length $id < 2;
34                 $id .= " " if length $id < 2;
35                 my ($i1, $i2) = split(//, $id, 2);
36
37                 $sfi =~ s/^\$// || die "can't fix subfield [$sfi]";
38
39                 $text =~ tr/^~]}\\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
40
41                 $data->{$idsl}->{$tag}->[ $tagno ]->[ 0 ] = $i1;
42                 $data->{$idsl}->{$tag}->[ $tagno ]->[ 1 ] = $i2;
43                 $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 2 ] = $sfi;
44                 $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 3 ] = $text;
45
46                 print STDERR "$lines " if $lines % 1000 == 0;
47         }
48         print STDERR "\n";
49 }
50
51 csv_file( 'TEKTAG.csv', sub {
52         my $line = shift;
53
54         my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres ) = split(/,/,$_);
55
56         my $text = $textkey . $textres; # FIXME fix CAPITAL letters in $textkey
57
58         return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
59 });
60
61 csv_file( 'LONTAG.csv', sub {
62         my $line = shift;
63
64         my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = split(/;/,$_, 7);
65
66         $text =~ s/;+$//;
67         $text =~ s/;/\n/g; # join OPIS[1-11]
68
69         return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
70 });
71
72 csv_file( 'IDNTAG.csv', sub {
73         my $line = shift;
74
75         my ( $idsl, $tag, $STSL, $KZVS, $BIBRAZ, $HIRAZ, $KPS, $OKO ) = split(/,/,$_);
76
77         my @leader;
78         $leader[5] = $STSL;
79         $leader[6] = $KZVS;
80         $leader[7] = $BIBRAZ;
81         $leader[8] = $HIRAZ;
82         $leader[17] = $KPS;
83         $leader[18] = $OKO;
84
85         $leader[23] = ' '; # last char;
86
87         my $full = join('', map { defined $_ ? $_ : ' ' } @leader);
88         $data->{$idsl}->{'leader'} = $full; 
89         return;
90 });
91
92 csv_file( 'OBRTAG.csv', sub {
93         my $line = shift;
94
95         my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF ) = split(/,/,$_);
96         return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF );
97 });
98
99 print STDERR "\n# getting all ids ";
100 my @ids = keys %$data;
101 print STDERR scalar(@ids), " found\n";
102
103 my $marc_file = 'liberated.marc';
104 open(my $marc_fh, '>:encoding(UTF-8)', $marc_file);
105 my $number = 0;
106
107 foreach my $id ( @ids ) {
108         my $rec = MARC::Record->new;
109         $rec->encoding( 'UTF-8' );
110         $rec->add_fields( [ '001', $id ] );
111
112         foreach my $field ( sort keys %{ $data->{$id} } ) {
113                 if ( $field eq 'leader' ) {
114                         $rec->leader( $data->{$id}->{$field} );
115                         next;
116                 }
117                 foreach my $arr ( @{ $data->{$id}->{$field} } ) {
118                         if ( ! $arr ) {
119                                 print STDERR "SKIPPED $id $field ",dump( $data->{$id}->{$field} ), "\n";
120                                 next;
121                         }
122                         $rec->add_fields( $field, @$arr );
123                 }
124         }
125
126         #print $rec->as_formatted;
127         #print "# $id ",dump($data->{$id});
128
129         print $marc_fh $rec->as_usmarc;
130         $number++;
131         print "$number " if $number % 1000 == 0;
132 }
133
134 close($marc_fh);
135 print "$marc_file ",-s $marc_file, " bytes\n";