Lempel-Ziv-Welch

lzw.pl

#!/usr/bin/perl
use strict;
use bytes;
use warnings 'all';

# ref: http://cpansearch.perl.org/src/MHOWARD/Compress-LZW-0.01/LZW.pm

my $buf = compress("tres pratos de trigo para tres tigres tristes\n");
print decompress($buf);

sub compress {
    my $str = shift;
    my $p   = '';
    my %d   = map { chr $_ => $_ } 0 .. 255;
    my $ncw = 256;
    my @o;

    foreach my $c (split(//, $str)) {
        my $q = $p . $c;
        if (exists $d{$q}) {
            $p = $q;
        } else {
            push @o, $d{$p};
            $d{$q} = $ncw++;
            $p = $c;
        }
    }
    push @o, $d{$p};

    return pack('S*', @o);
}

sub decompress {
    my ($p, @code) = unpack('S*', shift);
    my %d   = map{ $_ => chr $_ } 0 .. 255;
    my $ncw = 256;
    my $ret = $d{$p};

    foreach my $c (@code) {
        if (exists $d{$c}) {
            $d{$ncw++} = $d{$p} . substr($d{$c}, 0, 1);
        } else {
            die "($c == $ncw)?! Check your table size!" unless $c == $ncw++;
            my $dp = $d{$p};
            $d{$c} = $dp . substr($dp, 0, 1);
        }
        $ret .= $d{$c};
        $p = $c;
    }

    return $ret;
}