view release on metacpan or  search on metacpan

local/lib/perl5/x86_64-linux-gnu-thread-multi/Compress/Raw/Lzma.pm  view on Meta::CPAN

    LZMA_VERSION_STABILITY

    LZMA_VERSION_STABILITY_STRING
    LZMA_VERSION_STRING
    );

    #LZMA_VLI_MAX
    #LZMA_VLI_UNKNOWN
    #LZMA_VLI_BYTES_MAX

sub AUTOLOAD {
    my($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    my ($error, $val) = constant($constname);
    Carp::croak $error if $error;
    no strict 'refs';
    *{$AUTOLOAD} = sub { $val };
    goto &{$AUTOLOAD};

}

use constant FLAG_APPEND             => 1 ;
use constant FLAG_CRC                => 2 ;
use constant FLAG_ADLER              => 4 ;
use constant FLAG_CONSUME_INPUT      => 8 ;
use constant FLAG_LIMIT_OUTPUT       => 16 ;

eval {
    require XSLoader;
    XSLoader::load('Compress::Raw::Lzma', $XS_VERSION);
    1;
}
or do {
    require DynaLoader;
    local @ISA = qw(DynaLoader);
    bootstrap Compress::Raw::Lzma $XS_VERSION ;
};

use constant Parse_any      => 0x01;
use constant Parse_unsigned => 0x02;
use constant Parse_signed   => 0x04;
use constant Parse_boolean  => 0x08;
use constant Parse_string   => 0x10;
use constant Parse_custom   => 0x12;

use constant Parse_store_ref => 0x100 ;

use constant OFF_PARSED     => 0 ;
use constant OFF_TYPE       => 1 ;
use constant OFF_DEFAULT    => 2 ;
use constant OFF_FIXED      => 3 ;
use constant OFF_FIRST_ONLY => 4 ;
use constant OFF_STICKY     => 5 ;



sub ParseParameters
{
    my $level = shift || 0 ;

    my $sub = (caller($level + 1))[3] ;
    #local $Carp::CarpLevel = 1 ;
    my $p = new Compress::Raw::Lzma::Parameters() ;
    $p->parse(@_)
        or croak "$sub: $p->{Error}" ;

    return $p;
}


sub Compress::Raw::Lzma::Parameters::new
{
    my $class = shift ;

    my $obj = { Error => '',
                Got   => {},
              } ;

    #return bless $obj, ref($class) || $class || __PACKAGE__ ;
    return bless $obj, 'Compress::Raw::Lzma::Parameters' ;
}

sub Compress::Raw::Lzma::Parameters::setError
{
    my $self = shift ;
    my $error = shift ;
    my $retval = @_ ? shift : undef ;

    $self->{Error} = $error ;
    return $retval;
}

#sub getError
#{
#    my $self = shift ;
#    return $self->{Error} ;
#}

sub Compress::Raw::Lzma::Parameters::parse
{
    my $self = shift ;

    my $default = shift ;

    my $got = $self->{Got} ;
    my $firstTime = keys %{ $got } == 0 ;

    my (@Bad) ;
    my @entered = () ;

    # Allow the options to be passed as a hash reference or
    # as the complete hash.
    if (@_ == 0) {
        @entered = () ;
    }
    elsif (@_ == 1) {
        my $href = $_[0] ;
        return $self->setError("Expected even number of parameters, got 1")
            if ! defined $href or ! ref $href or ref $href ne "HASH" ;

        foreach my $key (keys %$href) {

local/lib/perl5/x86_64-linux-gnu-thread-multi/Compress/Raw/Lzma.pm  view on Meta::CPAN

    if (ref $_[0] ne 'ARRAY')
      { die "$_[0] not Lzma::Filter object or ARRAY ref" }

    my $filters = $_[0] ;
    my $count = @$filters;

    # check number of filters
    die sprintf "Too many filters ($count), max is %d", LZMA_FILTERS_MAX()
        if $count > LZMA_FILTERS_MAX();

    # TODO - add more tests here
    # Check that all filters inherit from Lzma::Filter
    # check that filters are supported
    # check memory requirements
    # need exactly one lzma1/2 filter
    # lzma1/2 is the last thing in the list
    for (my $i = 0; $i <  @$filters ; ++$i)
    {
        my $filt = $filters->[$i];
        die "filter is not an Lzma::Filter object"
            unless UNIVERSAL::isa($filt, 'Lzma::Filter');
        die "Lzma filter must be last"
            if UNIVERSAL::isa($filt, 'Lzma::Filter::Lzma') && $i < $count -1 ;

        #die "xxx" unless lzma_filter_encoder_is_supported($filt->id());
    }

    if (@$filters == 0)
    {
        push @$filters, $lzma2 ? Lzma::Filter::Lzma2()
                               : Lzma::Filter::Lzma1();
    }

    return $filters;
}

#package Lzma::Filter;
#package Lzma::Filter::Lzma;

#our ($VERSION, @ISA, @EXPORT, $AUTOLOAD);
@Lzma::Filter::Lzma::ISA = qw(Lzma::Filter);

sub Lzma::Filter::Lzma::mk
{
    my $type = shift;

    my $got = Compress::Raw::Lzma::ParseParameters(0,
        {
            'DictSize' => [1, 1, Parse_unsigned(), LZMA_DICT_SIZE_DEFAULT()],
            'PresetDict' => [1, 1, Parse_string(), undef],
            'Lc'    => [1, 1, Parse_unsigned(), LZMA_LC_DEFAULT()],
            'Lp'    => [1, 1, Parse_unsigned(), LZMA_LP_DEFAULT()],
            'Pb'    => [1, 1, Parse_unsigned(), LZMA_PB_DEFAULT()],
            'Mode'  => [1, 1, Parse_unsigned(), LZMA_MODE_NORMAL()],
            'Nice'  => [1, 1, Parse_unsigned(), 64],
            'Mf'    => [1, 1, Parse_unsigned(), LZMA_MF_BT4()],
            'Depth' => [1, 1, Parse_unsigned(), 0],
        }, @_) ;

    my $pkg = (caller(1))[3] ;

    my $DictSize = $got->value('DictSize');
    die "Dictsize $DictSize not in range 4KiB - 1536Mib"
        if $DictSize < 1024 * 4 ||
           $DictSize > 1024 * 1024 * 1536 ;

    my $Lc = $got->value('Lc');
    die "Lc $Lc not in range 0-4"
        if $Lc < 0 || $Lc > 4;

    my $Lp = $got->value('Lp');
    die "Lp $Lp not in range 0-4"
        if $Lp < 0 || $Lp > 4;

    die "Lc + Lp must be <= 4"
        if $Lc + $Lp > 4;

    my $Pb = $got->value('Pb');
    die "Pb $Pb not in range 0-4"
        if $Pb < 0 || $Pb > 4;

    my $Mode = $got->value('Mode');
    die "Mode $Mode not LZMA_MODE_FAST or LZMA_MODE_NORMAL"
        if $Mode != LZMA_MODE_FAST() && $Mode != LZMA_MODE_NORMAL();

    my $Mf = $got->value('Mf');
    die "Mf $Mf not valid"
        if ! grep { $Mf == $_ }
             ( LZMA_MF_HC3(),
               LZMA_MF_HC4(),
               LZMA_MF_BT2(),
               LZMA_MF_BT3(),
               LZMA_MF_BT4());

    my $Nice = $got->value('Nice');
    die "Nice $Nice not in range 2-273"
        if $Nice < 2 || $Nice > 273;

    my $obj = Lzma::Filter::Lzma::_mk($type,
                            $DictSize,
                            $Lc,
                            $Lp,
                            $Pb,
                            $Mode,
                            $Nice,
                            $Mf,
                            $got->value('Depth'),
                            $got->value('PresetDict'),
                        );

    bless $obj, $pkg
        if defined $obj;

    $obj;
}

sub Lzma::Filter::Lzma::mkPreset
{
    my $type = shift;

    my $preset = shift;
    my $pkg = (caller(1))[3] ;

    my $obj = Lzma::Filter::Lzma::_mkPreset($type, $preset);

    bless $obj, $pkg
        if defined $obj;

    $obj;
}

@Lzma::Filter::Lzma1::ISA = qw(Lzma::Filter::Lzma);
sub Lzma::Filter::Lzma1
{
    Lzma::Filter::Lzma::mk(0, @_);
}

@Lzma::Filter::Lzma1::Preset::ISA = qw(Lzma::Filter::Lzma);
sub Lzma::Filter::Lzma1::Preset
{
    Lzma::Filter::Lzma::mkPreset(0, @_);
}

@Lzma::Filter::Lzma2::ISA = qw(Lzma::Filter::Lzma);
sub Lzma::Filter::Lzma2
{
    Lzma::Filter::Lzma::mk(1, @_);
}

@Lzma::Filter::Lzma2::Preset::ISA = qw(Lzma::Filter::Lzma);
sub Lzma::Filter::Lzma2::Preset
{
    Lzma::Filter::Lzma::mkPreset(1, @_);
}

@Lzma::Filter::BCJ::ISA = qw(Lzma::Filter);

sub Lzma::Filter::BCJ::mk
{
    my $type = shift;
    my $got = Compress::Raw::Lzma::ParseParameters(0,
            {
                'Offset' => [1, 1, Parse_unsigned(), 0],
            }, @_) ;

    my $pkg = (caller(1))[3] ;
    my $obj = Lzma::Filter::BCJ::_mk($type, $got->value('Offset')) ;
    bless $obj, $pkg
        if defined $obj;

    $obj;
}

@Lzma::Filter::X86::ISA = qw(Lzma::Filter::BCJ);

sub Lzma::Filter::X86
{
    Lzma::Filter::BCJ::mk(LZMA_FILTER_X86(), @_);
}

@Lzma::Filter::PowerPC::ISA = qw(Lzma::Filter::BCJ);

sub Lzma::Filter::PowerPC
{
    Lzma::Filter::BCJ::mk(LZMA_FILTER_POWERPC(), @_);
}

@Lzma::Filter::IA64::ISA = qw(Lzma::Filter::BCJ);

sub Lzma::Filter::IA64
{
    Lzma::Filter::BCJ::mk(LZMA_FILTER_IA64(), @_);
}

@Lzma::Filter::ARM::ISA = qw(Lzma::Filter::BCJ);

sub Lzma::Filter::ARM
{
    Lzma::Filter::BCJ::mk(LZMA_FILTER_ARM(), @_);
}

@Lzma::Filter::ARMThumb::ISA = qw(Lzma::Filter::BCJ);

sub Lzma::Filter::ARMThumb
{
    Lzma::Filter::BCJ::mk(LZMA_FILTER_ARMTHUMB(), @_);
}

@Lzma::Filter::Sparc::ISA = qw(Lzma::Filter::BCJ);

sub Lzma::Filter::Sparc
{
    Lzma::Filter::BCJ::mk(LZMA_FILTER_SPARC(), @_);
}


@Lzma::Filter::Delta::ISA = qw(Lzma::Filter);
sub Lzma::Filter::Delta
{
    #my $pkg = shift ;
    my ($got) = Compress::Raw::Lzma::ParseParameters(0,
            {
                'Type'   => [1, 1, Parse_unsigned,  LZMA_DELTA_TYPE_BYTE()],
                'Distance' => [1, 1, Parse_unsigned, LZMA_DELTA_DIST_MIN()],
            }, @_) ;