File Coverage

blib/lib/DBIx/Class/InflateColumn/Geo.pm

Criterion	Covered	Total	%
statement	11	34	32.3
branch	0	20	0.0
condition	0	4	0.0
subroutine	4	8	50.0
pod	0	1	0.0
total	15	67	22.3

use 5.10.1;
use strict;
use warnings;

package DBIx::Class::InflateColumn::Geo;

# ABSTRACT: Inflate geometric columns to data structures
our $AUTHORITY = 'cpan:CSSON'; # AUTHORITY
our $VERSION = '0.0100';

use Carp qw/confess/;

sub register_column {
    my($self, $column, $info, @rest) = @_;

    $self->next::method($column, $info, @rest);

    return if !(defined $info->{'data_type'});

    $self->_handle_point($column, $info, @rest) if lc $info->{'data_type'} eq 'point';
}

sub _handle_point {
    my($self, $column, $info, @rest) = @_;

    my $srid = exists $info->{'geo_srid'} ? $info->{'geo_srid'} : 4326;
    my $xname = $info->{'geo_xname'} || 'x';
    my $yname = $info->{'geo_yname'} || 'y';
    my $with_astext = exists $info->{'geo_with_astext'} ? $info->{'geo_with_astext'} : 0;

    $self->inflate_column(
        $column => {
            inflate => sub {
                my($value, $object) = @_;

                my($astext) = $object->result_source->schema->storage->dbh->selectrow_array("SELECT ASTEXT(?)", {}, $value);

                if($astext =~ m{^POINT\(([^\s]+) ([^\s]+)\)$}i) {
                    my $result = {
                        $xname => $1,
                        $yname => $2,
                    };
                    if($with_astext) {
                        $result->{'astext'} = $astext;
                    }
                    return $result;
                }
                return;
            },
            deflate => sub {
                my($value, $object) = @_;

                my $stringified = ref $value eq 'HASH'  ? sprintf ('%s %s', $value->{ $xname }, $value->{ $yname })
                                : ref $value eq 'ARRAY' ? "$value->[0] $value->[1]"
                                :                         $value
                                ;

                if($stringified =~ m/[^-+\d\s\.]/) {
                    confess "The submitted value for column <$column> stringifies to <$stringified>, which is not suitable for POINT";
                }

                return $srid ? \"ST_PointFromText('POINT($stringified)', $srid)"
                             : \"ST_PointFromText('POINT($stringified)')"
                             ;
            },
        }
    );
}

1;

__END__