summaryrefslogtreecommitdiff
path: root/lib/Travel/Status
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status')
-rw-r--r--lib/Travel/Status/DE/ASEAG.pm249
-rw-r--r--lib/Travel/Status/DE/ASEAG/Result.pm141
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.