Projekt: Hesla Jednoty bratrské/2010/los10pre.pl

Přidat odkazy
Z Wikiverzity

los10pre.pl 

#!/usr/bin/perl -w
# Version 09-01
# odkazy: druhý besonderstag už není neděle ale svátek
# vyhází na začátku {...} a prázdné řádky
# Užití:
# perl losung.pl -s los09-04.txt > los09-04.pre 

#use Getopt::Long;
#my $result = GetOptions();
#print "result='$result'\n";

use Getopt::Std;

if ($main::opt_s) {};	# Jen abych se vyhnul warningu:
			# Name "main::opt_s" used only once: possible typo
if (!getopts('s')) {
     die "Chybné parametry příkazové řádky!\n".
	 "-s   swap: přehodí písně, čtení atd. u nedělí a svátků na konec dne\n";
}

#if ($main::opt_s) { die "swap OK"};

$year		= '2010';
@days		= (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
$month		= 0;
$day		= 0;	# day of month
$dow		= 4;	# day of week (sunday = 0, monday = 1, ...) = kterym_zacina_rok - 1; 1.1.2010 = pátek
$doy		= 0;	# day of year
$sonntag	= 0;	# poběží neděle
$inputline	= '';
$linenumber	= '0';
$besontail 	= '';	# odkazy v Besonderstagu
$if_besontail	= 0;	# jestli ten den je besontail
$style		= '';	# styl pro danou řádku, vycucnutý z .odt souboru

$src_template = '(([1-5]\. )?[A-ZÄÖÜ][a-zäöüß]+ ([0-9abc.,;\-]+))';
#o: $src_template = ' (([1-5]\.)?[A-ZÄÖÜ][a-zäöüß]+ ([0-9abc.,;\-]+))';

@dny_tydny = qw(
Weltgebetswoche
Beginn
Weltgebetstag
Weltgebetswoche
Gebetstag
);


sub err {
    my ($errormeldung) = @_;
    printf "\n!!%d: %02d.%02d. %s!!\n>>>%s<<<\n", $linenumber, $day, $month, $errormeldung, $_;
    die;
}

sub doy_dow {		# Day of year and Day of week
    $doy++;
    $dow++;
    $dow %= 7;
    if(! $dow) { $sonntag = 1;}
    my $d=0;
    for (my $m=1; $m<$month; $m++) { $d += $days[$m]; }
    $d += $day;
    if($d != $doy) { err "ERR1: den v roce počítaný = $doy != dle data = $d";}
}

##### main #####

# Strategie:
# Každá subroutina:
# - vstupní řádku má v $imputline, ale může si číst i další pomocí &readline
# - zkouší, zda na ni dotyčný řádekl pasuje
# -- jestli ano: zapíše výstup, vrátí 1
# -- jestli ne: vrátí 0

while ( &readline ) {
    if( &month )	{ next; }
    if( &date )		{ next; }
    if( &besonderstag ) { next; }
    if( &tag )		{ next; }
    if( &pozn)		{ next; }
    if( &week )		{ next; }
    print "?> $inputline";
#    err ("ERR2: Co to je?");
}


##### subroutines #####

sub readline {
    while (1) {
	$linenumber++;
	$_ = <>;
	if(!$_) {die "KONEC!\n";}
	s/^{(.*)}//;		# vyhodí {styl} na začátku řádky, zatím je sice k ničemu, ale třeba se bude někdy na něco hodit
	$style = $1;
	if (!(/^$/)) { last;}	# prázdné řádky přeskoč
    }
    $inputline = $_;
}

sub nextline {		# zatim nepoužitá subroutina
    if( ! &readline )	{ return 0; }
    if( &besonderstag ) { return 0; }
    if( &month )	{ return 0; }
    if( &date )		{ return 0; }
    return $inputline;
}

sub source {
    my ($src) = @_;
    if ( $src =~ /^$src_template$/) {
        print "-> $src\n"
    }
    else {
        err "ERR3: chybný/chybí odkaz";
    }
}

sub verse_print {
    ($tag, $verse) = @_;	# tag: 'm', '0', '1', '2' etc.>
    $verse =~ s/\s+$//;
    if($tag ne '1') {
	my $verse2 = $verse;
	$verse2 =~ s/(.*?(spricht|sprach|sagte|schrie|schreibt|betete).*?:)(.*)/<<$1>>$3/;
	if ($1) {
	   if (length($1) < 50) { $verse = $verse2;}
        }
    }
#    print "$tag> ***$verse***\n";
    print "$tag> $verse\n";
}

sub verse {
    ($tag, $_) = @_;		# tag: 'm', '0', '1', '2' etc.>
# print "sub verse: *****$_*****\n";
    if (/--/) { return 0;}	# Keine Losung
    my $spricht = '';
    if (/^(.* (spricht|sprach|sagte|schrie|schreibt|betete).*:) ?$/) {
        $spricht = "$1 ";
        &readline;
    }
    if (/^(.*) $src_template$/) {  # auf eine Reihe
#	print "--\n";
	my $verse = $spricht.$1;
	my $src = $2;
	&verse_print($tag, $verse);
	&source($src);
    }
    else {			# source auf andere Reihe
	&verse_print ($tag, $spricht.$_);
	&readline;
	chomp;
	if (/^$src_template$/) {
	    #chomp;
	    &source($_);
        }
	else {
	    err "ERR4: chybný/chybí odkaz";
	}
    }
}

sub month {
    my @month_de = qw(Januar Februar März April Mai Juni
	Juli August September Oktober November Dezember);
    my @month_cz = qw(Leden Únor Březen Duben Květen Červen
	Červenec Srpen Září Říjen Listopad Prosinec);
    $_ = $inputline;
    if (!/^([A-Za-zÄÖÜäöüß]*)$/) { return 0;}
#    print;
    my $m = 0;
    for my $month_de( @month_de ) {
	$m++;
	if ($1 eq $month_de) { goto OK;}
    }
    return 0;
OK: $month = $m;
#    $day = '1';  &doy_dow;	# v pripade, ze nejsou uvadena data 1.v mesici
#    print;
    print "\n# $month_de[$m-1]\n";
    &readline;
#  print "sub month: *****$_*****\n";
    if (! s/^Monatsspruch: //) { &err("ERR5: Fehlt Monatspruch!");}
    &readline;
    &verse ('m', $_);
    printf ("\n# %02d.%02d.%4d (%d)\n", $day, $month, $year, $dow);
}

sub week {		# jedno slovo
    $_ = $inputline;
    if (/^([A-Za-zÄÖÜäöüß]*)$/) { print "\n%> $_"; return 1;}
#    if (!/Weltgebetswoche/) { return 0;}
    foreach my $template (@dny_tydny) {
#	print "$template\n";
	if(/$template/) { print "\n%> $_"; return 1;}
    }
#    err"ERR6: WELT";
    return 0;
}

sub pozn {
    $_ = $inputline;
    if (/^(\d){1,2}\. (März|Mai|Juni|Juli|August|September|November)/)
	{ print "_> $_"; return 1;}	# začíná datumem
    return 0;
}

sub date {
    $_ = $inputline;
    if (!/^(\d{2})\.(\d{2})\.$year/) { return 0;}
    $day = $1;
    $month = $2;
    &doy_dow;
    chomp;
    print "\n# $_ ($dow)\n";
    if($besontail) { err "ERR7: Nevyprázdněný besontail:\n$besontail";}
    if($if_besontail) { err "ERR8: \$if_besontail hängt!";}
    return 1;
}

sub oprav {		# opraví/upraví odkaz na kanonický tvar
    my ($odk) = @_;
    $odk =~ s/ -/-/g;
    $odk =~ s/- /-/g;
    $odk =~ s/, /,/g;
    $odk =~ s/; /;/g;
    $odk =~ s/oder/|/;
    return $odk;
}

sub besonderstag {
    $_ = $inputline;
    # Lied,Wochenlied,Psalm,Wochenpsalm,Evangelium,Epistel,Psalm,Dritte Lesen,Predigt
    my ($ld, $wl, $ps, $wp, $ev, $ep,  $dl, $pr); 
    if (!/^____________/) { return 0;}
    &readline;
    print $sonntag ? "\n\@>> " : "\n\$>> " ;	#  Sonntag : Fest
    if(! $sonntag) {				# všední den
    	print "$_";
    }
    else {				# Sonntag 
      if(/^(.*) \((.*)\)/) {
	print "$1\n";
	my $o = $_ = $2;		# význam neděle
    	if ( / $src_template/) {	# s biblickým odkazem
            print "o> $`\n";
            print "-> $1\n";
  	}
	else {
	    print "o> $o\n";
	}
      }
      else { print "$_";}
    }
    &readline;
    if (! /::/) {                               # ještě nejsou odkazy, bude to verš
	&verse ('0', $inputline);
        &readline;				# Lied :: Psalm für Fest
#print '>>',$_.'<<';
	if    (s/^Lied: (.*) :: //) {
	    $ld = $1; $ld=~ s/ oder /|/g;
#	    print "*Ld> $ld\n";
	    $besontail .= "Ld> $ld\n";
	}
	elsif (s/^Wochenlied: (.*) :: //) {
	    $wl = $1; $wl=~ s/ oder /|/g;
#	    print "*WL> $wl\n";
	    $besontail .= "WL> $wl\n";
	}
	else { err ("ERR9: (Wochen)Lied"); }
	if (/^Psalm:? (.*)$/) {
	    $ps = $1;
#	    print "*PF> Psalm $ps\n";
	    $besontail .= "PF> Psalm $ps\n";
	}
	elsif (/^Wochenpsalm:? (.*)$/) {
	    $wp = $1;
#	    print "*WP> Psalm $wp\n";
	    $besontail .= "WP> Psalm $wp\n";
	}
	else { err ("ERR10: (Wochen)Psalm"); }

	&readline;
    }

#    s/^\(Pr.\) //;				# 2009 je evangelium zároveň jako Predigt; 2010 epištola jako Predigt
    if (/^(.*) :: (.*) :: (.*)$/) {		# Ev :: Ep :: Ps | DL
	$ev = &oprav($1);
#	print "Ev> $ev\n";
	$besontail .= "Ev> $ev\n";
	$ep = &oprav($2);
#	print "Ep> $ep\n";
	$besontail .= "Ep> $ep\n";
	$dl = $3;				# Dritte Lesen (für Fest)
	if ($dl =~ /^Psalm (.*)/) {
	    $dl = '';
	    $ps = $1;
#	    print "Ps> Psalm $ps\n";
	    $besontail .= "Ps> Psalm $ps\n";
	}
	else {
#	    print "DL> $dl\n";
	    $besontail .= "DL> $dl\n";
	}    
    }
    else { print $besontail; err ("ERR11: Lesen"); }
    
    &readline;		# Predigt
    if (/^Predigt: (.*)/) {			# 2009 není žádný zvláštní Predigt, 2010 zase je
	$pr = &oprav($1);
	print "Pr> $pr\n";
	$besontail .= "Pr> $pr\n";
	&readline;          # _____
    }
#    else { print $besontail; err ("ERR12: Predigt");}	# takže to není chyba

    if (! /^____________/) { print $besontail; err ("ERR13: Ještě něco na konci Besonderstagu"); }
    
    $if_besontail = 1;
    if(!$main::opt_s) {
	print $besontail;
	$besontail = '';
    }
    $sonntag = 0;
    return 1;
}

sub drittetext {			# Precte a analyzuje treti text
        &readline;

#	if(/(.*) {3,}(.*)/ || /(.*) ?(\*)/) {	# Autor tretiho textu na stejne radce (rok 2009)
	if(/(.*\.) ([^.,;!?]{5,})$/ || /(.*) ?(\*)/) {	# Autor tretiho textu na stejne radce (rok 2010)
	  print "DT> $1\n";			# Der dritte Text
	  print "DA> $2\n";			# Der dritte Text - Author
        }
	else {				# Autor tretiho textu na dalsi radce
	  print "DT> $_";			# Der dritte Text
          &readline;
	  print "DA> $_";			# Der dritte Text - Author
        }
}

sub tag {
    $_ = $inputline;

    if(! /^(\d{1,2})\. ([MDFS][a-z]+)$/) { return 0;}

    my @tage = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
    my ($l1, $l2);			# 1.Lesen, 2.Lesen
    
    if($1 != $day) { err "ERR14: den počítaný $day != udaný $1";}
    if($2 ne $tage[$dow]) { err "ERR15: den v týdnu počítaný $dow != udaný $2";}

    if($dow) {				# Wochentag
        print "\nx> $_";

        &readline;			# Losung aus Altes Testament
	&verse ('1', $inputline);

        &readline;			# Verse aus Neues Testament
	&verse ('2', $inputline);

	&drittetext;
	
	if($if_besontail) {
	    if($main::opt_s) {
# err "ERR16: swap OK";
		print $besontail;
		$besontail = '';
	    }
	    $if_besontail = 0;
	}
	else {
	    &readline;
	    if (/^(.*) :: (.*)$/) {		# Lesen  1> :: 2>
		$l1 = &oprav($1);			
		print "1-> $l1\n";
		$l2 = &oprav($2);
		print "2-> $l2\n";
	    }
	    else { err ("ERR17: Wochentag Lesen"); }
	}
    }
    else {				# Sonntag
        print "\n\+> $_";

        &readline;			# Losung aus Altes Testament
	&verse ('1', $inputline);

        &readline;			# Verse aus Neues Testament
	&verse ('2', $inputline);

	&drittetext;

	if($if_besontail) {
	    if($main::opt_s) {
# err "ERR18: swap OK";
		print $besontail;
		$besontail = '';
	    }
	    $if_besontail = 0;
	}
	else { err "ERR19: \$if_besontail fählt!"; }
    }
    return 1;
}

@pozn = (
'1. März 1457',
'3. Mai 1728',
'17. Juni 1722',
'6. Juli 1415',
'13. August 1727',
'21. August 1732',
'16. September 1741',
'13. November 1741'
);
Citováno z „https://cs.wikiversity.org/w/index.php?title=Projekt:_Hesla_Jednoty_bratrské/2010/los10pre.pl&oldid=114379“