File Coverage

blib/lib/VCS/Lite/Common.pm
Criterion Covered Total %
statement 34 40 85.0
branch 13 22 59.0
condition 4 11 36.3
subroutine 12 13 92.3
pod 9 9 100.0
total 72 95 75.7


line stmt bran cond sub pod time code
1             package VCS::Lite::Common;
2              
3 11     11   74 use strict;
  11         22  
  11         559  
4 11     11   65 use warnings;
  11         24  
  11         1125  
5              
6             our $VERSION = '0.11';
7              
8             #----------------------------------------------------------------------------
9              
10             our $username = $ENV{VCSLITE_USER} || $ENV{USER};
11             our $default_store = 'Storable';
12              
13 11     11   69 use File::Spec::Functions qw(splitpath splitdir);
  11         30  
  11         8096  
14              
15             #----------------------------------------------------------------------------
16              
17             sub path {
18 586     586 1 1067 my $self = shift;
19              
20 586 100       2750 return $self->{path} unless @_;
21              
22 189         258 my $newpath = shift;
23              
24 189 50       1050 if ($self->{path} ne $newpath) {
25 0         0 $self->{path} = $newpath;
26 0         0 $self->save;
27             }
28             }
29              
30             sub name {
31 22     22 1 69 my $self = shift;
32 22         52 my ($vol, $dir, $fil) = splitpath($self->path);
33              
34 22 50       339 $fil || (splitdir $dir)[-1];
35             }
36              
37             sub store {
38 134     134 1 193 my $self = shift;
39              
40 134         1150 $self->{store};
41             }
42              
43             sub save {
44 124     124 1 212 my ($self) = @_;
45              
46 124         340 $self->store->save($self);
47             }
48              
49             sub _mumble {
50 115     115   435 my ($self,$msg) = @_;
51              
52 115 50 66     2416 print $msg,"\n" if exists($self->{verbose}) && $self->{verbose};
53             }
54              
55             sub latest {
56 174     174 1 5833 my ($self,$base) = @_;
57              
58 174 50 33     543 $base .= '.' if $base && $base =~ /\d$/;
59 174   50     650 $base ||= '';
60 174 100       933 return 0 if !exists($self->{latest});
61 53 50       364 $self->{latest}{$base} || 0;
62             }
63              
64             sub up_generation {
65 0     0 1 0 my ($self,$gen) = @_;
66              
67 0 0 0     0 $gen =~ s/\.0$// or $gen =~ s/([1-9]\d*)$/$1-1/e or return;
  0         0  
68 0         0 $gen;
69             }
70              
71             sub user {
72 162     162 1 412 my $obj = shift;
73 162 100       1054 @_ ? ($username = shift) : $username;
74             }
75              
76             sub default_store {
77 218     218 1 359 my $obj = shift;
78 218 50       6501 @_ ? ($default_store = shift) : $default_store;
79             }
80              
81             sub parent {
82 2     2 1 1126 my $self = shift;
83              
84 2 50       11 return unless exists $self->{parent};
85              
86 2         16 $self->{parent_store}->retrieve($self->{parent});
87             }
88              
89             1;
90              
91             __END__