File Coverage

blib/lib/Google/Code/Upload.pm
Criterion Covered Total %
statement 27 60 45.0
branch 0 10 0.0
condition 0 13 0.0
subroutine 9 11 81.8
pod 2 2 100.0
total 38 96 39.5


line stmt bran cond sub pod time code
1             package Google::Code::Upload;
2 1     1   16902 use strict;
  1         3  
  1         53  
3 1     1   7 use warnings;
  1         2  
  1         61  
4             # ABSTRACT: upload files to a Google Code project (deprecated)
5             our $VERSION = '0.08'; # VERSION
6              
7 1     1   7 use File::Basename qw/basename/;
  1         2  
  1         116  
8 1     1   901 use LWP::UserAgent;
  1         47030  
  1         50  
9 1     1   722 use LWP::Protocol::https;
  1         118994  
  1         44  
10 1     1   582 use HTTP::Request::Common;
  1         1617  
  1         70  
11 1     1   6 use Scalar::Util qw/blessed/;
  1         2  
  1         42  
12 1     1   4 use Carp;
  1         1  
  1         46  
13              
14              
15              
16 1     1   5 use Exporter qw(import);
  1         1  
  1         417  
17             our @EXPORT_OK = qw/ upload /;
18              
19              
20             sub new {
21 0     0 1   my $class = shift;
22 0           my %args = @_;
23 0   0       $args{$_} || croak "You must provide $_" for qw(username password project);
24              
25 0 0         if ( $args{username} =~ /^(.*?)\@gmail\.com$/ ) {
26 0           $args{username} = $1;
27             }
28 0 0         my $agent_string = "$class/" . (defined $class->VERSION ? $class->VERSION : 'dev');
29              
30 0   0       my $self = {
31             ua => $args{ua} || LWP::UserAgent->new( agent => $agent_string ),
32             upload_uri => "https://$args{project}.googlecode.com/files",
33             password => $args{password},
34             username => $args{username},
35             };
36 0           return bless $self, $class;
37             }
38              
39              
40             sub upload {
41 0     0 1   my $self;
42             my $summary;
43 0           my $labels;
44 0           my $file;
45 0           my $description;
46              
47 0 0         if (blessed $_[0]) {
48 0           $self = shift;
49 0           my %args = @_;
50 0           $file = $args{file};
51 0   0       $summary = $args{summary} || basename($file);
52 0   0       $labels = $args{labels} || [];
53 0           $description = $args{description};
54             }
55             else {
56 0           $file = shift;
57 0           my $project = shift;
58 0           my $username = shift;
59 0           my $password = shift;
60 0           $summary = shift;
61 0   0       $labels = shift || [];
62 0           $description = shift;
63              
64 0           $self = __PACKAGE__->new(
65             project => $project,
66             username => $username,
67             password => $password,
68             );
69             }
70              
71 0           my $request = POST $self->{upload_uri},
72             Content_Type => 'form-data',
73             Content => [
74             summary => $summary,
75             ( $description ? (description => $description) : ()),
76 0 0         ( map { (label => $_) } @$labels),
77             filename => [$file, basename($file), Content_Type => 'application/octet-stream'],
78             ];
79 0           $request->authorization_basic($self->{username}, $self->{password});
80              
81 0           my $response = $self->{ua}->request($request);
82              
83 0 0         return $response->header('Location')
84             if $response->code == 201;
85 0           croak $response->status_line;
86             }
87              
88             1;
89              
90             __END__