From: Dobrica Pavlinusic Date: Fri, 13 Sep 2013 15:14:50 +0000 (+0200) Subject: fix case of key column using data from VC X-Git-Url: http://git.rot13.org/?p=crolist2marc;a=commitdiff_plain;h=98affe08c0b1d68d84962b40046f95ed2c85e746 fix case of key column using data from VC --- diff --git a/crolist2marc.pl b/crolist2marc.pl index 39eb028..20db8e0 100755 --- 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,9 +84,9 @@ 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 ); });