| [6a2e5f1] | 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 | my $ua = LWP::UserAgent->new; |
|---|
| 10 | my $json = JSON->new->utf8->indent; |
|---|
| 11 | |
|---|
| 12 | sub json_api { |
|---|
| 13 | my $url = shift; |
|---|
| 14 | |
|---|
| 15 | my $res = $ua->get( |
|---|
| 16 | "https://api.github.com$url" |
|---|
| 17 | ); |
|---|
| 18 | |
|---|
| 19 | $res->is_success or croak $res->status_line; |
|---|
| 20 | |
|---|
| 21 | return $json->decode($res->content); |
|---|
| 22 | } |
|---|
| 23 | |
|---|
| [19233f5] | 24 | |
|---|
| [6a2e5f1] | 25 | package GitHubBackup; |
|---|
| 26 | use base qw(Class::Accessor::Fast); |
|---|
| 27 | |
|---|
| 28 | use strict; |
|---|
| 29 | use warnings; |
|---|
| 30 | use utf8; |
|---|
| 31 | use Carp qw(croak); |
|---|
| 32 | |
|---|
| 33 | __PACKAGE__->mk_accessors( qw( |
|---|
| 34 | directory |
|---|
| 35 | account |
|---|
| 36 | repository |
|---|
| 37 | )); |
|---|
| 38 | |
|---|
| 39 | |
|---|
| 40 | # both hash and hashref are acceptable |
|---|
| 41 | sub new { |
|---|
| 42 | my $class = shift; |
|---|
| 43 | |
|---|
| 44 | my $args = (ref $_[0] eq 'HASH') ? $_[0] : {@_}; |
|---|
| [19233f5] | 45 | if (! $args->{directory}) { |
|---|
| 46 | $args->{directory} = "."; |
|---|
| 47 | } |
|---|
| 48 | |
|---|
| [6a2e5f1] | 49 | return $class->SUPER::new($args); |
|---|
| 50 | } |
|---|
| 51 | |
|---|
| 52 | sub repos { |
|---|
| 53 | my $self = shift; |
|---|
| [19233f5] | 54 | return $self->{repos} if ($self->{repos}); |
|---|
| [6a2e5f1] | 55 | |
|---|
| 56 | my $account = $self->account or croak "account is not set"; |
|---|
| 57 | if (my $repository = $self->repository) { |
|---|
| 58 | $self->{repos} = [ |
|---|
| [19233f5] | 59 | GitHubBackup::Repository->new({ |
|---|
| 60 | __super => $self, |
|---|
| 61 | full_name => "$account/$repository", |
|---|
| 62 | }) |
|---|
| [6a2e5f1] | 63 | ]; |
|---|
| 64 | |
|---|
| 65 | return $self->{repos}; |
|---|
| 66 | } |
|---|
| 67 | |
|---|
| 68 | my $page = 1; |
|---|
| 69 | my @repos; |
|---|
| 70 | while (1) { |
|---|
| 71 | my $result = utils::json_api("/users/$account/repos?per_page=100&page=$page"); |
|---|
| 72 | if (ref($result) eq 'ARRAY' && scalar @$result > 0) { |
|---|
| 73 | push @repos, @$result; |
|---|
| 74 | $page++; |
|---|
| 75 | |
|---|
| 76 | next; |
|---|
| 77 | } |
|---|
| 78 | last; |
|---|
| 79 | } |
|---|
| 80 | |
|---|
| 81 | foreach my $repos (@repos) { |
|---|
| 82 | push @{$self->{repos}}, |
|---|
| 83 | GitHubBackup::Repository->new({ |
|---|
| [19233f5] | 84 | __super => $self, |
|---|
| [6a2e5f1] | 85 | full_name => $repos->{full_name}, |
|---|
| 86 | clone_url => $repos->{clone_url}, |
|---|
| 87 | }) |
|---|
| 88 | ; |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | return $self->{repos}; |
|---|
| 92 | } |
|---|
| 93 | |
|---|
| 94 | |
|---|
| 95 | package GitHubBackup::Repository; |
|---|
| 96 | use base qw(Class::Accessor::Fast); |
|---|
| 97 | |
|---|
| 98 | use strict; |
|---|
| 99 | use warnings; |
|---|
| 100 | use utf8; |
|---|
| 101 | use Carp qw(croak); |
|---|
| [19233f5] | 102 | use Git::Repository; |
|---|
| 103 | use File::chdir; |
|---|
| 104 | |
|---|
| 105 | sub new { |
|---|
| 106 | my $class = shift; |
|---|
| 107 | my $args = shift; |
|---|
| 108 | |
|---|
| 109 | if (! exists $args->{clone_url}) { |
|---|
| 110 | my $result = utils::json_api('/repos/' . $args->{full_name}); |
|---|
| 111 | $args->{clone_url} = $result->{clone_url}; |
|---|
| 112 | } |
|---|
| 113 | |
|---|
| 114 | return $class->SUPER::new($args); |
|---|
| 115 | } |
|---|
| 116 | |
|---|
| 117 | sub clone_git { |
|---|
| 118 | my $self = shift; |
|---|
| 119 | |
|---|
| 120 | my $dir = $self->{__super}->directory .'/'. $self->{full_name}; |
|---|
| 121 | if (-d "$dir") { |
|---|
| 122 | local $CWD = $dir; |
|---|
| 123 | print "fetch ", $self->{full_name}, "\n"; |
|---|
| 124 | Git::Repository->run(fetch => '--all'); |
|---|
| 125 | return $self; |
|---|
| 126 | } |
|---|
| 127 | |
|---|
| 128 | print "clone ", $self->{full_name}, "\n"; |
|---|
| 129 | Git::Repository->run(clone => '--mirror' => $self->{clone_url} => $dir); |
|---|
| 130 | return $self; |
|---|
| 131 | } |
|---|
| 132 | |
|---|
| 133 | sub set_forks { |
|---|
| 134 | my $self = shift; |
|---|
| 135 | } |
|---|
| 136 | |
|---|
| 137 | sub clone_wiki { |
|---|
| 138 | my $self = shift; |
|---|
| 139 | } |
|---|
| 140 | |
|---|
| 141 | sub save_issues { |
|---|
| 142 | my $self = shift; |
|---|
| 143 | } |
|---|
| [6a2e5f1] | 144 | |
|---|
| 145 | |
|---|
| 146 | |
|---|
| 147 | 1; |
|---|
| 148 | __END__ |
|---|