File Coverage

blib/lib/Travel/Status/DE/EFA/Result.pm
Criterion Covered Total %
statement 21 55 38.1
branch 1 14 7.1
condition 3 22 13.6
subroutine 7 11 63.6
pod 6 6 100.0
total 38 108 35.1


line stmt bran cond sub pod time code
1             package Travel::Status::DE::EFA::Result;
2              
3 2     2   14 use strict;
  2         4  
  2         60  
4 2     2   11 use warnings;
  2         4  
  2         45  
5 2     2   34 use 5.010;
  2         7  
6              
7 2     2   41 no if $] >= 5.018, warnings => 'experimental::smartmatch';
  2         7  
  2         12  
8              
9 2     2   138 use parent 'Class::Accessor';
  2         4  
  2         10  
10              
11             our $VERSION = '1.21';
12              
13             Travel::Status::DE::EFA::Result->mk_ro_accessors(
14             qw(countdown date delay destination is_cancelled info key line lineref
15             mot occupancy operator platform platform_db platform_name sched_date sched_time time train_no type)
16             );
17              
18             my @mot_mapping = qw{
19             zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
20             schnellbus seilbahn schiff ast sonstige
21             };
22              
23             sub new {
24 40     40 1 443 my ( $obj, %conf ) = @_;
25              
26 40         73 my $ref = \%conf;
27              
28 40 50 66     123 if ( defined $ref->{delay} and $ref->{delay} eq '-9999' ) {
29 0         0 $ref->{delay} = 0;
30 0         0 $ref->{is_cancelled} = 1;
31             }
32             else {
33 40         67 $ref->{is_cancelled} = 0;
34             }
35              
36 40         228 return bless( $ref, $obj );
37             }
38              
39             sub mot_name {
40 3     3 1 47259 my ($self) = @_;
41              
42 3   50     23 return $mot_mapping[ $self->{mot} ] // 'sonstige';
43             }
44              
45             sub route_pre {
46 0     0 1   my ($self) = @_;
47              
48 0           return @{ $self->{prev_route} };
  0            
49             }
50              
51             sub route_post {
52 0     0 1   my ($self) = @_;
53              
54 0           return @{ $self->{next_route} };
  0            
55             }
56              
57             sub route_interesting {
58 0     0 1   my ( $self, $max_parts ) = @_;
59              
60 0           my @via = $self->route_post;
61 0           my ( @via_main, @via_show, $last_stop );
62 0   0       $max_parts //= 3;
63              
64 0           for my $stop (@via) {
65 0 0         if (
66             $stop->name_suf =~ m{ Bf | Hbf | Flughafen | Hauptbahnhof
67             | Krankenhaus | Klinik | (?: S $ ) }ox
68             )
69             {
70 0           push( @via_main, $stop );
71             }
72             }
73 0           $last_stop = pop(@via);
74              
75 0 0 0       if ( @via_main and $via_main[-1] == $last_stop ) {
76 0           pop(@via_main);
77             }
78 0 0 0       if ( @via and $via[-1] == $last_stop ) {
79 0           pop(@via);
80             }
81              
82 0 0 0       if ( @via_main and @via and $via[0] == $via_main[0] ) {
      0        
83 0           shift(@via_main);
84             }
85              
86 0 0         if ( @via < $max_parts ) {
87 0           @via_show = @via;
88             }
89             else {
90 0 0         if ( @via_main >= $max_parts ) {
91 0           @via_show = ( $via[0] );
92             }
93             else {
94 0           @via_show = splice( @via, 0, $max_parts - @via_main );
95             }
96              
97 0   0       while ( @via_show < $max_parts and @via_main ) {
98 0           my $stop = shift(@via_main);
99              
100             # FIXME cannot smartmatch $stop since it became an object
101             # if ( $stop ~~ \@via_show or $stop == $last_stop ) {
102             # next;
103             # }
104 0           push( @via_show, $stop );
105             }
106             }
107              
108 0           return @via_show;
109             }
110              
111             sub TO_JSON {
112 0     0 1   my ($self) = @_;
113              
114 0           return { %{$self} };
  0            
115             }
116              
117             1;
118              
119             __END__