Archive-ByteBoozer

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    - make test suite pass for the latest version of Params::Validate (>= 1.21)

0.07  2013-09-21
    - switched IO::Capture to Capture::Tiny, which is able to correctly capture
      contents written into the standard output file handle
    - fixed two randomly failing unit-tests, removed one duplicate test case
    - fixed "Use of uninitialized value in subroutine entry" warning during
      test suite execution

0.06  2013-06-15
    - introduced an additional "crunch" parameter named "relocate_output_up_to",
      allowing to relocate compressed data to the given end address (as opposite
      to the "relocate_output", which relocates data to the given start address)

0.05  2013-01-16
    - fixed "undefined symbol 'mXPUSHs'" compilation error for Perl 5.10.0 by
      removing "mXPUSHs()" macro from the XS code (according to perl5101delta
      "mXPUSHs()" macro for pushing SVs on the stack and mortalizing them has
      been introduced in Perl 5.10.1)

0.04  2013-01-13
    - fixed "error: two or more data types in declaration specifiers"
      compilation error on FreeBSD by reordering include directives in

MANIFEST  view on Meta::CPAN

file.h
Makefile.PL
MANIFEST
README
typemap
lib/Archive/ByteBoozer.pm
t/01-basic.t
t/02-param-check.t
t/03-cruncher.t
t/04-decruncher.t
t/05-relocate-output-up-to.t
META.yml                                 Module YAML meta-data (added by MakeMaker)
META.json                                Module JSON meta-data (added by MakeMaker)

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

  # Crunch data replacing the first two bytes with the new initial address first:
  my $initial_address = 0x4000;
  crunch(source => $original, target => $crunched, replace_initial_address => $initial_address);

  # Attach decruncher with the given execute program address:
  my $program_address = 0x0c00;
  crunch(source => $original, target => $crunched, attach_decruncher => $program_address);

  # Relocate compressed data to the given start address:
  my $start_address = 0x0800;
  crunch(source => $original, target => $crunched, relocate_output => $start_address);

  # Relocate compressed data to the given end address:
  my $end_address = 0x2800;
  crunch(source => $original, target => $crunched, relocate_output_up_to => $end_address);

  # Enable verbose output while crunching data:
  my $verbose = 1;
  crunch(source => $original, target => $crunched, verbose => $verbose);

=head1 DESCRIPTION

David Malmborg's "ByteBoozer" is a data cruncher for Commodore files written in C. In Perl the following operations are implemented via C<Archive::ByteBoozer> package:

=over

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


In addition to the source and target C<IO::> interfaces, which are mandatory arguments to the C<crunch> subroutine call, the following parameters are recognized:

=head3 attach_decruncher

C<attach_decruncher> enables to attach decruncher procedure with the given program start address:

  my $program_address = 0x0c00;
  crunch(source => $in, target => $out, attach_decruncher => $program_address);

This will create an executable BASIC file that is by default loaded into the memory area beginning at $0801 (assuming no output relocation has been requested), and jumping directly to the given execute program address of $0c00 upon completion of the ...

=head3 make_executable

C<make_executable> is an alias for C<attach_decruncher>:

  my $program_address = 0x3600;
  crunch(source => $in, target => $out, make_executable => $program_address);

=head3 relocate_output

C<relocate_output> is used for setting up a new start address of the compressed data (by default data is shifted and aligned to fill in the memory up to the address of $fff9):

    my $start_address = 0x0800;
    crunch(source => $in, target => $out, relocate_output => $start_address);

This will relocate compressed data to the given start address of $0800 by writing an appropriate information in the output stream.

=head3 relocate_output_up_to

