File Coverage

blib/lib/Geo/JSON/Simple.pm

Criterion	Covered	Total	%
statement	77	83	92.7
branch	6	8	75.0
condition			n/a
subroutine	26	28	92.8
pod	10	10	100.0
total	119	129	92.2

package Geo::JSON::Simple;
BEGIN {
  $Geo::JSON::Simple::AUTHORITY = 'cpan:GETTY';
}
{
  $Geo::JSON::Simple::VERSION = '0.001';
}
# ABSTRACT: Simplified functions for generating Geo::JSON objects

use strict;
use warnings;
use Exporter 'import';
use Carp 'croak';
use List::MoreUtils qw(
  natatime
);

use Geo::JSON;
use Geo::JSON::Point;
use Geo::JSON::MultiPoint;
use Geo::JSON::LineString;
use Geo::JSON::MultiLineString;
use Geo::JSON::Polygon;
use Geo::JSON::MultiPolygon;
use Geo::JSON::Feature;
use Geo::JSON::FeatureCollection;
use Geo::JSON::GeometryCollection;

our @EXPORT = qw(

  point
  multipoint
  linestring
  multilinestring
  polygon
  multipolygon

  feature
  featurecollection
  geometrycollection

  from_geo_json

);

sub point { Geo::JSON::Point->new({ coordinates => [ $_[0], $_[1] ] }) }
sub multipoint { Geo::JSON::MultiPoint->new({ coordinates => [ _make_positions(@_) ] }) }

sub linestring { Geo::JSON::LineString->new({ coordinates => [ _make_positions(@_) ] }) }
sub multilinestring { Geo::JSON::MultiLineString->new({ coordinates => [ map {
  [_make_positions(@{$_})]
} @_ ] }) }

sub polygon { Geo::JSON::Polygon->new({ coordinates => [ _make_linear_ring(@_) ] }) }
sub multipolygon { Geo::JSON::MultiPolygon->new({ coordinates => [ map {
  [_make_linear_ring(@{$_})]
} @_ ] }) }

sub _make_linear_ring { map {
  my @coordlist = _make_positions(@{$_}); [@coordlist,$coordlist[0]]
} @_ }

sub _make_positions {
  my $it = natatime 2, @_;
  my @coords;
  while (my @pair = $it->()) {
    push @coords, [@pair];
  }
  return @coords;
}

sub feature {
  my ( $object, %properties ) = @_;
  Geo::JSON::Feature->new({
    geometry => $object,
    properties => \%properties
  });
}

sub featurecollection {
  my @features;
  my $current_geometry;
  my @args;
  for (@_) {
    if (ref $_) {
      if ($current_geometry) {
        push @features, feature($current_geometry, @args);
        @args = ();
        $current_geometry = $_;
      } else {
        $current_geometry = $_;
      }
    } elsif (!$current_geometry) {
      croak "featurecollection needs to start with a geometry";
    } else {
      push @args, $_;
    }
  }
  if ($current_geometry) {
    push @features, feature($current_geometry, @args);
  }
  Geo::JSON::FeatureCollection->new({
    features => \@features
  });
}

sub geometrycollection {
  Geo::JSON::GeometryCollection->new({
    geometries => \@_
  });
}

sub from_geo_json { Geo::JSON->from_json(@_) }

1;

__END__