File Coverage

blib/lib/Compress/LZF_PP.pm

Criterion	Covered	Total	%
statement	51	72	70.8
branch	16	24	66.6
condition			n/a
subroutine	3	3	100.0
pod	0	1	0.0
total	70	100	70.0

package Compress::LZF_PP;
use strict;
use warnings;
our $VERSION = '0.33';
our @ISA     = qw(Exporter);
our @EXPORT  = qw(decompress);

my $DEBUG = 0;

sub decompress {
    my $in_data  = shift;
    my $in_len   = length($in_data);
    my $out_data = '';
    my $out_len  = 0;

    my $iidx = 0;
    my $oidx = 0;

    my $length0 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
    if ( $length0 == 0 ) {
        return substr( $in_data, 1, $in_len - 1 );
    } elsif ( !( $length0 & 0x80 ) ) {
        $out_len = $length0 & 0xff;
    } elsif ( !( $length0 & 0x20 ) ) {
        my $length1 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        $out_len = ( $out_len << 6 ) | ( $length1 & 0x3f );
    } elsif ( !( $length0 & 0x10 ) ) {
        my $length1 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length2 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        $out_len = $length0 & 0x1f;
        $out_len = ( $out_len << 6 ) | ( $length1 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length2 & 0x3f );
    } elsif ( !( $length0 & 0x08 ) ) {
        my $length1 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length2 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length3 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        $out_len = $length0 & 0x1f;
        $out_len = ( $out_len << 6 ) | ( $length1 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length2 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length3 & 0x3f );
    } elsif ( !( $length0 & 0x04 ) ) {
        my $length1 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length2 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length3 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length4 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        $out_len = $length0 & 0x1f;
        $out_len = ( $out_len << 6 ) | ( $length1 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length2 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length3 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length4 & 0x3f );
    } elsif ( !( $length0 & 0x02 ) ) {
        my $length1 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length2 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length3 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length4 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        my $length5 = unpack( 'C', substr( $in_data, $iidx++, 1 ) );
        $out_len = $length0 & 0x1f;
        $out_len = ( $out_len << 6 ) | ( $length1 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length2 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length3 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length4 & 0x3f );
        $out_len = ( $out_len << 6 ) | ( $length5 & 0x3f );
    } else {
        die "Unsupported length";
    }

    while ( $iidx < $in_len ) {
        my $ctrl = unpack( 'C', substr( $in_data, $iidx++, 1 ) );

        warn "$iidx, $oidx control $ctrl [[$out_data]]" if $DEBUG;

        if ( $ctrl < ( 1 << 5 ) ) {
            $ctrl++;
            my $toadd = substr( $in_data, $iidx, $ctrl );
            warn "  literal run $ctrl [$toadd]" if $DEBUG;
            $out_data .= $toadd;
            $oidx += $ctrl;
            $iidx += $ctrl;
        } else {
            my $len = $ctrl >> 5;
            my $reference = ( $oidx - ( ( $ctrl & 0x1f ) << 8 ) - 1 );
            if ( $len == 7 ) {
                $len += unpack( 'C', substr( $in_data, $iidx++, 1 ) );
            }
            $reference -= unpack( 'C', substr( $in_data, $iidx++, 1 ) );
            warn "  back reference $reference $len" if $DEBUG;
            $oidx += $len - 3;
            $len  += 3;

            while ( --$len != 0 ) {
                $out_data .= substr( $out_data, $reference++, 1 );
            }
        }
    }
    return $out_data;
}

1;

__END__