line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package VCS::Lite::Element; |
2
|
|
|
|
|
|
|
|
3
|
11
|
|
|
11
|
|
51
|
use strict; |
|
11
|
|
|
|
|
15
|
|
|
11
|
|
|
|
|
374
|
|
4
|
11
|
|
|
11
|
|
45
|
use warnings; |
|
11
|
|
|
|
|
17
|
|
|
11
|
|
|
|
|
576
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.12'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
9
|
|
|
|
|
|
|
|
10
|
11
|
|
|
11
|
|
90
|
use File::Spec::Functions qw(splitpath catfile catdir catpath rel2abs); |
|
11
|
|
|
|
|
13
|
|
|
11
|
|
|
|
|
885
|
|
11
|
11
|
|
|
11
|
|
561
|
use Time::Piece; |
|
11
|
|
|
|
|
8634
|
|
|
11
|
|
|
|
|
62
|
|
12
|
11
|
|
|
11
|
|
614
|
use Carp; |
|
11
|
|
|
|
|
15
|
|
|
11
|
|
|
|
|
574
|
|
13
|
11
|
|
|
11
|
|
5544
|
use VCS::Lite; |
|
11
|
|
|
|
|
113522
|
|
|
11
|
|
|
|
|
364
|
|
14
|
11
|
|
|
11
|
|
5957
|
use Params::Validate qw(:all); |
|
11
|
|
|
|
|
78048
|
|
|
11
|
|
|
|
|
2310
|
|
15
|
11
|
|
|
11
|
|
85
|
use Cwd qw(abs_path); |
|
11
|
|
|
|
|
23
|
|
|
11
|
|
|
|
|
575
|
|
16
|
|
|
|
|
|
|
|
17
|
11
|
|
|
11
|
|
61
|
use base qw(VCS::Lite::Common); |
|
11
|
|
|
|
|
15
|
|
|
11
|
|
|
|
|
4982
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
120
|
|
|
120
|
1
|
1726
|
my $pkg = shift; |
23
|
120
|
|
|
|
|
146
|
my $file = shift; |
24
|
120
|
|
|
|
|
520
|
my %args = validate ( @_, |
25
|
|
|
|
|
|
|
{ |
26
|
|
|
|
|
|
|
store => { |
27
|
|
|
|
|
|
|
type => SCALAR | OBJECT, |
28
|
|
|
|
|
|
|
default => $pkg->default_store, |
29
|
|
|
|
|
|
|
}, |
30
|
|
|
|
|
|
|
verbose => 0, |
31
|
|
|
|
|
|
|
recordsize => 0, #ignored unless VCS::Lite::Element::Binary |
32
|
|
|
|
|
|
|
} ); |
33
|
120
|
|
|
|
|
511
|
my $lite = $file; |
34
|
120
|
|
|
|
|
176
|
my $verbose = $args{verbose}; |
35
|
|
|
|
|
|
|
|
36
|
120
|
|
|
|
|
323
|
$file = rel2abs($file); |
37
|
120
|
|
|
|
|
1823
|
my $store_pkg; |
38
|
120
|
50
|
|
|
|
268
|
if (ref $args{store}) { |
39
|
0
|
|
|
|
|
0
|
$store_pkg = $args{store}; |
40
|
|
|
|
|
|
|
} else { |
41
|
120
|
100
|
|
|
|
392
|
$store_pkg = ($args{store} =~ /\:\:/) ? $args{store} : "VCS::Lite::Store::$args{store}"; |
42
|
120
|
|
|
|
|
7196
|
eval "require $store_pkg"; |
43
|
120
|
50
|
|
|
|
456
|
warn "Failed to require $store_pkg\n$@" if $@; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
120
|
|
|
|
|
624
|
my $ele = $store_pkg->retrieve($file); |
47
|
120
|
100
|
|
|
|
281
|
if ($ele) { |
48
|
94
|
|
|
|
|
311
|
$ele->path($file); |
49
|
94
|
|
|
|
|
499
|
return $ele; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
26
|
|
|
|
|
159
|
my $proto = bless { |
53
|
|
|
|
|
|
|
%args, |
54
|
|
|
|
|
|
|
path => $file, |
55
|
|
|
|
|
|
|
}, $pkg; |
56
|
|
|
|
|
|
|
|
57
|
26
|
|
|
|
|
98
|
$ele = $store_pkg->retrieve_or_create($proto); |
58
|
|
|
|
|
|
|
|
59
|
26
|
|
|
|
|
79
|
$ele->{path} = $file; |
60
|
|
|
|
|
|
|
|
61
|
26
|
50
|
|
|
|
77
|
if (!ref $lite) { |
62
|
26
|
100
|
|
|
|
592
|
unless (-f $file) { |
63
|
5
|
50
|
|
|
|
253
|
open FIL, '>', $file or croak("Failed to create $file, $!"); |
64
|
5
|
|
|
|
|
32
|
close FIL; |
65
|
|
|
|
|
|
|
} |
66
|
26
|
|
|
|
|
105
|
$lite = $ele->_slurp_lite($file); |
67
|
|
|
|
|
|
|
} else { |
68
|
0
|
|
|
|
|
0
|
$file = $lite->id; # Not handled at present |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
26
|
|
|
|
|
2897
|
$ele->_assimilate($lite); |
72
|
26
|
|
|
|
|
68
|
$ele->save; |
73
|
|
|
|
|
|
|
|
74
|
26
|
|
|
|
|
4835
|
$ele->{verbose} = $verbose; |
75
|
26
|
|
|
|
|
402
|
$ele; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub check_in { |
79
|
27
|
|
|
27
|
1
|
412
|
my $self = shift; |
80
|
27
|
|
|
|
|
482
|
my %args = validate ( @_, |
81
|
|
|
|
|
|
|
{ |
82
|
|
|
|
|
|
|
check_in_anyway => 0, |
83
|
|
|
|
|
|
|
description => { type => SCALAR }, |
84
|
|
|
|
|
|
|
} ); |
85
|
27
|
|
|
|
|
112
|
my $file = $self->{path}; |
86
|
|
|
|
|
|
|
|
87
|
27
|
|
|
|
|
71
|
my $lite = $self->_slurp_lite($file); |
88
|
|
|
|
|
|
|
|
89
|
27
|
|
|
|
|
2728
|
my $newgen = $self->_assimilate($lite); |
90
|
27
|
50
|
66
|
|
|
210
|
return if !$newgen && !$args{check_in_anyway}; |
91
|
|
|
|
|
|
|
|
92
|
14
|
|
|
|
|
66
|
$self->_mumble("Check in $file"); |
93
|
14
|
|
100
|
|
|
61
|
$self->{generation} ||= {}; |
94
|
14
|
|
|
|
|
17
|
my %gen = %{$self->{generation}}; |
|
14
|
|
|
|
|
43
|
|
95
|
14
|
|
|
|
|
61
|
$gen{$newgen} = { |
96
|
|
|
|
|
|
|
author => $self->user, |
97
|
|
|
|
|
|
|
description => $args{description}, |
98
|
|
|
|
|
|
|
updated => localtime->datetime, |
99
|
|
|
|
|
|
|
}; |
100
|
|
|
|
|
|
|
|
101
|
14
|
|
100
|
|
|
1301
|
$self->{latest} ||= {}; |
102
|
14
|
|
|
|
|
16
|
my %lat = %{$self->{latest}}; |
|
14
|
|
|
|
|
41
|
|
103
|
14
|
|
|
|
|
85
|
$newgen =~ /(\d+\.)*\d+$/; |
104
|
14
|
|
50
|
|
|
79
|
my $base = $1 || ''; |
105
|
14
|
|
|
|
|
27
|
$lat{$base}=$newgen; |
106
|
|
|
|
|
|
|
|
107
|
14
|
|
|
|
|
55
|
$self->_update_ctrl( generation => \%gen, latest => \%lat); |
108
|
14
|
|
|
|
|
2767
|
$newgen; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub repository { |
112
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
0
|
my ($vol,$dir,$fil) = splitpath($self->{path}); |
115
|
0
|
0
|
|
|
|
0
|
my $repos_path = $vol ? catdir($vol,$dir) : $dir; |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
0
|
VCS::Lite::Repository->new($repos_path, verbose => $self->{verbose}); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub traverse { |
121
|
16
|
|
|
16
|
1
|
25
|
undef; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub fetch { |
125
|
58
|
|
|
58
|
1
|
2703
|
my $self = shift; |
126
|
58
|
|
|
|
|
768
|
my %args = validate ( @_, |
127
|
|
|
|
|
|
|
{ |
128
|
|
|
|
|
|
|
time => 0, |
129
|
|
|
|
|
|
|
generation => 0, |
130
|
|
|
|
|
|
|
} ); |
131
|
|
|
|
|
|
|
|
132
|
58
|
|
100
|
|
|
364
|
my $gen = $args{generation} || $self->latest; |
133
|
|
|
|
|
|
|
|
134
|
58
|
50
|
|
|
|
185
|
if ($args{time}) { |
135
|
0
|
|
|
|
|
0
|
my $latest_time = ''; |
136
|
0
|
|
0
|
|
|
0
|
my $branch = $args{generation} || ''; |
137
|
0
|
0
|
|
|
|
0
|
$branch .= '.' if $branch; |
138
|
0
|
|
|
|
|
0
|
for (keys %{$self->{generation}}) { |
|
0
|
|
|
|
|
0
|
|
139
|
0
|
0
|
|
|
|
0
|
next unless /^$branch\d+$/; |
140
|
0
|
0
|
|
|
|
0
|
next if $self->{generation}{$_}{updated} > $args{time}; |
141
|
0
|
0
|
|
|
|
0
|
($latest_time,$gen) = ($self->{generation}{$_}{updated}, $_) |
142
|
|
|
|
|
|
|
if $self->{generation}{$_}{updated} > $latest_time; |
143
|
|
|
|
|
|
|
} |
144
|
0
|
0
|
|
|
|
0
|
return unless $latest_time; |
145
|
|
|
|
|
|
|
} |
146
|
58
|
50
|
66
|
|
|
211
|
return if $self->{generation} && !$self->{generation}{$gen}; |
147
|
|
|
|
|
|
|
|
148
|
58
|
|
|
|
|
67
|
my $skip_to; |
149
|
|
|
|
|
|
|
my @out; |
150
|
58
|
|
|
|
|
63
|
for (@{$self->_contents}) { |
|
58
|
|
|
|
|
174
|
|
151
|
2853
|
100
|
|
|
|
3626
|
if ($skip_to) { |
152
|
121
|
100
|
|
|
|
434
|
if (/^=$skip_to$/) { |
153
|
25
|
|
|
|
|
33
|
undef $skip_to; |
154
|
|
|
|
|
|
|
} |
155
|
121
|
|
|
|
|
183
|
next; |
156
|
|
|
|
|
|
|
} |
157
|
2732
|
100
|
|
|
|
4890
|
if (my ($type,$gensel) = /^([+-])(.+)/) { |
158
|
60
|
100
|
|
|
|
100
|
if (_is_parent_of($gensel,$gen) ^ ($type eq '+')) { |
159
|
25
|
|
|
|
|
28
|
$skip_to = $gensel; |
160
|
|
|
|
|
|
|
} |
161
|
60
|
|
|
|
|
89
|
next; |
162
|
|
|
|
|
|
|
} |
163
|
2672
|
100
|
|
|
|
6372
|
next if /^=/; |
164
|
|
|
|
|
|
|
|
165
|
2637
|
50
|
|
|
|
5202
|
if (/^ /) { |
166
|
2637
|
|
|
|
|
4339
|
push @out,substr($_,1); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
58
|
|
|
|
|
143
|
my $file = $self->{path}; |
171
|
58
|
|
|
|
|
414
|
VCS::Lite->new("$file\@\@$gen",undef,\@out); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub commit { |
175
|
4
|
|
|
4
|
1
|
8
|
my ($self,$parent) = @_; |
176
|
|
|
|
|
|
|
|
177
|
4
|
|
|
|
|
11
|
my ($vol,$dir,$file) = splitpath($self->path); |
178
|
4
|
|
|
|
|
71
|
my $updfile = catfile($parent,$file); |
179
|
4
|
|
|
|
|
13
|
my $chg = $self->fetch; |
180
|
4
|
|
|
|
|
179
|
my $before = VCS::Lite->new($updfile); |
181
|
4
|
100
|
|
|
|
395
|
return unless $before->delta($chg); |
182
|
|
|
|
|
|
|
|
183
|
3
|
|
|
|
|
2967
|
$self->_mumble("Committing $file to $parent"); |
184
|
|
|
|
|
|
|
|
185
|
3
|
|
|
|
|
4
|
my $out; |
186
|
3
|
50
|
|
|
|
239
|
open $out,'>',$updfile or croak "Failed to open $file for committing, $!"; |
187
|
3
|
|
|
|
|
16
|
print $out $chg->text; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub update { |
191
|
9
|
|
|
9
|
1
|
17
|
my ($self,$parent) = @_; |
192
|
|
|
|
|
|
|
|
193
|
9
|
|
|
|
|
23
|
my $file = $self->path; |
194
|
9
|
|
|
|
|
44
|
$self->_mumble("Updating $file from $parent"); |
195
|
|
|
|
|
|
|
|
196
|
9
|
|
|
|
|
22
|
my ($vol,$dir,$fil) = splitpath($file); |
197
|
9
|
|
|
|
|
131
|
my $fromfile = catfile($parent,$fil); |
198
|
9
|
|
50
|
|
|
45
|
my $baseline = $self->{baseline} || 0; |
199
|
9
|
|
|
|
|
14
|
my $parbas = $self->{parent_baseline}; |
200
|
|
|
|
|
|
|
|
201
|
9
|
|
|
|
|
27
|
my $orig = $self->fetch( generation => $baseline); |
202
|
9
|
|
|
|
|
399
|
my $parele = VCS::Lite::Element->new($fromfile, verbose => $self->{verbose}); |
203
|
9
|
|
|
|
|
31
|
my $parfrom = $parele->fetch( generation => $parbas); |
204
|
9
|
|
|
|
|
370
|
my $parlat = $parele->latest($parbas); |
205
|
9
|
|
|
|
|
18
|
my $parto = $parele->fetch( generation => $parlat); |
206
|
9
|
|
|
|
|
379
|
my $origplus = $parfrom->merge($parto,$orig); |
207
|
|
|
|
|
|
|
|
208
|
9
|
|
|
|
|
12959
|
my $chg = VCS::Lite->new($file); |
209
|
9
|
|
|
|
|
997
|
my $merged = $orig->merge($origplus,$chg); |
210
|
9
|
|
|
|
|
12771
|
my $out; |
211
|
9
|
50
|
|
|
|
809
|
open $out,'>',$file or croak "Failed to write back merge of $fil, $!"; |
212
|
9
|
|
|
|
|
37
|
print $out $merged->text; |
213
|
9
|
|
|
|
|
264
|
$self->_update_ctrl(baseline => $self->latest, parent_baseline => $parlat); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub _check_out_member { |
217
|
17
|
|
|
17
|
|
23
|
my $self = shift; |
218
|
17
|
|
|
|
|
26
|
my $newpath = shift; |
219
|
17
|
|
|
|
|
348
|
my %args = validate(@_, |
220
|
|
|
|
|
|
|
{ |
221
|
|
|
|
|
|
|
store => { type => SCALAR|OBJECT, optional => 1 }, |
222
|
|
|
|
|
|
|
} ); |
223
|
|
|
|
|
|
|
|
224
|
17
|
|
|
|
|
209
|
my $repos = VCS::Lite::Repository->new( |
225
|
|
|
|
|
|
|
$newpath, |
226
|
|
|
|
|
|
|
verbose => $self->{verbose}, |
227
|
|
|
|
|
|
|
%args); |
228
|
|
|
|
|
|
|
|
229
|
17
|
|
|
|
|
65
|
my ($vol,$dir,$fil) = splitpath($self->path); |
230
|
17
|
|
|
|
|
297
|
my $newfil = catfile($newpath,$fil); |
231
|
17
|
|
|
|
|
24
|
my $out; |
232
|
17
|
50
|
|
|
|
1176
|
open $out,'>',$newfil or croak "Failed to check_out $fil, $!"; |
233
|
17
|
|
|
|
|
102
|
print $out $self->fetch->text; |
234
|
17
|
|
|
|
|
2001
|
close $out; |
235
|
|
|
|
|
|
|
|
236
|
17
|
|
|
|
|
45
|
my $pkg = ref $self; |
237
|
17
|
|
|
|
|
105
|
$pkg->new($newfil,%args); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub _assimilate { |
241
|
53
|
|
|
53
|
|
111
|
my ($self,$lite,%args) = @_; |
242
|
|
|
|
|
|
|
|
243
|
53
|
|
|
|
|
173
|
my @newgen = map { [' '.$_] } $lite->text; |
|
2462
|
|
|
|
|
4365
|
|
244
|
53
|
|
|
|
|
298
|
my (@oldgen,@openers,@closers,$skip_to); |
245
|
53
|
|
66
|
|
|
287
|
my $genbase = $args{generation} || $self->latest; |
246
|
|
|
|
|
|
|
|
247
|
53
|
100
|
|
|
|
128
|
if (my $cont = $self->_contents) { |
248
|
28
|
|
|
|
|
58
|
for (@$cont) { |
249
|
1118
|
100
|
|
|
|
1433
|
if ($skip_to) { |
250
|
4
|
|
|
|
|
6
|
push @openers, $_; |
251
|
4
|
100
|
|
|
|
34
|
if (/^=$skip_to$/) { |
252
|
2
|
|
|
|
|
4
|
undef $skip_to; |
253
|
|
|
|
|
|
|
} |
254
|
4
|
|
|
|
|
19
|
next; |
255
|
|
|
|
|
|
|
} |
256
|
1114
|
100
|
|
|
|
2003
|
if (my ($type,$gen) = /^([+-])(.+)/) { |
257
|
7
|
50
|
|
|
|
15
|
$oldgen[-1][2] = [@closers] if @closers; |
258
|
7
|
|
|
|
|
14
|
@closers = (); |
259
|
7
|
|
|
|
|
9
|
push @openers, $_; |
260
|
7
|
100
|
|
|
|
18
|
if (_is_parent_of($gen,$genbase) ^ ($type eq '+')) { |
261
|
2
|
|
|
|
|
3
|
$skip_to = $gen; |
262
|
|
|
|
|
|
|
} |
263
|
7
|
|
|
|
|
14
|
next; |
264
|
|
|
|
|
|
|
} |
265
|
1107
|
100
|
|
|
|
1609
|
if (my ($gen) = /^=(.+)/) { |
266
|
5
|
|
|
|
|
9
|
push @closers, $_; |
267
|
5
|
|
|
|
|
10
|
next; |
268
|
|
|
|
|
|
|
} |
269
|
1102
|
50
|
|
|
|
2110
|
if (/^ /) { |
270
|
1102
|
100
|
|
|
|
1417
|
$oldgen[-1][2] = [@closers] if @closers; |
271
|
1102
|
|
|
|
|
1600
|
push @oldgen,[$_, [@openers]]; |
272
|
1102
|
|
|
|
|
1034
|
@openers = @closers = (); |
273
|
1102
|
|
|
|
|
1059
|
next; |
274
|
|
|
|
|
|
|
} |
275
|
0
|
|
|
|
|
0
|
croak "Invalid format in element contents"; |
276
|
|
|
|
|
|
|
} |
277
|
28
|
100
|
|
|
|
76
|
$oldgen[-1][2] = [@closers] if @closers; |
278
|
|
|
|
|
|
|
} else { |
279
|
25
|
|
|
|
|
524
|
$self->_contents([map $_->[0], @newgen]); |
280
|
25
|
|
|
|
|
227
|
return 1; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
28
|
|
|
|
|
168
|
$genbase =~ s/(\d+)$/$1+1/e; |
|
28
|
|
|
|
|
127
|
|
284
|
28
|
|
|
2500
|
|
210
|
my @sd = Algorithm::Diff::sdiff( \@oldgen, \@newgen, sub { $_[0][0] }); |
|
2500
|
|
|
|
|
11204
|
|
285
|
28
|
|
|
|
|
8196
|
my (@newcont,@pending); |
286
|
28
|
|
|
|
|
45
|
my $prev = 'u'; |
287
|
28
|
|
|
|
|
33
|
my $changed = 0; |
288
|
|
|
|
|
|
|
|
289
|
28
|
|
|
|
|
47
|
for (@sd) { |
290
|
1362
|
|
|
|
|
1274
|
my ($ind,$c1,$c2) = @$_; |
291
|
1362
|
|
|
|
|
938
|
my @res1; |
292
|
1362
|
100
|
|
|
|
1797
|
if ($c1) { |
293
|
1102
|
|
|
|
|
764
|
@res1 = (@{$c1->[1]},$c1->[0]); |
|
1102
|
|
|
|
|
1463
|
|
294
|
1102
|
100
|
|
|
|
1609
|
push @res1,@{$c1->[2]} if defined $c1->[2]; |
|
5
|
|
|
|
|
9
|
|
295
|
|
|
|
|
|
|
} |
296
|
1362
|
50
|
|
|
|
1991
|
my $res2 = $c2->[0] if $c2; |
297
|
|
|
|
|
|
|
|
298
|
1362
|
100
|
100
|
|
|
2522
|
push @newcont,"=$genbase\n" if ($prev ne 'u') && ($ind ne $prev); |
299
|
1362
|
100
|
100
|
|
|
2275
|
if (@pending && ($ind ne 'c')) { |
300
|
9
|
|
|
|
|
23
|
push @newcont, @pending, "=$genbase\n"; |
301
|
9
|
|
|
|
|
14
|
@pending=(); |
302
|
|
|
|
|
|
|
} |
303
|
1362
|
100
|
100
|
|
|
5011
|
if (($prev =~ /[u+]/) && ($ind =~ /[c-]/)) { |
304
|
9
|
|
|
|
|
28
|
push @newcont,"-$genbase\n"; |
305
|
9
|
|
|
|
|
11
|
$changed++; |
306
|
|
|
|
|
|
|
} |
307
|
1362
|
100
|
|
|
|
1531
|
if ($ind eq '+') { |
308
|
260
|
100
|
|
|
|
363
|
push @newcont,"+$genbase\n" if ($prev ne $ind); |
309
|
260
|
|
|
|
|
270
|
push @newcont, $res2; |
310
|
260
|
|
|
|
|
195
|
$changed++; |
311
|
|
|
|
|
|
|
} else { |
312
|
1102
|
|
|
|
|
1072
|
push @newcont, @res1; |
313
|
|
|
|
|
|
|
} |
314
|
1362
|
100
|
|
|
|
1803
|
if ($ind eq 'c') { |
315
|
38
|
100
|
|
|
|
61
|
push @pending,"+$genbase\n" if ($prev ne $ind); |
316
|
38
|
|
|
|
|
37
|
push @pending, $res2; |
317
|
|
|
|
|
|
|
} |
318
|
1362
|
|
|
|
|
1587
|
$prev = $ind; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
28
|
100
|
|
|
|
86
|
push @newcont,"=$genbase\n" if ($prev ne 'u'); |
322
|
28
|
100
|
|
|
|
388
|
return unless $changed; |
323
|
14
|
|
|
|
|
50
|
$self->_contents(\@newcont); |
324
|
14
|
|
|
|
|
237
|
$genbase; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub _is_parent_of { |
328
|
67
|
|
|
67
|
|
73
|
my ($gen1,$gen2) = @_; |
329
|
|
|
|
|
|
|
|
330
|
67
|
|
|
|
|
142
|
my @g1v = split /\./,$gen1; |
331
|
67
|
|
|
|
|
106
|
my @g2v = split /\./,$gen2; |
332
|
67
|
|
66
|
|
|
476
|
(shift @g1v,shift @g2v) while @g1v && @g2v && ($g1v[0] eq $g2v[0]); |
|
|
|
100
|
|
|
|
|
333
|
|
|
|
|
|
|
|
334
|
67
|
100
|
|
|
|
216
|
return 1 unless @g2v; |
335
|
18
|
50
|
|
|
|
30
|
return 0 unless @g1v; |
336
|
18
|
50
|
|
|
|
32
|
return 0 if @g1v > 1; |
337
|
|
|
|
|
|
|
|
338
|
18
|
|
|
|
|
74
|
$g1v[0] < $g2v[0]; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub _update_ctrl { |
342
|
23
|
|
|
23
|
|
65
|
my ($self,%args) = @_; |
343
|
|
|
|
|
|
|
|
344
|
23
|
|
33
|
|
|
102
|
my $path = $args{path} || $self->{path}; |
345
|
23
|
|
|
|
|
80
|
my ($vol,$dir,$fil) = splitpath($path); |
346
|
23
|
|
|
|
|
416
|
$self->{$_} = $args{$_} for keys %args; |
347
|
23
|
|
|
|
|
87
|
$self->{updated} = localtime->datetime; |
348
|
23
|
|
|
|
|
1789
|
$self->save; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub _contents { |
352
|
143
|
|
|
143
|
|
161
|
my $self = shift; |
353
|
|
|
|
|
|
|
|
354
|
143
|
100
|
|
|
|
308
|
$self->{contents} = shift if @_; |
355
|
143
|
100
|
|
|
|
341
|
return unless exists $self->{contents}; |
356
|
|
|
|
|
|
|
|
357
|
118
|
|
|
|
|
260
|
$self->{contents}; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub _slurp_lite { |
361
|
50
|
|
|
50
|
|
84
|
my ($self,$name) = @_; |
362
|
|
|
|
|
|
|
|
363
|
50
|
|
|
|
|
266
|
VCS::Lite->new($name); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
1; |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
__END__ |