import NUMTAG data

[crolist2marc] / crolist2marc.pl

diff --git a/crolist2marc.pl b/crolist2marc.pl
index 39eb028..50ae051 100755 (executable)
--- a/crolist2marc.pl
+++ b/crolist2marc.pl
@@ -9,16 +9,49 @@ use utf8;
 
 my $data;
 
+sub vc_casefix { # partial reverse-engeenered implementation of case mapping
+       my ( $vc, $k, $rest ) = @_;
+
+       $vc .= " " x (4 - length($vc));
+
+       my @m = map { ord($_) } split(//, $vc);
+
+       my $mask = ( $m[3] & 0b00001111 ) << 4 | ( $m[2] & 0b00001111 );
+
+       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;
+       }
+
+       if ( substr($vc,0,1) eq 'x' ) {
+               $fixed = ucfirst $fixed;
+       }
+
+       if ( $rest && length($fixed) < 8 ) {
+#              warn "# padding $fixed|$rest";
+               $fixed .= " " x ( 8 - length($fixed) );
+       }
+
+       return $fixed . $rest;
+}
+
 sub csv_file {
        my ($file,$parse) = @_;
 
        print STDERR "# reading $file ";
        my $lines = 1;
 
-       open(my $fh, '<', $file);
+       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++;
 
@@ -51,13 +84,23 @@ sub csv_file {
 csv_file( 'tsv/TEKTAG.csv', sub {
        my $line = shift;
 
-       my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres ) = split(/\t/,$_);
+       my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres, $vc ) = split(/\t/,$_);
 
-       my $text = $textkey . $textres; # FIXME fix CAPITAL letters in $textkey
+       my $text = vc_casefix( $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( $VC, $TXKEY, $TXRES );
+
+       return ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $text );
+});
+
 csv_file( 'tsv/LONTAG.csv', sub {
        my $line = shift;