File Coverage

blib/lib/Geo/GDAL/FFI/Dataset.pm

Criterion	Covered	Total	%
statement	106	255	41.5
branch	19	86	22.0
condition	9	66	13.6
subroutine	22	39	56.4
pod	19	30	63.3
total	175	476	36.7

package Geo::GDAL::FFI::Dataset;
use v5.10;
use strict;
use warnings;
use Carp;
use base 'Geo::GDAL::FFI::Object';
use Scalar::Util qw /blessed/;

our $VERSION = 0.0900;

sub DESTROY {
    my $self = shift;
    $self->FlushCache;
    #say STDERR "DESTROY $self";
    Geo::GDAL::FFI::GDALClose($$self);
}

sub GetName {
    my $self = shift;
    return $self->GetDescription;
}

sub FlushCache {
    my $self = shift;
    Geo::GDAL::FFI::GDALFlushCache($$self);
}

sub GetDriver {
    my $self = shift;
    my $dr = Geo::GDAL::FFI::GDALGetDatasetDriver($$self);
    return bless \$dr, 'Geo::GDAL::FFI::Driver';
}

sub GetWidth {
    my $self = shift;
    return Geo::GDAL::FFI::GDALGetRasterXSize($$self);
}

sub GetHeight {
    my $self = shift;
    return Geo::GDAL::FFI::GDALGetRasterYSize($$self);
}

sub GetSize {
    my $self = shift;
    return (
        Geo::GDAL::FFI::GDALGetRasterXSize($$self),
        Geo::GDAL::FFI::GDALGetRasterYSize($$self)
        );
}

sub GetProjectionString {
    my ($self) = @_;
    return Geo::GDAL::FFI::GDALGetProjectionRef($$self);
}

sub SetProjectionString {
    my ($self, $proj) = @_;
    my $e = Geo::GDAL::FFI::GDALSetProjection($$self, $proj);
    if ($e != 0) {
        confess Geo::GDAL::FFI::error_msg();
    }
}

sub GetGeoTransform {
    my ($self) = @_;
    my $t = [0,0,0,0,0,0];
    Geo::GDAL::FFI::GDALGetGeoTransform($$self, $t);
    return wantarray ? @$t : $t;
}

sub SetGeoTransform {
    my $self = shift;
    my $t = @_ > 1 ? [@_] : shift;
    Geo::GDAL::FFI::GDALSetGeoTransform($$self, $t);
}

sub GetBand {
    my ($self, $i) = @_;
    $i //= 1;
    my $b = Geo::GDAL::FFI::GDALGetRasterBand($$self, $i);
    Geo::GDAL::FFI::_register_parent_ref ($b, $self);
    return bless \$b, 'Geo::GDAL::FFI::Band';
}

sub GetBands {
    my $self = shift;
    my @bands;
    for my $i (1..Geo::GDAL::FFI::GDALGetRasterCount($$self)) {
        push @bands, $self->GetBand($i);
    }
    return @bands;
}

sub GetLayerCount {
    my ($self) = @_;
    return Geo::GDAL::FFI::GDALDatasetGetLayerCount($$self);
}


sub GetLayer {
    my ($self, $i) = @_;
    $i //= 0;
    my $l = Geo::GDAL::FFI::isint($i)
      ? Geo::GDAL::FFI::GDALDatasetGetLayer($$self, $i)
      : Geo::GDAL::FFI::GDALDatasetGetLayerByName($$self, $i);
    unless ($l) {
        my $msg = Geo::GDAL::FFI::error_msg()
          // "Could not access layer $i in data set.";
        confess $msg if $msg;
    }
    Geo::GDAL::FFI::_register_parent_ref ($l, $self);
    return bless \$l, 'Geo::GDAL::FFI::Layer';
}

