[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__ |
---|