aseag-m -> ura-m, add service selection parameters

3 files changed, 78 insertions, 402 deletions

diff --git a/bin/aseag-m b/bin/aseag-m
deleted file mode 100755
index 0f59ecb..0000000
--- a/bin/aseag-m
+++ /dev/null
@@ -1,382 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use 5.010;
-
-no if $] >= 5.018, warnings => 'experimental::smartmatch';
-
-our $VERSION = '1.02';
-
-binmode( STDOUT, ':encoding(utf-8)' );
-
-use DateTime;
-use DateTime::Format::Duration;
-use Getopt::Long qw(:config no_ignore_case bundling);
-use List::Util qw(max);
-use Travel::Status::DE::ASEAG;
-
-my (@grep_lines);
-my $hide_past       = 1;
-my $strftime_format = '%H:%M:%S';
-my $strfrel_format  = '%M min';
-my ( %edata, @edata_pre );
-my $calculate_routes = 0;
-my $developer_mode;
-my $via;
-
-GetOptions(
-	'h|help'      => sub { show_help(0) },
-	'l|line=s@'   => \@grep_lines,
-	'o|output=s@' => \@edata_pre,
-	'p|with-past' => sub { $hide_past = 0 },
-	's|strftime=s' => \$strftime_format,
-	'S|strfrel=s'  => \$strfrel_format,
-	'v|via=s'      => \$via,
-	'V|version'    => \&show_version,
-	'devmode'      => \$developer_mode,
-
-) or show_help(1);
-
-if ( @ARGV != 1 ) {
-	show_help(1);
-}
-
-# --line=foo,bar support
-@edata_pre  = split( qr{,}, join( q{,}, @edata_pre ) );
-@grep_lines = split( qr{,}, join( q{,}, @grep_lines ) );
-
-for my $efield (@edata_pre) {
-	given ($efield) {
-		when ('a') { $edata{route_after}       = 1; $calculate_routes = 1 }
-		when ('b') { $edata{route_before}      = 1; $calculate_routes = 1 }
-		when ('f') { $edata{route_full}        = 1; $calculate_routes = 1 }
-		when ('i') { $edata{indicator}         = 1 }
-		when ('r') { $edata{route_interesting} = 1; $calculate_routes = 1 }
-		when ('T') { $edata{relative_times}    = 1 }
-		default    { $edata{$efield}           = 1 }
-	}
-}
-
-my ($stop_name) = @ARGV;
-
-my $status
-  = Travel::Status::DE::ASEAG->new( developer_mode => $developer_mode );
-
-sub show_help {
-	my ($code) = @_;
-
-	print 'Usage: aseag-m [-pV] [-o <output>] [-l <lines>] [-v <stopname>] '
-	  . "<stopname>\n"
-	  . "See also: man aseag-m\n";
-
-	exit $code;
-}
-
-sub show_version {
-	say "aseag-m version ${VERSION}";
-
-	exit 0;
-}
-
-sub display_result {
-	my (@lines) = @_;
-
-	if ( not @lines ) {
-		die("Nothing to show\n");
-	}
-
-	my $max_col_idx = $#{ $lines[0] } - 1;
-
-	my @format = (q{%-}) x ( $max_col_idx + 1 );
-
-	if ( $edata{relative_times} ) {
-		$format[0] = q{%};
-	}
-
-	for my $i ( 0 .. $max_col_idx ) {
-		$format[$i] .= max map { length( $_->[$i] ) } @lines;
-		$format[$i] .= 's';
-	}
-
-	for my $line (@lines) {
-
-		printf( join( q{  }, @format ) . "\n", @{$line}[ 0 .. $max_col_idx ] );
-
-		if ( @{ $line->[ $max_col_idx + 1 ] } ) {
-			for my $route ( @{ $line->[ $max_col_idx + 1 ] } ) {
-				printf( join( q{  }, @format ) . "\n", @{$route} );
-			}
-			print "\n";
-		}
-	}
-
-	return;
-}
-
-sub get_exact_stop_name {
-	my ($fuzzy_name) = @_;
-
-	my @stops = $status->get_stop_by_name($fuzzy_name);
-
-	if ( @stops == 0 ) {
-		say STDERR "Got no departures for '$fuzzy_name'";
-		say STDERR 'The stop may not exist or not be in service right now';
-		exit(3);
-	}
-	elsif ( @stops == 1 ) {
-		return $stops[0];
-	}
-	else {
-		say STDERR "The stop name '$fuzzy_name' is ambiguous. Please choose "
-		  . 'one of the following:';
-		say STDERR join( "\n", @stops );
-		exit(3);
-	}
-}
-
-sub show_route {
-	my ( $dt_now, $dt_format, @routes ) = @_;
-	my @res;
-
-	if ( $edata{relative_times} ) {
-		@res = map {
-			[
-				$dt_format->format_duration(
-					$_->datetime->subtract_datetime($dt_now)
-				),
-				q{},
-				$_->name,
-				q{},
-			]
-		} @routes;
-	}
-	else {
-		@res = map {
-			[ $_->datetime->strftime($strftime_format), q{}, $_->name, q{}, ]
-		} @routes;
-	}
-
-	return @res;
-}
-
-sub show_results {
-	my @output;
-
-	my $dt_now = DateTime->now( time_zone => 'Europe/Berlin' );
-	my $dt_format
-	  = DateTime::Format::Duration->new( pattern => $strfrel_format );
-
-	for my $d (
-		$status->results(
-			calculate_routes => $calculate_routes,
-			hide_past        => $hide_past,
-			stop             => $stop_name,
-			via              => $via,
-		)
-	  )
-	{
-
-		if ( ( @grep_lines and not( $d->line ~~ \@grep_lines ) ) ) {
-			next;
-		}
-		my ( @line, @route );
-
-		if ( $edata{route_full} ) {
-			@route = (
-				show_route( $dt_now, $dt_format, $d->route_pre ),
-				[ ' - - - -', q{}, q{}, q{} ],
-				show_route( $dt_now, $dt_format, $d->route_post ),
-			);
-		}
-		elsif ( $edata{route_after} ) {
-			@route = show_route( $dt_now, $dt_format, $d->route_post );
-		}
-		elsif ( $edata{route_before} ) {
-			@route = reverse show_route( $dt_now, $dt_format, $d->route_pre );
-		}
-
-		if ( $edata{relative_times} ) {
-			@line = (
-				$dt_format->format_duration(
-					$d->datetime->subtract_datetime($dt_now)
-				),
-				$d->line,
-				q{},
-				$d->destination,
-				\@route,
-			);
-		}
-		else {
-			@line = (
-				$d->datetime->strftime($strftime_format),
-				$d->line, q{}, $d->destination, \@route,
-			);
-		}
-
-		if ( $edata{indicator} ) {
-			splice( @line, 1, 0, $d->stop_indicator );
-		}
-
-		if ( $edata{route_interesting} ) {
-			$line[2] = join( q{  }, map { $_->name } $d->route_interesting );
-		}
-
-		push( @output, \@line );
-	}
-
-	display_result(@output);
-
-	return;
-}
-
-if ( my $err = $status->errstr ) {
-	say STDERR "Request error: ${err}";
-	exit 2;
-}
-
-$stop_name = get_exact_stop_name($stop_name);
-if ($via) {
-	$via = get_exact_stop_name($via);
-}
-show_results();
-
-__END__
-
-=head1 NAME
-
-aseag-m - Unofficial interface to the ASEAG departure monitor
-
-=head1 SYNOPSIS
-
-B<aseag-m> [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>]
-[B<-s> I<timefmt> | B<-S> I<timefmt>]
-[B<-v> I<stopname>] I<stopname>
-
-=head1 VERSION
-
-version 1.02
-
-=head1 DESCRIPTION
-
-B<aseag-m> lists upcoming bus departures at the ASEAG stop I<name>.
-It only shows realtime data and has no knowledge of schedules or delays.
-Departures without such data may not appear at all.
-
-=head1 OPTIONS
-
-=over
-
-=item B<-l>, B<--line> I<lines>
-
-Limit output to departures of I<lines> (comma-separated list of line
-names, may be used multiple times).
-
-=item B<-o>, B<--output> I<outputtypes>
-
-Format output according to I<outputtypes>. I<outputtypes> is a
-comma-separated list and the B<--output> option may be repeated. Each
-output type has both a short and a long form, so for instance both
-C<< -or,T >> and C<< --output=route_interesting,relative_times >> are valid.
-
-Valid output types are:
-
-=over
-
-=item a / route_after
-
-For each departure, include the route after I<name>. Both stop names and
-departure times are shown.
-
-=item b / route_before
-
-For each departure, include the route leading to I<name>. Both stop names and
-departure times are shown.
-
-=item f / route_full
-
-For each departure, include the entire route (stop names and departure times).
-
-=item i / indicator
-
-Show stop point indicator, if available. This is usually a sub-stop or
-platform number, such as "H3".
-
-=item r / route_interesting
-
-For each departure, show up to three "interesting" stops between I<name> and
-its destination. The importance of a stop is determined heuristically based on
-its name, so it is not always accurate.
-
-=item T / relative_times
-
-Show relative times. Applies to departure and route output.
-
-=back
-
-Note that the routes may be incomplete, since the backend only provides a
-limited amount of departures and the routes are calculated from this set.
-intermediate stops are always included, but both route_after and route_before
-may be cut off after / before any stop. The same applies to route_full.
-
-=item B<-p>, B<--with-past>
-
-Include past departures. Applies both to the departure output and to the
-route output of B<-oa>, B<-ob>, B<-of>.
-
-=item B<-s>, B<--strftime> I<format>
-
-Format absolute times in I<format>, applies both to departure and route
-output.  See DateTime(3pm) for allowed patterns.
-
-=item B<-S>, B<--strfrel> I<format>
-
-Format relative times in I<format>, only applies when used with B<-oT>.
-See DateTime::Format::Duration(3pm) for allowed patterns.
-
-=item B<-v>, B<--via> I<stop>
-
-Only show lines which also serve I<stop> after I<name>.
-
-=item B<-V>, B<--version>
-
-Show version information.
-
-=back
-
-=head1 EXIT STATUS
-
-Normally zero. B<1> means B<aseag-m> was called with invalid options,
-B<2> indicates a request error from Travel::Status::DE::URA(3pm),
-B<3> a bad (unknown or ambiguous) I<stop> name.
-
-=head1 CONFIGURATION
-
-None.
-
-=head1 DEPENDENCIES
-
-=over
-
-=item * Class::Accessor(3pm)
-
-=item * DateTime(3pm)
-
-=item * DateTime::Format::Duration(3pm)
-
-=item * LWP::UserAgent(3pm)
-
-=item * Text::CSV(3pm)
-
-=back
-
-=head1 BUGS AND LIMITATIONS
-
-Unknown.
-
-=head1 AUTHOR
-
-Copyright (C) 2013-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
-
-=head1 LICENSE
-
-This program is licensed under the same terms as Perl itself.
diff --git a/bin/tfl-m b/bin/ura-m
index 96c1da5..72fd8d6 100755
--- a/bin/tfl-m
+++ b/bin/ura-m
@@ -12,8 +12,8 @@ binmode( STDOUT, ':encoding(utf-8)' );
 use DateTime;
 use DateTime::Format::Duration;
 use Getopt::Long qw(:config no_ignore_case bundling);