sub CreateLayer {
    my ($self, $args) = @_;
    $args //= {};
    my $name = $args->{Name} // '';
    my ($gt, $sr);
    if ($args->{GeometryFields}) {
        $gt = $Geo::GDAL::FFI::geometry_types{None};
    } else {
        $gt = $args->{GeometryType} // 'Unknown';
        $gt = $Geo::GDAL::FFI::geometry_types{$gt};
        confess "Unknown geometry type: '$args->{GeometryType}'." unless defined $gt;
        $sr = Geo::GDAL::FFI::OSRClone(${$args->{SpatialReference}}) if $args->{SpatialReference};
    }
    my $o = 0;
    if ($args->{Options}) {
        for my $key (keys %{$args->{Options}}) {
            $o = Geo::GDAL::FFI::CSLAddString($o, "$key=$args->{Options}->{$key}");
        }
    }
    my $l = Geo::GDAL::FFI::GDALDatasetCreateLayer($$self, $name, $sr, $gt, $o);
    Geo::GDAL::FFI::CSLDestroy($o);
    Geo::GDAL::FFI::OSRRelease($sr) if $sr;
    my $msg = Geo::GDAL::FFI::error_msg();
    confess $msg if $msg;
    Geo::GDAL::FFI::_register_parent_ref ($l, $self);
    my $layer = bless \$l, 'Geo::GDAL::FFI::Layer';
    if ($args->{Fields}) {
        for my $f (@{$args->{Fields}}) {
            $layer->CreateField($f);
        }
    }
    if ($args->{GeometryFields}) {
        for my $f (@{$args->{GeometryFields}}) {
            $layer->CreateGeomField($f);
        }
    }
    return $layer;
}

sub CopyLayer {
    my ($self, $layer, $name, $options) = @_;
    $name //= '';
    my $o = 0;
    for my $key (keys %$options) {
        $o = Geo::GDAL::FFI::CSLAddString($o, "$key=$options->{$key}");
    }
    my $l = Geo::GDAL::FFI::GDALDatasetCopyLayer($$self, $$layer, $name, $o);
    Geo::GDAL::FFI::CSLDestroy($o);
    unless ($l) {
        my $msg = Geo::GDAL::FFI::error_msg() // "GDALDatasetCopyLayer failed.";
        confess $msg if $msg;
    }
    Geo::GDAL::FFI::_register_parent_ref ($l, $self);
    return bless \$l, 'Geo::GDAL::FFI::Layer';
}


sub ExecuteSQL {
    my ($self, $sql, $filter, $dialect) = @_;

    my $lyr = Geo::GDAL::FFI::GDALDatasetExecuteSQL(
        $$self, $sql, $$filter, $dialect
    );

    if ($lyr) {
        if (defined wantarray) {
            Geo::GDAL::FFI::_register_parent_ref ($lyr, $self);
            return bless \$lyr, 'Geo::GDAL::FFI::Layer::ResultSet';
        }
        else {
            Geo::GDAL::FFI::GDALDatasetReleaseResultSet ($lyr, $$self);
        }
    }

    #  This is perhaps unnecessary, but ensures
    #  internal  details do not leak if spatial
    #  index is built in non-void context.
    return undef;
}


## utilities

sub new_options {
    my ($constructor, $options) = @_;
    $options //= [];
    confess "The options must be a reference to an array." unless ref $options;
    my $csl = 0;
    for my $s (@$options) {
        $csl = Geo::GDAL::FFI::CSLAddString($csl, $s);
    }
    $options = $constructor->($csl, 0);
    Geo::GDAL::FFI::CSLDestroy($csl);
    return $options;
}

sub GetInfo {
    my ($self, $options) = @_;
    $options = new_options(\&Geo::GDAL::FFI::GDALInfoOptionsNew, $options);
    my $info = Geo::GDAL::FFI::GDALInfo($$self, $options);
    Geo::GDAL::FFI::GDALInfoOptionsFree($options);
    return $info;
}
*Info = *GetInfo;

sub set_progress {
    my ($options, $args, $setter) = @_;
    return unless $args->{Progress};
    my $ffi = FFI::Platypus->new;
    $setter->($options, $ffi->closure($args->{Progress}), $args->{ProgressData});
}

sub Translate {
    my ($self, $path, $options, $progress, $data) = @_;
    $options = new_options(\&Geo::GDAL::FFI::GDALTranslateOptionsNew, $options);
    my $args = {Progress => $progress, ProgressData => $data};
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALTranslateOptionsSetProgress);
    my $e = 0;
    my $ds = Geo::GDAL::FFI::GDALTranslate($path, $$self, $options, \$e);
    Geo::GDAL::FFI::GDALTranslateOptionsFree($options);
    return bless \$ds, 'Geo::GDAL::FFI::Dataset' if $ds && ($e == 0);
    my $msg = Geo::GDAL::FFI::error_msg() // 'Translate failed.';
    confess $msg;
}

