summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorBirte Kristina Friesel <derf@finalrewind.org>2024-09-22 13:19:14 +0200
committerBirte Kristina Friesel <derf@finalrewind.org>2024-09-22 13:19:14 +0200
commitc438b3c4e210a4480652f297f1bf9510cdf44244 (patch)
tree2b2445ecba473799c3ebed1f7b8b1210084f29bc /lib
parentb8bdca3c045787ad546234fff0cf5801dbe1cd92 (diff)
Switch from XML to JSON API flavour
Diffstat (limited to 'lib')
-rw-r--r--lib/Travel/Status/DE/EFA.pm608
-rw-r--r--lib/Travel/Status/DE/EFA/Departure.pm (renamed from lib/Travel/Status/DE/EFA/Result.pm)41
-rw-r--r--lib/Travel/Status/DE/EFA/Line.pm2
3 files changed, 236 insertions, 415 deletions
diff --git a/lib/Travel/Status/DE/EFA.pm b/lib/Travel/Status/DE/EFA.pm
index ca207d5..eb104b3 100644
--- a/lib/Travel/Status/DE/EFA.pm
+++ b/lib/Travel/Status/DE/EFA.pm
@@ -9,75 +9,78 @@ our $VERSION = '2.02';
use Carp qw(confess cluck);
use DateTime;
+use DateTime::Format::Strptime;
use Encode qw(encode);
+use JSON;
use Travel::Status::DE::EFA::Line;
-use Travel::Status::DE::EFA::Result;
+use Travel::Status::DE::EFA::Departure;
use Travel::Status::DE::EFA::Stop;
use LWP::UserAgent;
-use XML::LibXML;
my %efa_instance = (
BSVG => {
- url => 'https://bsvg.efa.de/bsvagstd/XML_DM_REQUEST',
+ url => 'https://bsvg.efa.de/bsvagstd',
name => 'Braunschweiger Verkehrs-GmbH',
},
DING => {
- url => 'https://www.ding.eu/ding3/XSLT_DM_REQUEST',
+ url => 'https://www.ding.eu/ding3',
+ stopseq =>
+'https://www.ding.eu/ding3/XML_STOPSEQCOORD_REQUEST?=&jsonp=jsonpFn5&line=din:87002: :R:j24&stop=9001008&tripCode=290&date=20240520&time=14.0041.00&coordOutputFormat=WGS84[DD.DDDDD]&coordListOutputFormat=string&outputFormat=json&tStOTType=NEXT&hideBannerInfo=1',
name => 'Donau-Iller Nahverkehrsverbund',
},
KVV => {
- url => 'https://projekte.kvv-efa.de/sl3-alone/XSLT_DM_REQUEST',
+ url => 'https://projekte.kvv-efa.de/sl3-alone',
name => 'Karlsruher Verkehrsverbund',
},
LinzAG => {
- url => 'https://www.linzag.at/static/XSLT_DM_REQUEST',
+ url => 'https://www.linzag.at/static',
name => 'Linz AG',
encoding => 'iso-8859-15',
},
MVV => {
- url => 'https://efa.mvv-muenchen.de/mobile/XSLT_DM_REQUEST',
+ url => 'https://efa.mvv-muenchen.de/mobile',
name => 'Münchner Verkehrs- und Tarifverbund',
},
NVBW => {
- url => 'https://www.efa-bw.de/nvbw/XSLT_DM_REQUEST',
+ url => 'https://www.efa-bw.de/nvbw',
name => 'Nahverkehrsgesellschaft Baden-Württemberg',
},
VAG => {
- url => 'https://efa.vagfr.de/vagfr3/XSLT_DM_REQUEST',
+ url => 'https://efa.vagfr.de/vagfr3',
name => 'Freiburger Verkehrs AG',
},
VGN => {
- url => 'https://efa.vgn.de/vgnExt_oeffi/XML_DM_REQUEST',
+ url => 'https://efa.vgn.de/vgnExt_oeffi',
name => 'Verkehrsverbund Grossraum Nuernberg',
},
# HTTPS: certificate verification fails
VMV => {
- url => 'http://efa.vmv-mbh.de/vmv/XML_DM_REQUEST',
+ url => 'http://efa.vmv-mbh.de/vmv',
name => 'Verkehrsgesellschaft Mecklenburg-Vorpommern',
},
VRN => {
- url => 'https://www.vrn.de/mngvrn//XML_DM_REQUEST',
+ url => 'https://www.vrn.de/mngvrn/',
name => 'Verkehrsverbund Rhein-Neckar',
},
VRR => {
- url => 'https://efa.vrr.de/vrr/XSLT_DM_REQUEST',
+ url => 'https://efa.vrr.de/vrr',
name => 'Verkehrsverbund Rhein-Ruhr',
},
VRR2 => {
- url => 'https://app.vrr.de/standard/XML_DM_REQUEST',
+ url => 'https://app.vrr.de/standard',
name => 'Verkehrsverbund Rhein-Ruhr (alternative)',
},
VRR3 => {
- url => 'https://efa.vrr.de/rbgstd3/XML_DM_REQUEST',
+ url => 'https://efa.vrr.de/rbgstd3',
name => 'Verkehrsverbund Rhein-Ruhr (alternative alternative)',
},
VVO => {
- url => 'https://efa.vvo-online.de/VMSSL3/XSLT_DM_REQUEST',
+ url => 'https://efa.vvo-online.de/VMSSL3',
name => 'Verkehrsverbund Oberelbe',
},
VVS => {
- url => 'https://www2.vvs.de/vvs/XSLT_DM_REQUEST',
+ url => 'https://www2.vvs.de/vvs',
name => 'Verkehrsverbund Stuttgart',
},
@@ -107,26 +110,10 @@ sub new_p {
}
my $content = $tx->res->body;
- if ( $opt{efa_encoding} ) {
- $self->{xml} = encode( $opt{efa_encoding}, $content );
- }
- else {
- $self->{xml} = $content;
- }
-
- if ( not $self->{xml} ) {
-
- # LibXML doesn't like empty documents
- $promise->reject('Server returned nothing (empty result)');
- return;
- }
-
- $self->{tree} = XML::LibXML->load_xml(
- string => $self->{xml},
- );
+ $self->{response} = $self->{json}->decode($content);
if ( $self->{developer_mode} ) {
- say $self->{tree}->toString(1);
+ say $self->{json}->pretty->encode( $self->{response} );
}
$self->check_for_ambiguous();
@@ -158,7 +145,7 @@ sub new {
delete $opt{timeout};
}
- if ( not( $opt{name} ) ) {
+ if ( not( $opt{name} or $opt{from_json} ) ) {
confess('You must specify a name');
}
if ( $opt{type}
@@ -169,6 +156,12 @@ sub new {
if ( $opt{service} and exists $efa_instance{ $opt{service} } ) {
$opt{efa_url} = $efa_instance{ $opt{service} }{url};
+ if ( $opt{journey} ) {
+ $opt{efa_url} .= '/XML_STOPSEQCOORD_REQUEST';
+ }
+ else {
+ $opt{efa_url} .= '/XML_DM_REQUEST';
+ }
$opt{time_zone} //= $efa_instance{ $opt{service} }{time_zone};
}
@@ -219,39 +212,33 @@ sub new {
my $self = {
post => {
- command => q{},
- deleteAssignedStops_dm => '1',
- help => 'Hilfe',
- itdDateDay => $dt->day,
- itdDateMonth => $dt->month,
- itdDateYear => $dt->year,
- itdLPxx_id_dm => ':dm',
- itdLPxx_mapState_dm => q{},
- itdLPxx_mdvMap2_dm => q{},
- itdLPxx_mdvMap_dm => '3406199:401077:NAV3',
- itdLPxx_transpCompany => 'vrr',
- itdLPxx_view => q{},
- itdTimeHour => $dt->hour,
- itdTimeMinute => $dt->minute,
- language => 'de',
- mode => 'direct',
- nameInfo_dm => 'invalid',
- nameState_dm => 'empty',
- name_dm => encode( 'UTF-8', $opt{name} ),
- outputFormat => 'XML',
- ptOptionsActive => '1',
- requestID => '0',
- reset => 'neue Anfrage',
- sessionID => '0',
- submitButton => 'anfordern',
- typeInfo_dm => 'invalid',
- type_dm => $opt{type} // 'stop',
- useProxFootSearch => $opt{proximity_search} ? '1' : '0',
- useRealtime => '1',
+ language => 'de',
+ mode => 'direct',
+ outputFormat => 'JSON',
+ type_dm => $opt{type} // 'stop',
+ useProxFootSearch => $opt{proximity_search} ? '1' : '0',
+ useRealtime => '1',
+ itdDateDay => $dt->day,
+ itdDateMonth => $dt->month,
+ itdDateYear => $dt->year,
+ itdTimeHour => $dt->hour,
+ itdTimeMinute => $dt->minute,
+ name_dm => encode( 'UTF-8', $opt{name} ),
},
+ response => $opt{from_json},
developer_mode => $opt{developer_mode},
efa_url => $opt{efa_url},
service => $opt{service},
+ strp_stopseq => DateTime::Format::Strptime->new(
+ pattern => '%Y%m%d %H:%M',
+ time_zone => 'Europe/Berlin',
+ ),
+ strp_stopseq_s => DateTime::Format::Strptime->new(
+ pattern => '%Y%m%d %H:%M:%S',
+ time_zone => 'Europe/Berlin',
+ ),
+
+ json => JSON->new->utf8,
};
if ( $opt{place} ) {
@@ -281,33 +268,26 @@ sub new {
return $self;
}
- my $response = $self->{ua}->post( $self->{efa_url}, $self->{post} );
-
- if ( $response->is_error ) {
- $self->{errstr} = $response->status_line;
- return $self;
+ if ( $self->{developer_mode} ) {
+ say 'POST ' . $self->{efa_url};
+ while ( my ( $key, $value ) = each %{ $self->{post} } ) {
+ printf( "%30s = %s\n", $key, $value );
+ }
}
- if ( $opt{efa_encoding} ) {
- $self->{xml} = encode( $opt{efa_encoding}, $response->content );
- }
- else {
- $self->{xml} = $response->decoded_content;
- }
+ if ( not $self->{response} ) {
+ my $response = $self->{ua}->post( $self->{efa_url}, $self->{post} );
- if ( not $self->{xml} ) {
+ if ( $response->is_error ) {
+ $self->{errstr} = $response->status_line;
+ return $self;
+ }
- # LibXML doesn't like empty documents
- $self->{errstr} = 'Server returned nothing (empty result)';
- return $self;
+ $self->{response} = $self->{json}->decode( $response->content );
}
- $self->{tree} = XML::LibXML->load_xml(
- string => $self->{xml},
- );
-
if ( $self->{developer_mode} ) {
- say $self->{tree}->toString(1);
+ say $self->{json}->pretty->encode( $self->{response} );
}
$self->check_for_ambiguous();
@@ -315,20 +295,6 @@ sub new {
return $self;
}
-sub new_from_xml {
- my ( $class, %opt ) = @_;
-
- my $self = {
- xml => $opt{xml},
- };
-
- $self->{tree} = XML::LibXML->load_xml(
- string => $self->{xml},
- );
-
- return bless( $self, $class );
-}
-
sub errstr {
my ($self) = @_;
@@ -356,182 +322,98 @@ sub place_candidates {
sub check_for_ambiguous {
my ($self) = @_;
- my $xml = $self->{tree};
+ my $json = $self->{response};
- my $xp_place = XML::LibXML::XPathExpression->new('//itdOdv/itdOdvPlace');
- my $xp_name = XML::LibXML::XPathExpression->new('//itdOdv/itdOdvName');
- my $xp_mesg
- = XML::LibXML::XPathExpression->new('//itdMessage[@type="error"]');
-
- my $xp_place_elem = XML::LibXML::XPathExpression->new('./odvPlaceElem');
- my $xp_name_elem = XML::LibXML::XPathExpression->new('./odvNameElem');
-
- my $e_place = ( $xml->findnodes($xp_place) )[0];
- my $e_name = ( $xml->findnodes($xp_name) )[0];
- my @e_mesg = $xml->findnodes($xp_mesg);
-
- if ( not( $e_place and $e_name ) ) {
-
- # this should not happen[tm]
- cluck('skipping ambiguity check- itdOdvPlace/itdOdvName missing');
- return;
- }
-
- my $s_place = $e_place->getAttribute('state');
- my $s_name = $e_name->getAttribute('state');
-
- if ( $s_place eq 'list' ) {
- $self->{place_candidates} = [ map { $_->textContent }
- @{ $e_place->findnodes($xp_place_elem) } ];
- $self->{errstr} = 'ambiguous place parameter';
+ if ( $json->{departureList} ) {
return;
}
- if ( $s_name eq 'list' ) {
- $self->{name_candidates}
- = [ map { $_->textContent } @{ $e_name->findnodes($xp_name_elem) } ];
- $self->{errstr} = 'ambiguous name parameter';
- return;
- }
- if ( $s_place eq 'notidentified' ) {
- $self->{errstr} = 'invalid place parameter';
- return;
- }
- if ( $s_name eq 'notidentified' ) {
- $self->{errstr} = 'invalid name parameter';
- return;
- }
- if (@e_mesg) {
- $self->{errstr} = join( q{; }, map { $_->textContent } @e_mesg );
- return;
+ for my $m ( @{ $json->{dm}{message} // [] } ) {
+ if ( $m->{name} eq 'error' and $m->{value} eq 'name list' ) {
+ $self->{errstr} = "ambiguous name parameter";
+ $self->{name_candidates}
+ = [ map { $_->{name} } @{ $json->{dm}{points} // [] } ];
+ return;
+ }
+ if ( $m->{name} eq 'error' and $m->{value} eq 'place list' ) {
+ $self->{errstr} = "ambiguous name parameter";
+ $self->{name_candidates}
+ = [ map { $_->{name} } @{ $json->{dm}{points} // [] } ];
+ return;
+ }
}
return;
}
-sub identified_data {
- my ($self) = @_;
-
- if ( not $self->{tree} ) {
- return;
- }
-
- my $xp_place
- = XML::LibXML::XPathExpression->new('//itdOdv/itdOdvPlace/odvPlaceElem');
- my $xp_name
- = XML::LibXML::XPathExpression->new('//itdOdv/itdOdvName/odvNameElem');
-
- my $e_place = ( $self->{tree}->findnodes($xp_place) )[0];
- my $e_name = ( $self->{tree}->findnodes($xp_name) )[0];
-
- return ( $e_place->textContent, $e_name->textContent );
-}
-
sub lines {
my ($self) = @_;
- my @lines;
if ( $self->{lines} ) {
return @{ $self->{lines} };
}
- if ( not $self->{tree} ) {
- return;
- }
-
- my $xp_element
- = XML::LibXML::XPathExpression->new('//itdServingLines/itdServingLine');
-
- my $xp_info = XML::LibXML::XPathExpression->new('./itdNoTrain');
- my $xp_route = XML::LibXML::XPathExpression->new('./itdRouteDescText');
- my $xp_oper = XML::LibXML::XPathExpression->new('./itdOperator/name');
-
- for my $e ( $self->{tree}->findnodes($xp_element) ) {
-
- my $e_info = ( $e->findnodes($xp_info) )[0];
- my $e_route = ( $e->findnodes($xp_route) )[0];
- my $e_oper = ( $e->findnodes($xp_oper) )[0];
-
- if ( not($e_info) ) {
- cluck( 'node with insufficient data. This should not happen. '
- . $e->getAttribute('number') );
- next;
- }
-
- my $line = $e->getAttribute('number');
- my $direction = $e->getAttribute('direction');
- my $valid = $e->getAttribute('valid');
- 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 $identifier = $e->getAttribute('stateless');
-
- push(
- @lines,
- Travel::Status::DE::EFA::Line->new(
- name => $line,
- direction => $direction,
- valid => $valid,
- type => $type,
- mot => $mot,
- route => $route,
- operator => $operator,
- identifier => $identifier,
- )
- );
+ for my $line ( @{ $self->{response}{servingLines}{lines} // [] } ) {
+ push( @{ $self->{lines} }, $self->parse_line($line) );
}
- $self->{lines} = \@lines;
+ return @{ $self->{lines} // [] };
+}
- return @lines;
+sub parse_line {
+ my ( $self, $line ) = @_;
+
+ my $mode = $line->{mode} // {};
+
+ return Travel::Status::DE::EFA::Line->new(
+ type => $mode->{product},
+ name => $mode->{name},
+ number => $mode->{number},
+ direction => $mode->{destination},
+ valid => $mode->{timetablePeriod},
+ mot => $mode->{product},
+ operator => $mode->{diva}{operator},
+ identifier => $mode->{diva}{globalId},
+ ,
+ );
}
sub parse_route {
- my ( $self, @nodes ) = @_;
- my $xp_routepoint_date
- = XML::LibXML::XPathExpression->new('./itdDateTime/itdDate');
- my $xp_routepoint_time
- = XML::LibXML::XPathExpression->new('./itdDateTime/itdTime');
-
+ my ( $self, $stop_seq, $requested_id ) = @_;
my @ret;
- for my $e (@nodes) {
- my @dates = $e->findnodes($xp_routepoint_date);
- my @times = $e->findnodes($xp_routepoint_time);
+ if ( not $stop_seq ) {
+ return \@ret;
+ }
+
+ # Oh EFA, you so silly
+ if ( ref($stop_seq) eq 'HASH' ) {
+ # For lines that start or terminate at the requested stop, onwardStopSeq / prevStopSeq includes the requested stop.
+ if ( $stop_seq->{ref}{id} eq $requested_id ) {
+ return \@ret;
+ }
+ $stop_seq = [$stop_seq];
+ }
+
+ for my $stop ( @{ $stop_seq // [] } ) {
+ my $ref = $stop->{ref};
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.
-
- 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 ( $ref->{arrDateTimeSec} ) {
+ $arr = $self->{strp_stopseq_s}
+ ->parse_datetime( $ref->{arrDateTimeSec} );
+ }
+ elsif ( $ref->{arrDateTime} ) {
+ $arr = $self->{strp_stopseq}->parse_datetime( $ref->{arrDateTime} );
}
- 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'
- );
+ if ( $ref->{depDateTimeSec} ) {
+ $dep = $self->{strp_stopseq_s}
+ ->parse_datetime( $ref->{depDateTimeSec} );
+ }
+ elsif ( $ref->{depDateTime} ) {
+ $dep = $self->{strp_stopseq}->parse_datetime( $ref->{depDateTime} );
}
push(
@@ -539,14 +421,79 @@ sub parse_route {
Travel::Status::DE::EFA::Stop->new(
arr => $arr,
dep => $dep,
- name => $e->getAttribute('name'),
- name_suf => $e->getAttribute('nameWO'),
- platform => $e->getAttribute('platformName'),
+ name => $stop->{name},
+ name_suf => $stop->{nameWO},
+ platform => $ref->{platform} || $stop->{platformName} || undef,
)
);
}
- return @ret;
+ return \@ret;
+}
+
+sub parse_departure {
+ my ( $self, $departure ) = @_;
+
+ my ( $sched_dt, $real_dt );
+ my ( $prev_route, $next_route );
+
+ if ( my $dt = $departure->{dateTime} ) {
+ $sched_dt = DateTime->new(
+ year => $dt->{year},
+ month => $dt->{month},
+ day => $dt->{day},
+ hour => $dt->{hour},
+ minute => $dt->{minute},
+ second => $dt->{second} // 0,
+ time_zone => 'Europe/Berlin',
+ );
+ }
+
+ if ( my $dt = $departure->{realDateTime} ) {
+ $real_dt = DateTime->new(
+ year => $dt->{year},
+ month => $dt->{month},
+ day => $dt->{day},
+ hour => $dt->{hour},
+ minute => $dt->{minute},
+ second => $dt->{second} // 0,
+ time_zone => 'Europe/Berlin',
+ );
+ }
+
+ if ( $departure->{prevStopSeq} ) {
+ $prev_route = $self->parse_route( $departure->{prevStopSeq},
+ $departure->{stopID} );
+ }
+ if ( $departure->{onwardStopSeq} ) {
+ $next_route = $self->parse_route( $departure->{onwardStopSeq},
+ $departure->{stopID} );
+ }
+
+ my @hints
+ = map { $_->{content} } @{ $departure->{servingLine}{hints} // [] };
+
+ return Travel::Status::DE::EFA::Departure->new(
+ rt_datetime => $real_dt,
+ platform => $departure->{platform},
+ platform_name => $departure->{platformName},
+ platform_type => $departure->{pointType},
+ line => $departure->{servingLine}{symbol},
+ train_type => $departure->{servingLine}{trainType},
+ train_name => $departure->{servingLine}{trainName},
+ train_no => $departure->{servingLine}{trainNum},
+ origin => $departure->{servingLine}{directionFrom},
+ destination => $departure->{servingLine}{direction},
+ occupancy => $departure->{occupancy},
+ countdown => $departure->{countdown},
+ delay => $departure->{servingLine}{delay},
+ sched_datetime => $sched_dt,
+ type => $departure->{servingLine}{name},
+ mot => $departure->{servingLine}{motType},
+ hints => \@hints,
+ prev_route => $prev_route,
+ next_route => $next_route,
+ );
}
sub results {
@@ -557,147 +504,10 @@ sub results {
return @{ $self->{results} };
}
- if ( not $self->{tree} ) {
- return;
- }
-
- my $xp_element = XML::LibXML::XPathExpression->new('//itdDeparture');
-
- my $xp_date = XML::LibXML::XPathExpression->new('./itdDateTime/itdDate');
- my $xp_time = XML::LibXML::XPathExpression->new('./itdDateTime/itdTime');
- my $xp_rdate = XML::LibXML::XPathExpression->new('./itdRTDateTime/itdDate');
- my $xp_rtime = XML::LibXML::XPathExpression->new('./itdRTDateTime/itdTime');
- my $xp_line = XML::LibXML::XPathExpression->new('./itdServingLine');
- my $xp_info
- = XML::LibXML::XPathExpression->new('./itdServingLine/itdNoTrain');
- my $xp_prev_route
- = XML::LibXML::XPathExpression->new('./itdPrevStopSeq/itdPoint');
- my $xp_next_route
- = XML::LibXML::XPathExpression->new('./itdOnwardStopSeq/itdPoint');
-
- $self->lines;
-
- for my $e ( $self->{tree}->findnodes($xp_element) ) {
-
- my $e_date = ( $e->findnodes($xp_date) )[0];
- my $e_time = ( $e->findnodes($xp_time) )[0];
- my $e_line = ( $e->findnodes($xp_line) )[0];
- my $e_info = ( $e->findnodes($xp_info) )[0];
-
- my $e_rdate = ( $e->findnodes($xp_rdate) )[0];
- my $e_rtime = ( $e->findnodes($xp_rtime) )[0];
-
- if ( not( $e_date and $e_time and $e_line ) ) {
- cluck('node with insufficient data. This should not happen');
- next;
- }
-
- 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'
- );
- }
-
- 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 $delay = $e_info->getAttribute('delay');
- my $type = $e_info->getAttribute('name');
- my $mot = $e_line->getAttribute('motType');
-
- my $platform_is_db = 0;
-
- my @prev_route;
- my @next_route;
-
- if ( $self->{want_full_routes} ) {
- @prev_route
- = $self->parse_route( @{ [ $e->findnodes($xp_prev_route) ] } );
- @next_route
- = $self->parse_route( @{ [ $e->findnodes($xp_next_route) ] } );
- }
+ my $json = $self->{response};
- my @line_obj
- = grep { $_->{identifier} eq $e_line->getAttribute('stateless') }
- @{ $self->{lines} };
-
- # platform / platformName are inconsistent. The following cases are
- # known:
- #
- # * platform="int", platformName="" : non-DB platform
- # * platform="int", platformName="Bstg. int" : non-DB platform
- # * platform="#int", platformName="Gleis int" : non-DB platform
- # * platform="#int", platformName="Gleis int" : DB platform?
- # * platform="", platformName="Gleis int" : DB platform
- # * platform="DB", platformName="Gleis int" : DB platform
- # * platform="gibberish", platformName="Gleis int" : DB platform
-
- if ( ( $platform_name and $platform_name =~ m{ ^ Gleis }ox )
- and not( $platform and $platform =~ s{ ^ \# }{}ox ) )
- {
- $platform_is_db = 1;
- }
-
- if ( $platform_name and $platform_name =~ m{ ^ (Gleis | Bstg[.])}ox ) {
- $platform = ( split( / /, $platform_name ) )[1];
- }
- elsif ( $platform_name and not $platform ) {
- $platform = $platform_name;
- }
-
- push(
- @results,
- Travel::Status::DE::EFA::Result->new(
- 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,
- )
- );
+ for my $departure ( @{ $json->{departureList} // [] } ) {
+ push( @results, $self->parse_departure($departure) );
}
@results = map { $_->[0] }
@@ -734,7 +544,7 @@ Travel::Status::DE::EFA - unofficial EFA departure monitor
use Travel::Status::DE::EFA;
my $status = Travel::Status::DE::EFA->new(
- efa_url => 'https://efa.vrr.de/vrr/XSLT_DM_REQUEST',
+ efa_url => 'https://efa.vrr.de/vrr/XML_DM_REQUEST',
name => 'Essen Helenenstr'
);
@@ -805,7 +615,7 @@ iso-8859-15.
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).
+Travel::Status::DE::EFA::Departure(3pm).
=item B<proximity_search> => B<0>|B<1>
@@ -867,7 +677,7 @@ nothing (undef / empty list) otherwise.
=item $status->results
-Returns a list of Travel::Status::DE::EFA::Result(3pm) objects, each one describing
+Returns a list of Travel::Status::DE::EFA::Departure(3pm) objects, each one describing
one departure.
=item Travel::Status::DE::EFA::get_efa_urls()
@@ -906,23 +716,25 @@ None.
=item * DateTime(3pm)
-=item * LWP::UserAgent(3pm)
+=item * DateTime::Format::Strptime(3pm)
+
+=item * JSON(3pm)
-=item * XML::LibXML(3pm)
+=item * LWP::UserAgent(3pm)
=back
=head1 BUGS AND LIMITATIONS
-Not all features of the web interface are supported.
+The API is not exposed completely.
=head1 SEE ALSO
-efa-m(1), Travel::Status::DE::EFA::Result(3pm).
+efa-m(1), Travel::Status::DE::EFA::Departure(3pm).
=head1 AUTHOR
-Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2011-2024 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/Departure.pm
index 11ff15a..802f84e 100644
--- a/lib/Travel/Status/DE/EFA/Result.pm
+++ b/lib/Travel/Status/DE/EFA/Departure.pm
@@ -1,4 +1,4 @@
-package Travel::Status::DE::EFA::Result;
+package Travel::Status::DE::EFA::Departure;
use strict;
use warnings;
@@ -8,10 +8,10 @@ use parent 'Class::Accessor';
our $VERSION = '2.02';
-Travel::Status::DE::EFA::Result->mk_ro_accessors(
- 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)
+Travel::Status::DE::EFA::Departure->mk_ro_accessors(
+ qw(countdown datetime delay destination is_cancelled key line lineref
+ mot occupancy operator origin platform platform_db platform_name
+ rt_datetime sched_datetime train_type train_name train_no type)
);
my @mot_mapping = qw{
@@ -37,6 +37,12 @@ sub new {
return bless( $ref, $obj );
}
+sub hints {
+ my ($self) = @_;
+
+ return @{ $self->{hints} // [] };
+}
+
sub mot_name {
my ($self) = @_;
@@ -46,13 +52,13 @@ sub mot_name {
sub route_pre {
my ($self) = @_;
- return @{ $self->{prev_route} };
+ return @{ $self->{prev_route} // [] };
}
sub route_post {
my ($self) = @_;
- return @{ $self->{next_route} };
+ return @{ $self->{next_route} // [] };
}
sub route_interesting {
@@ -121,7 +127,7 @@ __END__
=head1 NAME
-Travel::Status::DE::EFA::Result - Information about a single
+Travel::Status::DE::EFA::Departure - Information about a single
departure received by Travel::Status::DE::EFA
=head1 SYNOPSIS
@@ -140,7 +146,7 @@ version 2.02
=head1 DESCRIPTION
-Travel::Status::DE::EFA::Result describes a single departure as obtained by
+Travel::Status::DE::EFA::Departure describes a single departure as obtained by
Travel::Status::DE::EFA. It contains information about the time, platform,
line number and destination.
@@ -171,12 +177,11 @@ indicates departure on time. undef when no realtime information is available.
Destination name.
-=item $departure->info
+=item $departure->hints
-Additional information related to the departure (string). If departures for
-an address were requested, this is the stop name, otherwise it may be recent
-news related to the line's schedule. If no information is available, returns
-an empty string.
+Additional information related to the departure (list of strings). If
+departures for an address were requested, this is the stop name, otherwise it
+may be recent news related to the line's schedule.
=item $departure->is_cancelled
@@ -216,6 +221,10 @@ Occupancy values are passed from the backend as-is. Known values are
"MANY_SEATS" (low occupation), "FEW_SEATS" (high occupation),
"STANDING_ONLY" (very high occupation), and "FULL" (boarding not advised).
+=item $departure->origin
+
+Origin name.
+
=item $departure->platform
Departure platform number (may not be a number).
@@ -277,9 +286,9 @@ field. See L</DEPARTURE TYPES>.
=over
-=item $departure = Travel::Status::DE::EFA::Result->new(I<%data>)
+=item $departure = Travel::Status::DE::EFA::Departure->new(I<%data>)
-Returns a new Travel::Status::DE::EFA::Result object. You should not need to
+Returns a new Travel::Status::DE::EFA::Departure object. You should not need to
call this.
=item $departure->TO_JSON
diff --git a/lib/Travel/Status/DE/EFA/Line.pm b/lib/Travel/Status/DE/EFA/Line.pm
index 69526fd..4f44c7b 100644
--- a/lib/Travel/Status/DE/EFA/Line.pm
+++ b/lib/Travel/Status/DE/EFA/Line.pm
@@ -9,7 +9,7 @@ use parent 'Class::Accessor';
our $VERSION = '2.02';
Travel::Status::DE::EFA::Line->mk_ro_accessors(
- qw(direction mot name operator route type valid));
+ qw(direction mot name number operator route type valid));
my @mot_mapping = qw{
zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus