File Coverage

blib/lib/Travel/Routing/DE/EFA/Route/Part.pm
Criterion Covered Total %
statement 42 64 65.6
branch 3 14 21.4
condition 3 10 30.0
subroutine 13 17 76.4
pod 12 13 92.3
total 73 118 61.8


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