Permalink
Browse files

first commit

  • Loading branch information...
1 parent 46862d0 commit 85115765dc9235eb5796faf396ff8777d4b617b0 @typester typester committed Jun 2, 2009
Showing with 741 additions and 0 deletions.
  1. +4 −0 .shipit
  2. +4 −0 Changes
  3. +381 −0 LICENSE
  4. +26 −0 MANIFEST
  5. +15 −0 MANIFEST.SKIP
  6. +8 −0 Makefile.PL
  7. +27 −0 README
  8. +212 −0 lib/Net/GitHub/Upload.pm
  9. +4 −0 t/00_compile.t
  10. +51 −0 t/live.t
  11. +4 −0 t/pod.t
  12. +5 −0 t/pod_coverage.t
View
@@ -0,0 +1,4 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+
+git.tagpattern = %v
+git.push_to = origin
View
@@ -0,0 +1,4 @@
+Revision history for Perl extension Net::GitHub::Upload
+
+ 0.01 Tue May 26 14:58:40 2009
+ - original version
View
381 LICENSE

Large diffs are not rendered by default.

Oops, something went wrong.
View
@@ -0,0 +1,26 @@
+Changes
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/TestBase.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Spiffy.pm
+inc/Test/Base.pm
+inc/Test/Base/Filter.pm
+inc/Test/Builder.pm
+inc/Test/Builder/Module.pm
+inc/Test/More.pm
+lib/Net/GitHub/Upload.pm
+LICENSE
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_compile.t
+t/pod.t
+t/pod_coverage.t
View
@@ -0,0 +1,15 @@
+\bRCS\b
+\bCVS\b
+^MANIFEST\.
+^Makefile$
+~$
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+^9\d_.*\.t
+^\.git/
+^\.shipit$
+\.gitignore$
View
@@ -0,0 +1,8 @@
+use inc::Module::Install;
+name 'Net-GitHub-Upload';
+all_from 'lib/Net/GitHub/Upload.pm';
+
+test_requires 'Test::More';
+use_test_base;
+auto_include;
+WriteAll;
View
27 README
@@ -0,0 +1,27 @@
+This is Perl module Net::GitHub::Upload.
+
+INSTALLATION
+
+Net::GitHub::Upload installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+ % cpan Net::GitHub::Upload
+
+Download it, unpack it, then build it as per the usual:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+DOCUMENTATION
+
+Net::GitHub::Upload documentation is available as in POD. So you can do:
+
+ % perldoc Net::GitHub::Upload
+
+to read the documentation online with your favorite pager.
+
+Daisuke Murase
View
@@ -0,0 +1,212 @@
+package Net::GitHub::Upload;
+use Any::Moose;
+
+our $VERSION = '0.01';
+
+use URI;
+use LWP::UserAgent;
+use HTTP::Request::Common;
+use Web::Scraper;
+use Path::Class qw/file/;
+use XML::Simple qw/XMLin/;
+require bytes;
+
+has login => (
+ is => 'rw',
+ isa => 'Str',
+ required => 1,
+);
+
+has token => (
+ is => 'rw',
+ isa => 'Str',
+ required => 1,
+);
+
+has ua => (
+ is => 'rw',
+ isa => 'LWP::UserAgent',
+ lazy => 1,
+ default => sub {
+ my $ua = LWP::UserAgent->new;
+ $ua->env_proxy;
+ $ua;
+ },
+);
+
+has download_scraper => (
+ is => 'rw',
+ isa => 'CodeRef',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+
+ my $fileinfo = scraper {
+ process '//tr',
+ id => '@id';
+ process '//td[2]/a',
+ link => '@href',
+ name => 'TEXT';
+ process '//td[3]',
+ description => 'TEXT';
+ process '//td[4]',
+ date => 'TEXT';
+ process '//td[5]',
+ size => 'TEXT';
+ };
+
+ my $downloads = scraper {
+ process '//div[@id="browser"]//tr[contains(@id, "download")',
+ "downloads[]" => $fileinfo;
+ result 'downloads';
+ };
+ },
+);
+
+no Any::Moose;
+
+sub upload {
+ my $self = shift;
+ my $info = @_ > 1 ? {@_} : $_[0];
+
+ die "required repository name" unless $info->{repos};
+ $info->{repos} = $self->login . '/' . $info->{repos} unless $info->{repos} =~ m!/!;
+
+ # file
+ if (my $file = $info->{file}) {
+ $file = $info->{file} = file($file);
+ die qq[file "$file" does not exists or readable] unless -f $file && -r _;
+
+ $info->{name} ||= $file->basename;
+ }
+ die qq[required 'file' or 'data' parameter to upload]
+ unless $info->{file} or $info->{data};
+ die qq[required 'name' parameter for filename with 'data' parameter']
+ unless $info->{name};
+
+ # check duplicate filename
+ my ($already_uploaded)
+ = grep { $_->{name} eq $info->{name} } @{ $self->list_files( $info->{repos} ) };
+ if ($already_uploaded) {
+ die qq[file '$already_uploaded->{name}' is already uploaded. please try different name];
+ }
+
+ my $res = $self->ua->request(
+ POST "http://github.com/$info->{repos}/downloads",
+ [ file_size => $info->{file} ? $info->{file}->stat->size
+ : bytes::length( $info->{data} ),
+ content_type => $info->{content_type} || 'application/octet-stream',
+ file_name => $info->{name},
+ description => $info->{description} || '',
+ login => $self->login,
+ token => $self->token,
+ ],
+ );
+ die qq[Failed to post file info: "@{[ $res->status_line ]}"]
+ unless $res->is_success;
+
+ my $upload_info = XMLin($res->content);
+
+ $res = $self->ua->request(
+ POST 'http://github.s3.amazonaws.com/',
+ Content_Type => 'form-data',
+ 'Accept-Types' => 'text/*',
+ Content => [
+ Filename => $info->{name},
+ policy => $upload_info->{policy},
+ success_action_status => 201,
+ key => $upload_info->{prefix} . $info->{name},
+ AWSAccessKeyId => $upload_info->{accesskeyid},
+ 'Content-Type' => $info->{content_type}
+ || 'application/octet-stream',
+ signature => $upload_info->{signature},
+ acl => $upload_info->{acl},
+ file => [
+ $info->{file} || undef,
+ $info->{name},
+ 'Content-Type' => $upload_info->{content_type}
+ || 'application/octet-stream',
+ $info->{data} ? (Content => $info->{data}) : (),
+ ],
+ ],
+ );
+
+ if ($res->code == 201) {
+ return 1;
+ }
+ else {
+ die qq[Failed to upload: @{[$res->status_line]}];
+ }
+}
+
+sub list_files {
+ my ($self, $repos) = @_;
+
+ die "required repository name" unless $repos;
+ $repos = $self->login . '/' . $repos unless $repos =~ m!/!;
+
+ my $uri = URI->new("http://github.com/${repos}/downloads");
+ $uri->query_form(
+ login => $self->login,
+ token => $self->token,
+ );
+
+ my $res = $self->ua->get($uri);
+ die qq[failed to list files: "@{[ $res->status_line ]}"] unless $res->is_success;
+
+ $self->download_scraper->scrape($res->content);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+__END__
+
+=head1 NAME
+
+Net::GitHub::Upload - Module abstract (<= 44 characters) goes here
+
+=head1 SYNOPSIS
+
+use Net::GitHub::Upload;
+
+my $github = Net::GitHub::Upload->new(
+ login => 'your user name',
+ token => 'your api token',
+);
+
+# upload a file
+$github->upload(
+ repos => 'username/repository',
+ file => '/path/to/file',
+);
+
+# upload data
+$github->upload(
+ repos => 'username/repository',
+ name => 'filename',
+ data => $data,
+);
+
+=head1 DESCRIPTION
+
+Stub documentation for this module was created by ExtUtils::ModuleMaker.
+It looks like the author of the extension was negligent enough
+to leave the stub unedited.
+
+Blah blah blah.
+
+=head1 AUTHOR
+
+Daisuke Murase <typester@cpan.org>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2009 KAYAC Inc. All rights reserved.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
View
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Net::GitHub::Upload' }
View
@@ -0,0 +1,51 @@
+use Test::Base;
+
+plan skip_all => qq{"GITHUB_LIVETEST" env required for this test}
+ unless $ENV{GITHUB_LIVETEST};
+
+plan 'no_plan';
+
+use FindBin;
+use_ok 'Config::Pit';
+use_ok 'Net::GitHub::Upload';
+
+my $repos = 'konnitiwa';
+
+my $conf = pit_get('github.com', { required => {
+ username => 'your github username',
+ token => 'your github api token',
+}});
+
+my $github = Net::GitHub::Upload->new(
+ login => $conf->{username},
+ token => $conf->{token},
+);
+
+
+my $uploaded = $github->list_files($repos);
+
+is_deeply(
+ $uploaded, $github->list_files('typester/' . $repos),
+ 'username auto completion ok',
+);
+
+ok(
+ $github->upload(
+ repos => $repos,
+ name => 'test_' . time,
+ file => "$FindBin::Bin/$FindBin::Script",
+ ),
+ 'upload file ok'
+);
+
+ok(
+ $github->upload(
+ repos => $repos,
+ name => 'test_' . time . '.txt',
+ data => 'test',
+ content_type => 'text/plain',
+ ),
+ 'upload data ok'
+);
+
+is(scalar @{ $uploaded } + 2, scalar @{$github->list_files($repos)}, 'update files ok');
View
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
View
@@ -0,0 +1,5 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
+ if $@;
+all_pod_coverage_ok();

0 comments on commit 8511576

Please sign in to comment.