C<relocate_output_up_to> is used for setting up a new start address of the compressed data by shifting it up to the given end address (by default data is shifted and aligned to fill in the memory up to the address of $fff9, however you might want to ...

  my $end_address = 0x2800;
  crunch(source => $original, target => $crunched, relocate_output_up_to => $end_address);

This will relocate compressed data to some address below $2800 by writing an appropriate information in the output stream.

In the above example the following assumptions are true: your source code or other used data begins at $2800 and you want to load your compressed soundtrack file somewhere between $1000 and $2800, however you may still want to execute your decrunchin...

C<relocate_output_up_to> and C<relocate_output> parameters are mutually exclusive. C<relocate_output_up_to> always takes precedence over C<relocate_output>.

=head3 precede_initial_address

C<precede_initial_address> adds given initial address at the beginning of an input stream, so this option can be used for setting up start address on the target device upon decrunching compressed data. If you are targetting a raw stream of bytes with...

    my $initial_address = 0x2000;
    crunch(source => $in, target => $out, precede_initial_address => $initial_address);

Before crunching algorithm is applied, data will be here prepended with the given initial address of $2000 first. This given initial address should be understood as the start address of the unpacked data (this is exactly where your compressed data is...

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


sub _precede_initial_address {
    my ($params) = @_;
    my $precede_initial_address = $params->{precede_initial_address};
    return unless defined $precede_initial_address;
    my @memory_address = _memory_address_bytes($precede_initial_address);
    substr $params->{_source_data}, 0, 0, join '', @memory_address;
    return;
}

sub _get_address_to_relocate_output_up_to {
    my ($params) = @_;
    my $data_length = length ($params->{_crunched_data}) - 0x02;
    my $relocate_output_up_to = $params->{relocate_output_up_to};
    my $address_to_relocate_data = $relocate_output_up_to - $data_length;
    return $address_to_relocate_data;
}

sub _relocate_output {
    my ($params) = @_;
    my $relocate_output = $params->{relocate_output};
    my $relocate_output_up_to = $params->{relocate_output_up_to};
    return unless defined $relocate_output || defined $relocate_output_up_to;
    my $address_to_relocate_data =
        defined $relocate_output_up_to ? _get_address_to_relocate_output_up_to($params) : $relocate_output;
    my @memory_address = _memory_address_bytes($address_to_relocate_data);
    substr $params->{_crunched_data}, 0, 2, join '', @memory_address;
    return;
}

sub _replace_initial_address {
    my ($params) = @_;
    my $replace_initial_address = $params->{replace_initial_address};
    return unless defined $replace_initial_address;
    my @memory_address = _memory_address_bytes($replace_initial_address);
    substr $params->{_source_data}, 0, 2, join '', @memory_address;

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

            } },
            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;
    _replace_initial_address $params;
    _attach_decruncher $params;
    _crunch_data $params;
    _relocate_output $params;
    _write_file $params;
    $pos->{source}->{set}->($params->{source}, $source_position);
    $pos->{target}->{set}->($params->{target}, $target_position);
    if (defined $params->{verbose} && $params->{verbose} == 1) {
        printf("[Archive::ByteBoozer] Compressed %u bytes into %u bytes.\n", length $params->{_source_data}, length $params->{_crunched_data});
    }
    return;
}

