Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
I threw this module together using a perl implementation of LZW from Compress::SelfExtracting. As this will be my first published module, I thought I'd RFC it before it goes live. If you're wondering how this module came about, check here -> Any news on Compress::LZW?. Obviously, there are improvements in the works, like using blocking, making a best-guess decision on table size, and auto-detection of table size through magic headers, but this is just the first. :) Currently, using a 16-bit codeword table, the compression croaks at 65,536 codewords. Happy birthday, free LZW!

I believe I want to make this module move toward a format compatible with compress -- currently it is not...
############################################################ package Compress::LZW; require Exporter; use Carp; use vars qw/@ISA @EXPORT $VERSION/; use warnings; use strict; @EXPORT = qw/compress decompress/;; @ISA = qw/Exporter/; $VERSION = 0.01; my (%LZ, %UNLZ); %LZ = (12 => sub { my $v = ''; for my $i (0..$#_) { vec($v, 3*$i, 4) = $_[$i]/256; vec($v, 3*$i+1, 4) = ($_[$i]/16)%16; vec($v, 3*$i+2, 4) = $_[$i]%16; } $v; }, 16 => sub { pack 'S*', @_ }); %UNLZ = (12 => sub { my $code = shift; my @code; my $len = length($code); my $reallen = 2*$len/3; foreach (0..$reallen - 1) { push @code, (vec($code, 3*$_, 4)<<8) | (vec($code, 3*$_+1, 4)<<4) | (vec($code, 3*$_+2, 4)); } @code; }, 16 => sub { unpack 'S*', shift; }); sub compress { my ($str, $bits) = @_; $bits = $bits ? $bits : 16; my $p = ''; my %d = map{(chr $_, $_)} 0..255; my @o = (); my $ncw = 256; for (split '', $str) { if (exists $d{$p.$_}) { $p .= $_; } else { push @o, $d{$p}; $d{$p.$_} = $ncw++; $p = $_; } } push @o, $d{$p}; if ($bits != 16 && $ncw < 1<<12) { $bits = 12; return $LZ{12}->(@o); } elsif ($ncw < 1<<16) { $bits = 16; return $LZ{16}->(@o); } else { croak "Sorry, code-word overflow"; } } sub decompress { my ($str, $bits) = @_; $bits = $bits ? $bits : 16; my %d = (map{($_, chr $_)} 0..255); my $ncw = 256; my $ret = ''; my ($p, @code) = $UNLZ{$bits}->($str); $ret .= $d{$p}; for (@code) { if (exists $d{$_}) { $ret .= $d{$_}; $d{$ncw++} = $d{$p}.substr($d{$_}, 0, 1); } else { my $dp = $d{$p}; unless ($_ == $ncw++) { carp "($_ == $ncw)?! Check your ta +ble size!" }; $ret .= ($d{$_} = $dp.substr($dp, 0, 1)); } $p = $_; } $ret; } ############################################################ 1; __END__ =head1 NAME Compress::LZW -- Pure perl implementation of LZW =head1 SYNOPSIS use Compress::LZW; my $compressed = compress($fatdata); my $fatdata = decompress($compressed); my $smallcompressed = compress($thindata, 12); my $thindata = decompress($smallcompressed, 12); =head1 DESCRIPTION C<Compress::LZW> it a perl implementation of the newly free LZW compression algorithm. It defaults to building a 16-bit codeword table, but provides the ability to choose a 12-bit table also. Depending on the size of your data, the 12-bit table may provide better compression. =head2 Functions =over =item C<compress> Takes a string as its first argument, and returns the compressed result. You can also specify the size of your codeword table in C<@_[1]>, choosing either 12 or 16. 16 is the default. C<compress> will =item C<decompress> Takes a string as its first argument, and returns the decompressed result. You can also specify the size of your codeword table in @_[1], choosing either 12 or 16. 16 is the default. =back =head1 EXPORTS C<Compress::LZW> exports: C<compress> C<decompress> That's all. =head1 SEE ALSO Other Compress::* modules, especially Compress::LZV1, Compress::LZF an +d Compress::Zlib. =head1 AUTHOR Sean O'Rourke, E<lt>seano@cpan.orgE<gt> - Original author, C<Compress: +:SelfExtracting> Matt Howard E<lt>mhoward@hattmoward.orgE<gt> - C<Compress::LZW> Bug reports welcome, patches even more welcome. =head1 COPYRIGHT Copyright (C) 2003 Sean O'Rourke & Matt Howard. All rights reserved, +some wrongs reversed. This module is distributed under the same terms as Perl itself. Let me know if you actually find it useful. =cut
Thanks,

mhoward - at - hattmoward.org

In reply to RFC: Compress::LZW by meredith

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (17)
    As of 2014-07-31 13:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (248 votes), past polls