File Coverage

blib/lib/Shell/Perl/Dumper.pm
Criterion Covered Total %
statement 17 70 24.2
branch 0 8 0.0
condition n/a
subroutine 6 21 28.5
pod n/a
total 23 99 23.2


line stmt bran cond sub pod time code
1             package Shell::Perl::Dumper;
2              
3 4     4   24 use strict;
  4         10  
  4         95  
4 4     4   19 use warnings;
  4         7  
  4         180  
5              
6             our $VERSION = '0.004';
7              
8 4     4   32 use base qw(Class::Accessor); # to get a new() for free
  4         8  
  4         2332  
9              
10             package Shell::Perl::Dumper::Plain;
11              
12             our @ISA = qw(Shell::Perl::Dumper); # to get a new() for free
13              
14             sub is_available {
15 0     0   0 return 1; # always available - no dependency but Perl
16             }
17              
18             sub dump_scalar {
19 0     0   0 shift;
20 0         0 return "$_[0]" . "\n";
21             }
22              
23             sub dump_list {
24 0     0   0 shift;
25 0         0 local $" = "\t";
26 0         0 return "@_" . "\n";
27             }
28              
29             package Shell::Perl::Data::Dump;
30              
31             our @ISA = qw(Shell::Perl::Dumper); # to get a new() for free
32              
33             # XXX make a Data::Dump object an instance variable
34              
35             sub _dump_code_filter {
36 0     0   0 my ($ctx, $object_ref) = @_;
37 0 0       0 return undef unless $ctx->is_code;
38              
39 0         0 require B::Deparse;
40 0         0 my $code = 'sub ' . (B::Deparse->new)->coderef2text($object_ref);
41 0         0 return { dump => $code };
42             }
43              
44             sub is_available {
45 2     2   6 return eval { require Data::Dump::Filtered; 1 };
  2         534  
  0         0  
46             }
47              
48             sub dump_scalar {
49 0     0   0 shift;
50 0         0 require Data::Dump::Filtered;
51 0         0 return Data::Dump::Filtered::dump_filtered(shift, \&_dump_code_filter) . "\n";
52             }
53              
54             sub dump_list {
55 0     0   0 shift;
56 0         0 require Data::Dump::Filtered;
57 0         0 return Data::Dump::Filtered::dump_filtered(@_, \&_dump_code_filter) . "\n";
58             }
59              
60             package Shell::Perl::Data::Dumper;
61              
62             our @ISA = qw(Shell::Perl::Dumper);
63              
64             # XXX make a Data::Dumper object an instance variable
65             # but OO Data::Dumper is very annoying
66              
67             sub is_available {
68 4     4   13 return eval { require Data::Dumper; 1 };
  4         1426  
  4         11992  
69             }
70              
71             sub dump_scalar {
72 0     0     shift;
73 0           require Data::Dumper;
74 0           local $Data::Dumper::Deparse = 1;
75 0           return Data::Dumper->Dump([shift], [qw($var)]);
76             }
77              
78             sub dump_list {
79             #goto &dump_scalar if @_==2; # fallback to dump_scalar if only one
80 0     0     shift;
81 0           require Data::Dumper;
82 0           local $Data::Dumper::Deparse = 1;
83 0           return Data::Dumper->Dump([[@_]], [qw(*var)]);
84             }
85              
86             package Shell::Perl::Dumper::YAML;
87              
88             our @ISA = qw(Shell::Perl::Dumper);
89              
90             sub _require_one_of {
91 0     0     my @modules = @_;
92 0           for (@modules) {
93 0           my $ret = eval "require $_; 1";
94 0 0         warn "pirl: $_ loaded ok\n" if $ret; # XXX
95 0 0         return $_ if $ret;
96             }
97             return undef
98 0           }
99              
100             our $YAML_PACKAGE;
101              
102             sub is_available {
103             #return eval { require YAML; 1 };
104 0     0     $YAML_PACKAGE = _require_one_of(qw(YAML::Syck YAML));
105 0 0         if ($YAML_PACKAGE) {
106 0           $YAML_PACKAGE->import(qw(Dump));
107 4     4   27 do { no strict 'refs'; ${ $YAML_PACKAGE . '::DumpCode' } = 1 };
  4         10  
  4         809  
  0            
  0            
  0            
108 0           return 1
109             } else {
110 0           return undef;
111             }
112              
113             }
114              
115             sub dump_scalar {
116 0     0     shift;
117             #require YAML; # done by &is_available
118 0           return Dump(shift);
119             }
120              
121             sub dump_list { # XXX
122 0     0     shift;
123             #require YAML; # done by &is_available
124 0           return Dump(@_);
125             }
126              
127             package Shell::Perl::Data::Dump::Streamer;
128              
129             our @ISA = qw(Shell::Perl::Dumper);
130              
131             sub is_available {
132 0     0     return eval { require Data::Dump::Streamer; 1 };
  0            
  0            
133             }
134              
135             sub dump_scalar {
136 0     0     shift;
137 0           require Data::Dump::Streamer;
138 0           return Data::Dump::Streamer::Dump(shift)->Names('$var')->Out;
139             }
140              
141             sub dump_list {
142             #goto &dump_scalar if @_==2; # fallback to dump_scalar if only one
143 0     0     shift;
144 0           require Data::Dump::Streamer;
145 0           return Data::Dump::Streamer::Dump([@_])->Names('*var')->Out;
146             }
147              
148             1;
149              
150             __END__