-use List::Util qw(max);
-use Travel::Status::DE::TFL;
+use List::Util qw(first max);
+use Travel::Status::DE::URA;
 
 my (@grep_lines);
 my $hide_past       = 1;
@@ -23,20 +23,31 @@ my ( %edata, @edata_pre );
 my $calculate_routes = 0;
 my $developer_mode;
 my $via;
+my ( $list_services, $service );
+my $ura_base    = 'http://ivu.aseag.de/interfaces/ura';
+my $ura_version = 1;
 
 GetOptions(
-	'h|help'      => sub { show_help(0) },
-	'l|line=s@'   => \@grep_lines,
-	'o|output=s@' => \@edata_pre,
-	'p|with-past' => sub { $hide_past = 0 },
-	's|strftime=s' => \$strftime_format,
-	'S|strfrel=s'  => \$strfrel_format,
-	'v|via=s'      => \$via,
-	'V|version'    => \&show_version,
-	'devmode'      => \$developer_mode,
+	'f|strftime=s'  => \$strftime_format,
+	'F|strfrel=s'   => \$strfrel_format,
+	'h|help'        => sub { show_help(0) },
+	'l|line=s@'     => \@grep_lines,
+	'L|list'        => \$list_services,
+	'o|output=s@'   => \@edata_pre,
+	'p|with-past'   => sub { $hide_past = 0 },
+	's|service=s'   => \$service,
+	'v|via=s'       => \$via,
+	'V|version'     => \&show_version,
+	'devmode'       => \$developer_mode,
+	'ura-base=s'    => \$ura_base,
+	'ura-version=s' => \$ura_version,
 
 ) or show_help(1);
 
