Initial commit

3 files changed, 474 insertions, 0 deletions

diff --git a/bin/dbris-m b/bin/dbris-m
new file mode 100755
index 0000000..7a2cf26
--- /dev/null
+++ b/bin/dbris-m
@@ -0,0 +1,155 @@
+#!perl
+use strict;
+use warnings;
+use 5.020;
+
+our $VERSION = '0.01';
+
+use utf8;
+use DateTime;
+use Encode qw(decode);
+use JSON;
+use Getopt::Long qw(:config no_ignore_case);
+use Travel::Status::DE::DBRIS;
+
+my $developer_mode;
+my $use_cache = 1;
+my $cache;
+my ( $json_output, $raw_json_output );
+
+my @output;
+
+binmode( STDOUT, ':encoding(utf-8)' );
+for my $arg (@ARGV) {
+	$arg = decode( 'UTF-8', $arg );
+}
+
+my $output_bold  = -t STDOUT ? "\033[1m" : q{};
+my $output_reset = -t STDOUT ? "\033[0m" : q{};
+
+GetOptions(
+	'h|help'    => sub { show_help(0) },
+	'V|version' => \&show_version,
+	'cache!'    => \$use_cache,
+	'devmode'   => \$developer_mode,
+	'json'      => \$json_output,
+	'raw-json'  => \$raw_json_output,
+
+) or show_help(1);
+
+if ($use_cache) {
+	my $cache_path = ( $ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache" )
+	  . '/Travel-Status-DE-HAFAS';
+	eval {
+		require Cache::File;
+		$cache = Cache::File->new(
+			cache_root      => $cache_path,
+			default_expires => '90 seconds',
+			lock_level      => Cache::File::LOCK_LOCAL(),
+		);
+	};
+	if ($@) {
+		$cache = undef;
+	}
+}
+
+my %opt = (
+	cache          => $cache,
+	station        => shift || show_help(1),
+	developer_mode => $developer_mode,
+);
+
+if ( $opt{station} =~ m{ ^ (?<lat> [0-9.]+ ) : (?<lon> [0-9].+ ) $ }x ) {
+	$opt{geoSearch} = {
+		latitude  => $+{lat},
+		longitude => $+{lon},
+	};
+	delete $opt{station};
+}
+elsif ( $opt{station} =~ m{ ^ [?] (?<query> .*) $ }x ) {
+	$opt{locationSearch} = $+{query};
+	delete $opt{station};
+}
+elsif ( $opt{station} =~ m{[|]} ) {
+	$opt{journey} = { id => $opt{station} };
+	delete $opt{station};
+}
+
+my $status = Travel::Status::DE::DBRIS->new(%opt);
+
+sub show_help {
+	my ($code) = @_;
+
+	print "Usage: db-ris-m <station|lat:lon>\n" . "See also: man dbris-m\n";
+
+	exit $code;
+}
+
+sub show_version {
+	say "dbris-m version ${VERSION}";
+
+	exit 0;
+}
+
+sub spacer {
+	my ($len) = @_;
+	return ( $len % 2 ? q { } : q{} ) . ( q{ ·} x ( $len / 2 ) );
+}
+
+sub display_occupancy {
+	my ($occupancy) = @_;
+
+	if ( not $occupancy ) {
+		return q{ };
+	}
+	if ( $occupancy == 1 ) {
+		return q{.};
+	}
+	if ( $occupancy == 2 ) {
+		return q{o};
+	}
+	if ( $occupancy == 3 ) {
+		return q{*};
+	}
+	if ( $occupancy == 4 ) {
+		return q{!};
+	}
+	return q{?};
+}
+
+sub format_delay {
+	my ( $delay, $len ) = @_;
+	if ( $delay and $len ) {
+		return sprintf( "(%+${len}d)", $delay );
+	}
+	return q{};
+}
+
+if ( my $err = $status->errstr ) {
+	say STDERR "Request error: ${err}";
+	exit 2;
+}
+
+if ($raw_json_output) {
+	say JSON->new->convert_blessed->encode( $status->{raw_json} );
+	exit 0;
+}
+
+if ($json_output) {
+	if ( $opt{journey} ) {
+		say JSON->new->convert_blessed->encode( $status->result );
+	}
+	else {
+		say JSON->new->convert_blessed->encode( [ $status->results ] );
+	}
+	exit 0;
+}
+
+if ( $opt{station} ) {
+	die("Unimplemented");
+}
+elsif ( $opt{geoSearch} ) {
+	for my $result ( $status->results ) {
+		printf( "%8d  %s\n", $result->eva, $result->name );
+	}
+}
diff --git a/lib/Travel/Status/DE/DBRIS.pm b/lib/Travel/Status/DE/DBRIS.pm
new file mode 100644
index 0000000..7743fce
--- /dev/null
+++ b/lib/Travel/Status/DE/DBRIS.pm
@@ -0,0 +1,277 @@
+package Travel::Status::DE::DBRIS;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.020;
+use utf8;
+
+use Carp qw(confess);
+use DateTime;
+use DateTime::Format::Strptime;
+use Encode qw(decode encode);
+use JSON;
+use LWP::UserAgent;
+use Travel::Status::DE::DBRIS::Location;
+
+our $VERSION = '0.01';
+
+# {{{ Constructors
+
+sub new {
+	my ( $obj, %conf ) = @_;
+	my $service = $conf{service};
+
+	my $ua = $conf{user_agent};
+
+	if ( not $ua ) {
+		my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };
+		$ua = LWP::UserAgent->new(%lwp_options);
+		$ua->env_proxy;
+	}
+
+	my $now  = DateTime->now( time_zone => 'Europe/Berlin' );
+	my $self = {
+		cache          => $conf{cache},
+		developer_mode => $conf{developer_mode},
+		messages       => [],
+		results        => [],
+		station        => $conf{station},
+		ua             => $ua,
+		now            => $now,
+		tz_offset      => $now->offset / 60,
+	};
+
+	bless( $self, $obj );
+
+	my $req;
+
+	if ( my $eva = $conf{station} ) {
+		$req
+		  = "https://www.bahnhof.de/api/boards/departures?evaNumbers=${eva}&duration=60&stationCategory=1&locale=de&sortBy=TIME_SCHEDULE";
+	}
+	elsif ( my $gs = $conf{geoSearch} ) {
+		my $lat = $gs->{latitude};
+		my $lon = $gs->{longitude};
+		$req
+		  = "https://www.bahn.de/web/api/reiseloesung/orte/nearby?lat=${lat}&long=${lon}&radius=9999&maxNo=100";
+	}
+
+	# journey : https://www.bahn.de/web/api/reiseloesung/fahrt?journeyId=2%7C%23VN%231%23ST%231733779122%23PI%230%23ZI%23324190%23TA%230%23DA%23141224%231S%238000001%231T%231822%23LS%238000080%23LT%232050%23PU%2380%23RT%231%23CA%23DPN%23ZE%2326431%23ZB%23RE+26431%23PC%233%23FR%238000001%23FT%231822%23TO%238000080%23TT%232050%23&poly=true
+	else {
+		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',
+	#);
+
+	my $json = $self->{json} = JSON->new->utf8;
+
+	if ( $conf{async} ) {
+		$self->{req} = $req;
+		return $self;
+	}
+
+	if ( $conf{json} ) {
+		$self->{raw_json} = $conf{json};
+	}
+	else {
+		if ( $self->{developer_mode} ) {
+			say "requesting $req";
+		}
+
+		my ( $content, $error ) = $self->get_with_cache($req);
+
+		if ($error) {
+			$self->{errstr} = $error;
+			return $self;
+		}
+
+		if ( $self->{developer_mode} ) {
+			say decode( 'utf-8', $content );
+		}
+
+		$self->{raw_json} = $json->decode($content);
+	}
+
+	if ( $conf{station} ) {
+		$self->parse_stationboard;
+	}
+	elsif ( $conf{geoSearch} ) {
+		$self->parse_geosearch;
+	}
+
+	return $self;
+}
+
+sub new_p {
+	my ( $obj, %conf ) = @_;
+	my $promise = $conf{promise}->new;
+
+	if (
+		not(   $conf{station}
+			or $conf{geoSearch} )
+	  )
+	{
+		return $promise->reject('station / geoSearch flag must be passed');
+	}
+
+	my $self = $obj->new( %conf, async => 1 );
+	$self->{promise} = $conf{promise};
+
+	$self->get_with_cache_p( $self->{url} )->then(
+		sub {
+			my ($content) = @_;
+			$self->{raw_json} = $self->{json}->decode($content);
+			if ( $conf{station} ) {
+				$self->parse_stationboard;
+			}
+			elsif ( $conf{geoSearch} ) {
+				$self->parse_search;
+			}
+			else {
+				$promise->resolve($self);
+			}
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
+# }}}
+# {{{ Internal Helpers
+
+sub get_with_cache {
+	my ( $self, $url ) = @_;
+	my $cache = $self->{cache};
+
+	if ( $self->{developer_mode} ) {
+		say "GET $url";
+	}
+
+	if ($cache) {
+		my $content = $cache->thaw($url);
+		if ($content) {
+			if ( $self->{developer_mode} ) {
+				say '  cache hit';
+			}
+			return ( ${$content}, undef );
+		}
+	}
+
+	if ( $self->{developer_mode} ) {
+		say '  cache miss';
+	}
+
+	my $reply = $self->{ua}->get($url);
+
+	if ( $reply->is_error ) {
+		return ( undef, $reply->status_line );
+	}
+	my $content = $reply->content;
+
+	if ($cache) {
+		$cache->freeze( $url, \$content );
+	}
+
+	return ( $content, undef );
+}
+
+sub get_with_cache_p {
+	my ( $self, $url ) = @_;
+	my $cache = $self->{cache};
+
+	if ( $self->{developer_mode} ) {
+		say "GET $url";
+	}
+
+	my $promise = $self->{promise}->new;
+
+	if ($cache) {
+		my $content = $cache->thaw($url);
+		if ($content) {
+			if ( $self->{developer_mode} ) {
+				say '  cache hit';
+			}
+			return $promise->resolve( ${$content} );
+		}
+	}
+
+	if ( $self->{developer_mode} ) {
+		say '  cache miss';
+	}
+
+	$self->{ua}->get_p($url)->then(
+		sub {
+			my ($tx) = @_;
+			if ( my $err = $tx->error ) {
+				$promise->reject(
+					"GET $url returned HTTP $err->{code} $err->{message}");
+				return;
+			}
+			my $content = $tx->res->body;
+			if ($cache) {
+				$cache->freeze( $url, \$content );
+			}
+			$promise->resolve($content);
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
+sub parse_geosearch {
+	my ($self) = @_;
+
+	$self->{results} = [];
+
+	if ( $self->{errstr} ) {
+		return $self;
+	}
+
+	@{ $self->{results} }
+	  = map { Travel::Status::DE::DBRIS::Location->new( json => $_ ) }
+	  @{ $self->{raw_json} // [] };
+
+	return $self;
+}
+
+# }}}
+# {{{ Public Functions
+
+sub errstr {
+	my ($self) = @_;
+
+	return $self->{errstr};
+}
+
+sub results {
+	my ($self) = @_;
+	return @{ $self->{results} };
+}
+
+sub result {
+	my ($self) = @_;
+	return $self->{result};
+}
+
+# }}}
+
+1;
diff --git a/lib/Travel/Status/DE/DBRIS/Location.pm b/lib/Travel/Status/DE/DBRIS/Location.pm
new file mode 100644
index 0000000..bb9a3ce
--- /dev/null
+++ b/lib/Travel/Status/DE/DBRIS/Location.pm
@@ -0,0 +1,42 @@
+package Travel::Status::DE::DBRIS::Location;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.01';
+
+Travel::Status::DE::DBRIS::Location->mk_ro_accessors(
+	qw(eva id lat lon name products type));
+
+sub new {
+	my ( $obj, %opt ) = @_;
+
+	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},
+	};
+
+	bless( $ref, $obj );
+
+	return $ref;
+}
+
+sub TO_JSON {
+	my ($self) = @_;
+
+	my $ret = { %{$self} };
+
+	return $ret;
+}
+
+1;