summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Travel/Status/DE/HAFAS/Journey.pm8
-rw-r--r--lib/Travel/Status/DE/HAFAS/Product.pm37
2 files changed, 31 insertions, 14 deletions
diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm
index 6a36c22..f7206e8 100644
--- a/lib/Travel/Status/DE/HAFAS/Journey.pm
+++ b/lib/Travel/Status/DE/HAFAS/Journey.pm
@@ -17,6 +17,7 @@ Travel::Status::DE::HAFAS::Journey->mk_ro_accessors(
qw(datetime sched_datetime rt_datetime
is_additional is_cancelled is_partially_cancelled
station station_eva platform sched_platform rt_platform operator
+ product
id name type type_long class number line line_no load delay
route_end route_start origin destination direction)
);
@@ -487,6 +488,13 @@ True if the journey was cancelled, false otherwise.
True if part of the journey was cancelled, false otherwise.
+=item $journey->product
+
+Travel::Status::DE::HAFAS::Product(3pm) instance describing the product (mode
+of transport, line number / ID, operator, ...) associated with this journey.
+Note that journeys may be associated with multiple products -- see also
+C<< $journey->route >> and C<< $stop->product >>.
+
=item $journey->rt_platform (station only)
Actual arrival/departure platform.
diff --git a/lib/Travel/Status/DE/HAFAS/Product.pm b/lib/Travel/Status/DE/HAFAS/Product.pm
index 5e45232..14cc018 100644
--- a/lib/Travel/Status/DE/HAFAS/Product.pm
+++ b/lib/Travel/Status/DE/HAFAS/Product.pm
@@ -11,19 +11,22 @@ use parent 'Class::Accessor';
our $VERSION = '5.05';
Travel::Status::DE::HAFAS::Product->mk_ro_accessors(
- qw(name type type_long class number line line_no operator)
-);
+ qw(name type type_long class number line line_id line_no operator));
# {{{ Constructor
sub new {
my ( $obj, %opt ) = @_;
- my $product = $opt{product};
- my $common = $opt{common};
- my $opL = $common->{opL};
+ my $product = $opt{product};
+ my $common = $opt{common};
+ my $opL = $common->{opL};
- my $class = $product->{cls};
+ # DB:
+ # catIn / catOutS eq "IXr" => "ICE X Regio"? regional tickets are generally accepted
+ # <= does not hold
+
+ my $class = $product->{cls};
my $name = $product->{addName} // $product->{name};
my $line_no = $product->{prodCtx}{line};
my $train_no = $product->{prodCtx}{num};
@@ -45,6 +48,11 @@ sub new {
$line_no = $product->{prodCtx}{matchId};
}
+ my $line_id;
+ if ( $product->{prodCtx}{lineId} ) {
+ $line_id = lc( $product->{prodCtx}{lineId} =~ s{_+}{-}gr );
+ }
+
my $operator;
if ( defined $product->{oprX} ) {
if ( my $opref = $opL->[ $product->{oprX} ] ) {
@@ -53,14 +61,15 @@ sub new {
}
my $ref = {
- name => $name,
- number => $train_no,
- line => $name,
- line_no => $line_no,
- type => $cat,
- type_long => $catlong,
- class => $class,
- operator => $operator,
+ name => $name,
+ number => $train_no,
+ line => $name,
+ line_id => $line_id,
+ line_no => $line_no,
+ type => $cat,
+ type_long => $catlong,
+ class => $class,
+ operator => $operator,
};
bless( $ref, $obj );