File Coverage

blib/lib/Github/Backup.pm
Criterion Covered Total %
statement 62 117 52.9
branch 17 62 27.4
condition 10 15 66.6
subroutine 15 20 75.0
pod 4 5 80.0
total 108 219 49.3


line stmt bran cond sub pod time code
1             package Github::Backup;
2              
3 6     6   77612 use strict;
  6         43  
  6         180  
4 6     6   30 use warnings;
  6         12  
  6         166  
5              
6 6     6   30 use Carp qw(croak);
  6         22  
  6         464  
7 6     6   3993 use Data::Dumper;
  6         46092  
  6         568  
8 6     6   3194 use Git::Repository;
  6         309958  
  6         29  
9 6     6   3440 use Hook::Output::Tiny;
  6         7079  
  6         208  
10 6     6   3202 use File::Copy;
  6         28843  
  6         480  
11 6     6   54 use File::Path;
  6         14  
  6         430  
12 6     6   4220 use JSON;
  6         65420  
  6         54  
13 6     6   5687 use LWP::UserAgent;
  6         263153  
  6         275  
14 6     6   5076 use Moo;
  6         54901  
  6         35  
15 6     6   13343 use Pithub;
  6         836327  
  6         278  
16              
17 6     6   58 use namespace::clean;
  6         77  
  6         73  
