diff options
Diffstat (limited to 'lib/Travel')
| -rw-r--r-- | lib/Travel/Status/DE/EFA.pm | 234 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Line.pm | 6 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Result.pm | 64 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Stop.pm | 31 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/VRR.pm | 11 |
5 files changed, 181 insertions, 165 deletions
diff --git a/lib/Travel/Status/DE/EFA.pm b/lib/Travel/Status/DE/EFA.pm index d79f3d1..56a870d 100644 --- a/lib/Travel/Status/DE/EFA.pm +++ b/lib/Travel/Status/DE/EFA.pm @@ -5,11 +5,10 @@ use warnings; use 5.010; use utf8; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - -our $VERSION = '1.17'; +our $VERSION = '2.00'; use Carp qw(confess cluck); +use DateTime; use Encode qw(encode); use Travel::Status::DE::EFA::Line; use Travel::Status::DE::EFA::Result; @@ -31,11 +30,13 @@ sub new { my @time = @now[ 2, 1 ]; my @date = ( $now[3], $now[4] + 1, $now[5] + 1900 ); - if ( not( $opt{place} and $opt{name} ) ) { - confess('You need to specify a place and a name'); + if ( not( $opt{name} ) ) { + confess('You must specify a name'); } - if ( $opt{type} and not( $opt{type} ~~ [qw[stop address poi]] ) ) { - confess('type must be stop, address or poi'); + if ( $opt{type} + and not( $opt{type} =~ m{ ^ (?: stop stopID address poi ) $ }x ) ) + { + confess('type must be stop, stopID, address, or poi'); } if ( not $opt{efa_url} ) { @@ -93,9 +94,6 @@ sub new { nameState_dm => 'empty', name_dm => encode( 'UTF-8', $opt{name} ), outputFormat => 'XML', - placeInfo_dm => 'invalid', - placeState_dm => 'empty', - place_dm => encode( 'UTF-8', $opt{place} ), ptOptionsActive => '1', requestID => '0', reset => 'neue Anfrage', @@ -103,12 +101,18 @@ sub new { submitButton => 'anfordern', typeInfo_dm => 'invalid', type_dm => $opt{type} // 'stop', - useProxFootSearch => '0', + useProxFootSearch => $opt{proximity_search} ? '1' : '0', useRealtime => '1', }, developer_mode => $opt{developer_mode}, }; + if ( $opt{place} ) { + $self->{post}{placeInfo_dm} = 'invalid'; + $self->{post}{placeState_dm} = 'empty'; + $self->{post}{place_dm} = encode( 'UTF-8', $opt{place} ); + } + if ( $opt{full_routes} ) { $self->{post}->{depType} = 'stopEvents'; $self->{post}->{includeCompleteStopSeq} = 1; @@ -191,33 +195,6 @@ sub place_candidates { return; } -sub sprintf_date { - my ($e) = @_; - - if ( $e->getAttribute('day') == -1 ) { - return; - } - - return sprintf( '%02d.%02d.%d', - $e->getAttribute('day'), - $e->getAttribute('month'), - $e->getAttribute('year'), - ); -} - -sub sprintf_time { - my ($e) = @_; - - if ( $e->getAttribute('minute') == -1 ) { - return; - } - - return sprintf( '%02d:%02d', - $e->getAttribute('hour'), - $e->getAttribute('minute'), - ); -} - sub check_for_ambiguous { my ($self) = @_; @@ -329,7 +306,7 @@ sub lines { my $type = $e_info->getAttribute('name'); my $mot = $e->getAttribute('motType'); my $route = ( $e_route ? $e_route->textContent : undef ); - my $operator = ( $e_oper ? $e_oper->textContent : undef ); + my $operator = ( $e_oper ? $e_oper->textContent : undef ); my $identifier = $e->getAttribute('stateless'); push( @@ -365,17 +342,45 @@ sub parse_route { my @dates = $e->findnodes($xp_routepoint_date); my @times = $e->findnodes($xp_routepoint_time); + my ( $arr, $dep ); + # note that the first stop has an arrival node with an invalid # timestamp and the terminal stop has a departure node with an - # invalid timestamp. sprintf_{date,time} return undef in these - # cases. + # invalid timestamp. + + if ( $dates[0] and $times[0] and $dates[0]->getAttribute('day') != -1 ) + { + $arr = DateTime->new( + year => $dates[0]->getAttribute('year'), + month => $dates[0]->getAttribute('month'), + day => $dates[0]->getAttribute('day'), + hour => $times[0]->getAttribute('hour'), + minute => $times[0]->getAttribute('minute'), + second => $times[0]->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } + + if ( $dates[-1] + and $times[-1] + and $dates[-1]->getAttribute('day') != -1 ) + { + $dep = DateTime->new( + year => $dates[-1]->getAttribute('year'), + month => $dates[-1]->getAttribute('month'), + day => $dates[-1]->getAttribute('day'), + hour => $times[-1]->getAttribute('hour'), + minute => $times[-1]->getAttribute('minute'), + second => $times[-1]->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } + push( @ret, Travel::Status::DE::EFA::Stop->new( - arr_date => sprintf_date( $dates[0] ), - arr_time => sprintf_time( $times[0] ), - dep_date => sprintf_date( $dates[-1] ), - dep_time => sprintf_time( $times[-1] ), + arr => $arr, + dep => $dep, name => $e->getAttribute('name'), name_suf => $e->getAttribute('nameWO'), platform => $e->getAttribute('platformName'), @@ -429,19 +434,43 @@ sub results { next; } - my $date = sprintf_date($e_date); - my $time = sprintf_time($e_time); + my ( $sched_dt, $real_dt ); + + if ( $e_date and $e_time and $e_date->getAttribute('day') != -1 ) { + $sched_dt = DateTime->new( + year => $e_date->getAttribute('year'), + month => $e_date->getAttribute('month'), + day => $e_date->getAttribute('day'), + hour => $e_time->getAttribute('hour'), + minute => $e_time->getAttribute('minute'), + second => $e_time->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } - my $rdate = $e_rdate ? sprintf_date($e_rdate) : $date; - my $rtime = $e_rtime ? sprintf_time($e_rtime) : $time; + if ( $e_rdate and $e_rtime and $e_rdate->getAttribute('day') != -1 ) { + $real_dt = DateTime->new( + year => $e_rdate->getAttribute('year'), + month => $e_rdate->getAttribute('month'), + day => $e_rdate->getAttribute('day'), + hour => $e_rtime->getAttribute('hour'), + minute => $e_rtime->getAttribute('minute'), + second => $e_rtime->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } my $platform = $e->getAttribute('platform'); my $platform_name = $e->getAttribute('platformName'); + my $countdown = $e->getAttribute('countdown'); + my $occupancy = $e->getAttribute('occupancy'); my $line = $e_line->getAttribute('number'); + my $train_type = $e_line->getAttribute('trainType'); + my $train_name = $e_line->getAttribute('trainName'); + my $train_no = $e_line->getAttribute('trainNum'); my $dest = $e_line->getAttribute('direction'); my $info = $e_info->textContent; my $key = $e_line->getAttribute('key'); - my $countdown = $e->getAttribute('countdown'); my $delay = $e_info->getAttribute('delay'); my $type = $e_info->getAttribute('name'); my $mot = $e_line->getAttribute('motType'); @@ -489,24 +518,26 @@ sub results { push( @results, Travel::Status::DE::EFA::Result->new( - date => $rdate, - time => $rtime, - platform => $platform, - platform_db => $platform_is_db, - platform_name => $platform_name, - key => $key, - lineref => $line_obj[0] // undef, - line => $line, - destination => $dest, - countdown => $countdown, - info => $info, - delay => $delay, - sched_date => $date, - sched_time => $time, - type => $type, - mot => $mot, - prev_route => \@prev_route, - next_route => \@next_route, + rt_datetime => $real_dt, + platform => $platform, + platform_db => $platform_is_db, + platform_name => $platform_name, + key => $key, + lineref => $line_obj[0] // undef, + line => $line, + train_type => $train_type, + train_name => $train_name, + train_no => $train_no, + destination => $dest, + occupancy => $occupancy, + countdown => $countdown, + info => $info, + delay => $delay, + sched_datetime => $sched_dt, + type => $type, + mot => $mot, + prev_route => \@prev_route, + next_route => \@next_route, ) ); } @@ -556,39 +587,11 @@ sub get_efa_urls { name => 'Nahverkehrsgesellschaft Baden-Württemberg', shortname => 'NVBW', }, - - # HTTPS not supported - { - url => 'http://efa.svv-info.at/sbs/XSLT_DM_REQUEST', - name => 'Salzburger Verkehrsverbund', - shortname => 'SVV', - }, - - # HTTPS: invalid certificate - { - url => 'http://www.travelineeastmidlands.co.uk/em/XSLT_DM_REQUEST', - name => 'Traveline East Midlands', - shortname => 'TLEM', - }, { url => 'https://efa.vagfr.de/vagfr3/XSLT_DM_REQUEST', name => 'Freiburger Verkehrs AG', shortname => 'VAG', }, - - # HTTPS: unsupported protocol - { - url => 'http://mobil.vbl.ch/vblmobil/XML_DM_REQUEST', - name => 'Verkehrsbetriebe Luzern', - shortname => 'VBL', - }, - - # HTTPS not supported - { - url => 'http://fahrplan.verbundlinie.at/stv/XSLT_DM_REQUEST', - name => 'Verkehrsverbund Steiermark', - shortname => 'Verbundlinie', - }, { url => 'https://efa.vgn.de/vgnExt_oeffi/XML_DM_REQUEST', name => 'Verkehrsverbund Grossraum Nuernberg', @@ -602,15 +605,7 @@ sub get_efa_urls { shortname => 'VMV', }, { - url => 'https://efa.vor.at/wvb/XSLT_DM_REQUEST', - name => 'Verkehrsverbund Ost-Region', - shortname => 'VOR', - encoding => 'iso-8859-15', - }, - - # HTTPS not supported - { - url => 'http://fahrplanauskunft.vrn.de/vrn/XML_DM_REQUEST', + url => 'https://www.vrn.de/mngvrn//XML_DM_REQUEST', name => 'Verkehrsverbund Rhein-Neckar', shortname => 'VRN', }, @@ -624,10 +619,13 @@ sub get_efa_urls { name => 'Verkehrsverbund Rhein-Ruhr (alternative)', shortname => 'VRR2', }, - - # HTTPS not supported { - url => 'http://efa.vvo-online.de:8080/dvb/XSLT_DM_REQUEST', + url => 'https://efa.vrr.de/rbgstd3/XML_DM_REQUEST', + name => 'Verkehrsverbund Rhein-Ruhr (alternative alternative)', + shortname => 'VRR3', + }, + { + url => 'https://efa.vvo-online.de/VMSSL3/XSLT_DM_REQUEST', name => 'Verkehrsverbund Oberelbe', shortname => 'VVO', }, @@ -654,19 +652,20 @@ Travel::Status::DE::EFA - unofficial EFA departure monitor my $status = Travel::Status::DE::EFA->new( efa_url => 'https://efa.vrr.de/vrr/XSLT_DM_REQUEST', - place => 'Essen', name => 'Helenenstr' + name => 'Essen Helenenstr' ); for my $d ($status->results) { printf( "%s %-8s %-5s %s\n", - $d->time, $d->platform_name, $d->line, $d->destination + $d->datetime->strftime('%H:%M'), + $d->platform_name, $d->line, $d->destination ); } =head1 VERSION -version 1.17 +version 2.00 =head1 DESCRIPTION @@ -682,7 +681,7 @@ It reports all upcoming tram/bus/train departures at a given place. =item my $status = Travel::Status::DE::EFA->new(I<%opt>) Requests the departures as specified by I<opts> and returns a new -Travel::Status::DE::EFA object. B<efa_url>, B<place> and B<name> are +Travel::Status::DE::EFA object. B<efa_url> and B<name> are mandatory. Dies if the wrong I<opts> were passed. Arguments: @@ -699,7 +698,7 @@ E<lt>derf+efa@finalrewind.orgE<gt>. Name of the place/city -=item B<type> => B<address>|B<poi>|B<stop> +=item B<type> => B<address>|B<poi>|B<stop>|B<stopID> Type of the following I<name>. B<poi> means "point of interest". Defaults to B<stop> (stop/station name). @@ -720,6 +719,11 @@ If true: Request full routes for all departures from the backend. This enables the B<route_pre>, B<route_post> and B<route_interesting> accessors in Travel::Status::DE::EFA::Result(3pm). +=item B<proximity_search> => B<0>|B<1> + +If true: Show departures for stops in the proximity of the requested place +as well. + =item B<timeout> => I<seconds> Request timeout, the argument is passed on to LWP::UserAgent(3pm). @@ -787,6 +791,8 @@ None. =item * Class::Accessor(3pm) +=item * DateTime(3pm) + =item * LWP::UserAgent(3pm) =item * XML::LibXML(3pm) @@ -803,7 +809,7 @@ efa-m(1), Travel::Status::DE::EFA::Result(3pm). =head1 AUTHOR -Copyright (C) 2011-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/EFA/Line.pm b/lib/Travel/Status/DE/EFA/Line.pm index e5cb3a3..565ca53 100644 --- a/lib/Travel/Status/DE/EFA/Line.pm +++ b/lib/Travel/Status/DE/EFA/Line.pm @@ -6,7 +6,7 @@ use 5.010; use parent 'Class::Accessor'; -our $VERSION = '1.17'; +our $VERSION = '2.00'; Travel::Status::DE::EFA::Line->mk_ro_accessors( qw(direction mot name operator route type valid)); @@ -57,7 +57,7 @@ requested station =head1 VERSION -version 1.17 +version 2.00 =head1 DESCRIPTION @@ -151,7 +151,7 @@ Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2011-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/EFA/Result.pm b/lib/Travel/Status/DE/EFA/Result.pm index b8553d7..ee1eafd 100644 --- a/lib/Travel/Status/DE/EFA/Result.pm +++ b/lib/Travel/Status/DE/EFA/Result.pm @@ -4,15 +4,14 @@ use strict; use warnings; use 5.010; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - use parent 'Class::Accessor'; -our $VERSION = '1.17'; +our $VERSION = '2.00'; Travel::Status::DE::EFA::Result->mk_ro_accessors( - qw(countdown date delay destination is_cancelled info key line lineref - mot platform platform_db platform_name sched_date sched_time time type) + qw(countdown datetime delay destination is_cancelled info key line lineref + mot occupancy operator platform platform_db platform_name rt_datetime + sched_datetime train_type train_name train_no type) ); my @mot_mapping = qw{ @@ -33,6 +32,8 @@ sub new { $ref->{is_cancelled} = 0; } + $ref->{datetime} = $ref->{rt_datetime} // $ref->{sched_datetime}; + return bless( $ref, $obj ); } @@ -128,14 +129,14 @@ departure received by Travel::Status::DE::EFA for my $departure ($status->results) { printf( "At %s: %s to %s from platform %d\n", - $departure->time, $departure->line, $departure->destination, - $departure->platform + $departure->datetime->strftime('%H:%M'), $departure->line, + $departure->destination, $departure->platform ); } =head1 VERSION -version 1.17 +version 2.00 =head1 DESCRIPTION @@ -147,20 +148,19 @@ line number and destination. =head2 ACCESSORS -"Actual" in the description means that the delay (if available) is already -included in the calculation, "Scheduled" means it isn't. - =over =item $departure->countdown -Actual time in minutes from now until the tram/bus/train will depart. +Time in minutes from now until the tram/bus/train will depart, including +realtime data if available. If delay information is available, it is already included. -=item $departure->date +=item $departure->datetime -Actual departure date (DD.MM.YYYY). +DateTime(3pm) object for departure date and time. Realtime data if available, +schedule data otherwise. =item $departure->delay @@ -208,6 +208,14 @@ and 11. Returns the "mode of transport", for instance "zug", "s-bahn", "tram" or "sonstige". +=item $departure->occupancy + +Returns expected occupancy, if available, undef otherwise. + +Occupancy values are passed from the backend as-is. Known values are +"MANY_SEATS" (low occupation), "FEW_SEATS" (high occupation), and +"STANDING_ONLY" (very high occupation). + =item $departure->platform Departure platform number (may not be a number). @@ -228,25 +236,35 @@ object. =item $departure->route_pre -List of stations the train passed (or will have passed) befoe this stop. +List of stations the vehicle passed (or will have passed) before this stop. Each station is a Travel::Status::DE::EFA::Stop(3pm) object. =item $departure->route_post -List of stations the train will pass after this stop. +List of stations the vehicle will pass after this stop. Each station is a Travel::Status::DE::EFA::Stop(3pm) object. -=item $departure->sched_date +=item $departure->rt_datetime + +DateTime(3pm) object holding the departure date and time according to +realtime data. Undef if unknown / unavailable. + +=item $departure->sched_datetime + +DateTime(3pm) object holding the scheduled departure date and time. + +=item $departure->train_type -Scheduled departure date (DD.MM.YYYY). +Train type, e.g. "ICE". Typically only defined for long-distance trains. -=item $departure->sched_time +=item $departure->train_name -Scheduled departure time (HH:MM). +Train name, e.g. "ICE International" or "InterCityExpresS" or "Deichgraf". +Typically only defined for long-distance trains. -=item $departure->time +=item $departure->train_no -Actual departure time (HH:MM). +Train number. Only defined if departure is a train. =item $departure->type @@ -323,7 +341,7 @@ Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2011-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/EFA/Stop.pm b/lib/Travel/Status/DE/EFA/Stop.pm index 566caa8..d313b9c 100644 --- a/lib/Travel/Status/DE/EFA/Stop.pm +++ b/lib/Travel/Status/DE/EFA/Stop.pm @@ -4,14 +4,12 @@ use strict; use warnings; use 5.010; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - use parent 'Class::Accessor'; -our $VERSION = '1.17'; +our $VERSION = '2.00'; Travel::Status::DE::EFA::Stop->mk_ro_accessors( - qw(arr_date arr_time dep_date dep_time name name_suf platform)); + qw(arr dep name name_suf platform)); sub new { my ( $obj, %conf ) = @_; @@ -41,14 +39,15 @@ in a Travel::Status::DE::EFA::Result's route for my $stop ($departure->route_post) { printf( "%s -> %s : %40s %s\n", - $stop->arr_time // q{ }, $stop->dep_time // q{ }, + $stop->arr ? $stop->arr->strftime('%H:%M') : q{--:--}, + $stop->dep ? $stop->dep->strftime('%H:%M') : q{--:--}, $stop->name, $stop->platform ); } =head1 VERSION -version 1.17 +version 2.00 =head1 DESCRIPTION @@ -62,21 +61,15 @@ delays or changed platforms are not taken into account. =over -=item $stop->arr_date - -arrival date (DD.MM.YYYY). undef if this is the first scheduled stop. - -=item $stop->arr_time - -arrival time (HH:MM). undef if this is the first scheduled stop. - -=item $stop->dep_date +=item $stop->arr -departure date (DD.MM.YYYY). undef if this is the final scehduled stop. +DateTime(3pm) object holding arrival date and time. undef if this is the +first scheduled stop. -=item $stop->dep_time +=item $stop->dep -departure time (HH:MM). undef if this is the final scehduled stop. +DateTime(3pm) object holding departure date and time. undef if this is the +final scheduled stop. =item $stop->name @@ -130,7 +123,7 @@ Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2015-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm index 9552e73..e6124bf 100644 --- a/lib/Travel/Status/DE/VRR.pm +++ b/lib/Travel/Status/DE/VRR.pm @@ -4,9 +4,7 @@ use strict; use warnings; use 5.010; -no if $] >= 5.018, warnings => "experimental::smartmatch"; - -our $VERSION = '1.17'; +our $VERSION = '2.00'; use parent 'Travel::Status::DE::EFA'; @@ -37,14 +35,15 @@ Travel::Status::DE::VRR - unofficial VRR departure monitor. for my $d ($status->results) { printf( "%s %d %-5s %s\n", - $d->time, $d->platform, $d->line, $d->destination + $d->datetime->strftime('%H:%M'), + $d->platform, $d->line, $d->destination ); } =head1 VERSION -version 1.17 +version 2.00 =head1 DESCRIPTION @@ -96,7 +95,7 @@ efa-m(1), Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2013-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2013-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE |