File Coverage

blib/lib/WebService/KVV/Live/Stop.pm
Criterion Covered Total %
statement 28 49 57.1
branch 3 16 18.7
condition n/a
subroutine 9 11 81.8
pod 2 2 100.0
total 42 78 53.8


line stmt bran cond sub pod time code
1 3     3   138987 use strict;
  3         32  
  3         74  
2 3     3   12 use warnings;
  3         6  
  3         138  
3             package WebService::KVV::Live::Stop;
4              
5             # ABSTRACT: Arrival times for Trams/Buses in the Karlsruhe metropolitan area
6             our $VERSION = '0.006'; # VERSION
7              
8 3     3   14 use Carp;
  3         6  
  3         134  
9 3     3   13 use utf8;
  3         5  
  3         11  
10 3     3   864 use Net::HTTP::Spore::Middleware::Format::JSON;
  3         1196210  
  3         120  
11 3     3   926 use Net::HTTP::Spore 0.08;
  3         2994403  
  3         103  
12 3     3   1216 use Net::HTTP::Spore::Middleware::DefaultParams;
  3         31870  
  3         118  
13 3     3   1170 use File::ShareDir 'dist_file';
  3         13123  
  3         1245  
14              
15             =pod
16              
17             =encoding utf8
18              
19             =head1 NAME
20              
21             WebService::KVV::Live::Stop - Arrival times for Trams/Buses in the Karlsruhe metropolitan area
22              
23              
24             =head1 SYNOPSIS
25              
26             use WebService::KVV::Live::Stop;
27             use utf8;
28             use open qw( :encoding(UTF-8) :std );
29              
30             my $stop = WebService::KVV::Live::Stop->new("Siemensallee");
31             print "Arrival time: $_->{time} $_->{route} $_->{destination}\n" for $stop->departures;
32              
33             Print departure table:
34              
35             use WebService::KVV::Live::Stop;
36             use utf8;
37             use open qw( :encoding(UTF-8) :std );
38            
39             use Data::Dumper::Table;
40             use Data::Visitor::Callback;
41              
42             $stop = WebService::KVV::Live::Stop->new($ARGV[0] // 'Kronenplatz');
43             my @entries = $stop->departures;
44             Data::Visitor::Callback->new('JSON::PP::Boolean' => sub { $_ = $_ ? 'true' : 0 })->visit(@entries);
45             my $departure_table = Tabulate \@entries;
46             $departure_table =~ s/^.*\n//; # remove object type
47              
48             print $departure_tabletable;
49              
50              
51              
52             =head1 DESCRIPTION
53              
54             API for searching for bus/tram stops in the Karlsruhe Metropolitan Area (Karlsruhe Verkehrsvertriebe network to be exact) and for listing departure times at said stops.
55              
56             =cut
57              
58             my $client = Net::HTTP::Spore->new_from_spec(dist_file 'WebService-KVV-Live-Stop', 'kvvlive.json');
59             $client->enable('Format::JSON');
60             $client->enable('DefaultParams', default_params => { key => '377d840e54b59adbe53608ba1aad70e8' });
61             $client->enable('UserAgent', useragent => __PACKAGE__ ." $VERSION");
62              
63             =head1 IMPLEMENTATION
64              
65             Not really an API, just a client for L<http://live.kvv.de>. See L<kvvlive.json|https://github.com/athreef/WebService-KVV-Live-Stop/blob/master/share/kvvlive.json> for details.
66              
67             The client is based on L<Net::HTTP::Spore> and has some workarounds: It overrides a method from C<Net::HTTP::Spore > that doesn't handle colons properly and throws a generic message on errors instead of the more specific HTTP error messages.
68              
69             =head1 METHODS AND ARGUMENTS
70              
71             =over 4
72              
73             =item new($latitude, $langitude), new($name), new($id)
74              
75             Search for matching local transport stops. C<$id> are identifiers starting with C<"de:">. C<$name> need not be an exact match.
76              
77             Returns a list of C<WebService::KVV::Live::Stop>s in list context. In scalar context returns the best match.
78              
79             =cut
80              
81             #FIXME: timeout
82             sub new {
83 3     3 1 381 my $class = shift;
84            
85 3         38 my @self;
86 3 50       13 @_ or croak "No stop specified";
87 3 50       38 my $response =
    50          
88             @_ == 2 ? $client->stop_by_latlon(LAT => shift, LON => shift)
89             : $_[0] =~ /^de:$/ ? $client->stop_by_id(ID => shift)
90             : $client->stop_by_name(NAME => shift)
91             ;
92 0 0         @{$response->{body}{stops}} or croak "No stops match arguments";
  0            
93 0 0         $response->{body}{stops} = [$response->{body}{stops}[0]] unless wantarray;
94 0           for my $stop (@{$response->{body}{stops}}) {
  0            
95 0           my $obj = $stop;
96 0           bless $obj, $class;
97 0           push @self, $obj;
98             }
99              
100 0 0         return wantarray ? @self : $self[0];
101             }
102              
103              
104             =item departures([$route])
105              
106             Returns a list of departures for a WebService::KVV::Live::Stop. Results can be restricted to a particular route (Linie) by the optional argument.
107              
108             =cut
109              
110             sub _departures {
111 0     0     my $id = shift;
112 0           my $route = shift;
113              
114             # ?maxInfos=:maxInfos
115 0 0         return defined $route ? $client->departures_by_route(ID => $id, ROUTE => $route)
116             : $client->departures_by_stop(ID => $id);
117             }
118              
119             sub departures {
120 0     0 1   my $self = shift;
121 0           my $route = shift;
122              
123 0           my $id = $self->{id};
124 0           my $response;
125 0           eval {
126 0           $response = _departures $id, $route;
127             };
128 0 0         defined $response or croak "Error during REST request (Ye, I know the error message sucks but it's acutally Net::HTTP::Spore throwing an exception without context)";
129 0           return @{$response->{body}->{departures}}
  0            
130             }
131              
132              
133             1;
134             __END__
135              
136             =back
137              
138              
139             =head1 GIT REPOSITORY
140              
141             L<http://github.com/athreef/WebService-KVV-Live-Stop>
142              
143             =head1 SEE ALSO
144              
145             L<http://live.kvv.de>
146              
147             =head1 AUTHOR
148              
149             Ahmad Fatoum C<< <athreef@cpan.org> >>, L<http://a3f.at>
150              
151             =head1 COPYRIGHT AND LICENSE
152              
153             Copyright (C) 2016 Ahmad Fatoum
154              
155             This library is free software; you can redistribute it and/or modify
156             it under the same terms as Perl itself.
157              
158             =cut