package Gunzip;
# Proof of concept code for a data driven pure perl gunzip
# Author:  Ton Hospel (perl-gunzip@ton.iguana.be)
# Licence: GPL or Perl Artistic, your choice

# About 200 to 300 times slower than real gunzip....

# todo:
#  Choose better names for fields and functions
#  Docs
#  header crc code is completely untested (No gzip file seems to use it)
#  Do something intelligent if a new segment follows the last one

# You can test this code like this:
# perl -I /some/dir -we 'use Gunzip; Gunzip->driver(shift)' foo.gz

use 5.006_001;

use warnings;
use strict;
use Carp;
use Time::Local;
use vars qw($VERSION);

$VERSION = "0.10";

# deflate header flags
use constant FTEXT	=> 1;
use constant FHCRC	=> 2;
use constant FEXTRA	=> 4;
use constant FNAME	=> 8;
use constant FCOMMENT	=> 16;

# deflate states
use constant HEADER	=>  1;
use constant EXTRA	=>  2;
use constant EXTRA_DATA	=>  3;
use constant NAME	=>  4;
use constant COMMENT	=>  5;
use constant HCRC	=>  6;
use constant BLOCK	=>  7;
use constant UNCOMPRESSED => 8;
use constant UNCOMPRESSED_DATA	=>  9;
use constant DYNAMIC_SIZES	=> 10;
use constant DYNAMIC_LENGTHS	=> 11;
use constant DYNAMIC_CODES	=> 12;
use constant LITERAL	=> 13;
use constant REPEAT	=> 14;
use constant DISTANCE	=> 15;
use constant EXTRA_DISTANCE	=> 16;
use constant TRAILER	=> 17;
use constant DONE	=> 18;

# We start dropping bytes if the window grows beyond this;
use constant MAX_WINDOW	=> 65536;
# Minimum window we keep so backrefs will work
use constant MIN_WINDOW => 32768;
use constant BAD_VAL	=> 1000;

my $base_time;

# Class attributes:
#  state: current state
#  collect: accumulator for the current state
#  need: Need a certain number of bytes before this state can be processed
#  want: Need a certain number of bytes before this state is finished,
#        but we'll already process as soon as anything is available
#  extra: extra data, defined if and only if flags & FEXTRA
#  crc16: crc of the currently seen header bytes
#  crc32: crc of the currently seen data bytes
#  flags: header flags
#  os: This identifies the type of file system on which compression took place
#  extra flags: Extra flags (2=slow max compress, 4=fast compress)
#  mtime: mtime of this segment
#  name: filename, defined if and only if flags & FNAME
#  comment: comment, defined if and only if flags & FCOMMENT
#  final: current block is the final one
#  type:  current block type
#  bits_val: a number basically representing a sequence of bits. Will be
#            processed LSb first.
#  bits_have: the number of bits in bits_val
#  hlit:  Number of literal/length codes
#  hdist: Number of distance codes
#  lit_code: literal/length code
#  dist_code: distance code
#  window: The last 32k (or more) of this segment, for looking up backrefs
#  win_end:  Last position returned to result_callback
#  win_seen: Last position used in accounting crc32 and isize
#  isize: number of bytes modulo 2**32
#  block: account as soon as you have this amount of new bytes
#  repeat_length: length of backref to be repeated
#  pos: up to where the last buffer was processed
#       (will be the buffer end except on segment end)
#  result_callback: closure to call when output bytes are available
#  header_callback: closure to call when the header is processed
#  done_callback:   closure to call when the whole segment is finished
#  user_data:       Unused by this code, allow user to store context

sub restart {
    my $gunzip = shift;

    $gunzip->{state}	= HEADER;
    $gunzip->{need}	= 10;
    $gunzip->{collect}	= "";
    $gunzip->{isize}    = 0;
    $gunzip->{crc32}	= $gunzip->{crc16} = 0xffffffff;
    $gunzip->{bits_val} = $gunzip->{bits_have} = 0;
}

