line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::GoogleDrive; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
25843
|
use common::sense; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
4
|
1
|
|
|
1
|
|
1227
|
use JSON; |
|
1
|
|
|
|
|
48463
|
|
|
1
|
|
|
|
|
8
|
|
5
|
1
|
|
|
1
|
|
2253
|
use Mouse; |
|
1
|
|
|
|
|
73091
|
|
|
1
|
|
|
|
|
9
|
|
6
|
1
|
|
|
1
|
|
2688
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
136220
|
|
|
1
|
|
|
|
|
54
|
|
7
|
1
|
|
|
1
|
|
1975
|
use HTTP::Request::Common; |
|
1
|
|
|
|
|
16101
|
|
|
1
|
|
|
|
|
526
|
|
8
|
1
|
|
|
1
|
|
16
|
use URI; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1976
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Net::GoogleDrive - A Google Drive API interface |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 VERSION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Version 0.02 |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Google Drive API is basd on OAuth. I try to abstract as much away as |
25
|
|
|
|
|
|
|
possible so you should not need to know too much about it. Kudos to |
26
|
|
|
|
|
|
|
Net::Dropbox::API. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This is how it works: |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use Net::GoogleDrive; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $gdrive = Net::GoogleDrive->new(); |
33
|
|
|
|
|
|
|
my $login_link = $gdrive->login_link(); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
... Time passes and the login link is clicked ... |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $gdrive = Net::GoogleDrive->new(); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# $code will come from CGI or somesuch: Google gives it to you |
40
|
|
|
|
|
|
|
$gdrive->token($code); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $files = $gdrive->files(); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
foreach my $f (@{ $files->{items} }) { |
45
|
|
|
|
|
|
|
if ($f->{downloadUrl}) { |
46
|
|
|
|
|
|
|
open(my $fh, ">", "file.dl") or die("file.dl: $!\n"); |
47
|
|
|
|
|
|
|
print($fh $gdrive->downloadUrl($f)); |
48
|
|
|
|
|
|
|
close($fh); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 FUNCTIONS |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
has 'ua' => (is => 'rw', isa => 'LWP::UserAgent', default => sub { LWP::UserAgent->new() }); |
57
|
|
|
|
|
|
|
has 'debug' => (is => 'rw', isa => 'Bool', default => 0); |
58
|
|
|
|
|
|
|
has 'error' => (is => 'rw', isa => 'Str', predicate => 'has_error'); |
59
|
|
|
|
|
|
|
has 'scope' => (is => 'rw', isa => 'Str', required => 'Str'); |
60
|
|
|
|
|
|
|
has 'redirect_uri' => (is => 'rw', isa => 'Str', required => 'Str'); |
61
|
|
|
|
|
|
|
has 'client_id' => (is => 'rw', isa => 'Str', required => 'Str'); |
62
|
|
|
|
|
|
|
has 'client_secret' => (is => 'rw', isa => 'Str'); |
63
|
|
|
|
|
|
|
has 'access_token' => (is => 'rw', isa => 'Str'); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 login_link |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
This returns the login URL. This URL has to be clicked by the user and the user then has |
68
|
|
|
|
|
|
|
to accept the application in Google Drive. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Google Drive then redirects back to the callback URI defined with |
71
|
|
|
|
|
|
|
C<$self-Eredirect_uri>. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=cut |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub login_link |
76
|
|
|
|
|
|
|
{ |
77
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
my $uri = URI->new('https://accounts.google.com/o/oauth2/auth'); |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
$uri->query_form ( |
82
|
|
|
|
|
|
|
response_type => "code", |
83
|
|
|
|
|
|
|
client_id => $self->client_id(), |
84
|
|
|
|
|
|
|
redirect_uri => $self->redirect_uri(), |
85
|
|
|
|
|
|
|
scope => $self->scope(), |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
|
return($uri->as_string()); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head2 token |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
This returns the Google Drive access token. This is needed to |
94
|
|
|
|
|
|
|
authorize with the API. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub token |
99
|
|
|
|
|
|
|
{ |
100
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
101
|
0
|
|
|
|
|
|
my $code = shift; |
102
|
|
|
|
|
|
|
|
103
|
0
|
|
0
|
|
|
|
my $req = &HTTP::Request::Common::POST( |
104
|
|
|
|
|
|
|
'https://accounts.google.com/o/oauth2/token', |
105
|
|
|
|
|
|
|
[ |
106
|
|
|
|
|
|
|
code => $code, |
107
|
|
|
|
|
|
|
client_id => $self->client_id(), |
108
|
|
|
|
|
|
|
client_secret => $self->client_secret() || die("no client_secret given"), |
109
|
|
|
|
|
|
|
redirect_uri => $self->redirect_uri(), |
110
|
|
|
|
|
|
|
grant_type => 'authorization_code', |
111
|
|
|
|
|
|
|
] |
112
|
|
|
|
|
|
|
); |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my $ua = $self->ua(); |
115
|
0
|
|
|
|
|
|
my $res = $ua->request($req); |
116
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
|
if ($res->is_success()) { |
118
|
0
|
|
|
|
|
|
my $token = JSON::from_json($res->content()); |
119
|
0
|
|
|
|
|
|
$self->access_token($token->{access_token}); |
120
|
|
|
|
|
|
|
|
121
|
0
|
0
|
|
|
|
|
print "Got Access Token ", $res->access_token(), "\n" if $self->debug(); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
else { |
124
|
0
|
|
|
|
|
|
$self->error($res->status_line()); |
125
|
0
|
|
|
|
|
|
warn "Something went wrong: ".$res->status_line(); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head2 files |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
This returns a files Resource object from JSON. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub files |
136
|
|
|
|
|
|
|
{ |
137
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
my $req = HTTP::Request->new( |
140
|
|
|
|
|
|
|
GET => 'https://www.googleapis.com/drive/v2/files', |
141
|
|
|
|
|
|
|
HTTP::Headers->new(Authorization => "Bearer " . $self->access_token()) |
142
|
|
|
|
|
|
|
); |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
my $res = $self->ua()->request($req); |
145
|
|
|
|
|
|
|
|
146
|
0
|
0
|
|
|
|
|
if ($res->is_success()) { |
147
|
0
|
|
|
|
|
|
my $list = JSON::from_json($res->content()); |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
return($list); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
else { |
152
|
0
|
|
|
|
|
|
$self->error($res->status_line()); |
153
|
0
|
|
|
|
|
|
warn "Something went wrong: ".$res->status_line(); |
154
|
0
|
|
|
|
|
|
return(undef); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head2 downloadUrl |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
This returns the binary data from a file. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub downloadUrl |
165
|
|
|
|
|
|
|
{ |
166
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
167
|
0
|
|
|
|
|
|
my $file = shift; |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
my $req = HTTP::Request->new( |
170
|
|
|
|
|
|
|
GET => $$file{downloadUrl}, |
171
|
|
|
|
|
|
|
HTTP::Headers->new(Authorization => "Bearer " . $self->access_token()) |
172
|
|
|
|
|
|
|
); |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
|
my $res = $self->ua()->request($req); |
175
|
|
|
|
|
|
|
|
176
|
0
|
0
|
|
|
|
|
if ($res->is_success()) { |
177
|
0
|
|
|
|
|
|
return($res->content()); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
else { |
180
|
0
|
|
|
|
|
|
$self->error($res->status_line()); |
181
|
0
|
|
|
|
|
|
warn "Something went wrong: ".$res->status_line(); |
182
|
0
|
|
|
|
|
|
return(undef); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head2 FUTURE |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
More can be added if there is interest. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=cut |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head1 AUTHOR |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Brian Medley, C<< >> |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head1 BUGS |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
There are plenty. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head1 SUPPORT |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
perldoc Net::GoogleDrive |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Copyright 2012 Brian Medley. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
211
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
212
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=cut |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
1; |