File Coverage

blib/lib/Data/HexDump/Range/Format.pm
Criterion Covered Total %
statement 28 59 47.4
branch 0 14 0.0
condition 0 6 0.0
subroutine 10 13 76.9
pod 1 3 33.3
total 39 95 41.0


line stmt bran cond sub pod time code
1              
2             package Data::HexDump::Range ; ## no critic (Modules::RequireFilenameMatchesPackage)
3              
4 2     2   9 use strict;
  2         3  
  2         76  
5 2     2   7 use warnings ;
  2         5  
  2         53  
6 2     2   8 use Carp ;
  2         2  
  2         145  
7              
8             BEGIN
9 2     2   30 {
10              
11 2         27 use Sub::Exporter -setup =>
12             {
13             exports => [ qw() ],
14             groups =>
15             {
16             all => [ qw() ],
17             }
18 2     2   9 };
  2         2  
19            
20 2     2   1001 use vars qw ($VERSION);
  2         3  
  2         68  
21             }
22              
23             #-------------------------------------------------------------------------------
24              
25 2     2   8 use English qw( -no_match_vars ) ;
  2         3  
  2         13  
26              
27 2     2   586 use Readonly ;
  2         2  
  2         118  
28             Readonly my $EMPTY_STRING => q{} ;
29              
30 2     2   10 use Carp qw(carp croak confess) ;
  2         2  
  2         69  
31              
32 2     2   1139 use Text::Colorizer ;
  2         6308  
  2         21  
33              
34             #-------------------------------------------------------------------------------
35              
36             =head1 NAME
37              
38             Data::HexDump::Range::Format - Handles formating for Data::HexDump::Range
39              
40             =head1 SUBROUTINES/METHODS
41              
42             Subroutines prefixed with B<[P]> are not part of the public API and shall not be used directly.
43              
44             =cut
45              
46             #-------------------------------------------------------------------------------
47              
48             sub get_bg_color
49             {
50              
51             =head2 [P] get_bg_color()
52              
53             Returns the default bg color
54              
55             I - None
56              
57             I - A string - a color according to the COLOR option and FORMAT
58              
59             I - None
60              
61             =cut
62              
63 0     0 0   my ($self) = @_ ;
64              
65 0           return $self->{COLORS}{$self->{FORMAT}}[-1] ;
66             }
67              
68             #-------------------------------------------------------------------------------
69              
70             sub get_default_color
71             {
72              
73             =head2 [P] get_default_color($color)
74              
75             Returns a color to use with a range that has none, only if $color is not defined
76              
77             my $default_color = $self->get_default_color($color) ;
78              
79             I - $color - scalar - a color name or undef
80              
81             I - A string - a color according to the COLOR option and FORMAT
82              
83             I - None
84              
85             =cut
86              
87 0     0 0   my ($self, $color) = @_ ;
88              
89 0           my $default_color ;
90              
91 0 0         if($self->{COLOR} eq 'cycle')
    0          
    0          
92             {
93 0   0       $default_color = $color || $self->{COLORS}{$self->{FORMAT}}[$self->{CURRENT_COLOR_INDEX}] ;
94            
95 0           $self->{CURRENT_COLOR_INDEX}++ ;
96 0 0         $self->{CURRENT_COLOR_INDEX} = 0 if $self->{CURRENT_COLOR_INDEX} >= @{$self->{COLORS}{$self->{FORMAT}}} ;
  0            
97             }
98             elsif($self->{COLOR} eq 'no_cycle')
99             {
100 0   0       $default_color = $color || $self->{COLORS}{$self->{FORMAT}}[-1] ;
101             }
102             elsif($self->{COLOR} eq 'bw')
103             {
104 0           $default_color = $self->{COLORS}{$self->{FORMAT}}[-1] ;
105             }
106             else
107             {
108 0           $self->{INTERACTION}{DIE}("Error: Invalid COLOR format.\n") ;
109             }
110            
111 0           return $default_color ;
112             }
113              
114             #-------------------------------------------------------------------------------
115              
116             sub format ## no critic (Subroutines::ProhibitBuiltinHomonyms)
117             {
118            
119             =head2 [P] format($line_data)
120              
121             Transform the line data into ANSI, ASCII or HTML
122              
123             I -
124              
125             =over 2
126              
127             =item * \%line_data - See L
128              
129             =back
130              
131             I - A dump in ANSI, ASCII or HTML.
132              
133             =cut
134              
135 0     0 1   my ($self, $line_data) = @_ ;
136              
137 0           my @colors ;
138 0 0         push @colors, 'COLORS' => $self->{COLOR_NAMES} if defined $self->{COLOR_NAMES} ;
139              
140 0           my $colorizer = Text::Colorizer->new
141             (
142             FORMAT => $self->{FORMAT},
143             @colors,
144             ) ;
145              
146 0           my @colored_lines ;
147              
148 0           my @fields = @{$self->{FIELDS_TO_DISPLAY}} ;
  0            
149 0           unshift @fields, 'INFORMATION', 'RULER' ;
150              
151 0           for my $line (@{$line_data})
  0            
152             {
153 0           for my $field (@fields)
154             {
155 0 0         if(exists $line->{$field})
156             {
157 0           for my $range (@{$line->{$field}})
  0            
158             {
159 0           push @colored_lines, $range->{"${field}_COLOR"}, $range->{$field} ,
160             }
161            
162 0           push @colored_lines, $EMPTY_STRING, q{ } ;
163             }
164             }
165            
166 0 0         push @colored_lines, $EMPTY_STRING, "\n" if $line->{NEW_LINE} ;
167             }
168              
169 0           return $colorizer->color(@colored_lines) ;
170             }
171              
172             #-------------------------------------------------------------------------------
173              
174             1 ;
175              
176             =head1 BUGS AND LIMITATIONS
177              
178             None so far.
179              
180             =head1 AUTHOR
181              
182             Nadim ibn hamouda el Khemir
183             CPAN ID: NKH
184             mailto: nadim@cpan.org
185              
186             =head1 COPYRIGHT AND LICENSE
187              
188             Copyright Nadim Khemir 2010-2012.
189              
190             This program is free software; you can redistribute it and/or
191             modify it under the terms of either:
192              
193             =over 4
194              
195             =item * the GNU General Public License as published by the Free
196             Software Foundation; either version 1, or (at your option) any
197             later version, or
198              
199             =item * the Artistic License version 2.0.
200              
201             =back
202              
203             =head1 SUPPORT
204              
205             You can find documentation for this module with the perldoc command.
206              
207             perldoc Data::HexDump::Range
208              
209             You can also look for information at:
210              
211             =over 4
212              
213             =item * AnnoCPAN: Annotated CPAN documentation
214              
215             L
216              
217             =item * RT: CPAN's request tracker
218              
219             Please report any bugs or feature requests to L .
220              
221             We will be notified, and then you'll automatically be notified of progress on
222             your bug as we make changes.
223              
224             =item * Search CPAN
225              
226             L
227              
228             =back
229              
230             =head1 SEE ALSO
231              
232             L
233              
234             =cut