Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
gh-deploy.pl
#!/usr/bin/env perl
# This script is free software; you can redistribute it and/or modify it under the same terms
# as Perl 5.10.0. For more details, see http://dev.perl.org/licenses/.
package github_downloader;
use Moose;
with 'MooseX::Getopt';
use YAML::Any;
use HTTP::Request::Common 'POST';
use LWP::UserAgent;
use List::Util 'first';
use Archive::Extract;
has login => (is => 'rw', isa => 'Str', required => 1);
has token => (is => 'rw', isa => 'Str', required => 1);
has tag => (is => 'rw', isa => 'Str', required => 1);
has download => (is => 'rw', isa => 'Bool');
has unpack => (is => 'rw', isa => 'Bool');
has repo => (is => 'rw', isa => 'Str', required => 1);
has ua => (
is => 'ro',
default => sub { LWP::UserAgent->new },
metaclass => 'NoGetopt'
);
sub gh_v2_request {
my $self = shift;
my $path = shift;
my $response = $self->ua->request(
POST "https://github.com/api/v2/yaml/repos/show/$path",
[login => $self->login, token => $self->token, @_]
);
return Load($response->content)->{tags};
}
sub tags {
my $self = shift;
return $self->gh_v2_request($self->repo . '/tags');
}
sub download_tag {
my $self = shift;
my $tag = shift;
$self->ua->requests_redirectable([qw{ GET HEAD POST }]);
my $filename = "$tag.tar.gz";
my $response = $self->ua->request(
POST(join(
'/',
'https://github.com',
$self->repo,
'tarball',
$tag),
[login => $self->login, token => $self->token]),
$filename
);
return $response->is_error ? () : $filename;
}
sub tag_re {
my $self = shift;
my $tag = $self->tag;
my $tag_re = $tag;
if($tag =~ /[\*\?]/) {
$tag_re =~ s/\*/.*/g;
$tag_re =~ s/\?/.?/g;
}
return qr/^$tag_re$/;
}
sub matching_tags {
my $self = shift;
my $tags = $self->tags;
delete $tags->{$_}
for grep { $_ !~ $self->tag_re } keys %$tags;
return $tags;
}
sub unpack_file {
my $self = shift;
my $filename = shift;
my $tmpdir = ".tmp.$$." . rand();
mkdir $tmpdir;
my $ae = Archive::Extract->new(archive => $filename);
$ae->extract or die "Failed unpacking $filename: $!";
return $ae->extract_path;
}
sub repo_base {
my $base = shift->repo;
$base =~ s{/}{-}g;
return $base;
}
sub main {
my $self = shift;
my $matching_tags = $self->matching_tags;
if(%$matching_tags) {
for(keys %$matching_tags) {
print "$_: $matching_tags->{$_}\n";
if($self->download) {
my $filename = $self->download_tag($_);
if($self->unpack) {
my $path = $self->unpack_file($filename);
symlink $path, $self->repo_base . '-' . $_;
}
}
}
}
}
1;
github_downloader->new_with_options->main;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment