git.rot13.org Git - crolist2marc/blob - 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 vc_casefix { # partial reverse-engeenered implementation of case mapping
  13         my ( $vc, $k, $rest ) = @_;
  14
  15         $vc .= " " x (4 - length($vc));
  16
  17         my @m = map { ord($_) } split(//, $vc);
  18
  19         my $mask = ( $m[3] & 0b00001111 ) << 4 | ( $m[2] & 0b00001111 );
  20
  21         my $sel = 0b10000000;
  22         my $fixed;
  23         my @chars = split(//, $k);
  24         foreach my $c ( @chars ) {
  25                 die "key [$k]" unless defined $c;
  26                 $fixed .= $mask & $sel ? uc($c) : lc($c);
  27                 $sel >>= 1;
  28         }
  29
  30         if ( substr($vc,0,1) eq 'x' ) {
  31                 $fixed = ucfirst $fixed;
  32         }
  33
  34         if ( $rest && length($fixed) < 8 ) {
  35 #               warn "# padding $fixed|$rest";
  36                 $fixed .= " " x ( 8 - length($fixed) );
  37         }
  38
  39         return $fixed . $rest;
  40 }
  41
  42 sub csv_file {
  43         my ($file,$parse) = @_;
  44
  45         print STDERR "# reading $file ";
  46         my $lines = 1;
  47
  48         open(my $fh, '<:encoding(UTF-8)', $file);
  49         my $h = <$fh>; # header
  50         while(<$fh>) {
  51                 chomp;
  52
  53 #               tr/^~]}\\|[{@`/ČčĆćĐđŠšŽž/; # CROASCII (YUS|HRN) B1.002:1982
  54
  55                 my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = $parse->($_);
  56                 $lines++;
  57
  58                 if ( ! $text ) {
  59                         print STDERR "\nSKIP $file +$lines [$_] " if $idsl;
  60                         next;
  61                 }
  62
  63                 $tagno ||= 0;
  64                 $sfino ||= 0;
  65
  66                 $id .= " " if length $id < 2;
  67                 $id .= " " if length $id < 2;
  68                 my ($i1, $i2) = split(//, $id, 2);
  69
  70                 $sfi =~ s/^\$// || die "can't fix subfield [$sfi]";
  71
  72                 $text =~ tr/^~]}\\|[{@`/ČčĆćĐđŠšŽž/; # CROASCII (YUS|HRN) B1.002:1982
  73
  74                 $data->{$idsl}->{$tag}->[ $tagno ]->[ 0 ] = $i1;
  75                 $data->{$idsl}->{$tag}->[ $tagno ]->[ 1 ] = $i2;
  76                 $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 2 ] = $sfi;
  77                 $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 3 ] = $text;
  78
  79                 print STDERR "$lines " if $lines % 1000 == 0;
  80         }
  81         print STDERR "\n";
  82 }
  83
  84 csv_file( 'tsv/TEKTAG.csv', sub {
  85         my $line = shift;
  86
  87         my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres, $vc ) = split(/\t/,$_);
  88
  89         my $text = vc_casefix( $vc, $textkey, $textres );
  90
  91         return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
  92 });
  93
  94 csv_file( 'tsv/NUMTAG.csv', sub {
  95         my $line = shift;
  96
  97         my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $LTAG, $LTAGNO, $LID, $LSFI, $TXKEY, $TXRES, $VC, $STOPW ) = split(/\t/,$_);
  98
  99         my $text = vc_casefix( $VC, $TXKEY, $TXRES );
 100
 101         return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $text );
 102 });
 103
 104 csv_file( 'tsv/LONTAG.csv', sub {
 105         my $line = shift;
 106
 107         my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = split(/\t/,$_, 7);
 108
 109         $text =~ s/\t+$//;
 110         $text =~ s/\t/\n/g; # join OPIS[1-11]
 111
 112         return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
 113 });
 114
 115 csv_file( 'tsv/IDNTAG.csv', sub {
 116         my $line = shift;
 117
 118         my ( $idsl, $tag, $STSL, $KZVS, $BIBRAZ, $HIRAZ, $KPS, $OKO ) = split(/\t/,$_);
 119
 120         my @leader;
 121         $leader[5] = $STSL;
 122         $leader[6] = $KZVS;
 123         $leader[7] = $BIBRAZ;
 124         $leader[8] = $HIRAZ;
 125         $leader[17] = $KPS;
 126         $leader[18] = $OKO;
 127
 128         $leader[23] = ' '; # last char;
 129
 130         my $full = join('', map { defined $_ ? $_ : ' ' } @leader);
 131         $data->{$idsl}->{'leader'} = $full;
 132         return;
 133 });
 134
 135 csv_file( 'tsv/OBRTAG.csv', sub {
 136         my $line = shift;
 137
 138         my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF ) = split(/\t/,$_);
 139         return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF );
 140 });
 141
 142 print STDERR "\n# getting all ids ";
 143 my @ids = sort keys %$data;
 144 print STDERR scalar(@ids), " found\n";
 145
 146 my $marc_file = 'liberated.marc';
 147 open(my $marc_fh, '>:encoding(UTF-8)', $marc_file);
 148 my $number = 0;
 149
 150 foreach my $id ( @ids ) {
 151         my $rec = MARC::Record->new;
 152         $rec->encoding( 'UTF-8' );
 153         $rec->add_fields( [ '001', $id ] );
 154
 155         foreach my $field ( sort keys %{ $data->{$id} } ) {
 156                 if ( $field eq 'leader' ) {
 157                         $rec->leader( $data->{$id}->{$field} );
 158                         next;
 159                 }
 160                 foreach my $arr ( @{ $data->{$id}->{$field} } ) {
 161                         if ( ! $arr ) {
 162 #                               print STDERR "SKIPPED $id $field ",dump( $data->{$id}->{$field} ), "\n";
 163                                 next;
 164                         }
 165                         $arr = [ $arr->[3] ] if ( $field < 010 ); # control fields don't have idicators or subfields
 166                         $rec->add_fields( $field, @$arr );
 167                 }
 168         }
 169
 170         #print $rec->as_formatted;
 171         #print "# $id ",dump($data->{$id});
 172
 173         print $marc_fh $rec->as_usmarc;
 174         $number++;
 175         print "$number " if $number % 1000 == 0;
 176 }
 177
 178 close($marc_fh);
 179 print "$marc_file ",-s $marc_file, " bytes\n";