File Coverage

blib/lib/IO/Compress/Lzop.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::Compress::Lzop ;

use strict ;
use warnings;
require Exporter ;
use bytes;

use IO::Compress::Base 2.072 ;

use IO::Compress::Base::Common  2.072 qw(isaScalar createSelfTiedObject);
use IO::Compress::Adapter::LZO  2.072 ;
use Compress::LZO qw(crc32 adler32 LZO_VERSION);
use IO::Compress::Lzop::Constants  2.072 ;

our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $LzopError);

$VERSION = '2.072';
$LzopError = '';

@ISA    = qw(Exporter IO::Compress::Base);
@EXPORT_OK = qw( $LzopError lzop ) ;
%EXPORT_TAGS = %IO::Compress::Base::EXPORT_TAGS ;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');

sub new
{
    my $class = shift ;

    my $obj = createSelfTiedObject($class, \$LzopError);
    return $obj->_create(undef, @_);
}

sub lzop
{
    my $obj = createSelfTiedObject(undef, \$LzopError);
    return $obj->_def(@_);
}

#sub ckSum
#{
#    my $self = shift ;
#
#    return adler32($_[0]) if *$self->{LZOP}{Adler32} ;
#    return crc32($_[0]) if *$self->{LZOP}{CRRC32} ;
#    return '';
#}

sub mkHeader
{
    my $self = shift ;
    my $param = shift ;

    my $filename = '';

    my $time = $param->getValue('time') ;

    my $flags = F_OS_UNIX  ;
    if (! $param->getValue('minimal')) {
        $flags |= F_ADLER32_D | F_ADLER32_C ;
        $filename = $param->getValue('name') || '';
    }

    my $mode = 0 ;
    if ($param->getValue('mode')) {
        $mode = $param->getValue('mode');
    }

    my $xtr = '';
    if ($param->parsed('extra')) {
        $flags |= F_H_EXTRA_FIELD ;

        my $extra = $param->getValue('extra') ;
        $xtr .= pack 'N', length($extra)  ; # Extra Length
        $xtr .= $extra                    ; # Extra Data
        $xtr .= pack 'N', adler32($xtr)   ; # Extra CRC
    }

    my $hdr = '' ;

    $hdr .= pack 'n', 0x1010     ; # lzop Version
    $hdr .= pack 'n', 0x1080     ; # LZO library version
    $hdr .= pack 'n', 0x1010     ; # lzop extract version
    $hdr .= pack 'C', 1          ; # Method
    $hdr .= pack 'C', 5          ; # Level
    $hdr .= pack 'N', $flags     ; # Flags

    $hdr .= pack 'N', $mode      ; # Mode
    $hdr .= pack 'N', $time      ; # Time
    $hdr .= pack 'N', 0          ; # GMDiff

    # Filename
    $hdr .= pack 'C', length $filename ; # filename length
    $hdr .= $filename ;

    # Header CRC
    $hdr .= pack 'N', adler32($hdr) ; # Header CRC

    # Extra
    $hdr .= $xtr;

    return SIGNATURE . $hdr;

}

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

    if (! $got->parsed('time') ) {
        # Modification time defaults to now.
        $got->setValue('time' => time) ;
    }

    #*$self->{LZOP}{Adler32} = ($got->getValue('??') ? 0 : 1) ;

    return 1 ;
}


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

    my ($obj, $errstr, $errno) =  IO::Compress::Adapter::LZO::mkCompObject(
                                              $got->getValue('blocksize'),
                                              $got->getValue('optimize'),
                                              $got->getValue('minimal'),
                                          );

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

    return $obj;

}


sub mkTrailer
{
    my $self = shift ;
    return pack "N", 0 ;
}

sub mkFinalTrailer
{
    return '';
}

#sub newHeader
#{
#    my $self = shift ;
#    return '';
#}

our %PARAMS = (
    'name'      => [IO::Compress::Base::Common::Parse_any,       undef],
    'time'      => [IO::Compress::Base::Common::Parse_any,       undef],
    'mode'      => [IO::Compress::Base::Common::Parse_any,       0],
    'extra'     => [IO::Compress::Base::Common::Parse_any,       undef],
    'minimal'   => [IO::Compress::Base::Common::Parse_boolean,   0],
    'blocksize' => [IO::Compress::Base::Common::Parse_unsigned,  BLOCK_SIZE],
    'optimize'  => [IO::Compress::Base::Common::Parse_boolean,   1],

   # TODO
   #   none
   #   crc32
   #   adler32
       );

sub getExtraParams
{
    return %PARAMS ;
}

sub getInverseClass
{
    return ('IO::Uncompress::UnLzop');
}

sub getFileInfo
{
    my $self = shift ;
    my $params = shift;
    my $filename = shift ;

    return
      if isaScalar($filename) ;

    my ($defaultMode, $defaultTime) = (stat($filename))[2, 9] ;

    $params->setValue('name' => $filename)
        if ! $params->parsed('name') ;

    $params->setValue('time' => $defaultTime)
        if ! $params->parsed('time') ;

    $params->setValue('mode' => $defaultMode)
        if ! $params->parsed('mode') ;
}

1;

__END__