File Coverage

blib/lib/IO/Uncompress/UnLzop.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package IO::Uncompress::UnLzop ;

use strict ;
use warnings;
use bytes;

use IO::Compress::Base::Common  2.073 qw(:Status createSelfTiedObject);

use IO::Uncompress::Base  2.073 ;
use IO::Uncompress::Adapter::LZO  2.073 ;
use Compress::LZO qw(crc32 adler32);
use IO::Compress::Lzop::Constants  2.073 ;


require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnLzopError);

$VERSION = '2.073';
$UnLzopError = '';

@ISA    = qw( IO::Uncompress::Base Exporter );
@EXPORT_OK = qw( $UnLzopError unlzop ) ;
#%EXPORT_TAGS = %IO::Uncompress::Base::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
#Exporter::export_ok_tags('all');


sub new
{
    my $class = shift ;
    my $obj = createSelfTiedObject($class, \$UnLzopError);

    $obj->_create(undef, 0, @_);
}

sub unlzop
{
    my $obj = createSelfTiedObject(undef, \$UnLzopError);
    return $obj->_inf(@_);
}

sub getExtraParams
{
    return ();
}

sub ckParams
{
    my $self = shift ;
    my $got = shift ;

    return 1;
}

sub mkUncomp
{
    my $self = shift ;
    my $got = shift ;

     my $magic = $self->ckMagic()
        or return 0;

    *$self->{Info} = $self->readHeader($magic)
        or return undef ;

    my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::LZO::mkUncompObject();

    return $self->saveErrorString(undef, $errstr, $errno)
        if ! defined $obj;

    *$self->{Uncomp} = $obj;

    return 1;
}


sub ckMagic
{
    my $self = shift;

    my $magic ;
    $self->smartReadExact(\$magic, 9);

    *$self->{HeaderPending} = $magic ;

    return $self->HeaderError("Header size is " .
                                        9 . " bytes")
        if length $magic != 9;

    return $self->HeaderError("Bad Magic.")
        if ! isLzopMagic($magic) ;


    *$self->{Type} = 'lzop';
    return $magic;
}

sub readHeader
{
    my $self = shift;
    my $magic = shift ;

    my $keep ;
    my $buffer;

    $self->smartReadExact(\$buffer, 25 )
        or return $self->HeaderError("Minimum header size is " .
                                     38 . " bytes") ;
    $keep .= $buffer;
    my $version = unpack 'n', substr($buffer, 0, 2);
    my $lib_ver = unpack 'n', substr($buffer, 2, 2);
    my $xtr_ver = unpack 'n', substr($buffer, 4, 2);
    my $method  = unpack 'C', substr($buffer, 6, 1);

    my $level   = unpack 'C', substr($buffer, 7, 1);
    my $flags   = unpack 'N', substr($buffer, 8, 4);

   #my $filter  = unpack 'N', substr($buffer, 8, 1);
    my $mode    = unpack 'N', substr($buffer, 12, 4);
    my $time    = unpack 'N', substr($buffer, 16, 4);
    my $gmoff   = unpack 'N', substr($buffer, 20, 4);
    my $flen    = unpack 'C', substr($buffer, 24, 1);

    my $filename ;
    if ($flen) {
        $self->smartReadExact(\$filename, $flen)
            or return $self->HeaderError("xxx");
        $keep .= $filename ;
    }


    $self->smartReadExact(\$buffer, 4)
        or return $self->HeaderError("xxx");
    my $crcGot = unpack 'N', $buffer;

    if (*$self->{Strict} ) {
        my $crc ;
        if ($flags & F_H_CRC32)
          { $crc = crc32($keep) }
        else
          { $crc = adler32($keep) }

        return $self->HeaderError("CRC Error")
            if $crcGot != $crc;
    }

    $keep .= $buffer ;

    if ($flags & F_H_EXTRA_FIELD) {
        $self->smartReadExact(\$buffer, 4)
            or return $self->HeaderError("xxx");
        my $len = unpack 'N', $buffer  ; # Extra Length
        my $extra = '';
        $self->smartReadExact(\$extra, $len)
            or return $self->HeaderError("xxx");
        $self->smartReadExact(\$buffer, 4)
            or return $self->HeaderError("xxx");
   }

    *$self->{LzopData}{Flags} = $flags;

    $keep = $magic . $keep ;

    return {
        'Type'          => 'lzop',
        'FingerprintLength'  => 9,
        'HeaderLength'  => length $keep,
        'TrailerLength' => 0,
        'Header'        => $keep,
        };

}

