File Coverage

blib/lib/Unicode/Peek.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	4	6	66.6
condition			n/a
subroutine	15	15	100.0
pod	0	4	0.0
total	61	67	91.0

package Unicode::Peek;

## Validate the version of Perl

BEGIN { die 'Perl version 5.13.2 or greater is required' if ($] < 5.013002); }

use strict;
use warnings;

require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Unicode::Peek ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );

our @EXPORT_OK = qw (
    ascii2hexEncode
    hex2ascciiDecode
    hexDumperOutput
    hexDumperInput
    );

## Version of Unicode::Peek module

our $VERSION = '0.08';
$VERSION = eval $VERSION;

## Load necessary modules
use utf8;
use Carp;
use feature 'say';
use Encode qw(decode encode);

binmode( STDOUT, ':utf8' ); # debuggin purposes

my @unicodes = ( 'UCS-2',
		 'UCS-2BE',
		 'UCS-2LE',
		 'UCS-4',
		 'UTF-7',
		 'utf8',
		 'utf-8-strict',
		 'UTF-8',
		 'UTF-16',
		 'UTF-16BE',
		 'UTF-16LE',
		 'UTF-32',
		 'UTF-32BE',
		 'UTF-32LE' );

sub _checkSubroutineParameters {
    croak "Please pass only two parameters '@_'"
	if scalar @_ != 2;

    croak "Unknown encoding format '$_[0]'"
	unless (grep { /$_[0]/ } @unicodes);

    return $_[0], $_[1];
}

sub _ascii2hex {
    return unpack("H*", $_[0]);
}

sub _hex2ascii {
    return pack("H*", $_[0]);
}

sub hexDumperOutput {
    my ( $unicodeFormat , $data ) = _checkSubroutineParameters(@_);
    my $hexString = ascii2hexEncode( $unicodeFormat , $data );
    # trim leading and trailing white space
    # split string every two characters
    # join the splitted characters with white space
    $hexString = join(' ', split(/(..)/, $hexString))
	=~ s/^\s+|\s+$//r =~ y/ / /rs;
    # insert new line character every 30 characters
    # return join("\n", unpack('(A30)*', $hexString));
    push my @aref, unpack('(A30)*', $hexString);
    return \@aref;
}

sub hexDumperInput {
    my ( $unicodeFormat , $arrayRef ) = _checkSubroutineParameters(@_);
    my $hexString = join('', split(/ /, join('', @$arrayRef)));
    return hex2ascciiDecode($unicodeFormat, $hexString);
}

sub ascii2hexEncode {
    my ( $unicodeFormat , $data ) = _checkSubroutineParameters(@_);
    my $octets = encode( $unicodeFormat , $data );
    return _ascii2hex( $octets );
}

sub hex2ascciiDecode {
    my ( $unicodeFormat , $data ) = _checkSubroutineParameters(@_);
    my $hex2ascciiString = _hex2ascii( $data );
    return decode( $unicodeFormat , $hex2ascciiString );
}

1;

__END__