File Coverage

blib/lib/Data/ConversionChain.pm

Criterion	Covered	Total	%
statement	15	106	14.1
branch	0	32	0.0
condition	0	6	0.0
subroutine	5	19	26.3
pod	14	14	100.0
total	34	177	19.2

package Data::ConversionChain;

use 5.006;
use strict;
use warnings FATAL => 'all';

# For the developers debugging - will be removed in later versions
use Data::Dumper;

# Additional conversions
use Digest::SHA qw(sha1 sha224 sha256 sha384 sha512 sha512224 sha512256);

=head1 NAME

Data::ConversionChain - Create permanent conversion chains

=head1 VERSION

Version 0.04

=cut

our $VERSION = '0.04';

=head1 SYNOPSIS

NOTE I created this module to assist me with another and found it so useful and different I decided to release it, I am still actively working on it and input is welcome, but be warned it is no where near complete.

Data::ConversionChain Allows you to create data manipulation 'objects' for when you are working in a situation where you need to shift one type of data into another or adjust text in specific ways, it was mainly created because the owner hates pack, but it can be very useful for padding data binary/bytes/hex conversions and more.

Here is a code snippet for converting a standard number into an equivlent that would be generated by a signed int32 in perl, the output will be returned in hex.

   use Data::ConversionChain;

   my $n2h = Data::ConversionChain->new(qw( i32s hex ));

   my $result = $n2h->proc('34243');

   # result = c3850000

I will continue expanding this module including sha, md5 and the entire of pack's data types usable in what I class to be a far more friendly way.

=head1 Callable functions

=head2 new

Create a new basic object.

 my $sha2hex = Data::ConversionChain->new(qw( sha256 hex ));

=cut

