File Coverage

blib/lib/WWW/PTV.pm

Criterion	Covered	Total	%
statement	27	168	16.0
branch	0	30	0.0
condition	0	12	0.0
subroutine	9	25	36.0
pod	13	13	100.0
total	49	248	19.7

package WWW::PTV;

use warnings;
use strict;

use LWP;
use WWW::Mechanize;
use HTML::TreeBuilder;
use Carp qw(croak);
use WWW::PTV::Area;
use WWW::PTV::Stop;
use WWW::PTV::Route;

our $VERSION = '0.06';
our $CACHE;

sub __request {
	my($self,$uri)	= @_;
	my $res = ( $uri !~ /^http:/
		? $self->{ua}->get( $self->{uri} . $uri )
		: $self->{ua}->get( $uri ) );
	$res->is_success and return $res->content;
	croak 'Unable to retrieve content: ' . $res->status_line
}

sub __tl_request {
	my ($self, $tag_id)= @_;
	my $r = ( $self->{cache} and $CACHE->{timetables}->{master}
		? $CACHE->{timetables}->{master}
		: $self->__request( 'http://ptv.vic.gov.au/timetables' ) );
	$CACHE->{timetables}->{master} = $r if $self->{cache};
	my $t 		= HTML::TreeBuilder->new_from_content( $r );
	$t		= $t->look_down( _tag => 'select', id => $tag_id );
	my @routes	= $t->look_down( _tag => 'option' );
	return my %routes = map { $_->attr( 'value' ) => $_->as_text } grep { $_->attr( 'value' ) ne '' } @routes
}

sub new {
	my($class,%args)= @_;
	my $self 	= bless {}, $class;
	$self->{uri} 	= 'http://' . ( defined $args{uri} ? $args{uri} : 'ptv.vic.gov.au' ) . '/';
	$self->{ua}	= LWP::UserAgent->new;
	$self->{tree}	= HTML::TreeBuilder->new;
	$self->{cache}++ if $args{cache};
	return $self
}

sub cache { $_[0]->{cache}++ }

sub nocache { $_[0]->{cache} = 0 }

sub get_metropolitan_bus_routes {
	return $_[0]->__tl_request( 'RouteForm1_RouteUrl' );
}

sub get_metropolitan_train_routes {
	return $_[0]->__tl_request( 'RouteForm2_RouteUrl' )
}

sub get_metropolitan_tram_routes {
	return $_[0]->__tl_request( 'RouteForm3_RouteUrl' );
}

sub get_vline_bus_routes {
	return $_[0]->__tl_request( 'RouteForm4_RouteUrl' )
}

sub get_vline_train_routes {
	return $_[0]->__tl_request( 'RouteForm5_RouteUrl' )
}

sub get_regional_bus_routes {
	return $_[0]->__tl_request( 'RouteForm6_RouteUrl' )
}

sub get_route_by_id {
	my( $self, $id )= @_;
	$id or return "Mandatory parameter id not given";

	return $CACHE->{ROUTE}->{$id} if ( $self->{cache} and $CACHE->{ROUTE}->{$id} );

	my $r 		= $self->__request( "/route/view/$id" );
	my $t		= HTML::TreeBuilder->new_from_content( $r );
	#my $t		= HTML::TreeBuilder->new_from_file( './metro_train_route_1' );
	#my $t		= HTML::TreeBuilder->new_from_file( './regional_bus_route_geelong_19' );
	my %route	= (id => $id);
	my $r_link	= $t->look_down( _tag => 'div', id => 'content' );
	$route{name}	= $t->look_down( _tag => 'h1' )->as_text;
	( $route{direction_in}, $route{direction_out} )
			= $r_link->look_down( _tag => 'a' );

	( $route{direction_in_link}, $route{direction_out_link} )
			= map { $_->attr( 'href' ) } $r_link->look_down( _tag => 'a' );

	( $route{direction_in}, $route{direction_out} )
			= map { $_->as_text } ( $route{direction_in}, $route{direction_out} );

	( $route{description_in}, $route{description_out} )
			= map { $_->as_text } $r_link->look_down( _tag => 'p' );
	my $operator 	= $t->look_down( _tag => 'div', class => 'operator' )->as_text;
	$operator 	=~ s/(Contact|Website|:)/,/g;
	$operator 	=~ s/\s//g;
	( $route{operator} ,$route{operator_ph} ) = ( split /,/, $operator )[0,2];
	$route{ua}	= $self->{ua};
	$route{uri}	= $self->{uri};
	my $route 	= WWW::PTV::Route->new( %route );
	$CACHE->{ROUTE}->{$id} = $route if ( $self->{cache} );
	return $route
}