sub chkTrailer
{
    return STATUS_OK;
}

sub readBlock
{
    my $self = shift ;
    my $buff = shift ;
    my $size = shift ;

    my $tmp;

    # uncompressed size
    $self->smartReadExact(\$tmp, 4)
        or return $self->saveErrorString(STATUS_ERROR, "Error Reading Data");

    my $uncSize = unpack("N", $tmp);
    $_[0] = $uncSize;

    if ($uncSize == 0) {
        return STATUS_ENDSTREAM;
    }

    return $self->saveErrorString(STATUS_ERROR, "Split file not supported")
        if $uncSize == 0xFFFFFFFF ;

    return $self->saveErrorString(STATUS_ERROR, "Corrupt - $uncSize >" . MAX_BLOCK_SIZE )
        if $uncSize > MAX_BLOCK_SIZE ;

    # compressed size
    $self->smartReadExact(\$tmp, 4)
        or return $self->saveErrorString(STATUS_ERROR, "Error Reading Data");

    my $compSize = unpack("N", $tmp);

    return $self->saveErrorString(STATUS_ERROR, "File corrupt compressed size > uncompressed size")
        if $compSize > $uncSize ;

    return $self->saveErrorString(STATUS_ERROR, "File corrupt uncompressed size > " . BLOCK_SIZE)
        if $uncSize > BLOCK_SIZE ;

    my $uncCRC ;
    my $compCRC ;
    if (*$self->{LzopData}{Flags} & FLAG_CRC_UNCOMP) {
        # CRC
        $self->smartReadExact(\$tmp, 4)
            or return $self->saveErrorString(STATUS_ERROR, "Error Reading Data");

        $uncCRC = unpack("N", $tmp);
    }

    if (*$self->{LzopData}{Flags} & FLAG_CRC_COMP) {
        # CRC
        if ($compSize != $uncSize) {
            $self->smartReadExact(\$tmp, 4)
                or return $self->saveErrorString(STATUS_ERROR, "Error Reading Data");

            $compCRC = unpack("N", $tmp);
        }
        else {
            $compCRC = $uncCRC ;
        }
    }

    *$self->{LzopData}{compSize} = $compSize;
    *$self->{LzopData}{uncSize} = $uncSize;
    *$self->{LzopData}{compCRC} = $compCRC;
    *$self->{LzopData}{uncCRC} = $uncCRC;


    # data
    $self->smartReadExact($buff, $compSize)
        or return $self->saveErrorString(STATUS_ERROR, "Error Reading Data");

    if (*$self->{Strict} && *$self->{LzopData}{Flags} & FLAG_CRC_COMP) {
        my $crc ;
        $crc = crc32($$buff)   if *$self->{LzopData}{Flags} & F_CRC32_C ;
        $crc = adler32($$buff) if *$self->{LzopData}{Flags} & F_ADLER32_C ;
        return $self->saveErrorString(STATUS_ERROR, "CRC error")
            if $compCRC != $crc;
    }

    return STATUS_OK;
}


sub postBlockChk
{
    my $self = shift ;
    my $buffer = shift ;
    my $offset = shift ;

    if (*$self->{Strict} && *$self->{LzopData}{Flags} & FLAG_CRC_UNCOMP
            && *$self->{LzopData}{compSize} != *$self->{LzopData}{uncSize} ) {

        my $crc ;

        my $buf = $buffer;

        if ($offset) {
            my $x = substr($$buffer, $offset);
            $buf = \$x;
        }

        $crc = crc32($$buffer)
            if *$self->{LzopData}{Flags} & F_CRC32_D ;

        $crc = adler32($$buffer)
            if *$self->{LzopData}{Flags} & F_ADLER32_D ;

        return $self->saveErrorString(STATUS_ERROR, "CRC error")
            if *$self->{LzopData}{uncCRC} != $crc;
    }

    return STATUS_OK;
}




sub isLzopMagic
{
    my $buffer = shift ;
    return $buffer eq SIGNATURE ;
}

1 ;

__END__