Show
Ignore:
Timestamp:
12/21/07 18:32:34 (13 months ago)
Author:
charsbar
Message:

lang/perl/Archive-Lha: xs -> trunk

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Archive-Lha/trunk/lib/Archive/Lha/Decode/Base.pm

    r3270 r3413  
    66use List::Util qw( min ); 
    77use Archive::Lha::Constants; 
    8 use Archive::Lha::Bitstream; 
    9 use Archive::Lha::Queue; 
    10 use Archive::Lha::TableSet; 
    11 use Archive::Lha::Tree; 
     8use base qw( Archive::Lha ); 
    129 
    1310sub import { 
    … …  
    1815    no strict 'refs'; no warnings 'redefine'; 
    1916 
    20     my $dicbit = $options{dicbit}; 
     17    my $dicbit = $options{dicbit} || 13; 
    2118 
    2219    # these should be configurable, probably? 
    … …  
    6865  my $header = $options{header}; 
    6966 
    70   my $bitstream = Archive::Lha::Bitstream->new( 
    71     callback => $options{read}, 
    72     length   => $header->{packed_size}, 
    73   ); 
    74  
    75   my $pt_table = Archive::Lha::TableSet->new( 
    76     bit => $class->PT_TABLE_BIT, length => $class->NPT 
    77   ); 
    78   my $c_table = Archive::Lha::TableSet->new( 
    79     bit => $class->C_TABLE_BIT, length => $class->NC 
    80   ); 
    81   my $tree = Archive::Lha::Tree->new( size => 2 * $class->NC - 1 ); 
    82  
    8367  my $self  = bless { 
    8468    blocksize => 0, 
    85     pt        => $pt_table, 
    86     c         => $c_table, 
    87     tree      => $tree, 
    88     bit       => $bitstream, 
     69    read      => $options{read}, 
    8970    write     => $options{write}, 
     71    packed    => $header->{packed_size}, 
    9072    original  => $header->{original_size}, 
    91     crc16     => $header->{crc16}, 
     73    crc16     => $header->{crc16} || 0, 
     74    DICSIZE   => $class->DICSIZE, 
     75    MAXMATCH  => $class->MAXMATCH, 
     76    THRESHOLD => $class->THRESHOLD, 
     77    NPT       => $class->NPT, 
     78    NP        => $class->NP, 
     79    NT        => $class->NT, 
     80    NC        => $class->NC, 
     81    PBIT      => $class->PBIT, 
     82    TBIT      => $class->TBIT, 
     83    CBIT      => $class->CBIT, 
     84    PT_TABLE_BIT  => $class->PT_TABLE_BIT, 
     85    PT_TABLE_SIZE => $class->PT_TABLE_SIZE, 
     86    C_TABLE_BIT   => $class->C_TABLE_BIT, 
     87    C_TABLE_SIZE  => $class->C_TABLE_SIZE, 
    9288  }, $class; 
    9389 
    9490  $self; 
    95 } 
    96  
    97 sub decode {  # modified from slide.c:decode 
    98   my $self = shift; 
    99  
    100   my $queue = Archive::Lha::Queue->new( 
    101     size     => $self->DICSIZE, 
    102     callback => $self->{write}, 
    103   ); 
    104   my $adjust   = ( 1 << UCHAR_BIT ) - $self->THRESHOLD; 
    105   my $total    = 0; 
    106   my $original = $self->{original}; 
    107  
    108   while ( $total < $original ) { 
    109     my $char = $self->_decode_c; 
    110     if ( $char <= UCHAR_MAX ) { 
    111       $queue->set( $char ); 
    112       $total++; 
    113     } 
    114     else { 
    115       my $length = $char - $adjust; 
    116       my $offset = $self->_decode_p + 1; 
    117  
    118       $queue->copy( $offset, $length ); 
    119       $total += $length; 
    120     } 
    121   } 
    122   $queue->output; 
    123   croak "CRC mismatch" if $queue->crc16 != $self->{crc16}; 
    124 } 
    125  
    126 sub _decode_c {  # modified from huf.c:decode_c 
    127   my $self = shift; 
    128  
    129   if ( $self->{blocksize} == 0 ) { 
    130     $self->{blocksize} = $self->bit->read( USHORT_BIT ); 
    131     $self->_read_pt( $self->NT, $self->TBIT, 3 ); 
    132     $self->_read_c; 
    133     $self->_read_pt( $self->NP, $self->PBIT, -1 ); 
    134   } 
    135   $self->{blocksize}--; 
    136  
    137   my $char = $self->c->value( $self->bit->peek( $self->c->bit ) ); 
    138  
    139   if ( $char < $self->c->length_size ) { 
    140     $self->bit->cut( $self->c->length( $char ) ); 
    141   } 
    142   else { 
    143     $self->bit->cut( $self->c->bit ); 
    144     $char = $self->tree->_follow( 
    145       from  => $char, 
    146       bits  => $self->bit->peek( USHORT_BIT ), 
    147       limit => $self->c->length_size, 
    148     ); 
    149     $self->bit->cut( $self->c->length( $char ) - $self->c->bit ); 
    150   } 
    151   return $char; 
    152 } 
    153  
    154 sub _decode_p {  # modified from huf.c:decode_p 
    155   my $self = shift; 
    156  
    157   my $pt = $self->pt->value( $self->bit->peek( $self->pt->bit ) ); 
    158  
    159   if ( $pt < $self->NP ) { 
    160     $self->bit->cut( $self->pt->length( $pt ) ); 
    161   } 
    162   else { 
    163     $self->bit->cut( $self->pt->bit ); 
    164     $pt = $self->tree->_follow( 
    165       from  => $pt, 
    166       bits  => $self->bit->peek( USHORT_BIT ), 
    167       limit => $self->NP, 
    168     ); 
    169     $self->bit->cut( $self->pt->length( $pt ) - $self->pt->bit ); 
    170   } 
    171   if ( $pt ) { 
    172     $pt = ( 1 << ( $pt - 1 ) ) + $self->bit->read( $pt - 1 ); 
    173   } 
    174   return $pt; 
    175 } 
    176  
    177 sub _read_pt {  # modified from huf.c:read_pt_len 
    178   my ($self, $nn, $nbit, $threshold) = @_; 
    179  
    180   my $n = $self->bit->read( $nbit ); 
    181   if ( $n == 0 ) { 
    182     $self->pt->fill_value( with => $self->bit->read( $nbit ) ); 
    183     $self->pt->fill_length( with => 0, to => $nn ); 
    184   } 
    185   else { 
    186     my $i = 0; 
    187     while ( $i < min( $n, $self->pt->length_size ) ) { 
    188       my $c = $self->bit->peek(3); 
    189       if ( $c == 7 ) { 
    190         my $mask = _ushort( 1 << ( ( USHORT_BIT - 1 ) - 3 ) ); 
    191         while ( $self->bit->check( $mask ) ) { 
    192           $mask >>= 1; 
    193           $c++; 
    194         } 
    195         $self->bit->cut( $c - 3 ); 
    196       } 
    197       else { 
    198         $self->bit->cut(3); 
    199       } 
    200  
    201       $self->pt->length( $i++ => $c ); 
    202       if ( $i == $threshold ) { 
    203         $c = $self->bit->read(2); 
    204         while( --$c >= 0 && $i < $self->pt->length_size ) { 
    205           $self->pt->length( $i++ => 0 ); 
    206         } 
    207       } 
    208     } 
    209     $self->pt->fill_length( with => 0, from => $i, to => $nn ); 
    210     $self->_make_table( $self->pt, $nn ); 
    211   } 
    212 } 
    213  
    214 sub _read_c {  # modified from huf.c:read_c_len 
    215   my $self = shift; 
    216  
    217   my $n = $self->bit->read( $self->CBIT ); 
    218   if ( $n == 0 ) { 
    219     $self->c->fill_value( with => $self->bit->read( $self->CBIT ) ); 
    220     $self->c->fill_length( with => 0 ); 
    221   } 
    222   else { 
    223     my $i = 0; 
    224     while ( $i < min( $n, $self->c->length_size ) ) { 
    225       my $c = $self->pt->value( $self->bit->peek( $self->pt->bit ) ); 
    226       if ( $c >= $self->NT ) { 
    227         $c = $self->tree->_follow( 
    228           from       => $c, 
    229           bits       => $self->bit->peek( USHORT_BIT ), 
    230           mask_shift => $self->pt->bit, 
    231           limit      => $self->NT, 
    232         ); 
    233       } 
    234       $self->bit->cut( $self->pt->length( $c ) ); 
    235       if ( $c <= 2 ) { 
    236         if ( $c == 0 ) { 
    237           $c = 1; 
    238         } 
    239         elsif ( $c == 1 ) { 
    240           $c = $self->bit->read(4) + 3; 
    241         } 
    242         else { 
    243           $c = $self->bit->read( $self->CBIT ) + 20; 
    244         } 
    245         while ( --$c >= 0 ) { 
    246           $self->c->length( $i++ => 0 ); 
    247         } 
    248       } 
    249       else { 
    250         $self->c->length( $i++ => $c - 2 ); 
    251       } 
    252     } 
    253     $self->c->fill_length( with => 0, from => $i ); 
    254     $self->_make_table( $self->c, $self->c->length_size ); 
    255   } 
    256 } 
    257  
    258 sub _make_table {  # modified from maketbl.c:make_table 
    259   my ($self, $table, $nchar) = @_; 
    260  
    261   my (@count, @weight, @start); 
    262  
    263   for( my $i = 1; $i <= USHORT_BIT; $i++ ) { 
    264     $count[$i]  = 0; 
    265     $weight[$i] = _ushort( 1 << ( USHORT_BIT - $i ) ); 
    266   } 
    267  
    268   for( my $i = 0; $i < $nchar; $i++ ) { 
    269     if ( $table->length( $i ) > USHORT_BIT ) { 
    270       croak "Table is broken: ".$table->stringify; 
    271     } 
    272     $count[ $table->length( $i ) ]++; 
    273   } 
    274  
    275   my $total = 0; 
    276   for( my $i = 1; $i <= USHORT_BIT; $i++ ) { 
    277     $start[$i] = $total; 
    278     $total += $weight[$i] * $count[$i]; 
    279   } 
    280  
    281   if ( $total & USHORT_MAX ) { 
    282     croak "Table is broken: ".$table->stringify; 
    283   } 
    284  
    285   my $m = USHORT_BIT - $table->bit; 
    286  
    287   for( my $i = 1; $i <= $table->bit; $i++ ) { 
    288     $start[$i]  = _ushort( $start[$i] >> $m ); 
    289     $weight[$i] = _ushort( $weight[$i] >> $m ); 
    290   } 
    291  
    292   my $j = $start[ $table->bit + 1 ] >> $m; 
    293   my $k = min( 1 << $table->bit, $table->size ); 
    294  
    295   if ( $j ) { 
    296     $table->fill_value( with => 0, from => $j, to => $k ); 
    297   } 
    298  
    299   my $avail = $nchar; 
    300   for( my $j = 0; $j < $nchar; $j++ ) { 
    301     my $k = $table->length( $j ) or next; 
    302     my $l = $start[$k] + $weight[$k]; 
    303  
    304     if ( $k <= $table->bit ) { 
    305       $l = min( $l, $table->size ); 
    306       $table->fill_value( with => $j, from => $start[$k], to => $l ); 
    307     } 
    308     else { 
    309       my $i = $start[$k]; 
    310       if ( ( $i >> $m ) > $table->size ) { 
    311         croak "Table is broken: ".$table->stringify; 
    312       } 
    313  
    314       my $p_addr = $i >> $m; 
    315       my $p_type = 'table'; 
    316       my $p      = $table->value( $p_addr ); 
    317       my $n = $k - $table->bit; 
    318       $i = _ushort( $i << $table->bit ); 
    319  
    320       while ( --$n >= 0 ) { 
    321         if ( $p == 0 ) { 
    322           $self->tree->right( $avail => 0 ); 
    323           $self->tree->left(  $avail => 0 ); 
    324           $p = $avail++; 
    325           if ( $p_type eq 'table' ) { 
    326             $table->value( $p_addr => $p ); 
    327           } 
    328           elsif ( $p_type eq 'right' ) { 
    329             $self->tree->right( $p_addr => $p ); 
    330           } 
    331           elsif ( $p_type eq 'left' ) { 
    332             $self->tree->left( $p_addr => $p ); 
    333           } 
    334         } 
    335         if ( $i >= USHORT_CENTER ) { 
    336           $p_type = 'right'; 
    337           $p_addr = $p; 
    338           $p = $self->tree->right( $p_addr ); 
    339         } 
    340         else { 
    341           $p_type = 'left'; 
    342           $p_addr = $p; 
    343           $p = $self->tree->left( $p_addr ); 
    344         } 
    345         $i = _ushort( $i << 1 ); 
    346       } 
    347       if ( $p_type eq 'table' ) { 
    348         $table->value( $p_addr => $j ); 
    349       } 
    350       elsif ( $p_type eq 'right' ) { 
    351         $self->tree->right( $p_addr => $j ); 
    352       } 
    353       elsif ( $p_type eq 'left' ) { 
    354         $self->tree->left( $p_addr => $j ); 
    355       } 
    356     } 
    357     $start[$k] = $l; 
    358   } 
    35991} 
    36092