in reply to Print perl source code in compiled script...
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;
|
|---|