#!/usr/bin/perl

package p2h;

my $CommentColor;
my $KeywordColor;
my $SpecialColor;
my $ConditionalColors;

my @Keywords = qw(
    -A -B -C -M -O -R -S -T -W -X -b -c -d -e -f -g -k -l -o -p
    -r -s -t -u -w -x -z
    ARGV DATA ENV SIG STDERR STDIN STDOUT
    atan2
    bind binmode bless
    caller chdir chmod chomp chop chown chr chroot close closedir
    cmp connect continue cos crypt
    dbmclose dbmopen defined delete die dump
    endgrent endhostent endnetent endprotoent
    endpwent endservent eof eq eval exec exit exp
    fcntl fileno flock fork format formline
    ge getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname
    gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername
    getpgrp getppid getpriority getprotobyname getprotobynumber
    getprotoent getpwent getpwnam getpwuid getservbyname getservbyport
    getservent getsockname getsockopt glob gmtime goto grep gt
    hex
    import index int ioctl
    join
    keys kill
    last lc lcfirst le length link listen local localtime log lstat lt
    m map mkdir msgctl msgget msgrcv msgsnd my
    ne no
    oct open opendir ord
    pack package pipe pop pos print printf push
    q qq quotemeta qw qx
    rand read readdir readlink recv redo ref rename require reset
    return reverse rewinddir rindex rmdir
    s scalar seek seekdir select semctl semget semop send setgrent
    sethostent setnetent setpgrp setpriority setprotoent setpwent
    setservent setsockopt shift shmctl shmget shmread shmwrite shutdown
    sin sleep socket socketpair sort splice split sprintf sqrt srand
    stat study sub substr symlink syscall sysopen sysread system
    syswrite
    tell telldir tie tied time times tr truncate
    uc ucfirst umask undef unless unlink unpack unshift untie until
    use utime
    values vec wait
    waitpid wantarray warn while write
    y
);

my @Conditionals = qw(
	case
	do
	each else elseif 
	exists
	for foreach
	if
	next
	switch
);


my @Special = qw(
	strict
	Switch
);

my @Escapes = qw(
	\n
	\t
	\"
);

my %Keywords;
@Keywords{@Keywords} = (1) x scalar(@Keywords);

my %Conditionals;
@Conditionals{@Conditionals} = (1) x scalar(@Conditionals);

my %Special;
@Special{@Special} = (1) x scalar(@Special);

my %Escapes;
@Escapes{@Escapes} = (1) x scalar(@Escapes);

$CommentColor = "#008000";
$KeywordColor = "#000080";
$ConditionalColor = "#800080";
$SpecialColor = "#BB0000";
$Escapescolor = "#800000";
$FontComment = "courier";

my($perlcode, $comment);
print "<PRE>\n";
while (<>) {
    ($perlcode, $comment) = split(/^#/, $_, 2);
    if ($perlcode ne '') {
	$perlcode =~ s/(<|&|\b\w+\b|-\w\b)/colorize_keyword($1)/ge;
	$perlcode =~ s/(<|&|\b\w+\b|-\w\b)/colorize_conditionals($1)/ge;
	$perlcode =~ s/(<|&|\b\w+\b|-\w\b)/colorize_special($1)/ge;
	#$perlcode =~ s/(\\n)/colorize_escapes($1)/ge;

	#/\(\)<\@,;:\\``\.\[\]/>
	
	print $perlcode;
    }
    if ($comment ne '') {
	print qq(<FONT );
	print qq(FACE="$FontComment" )  if $FontComment;
	print qq(COLOR="$CommentColor">),
	      '#', $comment,
	      qq(</FONT>);
    }
}
print "</PRE>\n";

sub colorize_keyword {
    my $word = shift;

    if ($word eq '<') {
    	return "&lt;";
    }
    if ($word eq '&') {
    	return "&amp;";
    }
    if ($Keywords{$word}) {
	return qq(<FONT COLOR="$KeywordColor"><B>$word</B></FONT>);
    }
    $word;
}


sub colorize_conditionals {
    my $word = shift;

    if ($Conditionals{$word}) {
	return qq(<FONT COLOR="$ConditionalColor"><B>$word</B></FONT>);
    }
    $word;
}

sub colorize_special {
    my $word = shift;

    if ($Special{$word}) {
	return qq(<FONT COLOR="$SpecialColor"><B>$word</B></FONT>);
    }
    $word;
}

sub colorize_escapes {
	my $word = shift;

	if ($Escapes{$word}) {
		return qq(<FONT COLOR="$EscapesColor">$word</FONT>);
	}
	$word;
}

=head1 NAME

p2h - perl to html 4.01

=head1 DESCRIPTION

This script will convert your perl script to colorized html conforming to 
W3C HTML 4.01 standard.

=head1 README

p2h 
v 0.01

USAGE:
p2h yourperl.pl >yourhtml.html

Consider this version alpha. It will convert code without 
errors. It will not output errors other than those not
caught, which is all :)

It will not take command line arguments including --help.

The next revision will take command line arguments to show
usage.

TODO
Add generic color themes, similar to vim. The ones I plan
on implementing are common ones like
light
dark
borland
elflord
black and white printable

If you have requests or suggestions please email them to 
me at

jasonholland [ AT ] rawsoftware [ DOT ] com

=head1 PREREQUISITES

This script uses the strict module C<strict>.

=head1 COREQUISITES

none

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

CPAN/Administrative
Educational
Web
Win32


=cut