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 96     96   1731 use 5.018;
  96         351  
4              
5 96     96   553 use strict;
  96         227  
  96         2178  
6 96     96   524 use warnings;
  96         245  
  96         3151  
7              
8 96     96   622 use Venus::Role 'with';
  96         272  
  96         773  
9              
10             # METHODS
11              
12             sub dump {
13 1745     1745 1 3766 my ($self, $method, @args) = @_;
14              
15 1745         7252 require Data::Dumper;
16              
17 96     96   807 no warnings 'once';
  96         258  
  96         23757  
18              
19 1745         3561 local $Data::Dumper::Indent = 0;
20 1745         2641 local $Data::Dumper::Purity = 0;
21 1745         2634 local $Data::Dumper::Quotekeys = 0;
22 1745         2484 local $Data::Dumper::Deepcopy = 1;
23 1745         2655 local $Data::Dumper::Deparse = 1;
24 1745         3195 local $Data::Dumper::Sortkeys = 1;
25 1745         2488 local $Data::Dumper::Terse = 1;
26 1745         2508 local $Data::Dumper::Useqq = 1;
27              
28 1745         2646 local $_ = $self;
29              
30 1745 100       6532 my $data = Data::Dumper->Dump([
31             $method ? scalar($self->$method(@args)) : $self
32             ]);
33              
34 1745         219504 $data =~ s/^"|"$//g;
35              
36 1745         11823 return $data;
37             }
38              
39             sub dump_pretty {
40 5     5 1 23 my ($self, $method, @args) = @_;
41              
42 5         21 require Data::Dumper;
43              
44 96     96   859 no warnings 'once';
  96         328  
  96         29819  
45              
46 5         15 local $Data::Dumper::Indent = 2;
47 5         13 local $Data::Dumper::Trailingcomma = 0;
48 5         12 local $Data::Dumper::Purity = 0;
49 5         11 local $Data::Dumper::Pad = '';
50 5         9 local $Data::Dumper::Varname = 'VAR';
51 5         9 local $Data::Dumper::Useqq = 0;
52 5         12 local $Data::Dumper::Terse = 1;
53 5         10 local $Data::Dumper::Freezer = '';
54 5         9 local $Data::Dumper::Toaster = '';
55 5         10 local $Data::Dumper::Deepcopy = 1;
56 5         8 local $Data::Dumper::Quotekeys = 0;
57 5         9 local $Data::Dumper::Bless = 'bless';
58 5         9 local $Data::Dumper::Pair = ' => ';
59 5         7 local $Data::Dumper::Maxdepth = 0;
60 5         10 local $Data::Dumper::Maxrecurse = 1000;
61 5         9 local $Data::Dumper::Useperl = 0;
62 5         15 local $Data::Dumper::Sortkeys = 1;
63 5         12 local $Data::Dumper::Deparse = 1;
64 5         9 local $Data::Dumper::Sparseseen = 0;
65              
66 5         9 local $_ = $self;
67              
68 5 100       58 my $data = Data::Dumper->Dump([
69             $method ? scalar($self->$method(@args)) : $self
70             ]);
71              
72 5         409 $data =~ s/^'|'$//g;
73              
74 5         13 chomp $data;
75              
76 5         105 return $data;
77             }
78              
79             # EXPORTS
80              
81             sub EXPORT {
82 99     99 0 426 ['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(string | coderef $method, any @args) (string)
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(string | coderef $method, any @args) (string)
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, Awncorp, C.
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