Projekt: Hesla Jednoty bratrské/2016/hes-sql-transl.pl
Vzhled
hes-sql-transl.pl
[editovat]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/;
$_;
}