File Coverage

lib/XML/Loy/GeoRSS.pm

Criterion	Covered	Total	%
statement	77	79	97.4
branch	39	54	72.2
condition	20	29	68.9
subroutine	15	16	93.7
pod	11	11	100.0
total	162	189	85.7

package XML::Loy::GeoRSS;
use strict;
use warnings;

use XML::Loy with => (
  prefix => 'georss',
  namespace => 'http://www.georss.org/georss'
);

use Carp qw/carp/;
use Scalar::Util qw/looks_like_number/;

# No constructor
sub new {
  carp 'Only use ' . __PACKAGE__ . ' as an extension';
  return;
};


# Add 'point' element
sub geo_point {
  my $self = shift;

  # Get
  if (@_ <= 1) {
    # Get point object
    my $point = $self->find('point') or return;
    $point = $point->[ shift // 0 ] or return;

    # Wrong namespace
    return if $point->namespace ne __PACKAGE__->_namespace;

    # Return point
    return [ split /\s+/, $point->text ];
  }

  # Set
  elsif (@_ == 2 && looks_like_number($_[0]) && looks_like_number($_[1])) {
    return $self->add(point => $_[0] . ' ' . $_[1]);
  }

  # Parameterlist has wrong length
  return;
};


# Add 'line' element
sub geo_line {
  my $self = shift;

  # Get
  if (@_ <= 1) {
    my $line = $self->find('line') or return;
    $line = $line->[ shift // 0 ] or return;

    # Wrong namespace
    return if $line->namespace ne __PACKAGE__->_namespace;

    # Return line
    my @points;
    my @v = split /\s+/, $line->text;
    push @points, [ shift(@v), shift(@v) // 0 ] while @v;
    return \@points;
  };

  # Parameterlist not even or too small
  return if @_ % 2 || @_ < 4;

  # Set
  return $self->add(line => join(' ',@_) );
};


# Add 'polygon' element
sub geo_polygon {
  my $self = shift;

  # Get
  if (@_ <= 1) {
    my $poly = $self->find('polygon') or return;
    $poly = $poly->[ shift // 0 ] or return;

    # Wrong namespace
    return if $poly->namespace ne __PACKAGE__->_namespace;

    # Return polygon
    my @points;
    my @v = split /\s+/, $poly->text;
    push @points, [ shift(@v), shift(@v) // 0 ] while @v;
    return \@points;
  };

  # Parameterlist not even or too small
  return if @_ % 2 || @_ < 6;

  # Last pair is not identical to first pair
  if ($_[0] != $_[$#_ - 1] && $_[1] != $_[$#_]) {
    push(@_, @_[0..1]);
  };

  # Add polygon
  return $self->add(polygon => join(' ', @_));
};


# Add properties
sub geo_property {
  my $self = shift;

  my %properties = @_;

  # Add all available properties
  foreach my $tag (grep(/^(?:(?:relationship|featuretype)tag|featurename)$/i,
		keys %properties)) {

    my $val = $properties{$tag};

    # Add as an array, if it is one
    foreach (ref $val ? @$val : ($val)) {
      $self->add( lc($tag) => $_ );
    };
  };

  return $self;
};


# Add 'floor' element
sub geo_floor {
  shift->add(floor => shift);
};


# Add 'elev' element
sub geo_elev {
  shift->add(elev => shift);
};


# Add 'radius' element
sub geo_radius {
  shift->add(radius => shift);
};


# Add 'where' element
sub geo_where {
  shift->add('where');
};


# Add 'box' element
sub geo_box {
  my $self = shift;

  if (@_ <= 1) {
    my $box = $self->find('box') or return;
    $box = $box->[ shift // 0 ] or return;

    # Wrong namespace
    return if $box->namespace ne __PACKAGE__->_namespace;

    # Return box
    my @points;
    my @v = split /\s+/, $box->text;
    return [
      [$v[0], $v[1]],
      [$v[2], $v[3]]
    ];
  };

  # Parameterlist has wrong length
  return unless @_ == 4;

  return $self->add(box => join(' ',@_));
};


# Add 'circle' element
sub geo_circle {
  my $self = shift;

  if (@_ <= 1) {
    my $circle = $self->find('circle') or return;
    $circle = $circle->[ shift // 0 ] or return;

    # Wrong namespace
    return if $circle->namespace ne __PACKAGE__->_namespace;

    # Return point
    my @v = split /\s+/, $circle->text;
    return [ [ $v[0], $v[1] ], $v[2] ];
  };

  # Parameterlist has wrong length
  return unless @_ == 3;

  return $self->add(circle => join(' ',@_));
};


1;


__END__