diff options
Diffstat (limited to 'lib/Travel/Status/DE')
| -rw-r--r-- | lib/Travel/Status/DE/VRR.pm | 70 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/VRR/Line.pm | 130 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/VRR/Result.pm | 3 |
3 files changed, 201 insertions, 2 deletions
diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm index 065d56c..dd149e8 100644 --- a/lib/Travel/Status/DE/VRR.pm +++ b/lib/Travel/Status/DE/VRR.pm @@ -6,8 +6,9 @@ use 5.010; our $VERSION = '0.02'; -use Carp qw(confess); +use Carp qw(confess cluck); use Encode qw(encode decode); +use Travel::Status::DE::VRR::Line; use Travel::Status::DE::VRR::Result; use LWP::UserAgent; use XML::LibXML; @@ -146,6 +147,59 @@ sub sprintf_time { ); } +sub lines { + my ($self) = @_; + my @lines; + + my $xp_element + = XML::LibXML::XPathExpression->new('//itdServingLines/itdServingLine'); + + my $xp_info = XML::LibXML::XPathExpression->new('./itdNoTrain'); + my $xp_route = XML::LibXML::XPathExpression->new('./itdRouteDescText'); + my $xp_oper = XML::LibXML::XPathExpression->new('./itdOperator/name'); + + if ( $self->{lines} ) { + return @{ $self->{lines} }; + } + + for my $e ( $self->{tree}->findnodes($xp_element) ) { + + my $e_info = ( $e->findnodes($xp_info) )[0]; + my $e_route = ( $e->findnodes($xp_route) )[0]; + my $e_oper = ( $e->findnodes($xp_oper) )[0]; + + if ( not( $e_info and $e_route and $e_oper ) ) { + cluck('node with insufficient data. This should not happen'); + next; + } + + my $line = $e->getAttribute('number'); + my $direction = $e->getAttribute('direction'); + my $valid = $e->getAttribute('valid'); + my $type = $e_info->getAttribute('name'); + my $route = $e_route->textContent; + my $operator = $e_oper->textContent; + my $identifier = $e->getAttribute('stateless'); + + push( + @lines, + Travel::Status::DE::VRR::Line->new( + name => $line, + direction => decode( 'UTF-8', $direction ), + valid => $valid, + type => decode( 'UTF-8', $type ), + route => decode( 'UTF-8', $route ), + operator => decode( 'UTF-8', $operator ), + identifier => $identifier, + ) + ); + } + + $self->{lines} = \@lines; + + return @lines; +} + sub results { my ($self) = @_; my @results; @@ -160,6 +214,12 @@ sub results { my $xp_info = XML::LibXML::XPathExpression->new('./itdServingLine/itdNoTrain'); + if ( $self->{results} ) { + return @{ $self->{results} }; + } + + $self->lines; + for my $e ( $self->{tree}->findnodes($xp_element) ) { my $e_date = ( $e->findnodes($xp_date) )[0]; @@ -171,6 +231,7 @@ sub results { my $e_rtime = ( $e->findnodes($xp_rtime) )[0]; if ( not( $e_date and $e_time and $e_line ) ) { + cluck('node with insufficient data. This should not happen'); next; } @@ -189,6 +250,10 @@ sub results { my $platform_is_db = 0; + my @line_obj + = grep { $_->{identifier} eq $e_line->getAttribute('stateless') } + @{ $self->{lines} }; + if ( $platform =~ s{ ^ \# }{}ox ) { $platform_is_db = 1; } @@ -200,6 +265,7 @@ sub results { time => $rtime, platform => $platform, platform_db => $platform_is_db, + lineref => $line_obj[0] // undef, line => $line, destination => decode( 'UTF-8', $dest ), countdown => $countdown, @@ -215,6 +281,8 @@ sub results { sort { $a->[1] <=> $b->[1] } map { [ $_, $_->countdown ] } @results; + $self->{results} = \@results; + return @results; } diff --git a/lib/Travel/Status/DE/VRR/Line.pm b/lib/Travel/Status/DE/VRR/Line.pm new file mode 100644 index 0000000..9abe473 --- /dev/null +++ b/lib/Travel/Status/DE/VRR/Line.pm @@ -0,0 +1,130 @@ +package Travel::Status::DE::VRR::Line; + +use strict; +use warnings; +use 5.010; + +use parent 'Class::Accessor'; + +our $VERSION = '0.02'; + +Travel::Status::DE::VRR::Line->mk_ro_accessors( + qw(direction name operator route type valid)); + +sub new { + my ( $obj, %conf ) = @_; + + my $ref = \%conf; + + return bless( $ref, $obj ); +} +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::VRR::Line - Information about a line departing at the +requested station + +=head1 SYNOPSIS + + for my $line ($status->lines) { + printf( + "line %s -> %s\nRoute: %s\nType %s, operator %s\nValid: %s\n\n", + $line->name, $line->direction, $line->route, + $line->type, $line->operator, $line->valid + ); + } + +=head1 VERSION + +version 0.02 + +=head1 DESCRIPTION + +FIXME + +=head1 METHODS + +=head2 ACCESSORS + +=over + +=item $departure->destination + +The tram/bus/train destination. + +=item $departure->info + +Additional information related to the departure (string). If departures for +an address were requested, this is the stop name, otherwise it may be recent +news related to the line's schedule. + +=item $departure->line + +The name/number of the line. + +=item $departure->platform + +The departure platform. Note that this is prefixed by either "Bstg." (for +tram/bus departures) or "Gleis" (for trains). + +=item $departure->time + +The departure time as string in "HH:MM" format. + +=back + +=head2 INTERNAL + +=over + +=item $departure = Travel::Status::DE::VRR::Result->new(I<%data>) + +Returns a new Travel::Status::DE::VRR::Result object. You should not need to +call this. + +Required I<data>: + +=over + +=item B<destination> => I<string> + +=item B<line> => I<string> + +=item B<platform> => I<string> + +=item B<time> => I<string> + +=back + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +Unknown. + +=head1 SEE ALSO + +Travel::Status::DE::VRR(3pm). + +=head1 AUTHOR + +Copyright (C) 2011 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/VRR/Result.pm b/lib/Travel/Status/DE/VRR/Result.pm index 9fdd826..6c8fb4e 100644 --- a/lib/Travel/Status/DE/VRR/Result.pm +++ b/lib/Travel/Status/DE/VRR/Result.pm @@ -9,7 +9,8 @@ use parent 'Class::Accessor'; our $VERSION = '0.02'; Travel::Status::DE::VRR::Result->mk_ro_accessors( - qw(countdown date delay destination info line platform platform_db sched_date sched_time time type) + qw(countdown date delay destination info line lineref platform + platform_db sched_date sched_time time type) ); sub new { |