add preliminary departure board support

4 files changed, 113 insertions, 19 deletions

diff --git a/bin/dbris-m b/bin/dbris-m
index 253bd19..9fa0990 100755
--- a/bin/dbris-m
+++ b/bin/dbris-m
@@ -10,6 +10,7 @@ use DateTime;
 use Encode qw(decode);
 use JSON;
 use Getopt::Long qw(:config no_ignore_case);
+use List::Util   qw(max);
 use Travel::Status::DE::DBRIS;
 
 my $developer_mode;
@@ -146,7 +147,17 @@ if ($json_output) {
 }
 
 if ( $opt{station} ) {
-	die("Unimplemented");
+	my $max_line = max map { length( $_->line ) } $status->results;
+	my $max_dest = max map { length( $_->dest_name ) } $status->results;
+	for my $result ( $status->results ) {
+		printf(
+			"%s  %${max_line}s  %${max_dest}s  %s\n",
+			$result->is_cancelled ? '--:--' : $result->dep->strftime('%H:%M'),
+			$result->line,
+			$result->dest_name,
+			$result->platform // $result->sched_platform
+		);
+	}
 }
 elsif ( $opt{geoSearch} ) {
 	for my $result ( $status->results ) {
diff --git a/lib/Travel/Status/DE/DBRIS.pm b/lib/Travel/Status/DE/DBRIS.pm
index 2b19924..a2bf311 100644
--- a/lib/Travel/Status/DE/DBRIS.pm
+++ b/lib/Travel/Status/DE/DBRIS.pm
@@ -13,6 +13,7 @@ use DateTime::Format::Strptime;
 use Encode qw(decode encode);
 use JSON;
 use LWP::UserAgent;
+use Travel::Status::DE::DBRIS::Journey;
 use Travel::Status::DE::DBRIS::Location;
 
 our $VERSION = '0.01';
@@ -67,10 +68,10 @@ sub new {
 		confess('station or geoSearch must be specified');
 	}
 
-	#$self->{strptime_obj} //= DateTime::Format::Strptime->new(
-	#	pattern   => '%Y%m%dT%H%M%S',
-	#	time_zone => $hafas_instance->{$service}{time_zone} // 'Europe/Berlin',
-	#);
+	$self->{strptime_obj} //= DateTime::Format::Strptime->new(
+		pattern   => '%Y-%m-%dT%H:%M:%S%Z',
+		time_zone => 'Europe/Berlin',
+	);
 
 	my $json = $self->{json} = JSON->new->utf8;
 
@@ -244,12 +245,6 @@ sub get_with_cache_p {
 sub parse_search {
 	my ($self) = @_;
 
-	$self->{results} = [];
-
-	if ( $self->{errstr} ) {
-		return $self;
-	}
-
 	@{ $self->{results} }
 	  = map { Travel::Status::DE::DBRIS::Location->new( json => $_ ) }
 	  @{ $self->{raw_json} // [] };
@@ -257,6 +252,21 @@ sub parse_search {
 	return $self;
 }
 
+sub parse_stationboard {
+	my ($self) = @_;
+
+	# @{$self->{messages}} = map { Travel::Status::DE::DBRIS::Message->new(...) } @{$self->{raw_json}{globalMessages}/[]};
+
+	@{ $self->{results} } = map {
+		Travel::Status::DE::DBRIS::Journey->new(
+			json         => $_,
+			strptime_obj => $self->{strptime_obj}
+		)
+	} @{ $self->{raw_json}{entries} // [] };
+
+	return $self;
+}
+
 # }}}
 # {{{ Public Functions
 
diff --git a/lib/Travel/Status/DE/DBRIS/Journey.pm b/lib/Travel/Status/DE/DBRIS/Journey.pm
new file mode 100644
index 0000000..df7eada
--- /dev/null
+++ b/lib/Travel/Status/DE/DBRIS/Journey.pm
@@ -0,0 +1,69 @@
+package Travel::Status::DE::DBRIS::Journey;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.01';
+
+Travel::Status::DE::DBRIS::Journey->mk_ro_accessors(
+	qw(type dep sched_dep rt_dep is_cancelled line stop_name stop_eva id admin_id journey_id sched_platform platform dest_name dest_eva route)
+);
+
+sub new {
+	my ( $obj, %opt ) = @_;
+
+	my $json     = $opt{json}->[0];
+	my $strptime = $opt{strptime_obj};
+
+	my $ref = {
+		type                => $json->{type},
+		line                => $json->{lineName},
+		is_cancelled        => $json->{canceled},
+		dest_name           => $json->{destination}{name},
+		platform            => $json->{platform},
+		sched_platform      => $json->{platformSchedule},
+		dest_eva            => $json->{destination}{evaNumber},
+		raw_route           => $json->{viaStops},
+		raw_cancelled_route => $json->{canceledStopsAfterActualDestination},
+	};
+
+	bless( $ref, $obj );
+
+	if ( $json->{timeSchedule} ) {
+		$ref->{sched_dep} = $strptime->parse_datetime( $json->{timeSchedule} );
+	}
+	if ( $json->{timeDelayed} ) {
+		$ref->{rt_dep} = $strptime->parse_datetime( $json->{timeDelayed} );
+	}
+	$ref->{dep} = $ref->{rt_dep} // $ref->{schd_dep};
+
+	return $ref;
+}
+
+sub route {
+	my ($self) = @_;
+
+	if ( $self->{route} ) {
+		return @{ $self->{route} };
+	}
+
+	@{ $self->{route} }
+	  = map { Travel::Status::DE::DBRIS::Location->new( json => $_ ) }
+	  ( @{ $self->{raw_route} // [] },
+		@{ $self->{raw_cancelled_route} // [] } );
+
+	return @{ $self->{route} };
+}
+
+sub TO_JSON {
+	my ($self) = @_;
+
+	my $ret = { %{$self} };
+
+	return $ret;
+}
+
+1;
diff --git a/lib/Travel/Status/DE/DBRIS/Location.pm b/lib/Travel/Status/DE/DBRIS/Location.pm
index bb9a3ce..f053f2b 100644
--- a/lib/Travel/Status/DE/DBRIS/Location.pm
+++ b/lib/Travel/Status/DE/DBRIS/Location.pm
@@ -9,7 +9,8 @@ use parent 'Class::Accessor';
 our $VERSION = '0.01';
 
 Travel::Status::DE::DBRIS::Location->mk_ro_accessors(
-	qw(eva id lat lon name products type));
+	qw(eva id lat lon name products type is_cancelled is_additional is_separation display_priority)
+);
 
 sub new {
 	my ( $obj, %opt ) = @_;
@@ -17,13 +18,16 @@ sub new {
 	my $json = $opt{json};
 
 	my $ref = {
-		eva      => $json->{extId},
-		id       => $json->{id},
-		lat      => $json->{lat},
-		lon      => $json->{lon},
-		name     => $json->{name},
-		products => $json->{products},
-		type     => $json->{type},
+		eva           => $json->{extId} // $json->{evaNumber},
+		id            => $json->{id},
+		lat           => $json->{lat},
+		lon           => $json->{lon},
+		name          => $json->{name},
+		products      => $json->{products},
+		type          => $json->{type},
+		is_cancelled  => $json->{canceled},
+		is_additional => $json->{additional},
+
 	};
 
 	bless( $ref, $obj );