my $data;
-my $lines = 0;
+sub vc_casefix { # partial reverse-engeenered implementation of case mapping
+ my ( $tag, $sfi, $vc, $k, $rest ) = @_;
-open(my $fh, '<', 'TEKTAG.csv');
-my $h = <$fh>; # header
-while(<$fh>) {
- chomp;
- my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres ) = split(/,/,$_);
+ $vc .= " " x (4 - length($vc));
- $tagno ||= 0;
- $sfino ||= 0;
+ $k =~ tr/^~]}\\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
- $id .= " " if length $id < 2;
- $id .= " " if length $id < 2;
- my ($i1, $i2) = split(//, $id, 2);
+ my @m = map { ord($_) } split(//, $vc);
- $sfi =~ s/^\$// || die "can't fix subfield [$sfi]";
+ my $mask = ( $m[3] & 0b00001111 ) << 4 | ( $m[2] & 0b00001111 );
- my $text = $textkey . $textres; # FIXME fix CAPITAL letters in $textkey
- $text =~ tr/^~]}\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
+ my $sel = 0b10000000;
+ my $fixed;
+ my @chars = split(//, $k);
+ foreach my $c ( @chars ) {
+ die "key [$k]" unless defined $c;
+ $fixed .= $mask & $sel ? uc($c) : lc($c);
+ $sel >>= 1;
+ }
- $data->{$idsl}->{$tag}->[ $tagno ]->[ 0 ] = $i1;
- $data->{$idsl}->{$tag}->[ $tagno ]->[ 1 ] = $i2;
- $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 2 ] = $sfi;
- $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 3 ] = $text;
+ if ( substr($vc,0,1) eq 'x' || ( $tag =~ m/^(200|210|225|700|701|702|710|711|712)$/ ) ) { #&& $sfi eq '$a' )) {
+ $fixed = ucfirst $fixed;
+ }
-# last if $lines++ > 5000;
+ if ( $rest && length($fixed) < 8 ) {
+# warn "# padding $fixed|$rest";
+ $fixed .= " " x ( 8 - length($fixed) );
+ }
+
+ return $fixed . $rest;
}
-warn dump($data);
+sub csv_file {
+ my ($file,$parse) = @_;
+
+ print STDERR "# reading $file ";
+ my $lines = 1;
+
+ open(my $fh, '<:encoding(UTF-8)', $file);
+ my $h = <$fh>; # header
+ while(<$fh>) {
+ chomp;
+
+# tr/^~]}\\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
+
+ my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = $parse->($_);
+ $lines++;
+
+ if ( ! $text ) {
+ print STDERR "\nSKIP $file +$lines [$_] " if $idsl;
+ next;
+ }
+
+ $tagno ||= 0;
+ $sfino ||= 0;
+
+ $id .= " " if length $id < 2;
+ $id .= " " if length $id < 2;
+ my ($i1, $i2) = split(//, $id, 2);
+
+ $sfi =~ s/^\$// || die "can't fix subfield [$sfi]";
+
+ $text =~ tr/^~]}\\|[{@`/ČčĆćĐ𩹮ž/; # CROASCII (YUS|HRN) B1.002:1982
+
+ $data->{$idsl}->{$tag}->[ $tagno ]->[ 0 ] = $i1;
+ $data->{$idsl}->{$tag}->[ $tagno ]->[ 1 ] = $i2;
+ $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 2 ] = $sfi;
+ $data->{$idsl}->{$tag}->[ $tagno ]->[ ( $sfino * 2 ) + 3 ] = $text;
+
+ print STDERR "$lines " if $lines % 1000 == 0;
+ }
+ print STDERR "\n";
+}
+
+csv_file( 'tsv/TEKTAG.csv', sub {
+ my $line = shift;
+
+ my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres, $vc ) = split(/\t/,$_);
+
+ my $text = vc_casefix( $tag, $sfi, $vc, $textkey, $textres );
+
+ return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
+});
+
+csv_file( 'tsv/NUMTAG.csv', sub {
+ my $line = shift;
+
+ my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $LTAG, $LTAGNO, $LID, $LSFI, $TXKEY, $TXRES, $VC, $STOPW ) = split(/\t/,$_);
+
+ my $text = vc_casefix( $TAG, $SFI, $VC, $TXKEY, $TXRES );
+
+ return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $text );
+});
+
+csv_file( 'tsv/LONTAG.csv', sub {
+ my $line = shift;
+
+ my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = split(/\t/,$_, 7);
+
+ $text =~ s/\t+$//;
+ $text =~ s/\t/\n/g; # join OPIS[1-11]
+
+ return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
+});
+
+csv_file( 'tsv/IDNTAG.csv', sub {
+ my $line = shift;
+
+ my ( $idsl, $tag, $STSL, $KZVS, $BIBRAZ, $HIRAZ, $KPS, $OKO ) = split(/\t/,$_);
+
+ my @leader;
+ $leader[5] = $STSL;
+ $leader[6] = $KZVS;
+ $leader[7] = $BIBRAZ;
+ $leader[8] = $HIRAZ;
+ $leader[17] = $KPS;
+ $leader[18] = $OKO;
+
+ $leader[23] = ' '; # last char;
+
+ my $full = join('', map { defined $_ ? $_ : ' ' } @leader);
+ $data->{$idsl}->{'leader'} = $full;
+ return;
+});
+
+csv_file( 'tsv/OBRTAG.csv', sub {
+ my $line = shift;
+
+ my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF ) = split(/\t/,$_);
+ return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF );
+});
+
+print STDERR "\n# getting all ids ";
+my @ids = sort keys %$data;
+print STDERR scalar(@ids), " found\n";
+
+my $marc_file = 'liberated.marc';
+open(my $marc_fh, '>:encoding(UTF-8)', $marc_file);
+my $number = 0;
+
+foreach my $id ( @ids ) {
+ my $rec = MARC::Record->new;
+ $rec->encoding( 'UTF-8' );
+ $rec->add_fields( [ '001', $id ] );
+
+ foreach my $field ( sort keys %{ $data->{$id} } ) {
+ if ( $field eq 'leader' ) {
+ $rec->leader( $data->{$id}->{$field} );
+ next;
+ }
+ foreach my $arr ( @{ $data->{$id}->{$field} } ) {
+ if ( ! $arr ) {
+# print STDERR "SKIPPED $id $field ",dump( $data->{$id}->{$field} ), "\n";
+ next;
+ }
+ $arr = [ $arr->[3] ] if ( $field < 010 ); # control fields don't have idicators or subfields
+ $rec->add_fields( $field, @$arr );
+ }
+ }
+
+ #print $rec->as_formatted;
+ #print "# $id ",dump($data->{$id});
+
+ print $marc_fh $rec->as_usmarc;
+ $number++;
+ print "$number " if $number % 1000 == 0;
+}
+close($marc_fh);
+print "$marc_file ",-s $marc_file, " bytes\n";
projects / crolist2marc / blobdiff