summaryrefslogtreecommitdiff
path: root/lib/Travel/Status/DE
diff options
context:
space:
mode:
authorDaniel Friesel <derf@finalrewind.org>2014-01-03 19:12:53 +0100
committerDaniel Friesel <derf@finalrewind.org>2014-01-03 19:12:53 +0100
commitbdfd43c81227c9e88c92ee145b5448463eeed276 (patch)
tree2d28607f36c75b1faa11516797bb05fa60b504db /lib/Travel/Status/DE
parent6a8f2dcb7938dc7883591eaec871878603be1839 (diff)
parse info and delay messages
Diffstat (limited to 'lib/Travel/Status/DE')
-rw-r--r--lib/Travel/Status/DE/IRIS.pm16
-rw-r--r--lib/Travel/Status/DE/IRIS/Result.pm75
2 files changed, 90 insertions, 1 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm
index 5776452..7b326d2 100644
--- a/lib/Travel/Status/DE/IRIS.pm
+++ b/lib/Travel/Status/DE/IRIS.pm
@@ -150,6 +150,9 @@ sub get_realtime {
my $e_tl = ( $s->findnodes('./tl') )[0];
my $e_ar = ( $s->findnodes('./ar') )[0];
my $e_dp = ( $s->findnodes('./dp') )[0];
+ my @e_ms = $s->findnodes('.//m');
+
+ my %messages;
my $result = first { $_->raw_id eq $id } $self->results;
@@ -159,6 +162,19 @@ sub get_realtime {
$result->add_realtime($s);
+ for my $e_m (@e_ms) {
+ my $type = $e_m->getAttribute('t');
+ my $value = $e_m->getAttribute('c');
+ my $id = $e_m->getAttribute('id');
+ my $ts = $e_m->getAttribute('ts');
+
+ if ($value) {
+ $messages{$id} = [ $ts, $type, $value ];
+ }
+ }
+
+ $result->add_messages(%messages);
+
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 7d0aa8a..94c638c 100644
--- a/lib/Travel/Status/DE/IRIS/Result.pm
+++ b/lib/Travel/Status/DE/IRIS/Result.pm
@@ -3,6 +3,7 @@ package Travel::Status::DE::IRIS::Result;
use strict;
use warnings;
use 5.010;
+use utf8;
no if $] >= 5.018, warnings => "experimental::smartmatch";
@@ -10,9 +11,64 @@ use parent 'Class::Accessor';
use Carp qw(cluck);
use DateTime;
use DateTime::Format::Strptime;
+use List::MoreUtils qw(uniq);
our $VERSION = '0.00';
+sub translate_msg {
+ my ( $self, $msg ) = @_;
+
+ my %translation = (
+ 2 => 'Polizeiliche Ermittlung',
+ 3 => 'Feuerwehreinsatz neben der Strecke',
+ 5 => 'Ärztliche Versorgung eines Fahrgastes',
+ 7 => 'Personen im Gleis',
+ 8 => 'Notarzteinsatz am Gleis',
+ 10 => 'Ausgebrochene Tiere im Gleis',
+ 11 => 'Unwetter',
+ 15 => 'Beeinträchtigung durch Vandalismus',
+ 16 => 'Entschärfung einer Fliegerbombe',
+ 17 => 'Beschädigung einer Brücke',
+ 18 => 'Umgestürzter Baum im Gleis',
+ 19 => 'Unfall an einem Bahnübergang',
+ 20 => 'Tiere im Gleis',
+ 21 => 'Warten auf weitere Reisende',
+ 22 => 'Witterungsbedingte Störung',
+ 23 => 'Feuerwehreinsatz auf Bahngelände',
+ 24 => 'Verspätung aus dem Ausland',
+ 25 => 'Warten auf verspätete Zugteile',
+ 28 => 'Gegenstände im Gleis',
+ 31 => 'Bauarbeiten',
+ 32 => 'Verzögerung beim Ein-/Ausstieg',
+ 33 => 'Oberleitungsstörung',
+ 34 => 'Signalstörung',
+ 35 => 'Streckensperrung',
+ 36 => 'Technische Störung am Zug',
+ 38 => 'Technische Störung an der Strecke',
+ 39 => 'Anhängen von zusätzlichen Wagen',
+ 40 => 'Stellwerksstörung/-ausfall',
+ 41 => 'Störung an einem Bahnübergang',
+ 42 => 'Außerplanmäßige Geschwindigkeitsbeschränkung',
+ 43 => 'Verspätung eines vorausfahrenden Zuges',
+ 44 => 'Warten auf einen entgegenkommenden Zug',
+ 45 => 'Überholung durch anderen Zug',
+ 46 => 'Warten auf freie Einfahrt',
+ 47 => 'Verspätete Bereitstellung',
+ 48 => 'Verspätung aus vorheriger Fahrt',
+ 80 => 'Abweichende Wagenreihung',
+ 83 => 'Fehlender Zugteil',
+ 86 => 'Keine Reservierungsanzeige',
+ 90 => 'Kein Bordrestaurant/Bordbistro',
+ 91 => 'Keine Fahrradmitnahme',
+ 92 => 'Rollstuhlgerechtes WC in einem Wagen ausgefallen',
+ 93 => 'Kein rollstuhlgerechtes WC',
+ 98 => 'Kein rollstuhlgerechter Wagen',
+ 99 => 'Verzögerungen im Betriebsablauf',
+ );
+
+ return $translation{$msg} // "?($msg)";
+}
+
Travel::Status::DE::IRIS::Result->mk_ro_accessors(
qw(arrival date datetime delay departure line_no platform raw_id
realtime_xml route_start route_end
@@ -102,8 +158,14 @@ sub add_dp {
}
}
+sub add_messages {
+ my ( $self, %messages ) = @_;
+
+ $self->{messages} = \%messages;
+}
+
sub add_realtime {
- my ($self, $xmlobj) = @_;
+ my ( $self, $xmlobj ) = @_;
$self->{realtime_xml} = $xmlobj;
}
@@ -128,6 +190,17 @@ sub destination {
return $self->route_end;
}
+sub info {
+ my ($self) = @_;
+
+ my @messages = sort keys %{ $self->{messages} };
+ my @ids = uniq( map { $self->{messages}{$_}->[2] } @messages );
+
+ my @info = map { $self->translate_msg($_) } @ids;
+
+ return @info;
+}
+
sub line {
my ($self) = @_;