File Coverage

blib/lib/Metabrik/Devel/Mercurial.pm
Criterion Covered Total %
statement 9 111 8.1
branch 0 68 0.0
condition 0 20 0.0
subroutine 3 14 21.4
pod 1 11 9.0
total 13 224 5.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # devel::mercurial Brik
5             #
6             package Metabrik::Devel::Mercurial;
7 1     1   1019 use strict;
  1         3  
  1         29  
8 1     1   6 use warnings;
  1         1  
  1         31  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         14  
  1         1366  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable hg) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             capture_mode => [ qw(0|1) ],
20             use_sudo => [ qw(0|1) ],
21             use_pager => [ qw(0|1) ],
22             },
23             attributes_default => {
24             capture_mode => 0,
25             use_sudo => 0,
26             use_pager => 1,
27             },
28             commands => {
29             install => [ ], # Inherited
30             clone => [ qw(repository directory|OPTIONAL) ],
31             push => [ qw(directory|OPTIONAL) ],
32             incoming => [ qw(directory|OPTIONAL) ],
33             pull => [ qw(directory|OPTIONAL) ],
34             update => [ qw(directory|OPTIONAL) ],
35             diff => [ qw(directory|file|OPTIONAL) ],
36             add => [ qw(directory|file) ],
37             commit => [ qw(directory|file|OPTIONAL) ],
38             stat => [ qw(directory|OPTIONAL) ],
39             modified => [ qw(directory|OPTIONAL) ],
40             },
41             require_binaries => {
42             hg => [ ],
43             },
44             need_packages => {
45             ubuntu => [ qw(mercurial) ],
46             debian => [ qw(mercurial) ],
47             kali => [ qw(mercurial) ],
48             },
49             };
50             }
51              
52             sub clone {
53 0     0 0   my $self = shift;
54 0           my ($repository, $directory) = @_;
55              
56 0   0       $directory ||= '';
57 0 0         $self->brik_help_run_undef_arg('clone', $repository) or return;
58              
59 0           my $cmd = "hg clone $repository $directory";
60              
61 0 0         $self->execute($cmd) or return;
62              
63 0           return $directory;
64             }
65              
66             sub push {
67 0     0 0   my $self = shift;
68 0           my ($directory) = @_;
69              
70 0   0       my $cwd = defined($self->shell) && $self->shell->pwd || '/tmp';
71              
72 0   0       $directory ||= '';
73 0 0         if (length($directory)) {
74 0 0         $self->brik_help_run_directory_not_found('push', $directory) or return;
75 0 0         if (defined($self->shell)) {
76 0 0         $self->shell->run_cd($directory) or return;
77             }
78             else {
79 0 0         chdir($directory) or return $self->log->error("push: chdir: $!");
80             }
81             }
82              
83 0           my $prev = $self->use_pager;
84              
85 0           $self->use_pager(0);
86 0           my $cmd = "hg push";
87 0           my $r = $self->execute($cmd);
88              
89 0           $self->use_pager($prev);
90              
91 0 0         if (length($directory)) {
92 0 0         if (defined($self->shell)) {
93 0 0         $self->shell->run_cd($cwd) or return;
94             }
95             else {
96 0 0         chdir($cwd) or return $self->log->error("push: chdir: $!");
97             }
98             }
99              
100 0           return $r;
101             }
102              
103             sub incoming {
104 0     0 0   my $self = shift;
105 0           my ($directory) = @_;
106              
107 0   0       my $cwd = defined($self->shell) && $self->shell->pwd || '/tmp';
108              
109 0   0       $directory ||= '';
110 0 0         if (length($directory)) {
111 0 0         $self->brik_help_run_directory_not_found('incoming', $directory) or return;
112 0 0         if (defined($self->shell)) {
113 0 0         $self->shell->run_cd($directory) or return;
114             }
115             else {
116 0 0         chdir($directory) or return $self->log->error("incoming: chdir: $!");
117             }
118             }
119              
120 0           my $cmd = "hg incoming";
121 0           my $r = $self->execute($cmd);
122              
123 0 0         if (length($directory)) {
124 0 0         if (defined($self->shell)) {
125 0 0         $self->shell->run_cd($cwd) or return;
126             }
127             else {
128 0 0         chdir($cwd) or return $self->log->error("incoming: chdir: $!");
129             }
130             }
131              
132 0           return $r;
133             }
134              
135             sub pull {
136 0     0 0   my $self = shift;
137 0           my ($directory) = @_;
138              
139 0           my $she = $self->shell;
140 0           my $cwd = $she->pwd;
141              
142 0   0       $directory ||= '';
143 0 0         if (length($directory)) {
144 0 0         $self->brik_help_run_directory_not_found('pull', $directory) or return;
145 0 0         $she->run_cd($directory) or return;
146             }
147              
148 0           my $cmd = "hg pull -u";
149 0           my $r = $self->execute($cmd);
150              
151 0 0         if (length($directory)) {
152 0 0         $she->run_cd($cwd) or return;
153             }
154              
155 0           return $r;
156             }
157              
158             # alias to pull
159             sub update {
160 0     0 0   my $self = shift;
161              
162 0           return $self->pull(@_);
163             }
164              
165             sub diff {
166 0     0 0   my $self = shift;
167 0           my ($data) = @_;
168              
169 0   0       $data ||= '.';
170 0 0         my $ref = $self->brik_help_run_invalid_arg('diff', $data, 'ARRAY', 'SCALAR') or return;
171 0 0         if ($ref eq 'ARRAY') {
172 0           $data = join(' ', @$data);
173             }
174              
175 0           my $cmd = "hg diff $data";
176              
177 0           return $self->execute($cmd);
178             }
179              
180             sub add {
181 0     0 0   my $self = shift;
182 0           my ($data) = @_;
183              
184 0 0         $self->brik_help_run_undef_arg('add', $data) or return;
185 0 0         my $ref = $self->brik_help_run_invalid_arg('add', $data, 'ARRAY', 'SCALAR')
186             or return;
187              
188 0 0         if ($ref eq 'ARRAY') {
189 0           $data = join(' ', @$data);
190             }
191              
192 0           my $prev = $self->use_pager;
193              
194 0           $self->use_pager(0);
195 0           my $cmd = "hg add $data";
196 0           my $r = $self->execute($cmd);
197              
198 0           $self->use_pager($prev);
199              
200 0           return $r;
201             }
202              
203             sub commit {
204 0     0 0   my $self = shift;
205 0           my ($data) = @_;
206              
207 0   0       $data ||= '.';
208 0 0         my $ref = $self->brik_help_run_invalid_arg('commit', $data, 'ARRAY', 'SCALAR')
209             or return;
210              
211 0 0         if ($ref eq 'ARRAY') {
212 0           $data = join(' ', @$data);
213             }
214              
215 0           my $prev = $self->use_pager;
216              
217 0           $self->use_pager(0);
218 0           my $cmd = "hg commit $data";
219 0           my $r = $self->execute($cmd);
220              
221 0           $self->use_pager($prev);
222              
223 0           return $r;
224             }
225              
226             sub stat {
227 0     0 0   my $self = shift;
228 0           my ($directory) = @_;
229              
230 0   0       $directory ||= '.';
231 0 0         $self->brik_help_run_directory_not_found('stat', $directory) or return;
232              
233 0           my $cmd = "hg stat $directory";
234              
235 0           return $self->execute($cmd);
236             }
237              
238             sub modified {
239 0     0 0   my $self = shift;
240 0           my ($directory) = @_;
241              
242 0   0       $directory ||= '.';
243 0 0         $self->brik_help_run_directory_not_found('modified', $directory) or return;
244              
245 0           my $cmd = "hg stat -m $directory";
246              
247 0           return $self->execute($cmd);
248             }
249              
250             1;
251              
252             __END__