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   59 use strict;
  11         16  
  11         370  
4 11     11   41 use warnings;
  11         17  
  11         856  
5              
6             our $VERSION = '0.12';
7              
8             #----------------------------------------------------------------------------
9              
10             our $username = $ENV{VCSLITE_USER} || $ENV{USER};
11             our $default_store = 'Storable';
12              
13 11     11   57 use File::Spec::Functions qw(splitpath splitdir);
  11         17  
  11         5586  
14              
15             #----------------------------------------------------------------------------
16              
17             sub path {
18 586     586 1 633 my $self = shift;
19              
20 586 100       2099 return $self->{path} unless @_;
21              
22 189         211 my $newpath = shift;
23              
24 189 50       590 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 48 my $self = shift;
32 22         30 my ($vol, $dir, $fil) = splitpath($self->path);
33              
34 22 50       267 $fil || (splitdir $dir)[-1];
35             }
36              
37             sub store {
38 134     134 1 171 my $self = shift;
39              
40 134         765 $self->{store};
41             }
42              
43             sub save {
44 124     124 1 163 my ($self) = @_;
45              
46 124         279 $self->store->save($self);
47             }
48              
49             sub _mumble {
50 115     115   165 my ($self,$msg) = @_;
51              
52 115 50 66     568 print $msg,"\n" if exists($self->{verbose}) && $self->{verbose};
53             }
54              
55             sub latest {
56 174     174 1 2506 my ($self,$base) = @_;
57              
58 174 50 33     392 $base .= '.' if $base && $base =~ /\d$/;
59 174   50     557 $base ||= '';
60 174 100       702 return 0 if !exists($self->{latest});
61 53 50       276 $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 289 my $obj = shift;
73 162 100       669 @_ ? ($username = shift) : $username;
74             }
75              
76             sub default_store {
77 218     218 1 265 my $obj = shift;
78 218 50       4323 @_ ? ($default_store = shift) : $default_store;
79             }
80              
81             sub parent {
82 2     2 1 935 my $self = shift;
83              
84 2 50       10 return unless exists $self->{parent};
85              
86 2         14 $self->{parent_store}->retrieve($self->{parent});
87             }
88              
89             1;
90              
91             __END__