diff options
| -rw-r--r-- | lib/Travel/Status/DE/IRIS.pm | 74 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/IRIS/Result.pm | 67 |
2 files changed, 127 insertions, 14 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm index 16883a4..223a3c9 100644 --- a/lib/Travel/Status/DE/IRIS.pm +++ b/lib/Travel/Status/DE/IRIS.pm @@ -11,6 +11,7 @@ our $VERSION = '0.00'; use Carp qw(confess cluck); use DateTime; use Encode qw(encode decode); +use List::Util qw(first); use LWP::UserAgent; use Travel::Status::DE::IRIS::Result; use XML::LibXML; @@ -56,6 +57,8 @@ sub new { @{ $self->{results} } = sort { $a->{datetime} <=> $b->{datetime} } @{ $self->{results} }; + $self->get_realtime; + return $self; } @@ -75,6 +78,8 @@ sub get_timetable { my $xml = XML::LibXML->load_xml( string => $res->decoded_content ); + #say $xml->toString(1); + my $station = ( $xml->findnodes('/timetable') )[0]->getAttribute('station'); for my $s ( $xml->findnodes('/timetable/s') ) { @@ -112,10 +117,71 @@ sub get_timetable { $data{departure_wings} = $e_dp->getAttribute('wings'); } - push( - @{ $self->{results} }, - Travel::Status::DE::IRIS::Result->new(%data) - ); + # if scheduled departure and current departure are not within the + # same hour, trains are reported twice. Don't add duplicates in + # that case. + if ( not first { $_->raw_id eq $id } @{ $self->{results} } ) { + push( + @{ $self->{results} }, + Travel::Status::DE::IRIS::Result->new(%data) + ); + } + } + + return $self; +} + +sub get_realtime { + my ($self) = @_; + + my $eva = $self->{nodes}{station}->getAttribute('eva'); + my $res = $self->{user_agent} + ->get("http://iris.noncd.db.de/iris-tts/timetable/fchg/${eva}"); + + if ( $res->is_error ) { + $self->{errstr} = $res->status_line; + return $self; + } + + my $xml = XML::LibXML->load_xml( string => $res->decoded_content ); + + for my $s ( $xml->findnodes('/timetable/s') ) { + my $id = $s->getAttribute('id'); + my $e_tl = ( $s->findnodes('./tl') )[0]; + my $e_ar = ( $s->findnodes('./ar') )[0]; + my $e_dp = ( $s->findnodes('./dp') )[0]; + + my $result = first { $_->raw_id eq $id } $self->results; + + if ( not $result ) { + next; + } + + if ($e_tl) { + $result->add_tl( + class => $e_tl->getAttribute('f'), # D N S F + unknown_t => $e_tl->getAttribute('t'), # p + train_no => $e_tl->getAttribute('n'), # dep number + type => $e_tl->getAttribute('c'), # S/ICE/ERB/... + line_no => $e_tl->getAttribute('l'), # 1 -> S1, ... + unknown_o => $e_tl->getAttribute('o'), # owner: 03/80/R2/... + ); + } + if ($e_ar) { + $result->add_ar( + arrival_ts => $e_ar->getAttribute('ct'), + platform => $e_ar->getAttribute('cp'), + route_pre => $e_ar->getAttribute('cpth'), + ); + } + if ($e_dp) { + $result->add_dp( + departure_ts => $e_dp->getAttribute('ct'), + platform => $e_dp->getAttribute('cp'), + route_pre => $e_dp->getAttribute('cpth'), + ); + } + } return $self; diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm index fbb519a..b87cdf5 100644 --- a/lib/Travel/Status/DE/IRIS/Result.pm +++ b/lib/Travel/Status/DE/IRIS/Result.pm @@ -14,8 +14,9 @@ use DateTime::Format::Strptime; our $VERSION = '0.00'; Travel::Status::DE::IRIS::Result->mk_ro_accessors( - qw(arrival date datetime departure line_no raw_id + qw(arrival date datetime delay departure line_no raw_id route_start route_end + sched_arrival sched_departure start stop_no time train_id train_no type unknown_t unknown_o) ); @@ -36,8 +37,10 @@ sub new { $ref->{train_id} = $train_id; $ref->{stop_no} = $stop_no; - my $ar = $ref->{arrival} = $strp->parse_datetime( $opt{arrival_ts} ); - my $dp = $ref->{departure} = $strp->parse_datetime( $opt{departure_ts} ); + my $ar = $ref->{arrival} = $ref->{sched_arrival} + = $strp->parse_datetime( $opt{arrival_ts} ); + my $dp = $ref->{departure} = $ref->{sched_departure} + = $strp->parse_datetime( $opt{departure_ts} ); if ( not( $ar or $dp ) ) { cluck( @@ -54,15 +57,59 @@ sub new { $ref->{date} = $dt->strftime('%d.%m.%Y'); $ref->{time} = $dt->strftime('%H:%M'); - $ref->{route_pre} = [ split( qr{\|}, $ref->{route_pre} // q{} ) ]; - $ref->{route_post} = [ split( qr{\|}, $ref->{route_post} // q{} ) ]; + $ref->{route_pre} = $ref->{sched_route_pre} + = [ split( qr{\|}, $ref->{route_pre} // q{} ) ]; + $ref->{route_post} = $ref->{sched_route_post} + = [ split( qr{\|}, $ref->{route_post} // q{} ) ]; - $ref->{route_end} = $ref->{route_post}[-1] || $ref->{station}; - $ref->{route_start} = $ref->{route_pre}[0] || $ref->{station}; + $ref->{route_end} = $ref->{sched_route_end} = $ref->{route_post}[-1] + || $ref->{station}; + $ref->{route_start} = $ref->{sched_route_start} = $ref->{route_pre}[0] + || $ref->{station}; return bless( $ref, $obj ); } +sub add_ar { + my ( $self, %attrib ) = @_; + + my $strp = DateTime::Format::Strptime->new( + pattern => '%y%m%d%H%M', + time_zone => 'Europe/Berlin', + ); + + if ( $attrib{arrival_ts} ) { + $self->{arrival} = $strp->parse_datetime( $attrib{arrival_ts} ); + $self->{delay} + = $self->arrival->subtract_datetime( $self->sched_arrival ) + ->in_units('minutes'); + } +} + +sub add_dp { + my ( $self, %attrib ) = @_; + + my $strp = DateTime::Format::Strptime->new( + pattern => '%y%m%d%H%M', + time_zone => 'Europe/Berlin', + ); + + if ( $attrib{departure_ts} ) { + $self->{departure} = $strp->parse_datetime( $attrib{departure_ts} ); + $self->{delay} + = $self->departure->subtract_datetime( $self->sched_departure ) + ->in_units('minutes'); + } +} + +sub add_tl { + my ( $self, %attrib ) = @_; + + # TODO + + return $self; +} + sub origin { my ($self) = @_; @@ -85,19 +132,19 @@ sub line { sub route_pre { my ($self) = @_; - return @{$self->{route_pre}}; + return @{ $self->{route_pre} }; } sub route_post { my ($self) = @_; - return @{$self->{route_post}}; + return @{ $self->{route_post} }; } sub route { my ($self) = @_; - return ($self->route_pre, $self->{station}, $self->route_post); + return ( $self->route_pre, $self->{station}, $self->route_post ); } sub train { |