Dev/github/GitHubBackup.pm

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