sub get_stop_by_id {
	my( $self, $id )= @_;
	$id or return "Mandatory parameter id not given";
	return $CACHE->{STOP}->{$id} if ( $self->{cache} and $CACHE->{STOP}->{$id} );
	my $r				= $self->__request( "/stop/view/$id" );
	my $t				= HTML::TreeBuilder->new_from_content( $r );
	#my $t				= HTML::TreeBuilder->new_from_file( './45470' );
	my %stop			= (id => $id );
	my $s_type 			= $t->look_down( _tag => 'img', class => 'stopModeImage' );
	$stop{address}			= $t->look_down( _tag => 'div', id => 'container' )
						->look_down( _tag => 'p' )
						->as_text;

	$stop{transport_type}		= $s_type->attr('src');
	$stop{transport_type}		=~ s|themes/transport-site/images/jp/icons/icon||;
	$stop{transport_type}		=~ s|\.png||;
	( $stop{street}, $stop{locality} ) = ( split /,/, $stop{address} );
	( $stop{postcode} ) = $stop{locality} =~ /\b(\d{4})\b/;
	$stop{municipiality}		= $t->look_down( _tag	=> 'table', class => 'stationSummary' )
						->look_down( _tag => 'a' )
						->as_text;

	( $stop{municipiality_id} )	= $t->look_down( _tag	=> 'table', class => 'stationSummary' )
						->look_down( _tag => 'a' )
						->attr( 'href' );
	( $stop{municipiality_id} )	= $stop{municipiality_id} =~ /\/(\d.*)$/;

	$stop{zone}			= ( $t->look_down( _tag => 'table', class => 'stationSummary' )
						->look_down( _tag => 'td' )
					  )[2]->as_text;

	$stop{map_ref}			= $t->look_down( _tag => 'div', class => 'aside' )
						->look_down( _tag => 'a' )
						->attr( 'href' );

	( $stop{latitude} )		= $stop{map_ref} =~ /=(-?\d.*),/;

	( $stop{longitude} )		= $stop{map_ref} =~ /,(-?\d.*)$/;

	( $stop{phone_feedback}, $stop{phone_station} )
					= map {	$_->as_text } $t->look_down( _tag => 'div', class => 'expander phone-numbers' )
								->look_down( _tag => 'dd' );

	$stop{staff_hours}		= $t->look_down( _tag => 'div', 'data-cookie' => 'stop-staff' )
						->look_down( _tag => 'dd' )->as_text;

	( $stop{myki_machines}, $stop{myki_checks}, $stop{vline_bookings} )
					= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-ticketing' )
								->look_down( _tag => 'dd' );

	( $stop{car_parking}, $stop{_bicycles}, $stop{taxi_rank} )
					= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-other-transport-links' )
								->look_down( _tag => 'dd' );

	( $stop{bicycle_racks}, $stop{bicycle_lockers}, $stop{bicycle_cage} )
					= map { s/.*://; $_ } split /,/, $stop{_bicycles};

	( $stop{wheelchair_accessible}, $stop{stairs}, $stop{escalator}, $stop{lift}, $stop{tactile_paths}, $stop{hearing_loop} )
					= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-accessibility' )
								->look_down( _tag => 'dd' );

	( $stop{seating}, $stop{lighting}, $stop{lockers}, $stop{public_phone}, $stop{public_toilet}, $stop{_waiting_area} )
					= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-general-facilities' )
								->look_down( _tag => 'dd' );

	( $stop{waiting_area_indoor}, $stop{waiting_area_sheltered} )
					= map { s/.*://; $_ } split /,/, $stop{_waiting_area};

	foreach my $line ( $t->look_down( _tag => 'div', 'data-cookie' => 'stop-line-timetables' )
			     ->look_down( _tag => 'div', class => 'timetable-row' ) ) {
		my $ref = { id => $line->look_down( _tag => 'a' )->attr( 'href' ) =~ /^.*\/(.*)/ };
		$ref->{ name } = $line->look_down( _tag => 'a' )->as_text;
		$ref->{ type } = _get_line_type( $line->look_down( _tag => 'img' )->attr( 'src' ) );
		push @{ $stop{routes} }, $ref
	}

	$stop{ua} = $self->{ua};

	my $stop = WWW::PTV::Stop->new( %stop );
	$CACHE->{STOP}->{$id} = $stop if ( $self->{cache} );

	return $stop
}

sub get_area_by_id {
	my( $self, $id )= @_;
	$id or return "Mandatory parameter id not given";
	return $CACHE->{AREA}->{$id} if ( $self->{cache} and $CACHE->{AREA}->{$id} );
	my $r				= $self->__request( "/location/view/$id" );
	my $t				= HTML::TreeBuilder->new_from_content( $r );
	#my $t				= HTML::TreeBuilder->new_from_file( './local_area_19' );
	#my $t				= HTML::TreeBuilder->new_from_file( './area_30' );
	my %area 			= ( id => $id );
	$area{name}			= $t->look_down( _tag => 'h1' )->as_text;
	@{ $area{suburbs}}		= split /, /, $t->look_down( _tag => 'p' )->as_text;
	my $t_type;

	foreach my $service ( $t->look_down( _tag => 'div', id => 'content' )->look_down( _tag => 'div' ) ) {
		my $type = $service->look_down( _tag => 'h3' );

		if ( $type->as_text ne '' ) { $t_type = $type->as_text }

		@{ $area{service}{names}{$t_type} }
			= map { $_->as_text } $service->look_down( _tag => 'li' );

		@{ $area{service}{links}{$t_type} }
			= map { $_->attr( 'href' ) } $service->look_down( _tag => 'a' );
	}

	my $area =  WWW::PTV::Area->new( %area );
	$CACHE->{AREA}->{$id} = $area if ( $self->{cache} );

	return $area
}

sub get_local_areas {
	my $self = shift;
	my $r = $self->__request( '/getting-around/local-areas/' );
	my $t = HTML::TreeBuilder->new_from_content( $r );
	#my $t = HTML::TreeBuilder->new_from_file( './local_areas_list' );
	$t = $t->look_down( _tag => 'div', id => 'content' );

	@{ $self->{local_areas}{names} }
		= map { $_->as_text } $t->look_down( _tag => 'li' );

	@{ $self->{local_areas}{links} }
		= map { $_->attr( 'href' ) } $t->look_down( _tag => 'a' );

	my %res;
	@res{ @{ $self->{local_areas}{names} } } = @{ $self->{local_areas}{links} };
	return %res
}

sub _get_line_type {
	my $obj = shift;
	$obj =~ s/^.*\/icon//;
	$obj =~ s/\..*$//;
	return lc $obj
}

1;

__END__