File Coverage

blib/lib/Shipwright/Source/SVK.pm
Criterion Covered Total %
statement 22 46 47.8
branch 1 12 8.3
condition n/a
subroutine 7 9 77.7
pod 2 2 100.0
total 32 69 46.3


line stmt bran cond sub pod time code
1             package Shipwright::Source::SVK;
2              
3 2     2   713 use warnings;
  2         4  
  2         56  
4 2     2   8 use strict;
  2         4  
  2         34  
5 2     2   8 use Shipwright::Util;
  2         4  
  2         170  
6 2     2   10 use File::Spec::Functions qw/catdir/;
  2         4  
  2         73  
7 2     2   10 use File::Path qw/remove_tree/;
  2         3  
  2         74  
8              
9 2     2   9 use base qw/Shipwright::Source::Base/;
  2         5  
  2         808  
10              
11             =head2 new
12              
13             =cut
14              
15             sub new {
16 1     1 1 2 my $class = shift;
17 1         6 my $self = $class->SUPER::new(@_);
18              
19 1 50       13 $self->name( $self->just_name( $self->source ) ) unless $self->name;
20 1         5 return $self;
21             }
22              
23             =head2 run
24              
25             =cut
26              
27             sub run {
28 0     0 1   my $self = shift;
29 0           $self->log->info( "preparing to run source: " . $self->source );
30              
31 0           $self->_update_url( $self->name, 'svk:' . $self->source );
32              
33 0           $self->_run;
34 0           my $s;
35 0 0         if ( $self->is_compressed ) {
36 0           require Shipwright::Source::Compressed;
37 0           $s = Shipwright::Source::Compressed->new( %$self, _no_update_url => 1 );
38             }
39             else {
40 0           require Shipwright::Source::Directory;
41 0           $s = Shipwright::Source::Directory->new( %$self, _no_update_url => 1 );
42             }
43 0           $s->run(@_);
44             }
45              
46             =head2 _run
47              
48             =cut
49              
50             sub _run {
51 0     0     my $self = shift;
52 0           my $source = $self->source;
53              
54 0           my @cmds;
55 0           my $path = catdir( $self->download_directory, $self->name );
56             push @cmds,
57             [
58 0 0         $ENV{'SHIPWRIGHT_SVK'}, 'co',
59             $self->source, $path,
60             $self->version ? ( '-r', $self->version ) : ()
61             ];
62 0           push @cmds, [ $ENV{'SHIPWRIGHT_SVK'}, 'co', '-d', $path, ];
63              
64 0 0         unless ( $self->version ) {
65             my ($out) = run_cmd(
66 0           [ $ENV{'SHIPWRIGHT_SVK'}, 'info', $self->source, ] );
67              
68 0 0         if ( $out =~ /^Revision: (\d+)/m ) {
69 0           $self->version($1);
70             }
71             }
72              
73 0 0         remove_tree($path) if -e $path;
74              
75 0           $self->source( $path );
76 0           run_cmd($_) for @cmds;
77             }
78              
79             1;
80              
81             __END__