1 | package GitHubBackup::API; |
---|
2 | use strict; |
---|
3 | use warnings; |
---|
4 | use utf8; |
---|
5 | use Carp qw(croak); |
---|
6 | |
---|
7 | use LWP::UserAgent; |
---|
8 | use JSON; |
---|
9 | |
---|
10 | sub new { |
---|
11 | my $class = shift; |
---|
12 | my $args = shift; |
---|
13 | |
---|
14 | return bless $args, $class; |
---|
15 | } |
---|
16 | |
---|
17 | sub json_api { |
---|
18 | my $self = shift; |
---|
19 | my $url = shift; |
---|
20 | |
---|
21 | my $ua = LWP::UserAgent->new; |
---|
22 | my $json = JSON->new->utf8->indent; |
---|
23 | |
---|
24 | my $res = $ua->get( |
---|
25 | "https://api.github.com$url" |
---|
26 | ); |
---|
27 | |
---|
28 | $res->is_success or croak $res->status_line; |
---|
29 | |
---|
30 | return $json->decode($res->content); |
---|
31 | } |
---|
32 | |
---|
33 | sub get { |
---|
34 | my $self = shift; |
---|
35 | my $url = shift; |
---|
36 | my %parameters = @_; |
---|
37 | |
---|
38 | if ($self->access_token) { |
---|
39 | $parameters{access_token} = $self->access_token; |
---|
40 | } |
---|
41 | my $parameters = ''; |
---|
42 | while (my($key, $value) = each %parameters) { |
---|
43 | $parameters .= "&$key=$value"; |
---|
44 | } |
---|
45 | |
---|
46 | my $page = 1; |
---|
47 | my $data = []; |
---|
48 | while(1) { |
---|
49 | my $result = $self->json_api("$url?per_page=100&page=$page$parameters"); |
---|
50 | if (ref($result) eq 'ARRAY' && scalar @$result > 0) { |
---|
51 | push @$data, @$result; |
---|
52 | $page++; |
---|
53 | |
---|
54 | next; |
---|
55 | } |
---|
56 | last; |
---|
57 | } |
---|
58 | |
---|
59 | return $data; |
---|
60 | } |
---|
61 | |
---|
62 | sub access_token { |
---|
63 | my $self = shift; |
---|
64 | |
---|
65 | return $self->{access_token}->(); |
---|
66 | } |
---|
67 | |
---|
68 | |
---|
69 | package GitHubBackup; |
---|
70 | |
---|
71 | use strict; |
---|
72 | use warnings; |
---|
73 | use utf8; |
---|
74 | use Carp qw(croak); |
---|
75 | use File::Spec; |
---|
76 | |
---|
77 | |
---|
78 | # both hash and hashref are acceptable |
---|
79 | sub new { |
---|
80 | my $class = shift; |
---|
81 | my $args = (ref $_[0] eq 'HASH') ? $_[0] : {@_}; |
---|
82 | |
---|
83 | return bless $args, $class; |
---|
84 | } |
---|
85 | |
---|
86 | sub account { |
---|
87 | my $self = shift; |
---|
88 | my $args = shift; |
---|
89 | |
---|
90 | if (defined $args) { |
---|
91 | $self->{repos} = undef; |
---|
92 | $self->{account} = $args; |
---|
93 | } |
---|
94 | |
---|
95 | return $self->{account}; |
---|
96 | } |
---|
97 | |
---|
98 | sub repository { |
---|
99 | my $self = shift; |
---|
100 | my $args = shift; |
---|
101 | |
---|
102 | if (defined $args) { |
---|
103 | $self->{repos} = undef; |
---|
104 | $self->{repository} = $args; |
---|
105 | } |
---|
106 | |
---|
107 | return $self->{repository}; |
---|
108 | } |
---|
109 | |
---|
110 | sub directory { |
---|
111 | my $self = shift; |
---|
112 | my $args = shift; |
---|
113 | |
---|
114 | if (defined $args) { |
---|
115 | $self->{directory} = File::Spec->rel2abs($args); |
---|
116 | } |
---|
117 | |
---|
118 | return $self->{directory}; |
---|
119 | } |
---|
120 | |
---|
121 | sub access_token { |
---|
122 | my $self = shift; |
---|
123 | my $args = shift; |
---|
124 | |
---|
125 | if (defined $args) { |
---|
126 | $self->{access_token} = $args; |
---|
127 | } |
---|
128 | |
---|
129 | return $self->{access_token}; |
---|
130 | } |
---|
131 | |
---|
132 | sub api { |
---|
133 | my $self = shift; |
---|
134 | |
---|
135 | unless ($self->{api}) { |
---|
136 | $self->{api} = GitHubBackup::API->new({ |
---|
137 | access_token => sub {$self->access_token}, |
---|
138 | }); |
---|
139 | } |
---|
140 | |
---|
141 | return $self->{api}; |
---|
142 | } |
---|
143 | |
---|
144 | sub repos { |
---|
145 | my $self = shift; |
---|
146 | return $self->{repos} if ($self->{repos}); |
---|
147 | |
---|
148 | $self->{repos} = []; |
---|
149 | |
---|
150 | my $account = $self->account or croak "account is not set"; |
---|
151 | my $token = ($self->access_token) ? "?access_token=" . $self->access_token : ''; |
---|
152 | my $result; |
---|
153 | if (my $repository = $self->repository) { |
---|
154 | $result = [ $self->api->json_api("/repos/$account/$repository$token") ]; |
---|
155 | } |
---|
156 | else { |
---|
157 | $result = $self->api->get("/users/$account/repos"); |
---|
158 | } |
---|
159 | |
---|
160 | foreach my $repos (@$result) { |
---|
161 | push @{$self->{repos}}, |
---|
162 | GitHubBackup::Repository->new({ |
---|
163 | directory => sub {$self->directory}, |
---|
164 | api => sub {$self->api}, |
---|
165 | repos => $repos, |
---|
166 | }) |
---|
167 | ; |
---|
168 | } |
---|
169 | |
---|
170 | return $self->{repos}; |
---|
171 | } |
---|
172 | |
---|
173 | sub backup { |
---|
174 | my $self = shift; |
---|
175 | |
---|
176 | foreach my $repos (@{$self->repos}) { |
---|
177 | $repos->backup; |
---|
178 | } |
---|
179 | |
---|
180 | return $self; |
---|
181 | } |
---|
182 | |
---|
183 | |
---|
184 | package GitHubBackup::Repository; |
---|
185 | |
---|
186 | use strict; |
---|
187 | use warnings; |
---|
188 | use utf8; |
---|
189 | use Carp qw(croak); |
---|
190 | use Git::Repository; |
---|
191 | use File::chdir; |
---|
192 | use File::Spec; |
---|
193 | use File::Path qw(mkpath); |
---|
194 | use LWP::UserAgent; |
---|
195 | use JSON; |
---|
196 | |
---|
197 | |
---|
198 | sub new { |
---|
199 | my $class = shift; |
---|
200 | my $args = shift; |
---|
201 | |
---|
202 | return bless $args, $class; |
---|
203 | } |
---|
204 | |
---|
205 | sub clone_url { |
---|
206 | return (shift)->{repos}{clone_url}; |
---|
207 | } |
---|
208 | |
---|
209 | sub full_name { |
---|
210 | return (shift)->{repos}{full_name}; |
---|
211 | } |
---|
212 | |
---|
213 | sub has_downloads { |
---|
214 | return (shift)->{repos}{has_downloads}; |
---|
215 | } |
---|
216 | |
---|
217 | sub forks_count { |
---|
218 | return (shift)->{repos}{forks_count}; |
---|
219 | } |
---|
220 | |
---|
221 | sub has_wiki { |
---|
222 | return (shift)->{repos}{has_wiki}; |
---|
223 | } |
---|
224 | |
---|
225 | sub has_issues { |
---|
226 | return (shift)->{repos}{has_issues}; |
---|
227 | } |
---|
228 | |
---|
229 | sub directory { |
---|
230 | my $self = shift; |
---|
231 | |
---|
232 | my $path = $self->full_name; |
---|
233 | if (my $base = $self->{directory}->()) { |
---|
234 | $path = File::Spec->catfile($base, $path); |
---|
235 | } |
---|
236 | |
---|
237 | return $path; |
---|
238 | } |
---|
239 | |
---|
240 | sub api { |
---|
241 | my $self = shift; |
---|
242 | |
---|
243 | return $self->{api}->(); |
---|
244 | } |
---|
245 | |
---|
246 | sub message { |
---|
247 | my $self = shift; |
---|
248 | my $message = shift; |
---|
249 | |
---|
250 | print $self->full_name, " $message\n"; |
---|
251 | |
---|
252 | return $self; |
---|
253 | } |
---|
254 | |
---|
255 | sub sync { |
---|
256 | my $self = shift; |
---|
257 | my $url = shift; |
---|
258 | my $dir = shift; |
---|
259 | |
---|
260 | if (-d "$dir") { |
---|
261 | local $CWD = $dir; |
---|
262 | $self->message("fetch --all $dir"); |
---|
263 | Git::Repository->run(fetch => '--all'); |
---|
264 | return $self; |
---|
265 | } |
---|
266 | |
---|
267 | $self->message("clone --mirror $dir"); |
---|
268 | mkpath $dir; |
---|
269 | Git::Repository->run(clone => '--mirror' => $url => $dir); |
---|
270 | |
---|
271 | return $self; |
---|
272 | } |
---|
273 | |
---|
274 | sub clone_git { |
---|
275 | my $self = shift; |
---|
276 | |
---|
277 | my $dir = $self->directory . '.git'; |
---|
278 | my $url = $self->clone_url; |
---|
279 | |
---|
280 | $self->sync($url => $dir); |
---|
281 | |
---|
282 | return $self; |
---|
283 | } |
---|
284 | |
---|
285 | sub forks { |
---|
286 | my $self = shift; |
---|
287 | return $self->{forks} if ($self->{forks}); |
---|
288 | |
---|
289 | $self->{forks} = $self->api->get("/repos/" . $self->full_name . "/forks"); |
---|
290 | |
---|
291 | return $self->{forks}; |
---|
292 | } |
---|
293 | |
---|
294 | sub set_forks { |
---|
295 | my $self = shift; |
---|
296 | |
---|
297 | my $dir = $self->directory . '.git'; |
---|
298 | local $CWD = $dir; |
---|
299 | |
---|
300 | my $remotes = Git::Repository->run(branch => '--remotes'); |
---|
301 | my @fetch; |
---|
302 | foreach my $fork (@{$self->forks}) { |
---|
303 | if ($remotes =~ /$fork->{full_name}/) { |
---|
304 | $self->message("have ". $fork->{full_name}); |
---|
305 | next; |
---|
306 | } |
---|
307 | $self->message("remote add ". $fork->{full_name}); |
---|
308 | Git::Repository->run(remote => add => $fork->{full_name} => $fork->{clone_url}); |
---|
309 | push @fetch, $fork->{full_name}; |
---|
310 | } |
---|
311 | |
---|
312 | foreach my $fork (@fetch) { |
---|
313 | $self->message("fetch $fork"); |
---|
314 | Git::Repository->run(fetch => $fork); |
---|
315 | } |
---|
316 | |
---|
317 | return $self; |
---|
318 | } |
---|
319 | |
---|
320 | sub clone_wiki { |
---|
321 | my $self = shift; |
---|
322 | |
---|
323 | my $dir = $self->directory . '.wiki.git'; |
---|
324 | my $url = 'https://github.com/' . $self->full_name . '.wiki.git'; |
---|
325 | |
---|
326 | my $ua = LWP::UserAgent->new(max_redirect => 0); |
---|
327 | my $res = $ua->head( |
---|
328 | 'https://github.com/' . $self->full_name . '/wiki' |
---|
329 | ); |
---|
330 | if ($res->code != 200) { |
---|
331 | $self->message("wiki does not exist"); |
---|
332 | return $self; |
---|
333 | } |
---|
334 | |
---|
335 | $self->sync($url => $dir); |
---|
336 | |
---|
337 | return $self; |
---|
338 | } |
---|
339 | |
---|
340 | sub issues { |
---|
341 | my $self = shift; |
---|
342 | return $self->{issues} if ($self->{issues}); |
---|
343 | |
---|
344 | my $open = $self->api->get("/repos/" . $self->full_name . "/issues"); |
---|
345 | my $closed = $self->api->get("/repos/" . $self->full_name . "/issues", state => 'closed'); |
---|
346 | |
---|
347 | if ($open) { push @{$self->{issues}}, @$open } |
---|
348 | if ($closed) { push @{$self->{issues}}, @$closed } |
---|
349 | |
---|
350 | return $self->{issues}; |
---|
351 | } |
---|
352 | |
---|
353 | sub save_issues { |
---|
354 | my $self = shift; |
---|
355 | |
---|
356 | my $ua = LWP::UserAgent->new; |
---|
357 | my $json = JSON->new->utf8->indent; |
---|
358 | |
---|
359 | my $dir = $self->directory . '.issues'; |
---|
360 | mkpath $dir unless (-d $dir); |
---|
361 | local $CWD = $dir; |
---|
362 | foreach my $issue (@{$self->issues}) { |
---|
363 | my $number = $issue->{number}; |
---|
364 | $self->message("save issue/$number"); |
---|
365 | |
---|
366 | open my $fh, ">$number.json"; |
---|
367 | print $fh $json->encode($issue); |
---|
368 | close $fh; |
---|
369 | |
---|
370 | if (exists $issue->{pull_request}{patch_url}) { |
---|
371 | $ua->mirror($issue->{pull_request}{patch_url} => "$number.patch"); |
---|
372 | } |
---|
373 | } |
---|
374 | |
---|
375 | return $self; |
---|
376 | } |
---|
377 | |
---|
378 | sub backup { |
---|
379 | my $self = shift; |
---|
380 | |
---|
381 | $self->clone_git if ($self->has_downloads eq 'true'); |
---|
382 | $self->set_forks if ($self->forks_count > 0); |
---|
383 | $self->clone_wiki if ($self->has_wiki eq 'true'); |
---|
384 | $self->save_issues if ($self->has_issues eq 'true'); |
---|
385 | |
---|
386 | return $self; |
---|
387 | } |
---|
388 | |
---|
389 | |
---|
390 | 1; |
---|
391 | __END__ |
---|