sub init {
    my ($gunzip, $options) = @_;

    $gunzip->{result_callback} = delete $options->{result};
    $gunzip->{header_callback} = delete $options->{header};
    $gunzip->{done_callback}   = delete $options->{done};
    $gunzip->{user_data}       = delete $options->{user_data};

    $gunzip->{block} = 32768;
    $gunzip->{window}   = "";
    $gunzip->{win_end}	= $gunzip->{win_seen} = 0;

    $gunzip->restart;

    return $gunzip;
}

sub new {
    my ($class, %options) = @_;
    my $gunzip = bless {}, $class;
    $gunzip->init(\%options);
    croak "Unknown options: ", join(", " => keys %options) if %options;
    return $gunzip;
}

sub text {
    my $gunzip = shift;
    croak "Flags not determined yet" unless $gunzip->{state} > HEADER;
    return $gunzip->{flags} & FTEXT ? 1 : 0;
}

sub mtime {
    my $gunzip = shift;
    croak "mtime not determined yet" unless $gunzip->{state} > HEADER;
    return $gunzip->{mtime};
}

sub last_pos {
    return shift->{pos};
}

# Return the crc of the current data
sub crc {
    my $gunzip = shift;
    return $gunzip->{state} == DONE ?
        $gunzip->{crc32} : $gunzip->{crc32} ^ 0xffffffff;
}

sub extra {
    my $gunzip = shift;
    croak "Extra not determined yet" unless $gunzip->{state} > EXTRA_DATA;
    return $gunzip->{extra};
}

sub file_name {
    my $gunzip = shift;
    croak "Filename not determined yet" unless $gunzip->{state} > NAME;
    return $gunzip->{name};
}

sub comment {
    my $gunzip = shift;
    croak "Comment not determined yet" unless $gunzip->{state} > COMMENT;
    return $gunzip->{comment};
}

# Contains the result if you didn't specify a result callback
sub window {
    my $gunzip = shift;
    return $gunzip->{window};
}

# Returns a reference to the result instead (avoid potentially huge copy)
sub window_reference {
    my $gunzip = shift;
    return \$gunzip->{window};
}

sub user_data {
    return shift->{user_data};
}

my %state_dispatcher =
    (HEADER()	=> "s_header",
     EXTRA()	=> "s_extra",
     EXTRA_DATA() => "s_extra_data",
     NAME()	=> "s_name",
     COMMENT()	=> "s_comment",
     HCRC()	=> "s_hcrc",
     BLOCK()	=> "s_block",
     LITERAL()	=> "s_deflate",
     REPEAT()	=> "s_deflate",
     DISTANCE()	=> "s_deflate",
     EXTRA_DISTANCE()	=> "s_deflate",
     UNCOMPRESSED() => "s_uncompressed",
     UNCOMPRESSED_DATA() => "s_uncompressed_data",
     DYNAMIC_SIZES() => "s_dynamic_sizes",
     DYNAMIC_LENGTHS() => "s_dynamic_lengths",
     DYNAMIC_CODES() => "s_dynamic_codes",
     TRAILER()	=> "s_trailer",
     );

my ($pos, @lit_base, @dist_base, $static_lit_code, $static_dist_code);

my $poly = oct reverse sprintf"%032bb0", 0x04C11DB7;
my @crc32 = map{for my$s(0..7) {$_ = $_>>1 ^ ($_&1 && $poly)} $_} 0..255;

my @lit_extra = (-1,
                 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,
                 3,3,3,3,4,4,4,4,5,5,5,5,0,-2,-2);
my @dist_extra = (0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,
                  9,9,10,10,11,11,12,12,13,13,-1,-1);
my @alpha_map = (16, 17, 18, 0, 8, 7, 9, 6, 10,
                 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);
sub prepare_tables {
    my $length = 3;
    for (@lit_extra) {
        push @lit_base, $length;
        $length += 1 << $_ if $_ >= 0;
    }
    # Exceptional case
    splice(@lit_base, -3, 3, 258);

    my $dist = 1;
    for (@dist_extra) {
        push @dist_base, $dist;
        $dist += 1 << $_ if $_ >= 0;
    }
    splice(@dist_base, -2, 2);
}

