Projekt: Hesla Jednoty bratrské/2016/hes-sql-transl.pl

hes-sql-transl.pl

Skript pro převod německých odkazů na verše z českých překladů bible – zůstává beze změny z minulých let.

#! /usr/bin/perl -w

# hes-sql-transl.pl    Převod databáze s německými Losungen do češtiny
# (copyleft)	  Petr Heřman
# v. 0.1		rok 2014

use strict;
#use utf8;
#use open ':utf8', ':std';
#binmode STDOUT, ':utf8';
#binmode STDOUT, 'encoding(utf8)';

use HesSQL qw($dbh $bib_dbh $transbook $nbook $bookname  $bibleverse $day_cs_r $day_w $song_w
    $dayname_w $losung_w $reading_w $day_r $losung_r $reading_r $seq_w);

my $verbose	= 10;

my %subst_sunday = (
    'DRITTLETZTER SONNTAG DES KIRCHENJAHRES' => 1,	# kolik se přičte k poslední počítané
    'VORLETZTER SONNTAG DES KIRCHENJAHRES'   => 2
);
my $nach_trinitatis=0;					# naposledy počítaná

my %dow_cs = (Mo=>'Po', Di=>'Út', Mi=>'St', Do=>'Čt', Fr=>'Pá', Sa=>'So', So=>'Ne'); # day of week

sub default {		# Nastavení defaultní hodnoty, pokud je nulová nebo nedefinovaná
    my ($variable_ref, $default_value) = @_;
    if(! ${$variable_ref}) {${$variable_ref} = $default_value;}
}

$dbh->do("TRUNCATE `seq`");

my $seq_cs	= 0;	# pořadí záznamů v tabulce `day`

my
$rows_deleted=$dbh->do("DELETE FROM `day`     WHERE `lang`='cs'",undef,'DONE') or die $dbh->errstr;
#$rows_deleted=$dbh->do("DELETE FROM `dayname` WHERE `lang`='cs'",undef,'DONE') or die $dbh->errstr;
$rows_deleted=$dbh->do("DELETE FROM `losung`  WHERE `lang`='cs'",undef,'DONE') or die $dbh->errstr;
$rows_deleted=$dbh->do("DELETE FROM `reading` WHERE `lang`='cs'",undef,'DONE') or die $dbh->errstr;
$rows_deleted=$dbh->do("DELETE FROM `song`    WHERE `lang`='cs'",undef,'DONE') or die $dbh->errstr;
$rows_deleted=$dbh->do("DELETE FROM `comment` WHERE `lang`='cs'",undef,'DONE') or die $dbh->errstr;
#$rows_deleted=$dbh->do("DELETE FROM `drittetext` WHERE `lang`='cs'",undef,'DONE')or die $dbh->errstr;

my $form = $verbose ? "%10s: %3d rows\n" : "";

printf $form, 'day', $day_r->execute();
while(my @row = $day_r->fetchrow_array ) {
    my ($date, $dow, $seq, $which, $nr, $D_text, $sel, $text, $meaning, $src) = @row;
    $text or die "$date: Chybí záznam v day_cs '$D_text'";
    if($D_text =~ /\. SONNTAG NACH TRINITATIS/) {$nach_trinitatis = $`;}
    elsif(my $addto = $subst_sunday{$D_text}){
        $text = $nach_trinitatis+$addto.'. neděle po sv. Trojici';
    }
    $day_w->execute($sel, $date, $dow_cs{$dow}, $seq, $which, $nr, 'cs', $text, $meaning, $src);
    $seq_w->execute($seq, ++$seq_cs);

    if($which eq 'sunday') {
      $song_w->execute(1, $date, $seq, 'Ld', 'cs', '', '', undef, undef, undef);
    }
}

printf $form, 'reading', $reading_r->execute();
while(my @row = $reading_r->fetchrow_array ) {
    my($sel, $date, $seq, $which, $lang, $source) = @row;
    #printf "%1d  %10s  %2d  %3s  %2s  %-30s", @row;
    my @source_cs;
    #foreach my $src(split / oder /, $source){
    foreach my $src(split /\/ oder /, $source){		# Matthäus 6,16-21 / oder 2.Petrus 1,2-11
        #print "$src |";
	$src =~ s/ +/ /g;
        $src =~ / /; my($book, $numb)=($`, $');
        if((my $nrows = $transbook->execute($book))==1){
	    #my($book_cs) = $transbook->fetchrow_array;
	    #print("'$src' -> $book -> '$book_cs $numb'\n");
	    push @source_cs, $transbook->fetchrow_array.' '.$numb;
	} else {
            print STDERR "\t!! reading $date, seq=$seq, which=$which: Nejeden ($nrows) překlad '$source'->'$src' \n";
	}
    }
    #print "\n";
    #print join(' | ', @source_cs), "\n";
    $reading_w->execute(1, $date, $seq, $which, 'cs', join(' | ', @source_cs));
}

