File Coverage

blib/lib/Devel/Examine/Subs.pm

Criterion	Covered	Total	%
statement	571	571	100.0
branch	271	286	94.7
condition	51	63	80.9
subroutine	56	57	98.2
pod	19	20	95.0
total	968	997	97.0

package Devel::Examine::Subs;
use 5.008;
use warnings;
use strict;

our $VERSION = '1.68';

use Carp;
use Data::Compare;
use Data::Dumper;
use Devel::Examine::Subs::Engine;
use Devel::Examine::Subs::Preprocessor;
use Devel::Examine::Subs::Postprocessor;
use File::Basename;
use File::Copy;
use File::Edit::Portable;
use PPI;
use Symbol qw(delete_package);

BEGIN {

    # we need to do some trickery for DTS due to circular referencing,
    # which broke CPAN installs.

    eval {
        require Devel::Trace::Subs;
    };

    eval {
        import Devel::Trace::Subs qw(trace);
    };

    if (! defined &trace){
        *trace = sub {};
    }
};

#
# public methods
#

sub new {

    # set up for tracing

    if ($ENV{DES_TRACE}){
        $ENV{DTS_ENABLE} = 1;
        $ENV{TRACE} = 1;
    }

    trace() if $ENV{TRACE};

    my $self = {};
    bless $self, shift;
    my $p = $self->_params(@_);

    # default configs

    $self->{namespace} = __PACKAGE__;
    $self->{params}{regex} = 1;
    $self->{params}{backup} = 0;

    $self->_config($p);

    return $self;
}
sub all {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{engine} = 'all';

    $self->run($p);
}
sub has {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{post_proc} = 'file_lines_contain';
    $self->{params}{engine} = 'has';

    $self->run($p);
}
sub missing {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{engine} = 'missing';

    $self->run($p);
}
sub lines {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{engine} = 'lines';

    if ($self->{params}{search} || $p->{search}){
        $self->{params}{post_proc} = 'file_lines_contain';
    }

    $self->run($p);
}
sub module {

    trace() if $ENV{TRACE};

    my $self = shift;

    my $p;

    # allow for single string value

    if (@_ == 1){
        my %p;
        $p{module} = shift;
        $p = $self->_params(%p);
    }
    else {
        $p = $self->_params(@_);
    }

    # set the preprocessor up, and have it return before
    # the building/compiling of file data happens

    $self->{params}{pre_proc} = 'module';
    $self->{params}{pre_proc_return} = 1;

    $self->{params}{engine} = 'module';

    $self->run($p);
}
sub objects {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{post_proc} = 'subs';
    $self->{params}{engine} = 'objects';

    $self->run($p);
}
sub search_replace {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{post_proc}
      = ['file_lines_contain', 'subs', 'objects'];

    $self->{params}{engine} = 'search_replace';

    $self->run($p);
}
sub replace {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{pre_proc} = 'replace';
    $self->{params}{pre_proc_return} = 1;

    $self->run($p);
}
sub inject_after {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    if (! $p->{injects} && ! $self->{params}{injects}){
        $p->{injects} = 1;
    }

    $self->{params}{post_proc}
      = ['file_lines_contain', 'subs', 'objects'];

    $self->{params}{engine} = 'inject_after';

    $self->run($p);
}
sub inject {
    trace() if $ENV{TRACE};
    my $self = shift;
    my $p = $self->_params(@_);

    # inject_use/inject_after_sub_def are preprocs

    if ($p->{inject_use} || $p->{inject_after_sub_def} || defined $p->{line_num}){
        $self->{params}{pre_proc} = 'inject';
        $self->{params}{pre_proc_return} = 1;
    }

    $self->run($p);
}
sub remove {
    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->{params}{pre_proc} = 'remove';
    $self->{params}{pre_proc_return} = 1;

    $self->run($p);
}
sub order {
    trace() if $ENV{TRACE};

    my $self = shift;

    if ($self->{params}{directory}){
        confess "\norder() can only be called on an individual file, not " .
                "a directory at this time\n\n";
    }

    return @{ $self->{order} };
}
sub backup {
    trace() if $ENV{TRACE};

    my $self = shift;
    my $state = shift || 0;

    $self->{params}{backup} = $state if defined $state;
    return $self->{params}{backup};
}

