The following commit has been merged in the master branch:
commit f3f84d343add289dead26c0d8fbc6f64846f3769
Author: James Vega <[email protected]>
Date: Tue Apr 13 23:35:17 2010 -0400
debcheckout: Switch from using the Switch module to Perl 5.10's switch
feature.
Signed-off-by: James Vega <[email protected]>
diff --git a/debian/changelog b/debian/changelog
index 2f7e412..726f8bd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,8 @@ devscripts (2.10.64) UNRELEASED; urgency=low
[ James Vega ]
* Devscripts::Versort: Correct _versort so the lists it returns aren't
shorter than the ones passed in to _versort. (Closes: #577654)
+ * debcheckout: Switch from using the Switch module to Perl 5.10's switch
+ feature.
-- Stefano Zacchiroli <[email protected]> Tue, 13 Apr 2010 16:31:50 +0200
diff --git a/scripts/debcheckout.pl b/scripts/debcheckout.pl
index 59e0410..2627dd5 100755
--- a/scripts/debcheckout.pl
+++ b/scripts/debcheckout.pl
@@ -189,8 +189,9 @@ debcheckout and this manpage have been written by Stefano
Zacchiroli
=cut
+use feature 'switch';
use strict;
-use Switch;
+use warnings;
use Getopt::Long;
use Pod::Usage;
use File::Basename;
@@ -348,12 +349,17 @@ sub set_destdir(@$$) {
my ($repo_type, $destdir, @cmd) = @_;
$destdir =~ s|^-d\s*||;
- switch ($repo_type) {
- case "cvs" { my $module = pop @cmd;
- push @cmd, ("-d", $destdir, $module);
+ given ($repo_type) {
+ when ("cvs") {
+ my $module = pop @cmd;
+ push @cmd, ("-d", $destdir, $module);
+ }
+ when (/^(bzr|darcs|git|hg|svn)$/) {
+ push @cmd, $destdir;
+ }
+ default {
+ die "sorry, don't know how to set the destination directory for
$repo_type repositories (patches welcome!)\n";
}
- case /^(bzr|darcs|git|hg|svn)$/ { push @cmd, $destdir; }
- else { die "sorry, don't know how to set the destination directory for
$repo_type repositories (patches welcome!)\n"; }
}
return @cmd;
}
@@ -383,12 +389,12 @@ sub set_auth($$$$) {
$user_local =~ s|(.*)(@)|$1|;
my $user_url = $url;
- switch ($repo_type) {
- case "bzr" {
+ given ($repo_type) {
+ when ("bzr") {
$url =~
s|^[\w+]+://(bzr\.debian\.org)/(.*)|bzr+ssh://$user$1/bzr/$2|;
$url =~
s[^\w+://(?:(bazaar|code)\.)?(launchpad\.net/.*)][bzr+ssh://${user}bazaar.$2];
}
- case "darcs" {
+ when ("darcs") {
if ($url =~ m|(~)|) {
$user_url =~ s|^\w+://(darcs\.debian\.org)/(~)(.*?)/.*|$3|;
die "the local user '$user_local' doesn't own the personal
repository '$url'\n"
@@ -398,7 +404,7 @@ sub set_auth($$$$) {
$url =~ s|^\w+://(darcs\.debian\.org)/(.*)|$user$1:/$2|;
}
}
- case "git" {
+ when ("git") {
if ($url =~ m%(/users/|~)%) {
$user_url =~ s|^\w+://(git\.debian\.org)/git/users/(.*?)/.*|$2|;
$user_url =~ s|^\w+://(git\.debian\.org)/~(.*?)/.*|$2|;
@@ -412,11 +418,15 @@ sub set_auth($$$$) {
}
}
# "hg ssh://" needs an extra slash so paths are not based in the user's
$HOME
- case "hg" { $url =~ s|^\w+://(hg\.debian\.org/)|ssh://$user$1/|; }
- case "svn" {
+ when ("hg") {
+ $url =~ s|^\w+://(hg\.debian\.org/)|ssh://$user$1/|;
+ }
+ when ("svn") {
$url =~ s|^\w+://(svn\.debian\.org)/(.*)|svn+ssh://$user$1/svn/$2|;
}
- else { die "sorry, don't know how to enable authentication for
$repo_type repositories (patches welcome!)\n"; }
+ default {
+ die "sorry, don't know how to enable authentication for $repo_type
repositories (patches welcome!)\n";
+ }
}
if ($url eq $old_url) { # last attempt: try with user-defined rules
$url = user_set_auth($repo_type, $url);
@@ -432,8 +442,8 @@ sub munge_url($$)
{
my ($repo_type, $repo_url) = @_;
- switch ($repo_type) {
- case 'bzr' {
+ given ($repo_type) {
+ when ('bzr') {
# bzr.d.o explicitly doesn't run a smart server. Need to use
nosmart
$repo_url =~
s|^http://(bzr\.debian\.org)/(.*)|nosmart+http://$1/$2|;
}
@@ -446,20 +456,20 @@ sub checkout_repo($$$) {
my ($repo_type, $repo_url, $destdir) = @_;
my @cmd;
- switch ($repo_type) {
- case "arch" { @cmd = ("tla", "grab", $repo_url); } # XXX ???
- case "bzr" { @cmd = ("bzr", "branch", $repo_url); }
- case "cvs" {
+ given ($repo_type) {
+ when ("arch") { @cmd = ("tla", "grab", $repo_url); } # XXX ???
+ when ("bzr") { @cmd = ("bzr", "branch", $repo_url); }
+ when ("cvs") {
$repo_url =~ s|^-d\s*||;
my ($root, $module) = split /\s+/, $repo_url;
$module ||= '';
@cmd = ("cvs", "-d", $root, "checkout", $module);
}
- case "darcs" { @cmd = ("darcs", "get", $repo_url); }
- case "git" { @cmd = ("git", "clone", $repo_url); }
- case "hg" { @cmd = ("hg", "clone", $repo_url); }
- case "svn" { @cmd = ("svn", "co", $repo_url); }
- else { die "unsupported version control system '$repo_type'.\n"; }
+ when ("darcs") { @cmd = ("darcs", "get", $repo_url); }
+ when ("git") { @cmd = ("git", "clone", $repo_url); }
+ when ("hg") { @cmd = ("hg", "clone", $repo_url); }
+ when ("svn") { @cmd = ("svn", "co", $repo_url); }
+ default { die "unsupported version control system '$repo_type'.\n"; }
}
@cmd = set_destdir($repo_type, $destdir, @cmd) if length $destdir;
print "@cmd ...\n";
@@ -496,8 +506,8 @@ sub checkout_files($$$$) {
return 1;
}
- switch ($repo_type) {
- case "arch" {
+ given ($repo_type) {
+ when ("arch") {
# If we've already retrieved a copy of the repository,
# reuse it
if (!length($tempdir)) {
@@ -521,7 +531,7 @@ sub checkout_files($$$$) {
return 1;
}
}
- case "cvs" {
+ when ("cvs") {
if (!length($tempdir)) {
if (!($tempdir = tempdir( "debcheckoutXXXX", TMPDIR => 1,
CLEANUP => 1 ))) {
print STDERR
@@ -559,7 +569,7 @@ sub checkout_files($$$$) {
}
}
}
- case /(svn|bzr)/ {
+ when (/(svn|bzr)/) {
@cmd = ($repo_type, "cat", "$repo_url/$file");
print "@cmd > $dir/" . basename($file) . " ... \n";
if (! open CAT, '-|', @cmd) {
@@ -577,7 +587,7 @@ sub checkout_files($$$$) {
print OUTPUT $content;
close OUTPUT;
}
- case /(darcs|hg)/ {
+ when (/(darcs|hg)/) {
# Subtly different but close enough
if (have_lwp) {
print "Attempting to retrieve $file via HTTP ...\n";
@@ -630,7 +640,7 @@ sub checkout_files($$$$) {
return 1;
}
}
- case "git" {
+ when ("git") {
# If there isn't a browse URL (either because the package
# doesn't ship one, or because we were called with a URL,
# try a common pattern for gitweb
@@ -725,7 +735,9 @@ sub checkout_files($$$$) {
close OUTPUT;
}
}
- else { die "unsupported version control system '$repo_type'.\n"; }
+ default {
+ die "unsupported version control system '$repo_type'.\n";
+ }
}
}
--
Git repository for devscripts
--
To unsubscribe, send mail to [email protected].
