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 33642f9642274ec359e1fd0d586291d36d3597e2 Author: Damyan Ivanov <d...@debian.org> Date: Thu May 8 09:34:18 2014 +0000 a script to fetch updated upstream source --- debian/fetch | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) diff --git a/debian/fetch b/debian/fetch new file mode 100755 index 0000000..c69ad74 --- /dev/null +++ b/debian/fetch @@ -0,0 +1,92 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use utf8; + +use Archive::Extract (); +use DirHandle (); +use File::Copy::Recursive (); +use File::Remove (); +use File::Temp (); +use Term::Cap (); +use WWW::Mechanize (); + + +my $term = Term::Cap->Tgetent(); +my $cd = $term->Tputs('cd'); +my $sc = $term->Tputs('sc'); +my $rc = $term->Tputs('rc'); + +sub doing { + print $sc, @_; +} + +sub done { + print "$rc$cd"; +} + +$| = 1; + +my $dist = shift @ARGV; + +my $tmp_dir = File::Temp->newdir( + "bundle-fetch-$dist-XXXXXXX", + DIR => '.', + CLEANUP => 1, +); + +my $ua = WWW::Mechanize->new; + +my $url = "https://metacpan.org/release/$dist"; +doing("Fetching $url..."); +$ua->get($url); +done(); + +my $download_link = $ua->find_link( + text_regex => qr(Download), + url_regex => qr(/$dist-.+\.(?:zip|tar\.(?:gz|xz|bz2|lzma))) +); + +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 $tarball_file = File::Spec->catfile( $tmp_dir, $fn ); + +doing("Downloading " . $download_link->url . '...'); +$ua->get( $download_link, ':content_file' => $tarball_file ); +done(); + +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(); + +my $dir = DirHandle->new($extract_dir); +my $extracted_tree; +while ( defined( $_ = $dir->read ) ) { + next if $_ eq '.'; + next if $_ eq '..'; + + die "Multiple directories extracted ($extracted_tree, $_)" + if $extracted_tree; + + $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(); + +$extracted_tree = File::Spec->catdir( $extract_dir, $extracted_tree ); + +doing("Copying $extracted_tree to $destination..."); +File::Copy::Recursive::dircopy( $extracted_tree, $destination ); +done(); -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatalyst-modules-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits