source: lab.git/Dev/github/GitHubBackup.pm @ 7848b0b

Last change on this file since 7848b0b was 257952a, checked in by Ken-ichi Mito <mitty@…>, 11 years ago

change information messages

  • replace symbols to git command keywords
  • Property mode set to 100644
File size: 7.7 KB
Line 
1package GitHubBackup::API;
2use strict;
3use warnings;
4use utf8;
5use Carp qw(croak);
6
7use LWP::UserAgent;
8use JSON;
9
10sub new {
11    my $class = shift;
12    my $args  = shift;
13   
14    return bless $args, $class;
15}
16
17sub 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
33sub 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
62sub access_token {
63    my $self = shift;
64   
65    return $self->{access_token}->();
66}
67
68
69package GitHubBackup;
70
71use strict;
72use warnings;
73use utf8;
74use Carp qw(croak);
75use File::Spec;
76
77
78# both hash and hashref are acceptable
79sub new {
80    my $class = shift;
81    my $args = (ref $_[0] eq 'HASH') ? $_[0] : {@_};
82   
83    return bless $args, $class;
84}
85
86sub 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
98sub 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
110sub 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
121sub 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
132sub 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
144sub 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
173sub backup {
174    my $self = shift;
175   
176    foreach my $repos (@{$self->repos}) {
177        $repos->backup;
178    }
179   
180    return $self;
181}
182
183
184package GitHubBackup::Repository;
185
186use strict;
187use warnings;
188use utf8;
189use Carp qw(croak);
190use Git::Repository;
191use File::chdir;
192use File::Spec;
193use File::Path qw(mkpath);
194use LWP::UserAgent;
195use JSON;
196
197
198sub new {
199    my $class = shift;
200    my $args  = shift;
201   
202    return bless $args, $class;
203}
204
205sub clone_url {
206    return (shift)->{repos}{clone_url};
207}
208
209sub full_name {
210    return (shift)->{repos}{full_name};
211}
212
213sub has_downloads {
214    return (shift)->{repos}{has_downloads};
215}
216
217sub forks_count {
218    return (shift)->{repos}{forks_count};
219}
220
221sub has_wiki {
222    return (shift)->{repos}{has_wiki};
223}
224
225sub has_issues {
226    return (shift)->{repos}{has_issues};
227}
228
229sub 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
240sub api {
241    my $self = shift;
242   
243    return $self->{api}->();
244}
245
246sub message {
247    my $self = shift;
248    my $message  = shift;
249   
250    print $self->full_name, " $message\n";
251   
252    return $self;
253}
254
255sub 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
274sub 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
285sub 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
294sub 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
320sub 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
340sub 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
353sub 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
378sub 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
3901;
391__END__
Note: See TracBrowser for help on using the repository browser.