X-Git-Url: http://git.rot13.org/?p=crolist2marc;a=blobdiff_plain;f=crolist2marc.pl;h=50ae051afa6e8034de29a01d3559f564265bb6da;hp=1819d46b6cbbe7aa7249467bc73b46b71ac35411;hb=f38a1bfdcec11795747621e5f29e6cdeef5dce7b;hpb=2c7609f123a02badfb61a45363c8fe3edefaaea6

diff --git a/crolist2marc.pl b/crolist2marc.pl
index 1819d46..50ae051 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++;
 
@@ -48,31 +81,41 @@ sub csv_file {
 	print STDERR "\n";
 }
 
-csv_file( 'TEKTAG.csv', sub {
+csv_file( 'tsv/TEKTAG.csv', sub {
 	my $line = shift;
 
-	my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $textkey, $textres ) = split(/,/,$_);
+	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( 'LONTAG.csv', sub {
+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;
 
-	my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = split(/;/,$_, 7);
+	my ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text ) = split(/\t/,$_, 7);
 
-	$text =~ s/;+$//;
-	$text =~ s/;/\n/g; # join OPIS[1-11]
+	$text =~ s/\t+$//;
+	$text =~ s/\t/\n/g; # join OPIS[1-11]
 
 	return ( $idsl, $tag, $tagno, $id, $sfi, $sfino, $text );
 });
 
-csv_file( 'IDNTAG.csv', sub {
+csv_file( 'tsv/IDNTAG.csv', sub {
 	my $line = shift;
 
-	my ( $idsl, $tag, $STSL, $KZVS, $BIBRAZ, $HIRAZ, $KPS, $OKO ) = split(/,/,$_);
+	my ( $idsl, $tag, $STSL, $KZVS, $BIBRAZ, $HIRAZ, $KPS, $OKO ) = split(/\t/,$_);
 
 	my @leader;
 	$leader[5] = $STSL;
@@ -89,15 +132,15 @@ csv_file( 'IDNTAG.csv', sub {
 	return;
 });
 
-csv_file( 'OBRTAG.csv', sub {
+csv_file( 'tsv/OBRTAG.csv', sub {
 	my $line = shift;
 
-	my ( $IDSL, $TAG, $TAGNO, $ID, $SFI, $SFINO, $CODINF ) = split(/,/,$_);
+	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 = keys %$data;
+my @ids = sort keys %$data;
 print STDERR scalar(@ids), " found\n";
 
 my $marc_file = 'liberated.marc';
@@ -107,6 +150,8 @@ 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} );
@@ -114,9 +159,10 @@ foreach my $id ( @ids ) {
 		}
 		foreach my $arr ( @{ $data->{$id}->{$field} } ) {
 			if ( ! $arr ) {
-				print STDERR "SKIPPED $id $field ",dump( $data->{$id}->{$field} ), "\n";
+#				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 );
 		}
 	}