#!/usr/bin/perl

# hes02xml.pl   Transformuje hesla JB na rok 2002 z .pre do Steebova .xml
#		Petr Heřman

$vermajor = '1';
$verminor = '05';
$ver = $vermajor.'.'.$verminor;
		        # V nedelnim <SR> je jeden <SL>; opraveno <C> a sublang
			# Hesla pro <DAY type=sunday,holiday>, zalomí řádky
			# Hesla pro <MONTH>, <WEEK>
$rok = '02';
$WIDTH = 65;            # sirka textoveho sloupce
$DEPTH = 30;            # hloubka zprava kam se hleda zalomeni radky


$Rok = '20'.$rok;

#	Tagy na zacatku radek:
#
#  #	Komentář
#  m>	Heslo měsíce
#  @>	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)
#  ~>   Doslova opsat
#  ?>	Dale neurceny (podivny?) radek
#  {	Zacatek pisne
#  }	Konec pisne
#	Kombinace (napr.):
#  1->	Prvni cteni s odkazem do SZ
#  1=>	Prvni cteni s odkazem do NZ
#  2->	Druhe cteni s odkazem do SZ
#  2=>	Druhe cteni s odkazem do NZ
#  3->	Treti cteni s odkazem do SZ
#  3=>	Treti cteni s odkazem do NZ


## $bk = '../bk';		### Adresar s bibli kralickou
## $path = 'cz/jb/hesla/';

@mesic_up = ('LEDEN', 'ÚNOR', 'BŘEZEN', 'DUBEN', 'KVĚTEN', 'ČERVEN',
	'ČERVENEC', 'SRPEN', 'ZÁŘÍ', 'ŘÍJEN', 'LISTOPAD', 'PROSINEC');
@mesic_lo = ('leden', 'únor', 'březen', 'duben', 'květen', 'červen',
	'červenec', 'srpen', 'září', 'říjen', 'listopad', 'prosinec');
@m_day=(31,28,31,30,31,30,31,31,30,31,30,31);


$hdr1 = <<'KONEC';
<?xml version='1.0' encoding='ISO-8859-2' standalone='no' ?>
<!DOCTYPE LOSFILE SYSTEM 'losfile.dtd' [ ]>
<LOSFILE dtdmainvers='1' dtdsubvers='2' xml:lang='cs' year='2002'>

<HEAD>
<FILEVERS>
KONEC

($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)=localtime(time);
$year+=1900;
$mon++;

$hdr2 = "$ver\n$year-$mon-$mday $hour:$min\n";

$hdr3 = <<'KONEC';
Petr Heřman mailto:hesla@dulos.cz
</FILEVERS>
<XLAT>
bez ozn. - Bible, Písmo svaté Starého a Nového zákona, Ekumenický překlad,
     2.vydání ERC, Praha 1984 (se svolením ČBS)
K - "Bible kralická" - poslední vydání z roku 1613
Písně:
bez ozn. - Bratrský zpěvník, 4.vydání z r. 1954.
Svítá - křesťanské písně (nejen) pro mládež, Synodní rada
        Českobratrské církve evang. ve vyd. Kalich, Praha 1992.
</XLAT>
<SUBLANG subcode="CS01">
  <TLPATTERN>Heslo na [DOW], [D]. [MONTH] [YYYY]</TLPATTERN>
  <MONTHS jan="ledna" feb="února" mar="března" apr="dubna" may="května"
  jun="června" jul="července" aug="srpna" sep="září" oct="října"
  nov="listopadu" dec="prosince"/>
  <DOW sun="neděli" mon="pondělí" tue="úterý" wed="středu"
       thu="čtvrtek" fri="pátek" sat="sobotu"/>
</SUBLANG>
</HEAD>

KONEC

# V minulé versi 1.02. byly tyto entity jako komentáře. Nyní to jsou elementy
#<!-- There are some entities not found in the Steeb's losfile.dtd
#     I hope it will be done in the future version.
#     Temporaly, these entities are included in this XML file as comments:
#<MONTH>	LM:	Losung for the Month
#<DAY>
#type='sunday'
#name	SY:	name of the Sunday of the church Year
#meaning MS:	Meaning of the Sunday name (for example: Oculi, Judica etc.)
#<L>	LW:	Losung for the Week
#type='holiday'
#	HD:	HoliDay
#<L>	LH:	Losung for the Holiday
#<SL>	S:	Source
#type='important'
#	IM:	IMportant day or week
#-->

$hdr = $hdr1.$hdr2.$hdr3;

######################################################