+if ($list_services) {
+	show_services(0);
+}
+
 if ( @ARGV != 1 ) {
 	show_help(1);
 }
@@ -57,23 +68,51 @@ for my $efield (@edata_pre) {
 	}
 }
 
+if ($service) {
+	my $service_ref = first { lc( $_->{shortname} ) eq lc($service) }
+	Travel::Status::DE::URA::get_services();
+	if ( not $service_ref ) {
+		printf STDERR (
+"Error: Unknown service '%s'. The following services are supported:\n\n",
+			$service
+		);
+		show_services(1);
+	}
+	$ura_base    = $service_ref->{ura_base};
+	$ura_version = $service_ref->{ura_version};
+}
+
 my ($stop_name) = @ARGV;
 
-my $status
-  = Travel::Status::DE::TFL->new( developer_mode => $developer_mode );
+my $status = Travel::Status::DE::URA->new(
+	developer_mode => $developer_mode,
+	ura_base       => $ura_base,
+	ura_version    => $ura_version,
+);
 
 sub show_help {
 	my ($code) = @_;
 
-	print 'Usage: tfl-m [-pV] [-o <output>] [-l <lines>] [-v <stopname>] '
+	print "Usage: $0 [-pV] [-o <output>] [-l <lines>] [-v <stopname>] "
 	  . "<stopname>\n"
-	  . "See also: man tfl-m\n";
+	  . "See also: man ura-m\n";
+
+	exit $code;
+}
+
+sub show_services {
+	my ($code) = @_;
+
+	printf( "%-60s %-14s %s\n\n", 'service', 'abbr. (-s)', 'url (-u)' );
+	for my $service ( Travel::Status::DE::URA::get_services() ) {
+		printf( "%-60s %-14s %s\n", @{$service}{qw(name shortname ura_base)} );
+	}
 
 	exit $code;
 }
 
 sub show_version {
-	say "tfl-m version ${VERSION}";
+	say "$0 version ${VERSION}";
 
 	exit 0;
 }
