#! /usr/bin/perl -CSD
use strict;

my ($Prog, $Version) = ("w0-l-perl", "2.0.3");
my $Perl_id = "[A-Za-z]\\w*";
my $Enhance = 0;
my @Res_word = ("and", "continue", "die", "do", "dump", "else", 
    "elsif", "eval", "exec", "exit", "for", "foreach", "fork",
    "if", "kill", "last", "next", "or", "return", "sub", 
    "unless", "until", "wait", "while");
my $Res_Perl = join("|", @Res_word);
PARAM:
while (@ARGV && $ARGV[0] =~ /^-/) { $_ = shift;
    /^-e$/ and do { $Enhance = "yes";  next PARAM; };
    /^-v$/ and do {
        print STDERR "This is $Prog (version $Version)\n";
        next PARAM; };
}
my $line;
while (<>) { 
    unless (/^code:(.*);$/) { print;  next; };
    chomp($line = $1);
    $_ = $line;  while (s/\bsub\s+($Perl_id)//o) { print "fdef:&$1;\n"; }
while (s/&($Perl_id)//o) { print "fuse:&$1;\n"; }
while (s/\@($Perl_id)//o) { print "vuse:\@$1;\n" unless $1 eq "_"; }
while (s/\$($Perl_id)\s*\[//o) { print "vuse:\@$1;\n" unless $1 eq "_"; }
while (s/%($Perl_id)//o) { print "vuse:%$1;\n"; }
while (s/\$($Perl_id)\s*\{//o) { print "vuse:%$1;\n"; }
while (s/\$($Perl_id)//o) { print "vuse:\$$1;\n" unless $1 eq "_"; }
    if ($Enhance) {
        $_ = $line;  /^\s*#/ and do { print "icode:$_;\n"; next; };
while (/\b($Res_Perl)\b/o) {
    print "code:$`;\n" if $`;
    print "bcode:$&;\n";
    $_ = $';
}
print "code:$_;\n" if $_;
    } else {
        print "code:$line;\n";
    }
}
exit 0;

sub Error {
    &Message(@_);  
    &Tidy_up if defined &Tidy_up;
    exit 1;
}
sub Message {
    print STDERR "$Prog: ", shift, "\n";
    while (@_) {
        print STDERR " "x(2+length $Prog), shift, "\n";
    }
}