open(KNITAB, "hes${rok}kni.tab") || die
  "Nemuzu otevrit seznam knih 'hes${rok}kni.tab'";
while(<KNITAB>)
  {
    chop;
    s/\x09/ /g;            # Tabelatory pryc
    s/ +/ /g;
    ($exist, $zkr, $dlouhy, $angl) = split(/ /);
    $zkr =~
    tr/ÁÉĚÍÓÚŮÝŽŠČŘĎŤŇáéěíóúůýžščřďťň/AEEIOUUYZSCRDTNaeeiouuyzscrdtn/;
    $zkr =~ tr/A-Z/a-z/;
    $Angl{$zkr} = $angl;
#   print STDERR $zkr, ' = ', $angl, "\n"; 
  }
close KNITAB;

$outfile = 'cs_los'.$rok.'.'.$verminor.'.xml';
open(STDOUT, ">$outfile") || do
  { print STDERR "Nemuzu presmerovat STDOUT do $outfile: $!\n"; next; };

print "$hdr\n";

foreach $filename (@ARGV)
{
open(INFILE, $filename) || do
{ print STDERR "Nemuzu otevrit soubor $filename: $!\n"; next; };

if($filename=~/hes$rok(\d\d)\.pre/ && $1<=12)	# nazev souboru
  {
    $nn_mes = $1;
    $n_mes = sprintf("%d", $nn_mes);
  }
else   
  {
    print STDERR "Soubor \'$filename\' preskocen - nema tvar /hes$rok[01..12].pre/\n";
    next;
  }

print STDERR "\tMakam na souboru $filename --> $outfile\n";

$tento_mesic=$mesic_up[$n_mes-1];

#<INFILE>;       ## heslo mesice (preskoc)
#<INFILE>;       ## odkaz na heslo mesice (preskoc)

$den=1;
$cteni=0;
$cteni1='';
$cteni2='';
$cteni3='';
$otnt='';

while (<INFILE>)            	##### pro kazdy radek ######
  {
    if(/^\#/) {next;}           	### Komentář
    
    if (/^(\d)([-=]> .*)/) 		### odkaz na čtení
      {
	if($1==1)
	  {
	    $cteni=1;
	    $cteni1 = &odkaz($2);
	  }
	elsif($1==2)
	  {
	    $cteni=2;
	    $cteni2 = &odkaz($2);
	  }
	elsif($1==3)
	  {
	    $cteni=3;
	    $cteni3 = &odkaz($2);
	  }
	else
	  {
	    $cteni=0;
	  }
	next;
      }

    elsif ($cteni)	# konec cteni
      {
	if($cteni==2) {print
	   " <SR> <SL>$cteni1</SL> </SR>\n".
	   " <CR> <SL>$cteni2</SL> </CR>\n";}

	elsif($cteni==3) {print
#	   " <SR> <SL>$cteni1</SL> <SL>$cteni2</SL> </SR>\n".	# dva <SL>
	   " <SR> <SL>$cteni1 :: $cteni2</SL> </SR>\n".		# jedno <SL>
	   " <CR> <SL>$cteni3</SL> </CR>\n";}

        $cteni=0;
        $cteni1='';
        $cteni2='';
        $cteni3='';
      }

    if(/^\s*$/)         ## prazdny radek
      {
	if ($losung_flag)
	{ print "</LOSUNG>\n\n"; $losung_flag = 0;}
        next;
      }
	
    if(/^@>(\w+)> (.*)/)		### NEDELNI TYDEN ###
      {
##      print "\n\\week{$}\n\n";
##	$center = 1;			# Centruje cely dalsi odstavec
	$_ = $2;
        s/---/-/;
        s/<<//g; s/>>//g; s/\\"/"/g;
	s/--/-/g;
        $nesv=0;			# Je to neděle
	$sunday++;
#        print "<!-- SY s='$sunday': $_ -->\n";
        print "<DAY d='$den' m='$n_mes' type='sunday' name='$_'";
	$_ = <INFILE>;
        if ((/^o> (.*)/)||(/^%> (.*)/))	### VYZNAM TYDNE NEBO SVATKU či význ.den
          {
	   $_ = $1;
##	   &nbsp;
	   $meaning = $_;
	   $konec_vyznamu = 2;
	   s/--/-/g;
#          print "<!-- MS: $_ -->\n";
	   print " meaning='$_";
	   $_ = <INFILE>;
           if (/^[-=]> (.*)/) 		### odkaz na vers
	      {
	        $_ = $1;
	        /(.*) >.*/;
		print " $1";
		$_ = <INFILE>;
	      }
	    print "'";
           }
	 print " ord='$sunday'>\n";
       if (/^0> (.*)/)			### HESLO TYDNE NEBO SVATKU
         {
	    $_ = $1;
##	    &nbsp;
	    s/--/-/g;
	    &zalom;
	    $verse_buf = $_;
         }
       else
         { print STDERR "u $sunday.  nedele  chybi heslo"; die;}
	$_ = <INFILE>;
       if (/^[-=]> .*/) 		### odkaz na predchazejici vers
	{ &opv;}
       else {print STDERR "chybi odkaz na predch. vers"; die;}
       print "</DAY>\n\n";    
      }

    elsif(/^\$>(\w+)> (.*)/)		### SVATEK ###
      {
##      print "\n\\feast{$_}\n\n";
##	$svatek = 1;			# Nasledujici se uz neoddeli <HR>
	$_ = $2;
        s/---/-/;
        s/<<//g; s/>>//g; s/\\"/"/g;
	s/--/-/g;
        $nesv=1;			# Je to svátek
#        print "<!-- HD: $_ -->\n";
        print "<DAY d='$den' m='$n_mes' type='holiday' name='$_'";
	$_ = <INFILE>;
        if ((/^o> (.*)/)||(/^%> (.*)/))	### VYZNAM TYDNE NEBO SVATKU či význ.den
          {
	   $_ = $1;
##	   &nbsp;
	   $meaning = $_;
	   $konec_vyznamu = 2;
	   s/--/-/g;
#          print "<!-- MS: $_ -->\n";
	   print " meaning='$_";
	   $_ = <INFILE>;
           if (/^[-=]> (.*)/) 		### odkaz na vers
	      {
	        $_ = $1;
	        /(.*) >.*/;
		print " $1";
		$_ = <INFILE>;
	      }
	    print "'";
           }
	 print ">\n";
       if (/^0> (.*)/)			### HESLO TYDNE NEBO SVATKU
         {
	    $_ = $1;
##	    &nbsp;
	    s/--/-/g;
	    &zalom;
	    $verse_buf = $_;
	    $_ = <INFILE>;
         }
       else
         { print STDERR "$den.$n_mes - u svatku chybi heslo\n";}
       if (/^[-=]> .*/) 		### odkaz na predchazejici vers
	{ &opv;}
       else {print STDERR "$den.$n_mes - u svatku chybi odkaz na predch. vers\n";}
       print "</DAY>\n\n";    
      }
     				
    elsif(/^%> (.*)/)			### VYZNAMNY DEN nebo TYDEN ###
      {
      	$_ = $1;
##        print "\n\\important{$_}\n";
	s/--/-/g;
#        print "<!-- IM: $_ -->\n\n";
        print "<DAY d='$den' m='$n_mes' type='important' name='$_'/>\n";
	print "<!-- It's not only one day but the whole next WEEK -->\n\n";
	$svatek = 1;			# Nasledujici se uz neoddeli <HR>
      }

    elsif (/^o> (.*)/)			### VYZNAM TYDNE NEBO SVATKU
      {
	$_ = $1;
##	&nbsp;
	$meaning = $_;
	$konec_vyznamu = 2;
	s/--/-/g;
#        print "<!-- MS: $_ -->\n";
	$day_meaning = $_;
      }

#    elsif (/^0> (.*)/)			### HESLO TYDNE NEBO SVATKU
#      {
#	&konec_vyznamu;
#	$_ = $1;
##	&nbsp;
##	print "\\weekww{$_}\n";
#	s/--/-/g;
#	if($nesv)
#           { print "<!-- LH: $_ -->\n";}
#	else
#           { print "<!-- LW: $_ -->\n";}
#      }

   elsif(/^\+> ((\d{1,2})\. (.*))/)	### NEDELE  ###
      {
	if ($losung_flag)
	  {print STDERR "neuzavreny LOSUNG: d='$den' m='$n_mes'>\n";}
        else {$losung_flag = 1;}

	if($den != $2)
	    { print STDERR "\n!! pocitany den=$den != $2 = oznaceny den\n"; $den=$2;}
##	print "\n\\sunday{$1}\n";
	print "<LOSUNG d='$den' m='$n_mes'>\n";
	print " <TL>$3 $2. $n_mes. $Rok</TL>\n";
	$den++;
	# print "\n[$den]";
      }
	       			
   elsif(/^x> ((\d{1,2})\. (.*))/)	### VSEDNI DEN ###
      {
	if ($losung_flag)
	  {print STDERR "neuzavreny LOSUNG: d='$den' m='$n_mes'>\n";}
        else {$losung_flag = 1;}

	if($den != $2)
	    { print STDERR "\n!! pocitany den=$den != $2 = oznaceny den\n"; $den=$2;}
       	if ($svatek) { $svatek=0; }

##	print "\n\\wrkday{$1}\n";
	print "<LOSUNG d='$den' m='$n_mes'>\n";
	print " <TL>$3 $2. $n_mes. $Rok</TL>\n";
	$den++;
	## print "\n[$den]";
      }

    elsif (/^1> (.*)/)			### SZ HESLO
      {
	$_ = $1;
##	&nbsp;
##	&quotes;
##	print "\\otverse{$_}\n";
	&zalom;
	$verse_buf = $_;
	$otnt = "OT";
	print " <$otnt>";
      }

    elsif (/^2> (.*)/)			### NZ VERS
      {
	$_ = $1;
##	&nbsp;
##	&quotes;
##	s/ \-\-\-/~---/;
##        print "\n";		# paragraph
##	print "\\ntverse{$_}\n";              # odradkovat predem
	&zalom;
	$verse_buf = $_;
	$otnt = "NT";
	print " <$otnt>";
      }

    elsif (/^[-=]> .*/) 		### odkaz na predchazejici vers
      {
##	if($konec_vyznamu) {$ref=&odkaz($&);}
##	else { print "\\ref{";
##	print &odkaz($&);
##	print "}\n";
##	   }
##	&konec_vyznamu;
	$ref=&odkaz($&);
  	if ($otnt)
          {
	    print "<S b='$book' ch='$chapter' v='$verse_no'/>\n";
	    print "$verse_buf\n";
	    print "  <SL>$ref</SL>\n".
	      " </$otnt>\n";
    	  }
	else
          {
              $_ = $ref;
              s/--/-/g;
              print "<!-- S b='$book' ch='$chapter' v='$verse_no' -->\n";
              print "<!-- SL: $_ -->\n\n";
          }
	$verse_buf = '';
	$otnt = '';
	$ref = '';
	$book = '';
	$chapter = '';
	$verse_no = '';
      }

    elsif (/^{/)			### Pisen
      {
	$pisen=1;
#	print "\n\\song{";
	print " <TT>\n";
      }

    elsif (/^}\s*(.*)/)			### Konec pisne
      {
	$pisen=0;
##	if ($1 eq '0,0') {print '!!';}	# Zapomenuto v .PRE
	$_ = $1;
##	&dash;
##	print "}{$_}\n\n";
	print "</L>\n  <SL>$_</SL>\n </TT>\n";
      }

    elsif ($pisen)			### Prubeh pisne
      {
        s/ *$//;		# prebyvaji mezery na konci radku
 chop;
##	if($pisen++ > 1) { print "\\\\\n";}
	if($pisen++ > 1) { print "</L>\n";}
	print "  <L>$_";
      }

    elsif (/^%> (.*)/)	 		### vyznamny den, tyden
      {
##        print "\n\\important{$1}\n";
#	print "\n\\anniversary{$1}\n\n";
	print " <C>\n  <L>$1</L>\n </C>\n";
      }

    elsif (/^_> (.*)/)	 		### vyroci
      {
##	print "\n\\anniversary{$1}\n\n";
#        print "\n\\important{$1}\n";
	print " <C>\n  <L>$1</L>\n </C>\n";
      }

    elsif (/^~> (.*)/)	 		### doslova tak, jak je
      {
	print " <C>\n  <L>$1</L>\n </C>\n";
      }

    elsif(/^m> (.*)/)                      ### HESLO MĚSÍCE ###
      {
	$_ = $1;
	s/--/-/g;
	s/<<//g; s/>>//g; s/\\"/"/g;
#        print "<!-- LM m='$n_mes': $_ -->\n";
	$nesv=3;
	&zalom;
	$verse_buf = $_;
        print "<MONTH m='$n_mes'>\n";
	$_ = <INFILE>;
       if (/^[-=]> .*/) 		### odkaz na predchazejici vers
	{ &opv;}
       else {print STDERR "u $n_mes. měsíce chybi odkaz na predch. vers\n"; die;}
       print "</MONTH>\n\n";    
      }

    elsif (/^?> (.*)/)	 		### nejaky jiny radek
      {
	print STDERR "\n\\textbf{!!! $1 !!!}\n";
      }

    else 				### COKOLIV JINEHO PODIVNEHO
      {
	print STDERR "??<P> $_";
      }
  }

if ($losung_flag)
   { print "</LOSUNG>\n\n"; $losung_flag = 0;}

}

print "</LOSFILE>\n";


######################### Subroutiny: ################################

sub nbsp		### Udela nbsp (non-breakable space) v $_
  {
#   s/ ([AIKOSUVZaikosuvz]) / $1~/g;
  }

sub quotes
  {
   local ($str, $i, $char, $up, $out);
   $str = $_;
   for($i=0;$i<length($str);$i++)
     {
       $char = substr($str, $i, 1);
       if($char eq '"')
          { if($up) {$out .= '\crqq';}
	    else {$out .= '\clqq ';}
	    $up = ++$up%2;
	  }
       else
	  {$out .= $char;}
     }
   $_ = $out;
  }  


sub opv		# Odkaz na předcházející verš
  {
	$ref=&odkaz($&);
          {
	    print "  <S b='$book' ch='$chapter' v='$verse_no'/>\n";
	    print "$verse_buf\n";
	    print "  <SL>$ref</SL>\n";
    	  }
	$verse_buf = '';
	$otnt = '';
	$ref = '';
	$book = '';
	$chapter = '';
	$verse_no = '';
    }

sub odkaz		### tiskne odkaz na predchazejici vers
  {
    local ($_) = @_;
##    local($anchor, $vlast, $zdroj);
    /^([-=])> (.*)/;
    $_ = $2;
	if(/(.*) >(\d?[a-z]{1,3}) (\d+),(\d+)/)
	  {
##            $anchor="$bk/$2$3.htm";
##	    if($4) { $anchor .= "#$4";}
	    $book = $Angl{$2};
	    $chapter = $3;
	    $verse_no = $4;
	    $_ = $1;
##	    s/ /&nbsp;/g;
#	    if( ([A-ZŽ]+)$/) {$vlast=$`; $zdroj=$1;}
#	    else {$vlast=$_; $zdroj='';}
#	    print "<A HREF=\"$anchor\">$vlast</A>$zdroj";
##	    print "<A HREF=\"$anchor\">$vlast</A>";
##	    if ($zdroj) { print "&nbsp;<A HREF=\"hes$rok"."idx.htm#zdr_$zdroj\">$zdroj</A>";}
	  }
	else		# Error
          { print STDERR $den-1; print STDERR ".$n_mes. Odkaz: $_\n"; }
  }

sub konec_vyznamu
{
if ($konec_vyznamu)
    {
     $konec_vyznamu = 0;
##     if($ref) {print "\\meaningvrs{$meaning}{$ref}\n"; $ref='';}
##     else {print "\\meaning{$meaning}\n"}
     $meaning='';
    }
}

sub zalom            # zalomi dlouhy radek v $_
{
  local ($tmp, $tst, $pos, $buf);

  s/\\"/"/g;		# spodní uvozovky se v .pre označují \"

  $buf = '';
  if (/<<(.*)>> (.*)/)
     {
	 $buf = "  <IL>$1</IL>\n";
	 $_ = $2;
     }

  while (length > $WIDTH)            # formatuj odstavec
    {
      $tst = ' '.reverse(substr($_, 0, $WIDTH));
      ($pos = index($tst, ' !')) >= 0 && $pos < $DEPTH ||
      ($pos = index($tst, ' ?')) >= 0 && $pos < $DEPTH ||
      ($pos = index($tst, ' .')) >= 0 && $pos < $DEPTH ||
      ($pos = index($tst, ' ;')) >= 0 && $pos < $DEPTH ||
      ($pos = index($tst, ' ,')) >= 0 && $pos < $DEPTH ||
      ($pos = index($tst, ' )')) >= 0 && $pos < $DEPTH ||
      ($pos = index($tst, ' a ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' i ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' k ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' o ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' s ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' u ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' v ')+2) >= 2 && $pos < 15 ||
      ($pos = index($tst, ' ', 1)) > 0 ||
      ($pos = 0) ;

      $pos = $WIDTH - $pos;

      if ($pos>5)		    # Naslo se misto na deleni
       {
	$tmp = substr($_, 0, $pos);
      	$tmp =~ s/^ +//;            # ukousni prvni mezery
      	$tmp =~ s/ +$//;            # ukousni posledni mezery
      	$buf .= '  <L>' . $tmp . "</L>\n";
      	$_ = substr($_, $pos);
       }
      else		    # jinak uz nedel
       {
	last;
       }
    }
  s/^ +//;                  # ukousni prvni mezery
  s/ +$//;                  # ukousni posledni mezery
  if (length > 1)            # vic nez "\n"
    {
     $buf .= "  <L>" . $_ . "</L>";
    }
  $_ = $buf;
}



