- speedup uncompress function

- factorize code

2 files changed, 209 insertions, 148 deletions

diff --git a/Packdrakeng.pm b/Packdrakeng.pm
index 6e13d65..e822dad 100644
--- a/Packdrakeng.pm
+++ b/Packdrakeng.pm
@@ -156,6 +156,7 @@ sub choose_compression_method {
 
 sub DESTROY {
     my ($pack) = @_;
+    $pack->{subuncompress}($pack, undef, undef);
     $pack->build_toc();
     close($pack->{handle}) if ($pack->{handle});
 }
@@ -256,6 +257,17 @@ sub read_toc {
     1;
 }
 
+sub sort_files_by_packing {
+    my ($pack, @files) = @_;
+    sort {
+        defined($pack->{files}{$a}) && defined($pack->{files}{$b}) ?
+            ($pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
+            $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
+            $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}) :
+        $a cmp $b
+    } @files;
+}
+
 # Goto to the end of written compressed data
 sub end_seek {
     my ($pack) = @_;
@@ -340,55 +352,89 @@ sub extern_compress {
 sub extern_uncompress {
     my ($pack, $destfh, $fileinfo) = @_;
 
+    if (defined($pack->{ustream_data}) && (
+            !defined($fileinfo) ||
+            ($fileinfo->{coff} != $pack->{ustream_data}{coff} || $fileinfo->{off} < $pack->{ustream_data}{off})
+        )) {
+        close($pack->{ustream_data}{handle});
+        unlink($pack->{ustream_data}{tempname}); # deleting temp file
+        $pack->{ustream_data} = undef;
+    }
+    
+    defined($fileinfo) or return 0;
     # We have to first extract the block to a temp file, burk !
-    my ($tempfh, $tempname) = tempfile();
-
-    my $cread = 0;
-    while ($cread < $fileinfo->{csize}) {
-        my $cl = sysread($pack->{handle}, my $data,
-            $cread + $pack->{bufsize} > $fileinfo->{csize} ?
-                $fileinfo->{csize} - $cread :
-                $pack->{bufsize}) or do {
-                $pack->{log}("Unexpected end of file");
+    
+    if (!defined($pack->{ustream_data})) {
+        my $tempfh;
+        $pack->{ustream_data}{coff} = $fileinfo->{coff};
+        $pack->{ustream_data}{read} = 0;
+
+        ($tempfh, $pack->{ustream_data}{tempname}) = tempfile();
+
+        my $cread = 0;
+        while ($cread < $fileinfo->{csize}) {
+            my $cl = sysread($pack->{handle}, my $data,
+                $cread + $pack->{bufsize} > $fileinfo->{csize} ?
+                    $fileinfo->{csize} - $cread :
+                    $pack->{bufsize}) or do {
+                    $pack->{log}("Unexpected end of file");
+                    close($tempfh);
+                    unlink($pack->{ustream_data}{tempname});
+                    $pack->{ustream_data} = undef;
+                    return -1;
+            };
+            $cread += $cl;
+            syswrite($tempfh, $data) == length($data) or do {
+                $pack->{log}("Can't write all data into temp file");
                 close($tempfh);
-                unlink($tempname);
+                unlink($pack->{ustream_data}{tempname});
+                $pack->{ustream_data} = undef;
                 return -1;
-        };
-        $cread += $cl;
-        syswrite($tempfh, $data) == length($data) or do {
-            $pack->{log}("Can't write all data into temp file");
-            close($tempfh);
-            unlink($tempname);
+            };
+        }
+        close($tempfh);
+        
+        CORE::open($pack->{ustream_data}{handle}, "cat '$pack->{ustream_data}{tempname}' | $pack->{uncompress_method} |") or do {
+            $pack->{log}("Can't start $pack->{uncompress_method} to uncompress data");
+            unlink($pack->{ustream_data}{tempname});
+            $pack->{ustream_data} = undef;
             return -1;
         };
+        binmode($pack->{ustream_data}{handle});
     }
-    close($tempfh);
-
-    CORE::open(my $hc, "cat '$tempname' | $pack->{uncompress_method} |") or do {
-        $pack->{log}("Can't start $pack->{uncompress_method} to uncompress data");
-        unlink($tempname);
-        return -1;
-    };
-    binmode($hc);
 
     my $byteswritten = 0;
-    my $read = 0;
+    $pack->{ustream_data}{off} = $fileinfo->{off};
+    #my $read = 0;
 
     while ($byteswritten < $fileinfo->{size}) {
-        my $length = sysread($hc, my $data, $pack->{bufsize}) or do {
-            $pack->{log}("Unexpected end of stream $tempname");
-            #unlink($tempname);
-            close($hc);
-            return -1;
-        };
-
-        if ($read < $fileinfo->{off} && $read + $length > $fileinfo->{off}) {
-            $data = substr($data, $fileinfo->{off} - $read);
+        my $data = $pack->{ustream_data}{buf};
+        $pack->{ustream_data}{buf} = undef;
+        my $length = 0;
+        if (!defined($data)) {
+            $length = sysread($pack->{ustream_data}{handle}, $data, $pack->{bufsize}) or do {
+                $pack->{log}("Unexpected end of stream $pack->{ustream_data}{tempname}");
+                unlink($pack->{ustream_data}{tempname});
+                close($pack->{ustream_data}{handle});
+                $pack->{ustream_data} = undef;
+                return -1;
+            };
         }
-        $read += $length;
-        if ($read <= $fileinfo->{off}) { next }
 
-        my $bw = $byteswritten + length($data) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($data);
+        if ($pack->{ustream_data}{read} < $fileinfo->{off} && $pack->{ustream_data}{read} + $length > $fileinfo->{off}) {
+            $data = substr($data, $fileinfo->{off} - $pack->{ustream_data}{read});
+        }
+        $pack->{ustream_data}{read} += $length;
+        if ($pack->{ustream_data}{read} <= $fileinfo->{off}) { next }
+
+        my $bw;
+        if ($byteswritten + length($data) > $fileinfo->{size}) {
+            $bw = $fileinfo->{size} - $byteswritten;
+            $pack->{ustream_data}{buf} = substr($data, $bw); # keeping track of unwritten uncompressed data
+        } else {
+            $bw = length($data);
+        }
+        
         syswrite($destfh, $data, $bw) == $bw or do {
             $pack->{log}("Can't write data into dest");
             return -1;
@@ -396,8 +442,6 @@ sub extern_uncompress {
         $byteswritten += $bw;
     }
 
-    close($hc);
-    unlink($tempname); # deleting temp file
     $byteswritten
 
 }
@@ -427,11 +471,7 @@ sub extract_block {
     syswrite($handle, $buf);
     }
 
-    foreach (sort {
-            $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
-            $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
-            $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}
-        } keys %{$pack->{files}}) {
+    foreach ($pack->sort_files_by_packing(keys %{$pack->{files}})) {
         $pack->{files}{$_}{coff} == $pack->{files}{$file}->{coff} or next;
     }
 
@@ -524,43 +564,42 @@ sub extract_virtual {
 }
 
 sub extract {
-    my ($pack, $destdir, @file) = @_;
-    foreach my $f (@file) {
-	my $dest = $destdir ? "$destdir/$f" : "$f";
-	my ($dir) = $dest =~ m!(.*)/.*!;
-	if (exists($pack->{dir}{$f})) {
-	    -d $dest || mkpath($dest)
-		or $pack->{log}("Unable to create dir $dest: $!");
-	    next;
-	} elsif (exists($pack->{'symlink'}{$f})) {
-	    -d $dir || mkpath($dir) or
-	    $pack->{log}("Unable to create dir $dest: $!");
-	    -l $dest and unlink $dest;
-	    symlink($pack->{'symlink'}{$f}, $dest)
-		or $pack->{log}("Unable to extract symlink $f: $!");
-	    next;
-	} elsif (exists($pack->{files}{$f})) {
-	    -d $dir || mkpath($dir) or do {
-		$pack->{log}("Unable to create dir $dir");
-	    };
-	    if (-l $dest) {
-		unlink($dest) or do {
-		    $pack->{log}("Can't remove link $dest: $!");
-		    next; # Don't overwrite a file because where the symlink point to
-		};
-	    }
-	    sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY)
-		or do {
-		$pack->{log}("Unable to extract $dest");
-		next;
-	    };
-	    my $written = $pack->extract_virtual($destfh, $f);
-	    $written == -1 and $pack->{log}("Unable to extract file $f");
-	    close($destfh);
-	    next;
-	} else {
-	    $pack->{log}("Can't find $f in archive");
-	}
+    my ($pack, $destdir, @files) = @_;
+    foreach my $f ($pack->sort_files_by_packing(@files)) {
+        my $dest = $destdir ? "$destdir/$f" : "$f";
+        my ($dir) = $dest =~ m!(.*)/.*!;
+        if (exists($pack->{dir}{$f})) {
+            -d $dest || mkpath($dest)
+            or $pack->{log}("Unable to create dir $dest: $!");
+            next;
+        } elsif (exists($pack->{'symlink'}{$f})) {
+            -d $dir || mkpath($dir) or
+            $pack->{log}("Unable to create dir $dest: $!");
+            -l $dest and unlink $dest;
+            symlink($pack->{'symlink'}{$f}, $dest)
+            or $pack->{log}("Unable to extract symlink $f: $!");
+            next;
+        } elsif (exists($pack->{files}{$f})) {
+	        -d $dir || mkpath($dir) or do {
+		        $pack->{log}("Unable to create dir $dir");
+	        };
+	        if (-l $dest) {
+		        unlink($dest) or do {
+		            $pack->{log}("Can't remove link $dest: $!");
+		            next; # Don't overwrite a file because where the symlink point to
+		        };
+	        }
+	        sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY) or do {
+    		    $pack->{log}("Unable to extract $dest");
+	        	next;
+	        };
+	        my $written = $pack->extract_virtual($destfh, $f);
+	        $written == -1 and $pack->{log}("Unable to extract file $f");
+	        close($destfh);
+	        next;
+        } else {
+            $pack->{log}("Can't find $f in archive");
+        }
     }
     1;
 }
@@ -568,7 +607,11 @@ sub extract {
 # Return \@dir, \@files, \@symlink list
 sub getcontent {
     my ($pack) = @_;
-    return([ keys(%{$pack->{dir}})], [ keys(%{$pack->{files}}) ], [ keys(%{$pack->{'symlink'}}) ]);
+    return(
+        [ keys(%{$pack->{dir}})],
+        [ $pack->sort_files_by_packing(keys %{$pack->{files}}) ], 
+        [ keys(%{$pack->{'symlink'}}) ]
+    );
 }
 
 sub infofile {
@@ -593,11 +636,7 @@ sub list {
     foreach my $file (keys %{$pack->{'symlink'}}) {
         printf "l %13c %s -> %s\n", ' ', $file, $pack->{'symlink'}{$file};
     }
-    foreach my $file (sort {
-            $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
-            $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
-            $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}
-        } keys %{$pack->{files}}) {
+    foreach my $file ($pack->sort_files_by_packing(keys %{$pack->{files}})) {
         printf "f %12d %s\n", $pack->{files}{$file}{size}, $file;
     }
 }
@@ -612,11 +651,7 @@ sub dumptoc {
     foreach my $file (keys %{$pack->{'symlink'}}) {
         printf $handle "l %13c %s -> %s\n", ' ', $file, $pack->{'symlink'}{$file};
     }
-    foreach my $file (sort {
-            $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ?
-            $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} :
-            $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff}
-        } keys %{$pack->{files}}) {
+    foreach my $file ($pack->sort_files_by_packing(keys %{$pack->{files}})) {
         printf $handle "f %d %d %d %d %s\n", $pack->{files}{$file}{size}, $pack->{files}{$file}{off}, $pack->{files}{$file}{csize}, $pack->{files}{$file}{coff}, $file;
     }
 }
diff --git a/Packdrakeng/zlib.pm b/Packdrakeng/zlib.pm
index 03673d2..72fe9e2 100644
--- a/Packdrakeng/zlib.pm
+++ b/Packdrakeng/zlib.pm
@@ -73,75 +73,101 @@ sub gzip_compress {
 
 sub gzip_uncompress {
     my ($pack, $destfh, $fileinfo) = @_;
-    my $x = inflateInit(
-        -WindowBits     =>  - MAX_WBITS(),
-    );
-    my $cread = 0; # Compressed data read
-    {
-        my $buf;
-        # get magic
-        if (sysread($pack->{handle}, $buf, 2) == 2) {
-            my @magic = unpack("C*", $buf);
-            $magic[0] == Compress::Zlib::MAGIC1 && $magic[1] == Compress::Zlib::MAGIC2 or do {
-                warn("Wrong magic header found");
-                return -1;
-            };
-        } else {
-            warn("Unexpect end of file while reading magic");
-            return -1;
-        }
-        my ($method, $flags);
-        if (sysread($pack->{handle}, $buf, 2) == 2) {
-            ($method, $flags) = unpack("C2", $buf);
-        } else {
-            warn("Unexpect end of file while reading flags");
-            return -1;
-        }
 
-        if (sysread($pack->{handle}, $buf, 6) != 6) {
-            warn("Unexpect end of file while reading gzip header");
-            return -1;
-        }
+    if (!defined $fileinfo) {
+        $pack->{ustream_data} = undef;
+        return 0;
+    }
+
+    if (defined($pack->{ustream_data}) && ($fileinfo->{coff} != $pack->{ustream_data}{coff} || $fileinfo->{off} < $pack->{ustream_data}{off})) {
+        $pack->{ustream_data} = undef;
+    }
 
-        $cread += 12; #Gzip header fixed size is already read
-        if ($flags & 0x04) {
+    if (!defined($pack->{ustream_data})) {
+        $pack->{ustream_data}{coff} = $fileinfo->{coff};
+        $pack->{ustream_data}{read} = 0; # uncompressed data read
+        $pack->{ustream_data}{x} = inflateInit(
+            -WindowBits     =>  - MAX_WBITS(),
+        );
+        $pack->{ustream_data}{cread} = 0; # Compressed data read
+        {
+            my $buf;
+            # get magic
             if (sysread($pack->{handle}, $buf, 2) == 2) {
-                my $len = unpack("I", $buf);
-                $cread += $len;
-                if (sysread($pack->{handle}, $buf, $len) != $len) {
-                    warn("Unexpect end of file while reading gzip header");
+                my @magic = unpack("C*", $buf);
+                $magic[0] == Compress::Zlib::MAGIC1 && $magic[1] == Compress::Zlib::MAGIC2 or do {
+                    warn("Wrong magic header found");
                     return -1;
-                }
+                };
+            } else {
+                warn("Unexpect end of file while reading magic");
+                return -1;
+            }
+            my ($method, $flags);
+            if (sysread($pack->{handle}, $buf, 2) == 2) {
+                ($method, $flags) = unpack("C2", $buf);
             } else {
+                warn("Unexpect end of file while reading flags");
+                return -1;
+            }
+
+            if (sysread($pack->{handle}, $buf, 6) != 6) {
                 warn("Unexpect end of file while reading gzip header");
                 return -1;
             }
+
+            $pack->{ustream_data}{cread} += 12; #Gzip header fixed size is already read
+            if ($flags & 0x04) {
+                if (sysread($pack->{handle}, $buf, 2) == 2) {
+                    my $len = unpack("I", $buf);
+                    $pack->{ustream_data}{cread} += $len;
+                    if (sysread($pack->{handle}, $buf, $len) != $len) {
+                        warn("Unexpect end of file while reading gzip header");
+                        return -1;
+                    }
+                } else {
+                    warn("Unexpect end of file while reading gzip header");
+                    return -1;
+                }
+            }
         }
+    } else {
+        sysseek($pack->{handle}, $pack->{ustream_data}{cread} - 2, 1);
     }
+    $pack->{ustream_data}{off} = $fileinfo->{off};
     my $byteswritten = 0;
-    my $read = 0; # uncompressed data read
     while ($byteswritten < $fileinfo->{size}) {
-        my $cl=sysread($pack->{handle}, my $buf, 
-            $cread + $pack->{bufsize} > $fileinfo->{csize} ? 
-                $fileinfo->{csize} - $cread : 
-                $pack->{bufsize}) or do {
-            warn("Enexpected end of file");
-            return -1;
-        };
-        $cread += $cl;
-        my ($out, $status) = $x->inflate(\$buf);
-        $status == Z_OK || $status == Z_STREAM_END or do {
-            warn("Unable to uncompress data");
-            return -1;
-        };
-        my $l = length($out) or next;
-        if ($read < $fileinfo->{off} && $read + $l > $fileinfo->{off}) {
-            $out = substr($out, $fileinfo->{off} - $read);    
+        my ($l, $out, $status) = (0, $pack->{ustream_data}{buf});
+        $pack->{ustream_data}{buf} = undef;
+        if (!defined($out)) {
+            my $cl=sysread($pack->{handle}, my $buf, 
+                $pack->{ustream_data}{cread} + $pack->{bufsize} > $fileinfo->{csize} ? 
+                    $fileinfo->{csize} - $pack->{ustream_data}{cread} : 
+                    $pack->{bufsize}) or do {
+                warn("Enexpected end of file");
+                return -1;
+            };
+            $pack->{ustream_data}{cread} += $cl;
+            ($out, $status) = $pack->{ustream_data}{x}->inflate(\$buf);
+            $status == Z_OK || $status == Z_STREAM_END or do {
+                warn("Unable to uncompress data");
+                return -1;
+            };
+            $l = length($out) or next;
+        }
+        if ($pack->{ustream_data}{read} < $fileinfo->{off} && $pack->{ustream_data}{read} + $l > $fileinfo->{off}) {
+            $out = substr($out, $fileinfo->{off} - $pack->{ustream_data}{read});    
+        }
+        $pack->{ustream_data}{read} += $l;
+        if ($pack->{ustream_data}{read} <= $fileinfo->{off}) { next }
+       
+        my $bw;
+        if ($byteswritten + length($out) > $fileinfo->{size}) {
+            $bw = $fileinfo->{size} - $byteswritten;
+            $pack->{ustream_data}{buf} = substr($out, $bw); # keeping track of unwritten uncompressed data
+        } else {
+            $bw = length($out);
         }
-        $read += $l;
-        if ($read <= $fileinfo->{off}) { next }
-        
-        my $bw = $byteswritten + length($out) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($out);
         syswrite($destfh, $out, $bw) == $bw or do {
             warn "Can't write data into dest";
             return -1;