| App::Framework::Extension::Filter - Script filter application object |
App::Framework::Extension::Filter - Script filter application object
use App::Framework::Extension::Filter ;
Application that filters either a file or a directory to produce some other output
* app_start - allows hash setup * app_end - allows file creation/tweak * app ** return output line? ** HASH state auto- updated with: *** all output lines (so far) *** regexp match vars (under 'vars' ?) ** app sets HASH 'output' to tell filter what to output (allows multi-line?) * options ** inplace - buffers up lines then overwrites (input) file ** dir - output to dir ** input file wildcards ** recurse - does recursive file find (ignore .cvs .svn) ** output - can spec filename template ($name.ext)
* Filtering feature ** All extra loading of filter submodules ** Feature options: +Filter(perl c) - specifies extra Filter::Perl, Filter::C modules * Filter spec:
(
('<spec>', <flags>, <code>),
('<spec>', <flags>, <code>),
('<spec>', <flags>, <code>),
)
Each entry perfomed on the line, move on to next entry if no match OR match and (flags & FILTER_CONTINUE) [default] Calls <code> on match AND (flags & FILTER_CALL); calls app if no <code> specified Flag bitmasks: FILTER_CONTINUE - allows next entry to be processed if matches; normally stops FILTER_CALL - call code on match
<spec> is of the form:
[<cond>:]/<regexp>/[:<setvars>]
<cond> evaluatable condition that must be met before running the regexp. Variables can be used by name (names are converted to $state->{'vars'}{name})
<stevars> colon separated list of variable assignments evaluated on match. Variables used by name (as <cond>). Regexp matches accessed by $n or \n
None
new([%args])
Create a new App::Framework::Extension::Filter.
The %args are specified as they would be in the set method, for example:
'mmap_handler' => $mmap_handler
The full list of possible arguments are :
'fields' => Either ARRAY list of valid field names, or HASH of field names with default values
Initialises the object class variables.
Filter the specified file(s) one at a time.
=cut
sub filter_run { my $this = shift ; my ($app, $opts_href, $args_href) = @_ ;
# Get command line arguments
# my @args = $this->args() ;
my @args = @{ $args_href->{'file'} || [] } ;
$this->_dispatch_entry_features(@_) ;
#$this->debug(2) ;
print "#!# Hello, Ive started filter_run()...\n" if $this->debug ;
## Update from options
$this->feature('Options')->obj_vars($this, [keys %FIELDS]) ;
#$app->prt_data("Filter=", $this) if $this->debug ;
## Set up filter state
my $state_href = {} ;
$state_href->{num_files} = scalar(@args) ;
$state_href->{file_number} = 1 ;
$state_href->{file_list} = \@args ;
$state_href->{vars} = {} ;
## do each file
foreach my $file (@args)
{
$state_href->{outfile} = '' ;
$state_href->{line_num} = 1 ;
$state_href->{output_lines} = [] ;
$state_href->{file} = $file ;
$this->_dispatch_label_entry_features('file', $app, $opts_href, $state_href) ;
$this->_start_output($state_href, $opts_href) ;
## call application start
$this->call_extend_fn('app_start_fn', $state_href) ;
## Process file
open my $fh, "<$file" or $this->throw_fatal("Unable to read file \"$file\": $!") ;
my $line ;
while(defined($line = <$fh>))
{
chomp $line ;
$state_href->{line} = $line ;
$state_href->{output} = undef ;
$this->_dispatch_label_entry_features('line', $app, $opts_href, $state_href) ;
## call application
$this->call_extend_fn('app_fn', $state_href, $line) ;
$this->_handle_output($state_href, $opts_href) ;
$state_href->{line_num}++ ;
$this->_dispatch_label_exit_features('line', $app, $opts_href, $state_href) ;
}
close $fh ;
## call application end
$this->call_extend_fn('app_end_fn', $state_href) ;
$this->_end_output($state_href, $opts_href) ;
$state_href->{file_number}++ ;
$this->_dispatch_label_exit_features('file', $app, $opts_href, $state_href) ;
}
$this->_dispatch_exit_features(@_) ;
}
# ============================================================================================ # PRIVATE METHODS # ============================================================================================
#----------------------------------------------------------------------------
Start of output file
=cut
sub _start_output { my $this = shift ; my ($state_href, $opts_href) = @_ ;
$this->set('out_fh' => undef) ;
print "_start_output\n" if $this->debug ;
## do nothing if buffering or in-place editing
return if ($this->buffer || $this->inplace) ;
print " + not buffering\n" if $this->debug ;
# open output file (and set up output dir)
$this->_open_output($state_href, $opts_href) ;
}
#----------------------------------------------------------------------------
Write out line (if required)
=cut
sub _handle_output { my $this = shift ; my ($state_href, $opts_href) = @_ ;
## buffer line(s)
push @{$state_href->{output_lines}}, $state_href->{output} if defined($state_href->{output}) ;
## do nothing if buffering or in-place editing
return if ($this->buffer || $this->inplace) ;
## ok to write
$this->_wr_output($state_href, $opts_href, $state_href->{output}) ;
}
#----------------------------------------------------------------------------
End of output file
=cut
sub _end_output { my $this = shift ; my ($state_href, $opts_href) = @_ ;
## if buffering or in-place editing, now need to write file
if ($this->buffer || $this->inplace)
{
# open output file (and set up output dir)
$this->_open_output($state_href, $opts_href) ;
foreach my $line (@{$state_href->{output_lines}})
{
$this->_wr_output($state_href, $opts_href, $line) ;
}
}
# close output file
$this->_close_output($state_href, $opts_href) ;
}
#----------------------------------------------------------------------------
Open the file (or STDOUT) depending on settings
=cut
sub _open_output { my $this = shift ; my ($state_href, $opts_href) = @_ ;
$this->set('out_fh' => undef) ;
print "_open_output\n" if $this->debug ;
my $outfile ;
if ($this->outfile)
{
## See if writing to dir
my $dir = $this->outdir ;
if ($dir)
{
## create path
mkpath([$dir], $this->debug, 0755) ;
}
$dir ||= '.' ;
my $fmt = $this->outfmt ;
my $file = $state_href->{file} ;
my $number = $state_href->{file_number} ;
my ($base, $path, $ext) = fileparse($file, '\..*') ;
my $name = $base ;
eval "\$outfile = \"$fmt\"" ;
print " + eval=$@\n" if $this->debug ;
print " + outfile=$outfile: dir=$dir fmt=$fmt file=$file num=$number base=$base path=$path\n" if $this->debug ;
$outfile = File::Spec->catfile($dir, $outfile) ;
$outfile = File::Spec->rel2abs($outfile) ;
}
if ($outfile)
{
my $file = $state_href->{file} ;
$file = File::Spec->rel2abs($file) ;
if ($outfile eq $file)
{
# In place editing
$this->inplace(1) ;
}
else
{
## Open output
open my $outfh, ">$outfile" or $this->throw_fatal("Unable to write \"$outfile\" : $!") ;
$this->out_fh($outfh) ;
$state_href->{outfile} = $outfile ;
}
}
else
{
## STDOUT
$this->out_fh(\*STDOUT) ;
}
}
#----------------------------------------------------------------------------
Close the file if open
=cut
sub _close_output { my $this = shift ; my ($state_href, $opts_href) = @_ ;
my $fh = $this->out_fh ;
$this->set('out_fh' => undef) ;
if ($this->outfile)
{
close $fh ;
}
else
{
## STDOUT - so ignore
}
}
#----------------------------------------------------------------------------
End of output file
=cut
sub _wr_output { my $this = shift ; my ($state_href, $opts_href, $line) = @_ ;
my $fh = $this->out_fh ;
print "_wr_output($line) fh=$fh\n" if $this->debug ; if ($fh) { print $fh "$line\n" ; } }
# ============================================================================================ # END OF PACKAGE
Setting the debug flag to level 1 prints out (to STDOUT) some debug messages, setting it to level 2 prints out more verbose messages.
Steve Price <sdprice at cpan.org>
None that I know of!
| App::Framework::Extension::Filter - Script filter application object |