view release on metacpan or  search on metacpan

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

    {   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]}
      : $_[0]->isa('Math::Polygon') ? $_[0]->points
      : $_[0];

    my @s = map
      { (ref $_ ne 'ARRAY' && $_->isa('Geo::Point'))
      ? $_->x.' '.$_->y
      : $_->[0].' '.$_->[1]
      } @points;

    local $" = ',';
    "(@s)";
}

sub wkt_point($;$)
{   my ($x, $y)
       = @_==2                ? @_
       : ref $_[0] eq 'ARRAY' ? @{$_[0]}
       :                       shift->xy;

    defined $x && defined $y ? "POINT($x $y)" : ();
}


sub wkt_linestring(@) { 'LINESTRING' . _list_of_points(@_) }


sub wkt_polygon(@)
{   my @polys
      = !defined $_[0]             ? return ()
      : ref $_[0] eq 'ARRAY'       ? (ref $_[0][0] ? @_ : [@_])
      : $_[0]->isa('Geo::Line')    ? @_
      : $_[0]->isa('Geo::Surface') ? ($_[0]->outer, $_[0]->inner)
      :                              [@_];

    'POLYGON(' .join(',' ,  map _list_of_points($_), @polys). ')';
}


sub wkt_multipoint(@) { 'MULTIPOINT(' .join(',', map wkt_point($_), @_). ')'}


sub wkt_multilinestring(@)
{   return () unless @_;
    'MULTILINESTRING(' .join(',' ,  map wkt_linestring($_), @_). ')';
}


sub wkt_multipolygon(@)
{   return () unless @_;

    my @polys = map wkt_polygon($_), @_;
    s/^POLYGON// for @polys;

    'MULTIPOLYGON(' .join(',' , @polys). ')';
}



sub wkt_optimal($)
{   my $geom = shift;
    return wkt_point(undef) unless defined $geom;