#!/usr/bin/perl
#
#  AUTOCONVERT
#
## (C) Internet servis a.s. jirka Gallas, 03/1998
#  placed into public domain 
#
# Tento program cte data z $gfrom a na miste je prepisuje.
# Prepsane soubory znackuje komentarem $conv, takze pri
# je priste uz konvertovat nebude (to se ta vyuzit tehdy,
# kdyz do adresare prihrajeme nove soubory). Kovertuji se
# pouze soubory s priponou .html a .htm
#
# Konfigurace: 
#	$gfrom  ..... 	urcuje adresar, od ktereho se zacne. 
#		   	Vsechny podadresare budou rovnez zpracovany.
#	$report ..... 	Soubor, do ktereho se uklada log.
#	$conv   ..... 	Znacka, kterou program vklada na zacatek konvertovanych
#		   	souboru.
#	$coding .....	nastaveni prekodovani cestiny. Sklada se ze dvou
#			pismen, prvni rika z jakeho kodu, druhe do jakeho
#			kodu. Vyznam pismen je takovyto:
#				w = CP1250
#				l = CP852
#				m = Macintosh
#				k = kod Kamenickych
#				a = ASCII
# 
# Program je pran v jazyce PERL 4, jeho implementace kamkoliv by nemel
# byt zadny problem. 

#================================================================
#		KONFIGURACE
#================================================================
$gfrom	=	"/usr/public/htdocs";			# odkud bere data
$report =	"/usr/public/report.txt";		# report file
$conv   =       "<!-- CONVERTED TO CP1250 -->";		# znacka koverze
$coding = 	"wa";					# prekodovani cestiny

#================================================================
#		MAIN
#================================================================
open(REP,">$report");
&proceed_directory($gfrom);
close(REP);