#
# publicly available semi-private developer methods
#

sub add_functionality {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = $self->_params(@_);

    $self->_config($p);

    my $to_add = $self->{params}{add_functionality};
    my $in_prod = $self->{params}{add_functionality_prod};

    my @allowed = qw(
                    pre_proc
                    post_proc
                    engine
    );

    my $is_allowed = 0;

    for (@allowed){
        if ($_ eq $to_add){
            $is_allowed = 1;
            last;
        }
    }

    if (! $is_allowed){
        confess "Adding a non-allowed piece of functionality...\n";
    }

    my %dt = (
            pre_proc => sub {
                        trace() if $ENV{TRACE};
                        return $in_prod
                        ? $INC{'Devel/Examine/Subs/Preprocessor.pm'}
                        : 'lib/Devel/Examine/Subs/Preprocessor.pm';
                      },
            post_proc => sub {
                        trace() if $ENV{TRACE};
                        return $in_prod
                        ? $INC{'Devel/Examine/Subs/Postprocessor.pm'}
                        : 'lib/Devel/Examine/Subs/Postprocessor.pm';
                      },
            engine => sub {
                        trace() if $ENV{TRACE};
                        return $in_prod
                        ? $INC{'Devel/Examine/Subs/Engine.pm'}
                        : 'lib/Devel/Examine/Subs/Engine.pm';
                      },
    );

    my $caller = (caller)[1];

    open my $fh, '<', $caller
      or confess "can't open the caller file $caller: $!";

    my $code_found = 0;
    my @code;

    while (<$fh>){
        chomp;
        if (m|^#(.*)|){
            $code_found = 1;
            next;
        }
        next if ! $code_found;
        last if m|^#(.*)|;
        push @code, $_;
    }

    my $file = $dt{$to_add}->();
    my $copy = $self->{params}{copy};

    if ($copy) {
        copy $file, $copy or die $!;
        $file = $copy;
    }

    my $sub_name;

    if ($code[0] =~ /sub\s+(\w+)/){
        $sub_name = $1;
    }
    else {
        confess "couldn't extract the sub name";
    }

    my $des = Devel::Examine::Subs->new(file => $file);

    my $existing_subs = $des->all;

    if (grep { $sub_name eq $_ } @$existing_subs) {
        confess "the sub you're trying to add already exists";
    }

    $des = Devel::Examine::Subs->new(
                                    file => $file,
                                    engine => 'objects',
                                    post_proc => [qw(subs end_of_last_sub)],
                                );
    $p = {
        engine => 'objects',
        post_proc => [qw(subs end_of_last_sub)],
        post_proc_return => 1,
    };

    my $start_writing = $des->run($p);

    my $rw = File::Edit::Portable->new;

    $rw->splice(file => $file, insert => \@code, line => $start_writing);

    my @insert = ("        $sub_name => \\&$sub_name,");

    my @ret = $rw->splice(
        file => $file,
        find => 'my\s+\$dt\s+=\s+\{',
        insert => \@insert,
    );

    return 1;
}
sub engines {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $module = $self->{namespace} . "::Engine";
    my $engine = $module->new;

    my @engines;

    for (keys %{$engine->_dt}){
        push @engines, $_ if $_ !~ /^_/;
    }
    return @engines;
}
sub pre_procs {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $module = $self->{namespace} . "::Preprocessor";
    my $pre_proc = $module->new;

    my @pre_procs;

    for (keys %{$pre_proc->_dt}){
        push @pre_procs, $_ if $_ !~ /^_/;
    }
    return @pre_procs;
}
sub post_procs {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $module = $self->{namespace} . "::Postprocessor";
    my $post_proc = $module->new;

    my @post_procs;

    for (keys %{$post_proc->_dt}){
        push @post_procs, $_ if $_ !~ /^_/;
    }
    return @post_procs;
}
sub run {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;

    $self->_config($p);

    $self->_run_end(0);

    my $struct;

    if ($self->{params}{directory}){
        $struct = $self->_run_directory;
    }
    else {
        $struct = $self->_core;
        $self->_write_file if $self->{write_file_contents};
    }

    $self->_run_end(1);

    return $struct;
}
sub valid_params {

    trace() if $ENV{TRACE};

    my $self = shift;
    return %{$self->{valid_params}};
}

