summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore10
-rw-r--r--Build.PL29
-rw-r--r--COPYING4
-rwxr-xr-xbin/aseag-m172
-rw-r--r--lib/Travel/Status/DE/ASEAG.pm249
-rw-r--r--lib/Travel/Status/DE/ASEAG/Result.pm141
6 files changed, 605 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..189304f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,10 @@
+/_build
+/Build
+/blib
+/cover_db
+/MANIFEST
+/MANIFEST.bak
+/MANIFEST.SKIP
+/MANIFEST.SKIP.bak
+/MYMETA.yml
+/MYMETA.json
diff --git a/Build.PL b/Build.PL
new file mode 100644
index 0000000..19e5e59
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Module::Build;
+
+Module::Build->new(
+
+ build_requires => {
+ 'File::Slurp' => 0,
+ 'Test::More' => 0,
+ 'Test::Pod' => 0,
+ },
+ configure_requires => {
+ 'Module::Build' => 0.40,
+ },
+ module_name => 'Travel::Status::DE::ASEAG',
+ license => 'perl',
+ requires => {
+ 'perl' => '5.10.1',
+ 'Carp' => 0,
+ 'Class::Accessor' => 0,
+ 'Getopt::Long' => 0,
+ 'List::Util' => 0,
+ 'LWP::UserAgent' => 0,
+ },
+ sign => 1,
+
+)->create_build_script();
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..15afa80
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,4 @@
+Copyright (C) 2013 Daniel Friesel <derf@finalrewind.org>
+
+All files in this distribution are licensed under the same terms as Perl
+itself.
diff --git a/bin/aseag-m b/bin/aseag-m
new file mode 100755
index 0000000..70eaeb9
--- /dev/null
+++ b/bin/aseag-m
@@ -0,0 +1,172 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+
+no if $] >= 5.018, warnings => "experimental::smartmatch";
+
+our $VERSION = '0.00';
+
+binmode( STDOUT, ':encoding(utf-8)' );
+
+use Getopt::Long qw(:config no_ignore_case);
+use List::Util qw(max);
+use Travel::Status::DE::ASEAG;
+
+my ( @grep_lines );
+
+GetOptions(
+ 'h|help' => sub { show_help(0) },
+ 'l|line=s@' => \@grep_lines,
+ '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(
+ name => $stop_name,
+);
+
+sub show_help {
+ my ($code) = @_;
+
+ print "Usage: aseag-m <stop name>\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 @line_length;
+
+ if ( not @lines ) {
+ die("Nothing to show\n");
+ }
+
+ for my $i ( 0 .. 2 ) {
+ $line_length[$i] = max map { length( $_->[$i] ) } @lines;
+ }
+
+ for my $line (@lines) {
+
+ printf(
+ join( q{ }, ( map { "%-${_}s" } @line_length ) ) . "\n",
+ @{$line}[ 0 .. 2 ]
+ );
+ }
+
+ return;
+}
+
+sub show_results {
+ my @output;
+
+ for my $d ( $status->results ) {
+
+ my $dtime = $d->time;
+
+ if (
+ ( @grep_lines and not( $d->line ~~ \@grep_lines ) )
+ )
+ {
+ next;
+ }
+
+ push( @output,
+ [ $dtime, $d->line, $d->destination ] );
+ }
+
+ display_result(@output);
+
+ return;
+}
+
+if ( my $err = $status->errstr ) {
+ say STDERR "Request error: ${err}";
+ exit 2;
+}
+
+show_results();
+
+__END__
+
+=head1 NAME
+
+efa-m - Unofficial interface to the efa.vrr.de departure monitor
+
+=head1 SYNOPSIS
+
+B<efa-m> [B<-d> I<date>] [B<-t> I<time>] I<city> [I<type>B<:>]I<name>
+
+=head1 VERSION
+
+version 1.04
+
+=head1 DESCRIPTION
+
+B<efa-m> lists upcoming tram, bus and train departures at the location I<name>
+in I<city>.
+
+By default, I<name> refers to a stop, this can be changed by specifying
+I<type>. Supported types are B<address> and B<poi> (point of interest).
+
+=head1 OPTIONS
+
+=over
+
+=item B<-l>, B<--line> I<lines>
+
+Only show departures of I<lines> (comma-separatad list, option may be
+repeated)
+
+=item B<-V>, B<--version>
+
+Show version information.
+
+=back
+
+=head1 EXIT STATUS
+
+Zero.
+
+=head1 CONFIGURATION
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item * Class::Accessor(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/lib/Travel/Status/DE/ASEAG.pm b/lib/Travel/Status/DE/ASEAG.pm
new file mode 100644
index 0000000..8311ad6
--- /dev/null
+++ b/lib/Travel/Status/DE/ASEAG.pm
@@ -0,0 +1,249 @@
+package Travel::Status::DE::ASEAG;
+
+use strict;
+use warnings;
+use 5.010;
+
+no if $] >= 5.018, warnings => "experimental::smartmatch";
+
+our $VERSION = '0.00';
+
+use Carp qw(confess cluck);
+use DateTime;
+use Encode qw(encode decode);
+use Travel::Status::DE::ASEAG::Result;
+use LWP::UserAgent;
+
+sub new {
+ my ( $class, %opt ) = @_;
+
+ my $ua = LWP::UserAgent->new(%opt);
+
+ my $self = {
+ fuzzy => $opt{fuzzy} // 1,
+ stop => $opt{name},
+ post => {
+ ReturnList =>
+ 'lineid,linename,directionid,destinationtext,vehicleid,'
+ .'tripid,estimatedtime,stopid,stoppointname'
+ },
+ };
+
+ bless( $self, $class );
+
+ $ua->env_proxy;
+
+ my $response
+ = $ua->post( 'http://ivu.aseag.de/interfaces/ura/instant_V1', $self->{post} );
+
+ if ( $response->is_error ) {
+ $self->{errstr} = $response->status_line;
+ return $self;
+ }
+
+ $self->{raw} = $response->decoded_content;
+
+ return $self;
+}
+
+sub new_from_xml {
+ my ( $class, %opt ) = @_;
+
+ my $self = { raw => $opt{raw}, };
+
+ return bless( $self, $class );
+}
+
+sub errstr {
+ my ($self) = @_;
+
+ return $self->{errstr};
+}
+
+sub sprintf_date {
+ my ($e) = @_;
+
+ return sprintf( '%02d.%02d.%d',
+ $e->getAttribute('day'),
+ $e->getAttribute('month'),
+ $e->getAttribute('year'),
+ );
+}
+
+sub sprintf_time {
+ my ($e) = @_;
+
+ return sprintf( '%02d:%02d',
+ $e->getAttribute('hour'),
+ $e->getAttribute('minute'),
+ );
+}
+
+sub is_my_stop {
+ my ($self, $stop) = @_;
+ my $my_stop = $self->{stop};
+
+ if ($self->{fuzzy}) {
+ return ($stop =~ m{ $my_stop }ix ? 1 : 0);
+ }
+ else {
+ return ($stop eq $my_stop);
+ }
+}
+
+sub results {
+ my ($self) = @_;
+ my @results;
+
+ my $dt_now = DateTime->now( time_zone => 'Europe/Berlin' );
+
+ for my $dep (split(/\r\n/, $self->{raw})) {
+ $dep =~ s{^\[}{};
+ $dep =~ s{\]$}{};
+
+ my ($u1, $stopname, $stopid, $lineid, $linename, $u2, $dest,
+ $vehicleid, $tripid, $timestamp) = split(/"?,"?/, $dep);
+
+ # version information
+ if ($u1 == 4) {
+ next;
+ }
+
+ if ($self->{stop} and not $self->is_my_stop($stopname)) {
+ next;
+ }
+
+ if (not $timestamp) {
+ cluck("departure element without timestamp: $dep");
+ next;
+ }
+
+ my $dt_dep = DateTime->from_epoch(
+ epoch => $timestamp / 1000,
+ time_zone => 'Europe/Berlin' );
+
+ push(@results, Travel::Status::DE::ASEAG::Result->new(
+ date => $dt_dep->strftime('%d.%m.%Y'),
+ time => $dt_dep->strftime('%H:%M:%S'),
+ datetime => $dt_dep,
+ line => $linename,
+ line_id => $lineid,
+ destination => decode( 'UTF-8', $dest ),
+ countdown => $dt_dep->subtract_datetime($dt_now)->in_units('minutes'),
+ countdown_sec => $dt_dep->subtract_datetime($dt_now)->in_units('seconds'),
+ ));
+ }
+
+ @results = map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] }
+ map { [ $_, $_->countdown ] } @results;
+
+ $self->{results} = \@results;
+
+ return @results;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::ASEAG - unofficial ASEAG departure monitor
+
+=head1 SYNOPSIS
+
+ use Travel::Status::DE::ASEAG;
+
+ my $status = Travel::Status::DE::ASEAG->new(
+ name => 'Aachen Bushof'
+ );
+
+ for my $d ($status->results) {
+ printf(
+ "%s %-5s %25s (in %d min)\n",
+ $d->time, $d->line, $d->destination, $d->countdown
+ );
+ }
+
+=head1 VERSION
+
+version 1.04
+
+=head1 DESCRIPTION
+
+Travel::Status::DE::ASEAG is an unofficial interface to the ASEAG departure
+monitor available at
+L<http://efa.vrr.de/vrr/XSLT_DM_REQUEST?language=de&itdLPxx_transpCompany=vrr&>.
+
+It reports all upcoming tram/bus/train departures at a given place.
+
+=head1 METHODS
+
+=over
+
+=item my $status = Travel::Status::DE::ASEAG->new(I<%opt>)
+
+Requests the departures as specified by I<opts> and returns a new
+Travel::Status::DE::ASEAG object. Dies if the wrong I<opts> were passed.
+
+Arguments:
+
+=over
+
+=item B<place> => I<place>
+
+Name of the place/city
+
+=item B<type> => B<address>|B<poi>|B<stop>
+
+Type of the following I<name>. B<poi> means "point of interest". Defaults to
+B<stop> (stop/station name).
+
+=item B<name> => I<name>
+
+address / poi / stop name to list departures for.
+
+=back
+
+=item $status->errstr
+
+In case of an HTTP request error, returns a string describing it. If none
+occured, returns undef.
+
+=item $status->results
+
+Returns a list of Travel::Status::DE::ASEAG::Result(3pm) objects, each describing
+one departure.
+
+=back
+
+=head1 DIAGNOSTICS
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item * Class::Accessor(3pm)
+
+=item * LWP::UserAgent(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+Many.
+
+=head1 SEE ALSO
+
+aseag-m(1), Travel::Status::DE::ASEAG::Result(3pm).
+
+=head1 AUTHOR
+
+Copyright (C) 2013 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
diff --git a/lib/Travel/Status/DE/ASEAG/Result.pm b/lib/Travel/Status/DE/ASEAG/Result.pm
new file mode 100644
index 0000000..668ba1d
--- /dev/null
+++ b/lib/Travel/Status/DE/ASEAG/Result.pm
@@ -0,0 +1,141 @@
+package Travel::Status::DE::ASEAG::Result;
+
+use strict;
+use warnings;
+use 5.010;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.00';
+
+Travel::Status::DE::ASEAG::Result->mk_ro_accessors(
+ qw(countdown countdown_sec date datetime destination line line_id time)
+);
+
+sub new {
+ my ( $obj, %conf ) = @_;
+
+ my $ref = \%conf;
+
+ return bless( $ref, $obj );
+}
+
+sub TO_JSON {
+ my ($self) = @_;
+
+ return { %{$self} };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::ASEAG::Result - Information about a single
+departure received by Travel::Status::DE::ASEAG
+
+=head1 SYNOPSIS
+
+ for my $departure ($status->results) {
+ printf(
+ "At %s: %s to %s (in %d minutes)",
+ $departure->time, $departure->line, $departure->destination,
+ $departure->countdown
+ );
+ }
+
+=head1 VERSION
+
+version 0.00
+
+=head1 DESCRIPTION
+
+Travel::Status::DE::ASEAG::Result describes a single departure as obtained by
+Travel::Status::DE::ASEAG. It contains information about the time,
+line number and destination.
+
+=head1 METHODS
+
+=head2 ACCESSORS
+
+=over
+
+=item $departure->countdown
+
+Time in minutes from the time Travel::Status::DE::ASEAG was instantiated until
+the bus will depart.
+
+=item $departure->countdown_sec
+
+Time in seconds from the time Travel::Status::DE::ASEAG was instantiated until
+the bus will depart.
+
+=item $departure->date
+
+Departure date (DD.MM.YYYY)
+
+=item $departure->datetime
+
+DateTime object holding the departure date and time.
+
+=item $departure->destination
+
+Destination name.
+
+=item $departure->line
+
+The name of the line.
+
+=item $departure->line_id
+
+The number of the line.
+
+=item $departure->time
+
+Departure time (HH:MM:SS).
+
+=back
+
+=head2 INTERNAL
+
+=over
+
+=item $departure = Travel::Status::DE::ASEAG::Result->new(I<%data>)
+
+Returns a new Travel::Status::DE::ASEAG::Result object. You should not need to
+call this.
+
+=item $departure->TO_JSON
+
+Allows the object data to be serialized to JSON.
+
+=back
+
+=head1 DIAGNOSTICS
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item Class::Accessor(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+Unknown.
+
+=head1 SEE ALSO
+
+Travel::Status::DE::ASEAG(3pm).
+
+=head1 AUTHOR
+
+Copyright (C) 2013 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 08:45:09 +0000