Projekt: Hesla Jednoty bratrské/1999/hes99pre.pl

Z Wikiverzity
                                                                             
#!/usr/bin/perl

# HES99PRE.PL	Predupravy Hesla
#	Petr Herman

#	Otaguje zacatky radek:
#
#  @>	Nedelni tyden
#  $>	Svatek
#  +>	Nedele
#  x>	vsedni den
#  o>   vyznam nedele
## 0>   Heslo tydne
#  1>	Prvni (SZ) heslo
#  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 = '99';		# Kalendarni rok

open(KNITAB, "hes${rok}kni.tab") || die
  "Nemuzu otevrit seznam knih 'hes${rok}kni.tab'";

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;

open(PERI_TXT, "hes${rok}per.txt") || die
  "Nemuzu otevrit soubor perikop 'hes${rok}per.txt'";

$n_peri=0;
while(<PERI_TXT>)
  {
    ($PERI[$n_peri], $PERI_ODK[$n_peri++]) = split(/\|/);
# printf ("%02d  %15s  %15s\n", $n_peri-1, $PERI[$n_peri-1], $PERI_ODK[$n_peri-1]);
#    ($je, $PERI[$n_peri], $PERI_ODK[$n_peri++]) = &odd_odkaz($_);
#    $je || die "Fatal: Nejde oddelit odkaz v perikope '$_'!";
  }