sub transintro;

printf $form, 'losung', $losung_r->execute();
while(my @row = $losung_r->fetchrow_array ) {
    my($sel, $date, $seq, $which, $nr, $lang, $transl, $source, $intro, $text) = @row;

    #sub chyba {
    #	my($text) = @_;
    #	print STDERR "\t!! $date seq=$seq which=$which: $text\n";
    #}

    my $intro_cs = undef;
    $intro_cs = transintro($intro) if $intro;
    #print "$intro_cs ($intro)\n" if $intro;

    $source =~ s/Judas +/Judas 1,/;
    $source =~ s/3.Johannes +/3.Johannes 1,/;
    $source =~ s/Philemon +/Philemon 1,/;

    $source =~ /^(\S+) +(\d+),(\d+)([.-])?(\d*)([.-])?(\d*)(.*)/
        or print STDERR "\t!! $date seq=$seq which=$which: Podivný tvar odkazu '$source'\n";
    my($book, $k, $v, $spoj, $v2, $spoj2, $v3, $rest)=($1, $2, $3, $4, $5, $6, $7, $8);
#    if($rest) {print  STDERR "\t?? $date seq=$seq which=$which: Nezpracovaný zbytek '$rest' u odkazu '$source'\n";}

    my $nrows; ($nrows = $nbook->execute($book)) == 1
        or print STDERR "\t!! $date seq=$seq which=$which: Nejedno ($nrows) číslo knihy '$book'\n";
        #or chyba "Nejedno ($nrows) číslo knihy '$book'";
    my $b = $nbook->fetchrow_array;

    ($nrows = $bookname->execute($b, 'hes', 1)) == 1
        or print STDERR "\t!! $date seq=$seq which=$which: Nejedno ($nrows) jméno knihy '$book' č.'$b' ($date)\n";
    my $book_cs = $bookname->fetchrow_array;

    my @alternate_numb;		# rozdílné číslování u kraličky
    undef @alternate_numb;

    my %tr_cs = (cep => '', kra => ' K');
    foreach my $transl_cs('cep', 'kra') {

        if (@alternate_numb) {
            ($k, $v) = @alternate_numb;
#	    print " {$k:$v}\n";
#            undef @alternate_numb;
        }

        my $source_cs = "$book_cs $k,$v";
        $source_cs .= "$spoj$v2" if $spoj;
        $source_cs .= "$spoj2$v3" if $spoj2;
        $source_cs .= $rest if $rest;
        #printf "%20s -> %-20s:", $source, $source_cs;

        my @verses = ($v);
        if($spoj) {
            if   ($spoj eq '.') {push @verses, $v2;}
            elsif($spoj eq '-') {for(my $i=$v+1;$i<=$v2;$i++){push @verses, $i;}}
            else {print STDERR "\t!! $date seq=$seq which=$which: divná spojka '$spoj' ($date)\n;"}
	    if($spoj2) {
		if   ($spoj2 eq '.') {push @verses, $v3;}
		elsif($spoj2 eq '-') {for(my $i=$v2+1;$i<=$v3;$i++){push @verses, $i;}}
		else {print STDERR "\t!! $date seq=$seq which=$which: divná spojka2 '$spoj2' ($date)\n;"}
	    }
        }
        #print "\n";

        my $text_cs = '';
        foreach my $vi(@verses) {
            my $id = "$b/$k:$vi".$tr_cs{$transl_cs};
            my $nrows; ($nrows = $bibleverse->execute($id))
                or print STDERR "\t!! $date seq=$seq which=$which: nejeden ($nrows) verš $id ($date)\n";
            my $verse; $verse = $bibleverse->fetchrow_array
                or print STDERR "\t!! $date seq=$seq which=$which: prázdný verš '$id'='$source_cs' ($date)\n";
            if ($transl_cs eq 'cep'){
                if ( $verse =~ s/^\[(\d+),(\d+)\] //) {
                    @alternate_numb = ($1, $2);
                    print "$date $which: [$1,$2] $id = $source_cs = '$verse'\n";
                } elsif ( $verse =~ s/^\[(\d+)] //) {
                    @alternate_numb = ($k, $1);
                    print "$date $which: [$1] $id = $source_cs = '$verse'\n";
                }
            }
            $text_cs .= $verse . ' ';
        }
        $text_cs =~ s/ +$//;
        $text_cs =~ s/`/'/;
        if ($transl_cs eq 'kra' && @alternate_numb) {
	    print ("$date $which ($transl_cs) {$k:$v}: $source_cs = $text_cs\n\n");
            undef @alternate_numb;
        }
        #print ("$date, $seq, $which, $source_cs: $text_cs\n") if $spoj;
        # table losung: sel, date, seq, which, nr, lang, transl, source, intro, text;
        $losung_w->execute(1, $date, $seq, $which, $nr, 'cs', $transl_cs,
            $source_cs.$tr_cs{$transl_cs}, $intro_cs, $text_cs);
    }
}

$dbh->disconnect;
$bib_dbh->disconnect;

sub transintro {
    ($_) = @_;
    s/: *^//;
    s/im Gleichnis/v podobenství/;

    s/Maria betete/Maria se modlila/;
    s/betete/se modlil/;
    s/erzählte/vyprávěl/;
    s/gelobte Gott/velebil Boha/;
    s/gelobte/velebil/;
    s/predigte/se modlil/;
    s/schreibt/píše/;
    s/sagte/řekl/;
    s/schrie/křičel/;
    s/sprach zu David/mluvil k Davidovi/;
    s/sprach zu Isaak/mluvil k Izákovi/;
    s/sprach zu Josef/mluvil k Josefovi/;
    s/sprach zu Petrus/mluvil k Petrovi/;
    s/sprach/mluvil/;
    s/sprachen/mluvili/;
    s/spricht/říká/;

    s/zu Abram/k Abramovi/;
    s/zu der Frau/ženě/;
    s/zu dem Geheilten/uzdravenému/;
    s/zu dem Hauptmann/setníkovi/;
    s/zu dem Knecht/služebníkovi/;
    s/zu der samaritischen Frau/samařské ženě/;
    s/zu seinen Jüngern/svým učedníkům/;
    s/zu den Jüngern/učedníkům/;
    s/zu den Zwölfen/dvanácti/;
    s/zu Bartimäus/Bartimeovi/;
    s/zu Natanael/Natanaelovi/;
    s/zu Petrus/Petrovi/;
    s/zu Paulus/Pavlovi/;
    s/zu Philippus/Filipovi/;
    s/zu Pilatus/Pilátovi/;
    s/zu Maria/Marii/;
    s/zu Maria aus Magdala/Marii Magdaléně/;
    s/zu Marta/Martě/;
    s/zu Saulus/Saulovi/;
    s/an Timotheus/Timotheovi/;
    s/zu Zachäus/Zacheovi/;

    s/Der Blinde/Slepý/;
    s/Der Engel/Anděl/;
    s/Der Geheilte/Uzdravený/;
    s/Der Hauptmann/Setník/;
    s/der HERR/Hospodin/;
    s/Der HERR/Hospodin/;
    s/Der Herr/Pán/;
    s/Der Seher/Prorok/;
    s/der Täufer/Křtitel/;
    s/Ein Mann/Nějaký muž/;
    s/Christus/Kristus/;
    s/Gott/Bůh/;
    s/Jesus/Ježíš/;
    s/Jesu/Ježíš/;
    s/Johannes/Jan/;
    s/Nathanael/Natanael/;
    s/Pavel und Barnabas/Pavel a Barnabáš/;
    s/Paulus/Pavel/;
    s/Petrus/Petr/;
    s/Simon/Šimon/;
    s/Zachäus/Zacheus/;
    s/So/Tak/;
    $_;
}