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