Package: whohas
Version: 0.24-2
Severity: normal
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
Hi,
Please find attached the refreshed patch for 0.24-2.
I also including date print (parsing of changelog on packages.d.o).
- -- System Information:
Debian Release: squeeze/sid
APT prefers unstable
APT policy: (500, 'unstable')
Architecture: amd64 (x86_64)
Kernel: Linux 2.6.32-26-generic (SMP w/4 CPU cores)
Locale: LANG=C, LC_CTYPE=C (charmap=ANSI_X3.4-1968)
Shell: /bin/sh linked to /bin/dash
Versions of packages whohas depends on:
ii libwww-perl 5.837-1 simple and consistent interface to
ii libxml-simple-perl 2.18-3 Perl module for reading and writin
ii perl 5.10.1-16 Larry Wall's Practical Extraction
whohas recommends no packages.
whohas suggests no packages.
- -- no debconf information
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.10 (GNU/Linux)
iQIcBAEBCAAGBQJNAX97AAoJEJmGUYuaqqClnVUQAJKcIiZhRjnDdO8HrSFmwOEs
aaoXbANgNfrWYD32o2WkLa3bn5onADKjLkQNNzwX7h6cfSBAMfsVgYlcNBhDiMoA
145rUPQa2Mh6pJ0Wrc7pCo+qcI7tIGHAmbPS6E849lMXVkpqa3t+u9mlAIb2H5Tu
PPkc8d38f2jvB0RGAGmLCfpxZiIeDuuqYxhy2B2B/n5H151ld5ZnEmPE3QK3Betl
pzW1ZXb+WGtSNNbsCWCcEfeOWNJXrjVK8uiRz0AD/agm+mqEsE1cbRG7rM+M8o+9
299MRqelG1+c0FldYqay6O69HU2E5BTHlhQ90Ri27AJrHQGGit725UQdgEVoQziz
mxyVLF7HEo/7mm9opyZ02I/j74GJJV98Y9QzmcQVd+IaGcekuS4CFrTBkRxbgrkG
Im1tRhVszYKelq+8UN4PeHDorycTa7SUvaKYEzpu+asZ5LPJEg5FcPzg1dAGLxG0
PkCpHjNI88rgTy2itUkb0vBhrSESf3R4BG3BdCQNeEIXW60mVa/yI9lbYnDE/NPq
MxPvTEEEOSaq9qKbtXwljYlirFrqABiDfhwcbUF4X2UJT71sHI56Q4nhoai1snUg
jJwTHvkLxmSFE49ktF7ou4g2FFxsQkCcD+zz0UlAMcfSysiR8mcOSKhFpbB4Rc+a
Wx1+6oh2hH5KERklTJYJ
=2hc/
-----END PGP SIGNATURE-----
--- whohas 2010-12-05 23:14:21.000000000 +0100
+++ whohas 2010-12-10 02:04:42.887626758 +0100
@@ -24,8 +24,6 @@
#use sigtrap;
#TODO --fetch-unstable switch
-#TODO make sure that debian's version numbers are from i386
-#TODO get date info about debian, ubuntu (link is to changelog)
#TODO get size and date info about slackware packages from subsequent links -
postponed until slackware packages is online again
#TODO architecture tests for those that support several
#TODO Gentoo: only report two most recent for each package?
@@ -49,7 +47,7 @@
my $cols = 6;
my $fedora_release = 14 ;
-my $ubuntu_current_release = "all" ;
+my $debian_ubuntu_arch = "i386" ;
#my $opensuse_rel_string = "112" ;
my $opensuse_major = "11" ;
my $opensuse_minor = "3" ;
@@ -158,7 +156,7 @@
$thrs[$here++] = threads->new(\&aur,
$ARGV[0]);
}
if ($debian_bool == 1) {
- $thrs[$here++] = threads->new(\&debian,
$ARGV[0]);
+ $thrs[$here++] = threads->new(\&debian_ubuntu,
$ARGV[0]);
}
if ($fink_bool == 1) {
$thrs[$here++] = threads->new(\&fink,
$ARGV[0]);
@@ -190,7 +188,7 @@
$thrs[$here++] = threads->new(\&sourcemage,
$ARGV[0]);
}
if ($ubuntu_bool == 1) {
- $thrs[$here++] = threads->new(\&ubuntu,
$ARGV[0]);
+ $thrs[$here++] = threads->new(\&debian_ubuntu,
$ARGV[0],"Ubuntu");
}
if ($gentoo_bool == 1) {
$thrs[$here++] = threads->new(\&gentoo,
$ARGV[0]);
@@ -218,7 +216,7 @@
&cygwin( $ARGV[0]);
}
if ($debian_bool == 1) {
- &debian( $ARGV[0]);
+ &debian_ubuntu( $ARGV[0]);
}
if ($fedora_bool == 1) {
&fedora( $ARGV[0]);
@@ -256,7 +254,7 @@
&sourcemage( $ARGV[0]);
}
if ($ubuntu_bool == 1) {
- &ubuntu( $ARGV[0]);
+ &debian_ubuntu( $ARGV[0],"Ubuntu");
}
if ($opkg_bool == 1) {
&opkg( $ARGV[0]);
@@ -336,9 +334,15 @@
return ($_[0]);
}
-sub ubuntu {
- my $base = "http://packages.ubuntu.com";;
- my $query =
$base."/search?keywords=".$_[0]."&searchon=names&suite=".$ubuntu_current_release."§ion=all";
+sub debian_ubuntu {
+ my $base = "http://packages.debian.org";;
+ my $variant = "Debian";
+ my $default_repo = "main";
+ if ($_[1] =~ /Ubuntu/) {
+ $base = "http://packages.ubuntu.com";;
+ $variant = "Ubuntu";
+ }
+ my $query =
$base."/search?keywords=".$_[0]."&searchon=names&suite=all§ion=all";
my @lines = split /\n/, &fetchdoc($query);
my @names;
my @versions;
@@ -356,16 +360,30 @@
# $lines[$i] <li class="intrepid"><a
class="resultlink" href="/intrepid/dpkg">intrepid</a> (base):
# $lines[$i+3] <br>1.14.20ubuntu6: amd64 i386
while ($lines[$i] =~ /class="resultlink"/) {
+ # don't want Debian backports or volatile
(don't have online changelog)
+ # and version are same as unstable (or
sometimes testing)
+ if ($lines[$i] =~
/class=".*-(backports|volatile)">/) {
+ goto END_OF_LOOP;
+ }
push @names, $name;
my @parts = split /href\=\"|\"\>|<\/a\>/,
$lines[$i];
- $parts[4] =~ s/ \(|\)://g;
+ $parts[5] =~ s/ \(|\)://g;
push @groups, $parts[4];
- push @urls, $base.$parts[2];
- push @dates, "";
- @parts = split />|<\/strong>/, $lines[$i+1];
+ push @urls, $base.$parts[2];
+ @parts = split /<strong class=\".*\"
title=\".*\">|<\/strong>/, $lines[$i+1];
+ # implicit repo main for Debian/Ubuntu
+ if (!$parts[1]) { $parts[1] = $default_repo; }
push @repos, $parts[1];
- @parts = split />|: /, $lines[$i+3];
- push @versions, $parts[1];
+ my $version_line = 3;
+ # we want i386 only (or with debport line for
Debian)
+ if (($lines[$i+$version_line] !~
/:.*$debian_ubuntu_arch/) && ($lines[$i+$version_line] !~ /: all/)) {
+ $version_line = 5;
+ }
+ # maybe [debports] for Debian
+ @parts = split /<br>|(\[<a href=.*\])?: /,
$lines[$i+$version_line];
+ push @versions, $parts[2];
+ # goto here if we match backports or volatile
package
+ END_OF_LOOP:
$i += 8;
}
}
@@ -377,20 +395,21 @@
push @thr, threads->new(\&debian_sizes,
$urls[$i]);
}
for (my $i = 0; $i < @thr; $i++) {
- push @sizes, $thr[$i]->join;
+ ($sizes[$i],$dates[$i]) = $thr[$i]->join;
}
} else {
for (my $i = 0; $i < @urls; $i++) {
- push @sizes, &debian_sizes($urls[$i]);
+ ($sizes[$i],$dates[$i]) =
&debian_sizes($urls[$i]);
}
}
} else {
for (my $i = 0; $i < @urls; $i++) {
push @sizes, "";
+ push @dates, "";
}
}
for (my $i = 0; $i < @repos; $i++) {
-
&pretty_print($cols,@columns,"Ubuntu",$names[$i],$versions[$i],$sizes[$i],$dates[$i],$repos[$i],$urls[$i]);
+
&pretty_print($cols,@columns,$variant,$names[$i],$versions[$i],$sizes[$i],$dates[$i],$repos[$i],$urls[$i]);
}
return ();
}
@@ -984,18 +1003,13 @@
return ();
}
+# return sizes and dates
sub debian_sizes {
my @lines = split /\n/, &fetchdoc($_[0]);
for (my $i = 0; $i < @lines; $i++) {
- if ($lines[$i] =~ /download\">i386<\/a/) {
- my @newparts = split /\"size\"\>|<\/td>/, $lines[$i+3];
- return &debian_size_convert($newparts[1]);
- }
- }
- for (my $i = 0; $i < @lines; $i++) {
- if ($lines[$i] =~ /download\">all<\/a/) {
+ if ($lines[$i] =~ /download\">($debian_ubuntu_arch|all)<\/a/) {
my @newparts = split /\"size\"\>|<\/td>/, $lines[$i+3];
- return &debian_size_convert($newparts[1]);
+ return
(&debian_size_convert($newparts[1]),&debian_ubuntu_dates($_[0]));
}
}
}
@@ -1073,6 +1087,42 @@
return ();
}
+sub debian_ubuntu_changelog_url {
+ my @lines = split /\n/, &fetchdoc($_[0], "silent");
+ for (my $i = 70; $i < @lines; $i++) {
+ my @parts = split /href=\"|\">/, $lines[$i];
+ if ($lines[$i] =~ /Debian Changelog/) {
+ # service on same vhost, relative path
+ return "http://packages.debian.org".$parts[1];
+ }
+ if ($lines[$i] =~ /Ubuntu Changelog/) {
+ # service on another vhost, absolute path
+ return $parts[1];
+ }
+ }
+}
+
+sub debian_ubuntu_dates {
+ my $changelog_url = &debian_ubuntu_changelog_url($_[0]);
+ my $version = $changelog_url;
+ $version =~ s/.*\/.*\_|\/changelog//g;
+ # escape + and ~ in version number
+ $version =~ s/\+/\\+/g;
+ $version =~ s/\~/\\~/g;
+ my @lines = split /\n/, &fetchdoc($changelog_url, "silent");
+ for (my $i = 0; $i < @lines; $i++) {
+ if ($lines[$i] =~ /$version/) {
+ for (my $j = $i; $j < @lines; $j++) {
+ if ($lines[$j] =~ /--.*\<....@.*\>/) {
+ $lines[$j] =~
s/\s+--.*\<....@.*\>.*,\s+|\s+\d{2}:\d{2}:\d{2} [+-]\d{4}//g;
+ $lines[$j] =~ s/ /-/g;
+ return &month_to_digits($lines[$j]);
+ }
+ }
+ }
+ }
+}
+
sub aur {
my $aurbase = "http://aur.archlinux.org";;
my $stop;
