Hexdump.pm

package Hexdump;
use strict;
use warnings;
use Exporter;
our @ISA=qw(Exporter);
use Carp;

our @EXPORT=qw(hexdump ascdump);
sub hexbytes {
    my $str= unpack("H*", $_[0]);
    $str =~ s/\w\w/$& /g;
    $str =~ s/ $//;
    return $str;
}
sub ascbytes {
    my $str= $_[0];
    $str =~ s/[^ -~]/./g;
    return $str;
}
sub hexdump {
    my @lines;
    my $same;
    my $ofs=$_[1] || 0;
    push @lines, sprintf("%s  %s", hexbytes(substr($_[0],$_*16,16)), ascbytes(substr($_[0],$_*16,16))) for 0..length($_[0])/16-1;
    for (0..$#lines) {
        if ($_ && $lines[$_-1] eq $lines[$_]) {
            if (!$same) {
                printf("*\n");
            }
            $same=1;
        }
        else {
            printf("%04x: %s\n", $ofs+$_*16, $lines[$_]);
            $same=0;
        }
    }
}
sub ascdump {
    my $ofs= $_[1] || 0;
    my %esc= (
        "\n"=>'n',
        "\r"=>'r',
        "\t"=>'t',
        "\n"=>'n',
        "\0"=>'0',
        "\\"=>'\\',
    );
    my $pos;
    while ($_[0] =~ /.*?[\r\n\x00]+/gs) {
        my $line= $&;
        my $epos= pos($_[0]);
        my $len= length($line);
        my $spos= $epos-$len;
        if ($spos!=$pos) {
            printf("W: %x!=%x\n", $spos, $pos);
        }

        $line =~ s/./exists $esc{$&}?"\\$esc{$&}":$&/gse;
        printf("%04x: %s\n", $ofs+$spos, $line);
        $pos= $epos;
    }
    my $line= substr($_[0], $pos);
    $line =~ s/./exists $esc{$&}?"\\$esc{$&}":$&/gse;
    printf("%04x: %s\n", $ofs+$pos, $line);
}
1;