# construct huffman code
sub make_huffman {
    my $counts = shift;
    my (%code, @counts);
    push @{$counts[$counts->[$_]]}, $_ for 0..$#$counts;
    my $value = 0;
    my $bits = -1;
    for (@counts) {
        $value *= 2;
        next unless ++$bits && $_;
        $code{sprintf"%0${bits}b", $value++} = $_ for @$_;
    }
    # Close the code to avoid infinite loops (and out of memory)
    $code{sprintf"%0${bits}b", $value++} = BAD_VAL for
        $value .. (1 << $bits)-1;
    @code{0, 1} = (BAD_VAL, BAD_VAL) unless %code;
    return \%code;
}

sub account {
    my $gunzip = shift;

    for my $window ($gunzip->{window}) {
        my $crc32 = $gunzip->{crc32};
        $crc32 = $crc32>>8 ^ $crc32[$crc32 & 0xff^ord(substr($window, $_, 1))]
            for $gunzip->{win_seen} .. length($window)-1;
        $gunzip->{crc32} = $crc32;
        $gunzip->{isize} = ($gunzip->{isize} + length($window) - $gunzip->{win_seen}) % 2**32;
        $gunzip->{win_seen} = length($window);
    }

    return unless $gunzip->{result_callback};

    $gunzip->{result_callback}->
        ($gunzip, $gunzip->{window}, $gunzip->{win_end}, $gunzip->{user_data});
    $gunzip->{win_end} = length($gunzip->{window});
    if (length($gunzip->{window}) >= MAX_WINDOW) {
        my $cut = length($gunzip->{window}) - MIN_WINDOW;
        substr($gunzip->{window}, 0, $cut) = "";
        $gunzip->{win_end}  -= $cut;
        $gunzip->{win_seen} -= $cut;
    }
}

sub process {
    my $gunzip = shift;

    $pos = @_ > 1 ? $_[1] : 0;
    {
        if ($gunzip->{need}) {
            my $have = length($_[0])-$pos;
            my $need = $gunzip->{need}-length($gunzip->{collect});
            # print STDERR "Need $need more bytes (have $have)\n";
            if ($have < $need) {
                $gunzip->{collect} .= substr($_[0], $pos);
                return;
            }
            $gunzip->{collect} .= substr($_[0], $pos, $need);
            $pos += $need;
        }
        defined(my $fun = $state_dispatcher{$gunzip->{state}}) ||
            die "Unknown gunzip state $gunzip->{state}";
        # print STDERR "dispatch $fun (state $gunzip->{state})\n";
        redo if $gunzip->$fun($_[0]);
    }
    $gunzip->account if length($gunzip->{window}) > $gunzip->{win_seen};
    $gunzip->{pos} = $pos;
    return $gunzip->{state} == DONE;
}

sub update_crc16 {
    my $gunzip = shift;
    for my $crc16 ($gunzip->{crc16}) {
        for my $str (@_ ? shift : $gunzip->{collect}) {
            $crc16 = $crc16>>8^$crc32[$crc16&0xff^ord(substr($str, $_, 1))] for
                0..length($str)-1;
        }
    }
}