sub _seek_and_tell {

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


=head1 EXAMPLES

Compress a PRG file named "part-1.prg", replace its start address with $2000 (this is where the data will be uncompressed to), move all packed bytes to $f000 (this will be written into loading address of the output file), and save crunched data into ...

  use Archive::ByteBoozer qw/crunch/;

  my $source            = new IO::File "part-1.prg", "r";
  my $target            = new IO::File "part-1.crunched.prg", "w";
  my $unpacking_address = 0x2000;
  my $relocate_address  = 0xf000;

  crunch(
    source                  => $source,
    target                  => $target,
    replace_initial_address => $unpacking_address,
    relocate_output         => $relocate_address,
  );

=head1 BUGS

There are no known bugs at the moment. Please report any bugs or feature requests.

=head1 EXPORT

C<Archive::ByteBoozer> exports nothing by default.

t/02-param-check.t  view on Meta::CPAN

        sub { crunch(%params) },
        qr/is_valid_memory_address/,
        'exceeding initial address to precede data',
    );
}
#########################
{
    my $in = new IO::Handle;
    my $out = new IO::Handle;
    my $start_address = '0xz0c00';
    my %params = (source => $in, target => $out, relocate_output => $start_address);
    throws_ok(
        sub { crunch(%params) },
        qr/is_valid_memory_address/,
        'invalid start address to relocate the compressed data',
    );
}
#########################
{
    my $in = new IO::Handle;
    my $out = new IO::Handle;
    my $start_address = -1;
    my %params = (source => $in, target => $out, relocate_output => $start_address);
    throws_ok(
        sub { crunch(%params) },
        qr/is_valid_memory_address/,
        'negative start address to relocate the compressed data',
    );
}
#########################
{
    my $in = new IO::Handle;
    my $out = new IO::Handle;
    my $start_address = 0x10000;
    my %params = (source => $in, target => $out, relocate_output => $start_address);
    throws_ok(
        sub { crunch(%params) },
        qr/is_valid_memory_address/,
        'exceeding start address to relocate the compressed data',
    );
}
#########################
{
    my $in = new IO::Handle;
    my $out = new IO::Handle;
    my $initial_address = '0xz0c00';
    my %params = (source => $in, target => $out, replace_initial_address => $initial_address);
    throws_ok(
        sub { crunch(%params) },

t/03-cruncher.t  view on Meta::CPAN

    my $expected_message = '[Archive::ByteBoozer] Compressed 7 bytes into 12 bytes.';
    is($stdout, $expected_message, 'enabling verbose output while crunching data');
}
#########################
{
    my @data = (0x00, 0x10, 0x01, 0x02, 0x03, 0x04, 0x05);
    my $data = join '', map { chr $_ } @data;
    my $in = new IO::Scalar \$data;
    my $out = new IO::Scalar;
    my $new_start_address = 0xabcd;
    my %params = (source => $in, target => $out, relocate_output => $new_start_address);
    crunch(%params);
    my $crunched_data = <$out>;
    my @crunched_data = split '', $crunched_data;
    my @expected_data = map { chr $_ } (0xcd, 0xab, 0x58, 0x00, 0x10, 0xbf, 0x01, 0x02, 0x03, 0x04, 0x05, 0xff);
    cmp_deeply(\@crunched_data, \@expected_data, 'relocating compressed data to the given start address');
}
#########################
{
    my @data = (0x01, 0x02, 0x03, 0x04, 0x05);
    my $data = join '', map { chr $_ } @data;
    my $in = new IO::Scalar \$data;
    my $out = new IO::Scalar;
    my $initial_address = 0x2468;
    my %params = (source => $in, target => $out, precede_initial_address => $initial_address);
    crunch(%params);

t/05-relocate-output-up-to.t  view on Meta::CPAN

    my $hex_data_dump = join ',', map { sprintf q{$%02x}, ord $_ } @data;
    return $hex_data_dump;
}
#########################
{
    my @data = (0x00, 0x10, 0x01, 0x01, 0x01, 0x01, 0x01);
    my $data = join '', map { chr $_ } @data;
    my $in = new IO::Scalar \$data;
    my $out = new IO::Scalar;
    my $end_address = 0x2800;
    my %params = (source => $in, target => $out, relocate_output_up_to => $end_address);
    crunch(%params);
    my $crunched_data = <$out>;
    my @crunched_data = split '', $crunched_data;
    my @expected_data = map { chr $_ } (0xf9, 0x27, 0x30, 0x00, 0x10, 0x01, 0x80, 0xff, 0xff);
    is(
        dump_hex_data(@crunched_data),
        dump_hex_data(@expected_data),
        'relocating compressed data up to the given end address',
    );
}
#########################
{
    my @data = (0x00, 0x10, 0x01, 0x01, 0x01, 0x01, 0x01);
    my $data = join '', map { chr $_ } @data;
    my $in = new IO::Scalar \$data;
    my $out = new IO::Scalar;
    my $new_start_address = 0xabcd;
    my $end_address = 0x2800;
    my %params = (source => $in, target => $out, relocate_output => $new_start_address, relocate_output_up_to => $end_address);
    crunch(%params);
    my $crunched_data = <$out>;
    my @crunched_data = split '', $crunched_data;
    my @expected_data = map { chr $_ } (0xf9, 0x27, 0x30, 0x00, 0x10, 0x01, 0x80, 0xff, 0xff);
    is(
        dump_hex_data(@crunched_data),
        dump_hex_data(@expected_data),
        'relocate_output_up_to takes precedence over relocate_output',
    );
}
#########################



( run in 0.697 second using v1.01-cache-2.11-cpan-71847e10f99 )