File Coverage

File:local/lib/perl5/Data/Printer/Filter.pm
Coverage:63.3%

linestmtbrancondsubtimecode
1package Data::Printer::Filter;
2
2
2
2
2
4
2
27
use strict;
3
2
2
2
2
4
0
21
use warnings;
4
2
2
2
2
73
1
6
use Clone::PP qw(clone);
5require Carp;
6require Data::Printer;
7
8my %_filters_for   = ();
9my %_extras_for    = ();
10
11sub import {
12
4
4
6
    my $caller = caller;
13
4
6
    my $id = Data::Printer::_object_id( \$caller );
14
15
4
4
    my %properties = ();
16
17    my $filter = sub {
18
26
26
16
        my ($type, $code, $extra) = @_;
19
20
26
50
25
76
        Carp::croak( "syntax: filter 'Class', sub { ... }" )
21          unless $type and $code and ref $code eq 'CODE';
22
23
26
50
15
        if ($extra) {
24
0
0
0
0
            Carp::croak( 'extra filter field must be a hashref' )
25                unless ref $extra and ref $extra eq 'HASH';
26
27
0
0
            $_extras_for{$id}{$type} = $extra;
28        }
29        else {
30
26
31
            $_extras_for{$id}{$type} = {};
31        }
32
33
26
47
        unshift @{ $_filters_for{$id}{$type} }, sub {
34
0
0
0
            my ($item, $p) = @_;
35
36            # send our closured %properties var instead
37            # so newline(), indent(), etc can work it
38
0
0
0
0
            %properties = %{ clone $p };
39
0
0
            delete $properties{filters}; # no need to rework filters
40
0
0
            $code->($item, \%properties);
41
26
10
        };
42
4
9
    };
43
44    my $filters = sub {
45
4
4
14
        return $_filters_for{$id};
46
4
6
    };
47
48    my $extras = sub {
49
4
4
8
        return $_extras_for{$id};
50
4
7
    };
51
52    my $newline = sub {
53
0
0
0
0
0
        return ${$properties{_linebreak}} . (' ' x $properties{_current_indent});
54
4
3
    };
55
56    my $indent = sub {
57
0
0
0
        $properties{_current_indent} += $properties{indent};
58
0
0
        $properties{_depth}++;
59
0
0
        return;
60
4
16
    };
61
62    my $outdent = sub {
63
0
0
0
        $properties{_current_indent} -= $properties{indent};
64
0
0
        $properties{_depth}--;
65
0
0
        return;
66
4
3
    };
67
68    my $imported = sub (\[@$%&];%) {
69
0
0
0
        my ($item, $p) = @_;
70
0
0
        return Data::Printer::p( $item, %properties );
71
4
7
    };
72
73    {
74
2
2
2
4
2
5
2
112
2
        no strict 'refs';
75
4
4
4
9
        *{"$caller\::filter"}  = $filter;
76
4
4
3
6
        *{"$caller\::indent"}  = $indent;
77
4
4
1
9
        *{"$caller\::outdent"} = $outdent;
78
4
4
2
5
        *{"$caller\::newline"} = $newline;
79
80
4
4
3
7
        *{"$caller\::p"} = $imported;
81
82
4
4
1
6
        *{"$caller\::_filter_list"}   = $filters;
83
4
4
2
61
        *{"$caller\::_extra_options"} = $extras;
84    }
85};
86
87
881;