File Coverage

blib/lib/Geo/GDAL/FFI/Feature.pm
Criterion Covered Total %
statement 153 167 91.6
branch 67 82 81.7
condition 31 58 53.4
subroutine 18 22 81.8
pod 10 14 71.4
total 279 343 81.3


line stmt bran cond sub pod time code
1             package Geo::GDAL::FFI::Feature;
2 5     5   61 use v5.10;
  5         16  
3 5     5   26 use strict;
  5         11  
  5         97  
4 5     5   24 use warnings;
  5         9  
  5         117  
5 5     5   24 use Config;
  5         10  
  5         175  
6 5     5   24 use Carp;
  5         9  
  5         316  
7 5     5   41 use Encode qw(decode encode);
  5         14  
  5         252  
8 5     5   34 use FFI::Platypus::Buffer;
  5         9  
  5         10661  
9              
10             our $VERSION = 0.0800;
11              
12             sub new {
13 5     5 1 35 my ($class, $defn) = @_;
14 5         673 my $f = Geo::GDAL::FFI::OGR_F_Create($$defn);
15 5         26 return bless \$f, $class;
16             }
17              
18             sub DESTROY {
19 6     6   1205 my $self = shift;
20 6         100 Geo::GDAL::FFI::OGR_F_Destroy($$self);
21             }
22              
23             sub GetFID {
24 1     1 1 7 my ($self) = @_;
25 1         8 return Geo::GDAL::FFI::OGR_F_GetFID($$self);
26             }
27              
28             sub SetFID {
29 0     0 1 0 my ($self, $fid) = @_;
30 0   0     0 $fid //= 0;
31 0         0 Geo::GDAL::FFI::OGR_F_GetFID($$self, $fid);
32             }
33              
34             sub GetDefn {
35 0     0 1 0 my ($self) = @_;
36 0         0 my $d = Geo::GDAL::FFI::OGR_F_GetDefnRef($$self);
37 0         0 ++$Geo::GDAL::FFI::immutable{$d};
38             #say STDERR "$d immutable";
39 0         0 return bless \$d, 'Geo::GDAL::FFI::FeatureDefn';
40             }
41              
42             sub Clone {
43 0     0 1 0 my ($self) = @_;
44 0         0 my $f = Geo::GDAL::FFI::OGR_F_Clone($$self);
45 0         0 return bless \$f, 'Geo::GDAL::FFI::Feature';
46             }
47              
48             sub Equals {
49 0     0 1 0 my ($self, $f) = @_;
50 0         0 return Geo::GDAL::FFI::OGR_F_Equal($$self, $$f);
51             }
52              
53             sub field_index {
54 36     36 0 78 my ($self, $field_name, $is_geom) = @_;
55 36 100       216 my $index = $is_geom ?
56             Geo::GDAL::FFI::OGR_F_GetGeomFieldIndex($$self, $field_name) :
57             Geo::GDAL::FFI::OGR_F_GetFieldIndex($$self, $field_name);
58 36 50       93 confess "Field '$field_name' does not exist." if $index < 0;
59 36         71 return $index;
60             }
61              
62             sub SetField {
63 16     16 1 6966 my $self = shift;
64 16         30 my $i = shift;
65 16   50     40 $i //= 0;
66 16 50       51 $i = $self->field_index($i) unless Geo::GDAL::FFI::isint($i);
67 16 100       40 unless (@_) {
68 1         13 Geo::GDAL::FFI::OGR_F_UnsetField($$self, $i) ;
69 1         2 return;
70             }
71 15         26 my ($value) = @_;
72 15 100       46 unless (defined $value) {
73 1         25 Geo::GDAL::FFI::OGR_F_SetFieldNull($$self, $i);
74 1         4 return;
75             }
76 14         66 my $d = Geo::GDAL::FFI::OGR_F_GetFieldDefnRef($$self, $i);
77 14         73 my $t = $Geo::GDAL::FFI::field_types_reverse{Geo::GDAL::FFI::OGR_Fld_GetType($d)};
78 14 50 66     81 if ($t =~ /^Integer64/ && $Config{use64bitint} ne 'define') {
79 0         0 confess "Your Perl does not support 64 bit integers.";
80             }
81 14 100       53 Geo::GDAL::FFI::OGR_F_SetFieldInteger($$self, $i, $value) if $t eq 'Integer';
82 14 100       52 Geo::GDAL::FFI::OGR_F_SetFieldInteger64($$self, $i, $value) if $t eq 'Integer64';
83 14 100       64 Geo::GDAL::FFI::OGR_F_SetFieldDouble($$self, $i, $value) if $t eq 'Real';
84 14 100       47 Geo::GDAL::FFI::OGR_F_SetFieldString($$self, $i, $value) if $t eq 'String';
85              
86 14 50       98 confess "Can't yet set binary fields." if $t eq 'Binary';
87              
88 14         32 my @s = @_;
89 14 100       49 Geo::GDAL::FFI::OGR_F_SetFieldIntegerList($$self, $i, scalar @s, \@s) if $t eq 'IntegerList';
90 14 100       69 Geo::GDAL::FFI::OGR_F_SetFieldInteger64List($$self, $i, scalar @s, \@s) if $t eq 'Integer64List';
91 14 100       40 Geo::GDAL::FFI::OGR_F_SetFieldDoubleList($$self, $i, scalar @s, \@s) if $t eq 'RealList';
92 14 100       84 if ($t eq 'StringList') {
    100          
    100          
    100          
93 1         3 my $csl = 0;
94 1         3 for my $s (@s) {
95 3         14 $csl = Geo::GDAL::FFI::CSLAddString($csl, $s);
96             }
97 1         11 Geo::GDAL::FFI::OGR_F_SetFieldStringList($$self, $i, $csl);
98 1         6 Geo::GDAL::FFI::CSLDestroy($csl);
99             } elsif ($t eq 'Date') {
100 2         8 my @dt = @_;
101 2   50     5 $dt[0] //= 2000; # year
102 2   50     5 $dt[1] //= 1; # month 1-12
103 2   50     5 $dt[2] //= 1; # day 1-31
104 2   50     18 $dt[3] //= 0; # hour 0-23
105 2   50     17 $dt[4] //= 0; # minute 0-59
106 2   50     17 $dt[5] //= 0.0; # second with millisecond accuracy
107 2   50     10 $dt[6] //= 100; # TZ
108 2         23 Geo::GDAL::FFI::OGR_F_SetFieldDateTimeEx($$self, $i, @dt);
109             } elsif ($t eq 'Time') {
110 1         5 my @dt = (0, 0, 0, @_);
111 1   50     6 $dt[3] //= 0; # hour 0-23
112 1   50     4 $dt[4] //= 0; # minute 0-59
113 1   50     4 $dt[5] //= 0.0; # second with millisecond accuracy
114 1   50     6 $dt[6] //= 100; # TZ
115 1         8 Geo::GDAL::FFI::OGR_F_SetFieldDateTimeEx($$self, $i, @dt);
116             } elsif ($t eq 'DateTime') {
117 1         4 my @dt = @_;
118 1   50     4 $dt[0] //= 2000; # year
119 1   50     3 $dt[1] //= 1; # month 1-12
120 1   50     4 $dt[2] //= 1; # day 1-31
121 1   50     4 $dt[3] //= 0; # hour 0-23
122 1   50     5 $dt[4] //= 0; # minute 0-59
123 1   50     5 $dt[5] //= 0.0; # second with millisecond accuracy
124 1   50     4 $dt[6] //= 100; # TZ
125 1         9 Geo::GDAL::FFI::OGR_F_SetFieldDateTimeEx($$self, $i, @dt);
126             }
127             }
128              
129             sub GetField {
130 13     13 1 68 my ($self, $i, $encoding) = @_;
131 13   50     29 $i //= 0;
132 13 50       32 $i = $self->field_index($i) unless Geo::GDAL::FFI::isint($i);
133 13 50       47 return unless $self->IsFieldSetAndNotNull($i);
134 13         41 my $d = Geo::GDAL::FFI::OGR_F_GetFieldDefnRef($$self, $i);
135 13         50 my $t = $Geo::GDAL::FFI::field_types_reverse{Geo::GDAL::FFI::OGR_Fld_GetType($d)};
136 13 50 66     55 if ($t =~ /^Integer64/ && $Config{use64bitint} ne 'define') {
137 0         0 confess "Your Perl does not support 64 bit integers.";
138             }
139 13 100       43 return Geo::GDAL::FFI::OGR_F_GetFieldAsInteger($$self, $i) if $t eq 'Integer';
140 11 100       33 return Geo::GDAL::FFI::OGR_F_GetFieldAsInteger64($$self, $i) if $t eq 'Integer64';
141 10 100       41 return Geo::GDAL::FFI::OGR_F_GetFieldAsDouble($$self, $i) if $t eq 'Real';
142 9 100       26 if ($t eq 'String') {
143 1         13 my $retval = Geo::GDAL::FFI::OGR_F_GetFieldAsString($$self, $i);
144 1 50       9 $retval = decode $encoding => $retval if defined $encoding;
145 1         43 return $retval;
146             }
147 8 50       18 return Geo::GDAL::FFI::OGR_F_GetFieldAsBinary($$self, $i) if $t eq 'Binary';
148 8         10 my @list;
149 8 100       65 if ($t eq 'IntegerList') {
    100          
    100          
    100          
    100          
    100          
    50          
150 1         3 my $len;
151 1         8 my $p = Geo::GDAL::FFI::OGR_F_GetFieldAsIntegerList($$self, $i, \$len);
152 1         10 @list = unpack("l[$len]", buffer_to_scalar($p, $len*4));
153             } elsif ($t eq 'Integer64List') {
154 1         3 my $len;
155 1         10 my $p = Geo::GDAL::FFI::OGR_F_GetFieldAsInteger64List($$self, $i, \$len);
156 1         11 @list = unpack("q[$len]", buffer_to_scalar($p, $len*8));
157             } elsif ($t eq 'RealList') {
158 1         2 my $len;
159 1         9 my $p = Geo::GDAL::FFI::OGR_F_GetFieldAsDoubleList($$self, $i, \$len);
160 1         8 @list = unpack("d[$len]", buffer_to_scalar($p, $len*8));
161             } elsif ($t eq 'StringList') {
162 1         17 my $p = Geo::GDAL::FFI::OGR_F_GetFieldAsStringList($$self, $i);
163 1         7 for my $i (0..Geo::GDAL::FFI::CSLCount($p)-1) {
164 3         14 push @list, Geo::GDAL::FFI::CSLGetField($p, $i);
165             }
166             } elsif ($t eq 'Date') {
167 2         10 my ($y, $m, $d, $h, $min, $s, $tz) = (0, 0, 0, 0, 0, 0.0, 0);
168 2         18 Geo::GDAL::FFI::OGR_F_GetFieldAsDateTimeEx($$self, $i, \$y, \$m, \$d, \$h, \$min, \$s, \$tz);
169 2         7 @list = ($y, $m, $d);
170             } elsif ($t eq 'Time') {
171 1         5 my ($y, $m, $d, $h, $min, $s, $tz) = (0, 0, 0, 0, 0, 0.0, 0);
172 1         10 Geo::GDAL::FFI::OGR_F_GetFieldAsDateTimeEx($$self, $i, \$y, \$m, \$d, \$h, \$min, \$s, \$tz);
173 1         13 $s = sprintf("%.3f", $s) + 0;
174 1         4 @list = ($h, $min, $s, $tz);
175             } elsif ($t eq 'DateTime') {
176 1         5 my ($y, $m, $d, $h, $min, $s, $tz) = (0, 0, 0, 0, 0, 0.0, 0);
177 1         8 Geo::GDAL::FFI::OGR_F_GetFieldAsDateTimeEx($$self, $i, \$y, \$m, \$d, \$h, \$min, \$s, \$tz);
178 1         11 $s = sprintf("%.3f", $s) + 0;
179 1         7 @list = ($y, $m, $d, $h, $min, $s, $tz);
180             }
181 8         60 return @list;
182             }
183              
184             sub IsFieldSet {
185 3     3 0 21 my ($self, $i) = @_;
186 3   50     10 $i //= 0;
187 3 50       8 $i = $self->field_index($i) unless Geo::GDAL::FFI::isint($i);
188 3         22 return Geo::GDAL::FFI::OGR_F_IsFieldSet($$self, $i);
189             }
190              
191             sub IsFieldNull {
192 3     3 0 1035 my ($self, $i) = @_;
193 3   50     17 $i //= 0;
194 3 50       14 $i = $self->field_index($i) unless Geo::GDAL::FFI::isint($i);
195 3         19 return Geo::GDAL::FFI::OGR_F_IsFieldNull($$self, $i);
196             }
197              
198             sub IsFieldSetAndNotNull {
199 13     13 0 28 my ($self, $i) = @_;
200 13   50     26 $i //= 0;
201 13 50       29 $i = $self->field_index($i) unless Geo::GDAL::FFI::isint($i);
202 13         97 return Geo::GDAL::FFI::OGR_F_IsFieldSetAndNotNull($$self, $i);
203             }
204              
205             sub GetGeomField {
206 3     3 1 20 my ($self, $i) = @_;
207 3   100     12 $i //= 0;
208 3 50       9 $i = $self->field_index($i, 1) unless Geo::GDAL::FFI::isint($i);
209 3         22 my $g = Geo::GDAL::FFI::OGR_F_GetGeomFieldRef($$self, $i);
210 3 50       10 confess "No such field: $i" unless $g;
211 3         9 ++$Geo::GDAL::FFI::immutable{$g};
212             #say STDERR "$g immutable";
213 3         16 return bless \$g, 'Geo::GDAL::FFI::Geometry';
214             }
215              
216             sub SetGeomField {
217 4     4 1 25 my $self = shift;
218 4         9 my $g = pop;
219 4         7 my $i = shift;
220 4   100     16 $i //= 0;
221 4 100       17 $i = $self->field_index($i, 1) unless Geo::GDAL::FFI::isint($i);
222 4 100       18 if (ref $g eq 'ARRAY') {
223 1         10 $g = Geo::GDAL::FFI::Geometry->new(@$g);
224             }
225 4         22 ++$Geo::GDAL::FFI::immutable{$$g};
226             #say STDERR "$$g immutable";
227 4         33 Geo::GDAL::FFI::OGR_F_SetGeomFieldDirectly($$self, $i, $$g);
228             }
229              
230             1;
231              
232             =pod
233              
234             =encoding UTF-8
235              
236             =head1 NAME
237              
238             Geo::GDAL::FFI::Feature - A GDAL vector feature
239              
240             =head1 SYNOPSIS
241              
242             =head1 DESCRIPTION
243              
244             =head1 METHODS
245              
246             =head2 new
247              
248             my $feature = Geo::GDAL::FFI::Feature->new($defn);
249              
250             Create a new Feature object. The argument is a FeatureDefn object,
251             which you can get from a Layer object (Defn method), another Feature
252             object (Defn method), or by explicitly creating a new FeatureDefn
253             object.
254              
255             =head2 GetDefn
256              
257             Returns the FeatureDefn object for this Feature.
258              
259             =head2 GetFID
260              
261             =head2 SetFID
262              
263             =head2 Clone
264              
265             =head2 Equals
266              
267             my $equals = $feature1->Equals($feature2);
268              
269             =head2 SetField
270              
271             $feature->SetField($fname, ...);
272              
273             Set the value of field $fname. If no arguments after the name is
274             given, the field is unset. If the arguments after the name is
275             undefined, sets the field to NULL. Otherwise sets the field according
276             to the field type.
277              
278             =head2 GetField
279              
280             my $value = $feature->GetField($fname);
281              
282             =head2 SetGeomField
283              
284             $feature->SetField($fname, $geom);
285              
286             $fname is optional and by default the first geometry field.
287              
288             =head2 GetGeomField
289              
290             my $geom = $feature->GetGeomField($fname);
291              
292             $fname is optional and by default the first geometry field.
293              
294             =head1 LICENSE
295              
296             This software is released under the Artistic License. See
297             L.
298              
299             =head1 AUTHOR
300              
301             Ari Jolma - Ari.Jolma at gmail.com
302              
303             =head1 SEE ALSO
304              
305             L
306              
307             L, L, L
308              
309             =cut
310              
311             __END__;