7 use Data::Dump qw(dump);
12 sub vc_casefix { # partial reverse-engeenered implementation of case mapping
13 my ( $vc, $k, $rest ) = @_;
15 $vc .= " " x (4 - length($vc));
17 my @m = map { ord($_) } split(//, $vc);
19 my $mask = ( $m[3] & 0b00001111 ) << 4 | ( $m[2] & 0b00001111 );
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);
30 if ( substr($vc,0,1) eq 'x' ) {
31 $fixed = ucfirst $fixed;
34 if ( $rest && length($fixed) < 8 ) {
35 # warn "# padding $fixed|$rest";
36 $fixed .= " " x ( 8 - length($fixed) );
39 return $fixed . $rest;
43 my ($file,$parse) = @_;
45 print STDERR "# reading $file ";
48 open(my $fh, '<:encoding(UTF-8)', $file);
49 my $h = <$fh>; # header
53 # tr/^~]}\\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
55 my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = $parse->($_);
59 print STDERR "\nSKIP $file +$lines [$_] " if $idsl;
66 $id .= " " if length $id < 2;
67 $id .= " " if length $id < 2;
68 my ($i1, $i2) = split(//, $id, 2);
70 $sfi =~ s/^\$// || die "can't fix subfield [$sfi]";
72 $text =~ tr/^~]}\\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
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;
79 print STDERR "$lines " if $lines % 1000 == 0;
84 csv_file( 'tsv/TEKTAG.csv', sub {
87 my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres, $vc ) = split(/\t/,$_);
89 my $text = vc_casefix( $vc, $textkey, $textres );
91 return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
94 csv_file( 'tsv/LONTAG.csv', sub {
97 my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = split(/\t/,$_, 7);
100 $text =~ s/\t/\n/g; # join OPIS[1-11]
102 return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
105 csv_file( 'tsv/IDNTAG.csv', sub {
108 my ( $idsl, $tag, $STSL, $KZVS, $BIBRAZ, $HIRAZ, $KPS, $OKO ) = split(/\t/,$_);
113 $leader[7] = $BIBRAZ;
118 $leader[23] = ' '; # last char;
120 my $full = join('', map { defined $_ ? $_ : ' ' } @leader);
121 $data->{$idsl}->{'leader'} = $full;
125 csv_file( 'tsv/OBRTAG.csv', sub {
128 my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF ) = split(/\t/,$_);
129 return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF );
132 print STDERR "\n# getting all ids ";
133 my @ids = sort keys %$data;
134 print STDERR scalar(@ids), " found\n";
136 my $marc_file = 'liberated.marc';
137 open(my $marc_fh, '>:encoding(UTF-8)', $marc_file);
140 foreach my $id ( @ids ) {
141 my $rec = MARC::Record->new;
142 $rec->encoding( 'UTF-8' );
143 $rec->add_fields( [ '001', $id ] );
145 foreach my $field ( sort keys %{ $data->{$id} } ) {
146 if ( $field eq 'leader' ) {
147 $rec->leader( $data->{$id}->{$field} );
150 foreach my $arr ( @{ $data->{$id}->{$field} } ) {
152 # print STDERR "SKIPPED $id $field ",dump( $data->{$id}->{$field} ), "\n";
155 $arr = [ $arr->[3] ] if ( $field < 010 ); # control fields don't have idicators or subfields
156 $rec->add_fields( $field, @$arr );
160 #print $rec->as_formatted;
161 #print "# $id ",dump($data->{$id});
163 print $marc_fh $rec->as_usmarc;
165 print "$number " if $number % 1000 == 0;
169 print "$marc_file ",-s $marc_file, " bytes\n";