File Coverage

blib/lib/VCS/Lite/Shell.pm
Criterion Covered Total %
statement 46 61 75.4
branch 11 24 45.8
condition 2 8 25.0
subroutine 13 19 68.4
pod 12 12 100.0
total 84 124 67.7


line stmt bran cond sub pod time code
1             package VCS::Lite::Shell;
2              
3 4     4   24503 use strict;
  4         6  
  4         131  
4 4     4   15 use warnings;
  4         5  
  4         159  
5              
6             our $VERSION = '0.12';
7              
8             #----------------------------------------------------------------------------
9              
10 4     4   15 use vars qw (@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  4         4  
  4         236  
11              
12 4     4   18 use Exporter ();
  4         7  
  4         229  
13             @ISA = qw (Exporter);
14             #Give a hoot don't pollute, do not export more than needed by default
15             @EXPORT = qw ();
16             @EXPORT_OK = qw (store add remove list check_in check_out commit update fetch diff);
17             %EXPORT_TAGS = (
18             local => [qw/store add remove check_in fetch diff/],
19             all => [qw/store add remove list check_in fetch diff check_out commit update/]
20             );
21              
22 4     4   504 use Params::Validate qw(:all);
  4         6591  
  4         829  
23 4     4   399 use VCS::Lite::Repository;
  4         7  
  4         100  
24 4     4   16 use Cwd;
  4         5  
  4         3516  
25              
26             our %store_list;
27              
28             #----------------------------------------------------------------------------
29              
30             sub store {
31 1     1 1 1 my ($which, $type, @att) = @_;
32              
33 1   50     3 $which ||= 'current';
34 1 50       6 $type = 'VCS::Lite::Store::'.$type unless $type =~ /\:\:/;
35 1 50       8 if ($type =~ /^\w+(:?\:\:\w+)*$/) {
36 1         45 eval "require $type";
37 1 50       3 carp $@ if $@;
38             }
39              
40 1 50       4 $store_list{$which} = @att ? $type->new(@att) : $type;
41             }
42              
43             sub repository {
44 1     1 1 29 my ($store,$dir) = validate_pos( @_,
45             { type => SCALAR | OBJECT},
46             { type => SCALAR, default => '.'} );
47              
48 1 50       21 store($store, VCS::Lite::Repository->default_store)
49             unless exists $store_list{$store};
50 1         7 VCS::Lite::Repository->new( $dir, store=>$store_list{$store} );
51             }
52              
53             sub member {
54 5     5 1 60 my ($st,$mem) = validate_pos( @_,
55             { type => SCALAR | OBJECT},
56             { type => SCALAR, default => '.'} );
57              
58 5 50       25 store($st, VCS::Lite::Repository->default_store)
59             unless exists $store_list{$st};
60 5         25 $store_list{$st}->retrieve($mem);
61             }
62              
63             sub add {
64 1     1 1 322 my $ele = shift;
65              
66 1         3 repository('current')->add($ele);
67             }
68              
69             sub remove {
70 0     0 1 0 my $ele = shift;
71              
72 0         0 repository('current')->remove($ele);
73             }
74              
75             sub list {
76 0     0 1 0 my %par = validate(@_, {
77             recurse => 0} );
78              
79 0         0 repository('current')->traverse( 'name', %par);
80             }
81              
82             sub fetch {
83 0     0 1 0 my ($ele, $gen) = validate_pos( @_, {type => SCALAR}, 0);
84              
85 0         0 my $mem = member('current',$ele);
86 0         0 my %par = ();
87 0 0 0     0 $par{generation} = $gen if defined $gen && $gen ne 'latest';
88 0         0 $mem->fetch(%par)->text;
89             }
90              
91             sub diff {
92 3     3 1 188 my %par = validate( @_,
93             {
94             file1 => { type => SCALAR },
95             gen1 => {
96             type => SCALAR,
97             optional => 1,
98             regex => qr/^\d+$/
99             },
100             file2 => {
101             type => SCALAR,
102             optional => 1,
103             },
104             gen2 => {
105             type => SCALAR,
106             optional => 1,
107             regex => qr/^\d+$|^latest$/
108             },
109             } );
110              
111 3 100       35 my $lite1 = member('current',$par{file1})
112             ->fetch(exists($par{gen1}) ? (generation => $par{gen1}) : ());
113 3         93 my $lite2;
114 3   33     10 $par{file2} ||= $par{file1};
115 3 50       5 if (exists $par{gen2}) {
116 0 0       0 $lite2 = member('current',$par{file2})
117             ->fetch(($par{gen1} eq 'latest') ? () : (generation => $par{gen2}));
118             } else {
119 3         9 $lite2 = VCS::Lite->new($par{file2});
120             }
121              
122 3 100       187 my $d = $lite1->delta($lite2) or return '';
123 2         614 $d->udiff;
124             }
125              
126             sub check_out {
127 0     0 1 0 my $parent_path = shift;
128              
129 0 0       0 store('current', VCS::Lite::Repository->default_store)
130             unless exists $store_list{current};
131              
132 0         0 repository('parent',$parent_path)
133             ->check_out( cwd(), store => $store_list{current} );
134             }
135              
136             sub check_in {
137 2     2 1 1141 my ($what,$descr) = @_;
138              
139 2         8 member('current',$what)->check_in( description => $descr);
140             }
141              
142             sub commit {
143 0     0 1   repository('current')->commit();
144             }
145              
146             sub update {
147 0     0 1   repository('current')->update();
148             }
149              
150             1; #this line is important and will help the module return a true value
151              
152             __END__