#================================================================
#		PODPROGRAMY
#================================================================
sub proceed_directory
{ local($dir)=@_;
  local(@files);
  local($file,$thisfile,$outdir);
  print REP "directory $dir\n";
  $outdir = $dir;
  $outdir =~ s/$gfrom/$gto/;
  if (!(opendir(DIR,"$dir")))
  { print REP "Cannot open directory $dir: $!\n";
    return;
  }
  @files  = readdir(DIR);
  closedir(DIR);
  foreach $file (@files)
  { next if ($file =~ /^\./);
    $thisfile = "$dir/$file";
    next if (-l $thisfile);
    if (-d $thisfile)
    { &proceed_directory($thisfile);
    } else
    { next if ($file !~ /\.html{0,1}$/);
      &proceed_file($file,$dir);
    }
  }
}
#----------------------------------------------------------------
sub proceed_file
{ local($fil,$dir)=@_;
  local($file)="$dir/$fil";
  local($lin,$klin,$key,$cdir,$code,$rut);
  local(@ff);
  if (!(open(IN,"<$file")))
  { print REP "Cannot open file $file: $!\n";
    return;
  }
  $n=0;
  while(<IN>)
  { if ($n == 0)
    { return if ($_ =~ /^$conv/);
      push(@ff,"$conv\n");
    }
    $n++;
    #-----------------------------------------------------------
    $code=&$coding($_);	# nebo natvrdo zvolit rutimu
    #-----------------------------------------------------------
    $code = &ejacout($code);	# zbav se nesmyslu
    $code =~ s#\r#\n#g;
    push(@ff,$code);
  }
  close(IN);  
  print REP "file $file\n";
  if (open(OUT,">$file"))
  { foreach $lin (@ff)
    { print OUT "$lin";
    }
    print OUT "\n\n";
    close(OUT);
  } else
  { print REP "Cannot write to file $file: $!\n";
  }
}
#================================================================
#		PRYC S NESMYSLY
#================================================================
sub ejacout
{ local($i)=@_;
  $i =~ s/&aacute;/á/g; # a s carkou
  $i =~ s/&egrave;/è/g; # c s hackem
  $i =~ s/&iuml;/ï/g;   # d s hackem
  $i =~ s/&eacute;/é/g; # e s carkou
  $i =~ s/&igrave;/ì/g; # e s hackem
  $i =~ s/&iacute;/í/g; # i s carkou
  $i =~ s/&ograve;/ò/g; # n s hackem
  $i =~ s/&oacute;/ó/g; # o s carkou
  $i =~ s/&oslash;/ø/g; # r s hackem
  $i =~ s/&uacute;/ú/g; # u s carkou
  $i =~ s/&ugrave;/ù/g; # u s krouzkem
  $i =~ s/&yacute;/ý/g; # y s carkou
  $i =~ s/&Aacute;/Á/g; # A s carkou
  $i =~ s/&Egrave;/È/g; # C s hackem
  $i =~ s/&Iuml;/Ï/g;   # D s hackem
  $i =~ s/&Eacute;/É/g; # E s carkou
  $i =~ s/&Igrave;/Ì/g; # E s hackem
  $i =~ s/&Iacute;/Í/g; # I s carkou
  $i =~ s/&Ograve;/Ò/g; # N s hackem
  $i =~ s/&Oacute;/Ó/g; # O s carkou
  $i =~ s/&Oslash;/Ø/g; # R s hackem
  $i =~ s/&Uacute;/Ú/g; # U s carkou
  $i =~ s/&Uacute;/Ù/g; # U s krouzkem
  $i =~ s/&Yacute;/Ý/g; # Y s carkou
  $i =~ s/&quot;/"/g;   # uvozovky nahore

  $i =~ s/&#(\d\d\d);/pack("c",$1)/ge;

  return($i);
}
#================================================================
#		PREVODY KODU
#================================================================
sub ww {
  local($a) = @_;
  return($a);
}
#---------------------
sub wa {
  local ( $a) = @_; 
  $a =~ tr/\x8a\x8d\x8e\x9a\x9d\x9e\xc1\xc8\xc9\xcc\xcd\xcf\xd2\xd3\xd8\xd9\xda\xdd\xe1\xe8\xe9\xec\xed\xef\xf2\xf3\xf8\xf9\xfa\xfd/\x53\x54\x5a\x73\x74\x7a\x41\x43\x45\x45\x49\x44\x4e\x4f\x52\x55\x55\x59\x61\x63\x65\x65\x69\x64\x6e\x6f\x72\x75\x75\x79/;
  return($a);
}
sub aw {
  local ( $a) = @_; 
  return($a);
}
#---------------------
sub wl {
  local ( $a) = @_; 
  $a =~ tr/\x2b\x2d\x7c\x8a\x8d\x8e\x9a\x9d\x9e\xc1\xc8\xc9\xcc\xcd\xcf\xd2\xd3\xd8\xd9\xda\xdd\xe1\xe8\xe9\xec\xed\xef\xf2\xf3\xf8\xf9\xfa\xfd/\xc5\xc4\xb3\xe6\x9b\xa6\xe7\x9c\xa7\xb5\xac\x90\xb7\xd6\xd2\xd5\xe0\xfc\xde\xe9\xed\xa0\x9f\x82\xd8\xa1\xd4\xe5\xa2\xfd\x85\xa3\xec/;
  return($a);
}
sub lw {
  local ( $a) = @_; 
  $a =~ tr/\x82\x85\x90\x9b\x9c\x9f\xa0\xa1\xa2\xa3\xa6\xa7\xac\xb3\xb4\xb5\xb7\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xd2\xd4\xd5\xd6\xd8\xd9\xda\xde\xe0\xe5\xe6\xe7\xe9\xec\xed\xfc\xfd/\xe9\xf9\xc9\x8d\x9d\xe8\xe1\xed\xf3\xfa\x8e\x9e\xc8\x7c\x2b\xc1\xcc\x2b\x2b\x2b\x2b\x2b\x2d\x2b\xcf\xef\xd2\xcd\xec\x2b\x2b\xd9\xd3\xf2\x8a\x9a\xda\xfd\xdd\xd8\xf8/;
  return($a);
}
#-------------------
sub wi {
  local ( $a) = @_; 
  $a =~ tr/\x8a\x8d\x8e\x9a\x9d\x9e/\xa9\xab\xae\xb9\xbb\xbe/;
  return($a);
}
sub ik {
  local ( $a) = @_; 
  $a =~ tr/\xa9\xab\xae\xb9\xbb\xbe\xc1\xc8\xc9\xcc\xcd\xcf\xd2\xd3\xd8\xd9\xda\xdd\xe1\xe8\xe9\xec\xed\xef\xf2\xf3\xf8\xf9\xfa\xfd/\x9b\x86\x92\xa8\x9f\x91\x8f\x80\x90\x89\x8b\x85\xa5\x95\x9e\xa6\x97\x9d\xa0\x87\x82\x88\xa1\x83\xa4\xa2\xa9\x96\xa3\x98/;
  return($a);
}
sub iw
{ local($a)=@_;
  local($b);
  $b=&ik($a);
  $a=&kw($b);
  return($a);
}
#--------------------
sub wm {
  local ( $a) = @_; 
  $a =~ tr/\x8a\x8d\x8e\x9a\x9d\x9e\xc1\xc8\xc9\xcc\xcd\xcf\xd2\xd3\xd8\xd9\xda\xdd\xe1\xe8\xe9\xec\xed\xef\xf2\xf3\xf8\xf9\xfa\xfd/\xe1\xe8\xeb\xe4\xe9\xec\xe7\x89\x83\x9d\xea\x91\xc5\xee\xdb\xf1\xf2\xf8\x87\x8b\x8e\x9e\x92\x93\xcb\x97\xde\xf3\x9c\xf9/;
  return($a);
}
sub mk {
  local ( $a) = @_; 
  $a =~ tr/\x83\x87\x89\x8b\x8e\x91\x92\x93\x97\x9c\x9d\x9e\xc5\xcb\xdb\xde\xe1\xe4\xe7\xe8\xe9\xea\xeb\xec\xee\xf1\xf2\xf3\xf8\xf9/\x90\xa0\x80\x87\x82\x85\xa1\x83\xa2\xa3\x89\x88\xa5\xa4\x9e\xa9\x9b\xa8\x8f\x86\x9f\x8b\x92\x91\x95\xa6\x97\x96\x9d\x98/;
  return($a);
}
sub mw
{ local($a)=@_;
  local($b);
  $b=&mk($a);
  $a=&kw($b);
  return($a);
}
#---------------------
sub wk 
{ local ( $a) = @_; 
  $a =~ tr/\x8a\x8d\x8e\x9a\x9d\x9e\xc1\xc8\xc9\xcc\xcd\xcf\xd2\xd3\xd8\xd9\xda\xdd\xe1\xe8\xe9\xec\xed\xef\xf2\xf3\xf8\xf9\xfa\xfd/\x9b\x86\x92\xa8\x9f\x91\x8f\x80\x90\x89\x8b\x85\xa5\x95\x9e\xa6\x97\x9d\xa0\x87\x82\x88\xa1\x83\xa4\xa2\xa9\x96\xa3\x98/;
  return($a);
}
sub kw {
  local ( $a) = @_; 
  $a =~ tr/\x80\x82\x83\x85\x86\x87\x88\x89\x8b\x8f\x90\x91\x92\x95\x96\x97\x98\x9b\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa8\xa9/\xc8\xe9\xef\xcf\x8d\xe8\xec\xcc\xcd\xc1\xc9\x9e\x8e\xd3\xf9\xda\xfd\x8a\xdd\xd8\x9d\xe1\xed\xf3\xfa\xf2\xd2\xd9\x9a\xf8/;
  return($a);
}

ÿ