Dev/github/GitHubBackup.pm

   1 package utils;
   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 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
  25 sub 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
  50 package GitHubBackup;
  51
  52 use strict;
  53 use warnings;
  54 use utf8;
  55 use Carp qw(croak);
  56 use File::Spec;
  57
  58
  59 # both hash and hashref are acceptable
  60 sub new {
  61     my $class = shift;
  62     my $args = (ref $_[0] eq 'HASH') ? $_[0] : {@_};
  63
  64     return bless $args, $class;
  65 }
  66
  67 sub 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
  79 sub 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
  91 sub 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
 102 sub 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     my $result;
 110     if (my $repository = $self->repository) {
 111         $result = [ utils::json_api("/repos/$account/$repository") ];
 112     }
 113     else {
 114         $result = utils::get("/users/$account/repos");
 115     }
 116
 117     foreach my $repos (@$result) {
 118         push @{$self->{repos}},
 119             GitHubBackup::Repository->new({
 120                 directory => sub {$self->directory},
 121                 repos     => $repos,
 122             })
 123         ;
 124     }
 125
 126     return $self->{repos};
 127 }
 128
 129 sub backup {
 130     my $self = shift;
 131
 132     foreach my $repos (@{$self->repos}) {
 133         $repos->backup;
 134     }
 135
 136     return $self;
 137 }
 138
 139
 140 package GitHubBackup::Repository;
 141
 142 use strict;
 143 use warnings;
 144 use utf8;
 145 use Carp qw(croak);
 146 use Git::Repository;
 147 use File::chdir;
 148 use File::Spec;
 149 use File::Path qw(mkpath);
 150 use LWP::UserAgent;
 151 use JSON;
 152
 153
 154 sub new {
 155     my $class = shift;
 156     my $args  = shift;
 157
 158     return bless $args, $class;
 159 }
 160
 161 sub clone_url {
 162     return (shift)->{repos}{clone_url};
 163 }
 164
 165 sub full_name {
 166     return (shift)->{repos}{full_name};
 167 }
 168
 169 sub directory {
 170     my $self = shift;
 171
 172     my $path = $self->full_name;
 173     if (my $base = $self->{directory}->()) {
 174         $path = File::Spec->catfile($base, $path);
 175     }
 176
 177     return $path;
 178 }
 179
 180 sub sync {
 181     my $self = shift;
 182     my $url = shift;
 183     my $dir = shift;
 184
 185     if (-d "$dir") {
 186         local $CWD = $dir;
 187         print "fetch ", $dir, "\n";
 188         Git::Repository->run(fetch => '--all');
 189         return $self;
 190     }
 191
 192     print "clone ", $dir, "\n";
 193     mkpath $dir;
 194     Git::Repository->run(clone => '--mirror' => $url => $dir);
 195
 196     return $self;
 197 }
 198
 199 sub clone_git {
 200     my $self = shift;
 201
 202     my $dir = $self->directory . '.git';
 203     my $url = $self->clone_url;
 204
 205     $self->sync($url => $dir);
 206
 207     return $self;
 208 }
 209
 210 sub forks {
 211     my $self = shift;
 212     return $self->{forks} if ($self->{forks});
 213
 214     $self->{forks} = utils::get("/repos/" . $self->full_name . "/forks");
 215
 216     return $self->{forks};
 217 }
 218
 219 sub set_forks {
 220     my $self = shift;
 221
 222     my $dir = $self->directory . '.git';
 223     local $CWD = $dir;
 224
 225     my $remotes = Git::Repository->run(branch => '--remotes');
 226     my @fetch;
 227     foreach my $fork (@{$self->forks}) {
 228         if ($remotes =~ /$fork->{full_name}/) {
 229             print "skip ", $fork->{full_name}, "\n";
 230             next;
 231         }
 232         print "add ", $fork->{full_name}, "\n";
 233         Git::Repository->run(remote => add => $fork->{full_name} => $fork->{clone_url});
 234         push @fetch, $fork->{full_name};
 235     }
 236
 237     foreach my $fork (@fetch) {
 238         print "fetch ", $fork, "\n";
 239         Git::Repository->run(fetch => $fork);
 240     }
 241
 242     return $self;
 243 }
 244
 245 sub clone_wiki {
 246     my $self = shift;
 247
 248     my $dir = $self->directory . '.wiki.git';
 249     my $url = 'https://github.com/' . $self->full_name . '.wiki.git';
 250
 251     $self->sync($url => $dir);
 252
 253     return $self;
 254 }
 255
 256 sub issues {
 257     my $self = shift;
 258     return $self->{issues} if ($self->{issues});
 259
 260     my $open   = utils::get("/repos/" . $self->full_name . "/issues");
 261     my $closed = utils::get("/repos/" . $self->full_name . "/issues", state => 'closed');
 262
 263     if ($open)   { push @{$self->{issues}}, @$open }
 264     if ($closed) { push @{$self->{issues}}, @$closed }
 265
 266     return $self->{issues};
 267 }
 268
 269 sub save_issues {
 270     my $self = shift;
 271
 272     my $ua = LWP::UserAgent->new;
 273     my $json = JSON->new->utf8->indent;
 274
 275     my $dir = $self->directory . '.issues';
 276     mkpath $dir unless (-d $dir);
 277     local $CWD = $dir;
 278     foreach my $issue (@{$self->issues}) {
 279         my $number = $issue->{number};
 280         print "save issue/$number\n";
 281
 282         open my $fh, ">$number.json";
 283         print $fh $json->encode($issue);
 284         close $fh;
 285
 286         if (exists $issue->{pull_request}{patch_url}) {
 287             $ua->mirror($issue->{pull_request}{patch_url} => "$number.patch");
 288         }
 289     }
 290
 291     return $self;
 292 }
 293
 294 sub backup {
 295     my $self = shift;
 296
 297     $self->clone_git;
 298     $self->set_forks;
 299     $self->clone_wiki;
 300     $self->save_issues;
 301
 302     return $self;
 303 }
 304
 305
 306 1;
 307 __END__