File Coverage

blib/lib/String/Dump.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	19	26	73.0
condition	6	12	50.0
subroutine	12	12	100.0
pod	6	6	100.0
total	87	100	87.0

package String::Dump;

use 5.006;
use strict;
use warnings;
use parent 'Exporter';
use charnames qw( :full );
use Carp;

our $VERSION = '0.09';
our @EXPORT  = qw( dump_hex dump_dec dump_oct dump_bin dump_names dump_codes );
our %EXPORT_TAGS = (all => \@EXPORT);

sub dump_hex {
    my ($str) = @_;
    carp('dump_hex() expects one argument') && return if @_ != 1;
    return unless defined $str;
    return sprintf '%*vX', ' ', $str;
}

sub dump_dec {
    my ($str) = @_;
    carp('dump_dec() expects one argument') && return if @_ != 1;
    return unless defined $str;
    return sprintf '%*vd', ' ', $str;
}

sub dump_oct {
    my ($str) = @_;
    carp('dump_oct() expects one argument') && return if @_ != 1;
    return unless defined $str;
    return sprintf '%*vo', ' ', $str;
}

sub dump_bin {
    my ($str) = @_;
    carp('dump_bin() expects one argument') && return if @_ != 1;
    return unless defined $str;
    return sprintf '%*vb', ' ', $str;
}

sub dump_names {
    my ($str) = @_;
    carp('dump_names() expects one argument') && return if @_ != 1;
    return unless defined $str;
    return join ', ',
           map { charnames::viacode(ord) || '?' }
           split '', $str;
}

sub dump_codes {
    my ($str) = @_;
    carp('dump_codes() expects one argument') && return if @_ != 1;
    return unless defined $str;
    return join ' ', map { sprintf 'U+%04X', ord } split '', $str;
}

1;

__END__