[SCM] Debian Qt/KDE packaging tools branch, master, updated. debian/0.7.0
Modestas Vainius
modax at alioth.debian.org
Tue Mar 16 01:07:28 UTC 2010
The following commit has been merged in the master branch:
commit 8fb462bc3cf673d0ff5926ed6be1131b03530301
Author: Modestas Vainius <modestas at vainius.eu>
Date: Tue Mar 16 02:57:15 2010 +0200
pkgkde-getbuildlogs: decode HTML and strip tags from the build log.
---
pkgkde-getbuildlogs | 70 +++++++++++++++++++++++++++++++++++++-------------
1 files changed, 52 insertions(+), 18 deletions(-)
diff --git a/pkgkde-getbuildlogs b/pkgkde-getbuildlogs
index f157999..4a39aca 100755
--- a/pkgkde-getbuildlogs
+++ b/pkgkde-getbuildlogs
@@ -39,6 +39,7 @@ use URI::Escape;
use HTTP::Response;
use LWP::UserAgent;
use HTML::LinkExtor;
+use HTML::Parser;
sub usage {
usageerr "[ -d destdir ] [ -v version ] [ -a arch ] [ -o ] [ package ] [ distribution ]";
@@ -89,6 +90,18 @@ sub get_rfc822_field_value {
}
}
+sub html2text {
+ my ($in, $out) = @_;
+ my $body;
+ my $parser = HTML::Parser->new( api_version => 3,
+ start_h => [ sub { if (shift() eq "body") { $body = 1 } }, "tagname" ],
+ end_h => [ sub { if (shift() eq "body") { $body = 0 } }, "tagname" ],
+ text_h => [ sub { if ($body) { print $out shift(); } }, "dtext" ]
+ );
+ $parser->ignore_elements("head", "a", "img");
+ return defined($parser->parse_file($in)) && defined($body);
+}
+
sub download_logs {
my ($destdir, $pkg, %opts) = @_;
my $distro = $opts{distro};
@@ -127,6 +140,7 @@ sub download_logs {
foreach my $link (@links) {
# Check if it is the link we need
if ($link =~ m,/fetch\.cgi(\?[^/]+)$,) {
+ my ($ok, @status);
my $filename = $1 . ".build";
$filename =~ s/[?;&][^=]+=([^?;&]+)/_$1/g;
$filename =~ s/^_\.*//;
@@ -134,38 +148,58 @@ sub download_logs {
my $file = File::Spec->catfile($destdir, $filename);
if ($opts{overwrite} || ! -e $file) {
+ # Create a temporary file
+ my $tmpfile1 = File::Temp->new(TEMPLATE => $filename . ".XXXXXX",
+ DIR => $destdir);
+ my $tmpfile2 = File::Temp->new(TEMPLATE => $filename . ".XXXXXX",
+ DIR => $destdir);
+
info "Fetching build log to $filename ...";
$request = HTTP::Request->new(GET => $link);
$request->header("Accept-Encoding" => "deflate, identity");
$browser->show_progress(1);
- $response = $browser->request($request, $file);
+ $tmpfile1->close();
+ $response = $browser->request($request, $tmpfile1->filename);
if ($response->is_success()) {
my $is_deflated = $response->header("Content-Encoding");
$is_deflated = defined $is_deflated && $is_deflated eq "deflate";
# Inflate contents if needed
if ($is_deflated) {
- my $inflatedfile = File::Temp->new(
- TEMPLATE => $filename . ".XXXXXX"
- );
- if (inflate($file => $inflatedfile, BinModeOut => 1)) {
- $inflatedfile->close();
- File::Copy::move($inflatedfile->filename, $file) or
- error "unable to rename '%s' to '%s'",
- $inflatedfile->filename, $file;
- push @ok, [ $filename, "deflate" ];
+ push @status, "deflate";
+ if (inflate($tmpfile1->filename => $tmpfile2, BinModeOut => 1)) {
+ $tmpfile2->close();
+ ($tmpfile1, $tmpfile2) = ($tmpfile2, $tmpfile1);
+ open($tmpfile2, ">:utf8", $tmpfile2->filename) or
+ syserr "unable to reopen temporary file";
+ $ok = 1;
} else {
- push @failed, [ $filename, "deflate" ];
unlink $filename;
}
} else {
- push @ok, [ $filename ];
+ $ok = 1;
+ }
+ if ($ok) {
+ open($tmpfile1, "<:utf8", $tmpfile1->filename);
+ if ($ok = html2text($tmpfile1 => $tmpfile2)) {
+ $tmpfile1->close();
+ $tmpfile1 = $tmpfile2;
+ } else {
+ push @status, "html unstripped";
+ }
+ $tmpfile1->close();
+ $tmpfile2->close();
+ File::Copy::move($tmpfile1->filename, $file) or
+ error "unable to rename '%s' to '%s'", $tmpfile1->filename, $file;
}
- } else {
- push @failed, [ $filename ];
}
} else {
info "Not overwriting existing build log $filename ...";
- push @failed, [ $filename, "exists, ignored" ];
+ push @status, "exists, ignored";
+ }
+ if ($ok) {
+ push @ok, [ $filename, @status ];
+ } else {
+ push @failed, [ $filename, @status ];
}
}
}
@@ -185,9 +219,9 @@ sub print_summary {
info $msg, @_ unless $is_warning;
warning $msg, @_ if $is_warning;
foreach my $log_info (@$logs) {
- my ($filename, $info) = @$log_info;
- if (defined $info) {
- printmsg " - %s [%s]", $filename, $info;
+ my ($filename, @info) = @$log_info;
+ if (@info) {
+ printmsg " - %s [%s]", $filename, join(", ", @info);
} else {
printmsg " - %s", $filename;
}
--
Debian Qt/KDE packaging tools
More information about the pkg-kde-commits
mailing list