[libcatalyst-modules-perl] 02/12: update all sources unless asked to update specific source
Damyan Ivanov
dmn at moszumanska.debian.org
Thu May 8 14:59:12 UTC 2014
This is an automated email from the git hooks/post-receive script.
dmn pushed a commit to branch dam-bundle-2.0
in repository libcatalyst-modules-perl.
commit 5e984a7000533319d9b60e57bd40646faa5eb4fc
Author: Damyan Ivanov <dmn at debian.org>
Date: Thu May 8 10:12:44 2014 +0000
update all sources unless asked to update specific source
---
debian/fetch | 104 ++++++++++++++++++++++++++++++++---------------------------
1 file changed, 57 insertions(+), 47 deletions(-)
diff --git a/debian/fetch b/debian/fetch
index c69ad74..1d3bf7f 100755
--- a/debian/fetch
+++ b/debian/fetch
@@ -28,65 +28,75 @@ sub done {
$| = 1;
-my $dist = shift @ARGV;
+my $ua = WWW::Mechanize->new;
-my $tmp_dir = File::Temp->newdir(
- "bundle-fetch-$dist-XXXXXXX",
- DIR => '.',
- CLEANUP => 1,
-);
+sub fetch_dist {
+ my $dist = shift;
-my $ua = WWW::Mechanize->new;
+ print "$dist... ";
-my $url = "https://metacpan.org/release/$dist";
-doing("Fetching $url...");
-$ua->get($url);
-done();
+ my $tmp_dir = File::Temp->newdir(
+ "bundle-fetch-$dist-XXXXXXX",
+ DIR => '.',
+ CLEANUP => 1,
+ );
-my $download_link = $ua->find_link(
- text_regex => qr(Download),
- url_regex => qr(/$dist-.+\.(?:zip|tar\.(?:gz|xz|bz2|lzma)))
-);
+ my $url = "https://metacpan.org/release/$dist";
+ doing("Fetching $url...");
+ $ua->get($url);
+ done();
-my $fn = $download_link->url;
-$fn =~ s{.+/}{};
-$fn or die "No file name in response";
-die "Invalid file name '$fn'"
- if $fn =~ m{[/\\:\ \$\%'"]} or $fn !~ /^[\x21-\x7f]+$/;
+ my $download_link = $ua->find_link(
+ text_regex => qr(Download),
+ url_regex => qr(/$dist-.+\.(?:zip|tar\.(?:gz|xz|bz2|lzma)))
+ );
-my $tarball_file = File::Spec->catfile( $tmp_dir, $fn );
+ my $fn = $download_link->url;
+ $fn =~ s{.+/}{};
+ $fn or die "No file name in response";
+ die "Invalid file name '$fn'"
+ if $fn =~ m{[/\\:\ \$\%'"]} or $fn !~ /^[\x21-\x7f]+$/;
-doing("Downloading " . $download_link->url . '...');
-$ua->get( $download_link, ':content_file' => $tarball_file );
-done();
+ my $tarball_file = File::Spec->catfile( $tmp_dir, $fn );
-my $extract_dir = File::Spec->catdir($tmp_dir, 'extract');
-my $tarball = Archive::Extract->new( archive => $tarball_file );
-doing("Extracting $tarball_file...");
-$tarball->extract( to => $extract_dir );
-done();
+ doing("Downloading " . $download_link->url . '...');
+ $ua->get( $download_link, ':content_file' => $tarball_file );
+ done();
-my $dir = DirHandle->new($extract_dir);
-my $extracted_tree;
-while ( defined( $_ = $dir->read ) ) {
- next if $_ eq '.';
- next if $_ eq '..';
+ my $extract_dir = File::Spec->catdir($tmp_dir, 'extract');
+ my $tarball = Archive::Extract->new( archive => $tarball_file );
+ doing("Extracting $tarball_file...");
+ $tarball->extract( to => $extract_dir );
+ done();
- die "Multiple directories extracted ($extracted_tree, $_)"
- if $extracted_tree;
+ my $dir = DirHandle->new($extract_dir);
+ my $extracted_tree;
+ while ( defined( $_ = $dir->read ) ) {
+ next if $_ eq '.';
+ next if $_ eq '..';
- $extracted_tree = $_;
-}
+ die "Multiple directories extracted ($extracted_tree, $_)"
+ if $extracted_tree;
+
+ $extracted_tree = $_;
+ }
-die "Nothing in the archive" unless $extracted_tree;
+ die "Nothing in the archive" unless $extracted_tree;
-my $destination = File::Spec->catdir( 'sources', $dist );
-doing("Removing $destination...");
-File::Remove::remove( \1, $destination );
-done();
+ my $destination = File::Spec->catdir( 'sources', $dist );
+ doing("Removing $destination...");
+ File::Remove::remove( \1, $destination );
+ done();
+
+ $extracted_tree = File::Spec->catdir( $extract_dir, $extracted_tree );
+
+ doing("Copying $extracted_tree to $destination...");
+ File::Copy::Recursive::dircopy( $extracted_tree, $destination );
+ done();
+
+ print "done.\n";
+}
-$extracted_tree = File::Spec->catdir( $extract_dir, $extracted_tree );
+ at ARGV = map { s{^sources/}{}; $_ } glob('sources/*') unless @ARGV;
-doing("Copying $extracted_tree to $destination...");
-File::Copy::Recursive::dircopy( $extracted_tree, $destination );
-done();
+fetch_dist($_) for @ARGV;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatalyst-modules-perl.git
More information about the Pkg-perl-cvs-commits
mailing list