close PERI_TXT;

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 (/^$/)	  {next};
    if (/^#/)     {next};	# kometář	
    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;

open(PERI, ">hes${rok}per.pre") || die
  "Nemuzu otevrit soubor 'hes${rok}per.pre' pro zapis";
$n_peri=0;

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;
$bl   = 0;	# blank lines

#----------------------------------------------------------------------
#Nastavení tabelátorů / formát v T602:
#1    6    12    18    24    30    36    42    48    54    60    66  70
#|    |     :     |     |     :     :     :     |     |     :     :   |
#----------------------------------------------------------------------
#                                                     MĚSÍC
#
#
#
#                 <I>Významný týden
#
#</I>                 <H2>Neděle církevního roku
#
#</H2>(Význam neděle.                                odkaz)
#
#Heslo týdne.                                   odkaz
#
#
#                 <I>Významný den
#
#</I>                 <B>Významný den církevního roku
#
#d. Den. </B>Heslo dne - starozákonní verš.         odkaz
#
#Novozákonní verš.                              odkaz
#
#1.čtení                                        2.čtení
#
#                 text písně                          číslo písně
#
#1.čtení                2.čtení                 Žalm
#
#     <B>Památný den
#
#
#</B>----------------------------------------------------------------------
#|    |     :     |     |     :     :     :     |     |     :     :   |
#1    6    12    18    24    30    36    42    48    54    60    66  70
#----------------------------------------------------------------------
#
#
# Měsíce jsou odděleny stránkou .PA
# Týdny jsou odděleny třemi volnými řádky
# Dny jsou odděleny dvěma volnými řádky
# Jednotlivé položky jsou odděleny jedním volným řádkem.


<INFILE>;			# Preskoc prvni radek (nazev mesice)
$inp_line = 1;			# input line = počítadlo vstup. řádek

while (<INFILE>)            ##### pro kazdy paragraph: ######
  {
    $inp_line++;

    s/<.{1,3}>//g;		# Odtaguj
    s/^ *//;			# vybodni se na mezery na zacatku

#    if(!$ne_prvni) { $ne_prvni=1; next; }	# preskoc nazev mesice
#   s/[ \t]+/ /g;                  # vse na jednu mezeru
#   s/^ //;                        # ukousni prvni mezeru
   s/ $//;                        # ukousni posledni mezeru

#   &status;			# napis status (pro ladeni)

   if (/^$/)  { $bl++;  next; } 
#   if (/^$/)  { $bl++; print; next; } # kolik prázdných řádek
#   if ($bl > 3) {&err (sprintf "%s volnych radku > 3", $bl);}
#   if ($bl == 2) {
				### ODDEL 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
      }
				### ODDEL  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
      }

   elsif (/((\d{1,2})\. Neděle)\. (.*)/)
      {
	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 (/((\d{1,2})\. (Pondělí|Úterý|Středa|Čtvrtek|Pátek|Sobota))\. (.*)/)
      {
	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;
      }
   elsif ($tyden || $svatek && $line==0)	# heslo tydne nebo svatku?
      {
	chop $_;
	&vers('0', $_);
      }
   elsif ($svatek && $line==1)	# Odkaz na heslo tydne ?
      {
	chop;
	print &kni_odk($_);
	$line++;
      }
   elsif ($line==1)		# Odkaz na SZ vers ?
      {
	chop;
	print &kni_odk($_);
	$line++;
      }
   elsif ($line==2)		# NZ vers ?
      {
	chop $_;
	&vers('2', $_);
      }
   elsif ($line==3)		# Odkaz na NZ vers ?
      {
	chop;
	print &kni_odk($_);
	$line++;
      }
   elsif ($line==4)		# Odkazy na cteni?
      {
	if (($nedele || $svatek) &&
		$pisen >= 0 )	# Je nebo bude pisen
	      {
		if (!$pisen)	# Zacatek pisne
		  {
		    $pisen = 1;
		    print "{\n";
		  }
		if (/(\d+,\d+)$/) # posledni vers (odkaz na sloku)
		  {
		    print "$`\n} $1\n";
		    $pisen = -1; # ukonceni pisne
		  }
		else
		  {
		    print;	# Prvni nebo dalsi (ne posledni) vers
		  }
	      }
	else			# Odkazy na cteni
	  {
	  CTENI:
	  {
	    $line++;
	    $pisen = 0;
#	    print "%> $_";

	    if ($nedele || $svatek)	# 3 cteni
	      {
 		($je, $_, $cteni3) = &odd_odkaz($_);
		if (!$je) { print "3!> $_"; last CTENI;} # neoddelen 3.odkaz
	      }
	    ($je, $cteni1, $cteni2) = &odd_odkaz($_);
	    if ($je)
	      {
		print "1"; print &kni_odk($cteni1);
		print "2"; print &kni_odk($cteni2);
	      }
	    else
	      { print "2!> $_";}	# neoddelen 2.odkaz

	    if ($nedele || $svatek)	# 3 cteni
	      {
		print "3"; print &kni_odk($cteni3);
	      }
	  }
	  }
      }
   elsif ($line==5)		# Vyznamna udalost?
      {
	print "_> $_";
	$line++;
      }
   else				# Dalsi dale neurcene radky
      {
	print "?> $_";
	$line++;
      }
 }
}

close PERI;

#################### Subroutines #############################

sub peri		# zapise perikopu do seznamu perikop
{
  local ($zkraceny);
  if($peri1)
    { print PERI "$peri1";
      if ($peri1 eq '@')
	{
	  print PERI ++$n_tyden;
	  chop ($zkraceny = <DATA>);
	}
      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 ($_) = @_;
 (scalar(/\s+(\d\.)?\s*([A-ZÁÉĚÍÓÚŮÝŽŠČŘĎŤŇ][a-záéěíóúůýžščřďťň]+\s?\d[0-9,;\.\-abc\(\) ]*\s*(E|H|GS|B|K|Z|S|Ž|P|KMS)?)$/),
	$`, $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";}
}

sub inp_err			# chyba ve vstupnim souboru
{
  local ($err) = @_;
  printf STDERR ("err. on line %d: %s\n%s\n", $inp_line, $err, $_); 
}

__END__
2.po vánocích
1.po Zj.Páně
2.po Zj.Páně
3.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.
24.po sv.Tr.
Poslední
1. adventní
2. adventní
3. adventní
4. adventní
2. svát.ván.