SVN devscripts commit: r1827 - in trunk: . debian scripts
Author: myon
Date: 2009-03-01 00:40:11 + (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/README2009-02-28 22:06:41 UTC (rev 1826)
+++ trunk/README2009-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/control2009-02-28 22:06:41 UTC (rev 1826)
+++ trunk/debian/control2009-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 21) == 0) {
-$wget = curl;
-} elsif (system(command -v wget /dev/null 21) == 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
-Bapt-cache(1), Bcurl(1), Bwget(1).
+Bapt-cache(1).
--
To unsubscribe, send mail to pkg-devscripts-unsubscr...@teams.debian.net.
SVN devscripts commit: r1828 - trunk/scripts
Author: myon
Date: 2009-03-01 00:59:38 + (Sun, 01 Mar 2009)
New Revision: 1828
Modified:
trunk/scripts/dcontrol.pl
Log:
dcontrol: Use : to separate archive, and add some // extra syntax to support
suite names with slashes.
Modified: trunk/scripts/dcontrol.pl
===
--- trunk/scripts/dcontrol.pl 2009-03-01 00:40:11 UTC (rev 1827)
+++ trunk/scripts/dcontrol.pl 2009-03-01 00:59:38 UTC (rev 1828)
@@ -48,11 +48,12 @@
Modifiers:
=version Exact version match
\...@architectureQuery this architecture
-/[archive.][suite][/component]
+/[archive:][suite][/component]
Restrict to archive (debian, debian-backports,
debian-security, debian-volatile), suite (always
codenames, with the exception of experimental), and/or
-component (main, updates/main, ...)
+component (main, updates/main, ...). Use // if the suite
+name contains slashes.
By default, all versions, suites, and architectures are queried.
Use \...@source for source packages. \...@binary returns no source packages.
@@ -86,13 +87,17 @@
if ($arg =~ /@([\w.-]+)/) {
$url .= architecture=$1;
}
-if ($arg =~ /\/([\w-]*)\.([\w-]*)\/([\w-]+)/) {
+if ($arg =~ m!/([\w-]*):([\w/-]*)//([\w/-]*)!) {
$url .= archive=$1suite=$2component=$3;
-} elsif ($arg =~ /\/([\w-]*)\.([\w\/-]*)/) {
+} elsif ($arg =~ m!/([\w/-]*)//([\w/-]*)!) {
+ $url .= suite=$1component=$2;
+} elsif ($arg =~ m!/([\w-]*):([\w-]*)/([\w/-]*)!) {
+ $url .= archive=$1suite=$2component=$3;
+} elsif ($arg =~ m!/([\w-]*):([\w-]*)!) {
$url .= archive=$1suite=$2;
-} elsif ($arg =~ /\/([\w-]*)\/([\w-]*)/) {
+} elsif ($arg =~ m!/([\w-]*)/([\w/-]*)!) {
$url .= suite=$1component=$2;
-} elsif ($arg =~ /\/([\w\/-]+)/) {
+} elsif ($arg =~ m!/([\w\/-]+)!) {
$url .= suite=$1;
}
if ($opt-{'show-suite'}) {
@@ -203,11 +208,13 @@
Query this only architecture. Use B@source for source packages,
B@binary excludes source packages.
-=item B/[IarchiveB.][Isuite][B/Icomponent]
+=item B/[IarchiveB:][Isuite][B/Icomponent]
-Restrict to archive (debian, debian-backports, debian-security,
-debian-volatile), suite (always codenames, with the exception of experimental),
-and/or component (main, updates/main, ...)
+Restrict to Iarchive (debian, debian-backports, debian-security,
+debian-volatile), Isuite (always codenames, with the exception of
+experimental), and/or Icomponent (main, updates/main, ...). Use two slashes
+(B//) to separate suite and component if the suite name contains slashes.
+(Component can be left empty.)
=back
--
To unsubscribe, send mail to pkg-devscripts-unsubscr...@teams.debian.net.
