r8893 - in /scripts/qa/DebianQA: Archive.pm Watch.pm

[tincho-guest at users.alioth.debian.org]

Author: tincho-guest
Date: Tue Nov  6 08:15:39 2007
New Revision: 8893

URL: http://svn.debian.org/wsvn/?sc=1&rev=8893
Log:
For some reason, the in-memory decompression was awfully slow. I found a way to
avoid that using a couple of temporary anonymous files.

Modified:
    scripts/qa/DebianQA/Archive.pm
    scripts/qa/DebianQA/Watch.pm

Modified: scripts/qa/DebianQA/Archive.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Archive.pm?rev=8893&op=diff
==============================================================================
--- scripts/qa/DebianQA/Archive.pm (original)
+++ scripts/qa/DebianQA/Archive.pm Tue Nov  6 08:15:39 2007
@@ -21,10 +21,10 @@
 use DebianQA::Config '%CFG';
 use DebianQA::Svn;
 use DebianQA::DebVersions;
+use Fcntl qw(:seek);
 use LWP::UserAgent;
 #use IO::Uncompress::Gunzip; # Only in lenny
-use IO::Scalar;
-use Compress::Zlib;
+use Compress::Zlib ();
 use HTML::TableExtract;
 
 my $ua = new LWP::UserAgent;
@@ -116,18 +116,30 @@
     foreach my $section(@sections) {
         my $url = $CFG{archive}{mirror} . "/dists/$suite/$section/source/Sources.gz";
         info("Downloading $url");
-        my $res = $ua->get($url);
+        open(TMP, "+>", undef) or die $!;
+        my $res = $ua->get($url, ":content_cb" => sub {
+                print TMP $_[0] or die $!;
+            });
         unless($res->is_success()) {
             warn "Can't download $url: " . $res->message();
             return 0;
         }
-        # Still reading it all in memory, couldn't find any nice way to
-        # interact with gunzip
-        my $gzdata = $res->content();
+        seek(TMP, 0, SEEK_SET) or die "Can't seek: $!\n";
+        my $gz = Compress::Zlib::gzopen(\*TMP, "rb")
+            or die "Can't open compressed file: $!\n";
+
+        my $data;
+        open($data, "+>", undef) or die $!;
+        my $buffer = " " x 4096;
+        my $bytes;
+        while(($bytes = $gz->gzread($buffer)) > 0) {
+            print $data $buffer;
+        }
+        die $gz->gzerror if($bytes < 0);
+        close TMP;
         #my $z = new IO::Uncompress::Gunzip(\$data);
-        my $uncdata = Compress::Zlib::memGunzip(\$gzdata);
-        my $data = IO::Scalar->new(\$uncdata);
-
+
+        seek($data, 0, SEEK_SET) or die "Can't seek: $!\n";
         # Blank line as "line" separator, so a "line" is a full record
         local $/ = "";
         while(<$data>) {

Modified: scripts/qa/DebianQA/Watch.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Watch.pm?rev=8893&op=diff
==============================================================================
--- scripts/qa/DebianQA/Watch.pm (original)
+++ scripts/qa/DebianQA/Watch.pm Tue Nov  6 08:15:39 2007
@@ -15,11 +15,13 @@
 our @ISA = "Exporter";
 our @EXPORT = qw(watch_download watch_get watch_get_consolidated);
 
+use Compress::Zlib ();
 use DebianQA::Cache;
 use DebianQA::Common;
 use DebianQA::Config '%CFG';
 use DebianQA::Svn;
 use DebianQA::DebVersions;;
+use Fcntl qw(:seek);
 use LWP::UserAgent;
 
 my $cpanregex =
@@ -111,6 +113,7 @@
     update_cache("watch", \%watch, "", $complete, 1);
     update_cache("consolidated", \%watch2, "watch", $complete, 0);
     unlock_cache("watch");
+    info("watch: ", scalar @pkglist, " packages scanned");
 }
 # Returns the hash of bugs. Doesn't download anything.
 sub watch_get {
@@ -217,15 +220,30 @@
 
     my $url = $CFG{watch}{cpan_mirror};
     info("Rebuilding CPAN cache from $url");
-    my $res = $ua->get($url);
+    open(TMP, "+>", undef) or die $!;
+    my $res = $ua->get($url, ":content_cb" => sub {
+            print TMP $_[0] or die $!;
+        });
     unless($res->is_success()) {
         warn "Can't download $url: " . $res->message();
-        return undef;
-    }
-    my $gzdata = $res->content();
+        return 0;
+    }
+    seek(TMP, 0, SEEK_SET) or die "Can't seek: $!\n";
+    my $gz = Compress::Zlib::gzopen(\*TMP, "rb")
+        or die "Can't open compressed file: $!\n";
+
+    my $data;
+    open($data, "+>", undef) or die $!;
+    my $buffer = " " x 4096;
+    my $bytes;
+    while(($bytes = $gz->gzread($buffer)) > 0) {
+        print $data $buffer;
+    }
+    die $gz->gzerror if($bytes < 0);
+    close TMP;
     #my $z = new IO::Uncompress::Gunzip(\$data);
-    my $uncdata = Compress::Zlib::memGunzip(\$gzdata);
-    my $data = IO::Scalar->new(\$uncdata);
+
+    seek($data, 0, SEEK_SET) or die "Can't seek: $!\n";
 
     my($dir, $type);
     while(<$data>) {