File Coverage

blib/lib/Travel/Routing/DE/EFA/Route/Part.pm
Criterion Covered Total %
statement 43 65 66.1
branch 3 14 21.4
condition 3 10 30.0
subroutine 13 17 76.4
pod 12 13 92.3
total 74 119 62.1


line stmt bran cond sub pod time code
1             package Travel::Routing::DE::EFA::Route::Part;
2              
3 2     2   13 use strict;
  2         3  
  2         71  
4 2     2   9 use warnings;
  2         4  
  2         109  
5 2     2   29 use 5.010;
  2         6  
6              
7 2     2   11 use parent 'Class::Accessor';
  2         16  
  2         10  
8              
9             our $VERSION = '2.24';
10              
11             my %occupancy = (
12             MANY_SEATS => 1,
13             FEW_SEATS => 2,
14             STANDING_ONLY => 3
15             );
16              
17             Travel::Routing::DE::EFA::Route::Part->mk_ro_accessors(
18             qw(arrival_platform arrival_stop
19             arrival_date arrival_time arrival_sdate arrival_stime arrival_delay
20             delay
21             departure_platform departure_delay
22             departure_stop departure_date departure_time departure_sdate
23             departure_stime
24             footpath_duration footpath_type
25             occupancy
26             train_destination train_line train_product
27             )
28             );
29              
30             sub new {
31 10     10 1 218 my ( $obj, %conf ) = @_;
32              
33 10         24 my $ref = \%conf;
34              
35 10 50 33     39 if ( $ref->{occupancy} and exists $occupancy{ $ref->{occupancy} } ) {
36 0         0 $ref->{occupancy} = $occupancy{ $ref->{occupancy} };
37             }
38             else {
39 10         28 delete $ref->{occupancy};
40             }
41              
42 10         24 $ref->{delay} = $ref->{departure_delay};
43              
44 10         59 return bless( $ref, $obj );
45             }
46              
47             sub arrival_routemaps {
48 2     2 1 7 my ($self) = @_;
49              
50 2         5 return @{ $self->{arrival_routemaps} };
  2         14  
51             }
52              
53             sub arrival_stationmaps {
54 2     2 1 6 my ($self) = @_;
55              
56 2         3 return @{ $self->{arrival_stationmaps} };
  2         15  
57             }
58              
59             sub arrival_stop_and_platform {
60 2     2 1 12922 my ($self) = @_;
61              
62 2 50       8 if ( length( $self->arrival_platform ) ) {
63             return
64 2         34 sprintf( '%s: %s', $self->get(qw(arrival_stop arrival_platform)) );
65             }
66 0         0 return $self->arrival_stop;
67             }
68              
69             sub departure_routemaps {
70 2     2 1 6 my ($self) = @_;
71              
72 2         4 return @{ $self->{departure_routemaps} };
  2         14  
73             }
74              
75             sub departure_stationmaps {
76 2     2 1 6 my ($self) = @_;
77              
78 2         4 return @{ $self->{departure_stationmaps} };
  2         13  
79             }
80              
81             sub departure_stop_and_platform {
82 2     2 1 7853 my ($self) = @_;
83              
84 2 50       11 if ( length( $self->departure_platform ) ) {
85              
86             return
87 2         38 sprintf( '%s: %s',
88             $self->get(qw(departure_stop departure_platform)) );
89             }
90 0         0 return $self->departure_stop;
91             }
92              
93             sub footpath_parts {
94 0     0 1 0 my ($self) = @_;
95              
96 0 0       0 if ( $self->{footpath_parts} ) {
97 0         0 return @{ $self->{footpath_parts} };
  0         0  
98             }
99 0         0 return;
100             }
101              
102             sub is_cancelled {
103 0     0 1 0 my ($self) = @_;
104              
105 0 0 0     0 if ( $self->{delay} and $self->{delay} eq '-9999' ) {
106 0         0 return 1;
107             }
108 0         0 return;
109             }
110              
111             # DEPRECATED
112             sub extra {
113 2     2 0 1480 my ($self) = @_;
114              
115 2   50     5 my @ret = map { $_->summary } @{ $self->{regular_notes} // [] };
  1         8  
  2         13  
116              
117 2         39 return @ret;
118             }
119              
120             sub regular_notes {
121 0     0 1 0 my ($self) = @_;
122              
123 0 0       0 if ( $self->{regular_notes} ) {
124 0         0 return @{ $self->{regular_notes} };
  0         0  
125             }
126 0         0 return;
127             }
128              
129             sub current_notes {
130 0     0 1 0 my ($self) = @_;
131              
132 0 0       0 if ( $self->{current_notes} ) {
133 0         0 return @{ $self->{current_notes} };
  0         0  
134             }
135 0         0 return;
136             }
137              
138             sub via {
139 1     1 1 4061 my ($self) = @_;
140              
141 1   50     3 return @{ $self->{via} // [] };
  1         16  
142             }
143              
144             1;
145              
146             __END__