Author: myon
Date: 2009-03-01 00:40:11 +0000 (Sun, 01 Mar 2009)
New Revision: 1827
Modified:
trunk/README
trunk/debian/control
trunk/scripts/dcontrol.pl
Log:
dcontrol: convert to use libwww-perl
Modified: trunk/README
===================================================================
--- trunk/README 2009-02-28 22:06:41 UTC (rev 1826)
+++ trunk/README 2009-03-01 00:40:11 UTC (rev 1827)
@@ -57,7 +57,7 @@
file with each of the files referenced therein
- dcontrol: Remotely query package and source control files for all Debian
- distributions. [wget | curl]
+ distributions. [libwww-perl]
- dd-list: Given a list of packages, pretty-print it ordered by maintainer.
Modified: trunk/debian/control
===================================================================
--- trunk/debian/control 2009-02-28 22:06:41 UTC (rev 1826)
+++ trunk/debian/control 2009-03-01 00:40:11 UTC (rev 1827)
@@ -52,7 +52,7 @@
- dcmd: run a given command replacing the name of a .changes or .dsc file
with each of the files referenced therein
- dcontrol: remotely query package and source control files for all Debian
- distributions. [wget | curl]
+ distributions. [libwww-perl]
- dd-list: given a list of packages, pretty-print it ordered by maintainer
- debc: display the contents of just-built .debs
- debchange/dch: automagically add entries to debian/changelog files
Modified: trunk/scripts/dcontrol.pl
===================================================================
--- trunk/scripts/dcontrol.pl 2009-02-28 22:06:41 UTC (rev 1826)
+++ trunk/scripts/dcontrol.pl 2009-03-01 00:40:11 UTC (rev 1827)
@@ -19,25 +19,19 @@
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
use strict;
-use Getopt::Long;
use File::Basename;
+use Getopt::Long;
+use LWP::UserAgent;
+use URI::Escape;
# global variables
my $progname = basename($0,'.pl'); # the '.pl' is for when we're debugging
my $modified_conf_msg;
my $dcontrol_url;
-my $wget;
my $opt;
-# use curl if installed, wget otherwise
-if (system("command -v curl >/dev/null 2>&1") == 0) {
- $wget = "curl";
-} elsif (system("command -v wget >/dev/null 2>&1") == 0) {
- $wget = "wget";
-} else {
- die "$progname: can't find either curl or wget; you need at least one of
these\ninstalled to run me!\n";
-}
+my $ua = LWP::UserAgent->new(agent => "$progname ###VERSION###");
# functions
@@ -80,30 +74,14 @@
EOF
}
-
-sub wget {
- my ($url) = @_;
-
- my @cmd = ($wget);
- # curl does not follow document moved headers, and does not exit
- # with a non-zero error code by default if a document is not found
- if ($wget eq "curl") {
- push @cmd, "-f", "-L", "-s", "-S";
- } else {
- push @cmd, "-O", "-", "-q";
- }
- system @cmd, $url;
- return $? >> 8;
-}
-
sub apt_get {
my ($arg) = @_;
unless ($arg =~ /^([\w.+-]+)/) {
die "$arg does not start with a valid package name\n";
}
- my $url = "$dcontrol_url?package=$1";
- if ($arg =~ /=([\w.-]+)/) {
- $url .= "&version=$1";
+ my $url = "$dcontrol_url?package=" . uri_escape($1);
+ if ($arg =~ /=([\w.+-]+)/) {
+ $url .= "&version=" . uri_escape($1);
}
if ($arg =~ /@([\w.-]+)/) {
$url .= "&architecture=$1";
@@ -121,8 +99,12 @@
$url .= "&annotate=yes";
}
print "$url\n" if $opt->{debug};
- wget ($url);
- print "\n";
+ my $response = $ua->get ($url);
+ if ($response->is_success) {
+ print $response->content . "\n";
+ } else {
+ die $response->status_line;
+ }
}
# main program
@@ -279,4 +261,4 @@
=head1 SEE ALSO
-B<apt-cache>(1), B<curl>(1), B<wget>(1).
+B<apt-cache>(1).
--
To unsubscribe, send mail to [email protected].