18              
19             our $VERSION = '1.04';
20              
21             # external
22              
23             has api_user => (
24             is => 'rw',
25             );
26             has _clean => (
27             # used to clean up test backup directories
28             is => 'rw',
29             );
30             has dir => (
31             is => 'rw',
32             );
33             has forks => (
34             is => 'rw',
35             );
36             has token => (
37             is => 'rw',
38             );
39             has proxy => (
40             is => 'rw',
41             );
42             has user => (
43             is => 'rw',
44             );
45             has limit => (
46             is => 'rw',
47             );
48              
49             # internal
50              
51             has gh => (
52             # Pithub object
53             is => 'rw',
54             );
55             has stg => (
56             # staging dir
57             is => 'rw',
58             );
59              
60             sub BUILD {
61 6     6 0 12453 my ($self) = @_;
62              
63 6 100       37 if (! $self->token){
64 2 50       7 $self->token($ENV{GITHUB_TOKEN}) if $ENV{GITHUB_TOKEN};
65             }
66              
67 6         18 for my $key (qw/api_user token dir/){
68 13 100       38 if (! $self->{$key}){
69 4         600 croak "ERROR: Missing mandatory parameter [$key].\n";
70             }
71             }
72              
73 2         35 my $ua = LWP::UserAgent->new;
74              
75 2 100       6600 if ($self->proxy){
76 1         12 $ENV{http_proxy} = $self->proxy;
77 1         7 $ENV{https_proxy} = $self->proxy;
78              
79 1         6 $ua->env_proxy;
80             }
81              
82 2         52866 my $gh = Pithub->new(
83             ua => $ua,
84             user => $self->api_user,
85             token => $self->token,
86             auto_pagination => 1,
87             );
88              
89 2         26029 $self->stg($self->dir . '.stg');
90 2         11 $self->gh($gh);
91              
92 2 50       20 $self->user($self->api_user) if ! defined $self->user;
93              
94 2 50       117 if (-d $self->stg){
95 0 0       0 rmtree $self->stg or die "can't remove the old staging directory...$!";
96             }
97              
98 2 50       273 mkdir $self->stg or die "can't create the backup staging directory...$!\n";
99             }
100              
101             sub list {
102 0     0 1 0 my ($self) = @_;
103              
104 0 0       0 if (! $self->{repo_list}) {
105 0         0 my $repo_list = $self->gh->repos->list(user => $self->user);
106 0         0 while (my $repo = $repo_list->next) {
107 0         0 push @{ $self->{repo_list} }, $repo;
  0         0  
108             }
109             }
110              
111 0         0 return $self->{repo_list};
112             }
113             sub repos {
114 0     0 1 0 my ($self) = @_;
115              
116 0         0 my $repos = $self->list;
117              
118 0         0 my $repo_count = 0;
119 0         0 for my $repo (@$repos){
120 0         0 $repo_count++;
121              
122 0 0       0 if ($self->limit) {
123 0 0       0 last if $repo_count >= $self->limit;
124             }
125              
126 0         0 $self->_trap->hook('stderr');
127              
128 0         0 print "Cloning $repo->{name}\n";
129              
130 0         0 my $stg = $self->stg . "/$repo->{name}";
131              
132 0 0       0 if (! $self->forks){
133 0 0       0 if (! exists $repo->{parent}){
134             Git::Repository->run(
135 0         0 clone => $repo->{clone_url} => $stg,
136             { quiet => 0 }
137             );
138             }
139             }
140             else {
141             Git::Repository->run(
142 0         0 clone => $repo->{clone_url} => $stg,
143             { quiet => 0 }
144             );
145             }
146 0         0 $self->_trap->unhook('stderr');
147             }
148             }
149             sub issues {
150 0     0 1 0 my ($self) = @_;
151              
152 0 0       0 mkdir $self->stg . "/issues" or die "can't create the 'issues' dir: $!";
153              
154 0         0 my $repos = $self->list;
155              
156 0         0 my $repo_count = 0;
157              
158 0         0 for my $repo (@$repos) {
159 0         0 $repo_count++;
160              
161 0 0       0 if ($self->limit) {
162 0 0       0 last if $repo_count >= $self->limit;
163             }
164              
165             my $closed_issue_list = $self->gh->issues->list(
166             user => $self->user,
167             repo => $repo->{name},
168 0         0 params => {
169             state => 'closed'
170             }
171             );
172              
173             my $open_issue_list = $self->gh->issues->list(
174             user => $self->user,
175             repo => $repo->{name},
176 0         0 params => {
177             state => 'open'
178             }
179             );
180              
181 0         0 my $open_issues = $open_issue_list->content;
182 0         0 my $closed_issues = $closed_issue_list->content;
183              
184 0         0 my $issue_dir = $self->stg . "/issues/$repo->{name}";
185              
186 0         0 my $dir_created = 0;
187              
188 0         0 for my $issue (@$open_issues, @$closed_issues) {
189 0 0       0 if (! $dir_created) {
190 0 0       0 mkdir $issue_dir or die $!;
191 0 0       0 mkdir "$issue_dir/open" or die $!;
192 0 0       0 mkdir "$issue_dir/closed" or die $!;
193 0         0 $dir_created = 1;
194             }
195              
196 0 0       0 my $issue_path = $issue->{state} eq 'open'
197             ? "$issue_dir/open/$issue->{id}"
198             : "$issue_dir/closed/$issue->{id}";
199              
200 0 0       0 open my $fh, '>', $issue_path or die "can't create the issue file";
201              
202 0         0 print "Copied $repo->{name} issue #$issue->{number} to $issue_path\n";
203              
204 0         0 print $fh encode_json $issue;
205             }
206             }
207             }
208             sub finish {
209 0     0 1 0 my ($self) = @_;
210 0 0 0     0 if ($self->stg && -d $self->stg) {
211 0 0       0 move $self->stg,
212             $self->dir or die "can't rename the staging directory: $!";
213             }
214             }
215             sub _trap {
216 0     0   0 my ($self) = @_;
217 0 0       0 if (! $self->{trap}) {
218 0         0 $self->{trap} = Hook::Output::Tiny->new;
219             }
220              
221 0         0 return $self->{trap};
222             }
223             sub DESTROY {
224 6     6   4163 my $self = shift;
225              
226 6 50 66     139 if ($self->dir && -d $self->dir) {
227 0 0       0 rmtree $self->dir or die "can't remove the old backup directory: $!";
228             }
229              
230 6 100 66     81 if ($self->stg && -d $self->stg) {
231 2 50       26 move $self->stg,
232             $self->dir or die "can't rename the staging directory: $!";
233             }
234              
235 6 100 100     392 if ($self->dir && -d $self->dir && $self->_clean) {
      100        
236             # we're in testing mode, clean everything up
237 1 50       643 rmtree $self->dir
238             or die "can't remove the test backup directory...$!";
239             }
240             }
241              
242             1;
243             __END__