#!/usr/bin/perl
# version 2.01 12-19-02 michael@bizsystems.com
# Copyright Michael Robinton and BizSystems
# all rights reserved
#
use strict;
if (@ARGV) {
&crypt_mod(@ARGV);
}
sub crypt_mod {
my $seed = 'BizSystems';
my ( $in, $out, $end, $crypt, $discrypt ) = @_;
eval qq{use Crypt::C_LockTite;};
if ( $@ ) {
$crypt = 0;
$end = 'sorry charlie';
}
my $syntax = <<EOF;
syntax: mod_parser.pl in out [END cutoff] [crypt key] [disable ENCRYPT]
pod to STDOUT unless END cutoff is enabled
END cutoff = save
save comments to output to stripped .pm file
do NOT use with C or xs files
EOF
if (@_ < 2) {
print $syntax;
exit;
}
unlink $out if (-e $out && -l $out); # don't OOPS if linked source
my $slurp;
unless (open (IN, "$in")) {
print "ERROR, not found $in\n";
$syntax;
exit;
}
my $pod = 0;
while (<IN>) {
if ( $pod ) {
if ( $_ =~ /^=cut/ ) {
$pod = 0; # kill pod printing
next;
}
print $_ unless $end && $end ne 'save';
next;
}
if ($_ =~ /^=\w/ && $_ !~ /^=cut/ ) {
print $_ unless $end && $end ne 'save';
$pod = 1; # on if any =www except =cut
next;
}
next if $end && $end ne 'save' &&
( $_ =~ /^\s*#/ || # comment and blank only lines
$_ !~ /\S/ );
last if $_ =~ /^__END__/ && $end && $end ne 'save';
$slurp .= $_;
}
close IN;
unless (open(OUT, ">$out")) {
print "open for output on $out failed\n";
exit;
}
if ( $crypt ) {
$slurp = "# Module $out\n" . $slurp;
unless ( $discrypt ) { # ENCRYPTION suspended for DEBUG
my $p = Crypt::C_LockTite->new;
my $tmp = $p->md5($crypt); # md5 of client ID
my $key = $p->new_md5_crypt($seed)->encrypt($tmp); # encrypt with seed
$p->new_crypt($key)->encrypt($slurp);
}
$slurp = "use Crypt::License;\n" . $slurp;
}
print OUT $slurp;
close OUT;
}