1 files changed, 155 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 );
+	}
+}