#
# private methods
#

sub _cache {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $file = shift;
    my $struct = shift;

    if ($self->{params}{cache_dump}){

        print Dumper $self->{cache};

        if ($self->{params}{cache_dump} > 1){
            exit;
        }
    }

    if (! $struct && $file){
        return $self->{cache}{$file};
    }
    if ($file && $struct){
        $self->{cache}{$file} = $struct;
    }
}
sub _cache_enabled {

    trace() if $ENV{TRACE};

    my $self = shift;
    return $self->{params}{cache};
}
sub _cache_safe {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $value = shift;

    $self->{cache_safe} = $value if defined $value;

    return $self->{cache_safe};
}
sub _clean_config {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $config_vars = shift; # href of valid params
    my $p = shift;           # href of params passed in

    for my $var (keys %$config_vars){

        last if ! $self->_run_end;

        # skip if it's a persistent var

        next if $config_vars->{$var} == 1;

        delete $self->{params}{$var};
    }

    # delete non-valid params

    for my $param (keys %$p){
        if (! exists $config_vars->{$param}){
            print "\n\nDES::_clean_config() deleting invalid param: $param\n";
            delete $p->{$param};
        }
    }
}
sub _clean_core_config {

    trace() if $ENV{TRACE};

    my $self = shift;

    # delete params we collected after _clean_config()

    delete $self->{params}{file_contents};
    delete $self->{params}{order};

    my @core_phases = qw(
        pre_proc
        post_proc
        engine
    );

    for (@core_phases){
        delete $self->{params}{$_};
    }
}
sub _config {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;

    my %valid_params = (

        # persistent

        backup => 1,
        cache => 1,
        copy => 1,
        diff => 1,
        extensions => 1,
        file => 1,
        maxdepth => 1,
        no_indent => 1,
        regex => 1,

        # persistent - core phases

        pre_proc => 1,
        post_proc => 1,
        engine => 1,

        # transient

        directory => 0,
        search => 0,
        replace => 0,
        injects => 0,
        code => 0,
        include => 0,
        exclude => 0,
        lines => 0,
        module => 0,
        objects_in_hash => 0,
        pre_proc_dump => 0,
        post_proc_dump => 0,
        engine_dump => 0,
        core_dump => 0,
        pre_proc_return => 0,
        post_proc_return => 0,
        engine_return => 0,
        config_dump => 0,
        cache_dump => 0,
        inject_use => 0,
        inject_after_sub_def => 0,
        delete => 0,
        file_contents => 0,
        exec => 0,                  # replace(), search_replace()
        limit => 0,
        line_num => 0,              # inject()
        add_functionality => 0,
        add_functionality_prod => 0,
        order => 0,
    );

    $self->{valid_params} = \%valid_params;

    # get previous run's config

    %{$self->{previous_run_config}} = %{$self->{params}};

    # clean config

    $self->_clean_config(\%valid_params, $p);

    for my $param (keys %$p){

        # validate the file

        if ($param eq 'file'){
            $self->_file($p);
            next;
        }

        $self->{params}{$param} = $p->{$param};
    }

    # check if we can cache

    if ($self->_cache_enabled) {

        my @unsafe_cache_params
            = qw(file extensions include exclude search);

        my $current = $self->{params};
        my $previous = $self->{previous_run_config};

        for (@unsafe_cache_params) {
            my $safe = Compare($current->{$_}, $previous->{$_}) || 0;

            $self->_cache_safe($safe);

            last if !$self->_cache_safe;
        }
    }

    if ($self->{params}{config_dump}){
        print Dumper $self->{params};
    }
}
sub _file {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;

    $self->{params}{file} = defined $p->{file} ? $p->{file} : $self->{params}{file};

    # if a module was passed in, dig up the file

    if ($self->{params}{file} =~ /::/){

        my $module = $self->{params}{file};
        (my $file = $module) =~ s|::|/|g;
        $file .= '.pm';

        my $module_is_loaded;

        if (! $INC{$file}){

            eval { require $file; import $module; };

            if ($@){
                $@ = "\nDevel::Examine::Subs::_file() speaking ... " .
                     "Can't transform module to a file name\n\n"
                     . $@;
                confess $@;
            }
        }
        else {
            $module_is_loaded = 1;
        }

        # set the file param

        $self->{params}{file} = $INC{$file};

        if (! $module_is_loaded){
            delete_package $module;
            delete $INC{$file};
        }
    }

    # configure directory searching for run()

    if (-d $self->{params}{file}){
        $self->{params}{directory} = 1;
        $self->{params}{extensions}
          = defined $p->{extensions} ? $p->{extensions} : [qw(*.pm *.pl)];
    }
    else {
        if (! $self->{params}{file} || ! -f $self->{params}{file}){
            die "Invalid file supplied: $self->{params}{file} $!";
        }
   }

   return $self->{params}{file};
}
sub _params {

    trace() if $ENV{TRACE};

    my $self = shift;
    my %params = @_;
    return \%params;
}
sub _read_file {

    # this sub prepares a temp copy of the original file,
    # recseps changed to local platform for PPI

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;

    my $file = $p->{file};

    return if ! $file;

    if ($self->{params}{backup}) {
        my $basename = basename($file);
        my $bak = "$basename.bak";

        copy $file, $bak
            or confess "DES::_read_file() can't create backup copy $bak!";
    }

    die "Can't call method \"serialize\" on an undefined file\n" if ! -f $file;

    $self->{rw} = File::Edit::Portable->new;

    my $ppi_doc;

    if ($self->{rw}->recsep($file, 'hex') ne $self->{rw}->platform_recsep('hex')) {
        my $fh = $self->{rw}->read($file);

        my $tempfile = $self->{rw}->tempfile;
        my $tempfile_name = $tempfile->filename;
        my $platform_recsep = $self->{rw}->platform_recsep;

        $self->{rw}->write(
            copy => $tempfile_name,
            contents => $fh,
            recsep => $platform_recsep
        );

        $ppi_doc = PPI::Document->new($tempfile_name);

        close $tempfile;
    }
    else {
        $ppi_doc = PPI::Document->new($file);
    }

    @{ $p->{file_contents} } = split /\n/, $ppi_doc->serialize;


    if (! $p->{file_contents}->[0]){
        return 0;
    }
    else {
        $self->{params}{file_contents} = $p->{file_contents};
        return 1;
    }
}
sub _run_directory {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;

    my $dir = $self->{params}{file};

    $self->{rw} = File::Edit::Portable->new;

    my @files = $self->{rw}->dir(
                            dir => $dir,
                            maxdepth => $self->{params}{maxdepth} || 0,
                            types => $self->{params}{extensions},
                            list => 1,
                        );

    my %struct;

    for my $file (@files){

        $self->{params}{file} = $file;
        my $data = $self->_core($p);

        $self->_write_file if $self->{write_file_contents};

        if (ref $data eq 'HASH' || ref $data eq 'ARRAY'){
            $struct{$file} = $data;
        }
    }

    return \%struct;
}
sub _run_end {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $value = shift;

    $self->{run_end} = $value if defined $value;

    # we clean core_config here

    $self->_clean_core_config if $value;

    return $self->{run_end};
}
sub _write_file {

    trace() if $ENV{TRACE};

    my $self = shift;

    my $copy = $self->{params}{copy};

    my $file = $self->{params}{file};
    my $contents = $self->{write_file_contents};

    return if ! $file;

    if ($self->{params}{directory} && $copy && ! -d $copy){
        warn "\n\nin directory mode, all files are copied to the dir named " .
             "in the copy param, which is $copy\n\n";

        mkdir $copy or confess "can't create directory $copy";
    }
    if ($copy && -d $copy){
        copy $file, $copy;
        my $filename = basename $file;
        $file = "$copy/$filename";
    }
    elsif ($copy) {
        $file = $copy;
    }

    my $write_response;

    eval {
        $write_response = $self->{rw}->write(file => $file, contents => $contents);
    };

    if ($@ || ! $write_response){
        $@ = "\nDevel::Examine::Subs::_write_file() speaking...\n\n" .
             "File::Edit::Portable::write() returned a failure status.\n\n" .
             $@;
        confess $@;
    }
}

