In a current project we required a way of accessing data by state based
on regions and sub regions (referred to as divisions) as described
by the Census Bureau. I did a quick search on CPAN and didn't find
a regions specific module, I found several that were State based
however and leverage one for this module.
Module Code:
package Region;
=pod
Module purpose is to provide access to US regions, divisions, and stat
+es
grouped either by the above or individually. See inline
comments for more information.
=cut
use strict;
use Geography::States;
my $debug = 0;
my %regions;
my $region;
my $division;
my $gs = Geography::States->new('USA');
while (<DATA>) {
next if $_ !~ m/[a-zA-Z]/ || $_ =~ /^#/;
if (m/^[A-Z]/ && m/[A-Z]$/) {
$_ =~ s/\s+$//;
print $_ , "\n" if $debug;
$region = ucfirst(lc($_));
}
elsif (m/^[A-Z]/ && m/[a-z]$/) {
$_ =~ s/\s+$//;
print "\t$_\n" if $debug;
$division = $_;
}
elsif (m/^\s+\w/) {
$_ =~ s/^\s+|\s+$//g;
my $code = $gs->state($_);
push @{ $regions{$region}{$division} } , { full => $_ , code => $c
+ode } ;
}
}
sub new {
my $class = shift;
my $self = {};
$self = \%regions;
bless $self, $class;
}
=pod
The regions method will return a list of regions in alphabetical order
=cut
sub regions {
my $self = shift;
return sort keys %{ $self };
}
=pod
The divisions method will return a list of all of the divisions
within a region. It accepts a list of arguments, those items
must be equal to the region names. When a list is passed only
the divisions in the regions passed will be returned.
=cut
sub divisions {
my ($self,@reg) = @_;
my @list;
if (!$reg[0]) {
@reg = sort keys %{ $self };
}
@reg = map { ucfirst(lc($_)) } @reg;
foreach my $region (@reg) {
foreach my $division (sort keys %{ $self->{$region} }) {
push @list, $division;
}
}
return @list;
}
=pod
The state method will return an array of states, the contents of which
are determined by arguments passed to the method.
If no options (hash) is sent in then it will return a list of all the
state codes in alphabetical order.
The state name can be returned if key "name" has value of 'full'
States for a region can be returned if an option of 'region' has been
set to one of the available regions.
States for a division can be returned if an option of 'division' has b
+een
set to one of the available divisions.
The only mixing that can be done is State name type (full or code) alo
+ng
with division OR state. Sending both a region and division will only w
+ork
if the division selected is under the region selected.
=cut
sub state {
my ($self,%args) = @_;
my $verbiage = $args{name} || 'code';
my $region_ = lc($args{region}) || 'ALL';
my $division_ = lc($args{division}) || 'ALL';
my @list;
foreach my $region (keys %{ $self }) {
next if $region_ ne 'ALL' && lc($region) ne $region_;
foreach my $division (keys %{ $self->{$region} }) {
next if $division_ ne 'ALL' && lc($division) ne $division_;
foreach my $state ( @{ $self->{$region}{$division} } ) {
push @list , $state->{$verbiage};
}
}
}
return sort(@list);
}
__DATA__
NORTHEAST
Middle Atlantic
New Jersey
New York
Pennsylvania
New England
Connecticut
Maine
Massachusetts
New Hampshire
Rhode Island
Vermont
MIDWEST
East North Central
Illinois
Indiana
Michigan
Ohio
Wisconsin
West North Central
Iowa
Kansas
Minnesota
Missouri
Nebraska
North Dakota
South Dakota
SOUTH
East South Central
Alabama
Kentucky
Mississippi
Tennessee
South Atlantic
Delaware
District of Columbia
Florida
Georgia
Maryland
North Carolina
South Carolina
Virginia
West Virginia
West South Central
Arkansas
Louisiana
Oklahoma
Texas
WEST
Mountain
Arizona
Colorado
Idaho
Montana
Nevada
New Mexico
Utah
Wyoming
Pacific
Alaska
California
Hawaii
Oregon
Washington
#POSSESSIONS
#
# Puerto Rico
# Virgin Islands
# Pacific Islands
#
# Pacific Islands Includes: Canton, Guam, Mariana, Marshall, Samoa, Wa
+ke
Informal Test Code
#!/usr/bin/perl
use Region;
use strict;
my $regions = Region->new();
print join("\n",$regions->regions);
print "\n\n";
print join("\n",$regions->divisions);
print "\n\n";
print join("\n",$regions->divisions('west'));
print "\n\n";
print join("\n",$regions->state( name => 'full' , region => 'west' ) )
+;
print "\n\n";
print join("\n",$regions->state( name => 'full' , division => 'East No
+rth Central' ) );
print "\n\n";
print join("\n",$regions->state( name => 'code' , region => 'South' ,
+division => 'South Atlantic' ) );
print "\n\n";
Possible Module Names
Geography::US::Census::Regions
Geography::US::Regions::Census
Locale::US::Census::Regions
???
Interest/Comments
Is there any interest in this module for addition to CPAN or is there an existing
module that I overlooked that already fills this space?
General comments on design and method interfaces would be appreciated even
if you don't need or want the module.
: Moved the while loop outside of the new to avoid issues if the user attempted to create multiple objects within a single script.
Removed the 'use Data::Dumper' that was left over from initial testing.