sub s_header {
    my $gunzip = shift;

    $gunzip->update_crc16;
    my ($id1, $id2, $cm, $flags, $mt, $xflags, $os) =
        unpack("CCCCVCC", $gunzip->{collect});
    if ($mt) {
        $base_time = timegm(0, 0, 0, 1, 0, 70) unless defined($base_time);
        $gunzip->{mtime} = $base_time + $mt;
    } else {
        $gunzip->{mtime} = undef;
    }
    print STDERR "id=$id1,$id2,cm=$cm,fl=$flags, mtime=$mt(", scalar gmtime($gunzip->{mtime}), " UT),xfl=$xflags,os=$os\n";
    $id1 ==  31 || croak "First id byte should be 31, not $id1";
    $id2 == 139 || croak "Second id byte should be 139, not $id2";
    $cm  ==   8 || croak "Only support deflate (method 8), not method $cm";
    croak "Unhandled flagbits in $flags" if
        $flags & ~(FTEXT | FHCRC | FEXTRA | FNAME | FCOMMENT);
    $gunzip->{os} = $os;
    $gunzip->{extra_flags} = $xflags;
    $gunzip->{flags} = $flags;
    $gunzip->{collect} = "";
    $gunzip->{extra}   = undef unless $flags & FEXTRA;
    $gunzip->{name}    = undef unless $flags & FNAME;
    $gunzip->{comment} = undef unless $flags & FCOMMENT;
    if ($flags & FEXTRA) {
        $gunzip->{state} = EXTRA;
        $gunzip->{need}	 = 2;
    } elsif ($flags & FNAME) {
        $gunzip->{state} = NAME;
        $gunzip->{need} = 0;
    } elsif ($flags & FCOMMENT) {
        $gunzip->{state} = COMMENT;
    }  elsif ($flags & FHCRC) {
        $gunzip->{state} = HCRC;
        $gunzip->{need}	 = 2;
    } else {
        $gunzip->{state} = BLOCK;
        $gunzip->{need} = 0;
        $gunzip->{header_callback}->($gunzip) if $gunzip->{header_callback};
    }
    return 1;
}

sub s_extra {
    my $gunzip = shift;

    $gunzip->update_crc16;
    $gunzip->{need} = unpack("v", $gunzip->{collect});
    $gunzip->{collect} = "";
    $gunzip->{state} = EXTRA_DATA;
    return 1;
}

sub s_extra_data {
    my $gunzip = shift;

    $gunzip->update_crc16;
    $gunzip->{extra} = $gunzip->{collect};
    $gunzip->{collect} = "";
    if ($gunzip->{flags} & FNAME) {
        $gunzip->{state} = NAME;
        $gunzip->{need} = 0;
    } elsif ($gunzip->{flags} & FCOMMENT) {
        $gunzip->{state} = COMMENT;
        $gunzip->{need} = 0;
    }  elsif ($gunzip->{flags} & FHCRC) {
        $gunzip->{state} = HCRC;
        $gunzip->{need} = 2;
    } else {
        $gunzip->{state} = BLOCK;
        $gunzip->{need} = 0;
        $gunzip->{header_callback}->($gunzip) if $gunzip->{header_callback};
    }
    return 1;
}

sub s_name {
    my $gunzip = shift;

    my $p = index($_[0], "\0", $pos);
    if ($p < $pos) {
        $gunzip->{collect} .= substr($_[0], $pos);
        $pos = length($_[0]);
        return;
    }
    $gunzip->{name} = $gunzip->{collect} . substr($_[0], $pos, $p-$pos);
    print STDERR "  Filename '$gunzip->{name}'\n";
    $gunzip->update_crc16($gunzip->{name});
    $gunzip->update_crc16("\0");
    $pos = $p+1;
    $gunzip->{collect} = "";
    if ($gunzip->{flags} & FCOMMENT) {
        $gunzip->{state} = COMMENT;
    }  elsif ($gunzip->{flags} & FHCRC) {
        $gunzip->{state} = HCRC;
        $gunzip->{need} = 2;
    } else {
        $gunzip->{state} = BLOCK;
        $gunzip->{need} = 0;
        $gunzip->{header_callback}->($gunzip) if $gunzip->{header_callback};
    }
    return 1;
}

sub s_comment {
    my $gunzip = shift;

    my $p = index($_[0], "\0", $pos);
    if ($p < $pos) {
        $gunzip->{collect} .= substr($_[0], $pos);
        $pos = length($_[0]);
        return;
    }
    $gunzip->{comment} = $gunzip->{collect} . substr($_[0], $pos, $p-$pos);
    $gunzip->update_crc16($gunzip->{comment});
    $gunzip->update_crc16("\0");
    $pos = $p+1;
    $gunzip->{collect} = "";
    if ($gunzip->{flags} & FHCRC) {
        $gunzip->{state} = HCRC;
        $gunzip->{need} = 2;
    } else {
        $gunzip->{state} = BLOCK;
        $gunzip->{need} = 0;
        $gunzip->{header_callback}->($gunzip) if $gunzip->{header_callback};
    }
    return 1;
}

