File Coverage

blib/lib/WWW/PTV/Route.pm

Criterion	Covered	Total	%
statement	21	82	25.6
branch	0	28	0.0
condition	0	13	0.0
subroutine	7	14	50.0
pod	3	4	75.0
total	31	141	21.9

package WWW::PTV::Route;

use strict;
use warnings;

use WWW::PTV::TimeTable;
use HTML::TreeBuilder;
use Scalar::Util qw(weaken);
use Carp qw(croak);

our $STOP = {};
our @ATTR = qw(	id direction_out direction_in direction_out_link direction_in_link
		description_out description_in name operator operator_ph );

foreach my $attr ( @ATTR ) {
        {
                no strict 'refs';
                *{ __PACKAGE__ .'::'. $attr } = sub {
                        my( $self, $val ) = @_;
                        $self->{$attr} = $val if $val;
                        return $self->{$attr}
                }
        }
}

sub new {
        my ( $class, %args ) = @_;

        my $self = bless {}, $class;
        $args{id} or croak 'Constructor failed: mandatory id argument not supplied';

        foreach my $attr ( @ATTR ) { $self->{$attr} = $args{$attr} }

	$self->{uri} = $args{uri};
	$args{ua} ? weaken( $self->{ua} = $args{ua} ) : croak 'Mandatory argument ua not supplied';

        return $self
}

sub get_inbound_tt	{ $_[0]->__get_tt( 'in' )	}

sub get_outbound_tt	{ $_[0]->__get_tt( 'out' )	}

sub __get_tt {
        my ( $self, $direction ) = @_;

	return unless $direction =~ /(in|out)/;

	my $tt = $self->__request( $direction eq 'out'
		? $self->{direction_out_link}
		: $self->{direction_in_link}
	);

	my $t = HTML::TreeBuilder->new_from_content( $tt );

	for ( $t->look_down( _tag => 'meta' ) ) {

		if( ( defined $_->attr( 'http-equiv' ) )
			and ( $_->attr( 'http-equiv' ) eq 'refresh' )
		) {
			( my $url = $_->attr( 'content' ) ) =~ s/^.*url=//;
			$url .= '&itdLPxx_scrollOffset=118';

			$t = HTML::TreeBuilder->new_from_content( $self->__request( $self->{uri}.'/tt/'.$url ) );

			last
		}
	}

	$tt = $t->look_down( _tag => 'img', title => 'Expand' );

	if ( $tt && $tt->attr( 'onclick' ) && $tt->attr( 'onclick' ) =~ /TTB_REQUEST/ ) {
		( $tt = $tt->attr( 'onclick' ) ) =~ s/^.*\('//;
		$tt =~ s/'.*$//;
		$t = HTML::TreeBuilder->new_from_content( $self->__request( "http://tt.ptv.vic.gov.au/tt/$tt" ) )
	}

	$t = $t->look_down( _tag => 'div', id => qr/tt(Bus|Tram|Train|Regional)/ );
	my @stops = $t->look_down( _tag => 'div', class => qr/^ma_stop/ );
	my @stop_names = map { $_->as_text } @stops;
	my @stop_links = map { my ($r) = $_->look_down( _tag => 'a' )->attr( 'href' ) =~ /.*\/(\d*$)/ } @stops;
	my $stop_times;
	my $c = 0;

	foreach my $t ( $t->look_down( _tag => 'div', class => qr/^ttBodyN?TP$/ ) ) {
		my $s;

		foreach my $t ( $t->look_down( _tag => 'span' ) ) {
			my ( $h, $m ) = split /:/, $t->as_text;
			push @{ $s }, $h and next if $h !~ /\d/;
			my $is_pm = $t->look_down( _tag => 'b' );

			push @{ $s }, ( $h == 12
					? ( $is_pm ? "$h:$m" : "00:$m" )
					: ( $is_pm ? $h + 12 .":$m" : "$h:$m" )
				);
		}

		$self->{ STOP }->{ $stop_links[$c] }->{ $direction } = $s;
		$self->{ STOP }->{ $stop_links[$c] }->{ name } = $stop_names[$c];
		$c++;
		push @{ $stop_times }, $s
	}

	my $ret = WWW::PTV::TimeTable->new( \@stop_names, \@stop_links, $stop_times );
	$self->{timetable}->{$direction} = $ret;
	return $ret;
}

sub __request {
        my ( $self, $uri ) = @_;

        my $res = ( $uri !~ /^http:/
                ? $self->{ua}->get( $self->{uri} . $uri )
                : $self->{ua}->get( $uri ) );

	return $res->content if $res->is_success;

	croak 'Unable to retrieve content: ' . $res->status_line
}

sub get_stop_names_and_ids {
	my ( $self, $direction ) = @_;

	$direction ||= 'out';
	$self->{timetable}->{$direction} || $self->__get_tt($direction);

	return $self->{timetable}->{$direction}->stop_names_and_ids;
}

1;

__END__