Changeset 3588 for lang/perl/Archive-Lha

Show
Ignore:
Timestamp:
12/26/07 12:00:47 (11 months ago)
Author:
charsbar
Message:

lang/perl/Archive-Lha: lots of changes, cleanups, pods and 0.02 -> CPAN

Location:
lang/perl/Archive-Lha/trunk
Files:
3 added
26 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Archive-Lha/trunk/Changes

    r3413 r3588  
    11Revision history for Archive-Lha 
    22 
    3 0.01 2007/12/10 
    4   - initial release 
     30.02 2007/12/26 
     4  - initial CPAN release 
     5 
     60.01 2007/12/18 
     7  - prototype uploaded to CodeRepos 

  • lang/perl/Archive-Lha/trunk/Lha.h

    r3413 r3588  
    77  modify it under the same terms as Perl itself. 
    88*/ 
     9 
    910#define hash_store(hash, key, value) \ 
    1011  hv_store(hash, key, strlen(key), value, 0) 
    … …  
    7273 
    7374typedef struct LhaStash { 
    74   LhaTree      * tree; 
    75   LhaTable     * pt; 
    76   LhaTable     * c; 
    77   LhaBitstream * bit; 
    78   SV           * read; 
    79   SV           * write; 
    80   unsigned short NPT; 
    81   unsigned short NP; 
    82   unsigned short NT; 
    83   unsigned short NC; 
    84   unsigned char  PBIT; 
    85   unsigned char  TBIT; 
    86   unsigned char  CBIT; 
    87   unsigned int original_size; 
    88   unsigned int packed_size; 
     75  LhaTree       * tree; 
     76  LhaTable      * pt; 
     77  LhaTable      * c; 
     78  LhaBitstream  * bit; 
     79  unsigned char * queue; 
     80  SV            * read; 
     81  SV            * write; 
     82  unsigned short  NPT; 
     83  unsigned short  NP; 
     84  unsigned short  NT; 
     85  unsigned short  NC; 
     86  unsigned char   PBIT; 
     87  unsigned char   TBIT; 
     88  unsigned char   CBIT; 
     89  unsigned int    original_size; 
     90  unsigned int    encoded_size; 
    8991} LhaStash; 
    9092 

  • lang/perl/Archive-Lha/trunk/Lha.xs

    r3413 r3588  
    1010#include "ppport.h" 
    1111#include "Lha.h" 
     12 
     13/* 
     14  these are not from LHa for UNIX 
     15*/ 
     16 
     17void 
     18destroy_stash(LhaStash * stash) 
     19{ 
     20  Safefree(stash->tree->left); 
     21  Safefree(stash->tree->right); 
     22  Safefree(stash->tree); 
     23  Safefree(stash->pt->table); 
     24  Safefree(stash->pt->length); 
     25  Safefree(stash->pt); 
     26  Safefree(stash->c->table); 
     27  Safefree(stash->c->length); 
     28  Safefree(stash->c); 
     29  Safefree(stash->bit); 
     30  Safefree(stash->queue); 
     31  Safefree(stash); 
     32} 
     33 
     34void 
     35safe_croak(LhaStash * stash, unsigned char * dying_message) 
     36{ 
     37  destroy_stash(stash); 
     38  croak(dying_message); 
     39} 
    1240 
    1341void 
    … …  
    4068  SPAGAIN; 
    4169  if (n != 1) 
    42     croak("There's something wrong in 'read' callback"); 
     70    safe_croak(stash, "There's something wrong in 'read' callback"); 
    4371  Copy(POPp, stash->bit->readbuf, len, unsigned char); 
    4472  PUTBACK; 
    … …  
    4674  LEAVE; 
    4775} 
     76 
     77/* 
     78  modified from LHa for UNIX: bitio.c ver 1.14 
     79    original authors: 
     80      Source All chagned       1995.01.14  N.Watazaki 
     81      Separated from crcio.c   2002.10.26  Koji Arai 
     82*/ 
    4883 
    4984unsigned short 
    … …  
    6297    n -= bit->pos; 
    6398    bit->value = shiftbits(bit, bit->pos); 
    64     if (stash->packed_size > 0) { 
     99    if (stash->encoded_size > 0) { 
    65100      if (bit->readpos == 0) { 
    66         if (stash->packed_size > READBUF_SIZE) 
     101        if (stash->encoded_size > READBUF_SIZE) 
    67102          len = READBUF_SIZE; 
    68103        else 
    69           len = stash->packed_size; 
     104          len = stash->encoded_size; 
    70105        input(stash, len); 
    71106      } 
    … …  
    73108      if (bit->readpos == READBUF_SIZE) 
    74109        bit->readpos = 0; 
    75       stash->packed_size--; 
     110      stash->encoded_size--; 
    76111    } 
    77112    else 
    … …  
    97132  return bits; 
    98133} 
     134 
     135void 
     136init_bitstream(LhaStash * stash) 
     137{ 
     138  LhaBitstream  * bitstream; 
     139 
     140  Newxz(bitstream, sizeof(LhaBitstream), LhaBitstream); 
     141  stash->bit = bitstream; 
     142 
     143  stash->bit->blocksize = 0; 
     144  stash->bit->readpos = 0; 
     145  stash->bit->value = 0; 
     146  stash->bit->buf = 0; 
     147  stash->bit->pos = 0; 
     148  fillbuf(stash, USHORT_BIT); 
     149} 
     150 
     151/* 
     152  modified from LHa for UNIX: maketbl.c ver 1.14 
     153    original author(s): 
     154      Source All chagned       1995.01.14  N.Watazaki 
     155*/ 
    99156 
    100157void 
    … …  
    112169 
    113170  if (table->bit > USHORT_BIT) { 
    114     croak("Table is broken: table bit is too large"); 
     171    safe_croak(stash, "Table is broken: table bit is too large"); 
    115172  } 
    116173 
    … …  
    122179  for(i = 0; i < nchar; i++) 
    123180    if (table->length[i] > USHORT_BIT) { 
    124       croak("Table is broken: bit length is too large"); 
     181      safe_croak(stash, "Table is broken: bit length is too large"); 
    125182    } 
    126183    else 
    … …  
    133190  } 
    134191  if (total & USHORT_MAX) { 
    135     croak("Table is broken: total mismatch"); 
     192    safe_croak(stash, "Table is broken: total mismatch"); 
    136193  } 
    137194 
    … …  
    162219      j = start[bit]; 
    163220      if ((j >> bits_to_shift) > table->size) { 
    164         croak("Table is broken"); 
     221        safe_croak(stash, "Table is broken"); 
    165222      } 
    166223      p = &(table->table[j >> bits_to_shift]); 
    … …  
    183240  } 
    184241} 
     242 
     243/* 
     244  modified from LHa for UNIX: huf.c ver 1.14 
     245    original authors: 
     246      Source All chagned       1995.01.14  N.Watazaki 
     247      Support LH7 & Bug Fixed  2000.10. 6  t.okamoto 
     248*/ 
    185249 
    186250void 
    … …  
    328392} 
    329393 
     394/* 
     395  modified from LHa for UNIX: crcio.c ver 1.14 
     396    original author(s): 
     397      Source All chagned       1995.01.14  N.Watazaki 
     398*/ 
     399 
    330400unsigned short 
    331401calc_crc16(unsigned short crc, unsigned char * str, unsigned int len) 
    … …  
    335405  return crc; 
    336406} 
     407 
     408/* 
     409  this is not from LHa for UNIX 
     410*/ 
    337411 
    338412void 
    … …  
    377451} 
    378452 
    379 void 
    380 free_tables(LhaStash * stash) 
    381 { 
    382   Safefree(stash->tree->left); 
    383   Safefree(stash->tree->right); 
    384   Safefree(stash->tree); 
    385   Safefree(stash->pt->table); 
    386   Safefree(stash->pt->length); 
    387   Safefree(stash->pt); 
    388   Safefree(stash->c->table); 
    389   Safefree(stash->c->length); 
    390   Safefree(stash->c); 
    391 } 
    392  
    393 void 
    394 init_bitstream(LhaStash * stash) 
    395 { 
    396   LhaBitstream  * bitstream; 
    397  
    398   Newxz(bitstream, sizeof(LhaBitstream), LhaBitstream); 
    399   stash->bit = bitstream; 
    400  
    401   stash->bit->blocksize = 0; 
    402   stash->bit->readpos = 0; 
    403   stash->bit->value = 0; 
    404   stash->bit->buf = 0; 
    405   stash->bit->pos = 0; 
    406   fillbuf(stash, USHORT_BIT); 
    407 } 
    408  
    409 void 
    410 free_bitstream(LhaStash * stash) 
    411 { 
    412   Safefree(stash->bit); 
    413 } 
    414  
    415 MODULE = Archive::Lha PACKAGE = Archive::Lha PREFIX = xs_ 
     453MODULE = Archive::Lha PACKAGE = Archive::Lha::Decode::Base PREFIX = xs_ 
    416454 
    417455PROTOTYPES: DISABLE 
     456 
     457#/* 
     458#  modified from LHa for UNIX: slide.c ver 1.14 
     459#    original authors: 
     460#      Modified                                   Nobutaka Watazaki 
     461#  Ver. 1.14d  Exchanging a search algorithm  1997.01.11  T.Okamoto 
     462#*/ 
    418463 
    419464unsigned short 
    … …  
    442487    Newxz(stash, sizeof(LhaStash), LhaStash); 
    443488 
     489    stash->queue = queue; 
     490 
    444491    stash->read          = self_sv("read"); 
    445492    stash->write         = self_sv("write"); 
    446     stash->original_size = self_uint("original"); 
    447     stash->packed_size   = self_uint("packed"); 
     493    stash->original_size = self_uint("original_size"); 
     494    stash->encoded_size  = self_uint("encoded_size"); 
    448495 
    449496    init_tables(self, stash); 
    … …  
    485532    } 
    486533 
    487     free_tables(stash); 
    488     free_bitstream(stash); 
    489     Safefree(stash); 
    490     Safefree(queue); 
     534    destroy_stash(stash); 
    491535 
    492536    RETVAL = crc16; 
    … …  
    495539    RETVAL 
    496540 
    497 unsigned short 
    498 xs_crc16(unsigned short crc, SV * str, unsigned int len) 
     541MODULE = Archive::Lha PACKAGE = Archive::Lha::CRC PREFIX = xs_ 
     542 
     543PROTOTYPES: DISABLE 
     544 
     545#/* this is not from LHa for UNIX */ 
     546 
     547unsigned short 
     548xs_update(unsigned short crc, SV * str, unsigned int len) 
    499549  CODE: 
    500550    RETVAL = calc_crc16(crc, SvPV(str, len), len); 
    … …  
    502552  OUTPUT: 
    503553    RETVAL 
     554 
     555MODULE = Archive::Lha PACKAGE = Archive::Lha PREFIX = xs_ 
     556 
     557PROTOTYPES: DISABLE 

  • lang/perl/Archive-Lha/trunk/MANIFEST

    r3413 r3588  
    44lib/Archive/Lha.pm 
    55lib/Archive/Lha/Constants.pm 
     6lib/Archive/Lha/CRC.pm 
    67lib/Archive/Lha/Debug.pm 
    78lib/Archive/Lha/Decode.pm 
    … …  
    1213lib/Archive/Lha/Decode/LH7.pm 
    1314lib/Archive/Lha/Header.pm 
     15lib/Archive/Lha/Header/Base.pm 
    1416lib/Archive/Lha/Header/Level0.pm 
    1517lib/Archive/Lha/Header/Level1.pm 
    … …  
    1719lib/Archive/Lha/Header/Utils.pm 
    1820lib/Archive/Lha/Stream.pm 
     21lib/Archive/Lha/Stream/Base.pm 
    1922lib/Archive/Lha/Stream/File.pm 
    2023lib/Archive/Lha/Stream/Hex.pm 
    … …  
    2528README 
    2629t/00_load.t 
    27 t/10_bitstream.t 
    2830t/20_decode.t 
    2931t/99_pod.t 
    … …  
    3234t/archive/lh5.lzh 
    3335t/archive/lh7.lzh 
     36tools/plha 

  • lang/perl/Archive-Lha/trunk/Makefile.PL

    r3413 r3588  
    1313    'Exporter::Lite'      => 0, 
    1414    'Fcntl'               => 0, 
     15    'File::Basename'      => 0, 
     16    'File::Path'          => 0, 
    1517    'File::Slurp'         => 0, 
     18    'File::Spec'          => 0, 
    1619    'List::Util'          => 0, 
    1720    'Log::Dispatch'       => 0, 
    … …  
    2023    'Time::Piece'         => 0, 
    2124  }, 
     25  EXE_FILES => ['tools/plha'], 
    2226  ($ExtUtils::MakeMaker::VERSION >= 6.31 
    2327    ? ( LICENSE => 'perl' ) 

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

    r3413 r3588  
    44use warnings; 
    55 
    6 our $VERSION = '0.01'; 
     6our $VERSION = '0.02'; 
    77 
    88require XSLoader; 
    … …  
    1919=head1 SYNOPSIS 
    2020 
     21  my $stream = Archive::Lha::Stream->new(file => 'some.lzh'); 
     22  while (defined(my $level = $stream->search_header)) { 
     23    my $header = Archive::Lha::Header->new( 
     24      level  => $level, 
     25      stream => $stream, 
     26    ); 
     27    $stream->seek($header->data_top); 
     28    my $decoder = Archive::Lha::Decode->new( 
     29      header => $header, 
     30      read   => sub { stream->read(@_) }, 
     31      write  => sub { print @_ }, 
     32    ); 
     33    my $crc = $decoder->decode; 
     34    die "crc mismatch" if $crc != $header->crc16; 
     35  } 
     36 
    2137=head1 DESCRIPTION 
     38 
     39LHa family is one of the lagacy but prevailing (and historically important) archivers. Though it has lost former popularity, it is still used widely in Japan, and reportedly, in Amiga world. And we have lots of LHa archives created under various environments at hand. 
     40 
     41This package offers rather crude methods to decode/extract files from LHa archives. As of writing this, I'm not inclined to support creating/updating archives for various reasons but this may change. As for decoding, I'll probably add if testable (and preferably uploadable) archives should be found or offered. 
    2242 
    2343=head1 ACKNOWLEDGMENT 
    2444 
    25 The decoding (XS) part is based on the C sources of LHa for UNIX version 1.14i-ac20050924p1. Though I modified a lot not only to XSify but aslo to make it (comparatively) thread-safe and easy to understand, I'm not fair if I omit the names of the original authors/contributors. If you find this port valuable, kudos be to them. If you find something wrong, most probably that'd be my fault. 
     45The decoding (XS) part is based on the C sources of LHa for UNIX version 1.14i-ac20050924p1. Though I modified a lot not only to XSify but also to make it (relatively) thread-safe and easy to understand, I'm not fair if I omit the names of the original authors/contributors. If you find this port valuable, kudos be to them. If you find something wrong, most probably that'd be my fault. 
    2646 
    27 According to the original C sources, those parts of LHa for UNIX version 1.14i-ac20050924p1 are copyrighted by Nobutaka Watazaki (1993-1995), Tsugio Okamoto (1996-2000?), and Koji Arai (2002-). I'm grateful to them, and also to all the people who involved in the development of LHa and its descendants/relatives including Masaru Oki, Yoichi Tagawa, Haruhiko Okumura, Haruyasu Yoshizaki, Kazuhiko Miki and others. 
     47According to the original C sources, those parts of LHa for UNIX version 1.14i-ac20050924p1 are copyrighted by Nobutaka Watazaki (1993-1995), Tsugio Okamoto (1996-2000?), and Koji Arai (2002-). I'm grateful to them, and also to all the people who involved in the development of LHa family including Masaru Oki, Yoichi Tagawa, Haruhiko Okumura, Haruyasu Yoshizaki, Kazuhiko Miki and others. 
    2848 
    29 Other parts including headers file and perl sources are mine or of contributors to this perl port. See appropriate POD sections for details. 
     49Other parts including a header file and perl sources are mine or of contributor(s) to this perl port. See appropriate POD sections for details. 
    3050 
    3151=head1 SEE ALSO 
    … …  
    4767=head1 AUTHOR 
    4868 
    49 Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>, unless otherwise noted. See above. 
     69Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>. 
    5070 
    5171=head1 COPYRIGHT AND LICENSE 
    5272 
    53 Copyright (C) 2007 by Kenichi Ishigaki. 
     73Copyright (C) 2007 by Kenichi Ishigaki, unless otherwise noted. See above. 
    5474 
    5575This program is free software; you can redistribute it and/or 

  • lang/perl/Archive-Lha/trunk/lib/Archive/Lha/Constants.pm

    r3270 r3588  
    4545=head1 DESCRIPTION 
    4646 
     47This is used internally to export several utility functions and constants used or supposed in XS/C. 
     48 
    4749=head1 AUTHOR 
    4850 

  • lang/perl/Archive-Lha/trunk/lib/Archive/Lha/Debug.pm

    r3270 r3588  
    4848=head1 SYNOPSIS 
    4949 
     50  DEBUG( warn => "You don't need to use this" ); 
     51 
    5052=head1 DESCRIPTION 
    5153 
    52 =head1 METHODS 
     54This is a simple wrapper of Log::Dispatch for debugging. See L<Log::Dispatch> for details. 
    5355 
    5456=head1 AUTHOR 

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

    r3270 r3588  
    1010  croak "Header is missing" unless defined $options{header}; 
    1111 
    12   my $method = uc $options{header}->{method}; 
     12  my $method = uc $options{header}->method; 
    1313 
    1414  my $package = 'Archive::Lha::Decode::'.$method; 
    … …  
    3030=head1 SYNOPSIS 
    3131 
     32  # don't forget :raw, or eol might be converted implicitly 
     33  open my $fh, '>:raw', $header->pathname; 
     34  binmode $fh; 
     35  $stream->seek( $header->data_top ); 
     36  my $decoder = Archive::Lha::Decode->new( 
     37    header => $header, 
     38    read   => sub { $stream->read(@_) }, 
     39    write  => sub { print $fh @_ }, 
     40  ) 
     41  my $crc16 = $decoder->decode; 
     42  croak "crc mismatch" if $crc16 != $header->crc16; 
     43 
    3244=head1 DESCRIPTION 
    3345 
     46This is used to decode/extract an archived file from the stream. Actually this ::Decode class is a factory and decoding is done by a delegated class according to the header's "method" property. 
     47 
     48All of the ::Decode subclasses require read/write callbacks. Read callback should take a byte length as an argument, and return the bytes of the length from a file or a string. Write callback should take a part of the decoded (probably binary) string as an argument, and the rest is up to you. You may want to write it down in a file as shown above, or maybe append it to a string to store in a database after finished. You may want to encode it first, or throw it away if the string contains unprintable binary. You may want to use a temporary file. You may want to update a progress indicator. Do whatever you want. 
     49 
    3450=head1 METHODS 
     51 
     52=head2 new 
     53 
     54takes an Archive::Lha::Header object, and read/write callbacks and creates an appropriate object. 
     55 
     56=head2 decode 
     57 
     58does the decoding stuff and returns CRC-16 of the decoded string. The decoded string itself is passed to the write callback while decoding (step by step). 
    3559 
    3660=head1 AUTHOR 

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

    r3413 r3588  
    44use warnings; 
    55use Carp; 
    6 use List::Util qw( min ); 
    76use Archive::Lha::Constants; 
    8 use base qw( Archive::Lha ); 
     7use Archive::Lha;  # to load XS 
    98 
    109sub import { 
    … …  
    1716    my $dicbit = $options{dicbit} || 13; 
    1817 
    19     # these should be configurable, probably? 
    20     # XXX: only if we want to support older/rare archives, though 
     18    # should these really be configurable? 
     19    # XXX: only if we want to support older/rare archives 
    2120    my $max_match = $options{max_match} || ( 1 << UCHAR_BIT ); 
    2221    my $threshold = $options{threshold} || 3; 
    … …  
    6665 
    6766  my $self  = bless { 
    68     blocksize => 0, 
    69     read      => $options{read}, 
    70     write     => $options{write}, 
    71     packed    => $header->{packed_size}, 
    72     original  => $header->{original_size}, 
    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, 
     67    blocksize     => 0, 
     68    read          => $options{read}, 
     69    write         => $options{write}, 
     70    encoded_size  => $header->{encoded_size}, 
     71    original_size => $header->{original_size}, 
     72    crc16         => $header->{crc16} || 0, 
     73    DICSIZE       => $class->DICSIZE, 
     74    MAXMATCH      => $class->MAXMATCH, 
     75    THRESHOLD     => $class->THRESHOLD, 
     76    NPT           => $class->NPT, 
     77    NP            => $class->NP, 
     78    NT            => $class->NT, 
     79    NC            => $class->NC, 
     80    PBIT          => $class->PBIT, 
     81    TBIT          => $class->TBIT, 
     82    CBIT          => $class->CBIT, 
    8483    PT_TABLE_BIT  => $class->PT_TABLE_BIT, 
    8584    PT_TABLE_SIZE => $class->PT_TABLE_SIZE, 
    … …  
    9998Archive::Lha::Decode::Base 
    10099 
    101 =head1 SYNOPSIS 
     100=head1 DESCRIPTION 
    102101 
    103 =head1 DESCRIPTION 
     102This is a base class for lh5-7 decoder. See L<Archive::Lha::Decode> for options and examples. 
    104103 
    105104=head1 METHODS 
    106105 
    107 =head1 AUTHOR, COPYRIGHT AND LICENSE 
     106=head2 new 
    108107 
    109 See L<Archive::Lha> for details. 
     108creates an object. 
     109 
     110=head2 decode 
     111 
     112decodes the archived file and returns CRC-16. See XS source for details. 
     113 
     114=head1 AUTHOR 
     115 
     116Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt> 
     117 
     118=head1 COPYRIGHT AND LICENSE 
     119 
     120Copyright (C) 2007 by Kenichi Ishigaki. 
     121 
     122This program is free software; you can redistribute it and/or 
     123modify it under the same terms as Perl itself. 
    110124 
    111125=cut 

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

    r3413 r3588  
    66use bytes; 
    77use Archive::Lha::Constants;