htmlize.pl
SUBROUTINES
- convert_tags
use File::Basename;
use strict;
my ($file, $title, $base_name, $html_file, $out, $i, @subs);
my $DEBUG = 0;
$file = $ARGV[0];
$title = basename($file);
if(! $ARGV[0])
{
print "\nUSAGE : htmlize.pl <filename.ext>\n";
print "Output: filename_ext.html (Ex: Module.pm will become Module_pm.html)\n\n";
exit 0;
}
if(!(-e $file))
{
print "File $file not found.\n";
exit 0;
}
$file = convert_tags($file);
$file =~ /(.*)\.tagtemp/o;
$base_name = $1;
$base_name =~ s#\.#\_#go;
$html_file = $base_name . ".html";
system("mv $file $html_file");
open(HTML_FILE, "+< $html_file") or die "Can't open file $html_file: $!\n";
$out = "";
$i=0;
print "\nDetermining method names...\n";
while(<HTML_FILE>)
{
my ($sub_name, $anchor, $link_to_top, $leftover);
my $rest = "";
if (/^sub\s+(.*)$/o)
{
$sub_name = $1;
if ($sub_name =~ /\{/)
{
$sub_name =~ s/(\{.*)$//;
$rest = $1;
}
$sub_name =~ s/\s+//go;
$subs[$i++] = $sub_name;
$anchor = "<a name=\"$sub_name\"></a>\n";
$link_to_top = "<a href=\"\#Top\" title=\"Go to top of page\">Top Of Page</a>\n";
$leftover = "sub $sub_name" . $rest . "\n";
$_ = $anchor . $link_to_top . $leftover;
}
$out .= $_;
}
print "Finished.\n";
print "Updating file with links to top of page...\n";
seek(HTML_FILE, 0, 0);
print HTML_FILE $out;
close(HTML_FILE);
print "Finished.\n";
print "Creating list of method names...\n";
$out = "";
$out = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11-transitional.dtd\">\n";
$out .= "<html>\n<head>\n<title>$title</title>\n";
$out .= "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=ISO-8859-1\" />\n";
$out .= "<style type=\"text/css\">\n";
$out .= "<!--\n";
$out .= "body {background-color:
".comment {color:
"a:link {text-decoration: none; color: blue;}\n" .
"a:visited {text-decoration: none; color: blue;}\n" .
"a:active {text-decoration: underline; color: blue;}\n" .
"a:hover {text-decoration: underline; color: black;}\n";
$out .= "-->\n";
$out .= "</style>\n";
$out .= "</head>\n";
$out .= "<body>\n";
$out .= "<a name=\"Top\"></a>\n";
$out .= "<center><h1>$title</h1></center>\n";
if(@subs)
{
$out .= "<hr />\n";
$out .= "<center><h3><span style=\"font-family: verdana;\">SUBROUTINES</span></h3></center>\n";
$out .= "<ol>\n";
foreach my $sub(@subs)
{
$out .= "<li><a href=\"\#$sub\" title=\"sub $sub\">$sub</a></li>\n";
}
$out .= "</ol><br />\n";
}
$out .= "<hr /><pre>\n";
print "Finished.\n";
print "Linking method names and updating file (may take a while)...\n";
open(HTML_FILE, "+< $html_file") or die "Can't open file $html_file: $!\n";
while(<HTML_FILE>)
{
my ($line, $sub_name, $link);
$line = $_;
if($line =~ /
and $line !~ /\\#/o
and $line !~ /\$\#/o # syntax for last array index, i.e. $#array
and $line !~ /a\s+href\s*=.*?#/o # on-page link, i.e. <a href="#download">
and $line !~ /(!|=)~\s*s\s*
{
$line =~ s/^(.*?)(
}
my $stime = time();
foreach my $sub_name (@subs)
{
next if $line =~ /^sub|\<a name\=.*$sub_name.*/i;
next if ($line =~ /\$$sub_name/);
next if ($line =~ /\$\$$sub_name/);
next if ($line =~ /\@$sub_name/);
next if ($line =~ /\%$sub_name/);
next if ($line =~ /
next if ($line =~ /SUPER::$sub_name/);
next if ($line =~ /^use\s+$sub_name/);
next if ($line =~ /^require\s+$sub_name/);
next if ($line =~ /^package\s+$sub_name/);
next if ($line =~ /$sub_name[A-Za-z0-9_]/);
next if ($line =~ /[A-Za-z0-9_]$sub_name/);
next if ($line =~ /\'|\"$sub_name\'|\"/);
if ( $line =~ /(^$sub_name\W|\W$sub_name\W)/g )
{
$link = "<a href=\"\#$sub_name\" title=\"sub $sub_name\">$sub_name</a>";
$line =~ s/$sub_name/$link/g;
# $line =~ s/([^\$]|\#|\&|^)$sub_name/$link/g;
}
}
my $etime = time();
$out .= $line;
my $time_per_line = $etime - $stime;
print "Time taken per line: $time_per_line secs.\n" if $DEBUG;
}
$out .= "-----------\n";
$out .= "<a href=\"\#Top\" title=\"Go to top of page\">Top Of Page</a>\n";
$out .= "-----------\n";
$out .= "</pre></body></html>\n";
print "Updating.\n";
seek(HTML_FILE, 0, 0);
print HTML_FILE $out;
close(HTML_FILE);
print "Done.\n\n";
Top Of Page
sub convert_tags
{
my($file) = @_;
my ($root, $tmp_file, $out);
$root = basename($file);
$tmp_file = $root.".tagtemp";
system("cp $file $tmp_file");
open(TMP_FILE, "+< $tmp_file") or die "Can't open file $tmp_file: $!\n";
$out = "";
while(<TMP_FILE>)
{
if(/\</o)
{
$_ =~ s/\</\<\;/go;
}
if(/\>/o)
{
$_ =~ s/\>/\>\;/go;
}
if(/\"/o)
{
$_ =~ s/\"/\"\;/go;
}
if(/\&/o)
{
if($_ !~ /\<\;|\>\;|\"\;/) {
$_ =~ s/\&/\&\;/go;
}
}
$out .= $_;
}
seek(TMP_FILE, 0, 0);
print TMP_FILE $out;
close(TMP_FILE);
return($tmp_file);
}
-----------
Top Of Page
-----------