#
# private methods for core phases
#

sub _core {

    trace() if $ENV{TRACE};

    my $self = shift;

    my $p = $self->{params};

    my $search = $self->{params}{search};
    my $file = $self->{params}{file};

    $self->_read_file($p);

    # pre processor

    my $data;

    if ($self->{params}{pre_proc}){
        my $pre_proc = $self->_pre_proc;

        $data = $pre_proc->($p, $data);

        if ($self->{params}{pre_proc_dump}){
            print Dumper $data;
            exit;
        }

        if ($p->{write_file_contents}){
            $self->{write_file_contents} = $p->{write_file_contents};
        }

        # for things that don't need to process files
        # (such as 'module'), return early

        if ($self->{params}{pre_proc_return}){
            return $data;
        }
    }

    # processor

    my $subs = $data;

    # bypass the proc if cache

    my $cache_enabled = $self->_cache_enabled;
    my $cache_safe = $self->_cache_safe;

    if ($cache_enabled && $cache_safe && $self->_cache($p->{file})){
        $subs = $self->_cache($p->{file});
    }
    else {
        $subs = $self->_proc($p);
    }

    return if ! $subs;

    # write to cache

    if ($self->_cache_enabled && ! $self->_cache($p->{file})){
        $self->_cache($p->{file}, $subs);
    }

    # post processor

    if ($self->{params}{post_proc}){
        for my $post_proc ($self->_post_proc($p, $subs)){
            $subs = $post_proc->($p, $subs);
            $self->{write_file_contents} = $p->{write_file_contents};
        }
    }

    if ($self->{params}{post_proc_return}){
        return $subs;
    }

    # engine

    my $engine = $self->_engine($p, $subs);

    if ($self->{params}{engine}){
        $subs = $engine->($p, $subs);
        $self->{write_file_contents} = $p->{write_file_contents};
    }

    # core dump

    if ($self->{params}{core_dump}){

        print "\n\t Core Dump called...\n\n";
        print "\n\n\t Dumping data... \n\n";
        print Dumper $subs;

        print "\n\n\t Dumping instance...\n\n";
        print Dumper $self;

        exit;
    }

    return $subs;
}
sub _pre_proc {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;
    my $subs = shift;

    my $pre_proc = $self->{params}{pre_proc};

    if (not $pre_proc or $pre_proc eq ''){
        return $subs;
    }

    # tell _core() to return directly from the pre_processor
    # if necessary, and bypass post_proc and engine

    if ($pre_proc eq 'module'){
       $self->{params}{pre_proc_return} = 1;
    }

    my $cref;

    if (not ref($pre_proc) eq 'CODE'){
        my $pre_proc_module = $self->{namespace} . "::Preprocessor";
        my $compiler = $pre_proc_module->new;

        if (! $compiler->exists($pre_proc)){
            confess "Devel::Examine::Subs::_pre_proc() speaking...\n\n" .
                  "pre_processor '$pre_proc' is not implemented.\n";
        }

        eval {
            $cref = $compiler->{pre_procs}{$pre_proc}->();
        };

        if ($@){
            $@ = "\n[Devel::Examine::Subs speaking] " .
                  "dispatch table in Devel::Examine::Subs::Preprocessor " .
                  "has a mistyped function as a value, but the key is ok\n\n"
            . $@;
            confess $@;
        }

    }

    if (ref($pre_proc) eq 'CODE'){
        $cref = $pre_proc;
    }

    return $cref;
}
sub _proc {

    # this method is the core data collection/manipulation
    # routine (aka the 'Processor phase') for all of DES

    # make sure all unit tests are successful after any change
    # to this subroutine!

    # if you want the data structure to look differently before
    # reaching here, use a pre_proc. If you want it different
    # afterwards, use a post_proc or an engine

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;

    my $file = $self->{params}{file};

    return {} if ! $file;

    my $PPI_doc = PPI::Document->new($file);
    my $PPI_subs = $PPI_doc->find('PPI::Statement::Sub');

    return if ! $PPI_subs;

    my %subs;
    $subs{$file} = {};
    my @sub_order;

    for my $PPI_sub (@{$PPI_subs}){

        my $include
          = defined $self->{params}{include} ? $self->{params}{include} : [];
        my $exclude
          = defined $self->{params}{exclude} ? $self->{params}{exclude} : [];

        delete $self->{params}{include} if $exclude->[0];

        my $name = $PPI_sub->name;

        push @sub_order, $name;

        # skip over excluded (or not included) subs

        next if grep {$name eq $_ } @$exclude;

        if ($include->[0]){
            next if (! grep {$name eq $_ && $_} @$include);
        }

        $subs{$file}{subs}{$name}{start} = $PPI_sub->line_number;
        $subs{$file}{subs}{$name}{start}--;

        my $lines = $PPI_sub =~ y/\n//;

        $subs{$file}{subs}{$name}{end}
          = $subs{$file}{subs}{$name}{start} + $lines;

        my $count_start = $subs{$file}{subs}{$name}{start};
        $count_start--;

        my $sub_line_count
          = $subs{$file}{subs}{$name}{end} - $count_start;

        $subs{$file}{subs}{$name}{num_lines} = $sub_line_count;

        @{ $subs{$file}{subs}{$name}{code} } = split /\n/, $PPI_sub->content;
    }

    @{ $p->{order} } = @sub_order;
    @{ $self->{order} } = @sub_order;

    return \%subs;
}
sub _post_proc {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;
    my $struct = shift;

    my $post_proc = $self->{params}{post_proc};

    my $post_proc_dump = $self->{params}{post_proc_dump};

    my @post_procs;

    if ($post_proc){

        my @post_proc_list;

        if (ref $post_proc ne 'ARRAY'){
            push @post_proc_list, $post_proc;
        }
        else {
            @post_proc_list = @{$post_proc};
        }

        for my $pf (@post_proc_list){

            my $cref;

            if (ref $pf ne 'CODE'){

                my $post_proc_module = $self->{namespace} . "::Postprocessor";
                my $compiler = $post_proc_module->new;

                # post_proc isn't in the dispatch table

                if (! $compiler->exists($pf)){
                    confess "\nDevel::Examine::Subs::_post_proc() " .
                          "speaking...\n\npost_proc '$pf' is not " .
                          "implemented. '$post_proc' was sent in.\n";
                }

                eval {
                    $cref = $compiler->{post_procs}{$pf}->();
                };

                if ($@){
                    $@ = "\n[Devel::Examine::Subs speaking] " .
                          "dispatch table in " .
                          "Devel::Examine::Subs::Postprocessor has a mistyped " .
                          "function as a value, but the key is ok\n\n"
                    . $@;
                    confess $@;
                }
            }
            if (ref($pf) eq 'CODE'){
                $cref = $pf;
            }

            if ($post_proc_dump && $post_proc_dump > 1){
                $self->{params}{post_proc_dump}--;
                $post_proc_dump = $self->{params}{post_proc_dump};
            }

            if ($post_proc_dump && $post_proc_dump == 1){
                my $subs = $cref->($p, $struct);
                print Dumper $subs;
                exit;
            }
            push @post_procs, $cref;
        }
    }
    else {
        return;
    }
    return @post_procs;
}
sub _engine {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $p = shift;
    my $struct = shift;

    my $engine
      = defined $p->{engine} ? $p->{engine} : $self->{params}{engine};

    if (not $engine or $engine eq ''){
        return $struct;
    }

    my $cref;

    if (not ref($engine) eq 'CODE'){

        # engine is a name

        my $engine_module = $self->{namespace} . "::Engine";
        my $compiler = $engine_module->new;

        # engine isn't in the dispatch table

        if (! $compiler->exists($engine)){
            confess "engine '$engine' is not implemented.\n";
        }

        eval {
            $cref = $compiler->{engines}{$engine}->();
        };

        # engine has bad func val in dispatch table, but key is ok

        if ($@){
            $@ = "\n[Devel::Examine::Subs speaking] " .
                  "dispatch table in Devel::Examine::Subs::Engine " .
                  "has a mistyped function as a value, but the key is ok\n\n"
            . $@;
            confess $@;
        }
    }

    if (ref($engine) eq 'CODE'){
        $cref = $engine;
    }

    if ($self->{params}{engine_dump}){
        my $subs = $cref->($p, $struct);
        print Dumper $subs;
        exit;
    }

    return $cref;
}

#
# pod
#

sub _pod{1;} #vim placeholder
1;
__END__