From 7f73d668ac162af723bbc80b2bb35b7419715c5b Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Fri, 3 Jan 2014 15:10:39 +0100 Subject: add debug helper script --- lib/Travel/Status/DE/IRIS.pm | 2 ++ lib/Travel/Status/DE/IRIS/Result.pm | 8 +++++++- scripts/debug | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 1 deletion(-) create mode 100755 scripts/debug diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm index 223a3c9..5776452 100644 --- a/lib/Travel/Status/DE/IRIS.pm +++ b/lib/Travel/Status/DE/IRIS.pm @@ -157,6 +157,8 @@ sub get_realtime { next; } + $result->add_realtime($s); + if ($e_tl) { $result->add_tl( class => $e_tl->getAttribute('f'), # D N S F diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm index e637564..de59a2a 100644 --- a/lib/Travel/Status/DE/IRIS/Result.pm +++ b/lib/Travel/Status/DE/IRIS/Result.pm @@ -15,7 +15,7 @@ our $VERSION = '0.00'; Travel::Status::DE::IRIS::Result->mk_ro_accessors( qw(arrival date datetime delay departure line_no platform raw_id - route_start route_end + realtime_xml route_start route_end sched_arrival sched_departure start stop_no time train_id train_no type unknown_t unknown_o) ); @@ -102,6 +102,12 @@ sub add_dp { } } +sub add_realtime { + my ($self, $xmlobj) = @_; + + $self->{realtime_xml} = $xmlobj; +} + sub add_tl { my ( $self, %attrib ) = @_; diff --git a/scripts/debug b/scripts/debug new file mode 100755 index 0000000..bc02543 --- /dev/null +++ b/scripts/debug @@ -0,0 +1,35 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use 5.018; + +binmode( STDOUT, ':encoding(utf-8)' ); + +use Data::Dumper; +use Travel::Status::DE::DeutscheBahn; +use Travel::Status::DE::IRIS; + +my $ris = Travel::Status::DE::DeutscheBahn->new( + station => $ARGV[0], + mode => 'dep', +); + +my $iris = Travel::Status::DE::IRIS->new( + station => $ARGV[1], +); + +my @res_ris = $ris->results; +my @res_iris = $iris->results; + +for my $d (@res_iris) { + printf("\n\n %5s %10s %4s %20s (%s)\n", $d->time, $d->train, $d->platform, $d->route_end, join(q{ }, $d->route_interesting)); + my @matching = grep { $_->time . $_->train eq $d->time . $d->train } @res_ris; + for my $risd (@matching) { + printf(" -> %5s %10s %4s %20s (%s)\n", $risd->time, $risd->train, $risd->platform, $risd->route_end, join(q{ }, $risd->route_interesting)); + printf(" -> %s\n", $risd->info_raw); + } + if ($d->realtime_xml) { + print $d->realtime_xml->toString(1); + } +} -- cgit v1.2.3