initial commit

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.