view release on metacpan or  search on metacpan

lib/Geo/WKT.pm  view on Meta::CPAN

# Copyrights 2008-2018 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Geo-WKT.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Geo::WKT;
use vars '$VERSION';
$VERSION = '0.96';

use base 'Exporter';

use strict;
use warnings;

use Geo::Shape  ();
use Carp;

our @EXPORT = qw(
  parse_wkt
  parse_wkt_point
  parse_wkt_polygon
  parse_wkt_geomcol
  parse_wkt_linestring
  wkt_point
  wkt_multipoint
  wkt_linestring
  wkt_polygon
  wkt_linestring
  wkt_multilinestring
  wkt_multipolygon
  wkt_optimal
  wkt_geomcollection
 );

sub wkt_optimal($);


sub parse_wkt_point($;$)
{     ($_[0] =~ m/^point\(\s*(\S+)\s+(\S+)\)$/i)
    ? Geo::Point->xy($1+0, $2+0, $_[1])
    : undef;
}


sub parse_wkt_polygon($;$)
{   my ($string, $proj) = @_;

    $string && $string =~ m/^polygon\(\((.+)\)\)$/i
        or return undef;

    my @poly;
    foreach my $poly (split m/\)\s*\,\s*\(/, $1)
    {   my @points = map +[split " ", $_, 2], split /\s*\,\s*/, $poly;
        push @poly, \@points;
    }

    Geo::Surface->new(@poly, proj => $proj);
}


sub parse_wkt_geomcol($;$)
{   my ($string, $proj) = @_;

    return undef if $string !~
        s/^(multiline|multipoint|multipolygon|geometrycollection)\(//i;

    my @comp;
    while($string =~ m/\D/)
    {   $string =~ s/^([^(]*\([^)]*\))//
            or last;

        my $take  = $1;
        while(1)
        {   my @open  = $take =~ m/\(/g;
            my @close = $take =~ m/\)/g;
            last if @open==@close;
            $take .= $1 if $string =~ s/^([^\)]*\))//;
        }
        push @comp, parse_wkt($take, $proj);
        $string =~ s/^\s*\,\s*//;
    }

    Geo::Space->new(@comp, proj => $proj);
}


sub parse_wkt_linestring($;$)
{   my ($string, $proj) = @_;

    $string && $string =~ m/^linestring\((.+)\)$/i
        or return undef;

    my @points = map +[split " ", $_, 2], split /\s*\,\s*/, $1;
    @points > 1 or return;

    Geo::Line->new(proj => $proj, points => \@points, filled => 0);
}


sub parse_wkt($;$)  # dirty code to avoid copying the sometimes huge string
{
      $_[0] =~ m/^point\(/i      ? &parse_wkt_point
    : $_[0] =~ m/^polygon\(/i    ? &parse_wkt_polygon
    : $_[0] =~ m/^linestring\(/i ? &parse_wkt_linestring
    :                              &parse_wkt_geomcol;
}


sub _list_of_points(@)
{   my @points
      = @_ > 1                      ? @_
      : ref $_[0] eq 'ARRAY'        ? @{$_[0]}