sub destination {
    my ($dst) = @_;
    confess "Destination missing." unless $dst;
    my $path;
    if (ref $dst) {
        $dst = $$dst;
    } else {
        $path = $dst;
        undef $dst;
    }
    return ($path, $dst);
}

sub dataset_input {
    my ($self, $input) = @_;
    $input //= [];
    confess "The input must be a reference to an array of datasets." unless ref ($input) =~ /ARRAY/;
    my @datasets = ($$self);
    for my $ds (@$input) {
        push @datasets, $$ds;
    }
    return \@datasets;
}

sub Warp {
    my ($self, $args) = @_;

    my ($path, $dst) = destination($args->{Destination});
    confess "Destination object should not be passed for non-void context"
      if defined wantarray && blessed $dst;

    my $input = $self->dataset_input($args->{Input});

    my $options = new_options(\&Geo::GDAL::FFI::GDALWarpAppOptionsNew, $args->{Options});
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALWarpAppOptionsSetProgress);

    my $e = 0;
    my $result;
    if (blessed($dst)) {
        Geo::GDAL::FFI::GDALWarp($path, $dst, scalar @$input, $input, $options, \$e);
    } else {
        $result = Geo::GDAL::FFI::GDALWarp($path, undef, scalar @$input, $input, $options, \$e);
    }
    Geo::GDAL::FFI::GDALWarpAppOptionsFree($options);
    if (defined $result) {
        confess Geo::GDAL::FFI::error_msg() // 'Warp failed.' if !$result || $e != 0;
        return bless \$result, 'Geo::GDAL::FFI::Dataset';
    }
}

sub VectorTranslate {
    my ($self, $args) = @_;
    my ($path, $dst) = destination($args->{Destination});
    confess "Destination object should not be passed for non-void context"
      if defined wantarray && blessed $dst;

    my $input = $self->dataset_input($args->{Input});

    my $options = new_options(\&Geo::GDAL::FFI::GDALVectorTranslateOptionsNew, $args->{Options});
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALVectorTranslateOptionsSetProgress);

    my $e = 0;
    my $result;
    if (blessed($dst)) {
        Geo::GDAL::FFI::GDALVectorTranslate(undef, $$dst, scalar @$input, $input, $options, \$e);
    }
    else {
        my $result = Geo::GDAL::FFI::GDALVectorTranslate($path, undef, scalar @$input, $input, $options, \$e);
    }
    Geo::GDAL::FFI::GDALVectorTranslateOptionsFree($options);
    confess Geo::GDAL::FFI::error_msg() // 'VectorTranslate failed.' if $e != 0;
    if (defined $result) {
        return bless \$result, 'Geo::GDAL::FFI::Dataset';
    }
}

sub DEMProcessing {
    my ($self, $path, $args) = @_;
    my $processing = $args->{Processing} // 'hillshade';
    my $colorfile = $args->{ColorFilename};
    my $options = new_options(\&Geo::GDAL::FFI::GDALDEMProcessingOptionsNew, $args->{Options});
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALDEMProcessingOptionsSetProgress);
    my $e = 0;
    my $result = Geo::GDAL::FFI::GDALDEMProcessing($path, $$self, $processing, $colorfile, $options, \$e);
    Geo::GDAL::FFI::GDALDEMProcessingOptionsFree($options);
    confess Geo::GDAL::FFI::error_msg() // 'DEMProcessing failed.' if !$result || $e != 0;
    return bless \$result, 'Geo::GDAL::FFI::Dataset';
}

