diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Travel/Status/DE/HAFAS/Journey.pm | 8 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/HAFAS/Product.pm | 37 |
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 ); |