package Geo::WKT::Simple;
use strict;
use warnings;
use parent 'Exporter';
our $VERSION = '0.01';
our @EXPORT;
our %EXPORT_TAGS = (
all => \@EXPORT,
parse => [qw/
wkt_parse_point
wkt_parse_linestring
wkt_parse_multilinestring
wkt_parse_polygon
wkt_parse_multipolygon
wkt_parse_geometrycollection
wkt_parse
/],
make => [qw/
wkt_make_point
wkt_make_linestring
wkt_make_multilinestring
wkt_make_polygon
wkt_make_multipolygon
wkt_make_geometrycollection
wkt_make
/],
);
@EXPORT = map { @{ $_ } } @EXPORT_TAGS{qw/ parse make /};
sub _parse_point {
$_[0] =~ /^\s*(\S+)\s+(\S+)\s*$/
}
sub _parse_points_list {
map { [ _parse_point($_) ] } split /\s*,\s*/, $_[0]
}
sub _parse_points_group {
map {
[ _parse_points_list($_) ]
} split /\s*\)\s*,\s*\(\s*/, $_[0]
}
sub _parse_points_group_list {
map {
[ _parse_points_group($_) ]
} split /\s*\)\s*\)\s*,\s*\(\s*\(\s*/, $_[0]
}
sub wkt_parse_point {
_parse_point(
$_[0] =~ /^point\s*\((.+)\)$/i
)
}
sub wkt_parse_linestring {
_parse_points_list(
$_[0] =~ /^linestring\s*\((.+)\)$/i,
);
}
sub wkt_parse_multilinestring {
_parse_points_group(
$_[0] =~ /^multilinestring\s*\(\s*\((.+)\)\s*\)$/i
)
}
sub wkt_parse_polygon {
my @groups = _parse_points_group(
$_[0] =~ /^polygon\s*\(\s*\((.+)\)\s*\)$/i
);
@groups;
}
sub wkt_parse_multipolygon {
my @groups_list = _parse_points_group_list(
$_[0] =~ /^multipolygon\s*\(\s*\(\s*\((.+)\)\s*\)\s*\)$/i
);
@groups_list;
}
my $ALLTYPES = "(?:MULTI)?(?:POINT|LINESTRING|POLYGON)|GEOMETRYCOLLECTION";
sub wkt_parse_geometrycollection {
my ($wkt) = $_[0] =~ /^geometrycollection\s*\((.+)\)$/i
or return;
# Copy from Geo::WKT
my @comps;
while ($wkt =~ /\D/) {
last unless $wkt =~ s/^[^(]*\([^)]*\)//;
my $take = $&;
while (1) {
my @open = $take =~ /\(/g;
my @close = $take =~ /\)/g;
last if @open == @close;
$take .= $& if $wkt =~ s/^[^\)]*\)//;
}
my ($type) = $take =~ /^($ALLTYPES)/;
push @comps, [ uc($type) => [ wkt_parse($type => $take) ] ];
$wkt =~ s/^\s*,\s*//;
}
@comps;
}
sub wkt_parse {
my ($type, $wkt) = @_;
return if uc($type) !~ /^$ALLTYPES$/;
do {
no strict 'refs';
&{ 'wkt_parse_'.lc($type) }($_[1]);
};
}
sub _cat {
'('.join(', ', @_).')'
}
sub _catlinestring {
_cat( map { "$_->[0] $_->[1]" } @_ )
}
sub _catpolygon {
_cat( map { _catlinestring(@$_) } @_ )
}
sub wkt_make_point {
'POINT'._cat("$_[0] $_[1]")
}
sub wkt_make_linestring {
'LINESTRING'._catlinestring(@_)
}
sub wkt_make_multilinestring {
'MULTILINESTRING'._catpolygon(@_)
}
sub wkt_make_polygon {
'POLYGON'._catpolygon(@_)
}
sub wkt_make_multipolygon {
'MULTIPOLYGON'._cat(
map { _catpolygon(@$_) } @_
)
}
sub wkt_make_geometrycollection {
'GEOMETRYCOLLECTION'._cat( map { wkt_make(@$_) } @_ )
}
sub wkt_make {
my ($type, $data) = @_;
return if $type !~ $ALLTYPES;
do {
no strict 'refs';
&{ 'wkt_make_'.lc($type) }(@$data);
};
}
1;
__END__
=head1 NAME
Geo::WKT::Simple - Simple utils to parse/build Well Known Text(WKT) format string.
=head1 SYNOPSIS
use Geo::WKT::Simple; # Export all
or
use Geo::WKT::Simple ':parse'; # Only WKT parser functions
or
use Geo::WKT::Simple ':make'; # Only WKT builder functions
# WKT POINT
wkt_parse_point('POINT(10 20)'); #=> (10 20)
wkt_make_point(10, 20); #=> POINT(10 20)
# WKT LINESTRING
wkt_parse_linestring('LINESTRING(1 2, 3 4)'); #=> ([ 1, 2 ], [ 3, 4 ])
wkt_make_linestring([ 1, 2 ], [ 3, 4 ]); #=> LINESTRING(1 2, 3 4)
# WKT POLYGON
wkt_parse_polygon('POLYGON((1 2, 3 4, 5 6, 1 2), (1 2, 3 4, 5 6, 1 2))');
#=> (
# [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 1, 2 ] ],
# [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 1, 2 ] ],
# )
wkt_make_polygon([
[ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 1, 2 ] ],
[ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 1, 2 ] ],
]) #=> 'POLYGON((1 2, 3 4, 5 6, 1 2), (1 2, 3 4, 5 6, 1 2))'
# And like so on for (MULTI)LINESTRING|POLYGON
# WKT GEOMETRYCOLLECTION
wkt_parse_geometrycollection(
'GEOMETRYCOLLECTION(POINT(10 20), LINESTRING(10 20, 30 40))'
); #=> ([ POINT => [ 10, 20 ] ], [ LINESTRING => [ [ 10, 20 ], [ 30, 40 ] ] ])
wkt_make_geometrycollection(
[ POINT => [ 10, 20 ] ], [ LINESTRING => [ [ 10, 20 ], [ 30, 40 ] ] ]
); #=> 'GEOMETRYCOLLECTION(POINT(10 20), LINESTRING(10 20, 30 40))'
# If you don't like too many exported symbols:
use Geo::WKT::Simple qw/ wkt_parse wkt_make /;
wkt_parse(POINT => 'POINT(10 20)');
wkt_make(POINT => [ 10, 20 ]);
=head1 DESCRIPTION
Geo::WKT::Simple is a module to provide simple parser for Well Known Text(WKT) format string.
This module can parse WKT format string into pure perl data structure.
=head2 Why not L<Geo::WKT> ?
There is a few reasons.
=over
=item - I just need simple return value represented by pure perl data structure.
Geo::WKT returns results as a Geo::* instances which represents each type of geodetic components.
=item - L<Geo::Proj4> dependencies. L<Geo::Proj4> depends to libproj4
=item - I need to support MULTI(LINESTRING|POLYGON).
=back
=head1 FUNCTIONS
See SYNOPSIS section for usages.
=head2 wkt_parse_point()
Parse WKT Point string.
=head2 wkt_parse_linestring()
Parse WKT Linestring string.
=head2 wkt_parse_multilinestring()
Parse WKT MultiLinestring string.
=head2 wkt_parse_polygon()
Parse WKT Polygon string.
=head2 wkt_parse_multipolygon()
Parse WKT MultiPolygon string.
=head2 wkt_parse_geometrycollection()
Parse WKT GeometryCollection string.
=head2 wkt_parse()
Dispatch to parser which specified in first argument.
wkt_parse(POINT => 'POINT(10 20)') is equivalent to wkt_parse_point('POINT(10 20)')
=head2 wkt_make_point()
Build WKT Point string.
=head2 wkt_make_linestring()
Build WKT Linestring string.
=head2 wkt_make_multilinestring()
Build WKT MultiLinestring string.
=head2 wkt_make_polygon()
Build WKT Polygon string.
=head2 wkt_make_multipolygon()
Build WKT MultiPolygon string.
=head2 wkt_make_geometrycollection()
Build WKT GeometryCollection string.
=head2 wkt_make()
Dispatch to builder function which specified in first argument.
wkt_make(POINT => [ 10, 20 ]) is equivalent to wkt_make_point(10, 20)
=head1 AUTHOR
Yuto KAWAMURA(kawamuray) E<lt>kawamuray.dadada {at} gmail.comE<gt>
=head1 SEE ALSO
L<Geo::WKT>: As same as this module except few things.
Well-known text: http://en.wikipedia.org/wiki/Well-known_text
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut