File Coverage

blib/lib/WebService/Nextbus/Agency.pm

Criterion	Covered	Total	%
statement	70	100	70.0
branch	11	18	61.1
condition	1	3	33.3
subroutine	15	18	83.3
pod	0	14	0.0
total	97	153	63.4

package WebService::Nextbus::Agency;
use 5.006;
use strict;
use warnings;
use integer;

our $VERSION = '0.12';

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	my $self = {
		_nameCode		=> undef,
		_routeRegExp	=> undef,
		_dirRegExp		=> undef,
		_routes		=> {},
	};
	bless ($self, $class);
}

# Input or check the name code for this agency, e.g. sf-muni
sub nameCode {
	my $self = shift;
	if (@_) { $self->{_nameCode} = shift }
	return $self->{_nameCode};
}

# Input or check the RegExps used for default parsing
sub routeRegExp {
	my $self = shift;
	if (@_) { $self->{_routeRegExp} = shift }
	return $self->{_routeRegExp};
}

sub dirRegExp {
	my $self = shift;
	if (@_) { $self->{_dirRegExp} = shift }
	return $self->{_dirRegExp};
}

# For building or checking the tree structure of routes, dirs, stops
sub routes {
	my $self = shift;
	if (@_) { %{$self->{_routes}} = %{$_[0]} }
	return \%{$self->{_routes}};
}

sub dirs {
	my $self = shift;
	my ($route, $newDirs) = @_;
	if ($newDirs) { %{$self->routes()->{$route}} = %$newDirs }
	return \%{$self->routes()->{$route}};
}

sub stops {
	my $self = shift;
	my ($route, $dir, $newStops) = @_;
	if ($newStops) { %{$self->dirs($route)->{$dir}} = %$newStops }
	return \%{$self->dirs($route)->{$dir}};
}

# Input or check a particular stop code given the route, dir, and name of stop.
sub stopCode {
	my $self = shift;
	my ($route, $dir, $stopName, $newCode) = @_;
	if ($newCode) { $self->stops($route, $dir)->{$stopName} = $newCode }
	return $self->stops($route, $dir)->{$stopName};
}

# Spit out the stop names (keys) or codes (values)
sub allStopNames {
	my $self = shift;
	my ($route, $dir) = @_;
	return keys(%{$self->stops($route, $dir)});
}

sub allStopCodes {
	my $self = shift;
	my ($route, $dir) = @_;
	return values(%{$self->stops($route, $dir)});
}

# Default parsing of input string according to object's stored RegExps
sub parseRoute {
	my $self = shift;
	my ($str) = @_;
	my $routeRegExp = $self->routeRegExp();
	my ($route) = ($str =~ /$routeRegExp/i);

	$str =~ s/$route\s*//;
	return (ucfirst($route), $str);
}

sub parseDir {
	my $self = shift;
	my ($str) = @_;
	my $dirRegExp = $self->dirRegExp();
	my ($dir) = ($str =~ /$dirRegExp/i);

	$str =~ s/$dir\s*//;
	return ($dir, $str);
}

# Search for stop codes in current tree.  First, check whether the input string
# directly matches a stop code.  Otherwise, assume the input string is a stop
# name and search the names for a match.  The matching is done word by word:
# first split the input at whitespaces, then match each word in turn, narrowing
# the list of stopnames at each step (but if the word makes no matches, then
# leave the list alone).  At the end, return all remaining matches.
sub str2stopCodes {
	my $self = shift;
	my ($route, $dir, $stopStr) = @_;

	my @stopCodes = $self->allStopCodes($route, $dir);
	if ((my @retCodes = grep(/$stopStr/i, @stopCodes)) == 1) {
		return @retCodes;
	}

	my @stopNames = $self->allStopNames($route, $dir);
	foreach my $word (split(/\s+/, $stopStr)) {
		if (my @temp = grep(/$word/i, @stopNames)) {
			@stopNames = @temp;
		}
	}

	my @retCodes;
	foreach my $stopName (@stopNames) {
		my $retCode = $self->stopCode($route, $dir, $stopName);
		push(@retCodes, $retCode);
	}
	return @retCodes;
}

# To dump the routes tree in human readable format.  Essentially the same as
# Data::Dumper in case you don't want to load that library.
sub routesAsString {
	my $self = shift;

	foreach my $routeKey (keys(%{$self->routes()})) {
		print "$routeKey =>\n";
		my $routeVal = $self->routes()->{$routeKey};
		foreach my $dirKey (keys(%$routeVal)) {
			print "	$dirKey =>\n";
			my $dirVal = $routeVal->{$dirKey};
			foreach my $stopKey (keys(%$dirVal)) {
				print "		$stopKey => ";
				my $stopVal = $dirVal->{$stopKey};
				print $stopVal . "\n";
			}
		}
	}
}

1
__END__