initial commit

2 files changed, 390 insertions, 0 deletions

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.