File Coverage

blib/lib/Venus/Role/Dumpable.pm
Criterion Covered Total %
statement 58 58 100.0
branch 4 4 100.0
condition n/a
subroutine 9 9 100.0
pod 2 3 66.6
total 73 74 98.6


line stmt bran cond sub pod time code
1             package Venus::Role::Dumpable;
2              
3 87     87   1479 use 5.018;
  87         298  
4              
5 87     87   458 use strict;
  87         181  
  87         1719  
6 87     87   430 use warnings;
  87         189  
  87         2317  
7              
8 87     87   524 use Venus::Role 'with';
  87         187  
  87         508  
9              
10             # METHODS
11              
12             sub dump {
13 1746     1746 1 3930 my ($self, $method, @args) = @_;
14              
15 1746         7032 require Data::Dumper;
16              
17 87     87   665 no warnings 'once';
  87         231  
  87         21393  
18              
19 1746         3449 local $Data::Dumper::Indent = 0;
20 1746         2566 local $Data::Dumper::Purity = 0;
21 1746         2535 local $Data::Dumper::Quotekeys = 0;
22 1746         2474 local $Data::Dumper::Deepcopy = 1;
23 1746         2485 local $Data::Dumper::Deparse = 1;
24 1746         2808 local $Data::Dumper::Sortkeys = 1;
25 1746         2647 local $Data::Dumper::Terse = 1;
26 1746         2575 local $Data::Dumper::Useqq = 1;
27              
28 1746         2692 local $_ = $self;
29              
30 1746 100       6355 my $data = Data::Dumper->Dump([
31             $method ? scalar($self->$method(@args)) : $self
32             ]);
33              
34 1746         208040 $data =~ s/^"|"$//g;
35              
36 1746         11473 return $data;
37             }
38              
39             sub dump_pretty {
40 5     5 1 14 my ($self, $method, @args) = @_;
41              
42 5         22 require Data::Dumper;
43              
44 87     87   712 no warnings 'once';
  87         221  
  87         27442  
45              
46 5         13 local $Data::Dumper::Indent = 2;
47 5         9 local $Data::Dumper::Trailingcomma = 0;
48 5         9 local $Data::Dumper::Purity = 0;
49 5         9 local $Data::Dumper::Pad = '';
50 5         10 local $Data::Dumper::Varname = 'VAR';
51 5         10 local $Data::Dumper::Useqq = 0;
52 5         11 local $Data::Dumper::Terse = 1;
53 5         10 local $Data::Dumper::Freezer = '';
54 5         8 local $Data::Dumper::Toaster = '';
55 5         7 local $Data::Dumper::Deepcopy = 1;
56 5         10 local $Data::Dumper::Quotekeys = 0;
57 5         7 local $Data::Dumper::Bless = 'bless';
58 5         7 local $Data::Dumper::Pair = ' => ';
59 5         11 local $Data::Dumper::Maxdepth = 0;
60 5         16 local $Data::Dumper::Maxrecurse = 1000;
61 5         6 local $Data::Dumper::Useperl = 0;
62 5         10 local $Data::Dumper::Sortkeys = 1;
63 5         11 local $Data::Dumper::Deparse = 1;
64 5         8 local $Data::Dumper::Sparseseen = 0;
65              
66 5         8 local $_ = $self;
67              
68 5 100       53 my $data = Data::Dumper->Dump([
69             $method ? scalar($self->$method(@args)) : $self
70             ]);
71              
72 5         343 $data =~ s/^'|'$//g;
73              
74 5         11 chomp $data;
75              
76 5         98 return $data;
77             }
78              
79             # EXPORTS
80              
81             sub EXPORT {
82 90     90 0 339 ['dump', 'dump_pretty']
83             }
84              
85             1;
86              
87              
88              
89             =head1 NAME
90              
91             Venus::Role::Dumpable - Dumpable Role
92              
93             =cut
94              
95             =head1 ABSTRACT
96              
97             Dumpable Role for Perl 5
98              
99             =cut
100              
101             =head1 SYNOPSIS
102              
103             package Example;
104              
105             use Venus::Class;
106              
107             attr 'test';
108              
109             with 'Venus::Role::Dumpable';
110              
111             package main;
112              
113             my $example = Example->new(test => 123);
114              
115             # $example->dump;
116              
117             =cut
118              
119             =head1 DESCRIPTION
120              
121             This package modifies the consuming package and provides methods for dumping
122             the object or the return value of a dispatched method call.
123              
124             =cut
125              
126             =head1 METHODS
127              
128             This package provides the following methods:
129              
130             =cut
131              
132             =head2 dump
133              
134             dump(Str | CodeRef $method, Any @args) (Str)
135              
136             The dump method returns a string representation of the underlying data. This
137             method supports dispatching, i.e. providing a method name and arguments whose
138             return value will be acted on by this method.
139              
140             I>
141              
142             =over 4
143              
144             =item dump example 1
145              
146             package main;
147              
148             my $example = Example->new(test => 123);
149              
150             my $dump = $example->dump;
151              
152             # "bless( {test => 123}, 'Example' )"
153              
154             =back
155              
156             =cut
157              
158             =head2 dump_pretty
159              
160             dump_pretty(Str | CodeRef $method, Any @args) (Str)
161              
162             The dump_pretty method returns a string representation of the underlying data
163             that is human-readable and useful for debugging. This method supports
164             dispatching, i.e. providing a method name and arguments whose return value will
165             be acted on by this method.
166              
167             I>
168              
169             =over 4
170              
171             =item dump_pretty example 1
172              
173             package main;
174              
175             my $example = Example->new(test => 123);
176              
177             my $dump_pretty = $example->dump_pretty;
178              
179             # bless( {
180             # test => 123
181             # }, 'Example' )
182              
183             =back
184              
185             =cut
186              
187             =head1 AUTHORS
188              
189             Awncorp, C
190              
191             =cut
192              
193             =head1 LICENSE
194              
195             Copyright (C) 2000, Al Newkirk.
196              
197             This program is free software, you can redistribute it and/or modify it under
198             the terms of the Apache license version 2.0.
199              
200             =cut