Skip to content

Commit

Permalink
Preliminary support for stop-specific operators / operator changes (#10)
Browse files Browse the repository at this point in the history
  • Loading branch information
@derf
derf committed Mar 26, 2024
1 parent 20b537c commit 9ef7552
Show file tree
Hide file tree
Showing 5 changed files with 287 additions and 57 deletions.
35 changes: 31 additions & 4 deletions bin/hafas-m
View file
Original file line number Diff line number Diff line change
Expand Up @@ -384,6 +384,8 @@ elsif ( $opt{locationSearch} ) {
}
elsif ( $opt{journey} ) {
my $result = $status->result;
my @prods;
my $prev_prod = 0;

printf( "%s → %s", $result->name, $result->route_end );
if ( $result->number ) {
Expand All @@ -392,7 +394,7 @@ elsif ( $opt{journey} ) {
if ( $result->line_no ) {
printf( " / Linie %s", $result->line_no );
}
printf( "\nFahrt %s am %s\n\n",
printf( "\nFahrt %s am %s\n",
$result->id, ( $result->route )[0]->sched_dep->strftime('%d.%m.%Y') );

my $delay_len = 0;
Expand All @@ -406,11 +408,24 @@ elsif ( $opt{journey} ) {
{
$occupancy_len = 2;
}
my $prod = $stop->prod_dep // $stop->prod_arr;
if ( $prod and $prod != $prev_prod ) {
push( @prods, $prod );
$prev_prod = $prod;
}
}
if ($delay_len) {
$delay_fmt = $delay_len + 3;
}

if ( @prods == 1 ) {
printf( "Betrieb: %s\n\n", $prev_prod->operator );
}
else {
printf( "Betrieb: %s\n\n", join( q{, }, map { $_->operator } @prods ) );
}
$prev_prod = 0;

my $now = DateTime->now( time_zone => 'Europe/Berlin' );
my $mark_stop = 0;
for my $i ( reverse 1 .. scalar $result->route ) {
Expand Down Expand Up @@ -440,8 +455,19 @@ elsif ( $opt{journey} ) {
$msg_line .= sprintf( ' (%d)', $message->{id} );
}
}

my $prod_line = q{};
if ( @prods > 1 ) {
my $prod = $stop->prod_dep // $stop->prod_arr;
if ( $prod and $prod != $prev_prod ) {
$prod_line
= sprintf( " : %s (%s)", $prod->name, $prod->operator );
$prev_prod = $prod;
}
}

printf(
"%s%5s %s %5s %-${delay_fmt}s%${occupancy_len}s%-${occupancy_len}s %s%s%s%s\n",
"%s%5s %s %5s %-${delay_fmt}s%${occupancy_len}s%-${occupancy_len}s %s%s%s%s%s\n",
$stop == $mark_stop ? $output_bold : q{},
$stop->arr_cancelled ? '--:--'
: ( $stop->arr ? $stop->arr->strftime('%H:%M') : q{} ),
Expand All @@ -454,8 +480,9 @@ elsif ( $opt{journey} ) {
$stop->load->{SECOND} ? display_occupancy( $stop->load->{SECOND} )
: q{},
$stop->loc->name,
$stop == $mark_stop ? $output_reset : q{},
$stop->direction ? sprintf( ' → %s', $stop->direction ) : q{},
$stop == $mark_stop ? $output_reset : q{},
$prod_line,
$stop->direction ? sprintf( ' → %s', $stop->direction ) : q{},
$msg_line,
);
}
Expand Down
24 changes: 24 additions & 0 deletions lib/Travel/Status/DE/HAFAS.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ use Travel::Status::DE::HAFAS::Journey;
use Travel::Status::DE::HAFAS::Location;
use Travel::Status::DE::HAFAS::Message;
use Travel::Status::DE::HAFAS::Polyline qw(decode_polyline);
use Travel::Status::DE::HAFAS::Product;
use Travel::Status::DE::HAFAS::StopFinder;

our $VERSION = '5.05';
Expand Down Expand Up @@ -702,6 +703,20 @@ sub add_message {
return $message;
}

sub parse_prodL {
my ($self) = @_;

my $common = $self->{raw_json}{svcResL}[0]{res}{common};
return [
map {
Travel::Status::DE::HAFAS::Product->new(
common => $common,
product => $_
)
} @{ $common->{prodL} }
];
}

sub parse_search {
my ($self) = @_;

Expand Down Expand Up @@ -730,6 +745,8 @@ sub parse_journey {
return $self;
}

my $prodL = $self->parse_prodL;

my @locL = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) }
@{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
my $journey = $self->{raw_json}{svcResL}[0]{res}{journey};
Expand All @@ -748,6 +765,7 @@ sub parse_journey {

$self->{result} = Travel::Status::DE::HAFAS::Journey->new(
common => $self->{raw_json}{svcResL}[0]{res}{common},
prodL => $prodL,
locL => \@locL,
journey => $journey,
polyline => \@polyline,
Expand All @@ -766,6 +784,8 @@ sub parse_journey_match {
return $self;
}

my $prodL = $self->parse_prodL;

my @locL = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) }
@{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };

Expand All @@ -776,6 +796,7 @@ sub parse_journey_match {
@{ $self->{results} },
Travel::Status::DE::HAFAS::Journey->new(
common => $self->{raw_json}{svcResL}[0]{res}{common},
prodL => $prodL,
locL => \@locL,
journey => $result,
hafas => $self,
Expand All @@ -794,6 +815,8 @@ sub parse_board {
return $self;
}

my $prodL = $self->parse_prodL;

my @locL = map { Travel::Status::DE::HAFAS::Location->new( loc => $_ ) }
@{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] };
Expand All @@ -803,6 +826,7 @@ sub parse_board {
@{ $self->{results} },
Travel::Status::DE::HAFAS::Journey->new(
common => $self->{raw_json}{svcResL}[0]{res}{common},
prodL => $prodL,
locL => \@locL,
journey => $result,
hafas => $self,
Expand Down
80 changes: 30 additions & 50 deletions lib/Travel/Status/DE/HAFAS/Journey.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,13 +26,12 @@ Travel::Status::DE::HAFAS::Journey->mk_ro_accessors(
sub new {
my ( $obj, %opt ) = @_;

my @prodL = @{ $opt{common}{prodL} // [] };
my @opL = @{ $opt{common}{opL} // [] };
my @icoL = @{ $opt{common}{icoL} // [] };
my @tcocL = @{ $opt{common}{tcocL} // [] };
my @remL = @{ $opt{common}{remL} // [] };
my @himL = @{ $opt{common}{himL} // [] };

my $prodL = $opt{prodL};
my $locL = $opt{locL};
my $hafas = $opt{hafas};
my $journey = $opt{journey};
Expand All @@ -45,34 +44,7 @@ sub new {
my $is_cancelled = $journey->{isCncl};
my $partially_cancelled = $journey->{isPartCncl};

my $product = $prodL[ $journey->{prodX} ];
my $name = $product->{addName} // $product->{name};
my $line_no = $product->{prodCtx}{line};
my $train_no = $product->{prodCtx}{num};
my $cat = $product->{prodCtx}{catOut};
my $catlong = $product->{prodCtx}{catOutL};
if ( $name and $cat and $name eq $cat and $product->{nameS} ) {
$name .= ' ' . $product->{nameS};
}
if ( defined $train_no and not $train_no ) {
$train_no = undef;
}
if (
not defined $line_no
and defined $product->{prodCtx}{matchId}
and
( not defined $train_no or $product->{prodCtx}{matchId} ne $train_no )
)
{
$line_no = $product->{prodCtx}{matchId};
}

my $operator;
if ( defined $product->{oprX} ) {
if ( my $opref = $opL[ $product->{oprX} ] ) {
$operator = $opref->{name};
}
}
my $product = $prodL->[ $journey->{prodX} ];

my @messages;
for my $msg ( @{ $journey->{msgL} // [] } ) {
Expand All @@ -89,25 +61,33 @@ sub new {

my $datetime_ref;

if ( @{ $journey->{stopL} // [] } or $journey->{stbStop}) {
my ($date_ref, $parse_fmt);
if ($jid =~ /#/) {
if ( @{ $journey->{stopL} // [] } or $journey->{stbStop} ) {
my ( $date_ref, $parse_fmt );
if ( $jid =~ /#/ ) {

# ÖBB Journey ID - technically we ought to use Europe/Vienna tz
# but let's not get into that...
$date_ref = ( split( /#/, $jid ) )[12];
$date_ref = ( split( /#/, $jid ) )[12];
$parse_fmt = '%d%m%y';
if ( length($date_ref) < 5 ) {
warn("HAFAS, not even once -- midnight crossing may be bogus -- date_ref $date_ref");
} elsif ( length($date_ref) == 5 ) {
warn(
"HAFAS, not even once -- midnight crossing may be bogus -- date_ref $date_ref"
);
}
elsif ( length($date_ref) == 5 ) {
$date_ref = "0${date_ref}";
}
} else {
}
else {
# DB Journey ID
$date_ref = ( split( qr{[|]}, $jid ) )[4];
$date_ref = ( split( qr{[|]}, $jid ) )[4];
$parse_fmt = '%d%m%Y';
if ( length($date_ref) < 7 ) {
warn("HAFAS, not even once -- midnight crossing may be bogus -- date_ref $date_ref");
} elsif ( length($date_ref) == 7 ) {
warn(
"HAFAS, not even once -- midnight crossing may be bogus -- date_ref $date_ref"
);
}
elsif ( length($date_ref) == 7 ) {
$date_ref = "0${date_ref}";
}
}
Expand All @@ -117,8 +97,6 @@ sub new {
)->parse_datetime($date_ref);
}

my $class = $product->{cls};

my @stops;
my $route_end;
for my $stop ( @{ $journey->{stopL} // [] } ) {
Expand All @@ -128,6 +106,7 @@ sub new {
loc => $loc,
stop => $stop,
common => $opt{common},
prodL => $prodL,
hafas => $hafas,
date => $date,
datetime_ref => $datetime_ref,
Expand All @@ -150,14 +129,15 @@ sub new {

my $ref = {
id => $jid,
name => $name,
number => $train_no,
line => $name,
line_no => $line_no,
type => $cat,
type_long => $catlong,
class => $class,
operator => $operator,
product => $product,
name => $product->name,
number => $product->number,
line => $product->name,
line_no => $product->line_no,
type => $product->type,
type_long => $product->type_long,
class => $product->class,
operator => $product->operator,
direction => $direction,
is_cancelled => $is_cancelled,
is_partially_cancelled => $partially_cancelled,
Expand Down
Loading

0 comments on commit 9ef7552

Please sign in to comment.