File Coverage

blib/lib/VCS/Rcs/Parser.pm
Criterion Covered Total %
statement 47 58 81.0
branch 10 30 33.3
condition 1 3 33.3
subroutine 8 8 100.0
pod 0 3 0.0
total 66 102 64.7


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__