#!/usr/bin/perl -w
#

# Module einbinden:

use strict;
use HTML::Entities;

# Dateinamen, Trenner holen:

my $file = shift || die("USAGE: test.pl filename outfile sep");
my $out = shift || "a.html";
my $s = shift || chr(1);

# @func festlegen:

my @func  =  qw(print chomp chop chr crypt hex index lc lcfirst length oct ord pack reverse rindex
        sprintf substr uc ucfirst pos quotemeta split study abs atan2 cos exp hex int log
        oct rand sin sqrt srand pop push shift splice unshift grep join map reverse sort
        unpack delete each exists keys values binmode close closedir dbmclose dbmopen die
        eof fileno flock format getc print printf read readdir rewinddir seek seekdir select
        syscall sysread sysseek syswrite tell telldir truncate warn write pack read syscall
        sysread syswrite unpack vec -X chdir chmod chown chroot fcntl glob ioctl link lstat
        mkdir open opendir readlink rename rmdir stat symlink sysopen umask unlink utime
        caller continue die do dump eval exit goto last next redo return sub wantarray defined
        dump eval formline local my our reset scalar undef wantarray alarm exec fork getpgrp
        getppid getpriority kill pipe setpgrp setpriority sleep system times wait waitpid do
        import no package require use bless package ref tie tied untie use
        accept bind connect getpeername getsockname getsockopt listen recv send setsockopt
        shutdown socket socketpair msgctl msgget msgrcv msgsnd semctl semget semop shmctl
        shmget shmread shmwrite endgrent endhostent endnetent endpwent getgrent getgrgid
        getgrnam getlogin getpwent getpwnam getpwuid setgrent setpwent endprotoent endservent
        gethostbyaddr gethostbyname gethostent getnetbyaddr getnetbyname getnetent
        getprotobyname getprotobynumber getprotoent getservbyname getservbyport getservent
        sethostent setnetent setprotoent setservent gmtime localtime time times);

# Farben holen:

my %shl;

open IN, "shl.ini";
  while (my$line = <IN>) {
    chomp $line;

    my ($key,$val) = split "=",$line;
    $shl{$key} = $val;
  }
close IN;

# Datei in $data einlesen.

my $data;

open IN, "$file" or die "USAGE: test.pl filename outfile sep";
  while (my$line = <IN>) {
    $data .= "$line";
  }
close IN;

# $data bearbeiten:

$data =~ s/(__.+__)$/${s}M1$1${s}M2/gim;
$data =~ s/(\d+)/${s}Z1$1${s}Z2/gi;
$data =~ s/([\\\/\$\@\¤\%\^\}\]\)\(\[\{\&\;]+)/${s}S1$1${s}S2/gi;
foreach my$func (@func) {
  $data =~ s/($func)/${s}F1$1${s}F2/gi;
}
$data =~ s/\"(.*)\"/${s}W1\"$1\"${s}W2/gi;
$data =~ s/(((s|tr|y)\/.*)?\/.*\/[gimsoecx]*)/${s}R1$1${s}R2/gi;
$data =~ s/(#.*)$/${s}C1$1${s}C2/gim;

$data = encode_entities($data,"<>");

$data =~ s/\n/\n<br>/g;
$data =~ s/${s}Z1/<font color=\"$shl{int}\">/g;
$data =~ s/${s}S1/<font color=\"$shl{special}\">/g;
$data =~ s/${s}W1/<font color=\"$shl{string}\">/g;
$data =~ s/${s}F1/<font color=\"$shl{func}\">/g;
$data =~ s/${s}C1/<font color=\"$shl{comment}\">/g;
$data =~ s/${s}M1/<font color=\"$shl{section}\">/g;
$data =~ s/${s}R1/<font color=\"$shl{regex}\">/g;
$data =~ s/${s}Z2/<\/font>/g;
$data =~ s/${s}S2/<\/font>/g;
$data =~ s/${s}W2/<\/font>/g;
$data =~ s/${s}F2/<\/font>/g;
$data =~ s/${s}C2/<\/font>/g;
$data =~ s/${s}M2/<\/font>/g;
$data =~ s/${s}R2/<\/font>/g;

$data = "<font color=\"$shl{undef}\"><pre>$data<\/pre><\/font>";

# Daten rausschreiben.

open OUT, ">$out";
  print OUT $data;
close OUT;