#!/usr/bin/perl
use strict;
# html_fntopt.pl - HTML document font face tags optimizer
#
# Skript sluziaci na upravu fontov v HTML dokumetoch. Prejde vsetky
# subory zodpovedajuce $FILEMASK v danom adresari. V kazdom z nich
# najde vsetky tagy <font ...> a v nich (ak existuje) zmeni polozku
# 'face'. Zmena prebieha podla dvoch poli. V prvom poli su regularne
# vyrazy. Ak regularny vyraz zodpoveda parametru 'face', zmeni ho na
# prislusny parameter z dalsieho pola, v ktorom su zadefinovane nove
# fonty. Po zmene sa uz dalej v prehladavani prvej tabulky nepokracuje.
#
# (c) 2001-2003 Ondrej Jombik <nepto@platon.sk>
#
# $Platon: html-fntopt.pl,v 1.3 2002/02/12 00:34:27 jombik9 Exp $
#
# Updates:
# 07/01/2001 - initial release
# 04/02/2002 - import to CVS
#
# VAROVANIE! Skript nefunguje pod operacnymi systemami MS-DOS,
# MS-Windows 9x, W2k atd... Vlastne funguje len pod Linuxom a aj
# to s istotou len pod mojim (Mandrake 7.0 Air 2.2.14-15mdk). :)
my $BACKUPS = 0; # 1 - Yes, 0 - No
my $BACKUP_EXT = ".fntopt_backup";
my $FILEMASK = "../*.htm";
my @OLDFONT_TBL = (
".*Arial.*",
".*Courier.*",
".*Times.*",
".*"
);
my @NEWFONT_TBL = (
"Helvetica CE, Arial CE, Helvetica, Arial, sans-serif",
"Courier CE, Courier, sans-serif",
"Times New Roman CE, Times CE, Times New Roman, Times, sans-serif",
"sans-serif"
);
#############################################################################
print <<EOM;
html_fntopt.pl v0.99 by Nepto -- neptunko\@pobox.sk -- http://neptun.w3.to
THIS SOFTWARE COMES WITH ABSOLUTELY NO WARRANTY! -- USE AT YOUR OWN RISK!
EOM
my @fnames;
my $fname;
my @lines;
my $line;
my $font_str;
my $i;
my $changes;
@fnames = `echo \`dir --quoting-style=escape -m $FILEMASK \` \\
| tr -d ' ' | tr ',' '\n' `;
foreach $fname (@fnames) {
$fname =~ s/\n//g;
$fname =~ s/\r//g;
print "Processing '$fname'... ";
$_ = `cat $fname`;
if (rename($fname, $fname . $BACKUP_EXT) != 1) {
die("can't rename file '$fname'");
}
if (open(handle, ">>$fname") != 1) {
rename($fname . $BACKUP_EXT, $fname);
die("can't open handle for file '$fname'");
}
$_ =~ s/^(.*\<font[ ]+.*face=\"[^\"]+\".*\>)([^\n]+.*)$/$1\n$2/mgi;
@lines = split("\n");
$changes = 0;
foreach $line (@lines) {
if ($line =~ /^.*\<font[ ]+.*face=\"([^\"]+)\".*\>$/i) {
$font_str = $1;
for ($i = 0; $i <= $#OLDFONT_TBL; $i++) {
if ($font_str =~ /@OLDFONT_TBL[$i]/) {
$line =~ s/^(.*\<font[ ]+.*face=\")[^\"]+(\".*\>)$/$1@NEWFONT_TBL[$i]$2/i;
$changes++;
last;
}
}
}
else {
$line = $line . "\n";
}
print handle $line if ($line ne "");
}
close(handle);
if ($BACKUPS == 0) {
if (unlink($fname . $BACKUP_EXT) != 1) {
die("can't delete file '" . $fname . $BACKUP_EXT . "'");
}
}
print "$changes changes.\n";
}
print $#fnames+1 . " files processed.\n";
Platon Group <platon@platon.sk> http://platon.sk/
|