Re: Print perl source code in compiled script...

[bcarroll]

I agree, backing up and using a version control system is the best route for maintaining code, but often times for my purposes (one time use) that is overkill. Being able to extract the exact source code (non obfuscated, etc. ) from an executable is what I am looking for.

And I think the answer is perlfilter.
I threw together a module that implements what I am trying to achieve.
Note: To ensure all of the sourcecode is captured, make sure use SourceDump; is the first line of the script file (or second line on *NIX). Any code that appears before use SourceDump; will not be captured

Here is the SourceDump module:

package SourceDump;

#http://perldoc.perl.org/perlfilter.html

use Filter::Util::Call;
my $stdout      = 1; # if true, prints sourcecode to STDOUT
my $fileout     = 1; # if true, writes sourcecode to FILE
my $filename    = 'SourceDump_'. time() .'.pl'; # sets name of file to
+ write to

# import() is called automatically every time a module is included wit
+h a use statement
sub import {
   my ($type) = @_;
   my ($ref)  = {};
   filter_add(bless $ref); # create association between the filter obj
+ect and the source stream
}

# filter() is called every time the Perl parser needs another line of 
+source to process
sub filter {
    my ($self) = @_;
    my ($status);
    # If a line was available from the source stream, filter_read() re
+turns a status value greater than zero and appends the line to $_
    # A status value of zero indicates end-of-file, less than zero mea
+ns an error.
    if ( ($status = filter_read()) > 0 ){
        return(1) if $_ =~ /SourceDump/; # skip lines that include the
+ word "SourceDump". ***FUTURE USE***
        &_stdout($_) if $stdout;
        &_fileout($_) if $fileout;
    }
    return($status);
}

###########################
# private methods
###########################
sub _stdout {
        print $_;
}

sub _fileout {
    my $error = "";
    open(my $FILE, '>>', $filename) or $error=$!;
    if ($error){
        &_error('fileout', $!);
        return(undef);
    }
    print $FILE $_;
    close($FILE);
}

sub _error {
    my $source  = shift;
    my $message = shift;
    print 'ERROR: ' . uc($source) . ", $message\n";
}

1;