sub s_hcrc {
    my $gunzip = shift;

    $gunzip->{crc16} = ($gunzip->{crc16} ^ 0xffffffff) & 0xffff;
    my $wanted_crc16 = unpack("v", $gunzip->{collect});
    print STDERR "crc16=$gunzip->{crc16}, wanted_crc16=$wanted_crc16\n";
    $gunzip->{crc16} == $wanted_crc16 ||
        croak "Header CRC16=$gunzip->{crc16}, expected $wanted_crc16";

    $gunzip->{collect} = "";
    $gunzip->{state} = BLOCK;
    $gunzip->{need} = 0;
    $gunzip->{header_callback}->($gunzip) if $gunzip->{header_callback};
    return 1;
}

sub s_block {
    my $gunzip = shift;

    if ($gunzip->{bits_have} < 3) {
        return if $pos >= length($_[0]);
        $gunzip->{bits_val} |= ord(substr($_[0], $pos++, 1)) << $gunzip->{bits_have};
        $gunzip->{bits_have} += 8;
    }

    $gunzip->{final} = $gunzip->{bits_val} & 1;
    $gunzip->{bits_val} >>= 1;
    $gunzip->{type}  = $gunzip->{bits_val} & 3;
    $gunzip->{bits_val} >>= 2;
    $gunzip->{bits_have} -= 3;

    print STDERR "  block type $gunzip->{type}\n";
    if ($gunzip->{type} == 0) {
        # Not compressed
        $gunzip->{bits_val} = $gunzip->{bits_have} = 0;
        $gunzip->{collect} = "";
        $gunzip->{need} = 4;
        $gunzip->{state} = UNCOMPRESSED;
    } elsif ($gunzip->{type} == 1) {
        prepare_tables() unless @lit_base;
        $gunzip->{lit_code}  = $static_lit_code  ||=
            make_huffman([(8)x144,(9)x112, (7)x24, (8)x8]);
        $gunzip->{dist_code} = $static_dist_code ||=
            make_huffman([(5)x32]);
        $gunzip->{collect} = "";
        $gunzip->{need} = 0;
        $gunzip->{state} = LITERAL;
    } elsif ($gunzip->{type} == 2) {
        prepare_tables() unless @lit_base;
        $gunzip->{state} = DYNAMIC_SIZES;
        $gunzip->{collect} = "";
        $gunzip->{need} = 0;

    } else {
        croak "deflate subtype $gunzip->{type} not supported";
    }
    return 1;
}

sub s_uncompressed {
    my $gunzip = shift;

    my ($len, $nlen) = unpack("vv", $gunzip->{collect});
    $len == (~$nlen & 0xffff) ||
        croak "$len is not the 1-complement of $nlen";
    $gunzip->{state} = UNCOMPRESSED_DATA;
    $gunzip->{collect} = "";
    $gunzip->{need} = 0;
    $gunzip->{want} = $len;
    return 1;
}

sub s_uncompressed_data {
    my $gunzip = shift;

    # print STDERR "Want $gunzip->{want} bytes, first few are ", unpack("H*", substr($_[0], $pos, 5)), "\n";
    for my $window ($gunzip->{window}) {
        if (length($_[0])-$pos >= $gunzip->{want}) {
            $window .= substr($_[0], $pos, $gunzip->{want});
            $pos += $gunzip->{want};
            $gunzip->account if
                length($window) >= $gunzip->{win_seen} + $gunzip->{block};
            if ($gunzip->{final}) {
                $gunzip->{need} = 8;
                $gunzip->{state} = TRAILER;
            } else {
                $gunzip->{state} = BLOCK;
            }
            return 1;
        } else {
            my $l = length($_[0])-$pos;
            $window .= substr($_[0], $pos);
            $gunzip->{want} -= $l;
            $pos = length($_[0]);
            return;
        }
    }
}

