File Coverage

lib/Data/HexDump.pm
Criterion Covered Total %
statement 86 110 78.1
branch 29 50 58.0
condition 21 39 53.8
subroutine 12 15 80.0
pod 0 8 0.0
total 148 222 66.6


line stmt bran cond sub pod time code
1             # -*- mode: Perl -*-
2              
3             ##########################################################################
4             #
5             # HexDump.pm - Hexadecial Dumper
6             #
7             # Copyright (c) 1998, 1999, Fabien Tassin
8             ##########################################################################
9             # ABSOLUTELY NO WARRANTY WITH THIS PACKAGE. USE IT AT YOUR OWN RISKS.
10             ##########################################################################
11              
12             package Data::HexDump;
13             $Data::HexDump::VERSION = '0.02_01'; # TRIAL
14              
15 2     2   881 $Data::HexDump::VERSION = '0.0201';use 5.006;
  2         13  
16 2     2   9 use strict;
  2         3  
  2         37  
17 2     2   7 use warnings;
  2         3  
  2         72  
18              
19 2     2   984 use parent 'Exporter';
  2         641  
  2         8  
20 2     2   105 use Carp;
  2         4  
  2         219  
21 2     2   949 use FileHandle;
  2         19655  
  2         13  
22              
23             our @EXPORT = qw( HexDump );
24              
25             sub new {
26 12     12 0 7112 my $this = shift;
27 12   33     42 my $class = ref($this) || $this;
28 12         18 my $self = {};
29 12         22 bless $self, $class;
30 12         28 $self->{'readsize'} = 128;
31 12         21 return $self;
32             }
33              
34             sub DESTROY {
35 12     12   6817 my $self = shift;
36 12 50       84 $self->{'fh'}->close if defined $self->{'file'};
37             }
38              
39             sub file {
40 0     0 0 0 my $self = shift;
41 0         0 my $file = shift;
42 0 0       0 $self->{'file'} = $file if defined $file;
43 0         0 $self->{'file'};
44             }
45              
46             sub fh {
47 0     0 0 0 my $self = shift;
48 0         0 my $fh = shift;
49 0 0       0 $self->{'fh'} = $fh if defined $fh;
50 0         0 $self->{'fh'};
51             }
52              
53             sub data {
54 12     12 0 17 my $self = shift;
55 12         20 my $data = shift;
56 12 50       27 $self->{'data'} = $data if defined $data;
57 12         15 $self->{'data'};
58             }
59              
60             sub block_size {
61 0     0 0 0 my $self = shift;
62 0         0 my $bs = shift;
63 0 0       0 $self->{'blocksize'} = $bs if defined $bs;
64 0         0 $self->{'blocksize'};
65             }
66              
67             sub dump {
68 12     12 0 16 my $self = shift;
69              
70 12         28 my $out;
71             my $l;
72 12 50       29 $self->{'i'} = 0 unless defined $self->{'i'};
73 12 50       25 $self->{'j'} = 0 unless defined $self->{'j'};
74 12         15 my $i = $self->{'i'};
75 12         14 my $j = $self->{'j'};
76 12 50 33     36 unless ($i || $j) {
77 12         21 $out = " ";
78 12         16 $l = "";
79 12         26 for (my $i = 0; $i < 16; $i++) {
80 192         252 $out .= sprintf "%02X", $i;
81 192 100       332 $out .= " " if $i < 15;
82 192 100       249 $out .= "- " if $i == 7;
83 192         325 $l .= sprintf "%X", $i;
84             }
85 12         16 $i = $j = 0;
86 12         25 $out .= " $l\n\n";
87             }
88 12 50       30 return undef if $self->{'eod'};
89 12         36 $out .= sprintf "%08X ", $j * 16;
90 12         15 $l = "";
91 12         15 my $val;
92 12         23 while ($val = $self->get) {
93 80   66     250 while (length $val && defined (my $v = substr $val, 0, 1, '')) {
94 8912         10463 $out .= sprintf "%02X", ord $v;
95 8912 100       9942 $out .= " " if $i < 15;
96             $out .= "- " if $i == 7 &&
97 8912 100 66     9963 (length $val || !($self->{'eod'} || length $val));
      66        
98 8912         6401 $i++;
99 8912 100 100     15554 $l .= ord($v) >= 0x20 && ord($v) <= 0x7E ? $v : ".";
100 8912 100       21376 if ($i == 16) {
101 551         434 $i = 0;
102 551         427 $j++;
103 551         551 $out .= " " . $l;
104 551         480 $l = "";
105 551         434 $out .= "\n";
106 551 0 33     646 if (defined $self->{'blocksize'} && $self->{'blocksize'} &&
      0        
107             ($j - $self->{'j'}) > $self->{'blocksize'} / 16) {
108 0         0 $self->{'i'} = $i;
109 0         0 $self->{'j'} = $j;
110 0         0 $self->{'val'} = $val;
111 0         0 return $out;
112             }
113             $out .= sprintf "%08X ", $j * 16 if length $val || !length $val &&
114 551 100 66     1921 !$self->{'eod'};
      100        
115             }
116             }
117             }
118 12 100 33     36 if ($i || (!$i && !$j)) {
      66        
119 10         26 $out .= " " x (3 * (17 - $i) - 2 * ($i > 8));
120 10         16 $out .= "$l\n";
121             }
122 12         18 $self->{'i'} = $i;
123 12         14 $self->{'j'} = $j;
124 12         20 $self->{'val'} = $val;
125 12         104 return $out;
126             }
127              
128             # get data from different sources (scalar, filehandle, file..)
129             sub get {
130 92     92 0 99 my $self = shift;
131              
132 92         71 my $buf;
133 92         93 my $length = $self->{'readsize'};
134 92 50 33     144 undef $self->{'val'} if defined $self->{'val'} && ! length $self->{'val'};
135 92 50       139 if (defined $self->{'val'}) {
    50          
    0          
    0          
136 0         0 $buf = $self->{'val'};
137 0         0 undef $self->{'val'};
138             }
139             elsif (defined $self->{'data'}) {
140 92 100       122 $self->{'data_offs'} = 0 unless defined $self->{'data_offs'};
141 92         89 my $offset = $self->{'data_offs'};
142 92         133 $buf = substr $self->{'data'}, $offset, $length;
143 92         88 $self->{'data_offs'} += length $buf;
144 92 100       142 $self->{'eod'} = 1 if $self->{'data_offs'} == length $self->{'data'};
145             }
146             elsif (defined $self->{'fh'}) {
147 0         0 read $self->{'fh'}, $buf, $length;
148 0         0 $self->{'eod'} = eof $self->{'fh'};
149             }
150             elsif (defined $self->{'file'}) {
151 0         0 $self->{'fh'} = FileHandle->new($self->{'file'});
152 0         0 read $self->{'fh'}, $buf, $length;
153 0         0 $self->{'eod'} = eof $self->{'fh'};
154             }
155             else {
156 0         0 print "Not yet implemented\n";
157             }
158 92         188 $buf;
159             }
160              
161             sub HexDump ($) {
162 11     11 0 283 my $val = shift;
163              
164 11         38 my $f = Data::HexDump->new();
165 11         25 $f->data($val);
166 11         25 $f->dump;
167             }
168              
169             1;
170              
171             =head1 NAME
172              
173             Data::HexDump - Hexadecial Dumper
174              
175             =head1 SYNOPSIS
176              
177             use Data::HexDump;
178              
179             my $buf = "foo\0bar";
180             print HexDump($buf);
181              
182             which produces:
183              
184             00 01 02 03 04 05 06 07 - 08 09 0A 0B 0C 0D 0E 0F 0123456789ABCDEF
185              
186             00000000 23 21 2F 75 73 72 2F 62 - 69 6E 2F 70 65 72 6C 0A #!/usr/bin/perl.
187             00000010 75 73 65 20 73 74 72 69 - 63 74 3B 0A 75 73 65 20 use strict;.use
188             00000020 77 61 72 6E 69 6E 67 73 - 3B 0A 0A 70 72 69 6E 74 warnings;..print
189             00000030 20 22 48 65 6C 6C 6F 2C - 20 77 6F 72 6C 64 5C 6E "Hello, world\n
190             00000040 22 3B 0A ";.
191              
192              
193             =head1 DESCRIPTION
194              
195             This module will generate a hexadecimal dump of a data string or file.
196             You can either use the exported function,
197             as shown in the SYNOPSIS above,
198             or the OO interface, described below.
199              
200             The result is returned in a string.
201             Each line of the result consists of the offset in the
202             source in the leftmost column of each line,
203             followed by one or more columns of data from the source in hexadecimal.
204             The rightmost column of each line shows the printable characters
205             (all others are shown as single dots).
206              
207             =head2 Functional Interface
208              
209             This module exports a single function, C,
210             which takes a scalar value and returns a string which
211             contains the hexdump of the passed data.
212              
213              
214             =head2 OO Interface
215              
216             You first construct a C object,
217             then tell it where to get the data from,
218             and then generate the hex dump:
219              
220             my $dh = Data::HexDump->new();
221              
222             $dh->data($scalar); # dump the data in this scalar
223             $dh->fh($fh); # read this filehandle
224             $dh->file($filename); # read this file and dump contents
225              
226             print while $_ = $f->dump;
227              
228             The different potential sources for data are considered
229             in the order given above,
230             so if you pass to the C method,
231             then any subsequent calls to C or C
232             will have no effect.
233              
234             =head1 SEE ALSO
235              
236             L, by Johan Vromans, is another simple option,
237             similar to this module. Last release in 2004.
238              
239             L (by David Cantrell, DCANTRELL)
240             is another hex dumper,
241             with more features than this module.
242              
243             L (by Kent Fredric, RIP)
244             provides a script which gives colourised output
245             with character class highlighting.
246              
247             L provides more functions, colour output,
248             and the ability to skip uninteresting parts of the input data.
249              
250             L provides hex dumps like xxd.
251             It doesn't say what xxd is, or provide a link,
252             and there's no example output.
253             But if you know and like xxd, this might be the one for you!
254              
255             L provides some configuration options,
256             but there are other more featured modules,
257             and this one doesn't have example output in the doc.
258              
259             L will convert ASCII strings to hex and reverse.
260              
261              
262             =head1 AUTHOR
263              
264             Fabien Tassin Efta@oleane.netE
265              
266              
267             =head1 COPYRIGHT
268              
269             Copyright (c) 1998-1999 Fabien Tassin. All rights reserved.
270             This program is free software; you can redistribute it and/or
271             modify it under the same terms as Perl itself.
272              
273             =cut