diff options
Diffstat (limited to 'lib/Travel/Status/DE/URA.pm')
| -rw-r--r-- | lib/Travel/Status/DE/URA.pm | 406 |
1 files changed, 323 insertions, 83 deletions
diff --git a/lib/Travel/Status/DE/URA.pm b/lib/Travel/Status/DE/URA.pm index 99a56fe..8859583 100644 --- a/lib/Travel/Status/DE/URA.pm +++ b/lib/Travel/Status/DE/URA.pm @@ -3,22 +3,34 @@ package Travel::Status::DE::URA; use strict; use warnings; use 5.010; +use utf8; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; +our $VERSION = '2.01'; -our $VERSION = '0.02'; +# create CONSTANTS for different Return Types +use constant { + TYPE_STOP => 0, + TYPE_PREDICTION => 1, + TYPE_MESSAGE => 2, + TYPE_BASE => 3, + TYPE_URA => 4, +}; use Carp qw(confess cluck); use DateTime; use Encode qw(encode decode); use List::MoreUtils qw(firstval none uniq); use LWP::UserAgent; +use Text::CSV; use Travel::Status::DE::URA::Result; +use Travel::Status::DE::URA::Stop; sub new { my ( $class, %opt ) = @_; - my $ua = LWP::UserAgent->new(%opt); + my %lwp_options = %{ $opt{lwp_options} // { timeout => 10 } }; + + my $ua = LWP::UserAgent->new(%lwp_options); my $response; if ( not( $opt{ura_base} and $opt{ura_version} ) ) { @@ -28,19 +40,34 @@ sub new { my $self = { datetime => $opt{datetime} // DateTime->now( time_zone => 'Europe/Berlin' ), - ura_base => $opt{ura_base}, - ura_version => $opt{ura_version}, - full_routes => $opt{full_routes} // 0, - hide_past => $opt{hide_past} // 1, - stop => $opt{stop}, - via => $opt{via}, - post => { - ReturnList => - 'lineid,linename,directionid,destinationtext,vehicleid,' - . 'tripid,estimatedtime,stopid,stoppointname' + developer_mode => $opt{developer_mode}, + ura_base => $opt{ura_base}, + ura_version => $opt{ura_version}, + full_routes => $opt{calculate_routes} // 0, + hide_past => $opt{hide_past} // 1, + stop => $opt{stop}, + via => $opt{via}, + via_id => $opt{via_id}, + stop_id => $opt{stop_id}, + line_id => $opt{line_id}, + circle => $opt{circle}, + post => { + StopAlso => 'False', + + # for easier debugging ordered in the returned order + ReturnList => 'stoppointname,stopid,stoppointindicator,' + . 'latitude,longitude,lineid,linename,' + . 'directionid,destinationtext,vehicleid,tripid,estimatedtime' }, }; + if ( $opt{with_messages} ) { + $self->{post}{ReturnList} .= ',messagetext,messagetype'; + } + if ( $opt{with_stops} ) { + $self->{post}{StopAlso} = 'True'; + } + $self->{ura_instant_url} = $self->{ura_base} . '/instant_V' . $self->{ura_version}; @@ -49,6 +76,27 @@ sub new { $ua->env_proxy; if ( substr( $self->{ura_instant_url}, 0, 5 ) ne 'file:' ) { + + # filter by stop_id only if full_routes is not set + if ( not $self->{full_routes} and $self->{stop_id} ) { + $self->{post}{StopID} = $self->{stop_id}; + + # filter for via as well to make via work + if ( defined $self->{via_id} ) { + $self->{post}{StopID} .= q{,} . $self->{via_id}; + } + } + + # filter by line + if ( $self->{line_id} ) { + $self->{post}{LineID} = $self->{line_id}; + } + + # filter for Stops in circle (lon,lat,dist) + if ( $self->{circle} ) { + $self->{post}{Circle} = $self->{circle}; + } + $response = $ua->post( $self->{ura_instant_url}, $self->{post} ); } else { @@ -60,27 +108,71 @@ sub new { return $self; } - $self->{raw_str} = $response->decoded_content; - if ( substr( $self->{ura_instant_url}, 0, 5 ) eq 'file:' ) { - $self->{raw_str} = encode( 'UTF-8', $self->{raw_str} ); + my $raw_str = $response->decoded_content; + + if ( $self->{developer_mode} ) { + say decode( 'UTF-8', $raw_str ); } - $self->parse_raw_data; + # Fix encoding in case we're running through test files + if ( substr( $self->{ura_instant_url}, 0, 5 ) eq 'file:' ) { + $raw_str = encode( 'UTF-8', $raw_str ); + } + $self->parse_raw_data($raw_str); return $self; } sub parse_raw_data { - my ($self) = @_; + my ( $self, $raw_str ) = @_; + my $csv = Text::CSV->new( { binary => 1 } ); - for my $dep ( split( /\r\n/, $self->{raw_str} ) ) { + for my $dep ( split( /\r\n/, $raw_str ) ) { $dep =~ s{^\[}{}; $dep =~ s{\]$}{}; - # first field == 4 => version information, no departure - if ( substr( $dep, 0, 1 ) != 4 ) { - my @fields = split( /"?,"?/, $dep ); - push( @{ $self->{raw_list} }, \@fields ); + $csv->parse($dep); + my @fields = $csv->fields; + + # encode all fields + for my $i ( 1, 11 ) { + $fields[$i] = encode( 'UTF-8', $fields[$i] ); + } + + push( @{ $self->{raw_list} }, \@fields ); + + my $type = $fields[0]; + + if ( $type == TYPE_STOP ) { + my $stop_name = $fields[1]; + my $stop_id = $fields[2]; + my $longitude = $fields[3]; + my $latitude = $fields[4]; + + # create Stop Dict + if ( not exists $self->{stops}{$stop_id} ) { + $self->{stops}{$stop_id} = Travel::Status::DE::URA::Stop->new( + name => decode( 'UTF-8', $stop_name ), + id => $stop_id, + longitude => $longitude, + latitude => $latitude, + ); + } + } + elsif ( $type == TYPE_MESSAGE ) { + push( + @{ $self->{messages} }, + { + stop_name => $fields[1], + stop_id => $fields[2], + + # 0 = long text. 2 = short text for station displays? + type => $fields[6], + text => $fields[7], + } + ); + } + elsif ( $type == TYPE_PREDICTION ) { push( @{ $self->{stop_names} }, $fields[1] ); } } @@ -103,40 +195,83 @@ sub get_stop_by_name { return ( grep { $_ =~ m{$name}i } @{ $self->{stop_names} } ); } +sub get_stops { + my ($self) = @_; + + return $self->{stops}; +} + sub errstr { my ($self) = @_; return $self->{errstr}; } +sub messages_by_stop_id { + my ( $self, $stop_id ) = @_; + + my @messages = grep { $_->{stop_id} == $stop_id } @{ $self->{messages} }; + @messages = map { $_->{text} } @messages; + + return @messages; +} + +sub messages_by_stop_name { + my ( $self, $stop_name ) = @_; + + my @messages + = grep { $_->{stop_name} eq $stop_name } @{ $self->{messages} }; + @messages = map { $_->{text} } @messages; + + return @messages; +} + sub results { my ( $self, %opt ) = @_; my @results; - my $full_routes = $opt{full_routes} // $self->{full_routes} // 0; - my $hide_past = $opt{hide_past} // $self->{hide_past} // 1; - my $stop = $opt{stop} // $self->{stop}; - my $via = $opt{via} // $self->{via}; + my $full_routes = $opt{calculate_routes} // $self->{full_routes} // 0; + my $hide_past = $opt{hide_past} // $self->{hide_past} // 1; + my $line_id = $opt{line_id} // $self->{line_id}; + my $stop = $opt{stop} // $self->{stop}; + my $stop_id = $opt{stop_id} // $self->{stop_id}; + my $via = $opt{via} // $self->{via}; + my $via_id = $opt{via_id} // $self->{via_id}; my $dt_now = $self->{datetime}; my $ts_now = $dt_now->epoch; - if ($via) { - $full_routes ||= 'after'; + if ( $via or $via_id ) { + $full_routes = 1; } for my $dep ( @{ $self->{raw_list} } ) { my ( - $u1, $stopname, $stopid, $lineid, $linename, - $u2, $dest, $vehicleid, $tripid, $timestamp + $type, $stopname, $stopid, $stopindicator, + $longitude, $latitude, $lineid, $linename, + $directionid, $dest, $vehicleid, $tripid, + $timestamp ) = @{$dep}; - my @route; + my ( @route_pre, @route_post ); + + # only work on Prediction informations + if ( $type != TYPE_PREDICTION ) { + next; + } + + if ( $line_id and not( $lineid eq $line_id ) ) { + next; + } if ( $stop and not( $stopname eq $stop ) ) { next; } + if ( $stop_id and not( $stopid eq $stop_id ) ) { + next; + } + if ( not $timestamp ) { cluck("departure element without timestamp: $dep"); next; @@ -155,52 +290,76 @@ sub results { my $ts_dep = $dt_dep->epoch; if ($full_routes) { - @route = map { [ $_->[9] / 1000, $_->[1] ] } - grep { $_->[8] == $tripid } @{ $self->{raw_list} }; + my @route + = map { [ $_->[12] / 1000, $_->[1], $_->[2], $_->[4], $_->[5] ] } + grep { $_->[11] == $tripid } + grep { $_->[0] == 1 } @{ $self->{raw_list} }; - if ( $full_routes eq 'before' ) { - @route = grep { $_->[0] < $ts_dep } @route; - } - elsif ( $full_routes eq 'after' ) { - @route = grep { $_->[0] > $ts_dep } @route; - } + @route_pre = grep { $_->[0] < $ts_dep } @route; + @route_post = grep { $_->[0] > $ts_dep } @route; if ( $via - and none { $_->[1] eq $via } @route ) + and none { $_->[1] eq $via } @route_post ) + { + next; + } + + if ( $via_id + and none { $_->[2] eq $via_id } @route_post ) { next; } if ($hide_past) { - @route = grep { $_->[0] >= $ts_now } @route; + @route_pre = grep { $_->[0] >= $ts_now } @route_pre; } - @route = map { $_->[0] } + @route_pre = map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->[0] ] } @route_pre; + @route_post = map { $_->[0] } sort { $a->[1] <=> $b->[1] } - map { [ $_, $_->[0] ] } @route; + map { [ $_, $_->[0] ] } @route_post; - @route = map { - [ - DateTime->from_epoch( + @route_pre = map { + Travel::Status::DE::URA::Stop->new( + datetime => DateTime->from_epoch( + epoch => $_->[0], + time_zone => 'Europe/Berlin' + ), + name => decode( 'UTF-8', $_->[1] ), + id => $_->[2], + longitude => $_->[3], + latitude => $_->[4], + ) + } @route_pre; + @route_post = map { + Travel::Status::DE::URA::Stop->new( + datetime => DateTime->from_epoch( epoch => $_->[0], time_zone => 'Europe/Berlin' ), - decode( 'UTF-8', $_->[1] ) - ] - } @route; + name => decode( 'UTF-8', $_->[1] ), + id => $_->[2], + longitude => $_->[3], + latitude => $_->[4], + ) + } @route_post; } push( @results, Travel::Status::DE::URA::Result->new( - datetime => $dt_dep, - dt_now => $dt_now, - line => $linename, - line_id => $lineid, - destination => decode( 'UTF-8', $dest ), - route_timetable => [@route], - stop => $stopname, - stop_id => $stopid, + datetime => $dt_dep, + dt_now => $dt_now, + line => $linename, + line_id => $lineid, + destination => $dest, + route_pre => [@route_pre], + route_post => [@route_post], + stop => $stopname, + stop_id => $stopid, + stop_indicator => $stopindicator, ) ); } @@ -209,19 +368,41 @@ sub results { sort { $a->[1] <=> $b->[1] } map { [ $_, $_->datetime->epoch ] } @results; - $self->{results} = \@results; - return @results; } +# static +sub get_services { + return ( + { + ura_base => 'http://ivu.aseag.de/interfaces/ura', + ura_version => 1, + name => 'Aachener Straßenbahn und Energieversorgungs AG', + shortname => 'ASEAG', + }, + { + ura_base => 'http://ura.itcs.mvg-mainz.de/interfaces/ura', + ura_version => 1, + name => 'Mainzer Mobilität', + shortname => 'MM', + }, + { + ura_base => 'http://countdown.api.tfl.gov.uk/interfaces/ura', + ura_version => 1, + name => 'Transport for London', + shortname => 'TfL', + } + ); +} + 1; __END__ =head1 NAME -Travel::Status::DE::URA - unofficial departure monitor for URA-based -realtime data providers (e.g. ASEAG) +Travel::Status::DE::URA - unofficial departure monitor for "Unified Realtime +API" data providers (e.g. ASEAG) =head1 SYNOPSIS @@ -242,13 +423,14 @@ realtime data providers (e.g. ASEAG) =head1 VERSION -version 0.02 +version 2.01 =head1 DESCRIPTION -Travel::Status::DE::URA is an unofficial interface URA-based realtime departure -monitors (as used e.g. by the ASEAG). It reports all upcoming departures at a -given place in real-time. Schedule information is not included. +Travel::Status::DE::URA is an unofficial interface to URA-based realtime +departure monitors (as used e.g. by the ASEAG). It reports all upcoming +departures at a given place in real-time. Schedule information is not +included. =head1 METHODS @@ -274,13 +456,43 @@ The version, may be any string. =back The request URL is I<ura_base>/instant_VI<version>, so for -C<< http://ivu.aseag.de/interfaces/ura >>, C<< 1 >> this module will point +C<< http://ivu.aseag.de/interfaces/ura >>, C<< 1 >> this module will send requests to C<< http://ivu.aseag.de/interfaces/ura/instant_V1 >>. +All remaining parameters are optional. + +=over + +=item B<lwp_options> => I<\%hashref> + +Passed on to C<< LWP::UserAgent->new >>. Defaults to C<< { timeout => 10 } >>, +you can use an empty hashref to override it. + +=item B<circle> => I<lon,lat,dist> + +Only request departures for stops which are located up to I<dist> meters +away from the location specified by I<lon> and I<lat>. Example parameter: +"50.78496,6.10897,100". + +=item B<with_messages> => B<0>|B<1> + +When set to B<1> (or any other true value): Also requests stop messages from +the URA service. Thene can include texts such as "Expect delays due to snow and +ice" or "stop closed, use replacement stop X instead". Use +C<< $status->messages >> to access them. + +=item B<with_stops> => B<0>|B<1> + +When set to B<1> (or any other true value): Also request all stops satisfying +the specified parameters. They can be accessed with B<get_stops>. Defaults to +B<0>. + +=back + Additionally, all options supported by C<< $status->results >> may be specified -here, causing them to be used as defaults. Note that while they may be -overridden later, they may limit the set of available departures requested from -the server. +here, causing them to be used as defaults. Note that while they can be +overridden later, they may limit the set of departures requested from the +server. =item $status->errstr @@ -294,6 +506,25 @@ Returns a list of stops matching I<$stopname>. For instance, if the stops parameter "bushof" will return "Aachen Bushof" and "Eupen Bushof", while "brand" will only return "Brand". +=item $status->get_stops + +Returns a hash reference describing all distinct stops returned by the request. +Each key is the unique ID of a stop and contains a +Travel::Status::DE::URA::Stop(3pm) object describing it. + +Only works when $status was created with B<with_stops> set to a true value. +Otherwise, undef is returned. + +=item $status->messages_by_stop_id($stop_id) + +Returns a list of messages for the stop with the ID I<$stop_id>. +At the moment, each message is a simple string. This may change in the future. + +=item $status->messages_by_stop_name($stop_id) + +Returns a list of messages for the stop with the name I<$stop_name>. +At the moment, each message is a simple string. This may change in the future. + =item $status->results(I<%opt>) Returns a list of Travel::Status::DE::URA::Result(3pm) objects, each describing @@ -303,30 +534,37 @@ Accepted parameters (all are optional): =over -=item B<full_routes> => B<before>|B<after>|I<bool> (default 0) +=item B<calculate_routes> => I<bool> (default 0) -When set to a true value: Compute B<route_timetable> fields in all -Travel::Status::DE::URA::Result(3pm) objects, otherwise they will not be -set. - -B<before> / B<after> limits the timetable to stops before / after the stop -I<name> (if set). +When set to a true value: Compute routes for all results, enabling use of +their B<route_> accessors. Otherwise, those will just return nothing +(undef / empty list, depending on context). =item B<hide_past> => I<bool> (default 1) Do not include past departures in the result list and the computed timetables. +=item B<line_id> => I<ID> + +Only return departures of line I<ID>. + =item B<stop> => I<name> Only return departures at stop I<name>. +=item B<stop_id> => I<ID> + +Only return departures at stop I<ID>. + =item B<via> => I<vianame> -Only return departures containing I<vianame> in their route. If B<stop> is set, -I<vianame> must be in the route after the stop I<name>. If, in addition to -that, B<full_routes> is set to B<before>, I<vianame> must be in the route -before the stop I<name>. Implies C<< full_routes> => 'after' >> unless -B<full_routes> is explicitly set to B<before> / B<after> / 1. +Only return departures containing I<vianame> in their route after their +corresponding stop. Implies B<calculate_routes>=1. + +=item B<via_id> => I<ID> + +Only return departures containing I<ID> in their route after their +corresponding stop. Implies B<calculate_routes>=1. =back @@ -348,6 +586,8 @@ None. =item * LWP::UserAgent(3pm) +=item * Text::CSV(3pm) + =back =head1 BUGS AND LIMITATIONS @@ -360,7 +600,7 @@ Travel::Status::DE::URA::Result(3pm). =head1 AUTHOR -Copyright (C) 2013 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2013-2016 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE |