# HES98PRE.PL Predupravy Hesla z formatu VENTURA do .PRE
# Petr Herman
# Predem musi byt pripraveny soubory:
# - tabulka knih: 'hes98kni.tab'
# - perikopy: 'hes98per.txt'
# Otaguje zacatky radek:
#
# @> Nedelni tyden
# $> Svatek
# +> Nedele
# x> vsedni den
# 0> Heslo tydne
# 1> Prvni (SZ) heslo nebo heslo tydne apod.
# 2> Druhy (NZ) vers
# -> Odkaz do SZ (neexistuje odkaz do Bible (SZ-neni jeste udelano))
# => Odkaz do NZ (existuje odkaz do Bible (NZ-uz je hotovo))
# %> Vyznamny den, tyden (v nadpisu)
# _> Vyznacna udalost (v poznamce na konci)
# ?> Dale neurceny (podivny?) radek
# { Zacatek pisne
# } Konec pisne
# Kombinace (napr.):
# 1=> Prvni cteni s odkazem do Bible
$rok = '98'; # Kalendarni rok
open(KNITAB, "hes${rok}kni.tab") || die
"Nemuzu otevrit seznam knih 'hes${rok}kni.tab'";
#-------- Nacti tabulku biblickych knih ------
while(<KNITAB>)
{
chop;
s/ +/ /g;
($exist, $zkr, $dlouhy) = split(/ /);
if ($exist eq '+') # Knihy (zkratky) existuji
{
$zkr =~
tr/ÁÉĚÍÓÚŮÝŽŠČŘĎŤŇáéěíóúůýžščřďťň/AEEIOUUYZSCRDTNaeeiouuyzscrdtn/;
$zkr =~ tr/A-Z/a-z/;
$ZKR{$dlouhy} = $zkr;
}
else
{ push (@NEEX, $dlouhy);} # Seznam knih co neexistuji
}
close KNITAB;
#-------- Nacti tabulku perikop --------
open(PERI_TXT, "hes${rok}per.txt") || die
"Nemuzu otevrit soubor perikop 'hes${rok}per.txt'";
$n_peri=0;
while(<PERI_TXT>)
{
($je, $PERI[$n_peri], $PERI_ODK[$n_peri++]) = &odd_odkaz($_);
$je || die "Fatal: Nejde oddelit odkaz v perikope '$_'!";
}
close PERI_TXT;
#---- Nacti hesla mesicu, generuj soub. mesicu s odkazy ----
open(MES_TXT, "hes${rok}mes.txt") || die
"Nemuzu otevrit hesla mesicu 'hes${rok}mes.txt'";
open(STDOUT, ">hes${rok}mes.pre") || die
"Nemuzu otevrit soubor pro hesla mesicu 'hes${rok}mes.pre' pro zapis.";
while(<MES_TXT>)
{
if (/^\d\d/) {$n_mes = $&; $line=0; print; next;}
if (!$line) # Heslo mesice
{
$line++; # priste odkaz
$HES_MES[$n_mes] = $_;
print;
}
else # odkaz
{
$ODK_MES[$n_mes] = $_;
print &kni_odk($_);
}
}
close STDOUT;
close MES_TXT;
#-------- Otevri vystupni soubor pro perikopy --------
open(PERI, ">hes${rok}per.pre") || die
"Nemuzu otevrit soubor 'hes${rok}per.pre' pro zapis";
$n_peri=0;
$/ = ""; # paragraph mode
#======== CYKLY PRO VSECHNY MESICE ========
foreach $filename (@ARGV)
{
open(INFILE, $filename) || do
{ print STDERR "Nemuzu otevrit soubor $filename: $!\n"; next; };
if($filename=~/hes$rok(\d\d).txt/ && $1<=12) # nazev souboru
{
$n_mes = $1;
$outfile = 'hes'.$rok.$n_mes.'.pre';
}
else
{
print STDERR "Soubor \'$filename\' preskocen - nema tvar /hes$rok\\d\\d.txt/\n";
next;
}
open(STDOUT, ">$outfile") || do
{ print STDERR "Nemuzu presmerovat STDOUT do $outfile: $!\n"; next; };
print STDERR "\tMakam na souboru $filename --> $outfile\n";
print $HES_MES[$n_mes]; # Heslo mesice
print &kni_odk($ODK_MES[$n_mes]); # Odkaz
$line = 0;
#======== HLAVNI CYKLUS PRO SOUBOR MESICE ========
#<INFILE>; # Preskoc prvni radek (nazev mesice)
while (<INFILE>) ##### pro kazdy paragraph: ######
{
# &status; # napis status (pro ladeni)
tr/\n//s; # vyhazi prazdne radky
s/\n/ /g; # slouci radky
s/ $/\n/; # posledni \n obnovi
s/^(@[A-Z]+ = )\s*/$1/; # nadbytecne mezery za rovnitkem
#print;
#}if(0){
if(/^@STRANA1? = /) {next;}
if(/^$/) {next;}
if(/^@NADPISS(PM)?1? = / || /^@STRED = <B>/) # Nedele tydnu nebo svatek #
{
$_ = $';
s/<D>//;
### @> NEDELE TYDNU ###
if( /^\s*((2)\.\s?(n).*(po) (vá)nocích.*)$/
|| /^\s*((\d)\.\s*(ne)děle.*(Zj).*)\s*$/
|| /^\s*((Po)sl.*(ne)děle.*(Zj).*)\s*$/
|| /^\s*(.*(Septua)gesimae.*)$/
|| /^\s*(.*(Sexa)gesimae.*)$/
|| /^\s*(.*(Estom)ihi.*)$/
|| /^\s*(.*(Invoc)avit.*)$/
|| /^\s*(.*(Remin)iscere.*)$/
|| /^\s*(.*(Oculi).*)$/
|| /^\s*(.*(Laet)are.*)$/
|| /^\s*(.*(Judica).*)$/
|| /^\s*(.*(Palma)rum.*)$/
|| /^\s*((Ne).*(veli)konoční.*)$/
|| /^\s*((Quasim)odogeniti.*)$/
|| /^\s*((Miseri)cordias.*)$/
|| /^\s*((Jubil)ate.*)$/
|| /^\s*((Cant)ate.*)$/
|| /^\s*((Rog)ate.*)$/
|| /^\s*((Exaudi).*)$/
|| /^\s*((Ne).*(svat)odušní.*)$/
|| /^\s*((Ne).*(Troj)ice.*)$/
|| /^\s*((\d{1,2})\.\s*(ne)děle.*(Tr)ojici.*)\s*$/
|| /^\s*((Posl)ední (ne)děle.*)$/
|| /^\s*((\d)\.\s*neděle.*(adv).*)\s*$/
|| /^\s*((N).*(po) (ván)ocích.*)$/)
{
$line=0;
$tyden=2;
$nedele=0;
$c_verse = 0;
$peri1 = '@';
$peri2 = $2.$3.$4.$5;
$peri2 =~ tr/ÁÉĚÍÓÚŮÝŽŠČŘĎŤŇáéěíóúůýžščřďťň/AEEIOUUYZSCRDTNaeeiouuyzscrdtn/;
print "\n@>$peri2> $_"; # odradkuj a tag pred tydnem
}
### $> SVATKY ###
elsif (/^\s*((Nov)ý (rok).*)$/
|| /^\s*(.*(Epif)anias.*)$/
# || /^\s*((Svět)ový.*(mod))/
|| /^\s*((Zel)ený čtvrtek.*)$/
|| /^\s*((Vel)ký [p|P]átek.*)$/
|| /^\s*((Po).*(veli)konoční.*)$/
|| /^\s*((Nanebe)vstoupení.*)$/
|| /^\s*((Po).*(svat)odušní.*)$/
# || /^\s*((Den) (ref)ormace.*)$/
|| /^\s*((Den) (pok)ání.*)$/
|| /^\s*((Štědrý) den.*)$/
|| /^\s*((\d).*svátek (ván)oční.*)$/
|| /^\s*((Závěr) roku.*)$/ )
{
$line=0;
$svatek=2;
$nedele=0;
$peri1 = '$';
$peri2 = $2.$3.$4.$5;
$peri2 =~ tr/ÁÉĚÍÓÚŮÝŽŠČŘĎŤŇáéěíóúůýžščřďťň/AEEIOUUYZSCRDTNaeeiouuyzscrdtn/;
print "\n\$>$peri2> $_"; # odradkuj a tag pred svatkem
}
else
{
print "\n!!![$&] @> $_\n"; # error
}
}
elsif(/^@DATU?S[SB][MVL]?1? = /) ### +> x> NEDELE, VSEDNI DEN ###
{
$_ = $';
if (/<B>((\d{1,2})\. Neděle)\. ?<D> ?(.*)/)
{
if($svatek) {$svatek--;}
if($tyden) {$tyden=0;}
$den=$2;
$nedele=1;
$line = 0;
print "\n+> $1\n"; # odradkuj a tag pred nedeli
&vers('1',$3); # SZ vers
&peri;
}
elsif (/<B>((\d{1,2})\. (Pondělí|Úterý|Středa|Čtvrtek|Pátek|Sobota))\. ?<D> ?(.*)/)
{
if($svatek) {$svatek--;}
if($tyden) {$tyden=0;}
$den=$2;
$nedele=0;
print "\nx> $1\n"; # odradkuj a tag pred vsednim dnem
$line = 0;
&vers('1',$4); # SZ heslo
&peri;
}
else
{
print "\n!!![$&] +x> $_\n"; # error
}
}
elsif(/^@DATUBEZ[BS][MV]?1? = /) ### 0> HESLO TYDNE, SVATKU nebo NZ ###
{
$_ = $';
# chop $_;
if ($tyden || $svatek) # heslo tydne nebo svatku?
{ &vers('0', $_);}
else # NZ vers vsedniho dne
{ &vers('2', $_);}
}
elsif(/^@EVANVPRM? = /) ### -> => ODKAZ NA VERS ###
{
$_ = $';
# chop;
print &kni_odk($_);
$line++;
}
elsif(/^@EVANVLE[MV]?[12]? = /) ### 1> 2> ODKAZ NA DVE CTENI ###
{
$_ = $';
if(s/<R>/ /) # 3 odkazy
{
($je, $_, $cteni3) = &odd_odkaz($_);
if (!$je)
{
print "\n!!![$&] 3> $_\n"; next; # neoddelen 3.odkaz
}
($je, $cteni1, $cteni2) = &odd_odkaz($_);
if (!$je)
{
print "\n!!![$&] 2> $_\n"; next; # neoddelen 2.odkaz
}
else
{
print "1"; print &kni_odk($cteni1);
print "2"; print &kni_odk($cteni2);
print "3"; print &kni_odk($cteni3);
}
}
else
{
($je, $cteni1, $cteni2) = &odd_odkaz($_);
if (!$je)
{
print "\n!!![$&] 2> $_\n"; next; # neoddelen 2.odkaz
}
else
{
print "1"; print &kni_odk($cteni1);
print "2"; print &kni_odk($cteni2);
}
}
}
elsif(/^@EVANSTR = /) ### 1> 2> 3> ODKAZ NA TRI CTENI ###
{
$_ = $';
($je, $_, $cteni3) = &odd_odkaz($_);
if (!$je)
{
print "\n!!![$&] 3> $_\n"; next; # neoddelen 3.odkaz
}
($je, $cteni1, $cteni2) = &odd_odkaz($_);
if (!$je)
{
print "\n!!![$&] 2> $_\n"; next; # neoddelen 2.odkaz
}
else
{
print "1"; print &kni_odk($cteni1);
print "2"; print &kni_odk($cteni2);
print "3"; print &kni_odk($cteni3);
}
}
elsif(/^@BASENBV? = /) ### PISEN ###
{
$_ = $';
print "{\n";
s/<R>\s?/\n/g;
s/ *<M>/\n} /;
s/<D>//;
print;
}
elsif(/^@NADPISK[12]? = /) ### VYZNAMNY DEN, TYDEN ###
{
$_ = $';
print "%> $_";
next;
}
elsif(/^@DATUBEZS = <B>/) ### VYZNAMNA UDALOST ###
{
$_ = $';
s/<D>//;
print "_> $_";
}
elsif(/^@\w+ = /) ### NEZNAMY TAG ###
{
$_ = $';
print "\n!!![$&] ?> $_\n"; # error
}
else
{
print "\n!!! ??> $_\n"; # neznamy radek
}
}
}
close PERI;
#################### Subroutines #############################
sub peri # zapise perikopu do seznamu perikop
{
local ($zkraceny);
#print STDERR "perikopa $peri1";
if($peri1)
{ print PERI "$peri1";
if ($peri1 eq '@')
{
print PERI ++$n_tyden;
$/ = "\n"; #line mode
chop ($zkraceny = <DATA>);
$/ = ""; #paragraph mode
#print STDERR "$n_tyden; $zkraceny\n";
}
#print STDERR "|$n_mes|$den|$peri2|$zkraceny|$PERI[$n_peri]|",
print PERI "|$n_mes|$den|$peri2|$zkraceny|$PERI[$n_peri]|",
&kni_odk($PERI_ODK[$n_peri++]);
$peri1='';
}
}
#--------------------------------------------------------------
sub odd_odkaz # Oddeli odkaz na konci radku
{
local ($_) = @_;
local ($odk);
if(/(.*)<_>(.*)/) # separovano <_><_> <_>
{
$_ = $1;
$odk = $2;
s/<_>//g;
s/<~>//g;
s/<%-?\d>//g; # Vyhodi <%-2>, <%0> atd.
s/<N>/ /g; # nedelitelna mezera
tr/ / /s; # Na jednu mezeru
s/ $//; # Mezera na konci
return (1, $_, $odk);
}
else {
(scalar(/\s+(\d\.)?\s*([A-ZÁÉĚÍÓÚŮÝŽŠČŘĎŤŇ][a-záéěíóúůýžščřďťň]+\s?\d[0-9,;\.\-abc\(\) ]*\s*(E|H|GS|B|K|Z|JH|S|Ž|P|ZJ)?)$/),
$`, $1.$2); }
}
#--------------------------------------------------------------
sub vers
{
local ($sz_nz,$_) = @_;
($je, $vers, $odkaz) = &odd_odkaz($_);
if($je)
{
print "$sz_nz> $vers\n";
$line +=2;
print &kni_odk($odkaz);
return 1;
}
else
{ print "$sz_nz> $_\n"; $line++; return 0; }
}
#--------------------------------------------------------------
sub status # vypis status pro ladeni
{
print $tyden ? 'T' : ' ';
print $svatek ? 'S' : ' ';
print $nedele ? 'N' : ' ';
print $pisen ? $pisen>0 ? '+' : '- ' : '=';
print $line;
print ' ';
}
#--------------------------------------------------------------
sub zkratka # hleda zkratku biblicke knihy
{
local ($kniha) = @_;
local ($zkr);
if($zkr = $ZKR{$kniha})
{ return $zkr;} # zkratka existuje
NEEXISTUJE:
{
for ($i=0; $i<scalar(@NEEX); $i++)
{
if ($kniha eq $NEEX[$i])
{ last NEEXISTUJE; }
}
return -1; # chyba - kniha nikde nenalezena
}
return ''; # kniha neexistuje
}
#--------------------------------------------------------------
sub kni_odk # tiskne dlouhy odkaz a zkratku
{
local ($_) = @_;
local ($kniha, $kap, $vers, $kap_verse, $odkaz, $zkr, $out);
if(/(\d\.)? ?([A-ZÁÉĚÍÓÚŮÝŽŠČŘĎŤŇ][a-záéěíóúůýžščřďťň]+)\s?((\d+)(,\s?(\d+))?.*)/)
# 1 -1 2 -2 34 -45 6 -6-5 -3
{
$kniha = $1.$2;
$kap = $4;
$vers = $6;
$kap_verse = $3;
$odkaz = $kniha.' '.$kap_verse;
$zkr = &zkratka($kniha);
if(!$zkr) # Kniha neni
{ return $out .= "-> $odkaz\n"; }
if($zkr == -1)
{ return $out .= "~> $odkaz !>kniha!\n";}
$out .= "=> $odkaz >$zkr $kap";
if($vers) {$out .= ",$vers\n";}
else { $out .= ",0\n";}
}
else
{ return $out .= "~> '$_' !>syntax!\n";}
}
__END__
2.po vánocích
1.po Zj.Páně
2.po Zj.Páně
3.po Zj.Páně
4.po Zj.Páně
Septuagesimae
Sexagesimae
Estomihi
Invocavit
Reminiscere
Oculi
Laetare
Judica
Palmarum
Velikonoční
Quasimodogen.
Misericord.D.
Jubilate
Cantate
Rogate
Exaudi
Svatodušní
Sv. Trojice
1. po sv.Tr.
2. po sv.Tr.
3. po sv.Tr.
4. po sv.Tr.
5. po sv.Tr.
6. po sv.Tr.
7. po sv.Tr.
8. po sv.Tr.
9. po sv.Tr.
10.po sv.Tr.
11.po sv.Tr.
12.po sv.Tr.
13.po sv.Tr.
14.po sv.Tr.
15.po sv.Tr.
16.po sv.Tr.
17.po sv.Tr.
18.po sv.Tr.
19.po sv.Tr.
20.po sv.Tr.
21.po sv.Tr.
22.po sv.Tr.
23.po sv.Tr.
Poslední
1. adventní
2. adventní
3. adventní
4. adventní
Po vánocích