sub s_dynamic_sizes {
    my $gunzip = shift;

    while ($gunzip->{bits_have} < 14) {
        return if $pos >= length($_[0]);
        $gunzip->{bits_val} |= ord(substr($_[0], $pos++, 1)) << $gunzip->{bits_have};
        $gunzip->{bits_have} += 8;
    }
    $gunzip->{hlit}  = 257+($gunzip->{bits_val} & 0x1f);
    $gunzip->{bits_val} >>= 5;
    $gunzip->{hdist} =   1+($gunzip->{bits_val} & 0x1f);
    $gunzip->{bits_val} >>= 5;
    $gunzip->{want}  =   4+($gunzip->{bits_val} & 0x0f);
    $gunzip->{bits_val} >>= 4;
    $gunzip->{bits_have} -= 14;
    # print STDERR "hlit=$gunzip->{hlit},hdist=$gunzip->{hdist},hclen=$gunzip->{want}\n";

    $gunzip->{collect} = "";
    $gunzip->{need} = 0;
    $gunzip->{lit_code} = [];
    $gunzip->{state} = DYNAMIC_LENGTHS;
    return 1;
}

sub s_dynamic_lengths {
    my $gunzip = shift;

    my ($bits_have, $bits_val, $want, $code) = @{$gunzip}{
        qw(bits_have bits_val want lit_code)};
    while (@$code < $want) {
        if ($bits_have < 3) {
            if ($pos >= length($_[0])) {
                @{$gunzip}{qw(bits_have bits_val)} = ($bits_have, $bits_val);
                return;
            }
            $bits_val |= ord(substr($_[0], $pos++, 1)) << $bits_have;
            $bits_have += 8;
        }
        push @$code, $bits_val & 0x07;
        $bits_val >>= 3;
        $bits_have -= 3;
    }
    # Build the code length huffman code
    my @alpha_code = (0) x @alpha_map;
    @alpha_code[@alpha_map[0..$#$code]] = @$code;
    @{$gunzip}{qw(state bits_have bits_val collect want lit_code dist_code)} =
        (DYNAMIC_CODES, $bits_have, $bits_val, "",
         $gunzip->{hlit} + $gunzip->{hdist}, make_huffman(\@alpha_code), []);
    return 1;
}

sub s_dynamic_codes {
    my $gunzip = shift;

    my ($bits_have, $bits_val, $want, $huff, $alpha_code, $code_len) = @{$gunzip}{
        qw(bits_have bits_val want collect lit_code dist_code)};
    while (@$code_len < $want) {
        until (exists $alpha_code->{$huff}) {
            if (--$bits_have < 0) {
                $bits_val = ord substr($_[0], $pos++, 1);
                unless ($bits_val || $pos <= length($_[0])) {
                    $pos = length($_[0]);
                    $gunzip->{collect} = $huff;
                    $gunzip->{bits_have} = 0;
                    return;
                }
                $bits_have = 7;
            }
            $huff .= $bits_val & 1 ? "1" : "0";
            $bits_val >>= 1;
        }
        my $alpha = $alpha_code->{$huff};
        if ($alpha < 16) {
            push @$code_len, $alpha;
        } elsif ($alpha == 16) {
            if ($bits_have < 2) {
                if ($pos >= length($_[0])) {
                    @{$gunzip}{qw(bits_have bits_val collect)} =
                        ($bits_have, $bits_val, $huff);
                    return;
                }
                $bits_val |= ord(substr($_[0], $pos++, 1)) << $bits_have;
                $bits_have += 8;
            }
            push @$code_len, ($code_len->[-1]) x (3 + ($bits_val & 0x03));
            $bits_val >>= 2;
            $bits_have -= 2;
        } elsif ($alpha == 17) {
            if ($bits_have < 3) {
                if ($pos >= length($_[0])) {
                    @{$gunzip}{qw(bits_have bits_val collect)} =
                        ($bits_have, $bits_val, $huff);
                    return;
                }
                $bits_val |= ord(substr($_[0], $pos++, 1)) << $bits_have;
                $bits_have += 8;
            }
            push @$code_len, (0) x (3 + ($bits_val & 0x07));
            $bits_val >>= 3;
            $bits_have -= 3;
        } elsif ($alpha == 18) {
            if ($bits_have < 7) {
                if ($pos >= length($_[0])) {
                    @{$gunzip}{qw(bits_have bits_val collect)} =
                        ($bits_have, $bits_val, $huff);
                    return;
                }
                $bits_val |= ord(substr($_[0], $pos++, 1)) << $bits_have;
                $bits_have += 8;
            }
            push @$code_len, (0) x (11 + ($bits_val & 0x7f));
            $bits_val >>= 7;
            $bits_have -= 7;
        } else {
            die "Invalid alpha $alpha";
        }
        $huff = "";
    }
    @$code_len == $want || croak "Too many codes";
    my @lit_len = splice(@$code_len, 0, $gunzip->{hlit});
    @{$gunzip}{qw(state bits_have bits_val collect lit_code dist_code)} =
        (LITERAL, $bits_have, $bits_val, "",
         make_huffman(\@lit_len), make_huffman($code_len));
    return 1;
}

sub s_deflate {
    my $gunzip = shift;
    my ($lit_code, $dist_code, $bits_have, $bits_val, $win_full, $length) =
        @{$gunzip}{qw(lit_code dist_code bits_have bits_val win_seen repeat_length)};
    $win_full += $gunzip->{block};
    for my $window ($gunzip->{window}) { for my $huff ($gunzip->{collect}) { for my $input ($_[0]) {
        # Pulling these variables out of the loop is ugly, but gains 1% speed
        my ($lit, $d, $dist, $e);
        my $l = length($input);
        goto REPEAT   if $gunzip->{state} == REPEAT;
        goto DISTANCE if $gunzip->{state} == DISTANCE;
        goto EXTRA_DISTANCE if $gunzip->{state} == EXTRA_DISTANCE;
        die "Unexpected state $gunzip->{state}" unless
            $gunzip->{state} == LITERAL;
        {
            if (--$bits_have < 0) {
                $bits_val = ord substr($input, $pos++, 1);
                unless ($bits_val || $pos <= $l) {
                    $pos = $l;
                    $gunzip->{state} = LITERAL;
                    $gunzip->{bits_have} = 0;
                    return;
                }
                $bits_have = 7;
            }
            $huff .= $bits_val & 1 ? "1" : "0";
            $bits_val >>= 1;
            redo unless exists $lit_code->{$huff};
          REPEAT:
            $lit = $lit_code->{$huff};
            if ($lit < 256) {
                $window .= chr($lit);
            } else {
                $length = $lit_base[$lit -= 256];
                if ($e = $lit_extra[$lit]) {
                    if ($bits_have < $e) {
                        if ($pos >= $l) {
                            @{$gunzip}{qw(state bits_have bits_val)} =
                                (REPEAT, $bits_have, $bits_val);
                            return;
                        }
                        $bits_val |= ord(substr($input, $pos++, 1)) << $bits_have;
                        $bits_have += 8;
                    } elsif ($e < 0) {
                        die "Invalid literal code" if $lit;
                        last;
                    }
                    $length += $bits_val & (1 << $e)-1;
                    $bits_val >>= $e;
                    $bits_have -= $e;
                } elsif (!defined($length)) {
                    die "Bad literal code $huff";
                }
                $huff = "";
              DISTANCE:
                {
                    if (--$bits_have < 0) {
                        $bits_val = ord substr($input, $pos++, 1);
                        unless ($bits_val || $pos <= $l) {
                            $pos = $l;
                            $gunzip->{state}= DISTANCE;
                            $gunzip->{bits_have} = 0;
                            $gunzip->{repeat_length} = $length;
                            return;
                        }
                        $bits_have = 7;
                    }
                    $huff .= $bits_val & 1 ? "1" : "0";
                    $bits_val >>= 1;
                    redo unless exists $dist_code->{$huff};
                }
              EXTRA_DISTANCE:
                $d = $dist_code->{$huff};
                die "Invalid distance code" if $d >= 30;
                $dist = $dist_base[$d];
                if ($e = $dist_extra[$d]) {
                    while ($bits_have < $e) {
                        if ($pos >= $l) {
                            @{$gunzip}{qw(state bits_have bits_val repeat_length)} =
                                (EXTRA_DISTANCE, $bits_have, $bits_val, $length);
                            return;
                        }
                        $bits_val |= ord(substr($input, $pos++, 1)) << $bits_have;
                        $bits_have += 8;
                    }
                    $dist += $bits_val & (1 << $e)-1;
                    $bits_val >>= $e;
                    $bits_have -= $e;
                }
                if ($length <= $dist) {
                    $window .= substr($window, -$dist, $length);
                } else {
                    $window .= substr($window, -$dist, 1) for 1..$length;
                }
            }
            $huff = "";
            if (length($window) >= $win_full) {
                $gunzip->account;
                $win_full = $gunzip->{win_seen} + $gunzip->{block};
            }
            redo;
        }
    }}}
    @{$gunzip}{qw(bits_have bits_val)} = ($bits_have, $bits_val);
    if ($gunzip->{final}) {
        $gunzip->{collect} = "";
        $gunzip->{need} = 8;
        $gunzip->{state} = TRAILER;
    } else {
        $gunzip->{state} = BLOCK;
    }
    return 1;
}

sub s_trailer {
    my $gunzip = shift;

    $gunzip->account if length($gunzip->{window}) > $gunzip->{win_seen};
    $gunzip->{pos} = $pos;
    $gunzip->{crc32} ^= 0xffffffff;

    my ($wanted_crc32, $wanted_isize) = unpack("VV", $gunzip->{collect});
    print STDERR "crc32=$gunzip->{crc32}, wanted_crc32=$wanted_crc32, isize=$gunzip->{isize}, wanted_isize=$wanted_isize\n";
    $gunzip->{crc32} == $wanted_crc32 ||
        die "CRC32=$gunzip->{crc32}, expected $wanted_crc32\n";
    $gunzip->{isize} == $wanted_isize ||
        die "element size=$gunzip->{isize}, expected $wanted_isize\n";
    $gunzip->{state} = DONE;

    # Clean up window for a possible restart
    if ($gunzip->{result_callback}) {
        substr($gunzip->{window}, 0, $gunzip->{win_end}) = "";
        $gunzip->{win_seen} -= $gunzip->{win_end};
        die "Seen below end" if $gunzip->{win_seen} < 0;
        $gunzip->{win_end} = 0;
    }

    $gunzip->{done_callback}->($gunzip) if $gunzip->{done_callback};
    return;
}

sub driver {
    my ($class, $file) = @_;
    my $to = $file;
    $to =~ s/\.gz\z//i || die "Filename $to does not end on .gz\n";
    my $new = "$to.new.$$";
    open(my $fout, ">", $new) || die "Could not create $new: $!";
    eval {
        open(my $fin, "<", $file) || die "Could not open $file: $!";
        binmode $fin;
        # Make this \1 for a state torture test
        local $/ = \8192;
        local $_;
        my $gunzip = $class->new
            (header => sub { binmode $fout unless shift->text },
             result => sub { print   $fout substr($_[1], $_[2]) });
        while (<$fin>) {
            goto DONE if $gunzip->process($_);
        }
        die "File $file is finished, the gzip stream isn't\n";
      DONE:
        close $fout;
        defined(my $mtime = $gunzip->{mtime}) || croak "No mtime in $file";
        utime $mtime, $mtime, $new;
        rename($new, $to) || die "Could not rename $new to $to: $!";
    };
    if ($@) {
        close $fout;
        unlink($new) || die "Could not unlink $new: $! after $@";
        die $@;
    }

}

1;