sub new {
 my $class = shift;
 my $conv = [@_];

 if (scalar(@{ $conv }) == 0) {
  # Passed a blank new() make a template
  $conv->[0] = { input => 'ascii', conversion => [], output => 'ascii' };
 }
 elsif (scalar(@{ $conv }) > 0) {
  if (ref($conv->[0]) eq 'HASH') {
   # Ok passed full struct
   $conv = $conv->[0];
  } else {
   # Ok a conversion chain list
   $conv = { input => 'ascii', conversion => $conv, output => 'ascii' };
  }
 }

# warn Dumper($conv);

 if (!$conv->{input}) { $conv->{input} = 'ascii' }
 if (!$conv->{output}) { $conv->{output} = 'ascii' }
 if (!$conv->{conversion}) { $conv->{conversion} = [] }

 my $self = {
  config => {
   input => $conv->{input},
   output => $conv->{output},
   conversion => $conv->{conversion},
  },
 };

 if (ref($conv->{conversion}) eq 'ARRAY') {
  # Ok this is a conversion chain... so lets create another object
  my $head = shift @{ $conv->{conversion} };

  # Check for parameterized arguments
  my $cmdbase = $head;
  if ($head =~ m#^(.*?)\(#) { $cmdbase = $1 }

  # Keep the integrity of datatype incase of special conversions
  if ( defined Data::ConversionChain->cmddat($self,$cmdbase) ) {
   if ( my $datatype = Data::ConversionChain->cmddat($self,$cmdbase,'type') ) { $self->{config}->{datatype} = $datatype }
   else { $self->{config}->{datatype} = $conv->{input} }
  }
  else { $self->{config}->{datatype} = $head }

  $self->{config}->{conversion} = $head;
  if (scalar @{ $conv->{conversion} } > 0) {
   $self->{config}->{output} = Data::ConversionChain->new({
    input => $self->{config}->{datatype},
    conversion => $conv->{conversion},
    output => $conv->{output}
   });
  } else {
   $self->{config}->{output} = $self->{config}->{datatype};
  }
 }

 bless $self, $class;
}

=head2 proc

Feed data into the filter and get the conversion returned.

=cut

sub proc {
 my $self = shift;
 my $data = shift;

 my $conversion = $self->{config}->{conversion};

 my $cmd = $conversion;
 my @args = ();
 my $proc = "";

 if ($conversion =~ m#^(.*?)\((.*?)\)#) {
  $cmd = $1;
  @args = split(/,/,$2);
 }

 if ($self->cmddat($cmd,'ext')) {
  $proc = &{ $self->cmddat($cmd,'sub') }($data,@args);
 } else {
  $proc = &{ $self->cmddat($cmd,'sub') }($self,$data,@args);
 }

 return $self->output($proc);
# warn "Convert to: $newdata";
}


=head1 Datatype conversion filters

Usable in new in formation of a conversion chain.

=head2 i64u

Convert an object into the equivalent of an unsigned int64.

Requires: 1 argument

=cut

sub i64u {
 my $self = shift;
 my $data = shift;

 return pack('Q',$data);
}

=head2 i64s

Convert an object into the equivalent of an signed int64.

Requires: 1 argument

=cut

sub i64s {
 my $self = shift;
 my $data = shift;

 return pack('q',$data);
}

=head2 i32s

Convert an object into the equivalent of an signed int32.

Requires: 1 argument

=cut

sub i32s {
 my $self = shift;
 my $data = shift;

 return pack('l',$data);
}

=head2 i32u

Convert an object into the equivalent of an unsigned int32.

Requires: 1 argument

=cut

sub i32u {
 my $self = shift;
 my $data = shift;

 return pack('V',$data);
}

=head2 hex

Convert data into hex.

Requires: 0 arguments

=cut

sub hex {
 my $self = shift;
 my ($data) = @_;

 return unpack('H*',$data);
}

=head2 sha1

Required arguments: 0

Convert data to sha1 (BYTES).

=head2 sha256

Required arguments: 0

Convert data to sha256 (BYTES).

=head2 sha384

Required arguments: 0

Convert data to sha384 (BYTES).

=head2 sha512

Required arguments: 0

Convert data to sha512 (BYTES).

=head2 sha512224

Required arguments: 0

Convert data to sha512224 (BYTES).

=head2 sha512256

Required arguments: 0

Convert data to sha512256 (BYTES).

=head1 Data manipulation filters

=head2 pad_right

Required arguments: 2

Syntax: pad_right(LENGTH,PAD_CHARACTER)

Pad the right hand side of the supplied data with ARG1 upto a length of ARG0.

=cut

sub pad_right {
 my $self = shift;
 my ($data,$length,$char) = @_;

 while(length($data) < $length) { $data .= $char }

 return $data;
}

=head2 pad_left

Required arguments: 2

Syntax: pad_left(LENGTH,PAD_CHARACTER)

Pad the left hand side of the supplied data with ARG1 upto a length of ARG0.

=cut

sub pad_left {
 my $self = shift;
 my ($data,$length,$char) = @_;

 while(length($data) < $length) { $data = $char.$data; }

 return $data;
}

=head2 truncate_right

Truncate text treating the right hand side of the data block as the start point.

Required arguments: 1

Syntax: truncate_right(10)

=cut

sub truncate_right {
 my $self = shift;
 my ($data,$length) = @_;

 return substr $data, (length($data) - $length);
}

=head2 truncate_left

Truncate text treating the left hand side of the data block as the start point.

=cut

sub truncate_left {
 my $self = shift;
 my ($data,$length) = @_;

 return substr $data, 0, $length;
}

=head1 Internal callable functions

These are used internally by the module, do not call them directly unless you have a very good reason!

=head2 input

Tell the object what it can expect on its input, this is very rarely required or used.

=cut

sub input {}

=head2 output

Send data through the output chain or return if the last object in the chain.

=cut

sub output {
 my $self = shift;
 my $data = shift;

 if ( ref($self->{config}->{output}) eq 'Data::ConversionChain' ) {
  return $self->{config}->{output}->proc($data);
 }

 return $data;
}


=head2 cmddat

Receive information back or sub references for data types.

=cut

sub cmddat {
 my $self = shift;
 my ($cmd,$type) = @_;

 my $cmdset = {
  pad_right => {
   sub => \&pad_right,
   type => "",
  },
  pad_left => {
   sub => \&pad_left,
   type => "",
  },
  truncate_left => {
   sub => \&truncate_left,
   type => "",
  },
  truncate_right => {
   sub => \&truncate_right,
   type => "",
  },
  md5 => {
   sub => \&md5,
   type => 'bytes',
  },
  hex => {
   sub => \&hex,
   type => 'hex',
  },
  i64s => {
   sub => \&i64s,
   type => 'bytes'
  },
  i64u => {
   sub => \&i64u,
   type => 'bytes',
  },
  i32s => {
   sub => \&i32s,
   type => 'bytes'
  },
  i32u => {
   sub => \&i32u,
   type => 'bytes',
  },
  sha1 => {
   sub => \&sha1,
   type => 'bytes',
   ext => 1,
  },
  sha224 => {
   sub => \&sha224,
   type => 'bytes',
   ext => 1,
  },
  sha256 => {
   sub => \&sha256,
   type => 'bytes',
   ext => 1,
  },
  sha384 => {
   sub => \&sha384,
   type => 'bytes',
   ext => 1,
  },
  sha512 => {
   sub => \&sha512,
   type => 'bytes',
   ext => 1,
  },
  sha512224 => {
   sub => \&sha512224,
   type => 'bytes',
   ext => 1,
  },
  sha512256 => {
   sub => \&sha512256,
   type => 'bytes',
   ext => 1,
  },
 };

 return 1 if ( (!$type) && ($cmdset->{$cmd}) );
 return 0 if ( (!$type) && (!$cmdset->{$cmd}) );

 return $cmdset->{$cmd}->{$type};
}


=head1 AUTHOR

Paul G Webster, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Data::ConversionChain


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2014 Paul G Webster.

This program is distributed under the (Revised) BSD License:
L

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

* Neither the name of Paul G Webster's Organization
nor the names of its contributors may be used to endorse or promote
products derived from this software without specific prior written
permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


=cut

1; # End of Data::ConversionChain