## @class Geo::Vector
# @brief A class for geospatial vector data
#
# Geo::Vector is an extra layer on top of Perl module ogr. ogr module
# allows using OGR (from GDAL) from Perl. Geo::Vector adds the required
# functionality to use ogr layers in Gtk2::Ex::Geo. Geo::Vector may also
# add extra functionality like rasterization, vectorization, rendering
# etc. which may be useful in stand-alone scripts.
# Geo::Vector mainly represents one layer but see below.
#
# This module should be discussed in geo-perl@list.hut.fi.
#
# The homepage of this module is http://libral.sf.net.
#
# @note All objects (for example Geo::Raster) given to methods or functions as
# parameter and returned
# from them are always given and returned as references (scalars) even if the
# methods parameter or return type indicate the actual object type!
# A reference to scalars, hashes and lists (arrays) is indicated by using for
# the type names hashref, scalarref and listref!
#
# @see Geo::GDAL
#
# @author Ari Jolma
# @author Copyright (c) 2005-2006 by Ari Jolma
# @author This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself, either Perl version 5.8.5 or,
# at your option, any later version of Perl 5 you may have available.
package Geo::Vector;
use 5.008;
use strict;
use warnings;
use Carp;
use File::Basename;
use POSIX;
POSIX::setlocale( &POSIX::LC_NUMERIC, "C" ); # http://www.remotesensing.org/gdal/faq.html nr. 11
use Geo::GDAL;
use Geo::Layer qw/:all/;
use Gtk2::Pango;
use Graph;
require Exporter;
use AutoLoader;
use vars qw( @ISA %GEOMETRY_TYPE %GEOMETRY_TYPE_INV %RENDER_AS );
@ISA = qw( Exporter Geo::Layer );
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Geo::Vector ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [qw( %GEOMETRY_TYPE %RENDER_AS &drivers )] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
%GEOMETRY_TYPE =
(
Unknown => $Geo::OGR::wkbUnknown,
Point => $Geo::OGR::wkbPoint,
LineString => $Geo::OGR::wkbLineString,
Polygon => $Geo::OGR::wkbPolygon,
MultiPoint => $Geo::OGR::wkbMultiPoint,
MultiLineString => $Geo::OGR::wkbMultiLineString,
MultiPolygon => $Geo::OGR::wkbMultiPolygon,
GeometryCollection => $Geo::OGR::wkbGeometryCollection,
Point25D => $Geo::OGR::wkbPoint25D,
LineString25D => $Geo::OGR::wkbLineString25D,
Polygon25D => $Geo::OGR::wkbPolygon25D,
MultiPoint25D => $Geo::OGR::wkbMultiPoint25D,
MultiLineString25D => $Geo::OGR::wkbMultiLineString25D,
MultiPolygon25D => $Geo::OGR::wkbMultiPolygon25D,
GeometryCollection25D => $Geo::OGR::wkbGeometryCollection25D,
);
for ( keys %GEOMETRY_TYPE ) {
$GEOMETRY_TYPE_INV{ $GEOMETRY_TYPE{$_} } = $_;
}
# from ral_visual.h:
%RENDER_AS = ( Native => 0, Points => 1, Lines => 2, Polygons => 4 );
our $VERSION = '0.51';
## @ignore
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function.
my $constname;
our $AUTOLOAD;
( $constname = $AUTOLOAD ) =~ s/.*:://;
croak "&Geo::Vector::constant not defined" if $constname eq 'constant';
my ($error, $val) = constant($constname);
if ($error) { croak $error; }
{
no strict 'refs';
# Fixed between 5.005_53 and 5.005_61
#XXX if ($] >= 5.00561) {
#XXX *$AUTOLOAD = sub () { $val };
#XXX }
#XXX else {
*$AUTOLOAD = sub { $val };
#XXX }
}
goto &$AUTOLOAD;
}
require XSLoader;
XSLoader::load( 'Geo::Vector', $VERSION );
=pod
=head1 NAME
Geo::Vector - Perl extension for geospatial vectors
The documentation of Geo::Vector is in doxygen format
=cut
## @cmethod @geometry_types()
#
# @brief Returns a list of valid geometry types.
#
# %GEOMETRY_TYPE is a hash of standard type names: 'Point', 'LineString', ...
# @return a list of valid geometry types (as strings).
sub geometry_types {
my ($class) = @_;
return keys %GEOMETRY_TYPE;
}
## @cmethod @render_as_modes()
#
# @brief Returns a list of valid render as modes.
#
# %RENDER_AS is a hash of render types: 'Native', 'Points', ...
# @return a list of valid render as modes (as strings).
sub render_as_modes {
my ($class) = @_;
return keys %RENDER_AS;
}
## @cmethod %drivers()
#
# @brief Returns a hash of supported OGR drivers.
# @return a hash ( name => driver ) of supported OGR drivers
sub drivers {
my %d;
for (0..Geo::OGR::GetDriverCount()-1) {
my $d = Geo::OGR::GetDriver($_);
$d{$d->{name}} = $d;
}
return %d;
}
## @cmethod Geo::Vector new()
#
# @brief Creates an empty Geo::Vector object.
#
# The object can be used to host a link to a Geo::OGR::Datasource and a
# Geo::OGR::Layer in it, or it can be used to host in-memory Geo::OGR::Features.
#
# @return A new Geo::Vector object with default values
# @note This constructor inherits all the named parameters of Geo::Layer.
## @cmethod Geo::Vector new($filename)
#
# @brief Opens a Geo::Vector object from file.
#
# The object can be used to host a link to a Geo::OGR::Datasource and a
# Geo::OGR::Layer in it, or it can be used to host in-memory Geo::OGR::Features.
#
# You can simply open a geospatial vector file:
# @code
# $v = new Geo::Vector("borders.shp");
# @endcode
#
# @param[in] filename A file having parameters for the new object.
# @return A new Geo::Vector object with from file loaded values.
# @note This constructor inherits all the named parameters of Geo::Layer.
## @cmethod Geo::Vector new(%params)
#
# @brief Opens or creates a new Geo::Vector object with the given parameters.
#
# The object can be used to host a link to a Geo::OGR::Datasource and a
# Geo::OGR::Layer in it, or it can be used to host in-memory Geo::OGR::Features.
#
# You can open a geospatial vector file using named parameters:
#
# @code
# $v = new Geo::Vector(filename=>"borders.shp");
#
# $v = new Geo::Vector(datasource=>".", layer=>"borders.shp");
# @endcode
#
# @param[in] params is a list of named parameters:
# - filename => string, split into datasource and layer if given
# - datasource => string.
# - layer_name => string (optional). Name of the layer.
# - update => true/false (optional, default is false).
# - srs => number (optional). A geographic coordinate system code number in the
# EPSG database (European Petroleum Survey Group, http://www.epsg.org/). Default
# value is 4326, which is for WGS84.
# - geometry_type => one of geometry_type(), forwarded to Geo::OGR::CreateLayer,
# if a new layer is to be created.
# - sql => (optional) string, forwarded to Geo::OGR::ExecuteSQL if given.
# - schema => as in method schema (optional).
# - driver (optional), needed only if a new datasource is to be created.
# - driver_options (optional), forwarded to Geo::OGR::CreateDataSource.
# @return A new Geo::Vector object with attribute values given as parameter.
sub new {
my $package = shift;
my %params = @_ == 1 ? ( filename => $_[0] ) : @_;
my %defaults = ( driver => '',
driver_options => [],
filename => '',
datasource => '',
layer_name => '',
update => 0,
srs => 'EPSG:4326',
geometry_type => 'Unknown',
sql => '',
);
$params{sql} = $params{SQL} if $params{SQL};
for my $key (keys %defaults) {
next if defined $params{$key};
$params{$key} = $defaults{$key};
}
$params{layer_name} = $params{layer} if exists $params{layer}; # support this still for a while
($params{layer_name},$params{datasource},undef) = fileparse($params{filename}) if $params{filename};
my $self = Geo::Layer::new($package, %params);
# open the datasource if datasource
if ($params{datasource}) {
if ($params{driver}) {
eval {
if (ref($params{driver}) eq 'Geo::OGR::Driver') {
$self->{ogr_driver} = $params{driver};
} elsif ($params{driver} =~ /^\d+$/) {
$self->{ogr_driver} = Geo::OGR::GetDriver($params{driver});
} elsif ($params{driver}) {
$self->{ogr_driver} = Geo::OGR::GetDriverByName($params{driver});
}
croak "Can't find driver: $params{driver}" unless $self->{ogr_driver};
$self->{ogr_datasource} =
$self->{ogr_driver}->CreateDataSource($params{datasource}, $params{driver_options});
};
croak "CreateDataSource failed for $params{datasource}: $@" if $@;
} else {
eval {
$self->{ogr_datasource} = Geo::OGR::Open($params{datasource},$params{update});
};
croak "Geo::OGR::Open failed for $params{datasource}: $@" if $@;
croak "$params{datasource} could not be opened for update"
if $params{update} and !$self->{ogr_datasource};
$self->{update} = $params{update};
}
$self->{datasource} = $params{datasource};
$self->{OGRDataSourceH} = get_OGRDataSourceH($self->{ogr_datasource})
if $self->{ogr_datasource};
if ($params{layer_name} or $params{sql}) {
croak "Datasource $params{datasource} is empty and no driver has been defined."
unless $self->{ogr_datasource};
layer($self, %params);
$self->{OGRLayerH} = get_OGRLayerH($self->{ogr_layer});
}
} else {
$self->{features} = [];
}
schema($self,$params{schema}) if $params{schema};
# is blessed in Geo::Layer
return $self;
}
## @method void save($filename)
#
# @brief Saving the object?
# @param[in] filename Name of file where the vector layer is saved.
# @todo The method is not yet ready!
sub save {
my($self, $filename) = @_;
# todo
print STDERR "Geo::Vector object '"
. $self->name()
. "' was not saved because the save method is not implemented.";
}
## @method ref %layers()
#
# @brief Lists the layers that are available in the datasource to which this
# object points to.
# @return A hashref to a layer_name=>geometry_type hash.
sub layers {
my ($self) = @_;
my %layers;
return {} unless $self->{ogr_datasource};
for my $i ( 0 .. $self->{ogr_datasource}->GetLayerCount - 1 ) {
my $l = $self->{ogr_datasource}->GetLayerByIndex($i);
my $fd = $l->GetLayerDefn();
my $t = $fd->GetGeomType;
next unless $GEOMETRY_TYPE_INV{$t};
$layers{ $l->GetName } = $GEOMETRY_TYPE_INV{$t};
}
return \%layers;
}
## @method void delete_layer($layer_name)
#
# @brief Attempts to Delete a layer from the datasource to which this object
# points to.
# @param[in] layer_name Name of the layer that should be deleted.
sub delete_layer {
my ( $self, $layer_name ) = @_;
return unless $self->{ogr_datasource};
for my $i ( 0 .. $self->{ogr_datasource}->GetLayerCount - 1 ) {
my $l = $self->{ogr_datasource}->GetLayerByIndex($i);
$self->{ogr_datasource}->DeleteLayer($i), last
if $l->GetName() eq $layer_name;
}
}
## @method Geo::Vector layer(%params)
#
# @brief Open or create a new layer.
# @param[in] params is a list of named parameters:
# - sql => string (optional) An SQL-string, forwarded to Geo::OGR::ExecuteSQL if
# given.
# - layer_name => string (optional). Name of/for the a layer.
# - srs => number (optional). A geographic coordinate system code number in the
# EPSG database (European Petroleum Survey Group, http://www.epsg.org/). Default
# value is 4326, which is for WGS84.
# - geometry_type => string (optional). One of the types supported given by
# geometry_type(), forwarded to Geo::OGR::CreateLayer if a new layer is to be
# created.
# @return An existing layer if one exists with the given name or can be found
# using the SQL command. Else the new created layer is returned.
# @exception If sql is given, but the SQL command is not possible to be executed.
# @exception If EPSG number is given for a new layer, but the number is not
# supported.
# @exception If the geometry type is given for a new layer, but it is not
# supported.
sub layer {
my ( $self, %params ) = @_;
return unless $self->{ogr_datasource};
$params{layer_name} = $params{layer}
if exists $params{layer}; # support this still for a while
# Open by SQL
if ( $params{sql} ) {
$self->{sql} = $params{sql};
eval {
$self->{ogr_layer} =
$self->{ogr_datasource}->ExecuteSQL( $self->{sql} );
};
croak "ExecuteSQL failed: $@" if $@ or !$self->{ogr_layer};
$self->{OGRLayerH} = get_OGRLayerH( $self->{ogr_layer} );
return $self;
}
# Open by name
$self->{ogr_layer} =
$self->{ogr_datasource}->GetLayerByName( $params{layer_name} );
if ( $self->{ogr_layer} ) {
$self->{OGRLayerH} = get_OGRLayerH( $self->{ogr_layer} );
return $self;
}
# Create new
my $srs;
if (ref($params{srs}) and ref($params{srs}) eq 'Geo::OSR::SpatialReference') {
$srs = $params{srs};
} else {
$srs = new Geo::OSR::SpatialReference;
$params{srs} = 'EPSG:4326' unless $params{srs};
if ( $params{srs} =~ /^EPSG:(\d+)/ ) {
eval { $srs->ImportFromEPSG($1); };
croak "ImportFromEPSG failed: $@" if $@;
} else {
croak "SRS $params{srs} not yet supported";
}
}
my $t = exists $params{geometry_type} ? $params{geometry_type} : 'Unknown';
croak "invalid geometry type: $GEOMETRY_TYPE{$t}"
unless exists $GEOMETRY_TYPE{$t};
eval {
$self->{ogr_layer} =
$self->{ogr_datasource}
->CreateLayer( $params{layer_name}, $srs, $GEOMETRY_TYPE{$t} );
};
croak "CreateLayer failed (does the datasource have update on?): $@"
if $@ or !$self->{ogr_layer};
$self->{update} = 1;
$self->{OGRLayerH} = get_OGRLayerH( $self->{ogr_layer} );
return $self;
}
## @ignore
sub DESTROY {
my $self = shift;
return unless $self;
$self->SUPER::DESTROY;
if ( $self->{sql} and $self->{ogr_datasource} ) {
$self->{ogr_datasource}->ReleaseResultSet( $self->{ogr_layer} );
}
if ( $self->{features} ) {
for ( @{ $self->{features} } ) {
undef $_;
}
}
}
## @method $feature_count()
#
# @brief Returns the number of features in the layer (may be approximate) or in
# the object.
# @return Number of features in the layer (may be approximate) or in the object.
sub feature_count {
my ($self) = @_;
if ( $self->{features} ) {
my $count = @{ $self->{features} };
return $count;
}
return unless $self->{ogr_layer};
my $count;
eval { $count = $self->{ogr_layer}->GetFeatureCount(); };
croak "GetFeatureCount failed: $@" if $@;
return $count;
}
## @method Geo::OSR::SpatialReference srs(%params)
#
# @brief Get or set (set is not yet implemented) the spatial reference system of
# the layer.
#
# SRS (Spatial reference system) is a geographic coordinate system code number
# in the EPSG database (European Petroleum Survey Group, http://www.epsg.org/).
# Default value is 4326, which is for WGS84.
# @param[in] params (optional) is a list of named parameters:
# - format => string. Name of the wanted return format, like 'Wkt'. Wkt is for
# Well-known text and is defined by the The OpenGIS Consortium specification for
# the exchange (and easy persistance) of geometry data in ASCII format.
# @return Returns the current spatial reference system of the layer
# as a Geo::OSR::SpatialReference or wkt string.
sub srs {
my ( $self, %params ) = @_;
return unless $self->{ogr_layer};
my $srs;
eval { $srs = $self->{ogr_layer}->GetSpatialRef(); };
croak "GetSpatialRef failed: $@" if $@;
return unless $srs;
if ( $params{format} ) {
return $srs->ExportToWkt if $params{format} eq 'Wkt';
}
return $srs;
}
## @method $field_count()
#
# @brief For a layer object returns the number of fields in the layer schema.
# For a feature set object requires a named parameter that specifies the feature.
#
# Each feature in a feature set object may have its own schema.
# @return For a layer object returns the number of fields in the layer schema.
# For a feature set object requires a named parameter that specifies the feature.
sub field_count {
my ( $self, %param ) = @_;
if ( $self->{features} ) {
my $f = $self->{features}->[ $param{feature} ];
return $f ? $f->GetFieldCount() : undef;
}
return unless $self->{ogr_layer};
my $n;
eval { $n = $self->{ogr_layer}->GetLayerDefn()->GetFieldCount(); };
croak "GetLayerDefn or GetFieldCount failed: $@" if $@;
return $n;
}
## @method $geometry_type(%param)
#
# @brief For a layer object returns the geometry type of the layer.
# For a feature set object requires a named parameter that specifies the feature.
#
# @param[in] param is a list of named parameters:
# - flatten => true/false. Default is false.
# - feature => integer. Index of the feature whose geometry type is queried.
# @return For a layer object returns the geometry type of the layer.
# For a feature set object returns specified features geometry type.
sub geometry_type {
my ( $self, %param ) = @_;
my $t;
if ( $self->{features} ) {
my $f = $self->{features}->[ $param{feature} ];
if ($f) {
$t = $f->GetGeometryRef->GetGeometryType;
}
}
elsif ( $self->{ogr_layer} ) {
$t = $self->{ogr_layer}->GetLayerDefn()->GetGeomType;
}
return unless $t;
$t = $t & ~0x80000000 if $param{flatten};
return $GEOMETRY_TYPE_INV{$t};
}
## @method hashref schema(ref % schema, ref Geo::OGR::Feature feature)
#
# @brief For a layer object gets or sets the schema of the layer.
# For a feature set object requires a named parameter that specifies the feature.
#
# @param[in] schema is a hashref field_name=>(Number, Type, TypeName, Justify,
# Width, Precision)=>value. So schema is a reference to a hash, whose keys are
# field names and values are hashrefs. The keys of the second hash are Number
# (o), Type (o), TypeName (i/o), and Justify, Width, and Precision (i/o, not
# obligatory). Fields are only created if they don't already exist in the layer.
# The returned schema contains a pseudofield FID (feature id).
# @param[in] feature The feature whose schema is queried (required for feature
# set layers)
# @return For a layer object returns a reference to the schema of the layer.
# For a feature object returns a reference to the specified features schema.
sub schema {
my $self = shift;
my $schema = shift;
my $feature;
if ( ref($schema) ) {
$feature = shift;
}
else {
$feature = $schema;
$schema = undef;
}
my $s;
if ( $self->{features} ) {
$s = $self->{features}->[$feature]->GetDefnRef if $feature;
}
elsif ( $self->{ogr_layer} ) {
$s = $self->{ogr_layer}->GetLayerDefn();
}
if ($schema) {
croak "refusing to set the schema of all features in a feature table at once" unless $s;
my %exists;
my $n = $s->GetFieldCount();
for my $i ( 0 .. $n - 1 ) {
my $fd = $s->GetFieldDefn($i);
my $name = $fd->GetName;
$exists{$name} = 1;
}
for my $name ( keys %$schema ) {
$schema->{$name}{Number} = $n++
unless defined $schema->{$name}{Number};
}
my $recreate = 0;
for my $name ( sort { $schema->{$a}{Number} <=> $schema->{$b}{Number} }
keys %$schema ) {
next if $name eq 'FID';
my $d = $schema->{$name};
my $type = $d->{Type};
$type = eval "\$Geo::OGR::OFT$d->{TypeName}" unless $type;
my $fd = new Geo::OGR::FieldDefn( $name, $type );
$fd->ACQUIRE;
$fd->SetJustify( $d->{Justify} ) if defined $d->{Justify};
$fd->SetWidth( $d->{Width} ) if defined $d->{Width};
if ( exists $d->{Width} ) {
$fd->SetWidth( $d->{Width} );
}
else {
$fd->SetWidth(10) if $type == $Geo::OGR::OFTInteger;
}
$fd->SetPrecision( $d->{Precision} ) if defined $d->{Precision};
unless ( $exists{$name} ) {
$self->{ogr_layer}->CreateField($fd) if $self->{ogr_layer};
$recreate = 1;
}
}
if ( $self->{features} and $recreate ) {
my $sg = $s->GetGeometryRef();
my $dg = Geo::OGR::Geometry->new( $sg->GetGeometryType );
$dg->ACQUIRE;
copy_geometry_data( $sg, $dg );
my $d = Geo::OGR::FeatureDefn->new();
for my $name (
sort { $schema->{$a}{Number} <=> $schema->{$b}{Number} }
keys %$schema ) {
my $fd =
Geo::OGR::FieldDefn->new( $name, $schema->{$name}{Type} );
$fd->ACQUIRE;
$fd->SetJustify( $schema->{$name}{Justify} )
if exists $schema->{$name}{Justify};
if ( exists $schema->{$name}{Width} ) {
$fd->SetWidth( $schema->{$name}{Width} );
}
else {
$fd->SetWidth(10)
if $schema->{$name}{Type} == $Geo::OGR::OFTInteger;
}
$fd->SetPrecision( $schema->{$name}{Precision} )
if exists $schema->{$name}{Precision};
$d->AddFieldDefn($fd);
}
$d->DISOWN; # this is given to feature
my $f = Geo::OGR::Feature->new($d);
$f->SetGeometry($dg);
for my $name ( keys %$schema ) {
$f->SetField( $name, $s->GetField($name) ) if $exists{$name};
}
$self->{features}->[$feature] = $f;
}
} else {
$schema = {};
my @s;
if ($s) {
push @s, $s;
}
else {
for my $feature ( @{ $self->{features} } ) {
push @s, $feature->GetDefnRef;
}
}
eval {
for my $s (@s) {
my $n = $s->GetFieldCount();
# this data is potentially not ok if table
for my $i ( 0 .. $n - 1 ) {
my $fd = $s->GetFieldDefn($i);
my $name = $fd->GetName;
$schema->{$name}{Number} = $i;
$schema->{$name}{Type} = $fd->GetType;
$schema->{$name}{TypeName} =
$fd->GetFieldTypeName( $fd->GetType );
$schema->{$name}{Justify} = $fd->GetJustify;
$schema->{$name}{Width} = $fd->GetWidth;
$schema->{$name}{Precision} = $fd->GetPrecision;
}
}
};
croak "GetFieldCount failed: $@" if $@;
$schema->{FID}{Number} = -1;
$schema->{FID}{Type} = $Geo::OGR::OFTInteger;
$schema->{FID}{TypeName} = 'Integer';
return $schema;
}
}
## @method select(%params)
#
# @brief Select features based on the information provided.
# @param params named params
# - key A Geo::OGR::Geometry object representing the point or area the user has selected
# The key, value pair is fed as such to features subroutine.
# A call without parameters deselects all features.
sub select {
my($self, %params) = @_;
if (@_ > 1) {
for my $key (keys %params) {
my $features = $self->features($key => $params{$key});
if ($features and @$features) {
my $f = $self->selected_features();
push @$features, values(%$f);
}
$self->selected_features($features);
}
} elsif ($params{selected_point}) {
my $features = $self->features(that_contain => $params{selected_point});
if ($features and @$features) {
my $f = $self->selected_features();
push @$features, values(%$f);
}
$self->selected_features($features);
} elsif ($params{selected_area}) {
my $features = $self->features(that_are_within => $params{selected_area});
if ($features and @$features) {
my $f = $self->selected_features();
push @$features, values(%$f);
}
$self->selected_features($features);
} else {
$self->selected_features([]);
}
}
## @method @value_range(%named_parameters)
#
# @brief Returns a list of the value range of the field.
# @param[in] named_parameters
# - field_name => string. The attribute whose min and max values are looked up.
# - filter => reference to a Geo::OGR::Geometry (optional). Used by
# Geo::OGR::SetSpatialFilter() if the layer is an OGR layer.
# - filter_rect => reference to an array defining the rect (min_x, min_y, max_x,
# max_y) (optional). Used by the Geo::OGR::SetSpatialFilterRect() if the layer
# is an OGR layer.
# @return An array that has as it's first value the ranges minimum and as second
# the maximum -- array(min, max).
## @method @value_range($field_name)
#
# @brief Returns a list of the value range of the field.
# @param[in] field_name The name of the field, whose min and max values are
# looked up.
# @return An array that has as it's first value the ranges minimum and as second
# the maximum -- array(min, max).
sub value_range {
my $self = shift;
my $field_name;
my %param;
if ( @_ == 1 ) {
$field_name = shift;
}
else {
%param = @_;
$field_name = $param{field_name};
}
if ( $self->{features} ) {
my @range;
for my $feature ( @{ $self->{features} } ) {
my $d = $feature->GetDefnRef;
my $n = $d->GetFieldCount;
my $value;
for my $i ( 0 .. $n - 1 ) {
my $fd = $d->GetFieldDefn($i);
my $name = $fd->GetName;
next unless $name eq $field_name;
my $type = $fd->GetType;
next
unless $type == $Geo::OGR::OFTInteger
or $type == $Geo::OGR::OFTReal;
$value = $feature->GetField($i);
}
next unless defined $value;
$range[0] =
defined $range[0]
? ( $range[0] < $value ? $range[0] : $value )
: $value;
$range[1] =
defined $range[1]
? ( $range[1] > $value ? $range[1] : $value )
: $value;
}
return @range;
}
my $schema = $self->schema()->{$field_name};
croak "value_range: field with name '$field_name' does not exist"
unless defined $schema;
croak
"value_range: can't use value from field '$field_name' since its' type is '$schema->{TypeName}'"
unless $schema->{TypeName} eq 'Integer'
or $schema->{TypeName} eq 'Real';
return ( 0, $self->{ogr_layer}->GetFeatureCount - 1 )
if $field_name eq 'FID';
my $field = $schema->{Number};
# this would be probably faster as a database operation if data is in a database
if ( exists $param{filter} ) {
$self->{ogr_layer}->SetSpatialFilter( $param{filter} );
}
elsif ( exists $param{filter_rect} ) {
$self->{ogr_layer}->SetSpatialFilterRect( @{ $param{filter_rect} } );
}
else {
$self->{ogr_layer}->SetSpatialFilter(undef);
}
$self->{ogr_layer}->ResetReading();
my @range;
while (1) {
my $f = $self->{ogr_layer}->GetNextFeature();
last unless $f;
my $value = $f->GetFieldAsString($field);
$range[0] =
defined $range[0]
? ( $range[0] < $value ? $range[0] : $value )
: $value;
$range[1] =
defined $range[1]
? ( $range[1] > $value ? $range[1] : $value )
: $value;
}
return @range;
}
## @method void copy_geometry_data(Geo::OGR::Geometry source, Geo::OGR::Geometry destination)
#
# @brief The method copies the data of the other Geo::OGR::Geometry to the other.
# @param[in] source A reference to an Geo::OGR::Geometry object, whose data is
# copied.
# @param[out] destination A reference to an Geo::OGR::Geometry object to which the
# other parameters data is copied to.
sub copy_geometry_data {
my ( $src, $dst ) = @_;
if ( $src->GetGeometryCount ) {
for ( 0 .. $src->GetGeometryCount - 1 ) {
my $s = $src->GetGeometryRef($_);
my $t = $s->GetGeometryType;
my $n = $s->GetGeometryName;
$t = $Geo::OGR::wkbLinearRing if $n eq 'LINEARRING';
my $r = new Geo::OGR::Geometry($t);
$r->ACQUIRE;
copy_geom_data( $s, $r );
$dst->AddGeometry($r);
}
} else {
for ( 0 .. $src->GetPointCount - 1 ) {
my $x = $src->GetX($_);
my $y = $src->GetY($_);
my $z = $src->GetZ($_);
$dst->AddPoint( $x, $y, $z );
}
}
}
## @method hashref has_field($field_name)
#
# @brief Tells if the layer has a field with a given name.
# @param[in] field_name Name of the field, which existence is asked.
# @return Returns the schema of the field.
sub has_field {
my ( $self, $field_name ) = @_;
return $self->schema->{$field_name};
}
sub selected_features {
my($self, $selected) = @_;
if (defined $selected) {
if (ref $selected eq 'ARRAY') {
my %s = map { $_->GetFID => $_ } @$selected;
$self->{_selected} = \%s;
} else {
$self->{_selected} = $selected;
}
} else {
return $self->{_selected};
}
}
## @method hashref feature($fid, $feature)
#
# @brief Get, add or update a feature.
#
# Example of retrieving:
# @code
# $feature = $vector->feature($i);
# @endcode
#
# Example of updating:
# @code
# $vector->feature($i, $feature);
# @endcode
#
# Example of adding:
# @code $vector->add_feature(%feature);
# @endcode
#
# @param[in] fid The FID of the feature (or the feature, if adding)
# @param[in] feature Feature to add (then no other parameters) or feature to update.
# @return Feature as a hashref (field_name, geometry, geometry_type)=>(value,
# geometry in array, geometry_type).
# @exception The fid is higher than the feature count.
# @todo Adding feature to ogr-layer.
## @method void feature(Geo::OGR::Feature feature)
#
# @brief Adding a feature.
#
# Example of adding:
# @code $vector->add_feature($feature);
# @endcode
#
# @param[in] feature Feature to add to the layer.
sub feature {
my ( $self, $fid, $feature ) = @_;
if ($feature) {
# update at i
if ( $self->{features} ) {
$feature = $self->make_feature($feature);
$self->{features}->[$fid] = $feature;
}
elsif ( $self->{ogr_layer} ) {
croak "can't set a feature in a layer (at least yet)";
}
else {
croak "no layer";
}
}
elsif ( ref($fid) ) {
$self->add_feature($fid);
}
else {
# retrieve
my $f;
if ( $self->{features} ) {
$f = @{ $self->{features}->[$fid] };
croak "feature index out of bounds: $fid" unless $f;
}
elsif ( $self->{ogr_layer} ) {
my $count = $self->{ogr_layer}->GetFeatureCount();
croak "Can't fetch feature nr $fid, there are only $count features"
if $fid >= $count;
$f = $self->{ogr_layer}->GetFeature($fid);
}
else {
croak "no layer";
}
my $defn = $f->GetDefnRef;
$feature = {};
my $n = $defn->GetFieldCount();
for my $fid ( 0 .. $n - 1 ) {
my $fd = $defn->GetFieldDefn($fid);
my $name = $fd->GetName;
$feature->{$name} = $f->GetField($fid);
}
my $geometry = $f->GetGeometryRef;
my $t = $geometry->GetGeometryType;
$feature->{geometry_type} = $GEOMETRY_TYPE_INV{$t};
$feature->{geometry} = get_geometry($geometry);
return $feature;
}
}
## @fn listref get_geometry(Geo::OGR::Geometry geometry)
#
# @brief Conversion Geo::OGR::Geometry -> Perl structure of arrays.
# @param[in] geometry An Geo::OGR::Geometry object.
# @return Reference to array having the geometry (for example for points:
# [x, y, z]).
sub get_geometry {
my ($geometry) = @_;
my $a = [];
if ( $geometry->GetGeometryCount ) {
for my $i ( 0 .. $geometry->GetGeometryCount - 1 ) {
push @$a, get_geometry( $geometry->GetGeometryRef($i) );
}
}
elsif ( $geometry->GetPointCount == 1 ) {
$a = [ $geometry->GetX(), $geometry->GetY(), $geometry->GetZ() ];
}
else {
for my $i ( 0 .. $geometry->GetPointCount - 1 ) {
push @$a,
[ $geometry->GetX($i), $geometry->GetY($i), $geometry->GetZ($i) ];
}
}
return $a;
}
## @fn void add_point(Geo::OGR::Geometry geometry, listref point)
#
# @brief Adds the given point to the given geometry.
# @param[out] geometry a Geo::OGR::Geometry object.
# @param[in] point A points coordinates as an array [x,y(,z)]
sub add_point {
my ( $geometry, $point ) = @_;
my $z = $point->[2];
$z = 0 unless defined $z;
$geometry->AddPoint( $point->[0], $point->[1], $z );
}
## @fn void add_points(Geo::OGR::Geometry geometry, listref points)
#
# @brief Adds the given points to the given geometry.
# @param[out] geometry A Geo::OGR::Geometry object.
# @param[in] points A reference to an array of points [point, point, ...], where
# each point is a reference to an array having the point's geometry [x,y(,z)].
sub add_points {
my ( $geometry, $points ) = @_;
for my $point (@$points) {
add_point( $geometry, $point );
}
}
## @fn Geo::OGR::Geometry make_geometry(listref geometry_array, $geometry_type)
#
# @brief Conversion from a Perl structure of arrays -> Geo::OGR::Geometry.
# @param[in] geometry_array A reference to an array having the geometry. In case of
# a single point the array has simply the point's coordinates ([x, y ,(z)]), but
# alternatively it can also have a set of references to other points (for
# example in the case of a line, multipoint or polygon). The geometry_array can
# be gotten by using the get_geometry() method.
# @param[in] geometry_type Type of the geometry. The geometry type can be gotten
# by using the geometry_type() method.
# @return A Geo::OGR::Geometry object.
sub make_geometry {
my ( $a, $geometry_type ) = @_;
$geometry_type = $GEOMETRY_TYPE{$geometry_type}
unless exists $GEOMETRY_TYPE_INV{$geometry_type};
my $geometry = new Geo::OGR::Geometry($geometry_type);
$geometry->ACQUIRE;
my $rt;
if ( $geometry_type == $Geo::OGR::wkbPolygon ) {
$rt = $Geo::OGR::wkbLinearRing;
} elsif ( $geometry_type == $Geo::OGR::wkbPolygon25D ) {
$rt = $Geo::OGR::wkbLinearRing25D;
}
my $m = $geometry_type & 0x80000000;
$geometry_type = $geometry_type & ~0x80000000;
SWITCH: {
if ( $geometry_type == $Geo::OGR::wkbPoint ) {
add_point( $geometry, $a );
last SWITCH;
}
if ( $geometry_type == $Geo::OGR::wkbLineString ) {
add_points( $geometry, $a );
last SWITCH;
}
if ( $geometry_type == $Geo::OGR::wkbPolygon ) {
for my $ring (@$a) {
my $r = new Geo::OGR::Geometry($rt);
$r->ACQUIRE;
add_points( $r, $ring );
$geometry->AddGeometry($r);
}
last SWITCH;
}
if ( $geometry_type == $Geo::OGR::wkbMultiPoint ) {
my $mt = $m ? $Geo::OGR::wkbPoint25D : $geometry_type;
for my $b (@$a) {
my $p = new Geo::OGR::Geometry($mt);
$p->ACQUIRE;
add_point( $p, $b );
$geometry->AddGeometry($p);
}
last SWITCH;
}
if ( $geometry_type == $Geo::OGR::wkbMultiLineString ) {
my $mt = $m ? $Geo::OGR::wkbLineString25D : $geometry_type;
for my $b (@$a) {
my $i = new Geo::OGR::Geometry($mt);
$i->ACQUIRE;
add_points( $i, $b );
$geometry->AddGeometry($i);
}
last SWITCH;
}
if ( $geometry_type == $Geo::OGR::wkbMultiPolygon ) {
my $mt = $m ? $Geo::OGR::wkbPolygon25D : $geometry_type;
for my $b (@$a) {
my $i = new Geo::OGR::Geometry($mt);
$i->ACQUIRE;
for my $ring (@$b) {
my $r = new Geo::OGR::Geometry($rt);
$r->ACQUIRE;
add_points( $r, $ring );
$i->AddGeometry($r);
}
$geometry->AddGeometry($i);
}
last SWITCH;
}
}
return $geometry;
}
## @method Geo::OGR::Feature make_feature(hashref feature)
#
# @brief Converts an feature given as hash to an Geo::OGR::Feature object.
# @param[in] feature is an reference to an hash having named parameters:
# - fieldname. Name of the field as a number (int/real) or string.
# - geometry. A reference to an array having the geometry. In case of
# a single point the array has simply the point's coordinates ([x, y ,(z)]), but
# alternatively it can also have a set of references to other points (for
# example in the case of a line, multipoint or polygon). The geometry_array can
# be gotten by using the get_geometry() method.
# - geometry_type. Type of the geometry. The geometry type can be gotten
# by using the geometry_type() method.
# @return Geo::OGR::Feature object.
# @note If the parameter is already a reference to an Geo::OGR::Feature nothing
# is done to the feature.
## @method Geo::OGR::Feature make_feature(%feature)
#
# @brief Converts an feature given as hash to an Geo::OGR::Feature object.
# @param[in] feature is a hash having named parameters:
# - fieldname. Name of the field as a number (int/real) or string.
# - geometry. A reference to an array having the geometry. In case of
# a single point the array has simply the point's coordinates ([x, y ,(z)]), but
# alternatively it can also have a set of references to other points (for
# example in the case of a line, multipoint or polygon). The geometry_array can
# be gotten by using the get_geometry() method.
# - geometry_type. Type of the geometry. The geometry type can be gotten
# by using the geometry_type() method.
# @return Geo::OGR::Feature object.
sub make_feature {
my $self = shift;
my $feature;
my %feature;
if ( @_ == 1 ) {
$feature = shift;
return $feature if ref($feature) eq 'Geo::OGR::Feature';
if ( ref($feature) eq 'HASH' ) {
%feature = %{ $_[0] };
}
else {
croak "can't make a feature out of $feature";
}
}
else {
%feature = @_;
}
croak "you must specify a geometry for the new feature"
unless $feature{geometry};
my $defn;
my $geom_type;
if ( $self->{features} ) {
$defn = Geo::OGR::FeatureDefn->new();
for my $name ( sort keys %feature ) {
next if $name eq 'geometry' or $name eq 'geometry_type';
my $value = $feature{$name}; # fieldname found.
my $type;
if ( $value =~ /^[+-]*\d+$/ ) {
$type = $Geo::OGR::OFTInteger;
}
elsif ( $value =~ /^[+-]*\d*\.*\d*$/ and $value =~ /\d/ ) {
$type = $Geo::OGR::OFTReal;
}
else {
$type = $Geo::OGR::OFTString;
}
my $fd = Geo::OGR::FieldDefn->new( $name, $type );
$fd->ACQUIRE;
$fd->SetWidth(10) if $type == $Geo::OGR::OFTInteger;
$defn->AddFieldDefn($fd);
}
$geom_type = $GEOMETRY_TYPE{ $feature{geometry_type} };
}
elsif ( $self->{ogr_layer} ) {
$defn = $self->{ogr_layer}->GetLayerDefn();
$geom_type = $defn->GetGeomType;
$geom_type = $GEOMETRY_TYPE{ $feature{geometry_type} }
if $geom_type == $Geo::OGR::wkbUnknown;
}
else {
croak "no features table nor layer where to put the new feature";
}
croak "could not come up with a type for the new geometry"
unless $geom_type;
$defn->DISOWN; # feature owns
$feature = Geo::OGR::Feature->new($defn);
my $n = $defn->GetFieldCount();
for my $i ( 0 .. $n - 1 ) {
my $fd = $defn->GetFieldDefn($i);
my $name = $fd->GetName;
$feature->SetField( $name, $feature{$name} );
}
$feature->SetGeometry( make_geometry( $feature{geometry}, $geom_type ) );
return $feature;
}
## @method void add_feature(%feature)
#
# @brief Adds a feature to the layer.
# @param feature is a hash having named parameters:
# - fieldname. Name of the field as a number (int/real) or string.
# - geometry. A reference to an array having the geometry. In case of
# a single point the array has simply the point's coordinates ([x, y ,(z)]), but
# alternatively it can also have a set of references to other points (for
# example in the case of a line, multipoint or polygon). The geometry_array can
# be gotten by using the get_geometry() method.
# - geometry_type. Type of the geometry. The geometry type can be gotten
# by using the geometry_type() method.
## @method void add_feature(hashref feature)
#
# @brief Adds a feature to the layer.
# @param[in] feature is an reference to an hash having named parameters:
# - fieldname. Name of the field as a number (int/real) or string.
# - geometry. A reference to an array having the geometry. In case of
# a single point the array has simply the point's coordinates ([x, y ,(z)]), but
# alternatively it can also have a set of references to other points (for
# example in the case of a line, multipoint or polygon). The geometry_array can
# be gotten by using the get_geometry() method.
# - geometry_type. Type of the geometry. The geometry type can be gotten
# by using the geometry_type() method.
## @method void add_feature(Geo::OGR::Feature feature)
#
# @brief Adds a feature to the layer.
# @param feature A Geo::OGR::Feature object.
sub add_feature {
my $self = shift;
my $feature = $self->make_feature(@_);
if ( $self->{features} ) {
push @{ $self->{features} }, $feature;
}
elsif ( $self->{ogr_layer} ) {
$self->{ogr_layer}->CreateFeature($feature);
$self->{ogr_layer}->SyncToDisk;
}
}
## @method listref features(%params)
#
# @brief Returns features satisfying the given requirement.
# @param[in] params is a list named parameters
# - that_contain => refeference to a list. A points coordinates as an array
# [x,y(,z)]. The point is given as requirement. A feature satisfies the
# requirement if the point is within the feature.
# - that_intersect => Geo::OGR::Geometry object. An envelope as requirement. A
# feature satisfies the requirement if the feature intersects with the given
# envelope.
# - with_id => Reference to an array of feature indexes (fids).
# @return A reference to an array of features.
sub features {
my ( $self, %params ) = @_;
my @features;
if ( exists $params{that_contain} ) {
my @point;
my $point;
if (ref($params{that_contain}) eq 'ARRAY') {
@point = @{ $params{that_contain} };
$point = new Geo::OGR::Geometry($Geo::OGR::wkbPoint);
$point->ACQUIRE;
$point->AddPoint(@point);
} else {
$point = $params{that_contain};
@point = ($point->GetX, $point->GetY);
}
my $layer = $self->{ogr_layer};
$layer->SetSpatialFilterRect( @point, @point );
$layer->ResetReading();
while (1) {
my $f = $layer->GetNextFeature();
last unless $f;
my $g = $f->GetGeometryRef;
next unless $point->Within($g);
push @features, $f;
}
}
elsif ( exists $params{focus} ) {
my $selected = $self->selected_features();
my $layer = $self->{ogr_layer};
$layer->SetSpatialFilterRect(@{$params{focus}});
$layer->ResetReading();
my $i = 1;
for my $id (sort {$a<=>$b} keys %$selected) {
$i++;
push @features, $selected->{$id};
}
my $from = $params{from} || 1;
my $count = $params{count} || 15;
while ($i < $from+$count) {
my $f = $layer->GetNextFeature();
last unless $f;
next if $selected->{$f->GetFID};
$i++;
next if $i <= $from;
push @features, $f;
}
}
elsif ( exists $params{filter_with_rect} ) {
my $rect = $params{filter_with_rect};
my $layer = $self->{ogr_layer};
$layer->SetSpatialFilterRect( @$rect );
$layer->ResetReading();
while (1) {
my $f = $layer->GetNextFeature();
last unless $f;
push @features, $f;
}
}
elsif ( exists $params{that_are_within} ) {
my $geom = $params{that_are_within};
my $layer = $self->{ogr_layer};
my $e = $geom->GetEnvelope;
$layer->SetSpatialFilterRect( $e->[0], $e->[2], $e->[1], $e->[3] );
$layer->ResetReading();
while (1) {
my $f = $layer->GetNextFeature();
last unless $f;
my $g = $f->GetGeometryRef;
next unless $g->Within($geom);
push @features, $f;
}
}
elsif ( exists $params{that_intersect} ) {
my $geom = $params{that_intersect};
my $layer = $self->{ogr_layer};
my $e = $geom->GetEnvelope;
$layer->SetSpatialFilterRect( $e->[0], $e->[2], $e->[1], $e->[3] );
$layer->ResetReading();
while (1) {
my $f = $layer->GetNextFeature();
last unless $f;
my $g = $f->GetGeometryRef;
next unless $g->Intersect($geom);
push @features, $f;
}
}
elsif ( exists $params{with_id} ) {
my $fids = $params{with_id};
if ( $self->{features} ) {
for my $f (@$fids) {
my $x = $self->{features}->[$f];
push @features, $x if $x;
}
}
elsif ( $self->{ogr_layer} ) {
for my $f (@$fids) {
my $x = $self->{ogr_layer}->GetFeature($f);
push @features, $x if $x;
}
}
else {
croak "the layer contains no data";
}
}
else {
croak
"nothing to do! specify that_contain=>[x,y] or that_intersect=>\$geom";
}
return \@features;
}
## @method @world(hash params)
#
# @brief Get the bounding box (xmin, ymin, xmax, ymax) of the layer or one of
# its features.
#
# The method uses Geo::OGR::Geometry::GetEnvelope() or
# Geo::OGR::Layer::GetExtent().
#
# Example of getting a bounding box:
# @code
# @bb = $vector->world(feature=>);
# @endcode
#
# @param[in] params is a list of named parameters:
# - feature => feature_index (optional).
# @return Returns the bounding box (minX, minY, maxX, maxY) as an array.
# If a single feature is defined with it's index as parameter, then the method
# returns that feature's bounding box, else the whole layer's bounding box.
sub world {
my $self = shift;
my %params;
%params = @_ unless @_ % 2;
my $extent;
if ( defined $params{feature} ) {
my $f;
if ( $self->{features} ) {
$f = $self->{features}->[ $params{feature} ];
} elsif ( $self->{ogr_layer} ) {
$f = $self->{ogr_layer}->GetFeature( $params{feature} );
} else {
croak "no layer";
}
croak "feature with fid=$params{feature} does not exist" unless $f;
eval { $extent = $f->GetGeometryRef()->GetEnvelope(); };
croak "GetEnvelope failed: $@" if $@;
}
else {
if ( $self->{features} ) {
for my $f ( @{ $self->{features} } ) {
my $e = $f->GetGeometryRef()->GetEnvelope();
unless ($extent) {
@$extent = @$e;
}
else {
$extent->[0] = MIN( $extent->[0], $e->[0] );
$extent->[2] = MIN( $extent->[2], $e->[2] );
$extent->[1] = MAX( $extent->[1], $e->[1] );
$extent->[3] = MAX( $extent->[3], $e->[3] );
}
}
}
elsif ( $self->{ogr_layer} ) {
eval { $extent = $self->{ogr_layer}->GetExtent(); };
croak "GetExtent failed: $@" if $@;
}
else {
croak "no layer";
}
}
# return a sensible world in any case
unless ($extent) {
$extent = [ 0, 1, 0, 1 ];
}
else {
$extent->[1] = $extent->[0] + 1 if $extent->[1] <= $extent->[0];
$extent->[3] = $extent->[2] + 1 if $extent->[3] <= $extent->[2];
}
return ( $extent->[0], $extent->[2], $extent->[1], $extent->[3] );
}
## @method Geo::Vector clip($name, %param)
#
# @brief Clip selected features from the layer into a new layer.
#
# @param[in] params is a list of named parameters:
# - layer_name name for the new layer (default is "clip")
# - driver driver (default is the driver of the layer)
# - datasource datasource (default is the datasource of the layer)
# The params are forwarded to the constructor of the new layer.
# @return A Geo::Vector object.
# @bug If self is a polygon shapefile, the result seems to be linestrings, but
# the saved shapefile is ok.
sub clip {
my($self, %param) = @_;
$param{clip} = 'clip' unless $param{clip};
$param{datasource} = $self->{datasource} unless $param{datasource};
$param{driver} = $self->{ogr_datasource}->GetDriver unless $param{driver};
my $clip = new Geo::Vector(%param);
my $schema = $self->{ogr_layer}->GetLayerDefn();
for my $i (0..$schema->GetFieldCount-1) {
my $fd = $schema->GetFieldDefn($i);
$clip->{ogr_layer}->CreateField($fd);
}
my $features = $self->selected_features();
for my $f (values %$features) {
next unless $f; # should not happen
my $geometry = $f->GetGeometryRef();
# make copies of the features and add them to clip
my $feature = new Geo::OGR::Feature($schema);
$feature->SetGeometry($geometry); # makes a copy
for my $i (0..$schema->GetFieldCount-1) {
my $value = $f->GetFieldAsString($i);
$feature->SetField($i, $value) if defined $value;
}
$clip->{ogr_layer}->CreateFeature($feature);
}
$clip->{ogr_layer}->SyncToDisk;
return Geo::Vector->new(%param);
}
## @method void add_layer(Geo::Layer another)
#
# @brief Adds an another layer to this layer.
# @param[in] another An another Geo::Vector layer.
# @note The layers must have the same geometry_type.
sub add_layer {
my ( $self, $another ) = @_;
croak "the layer is not writable" unless $self->{update};
my $type =
$GEOMETRY_TYPE_INV{ $self->{ogr_layer}->GetLayerDefn->GetGeomType };
my $another_type =
$GEOMETRY_TYPE_INV{ $another->{ogr_layer}->GetLayerDefn->GetGeomType };
croak "can't add a $another_type layer to a $type layer"
unless $type eq $another_type;
my $defn = $self->{ogr_layer}->GetLayerDefn();
my $schema = $self->schema;
my $another_schema = $another->schema;
$another->{ogr_layer}->ResetReading();
while (1) {
my $f = $another->{ogr_layer}->GetNextFeature();
last unless $f;
my $geometry = $f->GetGeometryRef();
# make copies of the features and add them to self
my $feature = new Geo::OGR::Feature($defn);
$feature->SetGeometry($geometry); # makes a copy
for my $fn ( keys %$schema ) {
next if $fn eq 'FID';
next unless $another_schema->{$fn};
$feature->SetField( $fn, $f->GetFieldAsString($fn) );
}
$self->{ogr_layer}->CreateFeature($feature);
}
$self->{ogr_layer}->SyncToDisk;
}
## @method Geo::Raster rasterize(%named_params)
#
# @brief Creates a new Geo::Raster from this Geo::Vector object.
#
# The new Geo::Raster has the size and extent of the Geo::Raster $this and draws
# the layer on it. The raster is boolean integer raster unless value_field is
# given. If value_field is floating point value, the returned raster is a
# floating point raster. render_as hash is optional, but if given should be one of
# 'Native', 'Points', 'Lines', or 'Polygons'. $fid (optional) is the number of
# the feature to render.
#
# @param[in] like (optional). A Geo::Raster object, from which the resulting
# Geo::Raster object's size and extent are copied.
# @param[in] M (optional). Height of the resulting Geo::Raster object. Has to be
# given if hash like is not given. If like is given, then M will not be used.
# @param[in] N (optional). Width of the resulting Geo::Raster object. Has to be
# given if hash like is not given. If like is given, then N will not be used.
# @param[in] world (optional). The world (bounding box) of the resulting raster
# layer. Useless to give if parameter like is given, because then it's world
# will be used.
# @param[in] render_as (optional). Rendering mode, which should be 'Native',
# 'Points', 'Lines' or 'Polygons'.
# @param[in] feature (optional). Number of the feature to render.
# @param[in] value_field (optional). Value fields name.
# @return A new Geo::Raster, which has the size and extent of the given as
# parameters and values of this object's OGRLayerH.
sub rasterize {
my $self = shift;
my %params;
%params = @_ if @_;
my %defaults = (
render_as => $self->{RENDER_AS} ? $self->{RENDER_AS} : 'Native',
feature => -1,
nodata_value => -9999,
datatype => 'Integer'
);
for ( keys %defaults ) {
$params{$_} = $defaults{$_} unless exists $params{$_};
}
croak "Not a valid rendering mode: $params{render_as}" unless defined $RENDER_AS{$params{render_as}};
croak "Geo::Vector->rasterize: empty layer" unless $self->{OGRLayerH};
( $params{M}, $params{N} ) = $params{like}->size() if $params{like};
$params{world} = [ $params{like}->world() ] if $params{like};
croak "Geo::Vector->rasterize needs the raster size: M, N"
unless $params{M} and $params{N};
$params{world} = [ $self->world() ] unless $params{world};
my $field = -1;
if ( defined $params{value_field} and $params{value_field} ne '' ) {
my $schema = $self->schema()->{ $params{value_field} };
croak "rasterize: field with name '$params{value_field}' does not exist"
unless defined $schema;
croak
"rasterize: can't use value from field ".
"'$params{value_field}' since its' type is '$schema->{TypeName}'"
unless $schema->{TypeName} eq 'Integer'
or $schema->{TypeName} eq 'Real';
$field = $schema->{Number};
$params{datatype} = $schema->{TypeName};
}
my $gd = Geo::Raster->new(
datatype => $params{datatype},
M => $params{M},
N => $params{N},
world => $params{world}
);
$gd->nodata_value( $params{nodata_value} );
$gd->set('nodata');
xs_rasterize( $self->{OGRLayerH}, $gd->{GRID},
$RENDER_AS{ $params{render_as} },
$params{feature}, $field );
return $gd;
}
## @method void graph()
#
# @brief Creates an undirected weighted graph from the OGR-layer.
#
# The edge weights are calculated according to the distances between the
# points inside each layer's feature. Requires Geo::Distance.
sub graph {
my ($self) = @_;
my %node;
my %edge;
my $layer = $self->{ogr_layer};
$layer->ResetReading();
my $distance = Geo::Distance->new();
while ( my $feature = $layer->GetNextFeature() ) {
my $geom = $feature->GetGeometryRef();
my $n = $geom->GetPointCount - 1;
my $length = 0;
# length of linestring computation, this is lat lon
my $lon1 = $geom->GetX(0);
my $lat1 = $geom->GetY(0);
for my $i ( 1 .. $n ) {
my $lon2 = $geom->GetX($i);
my $lat2 = $geom->GetY($i);
$length +=
$distance->distance( 'meter', $lon1, $lat1, $lon2, $lat2 );
$lon1 = $lon2;
$lat1 = $lat2;
}
# the cost model
my $cost = $length;
if ( $geom->GetGeometryCount == 0
and $geom->GetGeometryName =~ /^linestring/i ) {
my $fid = $feature->GetFID();
# the accuracy
my $first = sprintf( "%.5f %.5f", $geom->GetX(0), $geom->GetY(0) );
my $last = sprintf( "%.5f %.5f", $geom->GetX($n), $geom->GetY($n) );
$node{$first}++;
$node{$last}++;
# edges
my $liikennevi = $feature->GetFieldAsString('LIIKENNEVI');
if ( $liikennevi == 2 ) {
$edge{$first}{$last} = $cost;
$edge{$last}{$first} = $cost;
}
elsif ( $liikennevi == 3 ) {
$edge{$last}{$first} = $cost;
}
elsif ( $liikennevi == 4 ) {
$edge{$first}{$last} = $cost;
}
}
}
my $g = Graph->new;
for my $u ( keys %node ) {
$g->add_vertex($u);
for my $v ( keys %{ $edge{$u} } ) {
$g->add_weighted_edge( $u, $v, $edge{$u}{$v} );
}
}
$self->{graph} = $g;
}
## @method void overlay_graph(Gtk2::Gdk::Pixmap pixmap)
#
# @brief Creates from the objects graph an overlay graph (incl. vertices and
# edges) as a pixmap.
# @param[in,out] pixmap Gtk2::Gdk::Pixmap
sub overlay_graph {
my ( $self, $pixmap ) = @_;
my @V = $self->{graph}->vertices;
my $gc = new Gtk2::Gdk::GC $pixmap;
$gc->set_rgb_fg_color( Gtk2::Gdk::Color->new( 65535, 65535, 0 ) );
for my $v (@V) {
my @p = split /\s+/, $v;
@p = $self->{overlay}->point2pixmap_pixel(@p);
$pixmap->draw_rectangle( $gc, 0, $p[0] - 2, $p[1] - 2, 5, 5 );
}
my @E = $self->{graph}->edges;
for my $e (@E) {
my @u = split /\s+/, $e->[0];
my @v = split /\s+/, $e->[1];
@u = $self->{overlay}->point2pixmap_pixel(@u);
@v = $self->{overlay}->point2pixmap_pixel(@v);
$pixmap->draw_line( $gc, @u, @v );
next;
# arrows.. not very helpful
my $deltaX = $v[0] - $u[0];
my $deltaY = $v[1] - $u[1];
my $theta =
$deltaX == 0 ? 3.14159 / 2.0 : POSIX::atan( $deltaY / $deltaX );
my $theta2 = $theta;
$theta2 += 3.14159 if $deltaX < 0;
my $lengthdeltaX = -cos($theta2) * 8;
my $lengthdeltaY = -sin($theta2) * 8;
my $widthdeltaX = sin($theta2) * 5;
my $widthdeltaY = cos($theta2) * 5;
$pixmap->draw_line(
$gc, @v,
int( $v[0] + $lengthdeltaX + $widthdeltaX ),
int( $v[1] + $lengthdeltaY - $widthdeltaY )
);
$pixmap->draw_line(
$gc, @v,
int( $v[0] + $lengthdeltaX - $widthdeltaX ),
int( $v[1] + $lengthdeltaY + $widthdeltaY )
);
}
}
1;
__END__
=pod
=head1 SEE ALSO
Geo::GDAL
This module should be discussed in geo-perl@list.hut.fi.
The homepage of this module is http://libral.sf.net.
=head1 AUTHOR
Ari Jolma, Eari.jolma at tkk.fiE
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005-2006 by Ari Jolma
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.
=cut