| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# Copyright (c) 2001 by RIPE-NCC. All rights reserved. |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
|
5
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
|
6
|
|
|
|
|
|
|
# |
|
7
|
|
|
|
|
|
|
# You should have received a copy of the Perl license along with |
|
8
|
|
|
|
|
|
|
# Perl; see the file README in Perl distribution. |
|
9
|
|
|
|
|
|
|
# |
|
10
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License |
|
11
|
|
|
|
|
|
|
# along with Perl; see the file Copying. If not, write to |
|
12
|
|
|
|
|
|
|
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
|
13
|
|
|
|
|
|
|
# |
|
14
|
|
|
|
|
|
|
# You should have received a copy of the Artistic License |
|
15
|
|
|
|
|
|
|
# along with Perl; see the file Artistic. |
|
16
|
|
|
|
|
|
|
# |
|
17
|
|
|
|
|
|
|
# NO WARRANTY |
|
18
|
|
|
|
|
|
|
# |
|
19
|
|
|
|
|
|
|
# BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
|
20
|
|
|
|
|
|
|
# FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
|
21
|
|
|
|
|
|
|
# OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
|
22
|
|
|
|
|
|
|
# PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED |
|
23
|
|
|
|
|
|
|
# OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
|
24
|
|
|
|
|
|
|
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS |
|
25
|
|
|
|
|
|
|
# TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE |
|
26
|
|
|
|
|
|
|
# PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, |
|
27
|
|
|
|
|
|
|
# REPAIR OR CORRECTION. |
|
28
|
|
|
|
|
|
|
# |
|
29
|
|
|
|
|
|
|
# IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
|
30
|
|
|
|
|
|
|
# WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
|
31
|
|
|
|
|
|
|
# REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, |
|
32
|
|
|
|
|
|
|
# INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING |
|
33
|
|
|
|
|
|
|
# OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED |
|
34
|
|
|
|
|
|
|
# TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY |
|
35
|
|
|
|
|
|
|
# YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER |
|
36
|
|
|
|
|
|
|
# PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE |
|
37
|
|
|
|
|
|
|
# POSSIBILITY OF SUCH DAMAGES. |
|
38
|
|
|
|
|
|
|
# |
|
39
|
|
|
|
|
|
|
# END OF TERMS AND CONDITIONS |
|
40
|
|
|
|
|
|
|
# |
|
41
|
|
|
|
|
|
|
#$Revision: 1.12 $ |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
package VCS::Rcs::Parser; |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
require 5.8.0; |
|
46
|
2
|
|
|
2
|
|
88010
|
use strict; |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
91
|
|
|
47
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
61
|
|
|
48
|
2
|
|
|
2
|
|
11
|
use Carp; |
|
|
2
|
|
|
|
|
7
|
|
|
|
2
|
|
|
|
|
1422
|
|
|
49
|
|
|
|
|
|
|
|
|
50
|
2
|
|
|
2
|
|
1525
|
use VCS::Rcs::YappRcsParser; |
|
|
2
|
|
|
|
|
1129
|
|
|
|
2
|
|
|
|
|
988
|
|
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
our $VERSION = '0.07'; |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub new { |
|
55
|
8
|
|
|
8
|
0
|
40424
|
my $this = shift; |
|
56
|
8
|
|
|
|
|
23
|
my $rtext = shift; |
|
57
|
8
|
|
|
|
|
29
|
my %param = @_; |
|
58
|
|
|
|
|
|
|
|
|
59
|
8
|
|
|
|
|
30
|
my $revs = delete $param{revs}; |
|
60
|
8
|
|
|
|
|
23
|
my $dates = delete $param{dates}; |
|
61
|
|
|
|
|
|
|
|
|
62
|
8
|
50
|
|
|
|
41
|
croak "Unexpected Parameter(s):",(join ',', keys %param) if %param; |
|
63
|
|
|
|
|
|
|
|
|
64
|
8
|
50
|
|
|
|
47
|
(ref($rtext) eq 'SCALAR') or croak "Scalar Ref. to Text is missing!"; |
|
65
|
|
|
|
|
|
|
|
|
66
|
8
|
0
|
|
|
|
36
|
if($revs){ (ref($revs) eq 'ARRAY') or croak "revs must be arrayref!"}; |
|
|
0
|
50
|
|
|
|
0
|
|
|
67
|
|
|
|
|
|
|
|
|
68
|
8
|
0
|
|
|
|
27
|
if($dates){ (ref($dates) eq 'ARRAY') or croak "dates must be arrayref!"}; |
|
|
0
|
50
|
|
|
|
0
|
|
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
|
71
|
8
|
|
33
|
|
|
57
|
my $class = ref($this) || $this; |
|
72
|
8
|
|
|
|
|
21
|
my $self = {}; |
|
73
|
8
|
|
|
|
|
35
|
bless $self ,$class; |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
|
76
|
8
|
|
|
|
|
76
|
my $rcs = new VCS::Rcs::YappRcsParser; |
|
77
|
8
|
|
|
|
|
40
|
$self->{__dt__} = $rcs->Run($rtext, $revs, $dates); # VCS::Rcs::Deltatext |
|
78
|
|
|
|
|
|
|
|
|
79
|
8
|
|
|
|
|
51
|
for my $rev ($self->{__dt__}->revs) { |
|
80
|
56
|
|
|
|
|
727
|
my $rdate = $self->{__dt__}->date($rev); |
|
81
|
56
|
50
|
|
|
|
135
|
next unless (defined $rdate); |
|
82
|
56
|
50
|
|
|
|
135
|
$rdate = '19'.$rdate if (length($rdate) == 17); |
|
83
|
56
|
|
|
|
|
161
|
$self->{__date_index__}{$rdate} = $rev; |
|
84
|
56
|
|
|
|
|
215
|
$self->{__rev_index__}{$rev} = $rdate; |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
$self |
|
88
|
8
|
|
|
|
|
1372
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub co { |
|
92
|
8
|
|
|
8
|
0
|
58
|
my $self = shift; |
|
93
|
8
|
|
|
|
|
34
|
my %param = @_; |
|
94
|
|
|
|
|
|
|
|
|
95
|
8
|
|
|
|
|
34
|
my $rev = delete $param{rev}; |
|
96
|
8
|
|
|
|
|
22
|
my $date = delete $param{date}; |
|
97
|
|
|
|
|
|
|
|
|
98
|
8
|
50
|
|
|
|
34
|
croak "Unexpected Parameter(s):",(join ',', keys %param) if %param; |
|
99
|
|
|
|
|
|
|
|
|
100
|
8
|
50
|
|
|
|
57
|
return $self->{__dt__}->rev($rev) if (defined $rev); |
|
101
|
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
0
|
my @alldates = sort keys %{$self->{__date_index__}}; |
|
|
0
|
|
|
|
|
0
|
|
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
my($a,$date_proper); |
|
106
|
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
0
|
for $a (@alldates) { |
|
108
|
0
|
0
|
|
|
|
0
|
$date_proper=$a if ($a lt $date); |
|
109
|
|
|
|
|
|
|
} |
|
110
|
0
|
0
|
|
|
|
0
|
$date_proper=$alldates[-1] if ($alldates[-1] lt $date); |
|
111
|
|
|
|
|
|
|
|
|
112
|
2
|
|
|
2
|
|
17
|
no warnings; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
406
|
|
|
113
|
0
|
|
|
|
|
0
|
$self->{__dt__}->rev($self->{__date_index__}{$date_proper}) |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub revs { |
|
118
|
8
|
|
|
8
|
0
|
22
|
my $self = shift; |
|
119
|
8
|
|
|
|
|
34
|
my %param = @_; |
|
120
|
|
|
|
|
|
|
|
|
121
|
8
|
|
|
|
|
26
|
my $index = delete $param{index}; |
|
122
|
|
|
|
|
|
|
|
|
123
|
8
|
50
|
|
|
|
34
|
croak "Unexpected Parameter(s):",(join ',', keys %param) if %param; |
|
124
|
|
|
|
|
|
|
|
|
125
|
8
|
50
|
|
|
|
52
|
$index eq 'date' and return ($self->{__date_index__}); |
|
126
|
|
|
|
|
|
|
|
|
127
|
0
|
0
|
|
|
|
|
$index eq 'rev' and return ($self->{__rev_index__}); |
|
128
|
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
croak "Unexpected value(s):",(join ',', values %param); |
|
130
|
|
|
|
|
|
|
} |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
1; |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
__END__ |