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__ |