@@ -244,11 +283,11 @@ __END__
 
 =head1 NAME
 
-tfl-m - Unofficial interface to the TFL departure monitor
+ure-m - Unofficial interface to URA-based departure monitors
 
 =head1 SYNOPSIS
 
-B<tfl-m> [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>]
+B<ura-m> [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>]
 [B<-s> I<timefmt> | B<-S> I<timefmt>]
 [B<-v> I<stopname>] I<stopname>
 
@@ -258,7 +297,7 @@ version 1.02
 
 =head1 DESCRIPTION
 
-B<tfl-m> lists upcoming bus departures at the TFL stop I<name>.
+B<ura-m> lists upcoming bus departures at the URA stop I<name>.
 It only shows realtime data and has no knowledge of schedules or delays.
 Departures without such data may not appear at all.
 
@@ -345,7 +384,7 @@ Show version information.
 
 =head1 EXIT STATUS
 
-Normally zero. B<1> means B<tfl-m> was called with invalid options,
+Normally zero. B<1> means B<ura-m> was called with invalid options,
 B<2> indicates a request error from Travel::Status::DE::URA(3pm),
 B<3> a bad (unknown or ambiguous) I<stop> name.
 
diff --git a/lib/Travel/Status/DE/URA.pm b/lib/Travel/Status/DE/URA.pm
index ea8ed69..7c03ff0 100644
--- a/lib/Travel/Status/DE/URA.pm
+++ b/lib/Travel/Status/DE/URA.pm
@@ -3,6 +3,7 @@ package Travel::Status::DE::URA;
 use strict;
 use warnings;
 use 5.010;
+use utf8;
 
 no if $] >= 5.018, warnings => 'experimental::smartmatch';
 
@@ -337,6 +338,24 @@ sub results {
 	return @results;
 }
 
+# static
+sub get_services {
+	return (
+		{
+			ura_base    => 'http://ivu.aseag.de/interfaces/ura',
+			ura_version => 1,
+			name        => 'Aachener Straßenbahn und Energieversorgungs AG',
+			shortname   => 'ASEAG',
+		},
+		{
+			ura_base    => 'http://countdown.api.tfl.gov.uk/interfaces/ura',
+			ura_version => 1,
+			name        => 'Transport for London',
+			shortname   => 'TfL',
+		}
+	);
+}
+
 1;
 
 __END__