File Coverage

blib/lib/Devel/Examine/Subs/Postprocessor.pm

Criterion	Covered	Total	%
statement	114	114	100.0
branch	36	42	85.7
condition	9	9	100.0
subroutine	21	21	100.0
pod	4	6	66.6
total	184	192	95.8

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

our $VERSION = '1.61';

use Carp;
use Data::Dumper;

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 {};
    }
};

sub new {

    trace() if $ENV{TRACE};

    my $self = {};
    bless $self, shift;

    my $struct = shift;

    $self->{post_procs} = $self->_dt();

    return $self;
}
sub _dt {

    trace() if $ENV{TRACE};

    my $self = shift;

    my $dt = {
        file_lines_contain => \&file_lines_contain,
        subs => \&subs,
        objects => \&objects,
        _default => \&_default,
        _test => \&_test,
        _test_bad => \&_test_bad,
        end_of_last_sub => \&end_of_last_sub,
    };

    return $dt;
}
sub exists {

    trace() if $ENV{TRACE};

    my $self = shift;
    my $string = shift;

    if (exists $self->{post_procs}{$string}){
        return 1;
    }
    else {
        return 0;
    }
}
sub subs {

    trace() if $ENV{TRACE};

    return sub {

        trace() if $ENV{TRACE};

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

        my $s = $struct;
        my @subs;

        for my $f (keys %$s){

            for my $sub (keys %{$s->{$f}{subs}}){
                $s->{$f}{subs}{$sub}{start}++;
                $s->{$f}{subs}{$sub}{end}++;
                $s->{$f}{subs}{$sub}{name} = $sub;
                @{ $s->{$f}{subs}{$sub}{code} } = @{ $s->{$f}{subs}{$sub}{code} };
                push @subs, $s->{$f}{subs}{$sub};
            }
        }
        return \@subs;
    };
}
sub file_lines_contain {

    trace() if $ENV{TRACE};

    return sub {

        trace() if $ENV{TRACE};

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

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

        if ($search && ! $p->{regex}){
            $search = "\Q$search";
        }

        my $s = $struct;

        if (not $search){
            return $struct;
        }

        for my $f (keys %$s){
            for my $sub (keys %{$s->{$f}{subs}}){
                my $found = 0;
                my @has;
                for (@{$s->{$f}{subs}{$sub}{code}}){
                    if ($_ and /$search/){
                        $found++;
                        push @has, $_;
                     }
                }
                if (! $found){
                    delete $s->{$f}{subs}{$sub};
                    next;
                }
                $s->{$f}{subs}{$sub}{code} = \@has;
            }
        }
        return $struct;
    };
}
sub end_of_last_sub {

    trace() if $ENV{TRACE};

    return sub {

        trace() if $ENV{TRACE};

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

        my @last_line_nums;

        for my $sub (@$struct){
            push @last_line_nums, $sub->{end};
        }

        @last_line_nums = sort {$a<=>$b} @last_line_nums;

        return $last_line_nums[-1];

    };
}
sub _test {

    trace() if $ENV{TRACE};

    return sub {

        trace() if $ENV{TRACE};
        my $p = shift;
        my $struct = shift;
        return $struct;
    };
}
sub objects {

    trace() if $ENV{TRACE};

    # uses 'subs' post_proc

    return sub {

        trace() if $ENV{TRACE};

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

        my @return;

        return if not ref($struct) eq 'ARRAY';

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

        if ($search && ! $p->{regex}){
            $search = "\Q$search";
        }

        my $lines;

        my $des_sub;

        for my $sub (@$struct){

            $des_sub
              = Devel::Examine::Subs::Sub->new($sub, $sub->{name});

            push @return, $des_sub;
        }

        return \@return;
    };
}
sub _vim_placeholder {1;}
1;
__END__