Loading lib/Travel/Status/DE/VRR.pm +69 −1 Original line number Diff line number Diff line Loading @@ -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; Loading Loading @@ -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; Loading @@ -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]; Loading @@ -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; } Loading @@ -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; } Loading @@ -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, Loading @@ -215,6 +281,8 @@ sub results { sort { $a->[1] <=> $b->[1] } map { [ $_, $_->countdown ] } @results; $self->{results} = \@results; return @results; } Loading lib/Travel/Status/DE/VRR/Line.pm 0 → 100644 +130 −0 Original line number Diff line number Diff line 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. lib/Travel/Status/DE/VRR/Result.pm +2 −1 Original line number Diff line number Diff line Loading @@ -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 { Loading Loading
lib/Travel/Status/DE/VRR.pm +69 −1 Original line number Diff line number Diff line Loading @@ -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; Loading Loading @@ -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; Loading @@ -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]; Loading @@ -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; } Loading @@ -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; } Loading @@ -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, Loading @@ -215,6 +281,8 @@ sub results { sort { $a->[1] <=> $b->[1] } map { [ $_, $_->countdown ] } @results; $self->{results} = \@results; return @results; } Loading
lib/Travel/Status/DE/VRR/Line.pm 0 → 100644 +130 −0 Original line number Diff line number Diff line 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.
lib/Travel/Status/DE/VRR/Result.pm +2 −1 Original line number Diff line number Diff line Loading @@ -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 { Loading