source: lab.git/Dev/github/GitHubBackup.pm @ d51047d

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

utils::get returns '[]' while json_api gives no results

  • GitHubBackup->repos gives '[]' if no repositories
  • Property mode set to 100644
File size: 6.2 KB
Line 
1package utils;
2use strict;
3use warnings;
4use utf8;
5use Carp qw(croak);
6
7use LWP::UserAgent;
8use JSON;
9
10sub json_api {
11    my $url = shift;
12   
13    my $ua = LWP::UserAgent->new;
14    my $json = JSON->new->utf8->indent;
15   
16    my $res = $ua->get(
17        "https://api.github.com$url"
18    );
19   
20    $res->is_success or croak $res->status_line;
21   
22    return $json->decode($res->content);
23}
24
25sub get {
26    my $url = shift;
27    my %parameters = @_;
28   
29    my $parameters = '';
30    while (my($key, $value) = each %parameters) {
31        $parameters .= "&$key=$value";
32    }
33   
34    my $page = 1;
35    my $data = [];
36    while(1) {
37        my $result = json_api("$url?per_page=100&page=$page$parameters");
38        if (ref($result) eq 'ARRAY' && scalar @$result > 0) {
39            push @$data, @$result;
40            $page++;
41           
42            next;
43        }
44        last;
45    }
46   
47    return $data;
48}
49
50package GitHubBackup;
51
52use strict;
53use warnings;
54use utf8;
55use Carp qw(croak);
56use File::Spec;
57
58
59# both hash and hashref are acceptable
60sub new {
61    my $class = shift;
62    my $args = (ref $_[0] eq 'HASH') ? $_[0] : {@_};
63   
64    return bless $args, $class;
65}
66
67sub account {
68    my $self = shift;
69    my $args = shift;
70   
71    if (defined $args) {
72        $self->{repos} = undef;
73        $self->{account} = $args;
74    }
75   
76    return $self->{account};
77}
78
79sub repository {
80    my $self = shift;
81    my $args = shift;
82   
83    if (defined $args) {
84        $self->{repos} = undef;
85        $self->{repository} = $args;
86    }
87   
88    return $self->{repository};
89}
90
91sub directory {
92    my $self = shift;
93    my $args = shift;
94   
95    if (defined $args) {
96        $self->{directory} = File::Spec->rel2abs($args);
97    }
98   
99    return $self->{directory};
100}
101
102sub repos {
103    my $self = shift;
104    return $self->{repos} if ($self->{repos});
105   
106    $self->{repos} = [];
107   
108    my $account = $self->account or croak "account is not set";
109    if (my $repository = $self->repository) {
110        $self->{repos} = [
111            GitHubBackup::Repository->new({
112                directory => sub {$self->directory},
113                full_name => "$account/$repository",
114            })
115        ];
116       
117        return $self->{repos};
118    }
119   
120    my $result = utils::get("/users/$account/repos");
121    foreach my $repos (@$result) {
122        push @{$self->{repos}},
123            GitHubBackup::Repository->new({
124                directory => sub {$self->directory},
125                full_name => $repos->{full_name},
126                clone_url => $repos->{clone_url},
127            })
128        ;
129    }
130   
131    return $self->{repos};
132}
133
134sub backup {
135    my $self = shift;
136   
137    foreach my $repos (@{$self->repos}) {
138        $repos->backup;
139    }
140   
141    return $self;
142}
143
144
145package GitHubBackup::Repository;
146
147use strict;
148use warnings;
149use utf8;
150use Carp qw(croak);
151use Git::Repository;
152use File::chdir;
153use File::Spec;
154use File::Path qw(mkpath);
155use LWP::UserAgent;
156use JSON;
157
158
159sub new {
160    my $class = shift;
161    my $args  = shift;
162   
163    if (! exists $args->{clone_url}) {
164        my $result = utils::json_api('/repos/' . $args->{full_name});
165        $args->{clone_url} = $result->{clone_url};
166    }
167   
168    return bless $args, $class;
169}
170
171sub directory {
172    my $self = shift;
173   
174    my $path = $self->{full_name};
175    if (my $base = $self->{directory}->()) {
176        $path = File::Spec->catfile($base, $path);
177    }
178   
179    return $path;
180}
181
182sub sync {
183    my $self = shift;
184    my $url = shift;
185    my $dir = shift;
186   
187    if (-d "$dir") {
188        local $CWD = $dir;
189        print "fetch ", $dir, "\n";
190        Git::Repository->run(fetch => '--all');
191        return $self;
192    }
193   
194    print "clone ", $dir, "\n";
195    mkpath $dir;
196    Git::Repository->run(clone => '--mirror' => $url => $dir);
197   
198    return $self;
199}
200
201sub clone_git {
202    my $self = shift;
203   
204    my $dir = $self->directory . '.git';
205    my $url = $self->{clone_url};
206   
207    $self->sync($url => $dir);
208   
209    return $self;
210}
211
212sub forks {
213    my $self = shift;
214    return $self->{forks} if ($self->{forks});
215   
216    $self->{forks} = utils::get("/repos/" . $self->{full_name} . "/forks");
217   
218    return $self->{forks};
219}
220
221sub set_forks {
222    my $self = shift;
223   
224    my $dir = $self->directory . '.git';
225    local $CWD = $dir;
226   
227    my $remotes = Git::Repository->run(branch => '--remotes');
228    my @fetch;
229    foreach my $fork (@{$self->forks}) {
230        if ($remotes =~ /$fork->{full_name}/) {
231            print "skip ", $fork->{full_name}, "\n";
232            next;
233        }
234        print "add ", $fork->{full_name}, "\n";
235        Git::Repository->run(remote => add => $fork->{full_name} => $fork->{clone_url});
236        push @fetch, $fork->{full_name};
237    }
238   
239    foreach my $fork (@fetch) {
240        print "fetch ", $fork, "\n";
241        Git::Repository->run(fetch => $fork);
242    }
243   
244    return $self;
245}
246
247sub clone_wiki {
248    my $self = shift;
249   
250    my $dir = $self->directory . '.wiki.git';
251    my $url = 'https://github.com/' . $self->{full_name} . '.wiki.git';
252   
253    $self->sync($url => $dir);
254   
255    return $self;
256}
257
258sub issues {
259    my $self = shift;
260    return $self->{issues} if ($self->{issues});
261   
262    my $open   = utils::get("/repos/" . $self->{full_name} . "/issues");
263    my $closed = utils::get("/repos/" . $self->{full_name} . "/issues", state => 'closed');
264   
265    if ($open)   { push @{$self->{issues}}, @$open }
266    if ($closed) { push @{$self->{issues}}, @$closed }
267   
268    return $self->{issues};
269}
270
271sub save_issues {
272    my $self = shift;
273   
274    my $ua = LWP::UserAgent->new;
275    my $json = JSON->new->utf8->indent;
276   
277    my $dir = $self->directory . '.issues';
278    mkpath $dir unless (-d $dir);
279    local $CWD = $dir;
280    foreach my $issue (@{$self->issues}) {
281        my $number = $issue->{number};
282        print "save issue/$number\n";
283       
284        open my $fh, ">$number.json";
285        print $fh $json->encode($issue);
286        close $fh;
287       
288        if (exists $issue->{pull_request}{patch_url}) {
289            $ua->mirror($issue->{pull_request}{patch_url} => "$number.patch");
290        }
291    }
292   
293    return $self;
294}
295
296sub backup {
297    my $self = shift;
298   
299    $self->clone_git;
300    $self->set_forks;
301    $self->clone_wiki;
302    $self->save_issues;
303   
304    return $self;
305}
306
307
3081;
309__END__
Note: See TracBrowser for help on using the repository browser.