File Coverage

blib/lib/Data/HexDump/XXD.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	5	8	62.5
condition	3	3	100.0
subroutine	8	8	100.0
pod	2	2	100.0
total	58	61	95.0

package Data::HexDump::XXD;

use version; our $VERSION = qv('0.1.1');

use warnings;
use strict;
use Carp;

use base 'Exporter';

our @EXPORT_OK = qw( xxd_pack xxd_r xxd_unpack xxd );

# Other recommended modules (uncomment to use):
#  use IO::Prompt;
#  use Perl6::Export;
#  use Perl6::Slurp;
#  use Perl6::Say;
#  use Regexp::Autoflags;
#  use Readonly;

# Module implementation here
sub _xxd_line {    # format a hex dump a-la xxd
   my ($counter, @octets) = @_;
   $counter = sprintf '%07x:', $counter;
   my ($hex, $dump);
   my @sep = ('', ' ');
   for my $i (0 .. $#octets) {
      $hex .= unpack('H*', $octets[$i]) . $sep[$i % 2];
      my $code = ord $octets[$i];
      $dump .= ($code >= 0x20 && $code < 0x7F) ? $octets[$i] : '.';
   }

   $hex .= ' ' x (40 - length $hex);
   return join ' ', $counter, $hex, $dump;
} ## end sub _xxd_line

sub xxd {
   my $length = length $_[0];
   my $offset = 0;
   my @retval;
   while ($offset < $length) {
      push @retval,
        _xxd_line($offset, split //, substr $_[0], $offset, 16);
      $offset += 16;
   }
   return @retval if wantarray;
   return join "\n", @retval;
} ## end sub xxd
*xxd_unpack = \&xxd;

sub xxd_r {
   my @retval;
   for my $line (scalar(@_) > 1 ? @_ : split /\n/, $_[0]) {
      my ($payload) = $line =~ m{\A\S+:\s (.*?) \s\s}xms;
      next unless defined $payload;
      $payload =~ s/\s//g;
      push @retval, pack 'H*', $payload;
   }
   return join '', @retval;
} ## end sub xxd_r
*xxd_pack = \&xxd_r;

1;    # Magic true value required at end of module
__END__