You are here iC Home > Perl > Perl for Sysad's > HTML-ify

Perl

6.4 HTML-ify

19.11.2008
6.3 Perl Socket Server [  up  ] - [ a - z ] - [ search PC ] - [ top ] 6.4.1 Automate HTML-ify

6.1   telnet
6.2   whois Interface
6.3   Perl Socket Server
6.4   HTML-ify
 6.4.1  Automate HTML-ify
6.5   sslcsr.pl
6.6   getpid Process id
6.7   LDAP
6.8   Delete old files (cleanup.pl)
6.9   Delete accident files
6.10   wikisync.pl

[ Download ] - [ See a test output: t.pl ]
#!/usr/bin/perl -w

# htmlify.pl
#
# Author: Reto Schaer
#
# Documentation:
# http://www.infocopter.com/perl/modules/util-htmlify.html
#
# -- $Id: htmlify.pl,v 1.5 2006/01/20 13:43:06 webcms Exp $

$| = 1;
use strict;
my $VERSION = '0.80.05';

use File::Copy;

#####  PROTOTYPING
sub bleechQuote ($);
sub Error ($);

#####  GLOBAL
my @BLUE_WORDS = qw(my if else unless next sleep use strict scalar localtime while foreach);
my @RED_WORDS  = qw(print mkdir open close exit 0 1);

my $DIEZAHL = '42'; # -- http://www.42.org/42.html
my $IN = $ARGV[0] || '';

my $OUT = "/tmp/zz_trash_out$$\.html";

open(IN , "<$IN" ) or print STDERR $!;
open(OUT, ">$OUT") or print STDERR $!;

my $shebang = <IN>; chomp $shebang;

if ($shebang =~ /^\<!-- htmlify /) {
	close IN;
	close OUT;
	Error "Already html-ified! See source!";
}

$shebang = '<span style="color:green">' . $shebang . "</span>\n";

print OUT '<!-- htmlify --><pre>', $shebang;

my $LC = 1; # line counter (shebang already processed)

while(<IN>) {
	$LC++;
	# -- Safe these first:
	s/\&/\&amp;/g; # -- 1. !
	s/__(.+)$DIEZAHL(.*)__/--$DIEZAHL==$1$DIEZAHL$2==$DIEZAHL--/; # -- 2. !
	s/\</__LT42FOO__/g;
	s/\>/__GT42FOO__/g;
	s/\\\#/__SAFE42HASH__/g;
	s/\\"/__SAFE42QUOTE__/g;

	while (/["']/ && $_ !~ /\#/) {
		# -- Found a quote and no comment on line
		$_ = bleechQuote $_ ;
	}

	# -- Colorize keywords:
	foreach my $bw (@BLUE_WORDS) {
		s/\#/__FIRST42HASH__/;
		my ($left, $right) = split /__FIRST42HASH__/; $right ||= '';
		$left =~ s/\b$bw\b/__COLBLUE42START__$bw\__SPAN42END__/g;
		$_ = $left;
		$_ .= '#' . $right if $right;
	}

	foreach my $rw (@RED_WORDS) {
		s/\#/__FIRST42HASH__/;
		my ($left, $right) = split /__FIRST42HASH__/; $right ||= '';
		$left =~ s/\b$rw\b/__COLRED42START__$rw\__SPAN42END__/g;
		$_ = $left;
		$_ .= '#' . $right if $right;
	}

	if (/\#/) {
		s/\#/__FIRST42HASH__/;
		my ($left, $right) = split /__FIRST42HASH__/;
		while ($left =~ /["']/) {
			$left = (bleechQuote $left);
		}
		$_ = $left . '__FIRST42HASH__' . $right;
	}

	# -- "Green" a comment:
	s/color\:\#/__HTML42COLOR__/gi; # -- Safe these hash chars
	s/\#/__FIRST42HASH__/;
	s/(.*)__FIRST42HASH__(.+)/$1<span style="color:darkgreen">__HASH42FOO__$2\<\/span>/;

	# -- Wrap up:

	s/__COLRED42START__/\<span style="color:red">/g;
	s/__COLBLUE42START__/\<span style="color:blue">/g;
	s/__SPAN42END__/\<\/span>/g;

	s/__QUOT42BEGIN__/\&quot;\<span style="color:#717171">/g;
	s/__QUOT42END__/\<\/span>\&quot;/g;

	s/__SQUOT42BEGIN__/'\<span style="color:#717171">/g;
	s/__SQUOT42END__/\<\/span>'/g;

	s/__HTML42COLOR__/color\:\#/g;
	s/__STYLE42FOO__/ style="/g;
	s/__STYLE42CLOSE__/\">/;
	s/__HASH42FOO__/\#/g;

	s/__FREE42QUOTE__/"/g;
	s/__FREE42SQUOTE__/'/g;
	s/__FIRST42HASH__/\<span style="color\:darkgreen">\#<\/span>/g;

	s/__LT42FOO__/\&lt;/g;
	s/__GT42FOO__/\&gt;/g;

	s/__SAFE42HASH__/\\\#/g;
	s/__SAFE42QUOTE__/\\\&quot;/g;
	s/--$DIEZAHL==/__/g;
	s/==$DIEZAHL--/__/g;

	print OUT $_;
}

print OUT '</pre>';

close IN;
close OUT;

copy $OUT, $IN or print STDERR "$!\n";
unlink $OUT or print STDERR "$!";

print $LC, " lines processed\n";

##########################################
sub bleechQuote ($) {
##########################################
	my $in = $_[0];

	my $quot = '"';

	(my $temp = $in) =~ s/$quot/__QUOT42BEGIN__/;
	if ($temp =~ /$quot/) {
		$temp =~ s/$quot/__QUOT42END__/;
		$in = $temp;
	}
	else {	# Impair quote(s)
		$in =~ s/$quot/__FREE42QUOTE__/;
	}

	# -- Phase 2
	$quot = "'";
	($temp = $in) =~ s/$quot/__SQUOT42BEGIN__/;
	if ($temp =~ /$quot/) {
		$temp =~ s/$quot/__SQUOT42END__/;
		$in = $temp;
	}
	else {	# Impair quote(s)
		$in =~ s/$quot/__FREE42SQUOTE__/;
	}

	$in;
}

sub Error ($) {
	unlink $OUT;
	print "ERROR: $_[0]\n";
	exit;
}

Download

files/htmlify pl.txt


See also:
/perl/modules/util


Advanced search tips
6.3 Perl Socket Server [  up  ] - [ top ] 6.4.1 Automate HTML-ify



[ home ] - [ search ] - [ feedback ]

copyright by reto - created with mytexi