view release on metacpan or  search on metacpan

lib/Archive/ByteBoozer.pm  view on Meta::CPAN

$EXPORT_TAGS{'crunch'} = [ qw(&crunch) ];
$EXPORT_TAGS{'all'} = [ @{$EXPORT_TAGS{'crunch'}} ];
our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} };
our @EXPORT = qw();

our $VERSION = '0.10';

use Data::Dumper;
use IO::Scalar;
use Params::Validate qw(:all);
use Scalar::Util qw(looks_like_number refaddr);

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

=head2 crunch

In order to crunch the data, you are required to provide source and target C<IO::> interfaces:

  my $original = new IO::File "original.prg", "r";
  my $crunched = new IO::File "crunched.prg", "w";

lib/Archive/ByteBoozer.pm  view on Meta::CPAN

    my $params = { @_ };
    validate(
        @_, {
            source                  => { type => HANDLE, isa => 'IO::Handle', callbacks => {
                is_not_the_same_as_target => sub { exists $_[1]->{target} && refaddr $_[0] != refaddr $_[1]->{target} },
            } },
            target                  => { type => HANDLE, isa => 'IO::Handle', callbacks => {
                is_not_the_same_as_source => sub { exists $_[1]->{source} && refaddr $_[0] != refaddr $_[1]->{source} },
            } },
            attach_decruncher       => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            make_executable         => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            precede_initial_address => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            relocate_output         => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            relocate_output_up_to   => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            replace_initial_address => { type => SCALAR, optional => 1, callbacks => {
                is_valid_memory_address   => sub { looks_like_number $_[0] && $_[0] >= 0x0000 && $_[0] <= 0xffff },
            } },
            verbose                 => { type => SCALAR, optional => 1, regex => qr/^\d+$/ },
        }
    );
    my $pos = _seek_and_tell($params->{source}, $params->{target});
    my $source_position = $pos->{source}->{get}->($params->{source});
    my $target_position = $pos->{target}->{get}->($params->{target});
    _read_file $params;
    _precede_initial_address $params;
    die "Error (I-3): no data to crunch in input stream, aborting" unless length $params->{_source_data} > 1;