sub NearBlack {
    my ($self, $args) = @_;

    my ($path, $dst) = destination($args->{Destination});
    confess "Destination object should not be passed for non-void context"
      if defined wantarray && blessed $dst;

    my $input = $self->dataset_input($args->{Input});

    my $options = new_options(\&Geo::GDAL::FFI::GDALNearblackOptionsNew, $args->{Options});
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALNearblackOptionsSetProgress);

    my $e = 0;
    my $result;
    if (blessed($dst)) {
        Geo::GDAL::FFI::GDALNearblack($path, $$dst, $$self, $options, \$e);
    } else {
        $result = Geo::GDAL::FFI::GDALNearblack($path, undef, $$self, $options, \$e);
    }
    Geo::GDAL::FFI::GDALNearblackOptionsFree($options);

    confess Geo::GDAL::FFI::error_msg() // 'NearBlack failed.' if $e != 0;
    if (defined $result) {
        return bless \$result, 'Geo::GDAL::FFI::Dataset';
    }

}

sub Grid {
    my ($self, $path, $options, $progress, $data) = @_;
    $options = new_options(\&Geo::GDAL::FFI::GDALGridOptionsNew, $options);
    my $args = {Progress => $progress, ProgressData => $data};
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALGridOptionsSetProgress);
    my $e = 0;
    my $result = Geo::GDAL::FFI::GDALGrid($path, $$self, $options, \$e);
    Geo::GDAL::FFI::GDALGridOptionsFree($options);
    confess Geo::GDAL::FFI::error_msg() // 'Grid failed.' if !$result || $e != 0;
    return bless \$result, 'Geo::GDAL::FFI::Dataset';
}

sub Rasterize {
    my ($self, $args) = @_;

    my $dst = $args->{Destination};
    confess "Destination argument should not be passed for non-void context"
      if defined wantarray && blessed $dst;

    my $options = new_options(\&Geo::GDAL::FFI::GDALRasterizeOptionsNew, $args->{Options});
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALRasterizeOptionsSetProgress);

    my $e = 0;
    my $result;
    if (blessed($dst)) {
        Geo::GDAL::FFI::GDALRasterize(undef, $$dst, $$self, $options, \$e);
    } else {
        $result = Geo::GDAL::FFI::GDALRasterize($dst, undef, $$self, $options, \$e);
    }
    Geo::GDAL::FFI::GDALRasterizeOptionsFree($options);

    confess Geo::GDAL::FFI::error_msg() // 'Rasterize failed.' if $e != 0;
    if (defined $result) {
        return bless \$result, 'Geo::GDAL::FFI::Dataset';
    }
}

sub BuildVRT {
    my ($self, $path, $args) = @_;
    my $input = $self->dataset_input($args->{Input});
    my $options = new_options(\&Geo::GDAL::FFI::GDALBuildVRTOptionsNew, $args->{Options});
    set_progress($options, $args, \&Geo::GDAL::FFI::GDALBuildVRTOptionsSetProgress);
    my $e = 0;
    my $result = Geo::GDAL::FFI::GDALBuildVRT($path, scalar @$input, $input, 0, $options, \$e);
    Geo::GDAL::FFI::GDALBuildVRTOptionsFree($options);
    confess Geo::GDAL::FFI::error_msg() // 'BuildVRT failed.' if !$result || $e != 0;
    return bless \$result, 'Geo::GDAL::FFI::Dataset';
}

1;

{
    #  dummy class for result sets from ExecuteSQL
    #  allows specialised destroy method
    package Geo::GDAL::FFI::Layer::ResultSet;
    use base qw /Geo::GDAL::FFI::Layer/;

    sub DESTROY {
        my ($self) = @_;
        my $parent = Geo::GDAL::FFI::_get_parent_ref ($$self);
        Geo::GDAL::FFI::GDALDatasetReleaseResultSet ($$parent, $$self);
        Geo::GDAL::FFI::_deregister_parent_ref ($$self);
    }

    1;
}



=pod

=encoding UTF-8

=head1 NAME

Geo::GDAL::FFI::Dataset - A GDAL dataset

=head1 SYNOPSIS

=head1 DESCRIPTION

A collection of raster bands or vector layers. Obtain a dataset object
by opening it with the Open method of Geo::GDAL::FFI object or by
creating it with the Create method of a Driver object.

=head1 METHODS

=head2 GetDriver

 my $driver = $dataset->GetDriver;

=head2 GetWidth

 my $w = $dataset->GetWidth;

=head2 GetHeight

 my $h = $dataset->GetHeight;

