diff options
Diffstat (limited to 'bin')
| -rwxr-xr-x | bin/aseag-m | 305 | ||||
| -rwxr-xr-x | bin/ura-m | 467 |
2 files changed, 467 insertions, 305 deletions
diff --git a/bin/aseag-m b/bin/aseag-m deleted file mode 100755 index 757a794..0000000 --- a/bin/aseag-m +++ /dev/null @@ -1,305 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use 5.010; - -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - -our $VERSION = '0.02'; - -binmode( STDOUT, ':encoding(utf-8)' ); - -use DateTime; -use DateTime::Format::Duration; -use Getopt::Long qw(:config no_ignore_case); -use List::Util qw(max); -use Travel::Status::DE::ASEAG; - -my (@grep_lines); -my $full_route = 0; -my $hide_past = 1; -my $relative_times = 0; -my $strftime_format = '%H:%M:%S'; -my $strfrel_format = '%M min'; -my $via; - -GetOptions( - 'a|route-after' => sub { $full_route = 'after' }, - 'b|route-before' => sub { $full_route = 'before' }, - 'h|help' => sub { show_help(0) }, - 'f|full-route' => \$full_route, - 'l|line=s@' => \@grep_lines, - 'p|with-past' => sub { $hide_past = 0 }, - 'r|relative' => \$relative_times, - 's|strftime=s' => \$strftime_format, - 'S|strfrel=s' => \$strfrel_format, - 'v|via=s' => \$via, - 'V|version' => \&show_version, - -) or show_help(1); - -if ( @ARGV != 1 ) { - show_help(1); -} - -# --line=foo,bar support -@grep_lines = split( qr{,}, join( q{,}, @grep_lines ) ); - -my ($stop_name) = @ARGV; - -my $status = Travel::Status::DE::ASEAG->new; - -sub show_help { - my ($code) = @_; - - print "Usage: aseag-m [-abfprV] [-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) = @_; - - my @format = qw(%- %- %-); - - if ( not @lines ) { - die("Nothing to show\n"); - } - - if ($relative_times) { - $format[0] = q{%}; - } - - for my $i ( 0 .. 2 ) { - $format[$i] .= max map { length( $_->[$i] ) } @lines; - $format[$i] .= 's'; - } - - for my $line (@lines) { - - printf( join( q{ }, @format ) . "\n", @{$line}[ 0 .. 2 ] ); - - if ($full_route) { - print "\n" . $line->[3] . "\n\n\n"; - } - } - - return; -} - -sub get_exact_stop_name { - my ($fuzzy_name) = @_; - - my @stops = $status->get_stop_by_name($fuzzy_name); - - if ( @stops == 0 ) { - say STDERR "No stops match '$fuzzy_name'"; - exit(3); - } - elsif ( @stops == 1 ) { - return $stops[0]; - } - else { - say STDERR "The stop '$fuzzy_name' is ambiguous. Please choose one " - . 'of the following:'; - say STDERR join( "\n", @stops ); - exit(3); - } -} - -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( - full_routes => $full_route, - hide_past => $hide_past, - stop => $stop_name, - via => $via, - ) - ) - { - - if ( ( @grep_lines and not( $d->line ~~ \@grep_lines ) ) ) { - next; - } - - if ($relative_times) { - push( - @output, - [ - $dt_format->format_duration( - $d->datetime->subtract_datetime($dt_now) - ), - $d->line, - $d->destination, - join( - "\n", - map { - sprintf( - '%s %s', - $dt_format->format_duration( - $_->[0]->subtract_datetime($dt_now) - ), - $_->[1] - ) - } $d->route_timetable - ) - ] - ); - } - else { - push( - @output, - [ - $d->datetime->strftime($strftime_format), - $d->line, - $d->destination, - join( - "\n", - map { - sprintf( '%s %s', - $_->[0]->strftime($strftime_format), - $_->[1] ) - } $d->route_timetable - ) - ] - ); - } - } - - 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<-abfprV>] [B<-l> I<lines>] [B<-s> I<timefmt> | B<-S> I<timefmt>] -[B<-v> I<stopname>] I<stopname> - -=head1 VERSION - -version 0.02 - -=head1 DESCRIPTION - -B<aseag-m> lists upcoming bus departures at the ASEAG stop I<name>. - -=head1 OPTIONS - -=over - -=item B<-a>, B<--route-after> - -For each departure, include the route leading to I<name>. Both stop names and -departure times are shown. - -=item B<-b>, B<--route-before> - -For each departure, include the route after I<name>. Both stop names and -departure times are shown. - -=item B<-f>, B<--full-route> - -For each departure, include the entire route (stop names and departure times). - -=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<-p>, B<--with-past> - -Include past departures. Applies both to the departure output and to the -route output of B<-a>, B<-b>, B<-f>. - -=item B<-r>, B<--relative> - -Show relative times. Appleas both to departure and route output. - -=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<-r>. -See DateTime::Format::Duration(3pm) for allowed patterns. - -=item B<-v>, B<--via> I<stop> - -Only show lines which will also service I<stop> after I<name>. With B<-b>, -I<stop> must be in the schedule before I<name>, with B<-f> it may be anywhere, -with B<-a> (and by default) it must be 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::EFA(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) - -=back - -=head1 BUGS AND LIMITATIONS - -Unknown. - -=head1 AUTHOR - -Copyright (C) 2013 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/ura-m b/bin/ura-m new file mode 100755 index 0000000..eacfc86 --- /dev/null +++ b/bin/ura-m @@ -0,0 +1,467 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.010; + +our $VERSION = '2.01'; + +binmode( STDOUT, ':encoding(utf-8)' ); + +use DateTime; +use DateTime::Format::Duration; +use Getopt::Long qw(:config no_ignore_case bundling); +use List::Util qw(any first max); +use Travel::Status::DE::URA; + +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; +my ( $list_services, $service ); +my $ura_base = 'http://ivu.aseag.de/interfaces/ura'; +my $ura_version = 1; +my $script_name = ( split( qr{/}, $0 ) )[-1]; + +GetOptions( + 'f|strftime=s' => \$strftime_format, + 'F|strfrel=s' => \$strfrel_format, + 'h|help' => sub { show_help(0) }, + 'l|line=s@' => \@grep_lines, + '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, + 'list' => \$list_services, + '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); +} + +if ( not $service and $script_name ne 'ura-m' ) { + ($service) = ( $script_name =~ m{ ^ ( [^-]+ ) -m $ }x ); +} + +# --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) { + if ( $efield eq 'a' ) { $edata{route_after} = 1; $calculate_routes = 1 } + elsif ( $efield eq 'b' ) { $edata{route_before} = 1; $calculate_routes = 1 } + elsif ( $efield eq 'f' ) { $edata{route_full} = 1; $calculate_routes = 1 } + elsif ( $efield eq 'i' ) { $edata{indicator} = 1 } + elsif ( $efield eq 'r' ) { + $edata{route_interesting} = 1; + $calculate_routes = 1; + } + elsif ( $efield eq 'T' ) { $edata{relative_times} = 1 } + else { $edata{$efield} = 1 } +} + +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::URA->new( + developer_mode => $developer_mode, + ura_base => $ura_base, + ura_version => $ura_version, + with_messages => 1, +); + +sub show_help { + my ($code) = @_; + + print + "Usage: $script_name [-pV] [-o <output>] [-l <lines>] [-v <stopname>] " + . "<stopname>\n" + . "See also: man ura-m\n"; + + exit $code; +} + +sub show_services { + my ($code) = @_; + + printf( "%-60s %-14s %s\n\n", 'service', 'abbr. (-s)', 'url (--ura-base)' ); + 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 "$script_name 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 $m ( $status->messages_by_stop_name($stop_name) ) { + printf( "# %s\n", $m ); + } + + for my $d ( + $status->results( + calculate_routes => $calculate_routes, + hide_past => $hide_past, + stop => $stop_name, + via => $via, + ) + ) + { + + if ( ( @grep_lines and not( any { $d->line eq $_ } @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 + +ura-m - Unofficial interface to URA-based departure monitors + +=head1 SYNOPSIS + +B<ura-m> [B<-s> I<service>] [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>] +[B<-f> I<timefmt> | B<-F> I<timefmt>] +[B<-v> I<stopname>] I<stopname> + +=head1 VERSION + +version 2.01 + +=head1 DESCRIPTION + +B<ura-m> lists upcoming bus departures and bus service messages at the 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 OPERATOR SELECTION + +By default, B<ura-m> looks up departures for stops operated by ASEAG (Aachener +StraE<szlig>enbahn und Energieversorgungs AG), so it only works for Aachen and +its vicinity. Other operators (and, thus, other areas) can be selected using +either the B<-s>/B<--service> option, the B<--ura-base> option, or the program +name. + +By creating a I<service>-m symlink to B<ura-m>, it will default to the URA +interface operated by I<service>, as if B<-s> I<service> was specified. So, +for example, linking tfl-m to ura-m will request departures for TfL-operated +stops, and linking aseag-m to ura-m will request departures for ASEAG-operated +stops. + +Use the B<--list> option to get a list of supported backend services. + +=head1 OPTIONS + +=over + +=item B<-f>, 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<-F>, 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<-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<--list> + +List supported URA services with their URLs (see B<--ura-base>) and +abbreviations (see B<-s>). + +=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<--service> I<service> + +Request departures for URA instance I<service>, e.g. ASEAG (Aachen, Germany) +or TfL (London, UK). Use B<--list> to get a list of supported URA instances. +Note that I<service> is not case sensitive. + +=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. + +=item B<--ura-base> I<url> + +Set URA base to I<url>, defaults to C<< http://ivu.aseag.de/interfaces/ura >>. +See also B<--list> and B<-s>. + +=item B<--ura-version> I<version> + +Set URA API version to I<version>, defaults to C<< 1 >>. + +=back + +=head1 EXIT STATUS + +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. + +=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-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This program is licensed under the same terms as Perl itself. |