=head2 GetSize

 my @size = $dataset->GetSize;

Returns the size (width, height) of the bands of this raster dataset.

=head2 GetBand

 my $band = $dataset->GetBand($i);

Get the ith (by default the first) band of a raster dataset.

=head2 GetBands

 my @bands = $dataset->GetBands;

Returns a list of Band objects representing the bands of this raster
dataset.

=head2 CreateLayer

 my $layer = $dataset->CreateLayer({Name => 'layer', ...});

Create a new vector layer into this vector dataset.

Named arguments are the following.

=over 4

=item C

Optional, string, default is ''.

=item C

Optional, default is 'Unknown', the type of the first geometry field;
note: if type is 'None', the layer schema does not initially contain
any geometry fields.

=item C

Optional, a SpatialReference object, the spatial reference for the
first geometry field.

=item C

Optional, driver specific options in an anonymous hash.

=item C

Optional, a reference to an array of Field objects or schemas, the
fields to create into the layer.

=item C

Optional, a reference to an array of GeometryField objects or schemas,
the geometry fields to create into the layer; note that if this
argument is defined then the arguments GeometryType and
SpatialReference are ignored.

=back

=head2 GetLayerCount
 my $count = $dataset->GetLayerCount();


=head2 GetLayer

 my $layer = $dataset->GetLayer($name);

If $name is strictly an integer, then returns the (name-1)th layer in
the dataset, otherwise returns the layer whose name is $name. Without
arguments returns the first layer.

=head2 CopyLayer

 my $copy = $dataset->CopyLayer($layer, $name, {DST_SRSWKT => 'WKT of a SRS', ...});

Copies the given layer into this dataset using the name $name and
returns the new layer. The options hash is mostly driver specific.

=head2 ExecuteSQL
 $dataset->ExecuteSQL ($sql, $filter, $dialect);

 #  build a spatial index
 $dataset->ExecuteSQL (qq{CREATE SPATIAL INDEX ON "$some_layer_name"});

 #  filter a data set using the SQLite dialect and a second geometry
 my $filtered = $dataset->ExecuteSQL (
   qq{SELECT "$fld1", "$fld2" FROM "$some_layer_name"},
   $some_geometry,
   'SQLite',
 );

=head2 Info

 my $info = $dataset->Info($options);
 my $info = $dataset->Info(['-json', '-stats']);

This is the same as gdalinfo utility. $options is a reference to an
array.  Valid options are as per the L utility.

=head2 Translate

 my $target = $source->Translate($path, $options, $progress, $progress_data);

Convert a raster dataset into another raster dataset. This is the same
as the L utility. $name is the name of the target
dataset. $options is a reference to an array of switches.

=head2 Warp

 my $result = $dataset->Warp($args);

$args is a hashref, keys may be Destination, Input, Options, Progress,
ProgressData.

Valid options are as per the L utility.

=head2 VectorTranslate

 my $result = $dataset->VectorTranslate($args);

$args is a hashref, keys may be Destination, Input, Options, Progress,
ProgressData.

Valid options are as per the L utility.

=head2 DEMProcessing

 my $result = $dataset->DEMProcessing($path, $args);

$args is a hashref, keys may be Processing, ColorFilename, Options,
Progress, ProgressData.

See also L.

=head2 NearBlack

 my $result = $dataset->NearBlack($args);

$args is a hashref, keys may be Destination, Options, Progress,
ProgressData.

Valid options are as per the L utility.

=head2 Grid

 my $result = $dataset->Grid($path, $options, $progress, $progress_data);

Valid options are as per the L utility.

=head2 Rasterize

 my $result = $dataset->Rasterize($args);
 my $result = $dataset->Rasterize({Options => [-b => 1, -at]});

$args is a hashref, keys may be Destination, Options, Progress,
ProgressData.

Valid options are as per the L utility.

=head2 BuildVRT

 my $result = $dataset->BuildVRT($path, $args);

$args is a hashref, keys may be Input, Options, Progress,
ProgressData.

=head1 LICENSE

This software is released under the Artistic License. See
L.

=head1 AUTHOR

Ari Jolma - Ari.Jolma at gmail.com

=head1 SEE ALSO

L

L, L, L

=cut

__END__;