File Coverage

blib/lib/Geo/OGR.pm
Criterion Covered Total %
statement 857 1241 69.0
branch 358 688 52.0
condition 107 268 39.9
subroutine 135 196 68.8
pod 0 10 0.0
total 1457 2403 60.6


line stmt bran cond sub pod time code
1             # This file was automatically generated by SWIG (http://www.swig.org).
2             # Version 2.0.11
3             #
4             # Do not make changes to this file unless you know what you are doing--modify
5             # the SWIG interface file instead.
6              
7             package Geo::OGR;
8 19     19   64 use base qw(Exporter);
  19         18  
  19         1107  
9 19     19   63 use base qw(DynaLoader);
  19         18  
  19         8019  
10             require Geo::OSR;
11             require Geo::GDAL;
12             package Geo::OGRc;
13             bootstrap Geo::OGR;
14             package Geo::OGR;
15             @EXPORT = qw();
16              
17             # ---------- BASE METHODS -------------
18              
19             package Geo::OGR;
20              
21             sub TIEHASH {
22 0     0   0 my ($classname,$obj) = @_;
23 0         0 return bless $obj, $classname;
24             }
25              
26       0     sub CLEAR { }
27              
28       0     sub FIRSTKEY { }
29              
30       0     sub NEXTKEY { }
31              
32             sub FETCH {
33 0     0   0 my ($self,$field) = @_;
34 0         0 my $member_func = "swig_${field}_get";
35 0         0 $self->$member_func();
36             }
37              
38             sub STORE {
39 0     0   0 my ($self,$field,$newval) = @_;
40 0         0 my $member_func = "swig_${field}_set";
41 0         0 $self->$member_func($newval);
42             }
43              
44             sub this {
45 0     0 0 0 my $ptr = shift;
46 0         0 return tied(%$ptr);
47             }
48              
49              
50             # ------- FUNCTION WRAPPERS --------
51              
52             package Geo::OGR;
53              
54             *UseExceptions = *Geo::OGRc::UseExceptions;
55             *DontUseExceptions = *Geo::OGRc::DontUseExceptions;
56             *CreateGeometryFromWkb = *Geo::OGRc::CreateGeometryFromWkb;
57             *CreateGeometryFromWkt = *Geo::OGRc::CreateGeometryFromWkt;
58             *CreateGeometryFromGML = *Geo::OGRc::CreateGeometryFromGML;
59             *CreateGeometryFromJson = *Geo::OGRc::CreateGeometryFromJson;
60             *BuildPolygonFromEdges = *Geo::OGRc::BuildPolygonFromEdges;
61             *ApproximateArcAngles = *Geo::OGRc::ApproximateArcAngles;
62             *ForceToPolygon = *Geo::OGRc::ForceToPolygon;
63             *ForceToLineString = *Geo::OGRc::ForceToLineString;
64             *ForceToMultiPolygon = *Geo::OGRc::ForceToMultiPolygon;
65             *ForceToMultiPoint = *Geo::OGRc::ForceToMultiPoint;
66             *ForceToMultiLineString = *Geo::OGRc::ForceToMultiLineString;
67             *ForceTo = *Geo::OGRc::ForceTo;
68             *GetDriverCount = *Geo::OGRc::GetDriverCount;
69             *GetOpenDSCount = *Geo::OGRc::GetOpenDSCount;
70             *SetGenerate_DB2_V72_BYTE_ORDER = *Geo::OGRc::SetGenerate_DB2_V72_BYTE_ORDER;
71             *RegisterAll = *Geo::OGRc::RegisterAll;
72             *GeometryTypeToName = *Geo::OGRc::GeometryTypeToName;
73             *GetFieldTypeName = *Geo::OGRc::GetFieldTypeName;
74             *GetFieldSubTypeName = *Geo::OGRc::GetFieldSubTypeName;
75             *GT_Flatten = *Geo::OGRc::GT_Flatten;
76             *GT_SetZ = *Geo::OGRc::GT_SetZ;
77             *GT_SetM = *Geo::OGRc::GT_SetM;
78             *GT_SetModifier = *Geo::OGRc::GT_SetModifier;
79             *GT_HasZ = *Geo::OGRc::GT_HasZ;
80             *GT_HasM = *Geo::OGRc::GT_HasM;
81             *GT_IsSubClassOf = *Geo::OGRc::GT_IsSubClassOf;
82             *GT_IsCurve = *Geo::OGRc::GT_IsCurve;
83             *GT_IsSurface = *Geo::OGRc::GT_IsSurface;
84             *GT_IsNonLinear = *Geo::OGRc::GT_IsNonLinear;
85             *GT_GetCollection = *Geo::OGRc::GT_GetCollection;
86             *GT_GetCurve = *Geo::OGRc::GT_GetCurve;
87             *GT_GetLinear = *Geo::OGRc::GT_GetLinear;
88             *SetNonLinearGeometriesEnabledFlag = *Geo::OGRc::SetNonLinearGeometriesEnabledFlag;
89             *GetNonLinearGeometriesEnabledFlag = *Geo::OGRc::GetNonLinearGeometriesEnabledFlag;
90             *TermProgress_nocb = *Geo::OGRc::TermProgress_nocb;
91              
92             ############# Class : Geo::OGR::StyleTable ##############
93              
94             package Geo::OGR::StyleTable;
95 19     19   73 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         21  
  19         4733  
96             @ISA = qw( Geo::OGR );
97             %OWNER = ();
98             %ITERATORS = ();
99             sub new {
100 0     0   0 my $pkg = shift;
101 0         0 my $self = Geo::OGRc::new_StyleTable(@_);
102 0 0       0 bless $self, $pkg if defined($self);
103             }
104              
105             sub DESTROY {
106 0 0   0   0 return unless $_[0]->isa('HASH');
107 0         0 my $self = tied(%{$_[0]});
  0         0  
108 0 0       0 return unless defined $self;
109 0         0 delete $ITERATORS{$self};
110 0 0       0 if (exists $OWNER{$self}) {
111 0         0 Geo::OGRc::delete_StyleTable($self);
112 0         0 delete $OWNER{$self};
113             }
114             }
115              
116             *AddStyle = *Geo::OGRc::StyleTable_AddStyle;
117             *LoadStyleTable = *Geo::OGRc::StyleTable_LoadStyleTable;
118             *SaveStyleTable = *Geo::OGRc::StyleTable_SaveStyleTable;
119             *Find = *Geo::OGRc::StyleTable_Find;
120             *ResetStyleStringReading = *Geo::OGRc::StyleTable_ResetStyleStringReading;
121             *GetNextStyle = *Geo::OGRc::StyleTable_GetNextStyle;
122             *GetLastStyleName = *Geo::OGRc::StyleTable_GetLastStyleName;
123             sub DISOWN {
124 0     0   0 my $self = shift;
125 0         0 my $ptr = tied(%$self);
126 0         0 delete $OWNER{$ptr};
127             }
128              
129             sub ACQUIRE {
130 0     0   0 my $self = shift;
131 0         0 my $ptr = tied(%$self);
132 0         0 $OWNER{$ptr} = 1;
133             }
134              
135              
136             ############# Class : Geo::OGR::Layer ##############
137              
138             package Geo::OGR::Layer;
139 19     19   68 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         15  
  19         6430  
140             @ISA = qw( Geo::GDAL::MajorObject Geo::OGR );
141             %OWNER = ();
142             *GetRefCount = *Geo::OGRc::Layer_GetRefCount;
143             *SetSpatialFilter = *Geo::OGRc::Layer_SetSpatialFilter;
144             *SetSpatialFilterRect = *Geo::OGRc::Layer_SetSpatialFilterRect;
145             *GetSpatialFilter = *Geo::OGRc::Layer_GetSpatialFilter;
146             *SetAttributeFilter = *Geo::OGRc::Layer_SetAttributeFilter;
147             *ResetReading = *Geo::OGRc::Layer_ResetReading;
148             *GetName = *Geo::OGRc::Layer_GetName;
149             *GetGeomType = *Geo::OGRc::Layer_GetGeomType;
150             *GetGeometryColumn = *Geo::OGRc::Layer_GetGeometryColumn;
151             *GetFIDColumn = *Geo::OGRc::Layer_GetFIDColumn;
152             *_GetFeature = *Geo::OGRc::Layer__GetFeature;
153             *GetNextFeature = *Geo::OGRc::Layer_GetNextFeature;
154             *SetNextByIndex = *Geo::OGRc::Layer_SetNextByIndex;
155             *SetFeature = *Geo::OGRc::Layer_SetFeature;
156             *CreateFeature = *Geo::OGRc::Layer_CreateFeature;
157             *DeleteFeature = *Geo::OGRc::Layer_DeleteFeature;
158             *SyncToDisk = *Geo::OGRc::Layer_SyncToDisk;
159             *GetLayerDefn = *Geo::OGRc::Layer_GetLayerDefn;
160             *GetFeatureCount = *Geo::OGRc::Layer_GetFeatureCount;
161             *GetExtent = *Geo::OGRc::Layer_GetExtent;
162             *_TestCapability = *Geo::OGRc::Layer__TestCapability;
163             *_CreateField = *Geo::OGRc::Layer__CreateField;
164             *_DeleteField = *Geo::OGRc::Layer__DeleteField;
165             *ReorderField = *Geo::OGRc::Layer_ReorderField;
166             *ReorderFields = *Geo::OGRc::Layer_ReorderFields;
167             *_AlterFieldDefn = *Geo::OGRc::Layer__AlterFieldDefn;
168             *CreateGeomField = *Geo::OGRc::Layer_CreateGeomField;
169             *StartTransaction = *Geo::OGRc::Layer_StartTransaction;
170             *CommitTransaction = *Geo::OGRc::Layer_CommitTransaction;
171             *RollbackTransaction = *Geo::OGRc::Layer_RollbackTransaction;
172             *FindFieldIndex = *Geo::OGRc::Layer_FindFieldIndex;
173             *GetSpatialRef = *Geo::OGRc::Layer_GetSpatialRef;
174             *GetFeaturesRead = *Geo::OGRc::Layer_GetFeaturesRead;
175             *SetIgnoredFields = *Geo::OGRc::Layer_SetIgnoredFields;
176             *Intersection = *Geo::OGRc::Layer_Intersection;
177             *Union = *Geo::OGRc::Layer_Union;
178             *SymDifference = *Geo::OGRc::Layer_SymDifference;
179             *Identity = *Geo::OGRc::Layer_Identity;
180             *Update = *Geo::OGRc::Layer_Update;
181             *Clip = *Geo::OGRc::Layer_Clip;
182             *Erase = *Geo::OGRc::Layer_Erase;
183             *GetStyleTable = *Geo::OGRc::Layer_GetStyleTable;
184             *SetStyleTable = *Geo::OGRc::Layer_SetStyleTable;
185             sub DISOWN {
186 0     0   0 my $self = shift;
187 0         0 my $ptr = tied(%$self);
188 0         0 delete $OWNER{$ptr};
189             }
190              
191             sub ACQUIRE {
192 0     0   0 my $self = shift;
193 0         0 my $ptr = tied(%$self);
194 0         0 $OWNER{$ptr} = 1;
195             }
196              
197              
198             ############# Class : Geo::OGR::Feature ##############
199              
200             package Geo::OGR::Feature;
201 19     19   73 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         24  
  19         2776  
202             @ISA = qw( Geo::OGR );
203             %OWNER = ();
204             sub DESTROY {
205 44     44   1751 my $self = shift;
206 44 100       122 unless ($self->isa('SCALAR')) {
207 22 50       47 return unless $self->isa('HASH');
208 22         18 $self = tied(%{$self});
  22         28  
209 22 50       37 return unless defined $self;
210             }
211 44         51 my $code = $Geo::GDAL::stdout_redirection{$self};
212 44         31 delete $Geo::GDAL::stdout_redirection{$self};
213 44         30 delete $ITERATORS{$self};
214 44 100       71 if (exists $OWNER{$self}) {
215 22         183 Geo::OGRc::delete_Feature($self);
216 22         31 delete $OWNER{$self};
217             }
218 44         55 $self->RELEASE_PARENTS();
219 44 50       151 if ($code) {
220 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
221 0         0 $code->close;
222             }
223              
224             }
225              
226 19     19   78 use Carp;
  19         20  
  19         9369  
227             sub new {
228 13     13   254 my $pkg = shift;
229 13         41 my $arg = blessed($_[0]);
230 13         11 my $defn;
231 13 100 66     51 if ($arg && $arg eq 'Geo::OGR::FeatureDefn') {
232 10         9 $defn = $_[0];
233             } else {
234 3         10 $defn = Geo::OGR::FeatureDefn->new(@_);
235             }
236 12         152 my $self = Geo::OGRc::new_Feature($defn);
237 12 50       51 bless $self, $pkg if defined($self);
238             }
239              
240             *GetDefnRef = *Geo::OGRc::Feature_GetDefnRef;
241             *_SetGeometry = *Geo::OGRc::Feature__SetGeometry;
242             *SetGeometryDirectly = *Geo::OGRc::Feature_SetGeometryDirectly;
243             *GetGeometryRef = *Geo::OGRc::Feature_GetGeometryRef;
244             *SetGeomField = *Geo::OGRc::Feature_SetGeomField;
245             *SetGeomFieldDirectly = *Geo::OGRc::Feature_SetGeomFieldDirectly;
246             *GetGeomFieldRef = *Geo::OGRc::Feature_GetGeomFieldRef;
247             *Clone = *Geo::OGRc::Feature_Clone;
248             *Equal = *Geo::OGRc::Feature_Equal;
249             *GetFieldCount = *Geo::OGRc::Feature_GetFieldCount;
250             *GetFieldDefnRef = *Geo::OGRc::Feature_GetFieldDefnRef;
251             *GetGeomFieldCount = *Geo::OGRc::Feature_GetGeomFieldCount;
252             *GetGeomFieldDefnRef = *Geo::OGRc::Feature_GetGeomFieldDefnRef;
253             *GetFieldAsString = *Geo::OGRc::Feature_GetFieldAsString;
254             *GetFieldAsInteger = *Geo::OGRc::Feature_GetFieldAsInteger;
255             *GetFieldAsInteger64 = *Geo::OGRc::Feature_GetFieldAsInteger64;
256             *GetFieldAsDouble = *Geo::OGRc::Feature_GetFieldAsDouble;
257             *GetFieldAsDateTime = *Geo::OGRc::Feature_GetFieldAsDateTime;
258             *GetFieldAsIntegerList = *Geo::OGRc::Feature_GetFieldAsIntegerList;
259             *GetFieldAsInteger64List = *Geo::OGRc::Feature_GetFieldAsInteger64List;
260             *GetFieldAsDoubleList = *Geo::OGRc::Feature_GetFieldAsDoubleList;
261             *GetFieldAsStringList = *Geo::OGRc::Feature_GetFieldAsStringList;
262             *GetFieldAsBinary = *Geo::OGRc::Feature_GetFieldAsBinary;
263             *IsFieldSet = *Geo::OGRc::Feature_IsFieldSet;
264             *_GetFieldIndex = *Geo::OGRc::Feature__GetFieldIndex;
265             *_GetGeomFieldIndex = *Geo::OGRc::Feature__GetGeomFieldIndex;
266             *GetFID = *Geo::OGRc::Feature_GetFID;
267             *SetFID = *Geo::OGRc::Feature_SetFID;
268             *DumpReadable = *Geo::OGRc::Feature_DumpReadable;
269             *_UnsetField = *Geo::OGRc::Feature__UnsetField;
270             *SetFieldInteger64 = *Geo::OGRc::Feature_SetFieldInteger64;
271             *_SetField = *Geo::OGRc::Feature__SetField;
272             *SetFieldIntegerList = *Geo::OGRc::Feature_SetFieldIntegerList;
273             *SetFieldInteger64List = *Geo::OGRc::Feature_SetFieldInteger64List;
274             *SetFieldDoubleList = *Geo::OGRc::Feature_SetFieldDoubleList;
275             *SetFieldStringList = *Geo::OGRc::Feature_SetFieldStringList;
276             *SetFieldBinary = *Geo::OGRc::Feature_SetFieldBinary;
277             *SetFieldBinaryFromHexString = *Geo::OGRc::Feature_SetFieldBinaryFromHexString;
278             *_SetFrom = *Geo::OGRc::Feature__SetFrom;
279             *SetFromWithMap = *Geo::OGRc::Feature_SetFromWithMap;
280             *GetStyleString = *Geo::OGRc::Feature_GetStyleString;
281             *SetStyleString = *Geo::OGRc::Feature_SetStyleString;
282             *GetFieldType = *Geo::OGRc::Feature_GetFieldType;
283             *_Validate = *Geo::OGRc::Feature__Validate;
284             *FillUnsetWithDefault = *Geo::OGRc::Feature_FillUnsetWithDefault;
285             *GetNativeData = *Geo::OGRc::Feature_GetNativeData;
286             *GetNativeMediaType = *Geo::OGRc::Feature_GetNativeMediaType;
287             *SetNativeData = *Geo::OGRc::Feature_SetNativeData;
288             *SetNativeMediaType = *Geo::OGRc::Feature_SetNativeMediaType;
289             sub DISOWN {
290 0     0   0 my $self = shift;
291 0         0 my $ptr = tied(%$self);
292 0         0 delete $OWNER{$ptr};
293             }
294              
295             sub ACQUIRE {
296 0     0   0 my $self = shift;
297 0         0 my $ptr = tied(%$self);
298 0         0 $OWNER{$ptr} = 1;
299             }
300              
301              
302             ############# Class : Geo::OGR::FeatureDefn ##############
303              
304             package Geo::OGR::FeatureDefn;
305 19     19   77 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         18  
  19         2769  
306             @ISA = qw( Geo::OGR );
307             %OWNER = ();
308             sub DESTROY {
309 82     82   370 my $self = shift;
310 82 100       204 unless ($self->isa('SCALAR')) {
311 41 50       79 return unless $self->isa('HASH');
312 41         30 $self = tied(%{$self});
  41         48  
313 41 50       59 return unless defined $self;
314             }
315 82         87 my $code = $Geo::GDAL::stdout_redirection{$self};
316 82         60 delete $Geo::GDAL::stdout_redirection{$self};
317 82         60 delete $ITERATORS{$self};
318 82 100       118 if (exists $OWNER{$self}) {
319 4         23 Geo::OGRc::delete_FeatureDefn($self);
320 4         5 delete $OWNER{$self};
321             }
322 82         105 $self->RELEASE_PARENTS();
323 82 50       285 if ($code) {
324 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
325 0         0 $code->close;
326             }
327              
328             }
329              
330 19     19   74 use strict;
  19         21  
  19         401  
331 19     19   67 use warnings;
  19         20  
  19         402  
332 19     19   64 use Carp;
  19         19  
  19         846  
333 19     19   66 use Scalar::Util 'blessed';
  19         25  
  19         8597  
334             sub new {
335 4     4   5 my $pkg = shift;
336 4         5 my %schema;
337 4 50 33     33 if (@_ == 1 and ref($_[0]) eq 'HASH') {
    50 33        
338 0         0 %schema = %{$_[0]};
  0         0  
339             } elsif (@_ and @_ % 2 == 0) {
340 4         15 %schema = @_;
341             }
342 4         5 my $fields = $schema{Fields};
343 4 50 33     20 Geo::GDAL::error("The 'Fields' argument must be an array reference.") if $fields and ref($fields) ne 'ARRAY';
344 4   50     282 $schema{Name} //= '';
345 4         123 my $self = Geo::OGRc::new_FeatureDefn($schema{Name});
346 4         5 bless $self, $pkg;
347 4         7 my $gt = $schema{GeometryType};
348 4 100       15 if ($gt) {
    50          
349 2         6 $self->GeometryType($gt);
350             } elsif ($fields) {
351 2         15 $self->DeleteGeomFieldDefn(0);
352             }
353 4 50       10 $self->StyleIgnored($schema{StyleIgnored}) if exists $schema{StyleIgnored};
354 4         2 for my $fd (@{$fields}) {
  4         8  
355 18         9 my $d = $fd;
356 18 100       34 if (ref($fd) eq 'HASH') {
357 17 100 66     54 if ($fd->{GeometryType} or exists $Geo::OGR::Geometry::TYPE_STRING2INT{$fd->{Type}}) {
358 3         9 $d = Geo::OGR::GeomFieldDefn->new(%$fd);
359             } else {
360 14         33 $d = Geo::OGR::FieldDefn->new(%$fd);
361             }
362             }
363 18 100 66     105 if (blessed($d) and $d->isa('Geo::OGR::FieldDefn')) {
    50 33        
364 15         69 AddFieldDefn($self, $d);
365             } elsif (blessed($d) and $d->isa('Geo::OGR::GeomFieldDefn')) {
366 3 100       8 Geo::GDAL::error("Do not mix GeometryType and geometry fields in Fields.") if $gt;
367 2         10 AddGeomFieldDefn($self, $d);
368             } else {
369 0         0 Geo::GDAL::error("Item in field list does not define a field.");
370             }
371             }
372 3         8 return $self;
373             }
374              
375             *GetName = *Geo::OGRc::FeatureDefn_GetName;
376             *GetFieldCount = *Geo::OGRc::FeatureDefn_GetFieldCount;
377             *_GetFieldDefn = *Geo::OGRc::FeatureDefn__GetFieldDefn;
378             *_GetFieldIndex = *Geo::OGRc::FeatureDefn__GetFieldIndex;
379             *AddFieldDefn = *Geo::OGRc::FeatureDefn_AddFieldDefn;
380             *GetGeomFieldCount = *Geo::OGRc::FeatureDefn_GetGeomFieldCount;
381             *_GetGeomFieldDefn = *Geo::OGRc::FeatureDefn__GetGeomFieldDefn;
382             *_GetGeomFieldIndex = *Geo::OGRc::FeatureDefn__GetGeomFieldIndex;
383             *AddGeomFieldDefn = *Geo::OGRc::FeatureDefn_AddGeomFieldDefn;
384             *DeleteGeomFieldDefn = *Geo::OGRc::FeatureDefn_DeleteGeomFieldDefn;
385             *GetGeomType = *Geo::OGRc::FeatureDefn_GetGeomType;
386             *SetGeomType = *Geo::OGRc::FeatureDefn_SetGeomType;
387             *GetReferenceCount = *Geo::OGRc::FeatureDefn_GetReferenceCount;
388             *IsGeometryIgnored = *Geo::OGRc::FeatureDefn_IsGeometryIgnored;
389             *SetGeometryIgnored = *Geo::OGRc::FeatureDefn_SetGeometryIgnored;
390             *IsStyleIgnored = *Geo::OGRc::FeatureDefn_IsStyleIgnored;
391             *SetStyleIgnored = *Geo::OGRc::FeatureDefn_SetStyleIgnored;
392             *IsSame = *Geo::OGRc::FeatureDefn_IsSame;
393             sub DISOWN {
394 0     0   0 my $self = shift;
395 0         0 my $ptr = tied(%$self);
396 0         0 delete $OWNER{$ptr};
397             }
398              
399             sub ACQUIRE {
400 0     0   0 my $self = shift;
401 0         0 my $ptr = tied(%$self);
402 0         0 $OWNER{$ptr} = 1;
403             }
404              
405              
406             ############# Class : Geo::OGR::FieldDefn ##############
407              
408             package Geo::OGR::FieldDefn;
409 19     19   90 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         15  
  19         2642  
410             @ISA = qw( Geo::OGR );
411             %OWNER = ();
412             sub DESTROY {
413 144     144   459 my $self = shift;
414 144 100       353 unless ($self->isa('SCALAR')) {
415 72 50       135 return unless $self->isa('HASH');
416 72         44 $self = tied(%{$self});
  72         78  
417 72 50       98 return unless defined $self;
418             }
419 144         132 my $code = $Geo::GDAL::stdout_redirection{$self};
420 144         105 delete $Geo::GDAL::stdout_redirection{$self};
421 144         104 delete $ITERATORS{$self};
422 144 100       210 if (exists $OWNER{$self}) {
423 32         126 Geo::OGRc::delete_FieldDefn($self);
424 32         40 delete $OWNER{$self};
425             }
426 144         162 $self->RELEASE_PARENTS();
427 144 50       398 if ($code) {
428 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
429 0         0 $code->close;
430             }
431              
432             }
433              
434 19     19   68 use Carp;
  19         16  
  19         7705  
435             sub new {
436 32     32   38 my $pkg = shift;
437 32         52 my $params = {Name => 'unnamed', Type => 'String'};
438 32 100 66     134 if (@_ == 0) {
    50 33        
    50          
439             } elsif (@_ == 1 and not ref $_[0]) {
440 0         0 $params->{Name} = shift;
441             } elsif (@_ == 2 and not $Geo::OGR::FieldDefn::SCHEMA_KEYS{$_[0]}) {
442 0         0 $params->{Name} = shift;
443 0         0 $params->{Type} = shift;
444             } else {
445 31 100       71 my $tmp = @_ % 2 == 0 ? {@_} : shift;
446 31         52 for my $key (keys %$tmp) {
447 62 100       79 if ($Geo::OGR::FieldDefn::SCHEMA_KEYS{$key}) {
448 61         84 $params->{$key} = $tmp->{$key};
449             } else {
450 1 50       3 carp "Unknown parameter: '$key'." if $key ne 'Index';
451             }
452             }
453             }
454 32         78 $params->{Type} = Geo::GDAL::string2int($params->{Type}, \%Geo::OGR::FieldDefn::TYPE_STRING2INT);
455 32         342 my $self = Geo::OGRc::new_FieldDefn($params->{Name}, $params->{Type});
456 32         39 bless $self, $pkg;
457 32         32 delete $params->{Name};
458 32         29 delete $params->{Type};
459 32         58 $self->Schema($params);
460 32         47 return $self;
461             }
462              
463             *GetName = *Geo::OGRc::FieldDefn_GetName;
464             *GetNameRef = *Geo::OGRc::FieldDefn_GetNameRef;
465             *SetName = *Geo::OGRc::FieldDefn_SetName;
466             *GetType = *Geo::OGRc::FieldDefn_GetType;
467             *SetType = *Geo::OGRc::FieldDefn_SetType;
468             *GetSubType = *Geo::OGRc::FieldDefn_GetSubType;
469             *SetSubType = *Geo::OGRc::FieldDefn_SetSubType;
470             *GetJustify = *Geo::OGRc::FieldDefn_GetJustify;
471             *SetJustify = *Geo::OGRc::FieldDefn_SetJustify;
472             *GetWidth = *Geo::OGRc::FieldDefn_GetWidth;
473             *SetWidth = *Geo::OGRc::FieldDefn_SetWidth;
474             *GetPrecision = *Geo::OGRc::FieldDefn_GetPrecision;
475             *SetPrecision = *Geo::OGRc::FieldDefn_SetPrecision;
476             *GetTypeName = *Geo::OGRc::FieldDefn_GetTypeName;
477             *GetFieldTypeName = *Geo::OGRc::FieldDefn_GetFieldTypeName;
478             *IsIgnored = *Geo::OGRc::FieldDefn_IsIgnored;
479             *SetIgnored = *Geo::OGRc::FieldDefn_SetIgnored;
480             *IsNullable = *Geo::OGRc::FieldDefn_IsNullable;
481             *SetNullable = *Geo::OGRc::FieldDefn_SetNullable;
482             *GetDefault = *Geo::OGRc::FieldDefn_GetDefault;
483             *SetDefault = *Geo::OGRc::FieldDefn_SetDefault;
484             *IsDefaultDriverSpecific = *Geo::OGRc::FieldDefn_IsDefaultDriverSpecific;
485             sub DISOWN {
486 0     0   0 my $self = shift;
487 0         0 my $ptr = tied(%$self);
488 0         0 delete $OWNER{$ptr};
489             }
490              
491             sub ACQUIRE {
492 0     0   0 my $self = shift;
493 0         0 my $ptr = tied(%$self);
494 0         0 $OWNER{$ptr} = 1;
495             }
496              
497              
498             ############# Class : Geo::OGR::GeomFieldDefn ##############
499              
500             package Geo::OGR::GeomFieldDefn;
501 19     19   79 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         14  
  19         2329  
502             @ISA = qw( Geo::OGR );
503             %OWNER = ();
504             %ITERATORS = ();
505             sub DESTROY {
506 80 100   80   443 return unless $_[0]->isa('HASH');
507 40         28 my $self = tied(%{$_[0]});
  40         61  
508 40 50       71 return unless defined $self;
509 40         46 delete $ITERATORS{$self};
510 40 100       108 if (exists $OWNER{$self}) {
511 10         66 Geo::OGRc::delete_GeomFieldDefn($self);
512 10         27 delete $OWNER{$self};
513             }
514             }
515              
516 19     19   70 use Carp;
  19         58  
  19         6098  
517             sub new {
518 10     10   12 my $pkg = shift;
519 10         26 my $params = {Name => 'geom', Type => 'Unknown'};
520 10 50 66     59 if (@_ == 0) {
    50          
    50          
521             } elsif (@_ == 1) {
522 0         0 $params->{Name} = shift;
523             } elsif (@_ == 2 and not $Geo::OGR::GeomFieldDefn::SCHEMA_KEYS{$_[0]}) {
524 0         0 $params->{Name} = shift;
525 0         0 $params->{Type} = shift;
526             } else {
527 10 50       42 my $tmp = @_ % 2 == 0 ? {@_} : shift;
528 10         20 for my $key (keys %$tmp) {
529 19 50       34 if ($Geo::OGR::GeomFieldDefn::SCHEMA_KEYS{$key}) {
530 19         32 $params->{$key} = $tmp->{$key};
531             } else {
532 0 0 0     0 carp "Unknown parameter: '$key'." if $key ne 'Index' && $key ne 'GeometryType';
533             }
534             }
535 10   33     31 $params->{Type} //= $tmp->{GeometryType};
536             }
537 10         29 $params->{Type} = Geo::GDAL::string2int($params->{Type}, \%Geo::OGR::Geometry::TYPE_STRING2INT);
538 10         129 my $self = Geo::OGRc::new_GeomFieldDefn($params->{Name}, $params->{Type});
539 10         16 bless $self, $pkg;
540 10         15 delete $params->{Name};
541 10         13 delete $params->{Type};
542 10         24 $self->Schema($params);
543 10         17 return $self;
544             }
545              
546             *GetName = *Geo::OGRc::GeomFieldDefn_GetName;
547             *GetNameRef = *Geo::OGRc::GeomFieldDefn_GetNameRef;
548             *SetName = *Geo::OGRc::GeomFieldDefn_SetName;
549             *GetType = *Geo::OGRc::GeomFieldDefn_GetType;
550             *SetType = *Geo::OGRc::GeomFieldDefn_SetType;
551             *GetSpatialRef = *Geo::OGRc::GeomFieldDefn_GetSpatialRef;
552             *SetSpatialRef = *Geo::OGRc::GeomFieldDefn_SetSpatialRef;
553             *IsIgnored = *Geo::OGRc::GeomFieldDefn_IsIgnored;
554             *SetIgnored = *Geo::OGRc::GeomFieldDefn_SetIgnored;
555             *IsNullable = *Geo::OGRc::GeomFieldDefn_IsNullable;
556             *SetNullable = *Geo::OGRc::GeomFieldDefn_SetNullable;
557             sub DISOWN {
558 0     0   0 my $self = shift;
559 0         0 my $ptr = tied(%$self);
560 0         0 delete $OWNER{$ptr};
561             }
562              
563             sub ACQUIRE {
564 0     0   0 my $self = shift;
565 0         0 my $ptr = tied(%$self);
566 0         0 $OWNER{$ptr} = 1;
567             }
568              
569              
570             ############# Class : Geo::OGR::Geometry ##############
571              
572             package Geo::OGR::Geometry;
573 19     19   76 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         25  
  19         2673  
574             @ISA = qw( Geo::OGR );
575             %OWNER = ();
576             sub DESTROY {
577 104     104   3018 my $self = shift;
578 104 100       283 unless ($self->isa('SCALAR')) {
579 52 50       91 return unless $self->isa('HASH');
580 52         43 $self = tied(%{$self});
  52         60  
581 52 50       69 return unless defined $self;
582             }
583 104         101 my $code = $Geo::GDAL::stdout_redirection{$self};
584 104         77 delete $Geo::GDAL::stdout_redirection{$self};
585 104         74 delete $ITERATORS{$self};
586 104 100       165 if (exists $OWNER{$self}) {
587 23         137 Geo::OGRc::delete_Geometry($self);
588 23         33 delete $OWNER{$self};
589             }
590 104         113 $self->RELEASE_PARENTS();
591 104 50       351 if ($code) {
592 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
593 0         0 $code->close;
594             }
595              
596             }
597              
598 19     19   69 use Carp;
  19         14  
  19         38312  
599             sub new {
600 26     26   1178 my $pkg = shift;
601 26         24 my %param;
602 26 100 100     96 if (@_ == 1 and ref($_[0]) eq 'HASH') {
    100          
603 7         6 %param = %{$_[0]};
  7         24  
604             } elsif (@_ % 2 == 0) {
605 18         36 %param = @_;
606             } else {
607 1         3 ($param{GeometryType}) = @_;
608             }
609 26   66     88 my $type = $param{GeometryType} // $param{Type} // $param{type};
      33        
610 26   33     84 my $srs = $param{SRS} // $param{srs};
611 26   66     54 my $wkt = $param{WKT} // $param{wkt};
612 26   33     47 my $wkb = $param{WKB} // $param{wkb};
613 26   33     98 my $hex = $param{HEXEWKB} // $param{HEX_EWKB} // $param{hexewkb} // $param{hex_ewkb};
      33        
      33        
614 26         21 my $srid;
615 26 50       32 if ($hex) {
616             # EWKB contains SRID
617 0         0 $srid = substr($hex, 10, 8);
618 0         0 substr($hex, 10, 8) = '';
619             } else {
620 26   33     108 $hex = $param{HEXWKB} // $param{HEX_WKB} // $param{hexwkb} // $param{hex_wkb};
      33        
      66        
621             }
622 26 100       39 if ($hex) {
623 1         1 $wkb = '';
624 1         4 for (my $i = 0; $i < length($hex); $i+=2) {
625 89         114 $wkb .= chr(hex(substr($hex,$i,2)));
626             }
627             }
628 26   33     56 my $gml = $param{GML} // $param{gml};
629 26   66     87 my $json = $param{GeoJSON} // $param{geojson} // $param{JSON} // $param{json};
      33        
      33        
630 26   66     42 my $points = $param{Points} // $param{points};
631 26   33     50 my $arc = $param{Arc} // $param{arc};
632 26         19 my $self;
633 26 100       55 if (defined $wkt) {
    100          
    100          
    100          
    50          
    0          
634 16         403 $self = Geo::OGRc::CreateGeometryFromWkt($wkt, $srs);
635             } elsif (defined $wkb) {
636 1         19 $self = Geo::OGRc::CreateGeometryFromWkb($wkb, $srs);
637             } elsif (defined $gml) {
638 1         44 $self = Geo::OGRc::CreateGeometryFromGML($gml);
639             } elsif (defined $json) {
640 1         162 $self = Geo::OGRc::CreateGeometryFromJson($json);
641             } elsif (defined $type) {
642 7         24 $type = Geo::GDAL::string2int($type, \%Geo::OGR::Geometry::TYPE_STRING2INT);
643 7         63 $self = Geo::OGRc::new_Geometry($type); # flattens the type
644 7 50       39 $self->Set3D(1) if Geo::OGR::GT_HasZ($type);
645 7 50       20 $self->SetMeasured(1) if Geo::OGR::GT_HasM($type);
646             } elsif (defined $arc) {
647 0         0 $self = Geo::OGRc::ApproximateArcAngles(@$arc);
648             } else {
649 0         0 Geo::GDAL::error(1, undef, map {$_=>1} qw/GeometryType WKT WKB HEXEWKB HEXWKB GML GeoJSON Arc/);
  0         0  
650             }
651 25 50       58 bless $self, $pkg if defined $self;
652 25 100       45 $self->Points($points) if $points;
653 25         88 return $self;
654             }
655              
656             *ExportToWkt = *Geo::OGRc::Geometry_ExportToWkt;
657             *ExportToIsoWkt = *Geo::OGRc::Geometry_ExportToIsoWkt;
658             *_ExportToWkb = *Geo::OGRc::Geometry__ExportToWkb;
659             *ExportToIsoWkb = *Geo::OGRc::Geometry_ExportToIsoWkb;
660             *ExportToGML = *Geo::OGRc::Geometry_ExportToGML;
661             *ExportToKML = *Geo::OGRc::Geometry_ExportToKML;
662             *ExportToJson = *Geo::OGRc::Geometry_ExportToJson;
663             *AddPoint_3D = *Geo::OGRc::Geometry_AddPoint_3D;
664             *AddPointM = *Geo::OGRc::Geometry_AddPointM;
665             *AddPointZM = *Geo::OGRc::Geometry_AddPointZM;
666             *AddPoint_2D = *Geo::OGRc::Geometry_AddPoint_2D;
667             *AddGeometryDirectly = *Geo::OGRc::Geometry_AddGeometryDirectly;
668             *AddGeometry = *Geo::OGRc::Geometry_AddGeometry;
669             *Clone = *Geo::OGRc::Geometry_Clone;
670             *GetGeometryType = *Geo::OGRc::Geometry_GetGeometryType;
671             *GetGeometryName = *Geo::OGRc::Geometry_GetGeometryName;
672             *Length = *Geo::OGRc::Geometry_Length;
673             *Area = *Geo::OGRc::Geometry_Area;
674             *GetArea = *Geo::OGRc::Geometry_GetArea;
675             *GetPointCount = *Geo::OGRc::Geometry_GetPointCount;
676             *GetX = *Geo::OGRc::Geometry_GetX;
677             *GetY = *Geo::OGRc::Geometry_GetY;
678             *GetZ = *Geo::OGRc::Geometry_GetZ;
679             *GetM = *Geo::OGRc::Geometry_GetM;
680             *GetPoint_3D = *Geo::OGRc::Geometry_GetPoint_3D;
681             *GetPointZM = *Geo::OGRc::Geometry_GetPointZM;
682             *GetPoint_2D = *Geo::OGRc::Geometry_GetPoint_2D;
683             *GetGeometryCount = *Geo::OGRc::Geometry_GetGeometryCount;
684             *SetPoint_3D = *Geo::OGRc::Geometry_SetPoint_3D;
685             *SetPointM = *Geo::OGRc::Geometry_SetPointM;
686             *SetPointZM = *Geo::OGRc::Geometry_SetPointZM;
687             *SetPoint_2D = *Geo::OGRc::Geometry_SetPoint_2D;
688             *GetGeometryRef = *Geo::OGRc::Geometry_GetGeometryRef;
689             *Simplify = *Geo::OGRc::Geometry_Simplify;
690             *SimplifyPreserveTopology = *Geo::OGRc::Geometry_SimplifyPreserveTopology;
691             *DelaunayTriangulation = *Geo::OGRc::Geometry_DelaunayTriangulation;
692             *Boundary = *Geo::OGRc::Geometry_Boundary;
693             *GetBoundary = *Geo::OGRc::Geometry_GetBoundary;
694             *ConvexHull = *Geo::OGRc::Geometry_ConvexHull;
695             *Buffer = *Geo::OGRc::Geometry_Buffer;
696             *Intersection = *Geo::OGRc::Geometry_Intersection;
697             *Union = *Geo::OGRc::Geometry_Union;
698             *UnionCascaded = *Geo::OGRc::Geometry_UnionCascaded;
699             *Difference = *Geo::OGRc::Geometry_Difference;
700             *SymDifference = *Geo::OGRc::Geometry_SymDifference;
701             *SymmetricDifference = *Geo::OGRc::Geometry_SymmetricDifference;
702             *Distance = *Geo::OGRc::Geometry_Distance;
703             *Empty = *Geo::OGRc::Geometry_Empty;
704             *IsEmpty = *Geo::OGRc::Geometry_IsEmpty;
705             *IsValid = *Geo::OGRc::Geometry_IsValid;
706             *IsSimple = *Geo::OGRc::Geometry_IsSimple;
707             *IsRing = *Geo::OGRc::Geometry_IsRing;
708             *Intersects = *Geo::OGRc::Geometry_Intersects;
709             *Intersect = *Geo::OGRc::Geometry_Intersect;
710             *Equals = *Geo::OGRc::Geometry_Equals;
711             *Equal = *Geo::OGRc::Geometry_Equal;
712             *Disjoint = *Geo::OGRc::Geometry_Disjoint;
713             *Touches = *Geo::OGRc::Geometry_Touches;
714             *Crosses = *Geo::OGRc::Geometry_Crosses;
715             *Within = *Geo::OGRc::Geometry_Within;
716             *Contains = *Geo::OGRc::Geometry_Contains;
717             *Overlaps = *Geo::OGRc::Geometry_Overlaps;
718             *TransformTo = *Geo::OGRc::Geometry_TransformTo;
719             *Transform = *Geo::OGRc::Geometry_Transform;
720             *GetSpatialReference = *Geo::OGRc::Geometry_GetSpatialReference;
721             *AssignSpatialReference = *Geo::OGRc::Geometry_AssignSpatialReference;
722             *CloseRings = *Geo::OGRc::Geometry_CloseRings;
723             *FlattenTo2D = *Geo::OGRc::Geometry_FlattenTo2D;
724             *Segmentize = *Geo::OGRc::Geometry_Segmentize;
725             *GetEnvelope = *Geo::OGRc::Geometry_GetEnvelope;
726             *GetEnvelope3D = *Geo::OGRc::Geometry_GetEnvelope3D;
727             *Centroid = *Geo::OGRc::Geometry_Centroid;
728             *PointOnSurface = *Geo::OGRc::Geometry_PointOnSurface;
729             *WkbSize = *Geo::OGRc::Geometry_WkbSize;
730             *GetCoordinateDimension = *Geo::OGRc::Geometry_GetCoordinateDimension;
731             *CoordinateDimension = *Geo::OGRc::Geometry_CoordinateDimension;
732             *Is3D = *Geo::OGRc::Geometry_Is3D;
733             *IsMeasured = *Geo::OGRc::Geometry_IsMeasured;
734             *SetCoordinateDimension = *Geo::OGRc::Geometry_SetCoordinateDimension;
735             *Set3D = *Geo::OGRc::Geometry_Set3D;
736             *SetMeasured = *Geo::OGRc::Geometry_SetMeasured;
737             *GetDimension = *Geo::OGRc::Geometry_GetDimension;
738             *HasCurveGeometry = *Geo::OGRc::Geometry_HasCurveGeometry;
739             *GetLinearGeometry = *Geo::OGRc::Geometry_GetLinearGeometry;
740             *GetCurveGeometry = *Geo::OGRc::Geometry_GetCurveGeometry;
741             *Value = *Geo::OGRc::Geometry_Value;
742             *Move = *Geo::OGRc::Geometry_Move;
743             sub DISOWN {
744 0     0   0 my $self = shift;
745 0         0 my $ptr = tied(%$self);
746 0         0 delete $OWNER{$ptr};
747             }
748              
749             sub ACQUIRE {
750 0     0   0 my $self = shift;
751 0         0 my $ptr = tied(%$self);
752 0         0 $OWNER{$ptr} = 1;
753             }
754              
755              
756             # ------- VARIABLE STUBS --------
757              
758             package Geo::OGR;
759              
760             *wkb25DBit = *Geo::OGRc::wkb25DBit;
761             *wkb25Bit = *Geo::OGRc::wkb25Bit;
762             *wkbUnknown = *Geo::OGRc::wkbUnknown;
763             *wkbPoint = *Geo::OGRc::wkbPoint;
764             *wkbLineString = *Geo::OGRc::wkbLineString;
765             *wkbPolygon = *Geo::OGRc::wkbPolygon;
766             *wkbMultiPoint = *Geo::OGRc::wkbMultiPoint;
767             *wkbMultiLineString = *Geo::OGRc::wkbMultiLineString;
768             *wkbMultiPolygon = *Geo::OGRc::wkbMultiPolygon;
769             *wkbGeometryCollection = *Geo::OGRc::wkbGeometryCollection;
770             *wkbCircularString = *Geo::OGRc::wkbCircularString;
771             *wkbCompoundCurve = *Geo::OGRc::wkbCompoundCurve;
772             *wkbCurvePolygon = *Geo::OGRc::wkbCurvePolygon;
773             *wkbMultiCurve = *Geo::OGRc::wkbMultiCurve;
774             *wkbMultiSurface = *Geo::OGRc::wkbMultiSurface;
775             *wkbCurve = *Geo::OGRc::wkbCurve;
776             *wkbSurface = *Geo::OGRc::wkbSurface;
777             *wkbPolyhedralSurface = *Geo::OGRc::wkbPolyhedralSurface;
778             *wkbTIN = *Geo::OGRc::wkbTIN;
779             *wkbNone = *Geo::OGRc::wkbNone;
780             *wkbLinearRing = *Geo::OGRc::wkbLinearRing;
781             *wkbCircularStringZ = *Geo::OGRc::wkbCircularStringZ;
782             *wkbCompoundCurveZ = *Geo::OGRc::wkbCompoundCurveZ;
783             *wkbCurvePolygonZ = *Geo::OGRc::wkbCurvePolygonZ;
784             *wkbMultiCurveZ = *Geo::OGRc::wkbMultiCurveZ;
785             *wkbMultiSurfaceZ = *Geo::OGRc::wkbMultiSurfaceZ;
786             *wkbCurveZ = *Geo::OGRc::wkbCurveZ;
787             *wkbSurfaceZ = *Geo::OGRc::wkbSurfaceZ;
788             *wkbPolyhedralSurfaceZ = *Geo::OGRc::wkbPolyhedralSurfaceZ;
789             *wkbTINZ = *Geo::OGRc::wkbTINZ;
790             *wkbPointM = *Geo::OGRc::wkbPointM;
791             *wkbLineStringM = *Geo::OGRc::wkbLineStringM;
792             *wkbPolygonM = *Geo::OGRc::wkbPolygonM;
793             *wkbMultiPointM = *Geo::OGRc::wkbMultiPointM;
794             *wkbMultiLineStringM = *Geo::OGRc::wkbMultiLineStringM;
795             *wkbMultiPolygonM = *Geo::OGRc::wkbMultiPolygonM;
796             *wkbGeometryCollectionM = *Geo::OGRc::wkbGeometryCollectionM;
797             *wkbCircularStringM = *Geo::OGRc::wkbCircularStringM;
798             *wkbCompoundCurveM = *Geo::OGRc::wkbCompoundCurveM;
799             *wkbCurvePolygonM = *Geo::OGRc::wkbCurvePolygonM;
800             *wkbMultiCurveM = *Geo::OGRc::wkbMultiCurveM;
801             *wkbMultiSurfaceM = *Geo::OGRc::wkbMultiSurfaceM;
802             *wkbCurveM = *Geo::OGRc::wkbCurveM;
803             *wkbSurfaceM = *Geo::OGRc::wkbSurfaceM;
804             *wkbPolyhedralSurfaceM = *Geo::OGRc::wkbPolyhedralSurfaceM;
805             *wkbTINM = *Geo::OGRc::wkbTINM;
806             *wkbPointZM = *Geo::OGRc::wkbPointZM;
807             *wkbLineStringZM = *Geo::OGRc::wkbLineStringZM;
808             *wkbPolygonZM = *Geo::OGRc::wkbPolygonZM;
809             *wkbMultiPointZM = *Geo::OGRc::wkbMultiPointZM;
810             *wkbMultiLineStringZM = *Geo::OGRc::wkbMultiLineStringZM;
811             *wkbMultiPolygonZM = *Geo::OGRc::wkbMultiPolygonZM;
812             *wkbGeometryCollectionZM = *Geo::OGRc::wkbGeometryCollectionZM;
813             *wkbCircularStringZM = *Geo::OGRc::wkbCircularStringZM;
814             *wkbCompoundCurveZM = *Geo::OGRc::wkbCompoundCurveZM;
815             *wkbCurvePolygonZM = *Geo::OGRc::wkbCurvePolygonZM;
816             *wkbMultiCurveZM = *Geo::OGRc::wkbMultiCurveZM;
817             *wkbMultiSurfaceZM = *Geo::OGRc::wkbMultiSurfaceZM;
818             *wkbCurveZM = *Geo::OGRc::wkbCurveZM;
819             *wkbSurfaceZM = *Geo::OGRc::wkbSurfaceZM;
820             *wkbPolyhedralSurfaceZM = *Geo::OGRc::wkbPolyhedralSurfaceZM;
821             *wkbTINZM = *Geo::OGRc::wkbTINZM;
822             *wkbPoint25D = *Geo::OGRc::wkbPoint25D;
823             *wkbLineString25D = *Geo::OGRc::wkbLineString25D;
824             *wkbPolygon25D = *Geo::OGRc::wkbPolygon25D;
825             *wkbMultiPoint25D = *Geo::OGRc::wkbMultiPoint25D;
826             *wkbMultiLineString25D = *Geo::OGRc::wkbMultiLineString25D;
827             *wkbMultiPolygon25D = *Geo::OGRc::wkbMultiPolygon25D;
828             *wkbGeometryCollection25D = *Geo::OGRc::wkbGeometryCollection25D;
829             *OFTInteger = *Geo::OGRc::OFTInteger;
830             *OFTIntegerList = *Geo::OGRc::OFTIntegerList;
831             *OFTReal = *Geo::OGRc::OFTReal;
832             *OFTRealList = *Geo::OGRc::OFTRealList;
833             *OFTString = *Geo::OGRc::OFTString;
834             *OFTStringList = *Geo::OGRc::OFTStringList;
835             *OFTWideString = *Geo::OGRc::OFTWideString;
836             *OFTWideStringList = *Geo::OGRc::OFTWideStringList;
837             *OFTBinary = *Geo::OGRc::OFTBinary;
838             *OFTDate = *Geo::OGRc::OFTDate;
839             *OFTTime = *Geo::OGRc::OFTTime;
840             *OFTDateTime = *Geo::OGRc::OFTDateTime;
841             *OFTInteger64 = *Geo::OGRc::OFTInteger64;
842             *OFTInteger64List = *Geo::OGRc::OFTInteger64List;
843             *OFSTNone = *Geo::OGRc::OFSTNone;
844             *OFSTBoolean = *Geo::OGRc::OFSTBoolean;
845             *OFSTInt16 = *Geo::OGRc::OFSTInt16;
846             *OFSTFloat32 = *Geo::OGRc::OFSTFloat32;
847             *OJUndefined = *Geo::OGRc::OJUndefined;
848             *OJLeft = *Geo::OGRc::OJLeft;
849             *OJRight = *Geo::OGRc::OJRight;
850             *wkbXDR = *Geo::OGRc::wkbXDR;
851             *wkbNDR = *Geo::OGRc::wkbNDR;
852             *NullFID = *Geo::OGRc::NullFID;
853             *ALTER_NAME_FLAG = *Geo::OGRc::ALTER_NAME_FLAG;
854             *ALTER_TYPE_FLAG = *Geo::OGRc::ALTER_TYPE_FLAG;
855             *ALTER_WIDTH_PRECISION_FLAG = *Geo::OGRc::ALTER_WIDTH_PRECISION_FLAG;
856             *ALTER_NULLABLE_FLAG = *Geo::OGRc::ALTER_NULLABLE_FLAG;
857             *ALTER_DEFAULT_FLAG = *Geo::OGRc::ALTER_DEFAULT_FLAG;
858             *ALTER_ALL_FLAG = *Geo::OGRc::ALTER_ALL_FLAG;
859             *F_VAL_NULL = *Geo::OGRc::F_VAL_NULL;
860             *F_VAL_GEOM_TYPE = *Geo::OGRc::F_VAL_GEOM_TYPE;
861             *F_VAL_WIDTH = *Geo::OGRc::F_VAL_WIDTH;
862             *F_VAL_ALLOW_NULL_WHEN_DEFAULT = *Geo::OGRc::F_VAL_ALLOW_NULL_WHEN_DEFAULT;
863             *F_VAL_ALL = *Geo::OGRc::F_VAL_ALL;
864             *OLCRandomRead = *Geo::OGRc::OLCRandomRead;
865             *OLCSequentialWrite = *Geo::OGRc::OLCSequentialWrite;
866             *OLCRandomWrite = *Geo::OGRc::OLCRandomWrite;
867             *OLCFastSpatialFilter = *Geo::OGRc::OLCFastSpatialFilter;
868             *OLCFastFeatureCount = *Geo::OGRc::OLCFastFeatureCount;
869             *OLCFastGetExtent = *Geo::OGRc::OLCFastGetExtent;
870             *OLCCreateField = *Geo::OGRc::OLCCreateField;
871             *OLCDeleteField = *Geo::OGRc::OLCDeleteField;
872             *OLCReorderFields = *Geo::OGRc::OLCReorderFields;
873             *OLCAlterFieldDefn = *Geo::OGRc::OLCAlterFieldDefn;
874             *OLCTransactions = *Geo::OGRc::OLCTransactions;
875             *OLCDeleteFeature = *Geo::OGRc::OLCDeleteFeature;
876             *OLCFastSetNextByIndex = *Geo::OGRc::OLCFastSetNextByIndex;
877             *OLCStringsAsUTF8 = *Geo::OGRc::OLCStringsAsUTF8;
878             *OLCIgnoreFields = *Geo::OGRc::OLCIgnoreFields;
879             *OLCCreateGeomField = *Geo::OGRc::OLCCreateGeomField;
880             *OLCCurveGeometries = *Geo::OGRc::OLCCurveGeometries;
881             *OLCMeasuredGeometries = *Geo::OGRc::OLCMeasuredGeometries;
882             *ODsCCreateLayer = *Geo::OGRc::ODsCCreateLayer;
883             *ODsCDeleteLayer = *Geo::OGRc::ODsCDeleteLayer;
884             *ODsCCreateGeomFieldAfterCreateLayer = *Geo::OGRc::ODsCCreateGeomFieldAfterCreateLayer;
885             *ODsCCurveGeometries = *Geo::OGRc::ODsCCurveGeometries;
886             *ODsCTransactions = *Geo::OGRc::ODsCTransactions;
887             *ODsCEmulatedTransactions = *Geo::OGRc::ODsCEmulatedTransactions;
888             *ODsCMeasuredGeometries = *Geo::OGRc::ODsCMeasuredGeometries;
889             *ODrCCreateDataSource = *Geo::OGRc::ODrCCreateDataSource;
890             *ODrCDeleteDataSource = *Geo::OGRc::ODrCDeleteDataSource;
891             *OLMD_FID64 = *Geo::OGRc::OLMD_FID64;
892             *TermProgress = *Geo::OGRc::TermProgress;
893              
894              
895             package Geo::OGR;
896             our $VERSION = '2.010301'; # this needs to be the same as that in gdal_perl.i
897              
898             sub Driver {
899 17 100   17 0 110 return 'Geo::GDAL::Driver' unless @_;
900 14         42 bless Geo::GDAL::Driver(@_), 'Geo::OGR::Driver';
901             }
902             *GetDriver = *Driver;
903              
904             sub GetDriverNames {
905 0     0 0 0 my @names;
906 0         0 for my $i (0..Geo::GDAL::GetDriverCount()-1) {
907 0         0 my $driver = Geo::GDAL::GetDriver($i);
908 0 0       0 push @names, $driver->Name if $driver->TestCapability('VECTOR');
909             }
910 0         0 return @names;
911             }
912             *DriverNames = *GetDriverNames;
913              
914             sub Drivers {
915 1     1 0 177 my @drivers;
916 1         53 for my $i (0..GetDriverCount()-1) {
917 45         112 my $driver = Geo::GDAL::GetDriver($i);
918 45 100       71 push @drivers, $driver if $driver->TestCapability('VECTOR');
919             }
920 1         3 return @drivers;
921             }
922              
923             sub Open {
924 0     0 0 0 my @p = @_; # name, update
925 0         0 my @flags = qw/VECTOR/;
926 0 0       0 push @flags, qw/UPDATE/ if $p[1];
927 0         0 my $dataset = Geo::GDAL::OpenEx($p[0], \@flags);
928 0 0       0 Geo::GDAL::error("Failed to open $p[0]. Is it a vector dataset?") unless $dataset;
929 0         0 return $dataset;
930             }
931              
932             sub OpenShared {
933 0     0 0 0 my @p = @_; # name, update
934 0         0 my @flags = qw/VECTOR SHARED/;
935 0 0       0 push @flags, qw/UPDATE/ if $p[1];
936 0         0 my $dataset = Geo::GDAL::OpenEx($p[0], \@flags);
937 0 0       0 Geo::GDAL::error("Failed to open $p[0]. Is it a vector dataset?") unless $dataset;
938 0         0 return $dataset;
939             }
940              
941             package Geo::OGR::Driver;
942             our @ISA = qw/Geo::GDAL::Driver/;
943              
944             sub Create {
945 14     14   206 my ($self, $name, $options) = @_; # name, options
946 14   50     64 $options //= {};
947 14         71 $self->SUPER::Create(Name => $name, Width => 0, Height => 0, Bands => 0, Type => 'Byte', Options => $options);
948             }
949              
950             sub Copy {
951 0     0   0 my ($self, @p) = @_; # src, name, options
952 0         0 my $strict = 1; # the default in bindings
953 0 0 0     0 $strict = 0 if $p[2] && $p[2]->{STRICT} eq 'NO';
954 0         0 $self->SUPER::Copy($p[1], $p[0], $strict, @{$p[2..4]}); # path, src, strict, options, cb, cb_data
  0         0  
955             }
956              
957             sub Open {
958 0     0   0 my $self = shift;
959 0         0 my @p = @_; # name, update
960 0         0 my @flags = qw/VECTOR/;
961 0 0       0 push @flags, qw/UPDATE/ if $p[1];
962 0         0 my $dataset = Geo::GDAL::OpenEx($p[0], \@flags, [$self->Name()]);
963 0 0       0 Geo::GDAL::error("Failed to open $p[0]. Is it a vector dataset?") unless $dataset;
964 0         0 return $dataset;
965             }
966              
967              
968             package Geo::OGR::DataSource;
969              
970             *Open = *Geo::OGR::Open;
971             *OpenShared = *Geo::OGR::OpenShared;
972              
973              
974             package Geo::OGR::Layer;
975 19     19   100 use strict;
  19         22  
  19         340  
976 19     19   71 use warnings;
  19         33  
  19         457  
977 19     19   65 use Carp;
  19         18  
  19         848  
978 19     19   64 use Scalar::Util 'blessed';
  19         22  
  19         701  
979 19     19   59 use vars qw /@CAPABILITIES %CAPABILITIES %DEFNS %FEATURES/;
  19         15  
  19         28479  
980             for (keys %Geo::OGR::) {
981             push(@CAPABILITIES, $1), next if /^OLC(\w+)/;
982             }
983             for my $s (@CAPABILITIES) {
984             my $cap = eval "\$Geo::OGR::OLC$s";
985             $CAPABILITIES{$s} = $cap;
986             }
987              
988             sub DESTROY {
989 48     48   1929 my $self = shift;
990 48 100       150 unless ($self->isa('SCALAR')) {
991 24 50       50 return unless $self->isa('HASH');
992 24         22 $self = tied(%{$self});
  24         37  
993 24 50       38 return unless defined $self;
994             }
995 48 50       81 if ($Geo::GDAL::Dataset::RESULT_SET{$self}) {
996 0         0 $Geo::GDAL::Dataset::LAYERS{$self}->_ReleaseResultSet($self);
997 0         0 delete $Geo::GDAL::Dataset::RESULT_SET{$self}
998             }
999 48         31 delete $ITERATORS{$self};
1000 48 50       67 if (exists $OWNER{$self}) {
1001 0         0 delete $OWNER{$self};
1002             }
1003 48         57 $self->RELEASE_PARENTS();
1004             }
1005              
1006             sub RELEASE_PARENTS {
1007 48     48   41 my $self = shift;
1008 48         168 delete $Geo::GDAL::Dataset::LAYERS{$self};
1009             }
1010              
1011             sub Dataset {
1012 5     5   9 my $self = shift;
1013 5         9 return $Geo::GDAL::Dataset::LAYERS{tied(%$self)};
1014             }
1015              
1016             sub Capabilities {
1017 1 50   1   6 return @CAPABILITIES if @_ == 0;
1018 1         1 my $self = shift;
1019 1         2 my @cap;
1020 1         2 for my $cap (@CAPABILITIES) {
1021 18 100       60 push @cap, $cap if _TestCapability($self, $CAPABILITIES{$cap});
1022             }
1023 1         4 return @cap;
1024             }
1025              
1026             sub TestCapability {
1027 0     0   0 my($self, $cap) = @_;
1028 0         0 return _TestCapability($self, $CAPABILITIES{$cap});
1029             }
1030              
1031             sub GetDataSource {
1032 0     0   0 my $self = shift;
1033 0         0 return $Geo::GDAL::Dataset::LAYERS{tied(%$self)};
1034             }
1035             *DataSource = *GetDataSource;
1036              
1037             sub GetDefn {
1038 18     18   19 my $self = shift;
1039 18         96 my $defn = $self->GetLayerDefn;
1040 18         52 $DEFNS{tied(%$defn)} = $self;
1041 18         44 return $defn;
1042             }
1043              
1044             sub CreateField {
1045 21     21   422 my $self = shift;
1046 21         127 my %defaults = ( ApproxOK => 1,
1047             Type => '' );
1048 21         22 my %params;
1049 21 50       67 if (@_ == 0) {
    100          
    50          
1050             } elsif (ref($_[0]) eq 'HASH') {
1051 13         14 %params = %{$_[0]};
  13         36  
1052             } elsif (@_ % 2 == 0) {
1053 8         19 %params = @_;
1054             } else {
1055 0         0 ($params{Defn}) = @_;
1056             }
1057 21         38 for my $k (keys %defaults) {
1058 42   100     115 $params{$k} //= $defaults{$k};
1059             }
1060 21 50 33     153 if (blessed($params{Defn}) and $params{Defn}->isa('Geo::OGR::FieldDefn')) {
    50 33        
1061 0         0 $self->_CreateField($params{Defn}, $params{ApproxOK});
1062             } elsif (blessed($_[0]) and $params{Defn}->isa('Geo::OGR::GeomFieldDefn')) {
1063 0         0 $self->CreateGeomField($params{Defn}, $params{ApproxOK});
1064             } else {
1065 21         24 my $a = $params{ApproxOK};
1066 21         21 delete $params{ApproxOK};
1067 21 100       32 if (exists $params{GeometryType}) {
1068 2         3 $params{Type} = $params{GeometryType};
1069 2         3 delete $params{GeometryType};
1070             }
1071 21 100       57 if (exists $Geo::OGR::FieldDefn::TYPE_STRING2INT{$params{Type}}) {
    50          
1072 15         57 my $fd = Geo::OGR::FieldDefn->new(%params);
1073 15         158 _CreateField($self, $fd, $a);
1074             } elsif (exists $Geo::OGR::Geometry::TYPE_STRING2INT{$params{Type}}) {
1075 6         34 my $fd = Geo::OGR::GeomFieldDefn->new(%params);
1076 6         97 CreateGeomField($self, $fd, $a);
1077             } else {
1078 0         0 Geo::GDAL::error("Invalid field type: $params{Type}.")
1079             }
1080             }
1081             }
1082              
1083             sub AlterFieldDefn {
1084 1     1   737 my $self = shift;
1085 1   50     11 my $index = $self->GetLayerDefn->GetFieldIndex(shift // 0);
1086 1 50       28 my $param = @_ % 2 == 0 ? {@_} : shift;
1087 1 50 33     5 if (blessed($param) and $param->isa('Geo::OGR::FieldDefn')) {
1088 0         0 _AlterFieldDefn($self, $index, @_);
1089             } else {
1090 1         3 my $definition = Geo::OGR::FieldDefn->new($param);
1091 1         1 my $flags = 0;
1092 1 50       3 $flags |= 1 if exists $param->{Name};
1093 1 50       3 $flags |= 2 if exists $param->{Type};
1094 1 50 33     6 $flags |= 4 if exists $param->{Width} or exists $param->{Precision};
1095 1 50       3 $flags |= 8 if exists $param->{Nullable};
1096 1 50       2 $flags |= 16 if exists $param->{Default};
1097 1         13 _AlterFieldDefn($self, $index, $definition, $flags);
1098             }
1099             }
1100              
1101             sub DeleteField {
1102 2     2   529 my ($self, $field) = @_;
1103 2   50     21 my $index = $self->GetLayerDefn->GetFieldIndex($field // 0);
1104 2         5 _DeleteField($self, $index);
1105             }
1106              
1107             sub GetSchema {
1108 7     7   24 my $self = shift;
1109 7 50       14 carp "Schema of a layer should not be set directly." if @_;
1110 7 50 33     15 if (@_ and @_ % 2 == 0) {
1111 0         0 my %schema = @_;
1112 0 0       0 if ($schema{Fields}) {
1113 0         0 for my $field (@{$schema{Fields}}) {
  0         0  
1114 0         0 $self->CreateField($field);
1115             }
1116             }
1117             }
1118 7         12 return $self->GetDefn->Schema;
1119             }
1120             *Schema = *GetSchema;
1121              
1122             sub Row {
1123 1     1   8 my $self = shift;
1124 1         2 my $update = @_ > 0;
1125 1         3 my %row = @_;
1126 1 50       5 my $feature = defined $row{FID} ? $self->GetFeature($row{FID}) : $self->GetNextFeature;
1127 1 50       2 return unless $feature;
1128 1         2 my $ret;
1129 1 50       2 if (defined wantarray) {
1130 0         0 $ret = $feature->Row(@_);
1131             } else {
1132 1         3 $feature->Row(@_);
1133             }
1134 1 50       12 $self->SetFeature($feature) if $update;
1135 1 50       4 return unless defined wantarray;
1136 0         0 return $ret;
1137             }
1138              
1139             sub Tuple {
1140 1     1   5 my $self = shift;
1141 1         2 my $FID = shift;
1142 1 50       4 my $feature = defined $FID ? $self->GetFeature($FID) : $self->GetNextFeature;
1143 1 50       2 return unless $feature;
1144 1         2 my $set = @_ > 0;
1145 1 50       2 unshift @_, $feature->GetFID if $set;
1146 1         1 my @ret;
1147 1 50       2 if (defined wantarray) {
1148 1         3 @ret = $feature->Tuple(@_);
1149             } else {
1150 0         0 $feature->Tuple(@_);
1151             }
1152 1 50       3 $self->SetFeature($feature) if $set;
1153 1 50       3 return unless defined wantarray;
1154 1         3 return @ret;
1155             }
1156              
1157             sub SpatialFilter {
1158 0     0   0 my $self = shift;
1159 0 0       0 $self->SetSpatialFilter($_[0]) if @_ == 1;
1160 0 0       0 $self->SetSpatialFilterRect(@_) if @_ == 4;
1161 0 0       0 return unless defined wantarray;
1162 0         0 $self->GetSpatialFilter;
1163             }
1164              
1165             sub InsertFeature {
1166 9     9   38 my $self = shift;
1167 9         8 my $feature = shift;
1168 9 50       16 Geo::GDAL::error("Usage: \$feature->InsertFeature(reference to a hash or array).") unless ref($feature);
1169 9         15 my $new = Geo::OGR::Feature->new($self->GetDefn);
1170 9 100 0     17 if (ref($feature) eq 'HASH') {
    50          
    0          
1171 6         20 $new->Row(%$feature);
1172             } elsif (ref($feature) eq 'ARRAY') {
1173 3         10 $new->Tuple(@$feature);
1174             } elsif (blessed($feature) and $feature->isa('Geo::OGR::Feature')) {
1175 0         0 $new->Row($feature->Row);
1176             }
1177 8         116 $self->CreateFeature($new);
1178 8 100       22 return unless defined wantarray;
1179 1         3 $FEATURES{tied(%$new)} = $self;
1180 1         4 return $new;
1181             }
1182              
1183             sub GetFeature {
1184 5     5   16 my ($self, $fid) = @_;
1185 5   50     10 $fid //= 0;
1186 5         43 my $f = $self->_GetFeature($fid);
1187 5         59 $FEATURES{tied(%$f)} = $self;
1188 5         10 return $f;
1189             }
1190              
1191             sub ForFeatures {
1192 2     2   350 my $self = shift;
1193 2         3 my $code = shift;
1194 2         3 my $in_place = shift;
1195 2         26 $self->ResetReading;
1196 2         38 while (my $f = $self->GetNextFeature) {
1197 3         7 $FEATURES{tied(%$f)} = $self;
1198 3         7 $code->($f);
1199 3 50       13 $self->SetFeature($f) if $in_place;
1200             };
1201             }
1202              
1203             sub ForGeometries {
1204 0     0   0 my $self = shift;
1205 0         0 my $code = shift;
1206 0         0 my $in_place = shift;
1207 0         0 $self->ResetReading;
1208 0         0 while (my $f = $self->GetNextFeature) {
1209 0         0 my $g = $f->Geometry();
1210 0         0 $code->($g);
1211 0 0       0 if ($in_place) {
1212 0         0 $f->Geometry($g);
1213 0         0 $self->SetFeature($f);
1214             }
1215             }
1216             }
1217              
1218             sub GetFieldNames {
1219 2     2   334 my $self = shift;
1220 2         5 my $d = $self->GetDefn;
1221 2         3 my @ret;
1222 2         12 for (my $i = 0; $i < $d->GetFieldCount; $i++) {
1223 13         17 push @ret, $d->GetFieldDefn($i)->Name();
1224             }
1225 2         9 for (my $i = 0; $i < $d->GetGeomFieldCount; $i++) {
1226 3         5 push @ret, $d->GetGeomFieldDefn($i)->Name();
1227             }
1228 2         6 return @ret;
1229             }
1230              
1231             sub GetFieldDefn {
1232 0     0   0 my $self = shift;
1233 0         0 my $d = $self->GetDefn;
1234 0   0     0 my $field = $d->GetFieldIndex(shift // 0);
1235 0         0 return $d->_GetFieldDefn($field);
1236             }
1237              
1238             sub GetGeomFieldDefn {
1239 0     0   0 my $self = shift;
1240 0         0 my $d = $self->GetDefn;
1241 0   0     0 my $field = $d->GetGeomFieldIndex(shift // 0);
1242 0         0 return $d->_GetGeomFieldDefn($field);
1243             }
1244              
1245             sub GeometryType {
1246 2     2   197 my $self = shift;
1247 2         5 my $d = $self->GetDefn;
1248 2   50     8 my $field = $d->GetGeomFieldIndex(shift // 0);
1249 2         6 my $fd = $d->_GetGeomFieldDefn($field);
1250 2 50       7 return $fd->Type if $fd;
1251             }
1252              
1253             sub SpatialReference {
1254 0     0   0 my $self = shift;
1255 0         0 my $d = $self->GetDefn;
1256 0 0 0     0 my $field = @_ == 2 ? $d->GetGeomFieldIndex(shift // 0) : 0;
1257 0         0 my $sr = shift;
1258 0         0 my $d2 = $d->_GetGeomFieldDefn($field);
1259 0 0       0 $d2->SpatialReference($sr) if defined $sr;
1260 0 0       0 return $d2->SpatialReference() if defined wantarray;
1261             }
1262              
1263              
1264              
1265              
1266             package Geo::OGR::FeatureDefn;
1267 19     19   91 use strict;
  19         19  
  19         332  
1268 19     19   54 use warnings;
  19         14  
  19         400  
1269 19     19   53 use Encode;
  19         16  
  19         1078  
1270 19     19   66 use Carp;
  19         16  
  19         1059  
1271 19     19   66 use Scalar::Util 'blessed';
  19         18  
  19         16994  
1272              
1273             sub RELEASE_PARENTS {
1274 82     82   56 my $self = shift;
1275 82         78 delete $Geo::OGR::Feature::DEFNS{$self};
1276 82         97 delete $Geo::OGR::Layer::DEFNS{$self};
1277             }
1278              
1279             sub Feature {
1280 1     1   6 my $self = shift;
1281 1         4 return $Geo::OGR::Feature::DEFNS{tied(%$self)};
1282             }
1283              
1284              
1285             sub GetFieldIndex {
1286 17     17   19 my ($self, $name) = @_;
1287 17         64 my $index = $self->_GetFieldIndex($name);
1288 17 100 66     69 if ($index < 0 and $name =~ /^\d+$/) {
1289             # the name is allowed to be an index
1290 13 50 33     52 $index = $name if $name >= 0 && $name < $self->GetFieldCount();
1291             }
1292 17 50       26 Geo::GDAL::error("'$name' is not a non-spatial field.") if $index < 0;
1293 17         21 return $index;
1294             }
1295              
1296             sub GetGeomFieldIndex {
1297 16     16   17 my ($self, $name) = @_;
1298 16         70 my $index = $self->_GetGeomFieldIndex($name);
1299 16 100 66     83 if ($index < 0 and $name =~ /^\d+$/) {
1300             # the name is allowed to be an index
1301 15 50 33     85 $index = $name if $name >= 0 && $name < $self->GetGeomFieldCount();
1302             }
1303 16 50       28 Geo::GDAL::error("'$name' is not a spatial field.") if $index < 0;
1304 16         21 return $index;
1305             }
1306              
1307             *Name = *GetName;
1308              
1309             sub GetSchema {
1310 8     8   11 my $self = shift;
1311 8 50       14 carp "Schema of a feature definition should not be set directly." if @_;
1312 8 50 33     15 if (@_ and @_ % 2 == 0) {
1313 0         0 my %schema = @_;
1314 0 0       0 if ($schema{Fields}) {
1315 0         0 for my $field (@{$schema{Fields}}) {
  0         0  
1316 0         0 $self->AddField($field);
1317             }
1318             }
1319             }
1320 8         8 my %schema;
1321 8         45 $schema{Name} = $self->Name();
1322 8         17 $schema{StyleIgnored} = $self->StyleIgnored();
1323 8         11 $schema{Fields} = [];
1324 8         35 for my $i (0..$self->GetFieldCount-1) {
1325 9         46 my $s = $self->_GetFieldDefn($i)->Schema;
1326 9         15 push @{$schema{Fields}}, $s;
  9         22  
1327             }
1328 8         39 for my $i (0..$self->GetGeomFieldCount-1) {
1329 10         53 my $s = $self->_GetGeomFieldDefn($i)->Schema;
1330 10         16 push @{$schema{Fields}}, $s;
  10         19  
1331             }
1332 8 50       23 return wantarray ? %schema : \%schema;
1333             }
1334             *Schema = *GetSchema;
1335              
1336             sub AddField {
1337 1     1   1 my $self = shift;
1338 1 50 33     6 Geo::GDAL::error("Read-only definition.") if $Geo::OGR::Feature::DEFNS{tied(%$self)} || $Geo::OGR::Layer::DEFNS{tied(%$self)};
1339 1         6 my %params;
1340 1 50       9 if (@_ == 0) {
    50          
    50          
1341             } elsif (ref($_[0]) eq 'HASH') {
1342 0         0 %params = %{$_[0]};
  0         0  
1343             } elsif (@_ % 2 == 0) {
1344 1         2 %params = @_;
1345             }
1346 1   50     3 $params{Type} //= '';
1347 1 50       5 if (exists $Geo::OGR::FieldDefn::TYPE_STRING2INT{$params{Type}}) {
1348 0         0 my $fd = Geo::OGR::FieldDefn->new(%params);
1349 0         0 $self->AddFieldDefn($fd);
1350             } else {
1351 1         4 my $fd = Geo::OGR::GeomFieldDefn->new(%params);
1352 1         8 $self->AddGeomFieldDefn($fd);
1353             }
1354             }
1355              
1356             sub DeleteField {
1357 0     0   0 my ($self, $name) = @_;
1358 0 0 0     0 Geo::GDAL::error("Read-only definition.") if $Geo::OGR::Feature::DEFNS{tied(%$self)} || $Geo::OGR::Layer::DEFNS{tied(%$self)};
1359 0         0 for my $i (0..$self->GetFieldCount-1) {
1360 0 0       0 Geo::GDAL::error("Non-spatial fields cannot be deleted.") if $self->_GetFieldDefn($i)->Name eq $name;
1361             }
1362 0         0 for my $i (0..$self->GetGeomFieldCount-1) {
1363 0 0       0 $self->DeleteGeomFieldDefn($i) if $self->_GetGeomFieldDefn($i)->Name eq $name;
1364             }
1365 0         0 Geo::GDAL::error(2, $name, 'Field');
1366             }
1367              
1368             sub GetFieldNames {
1369 0     0   0 my $self = shift;
1370 0         0 my @names = ();
1371 0         0 for my $i (0..$self->GetFieldCount-1) {
1372 0         0 push @names, $self->_GetFieldDefn($i)->Name;
1373             }
1374 0         0 for my $i (0..$self->GetGeomFieldCount-1) {
1375 0         0 push @names, $self->_GetGeomFieldDefn($i)->Name;
1376             }
1377 0         0 return @names;
1378             }
1379              
1380             sub GetFieldDefn {
1381 13     13   6 my $self = shift;
1382 13         16 my $field = $self->GetFieldIndex(shift);
1383 13         44 return $self->_GetFieldDefn($field);
1384             }
1385              
1386             sub GetGeomFieldDefn {
1387 14     14   12 my $self = shift;
1388 14         24 my $field = $self->GetGeomFieldIndex(shift);
1389 14         66 return $self->_GetGeomFieldDefn($field);
1390             }
1391              
1392             sub GeomType {
1393 2     2   3 my ($self, $type) = @_;
1394 2 50 33     13 Geo::GDAL::error("Read-only definition.") if $Geo::OGR::Feature::DEFNS{tied(%$self)} || $Geo::OGR::Layer::DEFNS{tied(%$self)};
1395 2 50       4 if (defined $type) {
1396 2         8 $type = Geo::GDAL::string2int($type, \%Geo::OGR::Geometry::TYPE_STRING2INT);
1397 2         25 SetGeomType($self, $type);
1398             }
1399 2 50       5 return $Geo::OGR::Geometry::TYPE_INT2STRING{GetGeomType($self)} if defined wantarray;
1400             }
1401             *GeometryType = *GeomType;
1402              
1403             sub GeometryIgnored {
1404 0     0   0 my $self = shift;
1405 0 0       0 SetGeometryIgnored($self, $_[0]) if @_;
1406 0 0       0 IsGeometryIgnored($self) if defined wantarray;
1407             }
1408              
1409             sub StyleIgnored {
1410 8     8   7 my $self = shift;
1411 8 50       13 SetStyleIgnored($self, $_[0]) if @_;
1412 8 50       50 IsStyleIgnored($self) if defined wantarray;
1413             }
1414              
1415              
1416              
1417              
1418             package Geo::OGR::Feature;
1419 19     19   85 use strict;
  19         19  
  19         383  
1420 19     19   53 use warnings;
  19         24  
  19         454  
1421 19     19   57 use vars qw /%GEOMETRIES %DEFNS/;
  19         17  
  19         786  
1422 19     19   63 use Carp;
  19         18  
  19         668  
1423 19     19   59 use Encode;
  19         18  
  19         1015  
1424 19     19   71 use Scalar::Util 'blessed';
  19         24  
  19         36405  
1425              
1426              
1427             sub RELEASE_PARENTS {
1428 44     44   37 my $self = shift;
1429 44         54 delete $Geo::OGR::Layer::FEATURES{$self};
1430             }
1431              
1432             sub Layer {
1433 5     5   9 my $self = shift;
1434 5         15 return $Geo::OGR::Layer::FEATURES{tied(%$self)};
1435             }
1436              
1437             sub FETCH {
1438 9     9   825 my $self = shift;
1439 9         12 my $field = shift;
1440 9         12 eval {my $i = $self->GetFieldIndex($field)};
  9         15  
1441 9 100       198 return $self->GetField($field) unless $@;
1442 2         7 Geo::GDAL::error("'$field' is not a non-spatial field and it is not safe to retrieve geometries from a feature this way.");
1443             }
1444              
1445             sub STORE {
1446 4     4   674 my $self = shift;
1447 4         5 my $field = shift;
1448 4         5 eval {my $i = $self->GetFieldIndex($field)};
  4         7  
1449 4 100       200 unless ($@) {
1450 2         7 $self->SetField($field, @_);
1451             } else {
1452 2         6 $self->Geometry($field, @_);
1453             }
1454             }
1455              
1456             sub FID {
1457 0     0   0 my $self = shift;
1458 0 0       0 $self->SetFID($_[0]) if @_;
1459 0 0       0 return unless defined wantarray;
1460 0         0 $self->GetFID;
1461             }
1462              
1463             sub GetFieldIndex {
1464 101     101   856 my ($self, $name) = @_;
1465 101         353 my $index = $self->_GetFieldIndex($name);
1466 101 100 100     411 if ($index < 0 and $name =~ /^\d+$/) {
1467             # the name is allowed to be an index
1468 61 100 66     266 $index = $name if $name >= 0 && $name < $self->GetFieldCount();
1469             }
1470 101 100       149 Geo::GDAL::error("'$name' is not a non-spatial field.") if $index < 0;
1471 95         109 return $index;
1472             }
1473              
1474             sub GetGeomFieldIndex {
1475 24     24   26 my ($self, $name) = @_;
1476 24         93 my $index = $self->_GetGeomFieldIndex($name);
1477 24 100 100     124 if ($index < 0 and $name =~ /^\d+$/) {
1478             # the name is allowed to be an index
1479 19 50 33     120 $index = $name if $name >= 0 && $name < $self->GetGeomFieldCount();
1480             }
1481 24 100       42 Geo::GDAL::error("'$name' is not a spatial field.") if $index < 0;
1482 23         41 return $index;
1483             }
1484              
1485             sub GetFieldDefn {
1486 0     0   0 my $self = shift;
1487 0         0 my $field = $self->GetFieldIndex(shift);
1488 0         0 return $self->GetFieldDefnRef($field);
1489             }
1490              
1491             sub GetGeomFieldDefn {
1492 0     0   0 my $self = shift;
1493 0         0 my $field = $self->GetGeomFieldIndex(shift);
1494 0         0 return $self->GetGeomFieldDefnRef($field);
1495             }
1496              
1497             sub StyleString {
1498 0     0   0 my $self = shift;
1499 0 0       0 $self->SetStyleString($_[0]) if @_;
1500 0 0       0 return unless defined wantarray;
1501 0         0 $self->GetStyleString;
1502             }
1503              
1504             sub Validate {
1505 0     0   0 my $self = shift;
1506 0         0 my $flags = 0;
1507 0         0 for my $flag (@_) {
1508 0         0 my $f = eval '$Geo::OGR::'.uc($flag);
1509 0         0 $flags |= $f;
1510             }
1511 0         0 _Validate($self, $flags);
1512             }
1513              
1514             sub GetSchema {
1515 0     0   0 my $self = shift;
1516 0 0       0 Geo::GDAL::error("Schema of a feature cannot be set directly.") if @_;
1517 0         0 return $self->GetDefnRef->Schema;
1518             }
1519             *Schema = *GetSchema;
1520              
1521             sub Row {
1522 10     10   12 my $self = shift;
1523 10         35 my $nf = $self->GetFieldCount;
1524 10         23 my $ngf = $self->GetGeomFieldCount;
1525 10 100       18 if (@_) { # update
1526 7         8 my %row;
1527 7 50 33     44 if (@_ == 1 and ref($_[0]) eq 'HASH') {
    50 33        
1528 0         0 %row = %{$_[0]};
  0         0  
1529             } elsif (@_ and @_ % 2 == 0) {
1530 7         19 %row = @_;
1531             } else {
1532 0         0 Geo::GDAL::error('Usage: $feature->Row(%FeatureData).');
1533             }
1534 7 100       18 $self->SetFID($row{FID}) if defined $row{FID};
1535             #$self->Geometry($schema, $row{Geometry}) if $row{Geometry};
1536 7         16 for my $name (keys %row) {
1537 12 100       27 next if $name eq 'FID';
1538 11 100       16 if ($name eq 'Geometry') {
1539 3         6 $self->Geometry(0, $row{$name});
1540 3         5 next;
1541             }
1542 8         8 my $f = 0;
1543 8         16 for my $i (0..$nf-1) {
1544 11 100       46 if ($self->GetFieldDefnRef($i)->Name eq $name) {
1545 7         16 $self->SetField($i, $row{$name});
1546 7         7 $f = 1;
1547 7         9 last;
1548             }
1549             }
1550 8 100       15 next if $f;
1551 1         3 for my $i (0..$ngf-1) {
1552 1 50       7 if ($self->GetGeomFieldDefnRef($i)->Name eq $name) {
1553 1         4 $self->Geometry($i, $row{$name});
1554 1         1 $f = 1;
1555 1         2 last;
1556             }
1557             }
1558 1 50       2 next if $f;
1559 0         0 carp "Unknown field: '$name'.";
1560             }
1561             }
1562 10 100       19 return unless defined wantarray;
1563 3         5 my %row = ();
1564 3         5 for my $i (0..$nf-1) {
1565 7         24 my $name = $self->GetFieldDefnRef($i)->Name;
1566 7         9 $row{$name} = $self->GetField($i);
1567             }
1568 3         7 for my $i (0..$ngf-1) {
1569 3   100     17 my $name = $self->GetGeomFieldDefnRef($i)->Name || 'Geometry';
1570 3         6 $row{$name} = $self->GetGeometry($i);
1571             }
1572 3         17 $row{FID} = $self->GetFID;
1573 3         6 return \%row;
1574             }
1575              
1576             sub Tuple {
1577 7     7   394 my $self = shift;
1578 7         35 my $nf = $self->GetFieldCount;
1579 7         22 my $ngf = $self->GetGeomFieldCount;
1580 7 100       12 if (@_) {
1581 3         4 my $FID;
1582 3 100       6 $FID = shift if @_ == $nf + $ngf + 1;
1583 3 100       18 $self->SetFID($FID) if defined $FID;
1584 3         3 my $values = \@_;
1585 3 100       8 if (@$values != $nf + $ngf) {
1586 1         1 my $n = $nf + $ngf;
1587 1         6 Geo::GDAL::error("Too many or too few attribute values for a feature (need $n).");
1588             }
1589 2         2 my $index = 0; # index to non-geometry and geometry fields
1590 2         7 for my $i (0..$nf-1) {
1591 2         7 $self->SetField($i, $values->[$i]);
1592             }
1593 2         11 for my $i (0..$ngf-1) {
1594 2         8 $self->Geometry($i, $values->[$nf+$i]);
1595             }
1596             }
1597 6 100       11 return unless defined wantarray;
1598 4         26 my @ret = ($self->GetFID);
1599 4         9 for my $i (0..$nf-1) {
1600 10         11 my $v = $self->GetField($i);
1601 10         14 push @ret, $v;
1602             }
1603 4         8 for my $i (0..$ngf-1) {
1604 4         5 my $v = $self->GetGeometry($i);
1605 4         7 push @ret, $v;
1606             }
1607 4         12 return @ret;
1608             }
1609              
1610             sub GetDefn {
1611 14     14   13 my $self = shift;
1612 14         66 my $defn = $self->GetDefnRef;
1613 14         33 $DEFNS{tied(%$defn)} = $self;
1614 14         29 return $defn;
1615             }
1616              
1617             *GetFieldNames = *Geo::OGR::Layer::GetFieldNames;
1618              
1619             sub GetField {
1620 40     40   38 my ($self, $field) = @_;
1621 40         50 $field = $self->GetFieldIndex($field);
1622 40 100       130 return unless IsFieldSet($self, $field);
1623 29         62 my $type = GetFieldType($self, $field);
1624 29 100       46 if ($type == $Geo::OGR::OFTInteger) {
1625 13         88 return GetFieldAsInteger($self, $field);
1626             }
1627 16 100       27 if ($type == $Geo::OGR::OFTInteger64) {
1628 1         9 return GetFieldAsInteger64($self, $field);
1629             }
1630 15 100       20 if ($type == $Geo::OGR::OFTReal) {
1631 2         20 return GetFieldAsDouble($self, $field);
1632             }
1633 13 100       18 if ($type == $Geo::OGR::OFTString) {
1634 4         35 return GetFieldAsString($self, $field);
1635             }
1636 9 100       10 if ($type == $Geo::OGR::OFTIntegerList) {
1637 1         6 my $ret = GetFieldAsIntegerList($self, $field);
1638 1 50       9 return wantarray ? @$ret : $ret;
1639             }
1640 8 100       13 if ($type == $Geo::OGR::OFTInteger64List) {
1641 1         9 my $ret = GetFieldAsInteger64List($self, $field);
1642 1 50       5 return wantarray ? @$ret : $ret;
1643             }
1644 7 100       9 if ($type == $Geo::OGR::OFTRealList) {
1645 1         8 my $ret = GetFieldAsDoubleList($self, $field);
1646 1 50       5 return wantarray ? @$ret : $ret;
1647             }
1648 6 100       10 if ($type == $Geo::OGR::OFTStringList) {
1649 1         8 my $ret = GetFieldAsStringList($self, $field);
1650 1 50       5 return wantarray ? @$ret : $ret;
1651             }
1652 5 100       9 if ($type == $Geo::OGR::OFTBinary) {
1653 2         12 return GetFieldAsBinary($self, $field);
1654             }
1655 3 100       6 if ($type == $Geo::OGR::OFTDate) {
1656 1         9 my @ret = GetFieldAsDateTime($self, $field);
1657             # year, month, day, hour, minute, second, timezone
1658 1 50       7 return wantarray ? @ret[0..2] : [@ret[0..2]];
1659             }
1660 2 100       3 if ($type == $Geo::OGR::OFTTime) {
1661 1         5 my @ret = GetFieldAsDateTime($self, $field);
1662 1 50       5 return wantarray ? @ret[3..6] : [@ret[3..6]];
1663             }
1664 1 50       3 if ($type == $Geo::OGR::OFTDateTime) {
1665 1         26 my @ret = GetFieldAsDateTime($self, $field);
1666 1 50       7 return wantarray ? @ret : [@ret];
1667             }
1668 0         0 Geo::GDAL::error("Perl bindings do not support field type '$Geo::OGR::FieldDefn::TYPE_INT2STRING{$type}'.");
1669             }
1670              
1671             sub UnsetField {
1672 0     0   0 my ($self, $field) = @_;
1673 0         0 $field = $self->GetFieldIndex($field);
1674 0         0 _UnsetField($self, $field);
1675             }
1676              
1677             sub SetField {
1678 25     25   19 my $self = shift;
1679 25         35 my $field = $self->GetFieldIndex(shift);
1680 25         28 my $arg = $_[0];
1681 25 100 66     89 if (@_ == 0 or !defined($arg)) {
1682 1         7 _UnsetField($self, $field);
1683 1         1 return;
1684             }
1685 24 50       35 $arg = [@_] if @_ > 1;
1686 24         87 my $type = $self->GetFieldType($field);
1687 24 100       37 if (ref($arg)) {
1688 7 100       32 if ($type == $Geo::OGR::OFTIntegerList) {
    100          
    100          
    100          
    100          
    100          
    50          
    0          
1689 1         7 SetFieldIntegerList($self, $field, $arg);
1690             }
1691             elsif ($type == $Geo::OGR::OFTInteger64List) {
1692 1         8 SetFieldInteger64List($self, $field, $arg);
1693             }
1694             elsif ($type == $Geo::OGR::OFTRealList) {
1695 1         11 SetFieldDoubleList($self, $field, $arg);
1696             }
1697             elsif ($type == $Geo::OGR::OFTStringList) {
1698 1         17 SetFieldStringList($self, $field, $arg);
1699             }
1700             elsif ($type == $Geo::OGR::OFTDate) {
1701 1         16 _SetField($self, $field, @$arg[0..2], 0, 0, 0, 0);
1702             }
1703             elsif ($type == $Geo::OGR::OFTTime) {
1704 1   50     3 $arg->[3] //= 0;
1705 1         5 _SetField($self, $field, 0, 0, 0, @$arg[0..3]);
1706             }
1707             elsif ($type == $Geo::OGR::OFTDateTime) {
1708 1   50     3 $arg->[6] //= 0;
1709 1         6 _SetField($self, $field, @$arg[0..6]);
1710             }
1711             elsif ($type == $Geo::OGR::OFTInteger64)
1712             {
1713 0         0 SetFieldInteger64($self, $field, $arg);
1714             }
1715             else {
1716 0         0 $type = $Geo::OGR::FieldDefn::TYPE_INT2STRING{$type};
1717 0         0 Geo::GDAL::error("Expected one non-reference argument for this field of type '$type'.");
1718             }
1719             } else {
1720 17 100 100     97 if ($type == $Geo::OGR::OFTBinary) {
    100 66        
    50          
1721             #$arg = unpack('H*', $arg); # remove when SetFieldBinary is available
1722 1         6 $self->SetFieldBinary($field, $arg);
1723             }
1724             elsif ($type == $Geo::OGR::OFTInteger64)
1725             {
1726 1         9 SetFieldInteger64($self, $field, $arg);
1727             }
1728             elsif ($type == $Geo::OGR::OFTInteger or $type == $Geo::OGR::OFTReal or $type == $Geo::OGR::OFTString)
1729             {
1730 15         212 _SetField($self, $field, $arg);
1731             }
1732             else {
1733 0         0 $type = $Geo::OGR::FieldDefn::TYPE_INT2STRING{$type};
1734 0         0 Geo::GDAL::error("Expected more than one argument or a reference argument for this field of type '$type'.");
1735             }
1736             }
1737             }
1738              
1739             sub Field {
1740 19     19   2997 my $self = shift;
1741 19   50     58 my $field = $self->GetFieldIndex(shift // 0);
1742 19 100       38 $self->SetField($field, @_) if @_;
1743 19 100       43 $self->GetField($field) if defined wantarray;
1744             }
1745              
1746             sub Geometry {
1747 24     24   602 my $self = shift;
1748 24 100 66     120 my $field = ((@_ > 0 and ref($_[0]) eq '') or (@_ > 2 and @_ % 2 == 1)) ? shift : 0;
1749 24         43 $field = $self->GetGeomFieldIndex($field);
1750 23         19 my $geometry;
1751 23 50 66     69 if (@_ and @_ % 2 == 0) {
1752 0         0 %$geometry = @_;
1753             } else {
1754 23         24 $geometry = shift;
1755             }
1756 23 100       36 if ($geometry) {
1757 11         20 my $type = $self->GetDefn->GetGeomFieldDefn($field)->Type;
1758 11 100 66     34 if (blessed($geometry) and $geometry->isa('Geo::OGR::Geometry')) {
    50          
1759 4         10 my $gtype = $geometry->GeometryType;
1760 4 50 33     33 Geo::GDAL::error("The type of the inserted geometry ('$gtype') is not the same as the type of the field ('$type').")
1761             if $type ne 'Unknown' and $type ne $gtype;
1762 4         4 eval {
1763 4         69 $self->SetGeomFieldDirectly($field, $geometry->Clone);
1764             };
1765 4 50       6 confess Geo::GDAL->last_error if $@;
1766             } elsif (ref($geometry) eq 'HASH') {
1767 7   33     37 $geometry->{GeometryType} //= $type;
1768 7         10 eval {
1769 7         40 $geometry = Geo::OGR::Geometry->new($geometry);
1770             };
1771 7         19 my $gtype = $geometry->GeometryType;
1772 7 50 33     33 Geo::GDAL::error("The type of the inserted geometry ('$gtype') is not the same as the type of the field ('$type').")
1773             if $type ne 'Unknown' and $type ne $gtype;
1774 7         8 eval {
1775 7         62 $self->SetGeomFieldDirectly($field, $geometry);
1776             };
1777 7 50       16 confess Geo::GDAL->last_error if $@;
1778             } else {
1779 0         0 Geo::GDAL::error("Usage: \$feature->Geometry([field],[geometry])");
1780             }
1781             }
1782 23 100       56 return unless defined wantarray;
1783 16         110 $geometry = $self->GetGeomFieldRef($field);
1784 16 50       35 return unless $geometry;
1785 16         54 $GEOMETRIES{tied(%$geometry)} = $self;
1786 16         52 return $geometry;
1787             }
1788             *GetGeometry = *Geometry;
1789             *SetGeometry = *Geometry;
1790              
1791             sub SetFrom {
1792 0     0   0 my($self, $other) = @_;
1793 0 0       0 _SetFrom($self, $other), return if @_ <= 2;
1794 0         0 my $forgiving = $_[2];
1795 0 0       0 _SetFrom($self, $other, $forgiving), return if @_ <= 3;
1796 0         0 my $map = $_[3];
1797 0         0 my @list;
1798 0         0 for my $i (1..GetFieldCount($self)) {
1799 0   0     0 push @list, ($map->{$i} || -1);
1800             }
1801 0         0 SetFromWithMap($self, $other, 1, \@list);
1802             }
1803              
1804              
1805              
1806              
1807             package Geo::OGR::FieldDefn;
1808 19     19   89 use strict;
  19         25  
  19         306  
1809 19     19   55 use warnings;
  19         20  
  19         571  
1810 19         1320 use vars qw /
1811             %SCHEMA_KEYS
1812             @TYPES @SUB_TYPES @JUSTIFY_VALUES
1813             %TYPE_STRING2INT %TYPE_INT2STRING
1814             %SUB_TYPE_STRING2INT %SUB_TYPE_INT2STRING
1815             %JUSTIFY_STRING2INT %JUSTIFY_INT2STRING
1816 19     19   56 /;
  19         22  
1817 19     19   65 use Carp;
  19         22  
  19         702  
1818 19     19   62 use Encode;
  19         20  
  19         14291  
1819             %SCHEMA_KEYS = map {$_ => 1} qw/Name Type SubType Justify Width Precision Nullable Default Ignored/;
1820             for (keys %Geo::OGR::) {
1821             push(@TYPES, $1), next if /^OFT(\w+)/;
1822             push(@SUB_TYPES, $1), next if /^OFST(\w+)/;
1823             push(@JUSTIFY_VALUES, $1), next if /^OJ(\w+)/;
1824             }
1825             for my $string (@TYPES) {
1826             my $int = eval "\$Geo::OGR::OFT$string";
1827             $TYPE_STRING2INT{$string} = $int;
1828             $TYPE_INT2STRING{$int} = $string;
1829             }
1830             for my $string (@SUB_TYPES) {
1831             my $int = eval "\$Geo::OGR::OFST$string";
1832             $SUB_TYPE_STRING2INT{$string} = $int;
1833             $SUB_TYPE_INT2STRING{$int} = $string;
1834             }
1835             for my $string (@JUSTIFY_VALUES) {
1836             my $int = eval "\$Geo::OGR::OJ$string";
1837             $JUSTIFY_STRING2INT{$string} = $int;
1838             $JUSTIFY_INT2STRING{$int} = $string;
1839             }
1840              
1841             sub Types {
1842 0     0   0 return @TYPES;
1843             }
1844              
1845             sub SubTypes {
1846 0     0   0 return @SUB_TYPES;
1847             }
1848              
1849             sub JustifyValues {
1850 0     0   0 return @JUSTIFY_VALUES;
1851             }
1852              
1853             sub Schema {
1854 42     42   35 my $self = shift;
1855 42 100       74 if (@_) {
1856 33 100       51 my $params = @_ % 2 == 0 ? {@_} : shift;
1857 33         74 for my $key (keys %SCHEMA_KEYS) {
1858 297 100       360 next unless exists $params->{$key};
1859 1         52 eval "\$self->$key(\$params->{$key})";
1860 1 50       4 confess(Geo::GDAL->last_error()) if $@;
1861             }
1862             }
1863 42 100       84 return unless defined wantarray;
1864 10         16 my %schema = ();
1865 10         24 for my $key (keys %SCHEMA_KEYS) {
1866 90         2817 $schema{$key} = eval '$self->'.$key;
1867             }
1868 10 50       25 return wantarray ? %schema : \%schema;
1869             }
1870             *GetSchema = *Schema;
1871             *SetSchema = *Schema;
1872              
1873             sub Name {
1874 41     41   33 my $self = shift;
1875 41 50       60 SetName($self, $_[0]) if @_;
1876 41 50       250 GetName($self) if defined wantarray;
1877             }
1878              
1879             sub Type {
1880 10     10   10 my($self, $type) = @_;
1881 10 50       18 if (defined $type) {
1882 0 0       0 Geo::GDAL::error(1, $type, \%TYPE_STRING2INT) unless exists $TYPE_STRING2INT{$type};
1883 0         0 $type = $TYPE_STRING2INT{$type};
1884 0         0 SetType($self, $type);
1885             }
1886 10 50       101 return $TYPE_INT2STRING{GetType($self)} if defined wantarray;
1887             }
1888              
1889             sub SubType {
1890 10     10   12 my($self, $sub_type) = @_;
1891 10 50       19 if (defined $sub_type) {
1892 0 0       0 Geo::GDAL::error(1, $sub_type, \%SUB_TYPE_STRING2INT) unless exists $SUB_TYPE_STRING2INT{$sub_type};
1893 0         0 $sub_type = $SUB_TYPE_STRING2INT{$sub_type};
1894 0         0 SetSubType($self, $sub_type);
1895             }
1896 10 50       105 return $SUB_TYPE_INT2STRING{GetSubType($self)} if defined wantarray;
1897             }
1898              
1899             sub Justify {
1900 10     10   12 my($self, $justify) = @_;
1901 10 50       20 if (defined $justify) {
1902 0 0       0 Geo::GDAL::error(1, $justify, \%JUSTIFY_STRING2INT) unless exists $JUSTIFY_STRING2INT{$justify};
1903 0 0       0 $justify = $JUSTIFY_STRING2INT{$justify} if exists $JUSTIFY_STRING2INT{$justify};
1904 0         0 SetJustify($self, $justify);
1905             }
1906 10 50       110 return $JUSTIFY_INT2STRING{GetJustify($self)} if defined wantarray;
1907             }
1908              
1909             sub Width {
1910 11     11   10 my $self = shift;
1911 11 100       23 SetWidth($self, $_[0]) if @_;
1912 11 100       102 GetWidth($self) if defined wantarray;
1913             }
1914              
1915             sub Precision {
1916 10     10   10 my $self = shift;
1917 10 50       19 SetPrecision($self, $_[0]) if @_;
1918 10 50       106 GetPrecision($self) if defined wantarray;
1919             }
1920              
1921             sub Nullable {
1922 10     10   10 my $self = shift;
1923 10 50       20 SetNullable($self, $_[0]) if @_;
1924 10 50       90 IsNullable($self) if defined wantarray;
1925             }
1926              
1927             sub Default {
1928 10     10   12 my $self = shift;
1929 10 50       18 SetDefault($self, $_[0]) if @_;
1930 10 50       118 GetDefault($self) if defined wantarray;
1931             }
1932              
1933             sub Ignored {
1934 10     10   12 my $self = shift;
1935 10 50       19 SetIgnored($self, $_[0]) if @_;
1936 10 50       99 IsIgnored($self) if defined wantarray;
1937             }
1938              
1939              
1940              
1941              
1942             package Geo::OGR::GeomFieldDefn;
1943 19     19   87 use strict;
  19         24  
  19         302  
1944 19     19   58 use warnings;
  19         21  
  19         442  
1945 19     19   53 use vars qw / %SCHEMA_KEYS /;
  19         20  
  19         561  
1946 19     19   59 use Carp;
  19         20  
  19         738  
1947 19     19   60 use Scalar::Util 'blessed';
  19         21  
  19         6955  
1948             %SCHEMA_KEYS = map {$_ => 1} qw/Name Type SpatialReference Nullable Ignored/;
1949              
1950             sub Schema {
1951 20     20   21 my $self = shift;
1952 20 100       39 if (@_) {
1953 10 50       23 my $params = @_ % 2 == 0 ? {@_} : shift;
1954 10         28 for my $key (keys %SCHEMA_KEYS) {
1955 50 50       79 next unless exists $params->{$key};
1956 0         0 eval "\$self->$key(\$params->{$key})";
1957 0 0       0 confess Geo::GDAL->last_error() if $@;
1958             }
1959             }
1960 20 100       39 return unless defined wantarray;
1961 10         14 my %schema = ();
1962 10         22 for my $key (keys %SCHEMA_KEYS) {
1963 50         1514 $schema{$key} = eval '$self->'.$key;
1964             }
1965 10 50       27 return wantarray ? %schema : \%schema;
1966             }
1967             *GetSchema = *Schema;
1968             *SetSchema = *Schema;
1969              
1970             sub Name {
1971 17     17   19 my $self = shift;
1972 17 50       42 SetName($self, $_[0]) if @_;
1973 17 50       173 GetName($self) if defined wantarray;
1974             }
1975              
1976             sub Type {
1977 23     23   27 my($self, $type) = @_;
1978 23 50       39 if (defined $type) {
1979 0         0 $type = Geo::GDAL::string2int($type, \%Geo::OGR::Geometry::TYPE_STRING2INT);
1980 0         0 SetType($self, $type);
1981             }
1982 23 50       218 $Geo::OGR::Geometry::TYPE_INT2STRING{GetType($self)} if defined wantarray;
1983             }
1984             *GeometryType = *Type;
1985              
1986             sub Types {
1987 0     0   0 return @Geo::OGR::Geometry::GEOMETRY_TYPES;
1988             }
1989              
1990             sub SpatialReference {
1991 10     10   11 my $self = shift;
1992 10 50       20 SetSpatialRef($self, $_[0]) if @_;
1993 10 50       100 GetSpatialRef($self) if defined wantarray;
1994             }
1995              
1996             sub Nullable {
1997 10     10   9 my $self = shift;
1998 10 50       22 SetNullable($self, $_[0]) if @_;
1999 10 50       115 IsNullable($self) if defined wantarray;
2000             }
2001              
2002             sub Ignored {
2003 10     10   13 my $self = shift;
2004 10 50       19 SetIgnored($self, $_[0]) if @_;
2005 10 50       114 IsIgnored($self) if defined wantarray;
2006             }
2007              
2008              
2009              
2010              
2011             package Geo::OGR::Geometry;
2012 19     19   80 use strict;
  19         21  
  19         297  
2013 19     19   53 use warnings;
  19         15  
  19         374  
2014 19     19   51 use Carp;
  19         23  
  19         851  
2015 19         39790 use vars qw /
2016             @BYTE_ORDER_TYPES @GEOMETRY_TYPES
2017             %BYTE_ORDER_STRING2INT %BYTE_ORDER_INT2STRING
2018             %TYPE_STRING2INT %TYPE_INT2STRING
2019 19     19   74 /;
  19         24  
2020             @BYTE_ORDER_TYPES = qw/XDR NDR/;
2021             for my $string (@BYTE_ORDER_TYPES) {
2022             my $int = eval "\$Geo::OGR::wkb$string";
2023             $BYTE_ORDER_STRING2INT{$string} = $int;
2024             $BYTE_ORDER_INT2STRING{$int} = $string;
2025             }
2026             for (keys %Geo::OGR::) {
2027             next if /^wkb25/;
2028             next if /^wkb.DR/;
2029             push(@GEOMETRY_TYPES, $1), next if /^wkb(\w+)/;
2030             }
2031             for my $string (@GEOMETRY_TYPES) {
2032             my $int = eval "\$Geo::OGR::wkb$string";
2033             $TYPE_STRING2INT{$string} = $int;
2034             if ($string =~ /25D/) {
2035             my $s = $string;
2036             $s =~ s/25D/Z/;
2037             $TYPE_STRING2INT{$s} = $int;
2038             }
2039             $TYPE_INT2STRING{$int} = $string;
2040             }
2041              
2042             sub ByteOrders {
2043 0     0   0 return @BYTE_ORDER_TYPES;
2044             }
2045              
2046             sub GeometryTypes {
2047 0     0   0 return @GEOMETRY_TYPES;
2048             }
2049              
2050             sub RELEASE_PARENTS {
2051 104     104   71 my $self = shift;
2052 104         121 delete $Geo::OGR::Feature::GEOMETRIES{$self};
2053             }
2054              
2055             sub Feature {
2056 1     1   324 my $self = shift;
2057 1         4 return $Geo::OGR::Feature::GEOMETRIES{tied(%$self)};
2058             }
2059              
2060             sub ApproximateArcAngles {
2061 0     0   0 my %p = @_;
2062 0         0 my %default = ( Center => [0,0,0],
2063             PrimaryRadius => 1,
2064             SecondaryAxis => 1,
2065             Rotation => 0,
2066             StartAngle => 0,
2067             EndAngle => 360,
2068             MaxAngleStepSizeDegrees => 4
2069             );
2070 0         0 for my $p (keys %p) {
2071 0 0       0 if (exists $default{$p}) {
2072 0   0     0 $p{$p} //= $default{$p};
2073             } else {
2074 0         0 carp "Unknown parameter: '$p'.";
2075             }
2076             }
2077 0         0 for my $p (keys %default) {
2078 0   0     0 $p{$p} //= $default{$p};
2079             }
2080 0 0       0 Geo::GDAL::error("Usage: Center => [x,y,z].") unless ref($p{Center}) eq 'ARRAY';
2081 0         0 for my $i (0..2) {
2082 0   0     0 $p{Center}->[$i] //= 0;
2083             }
2084 0         0 return Geo::OGR::ApproximateArcAngles($p{Center}->[0], $p{Center}->[1], $p{Center}->[2], $p{PrimaryRadius}, $p{SecondaryAxis}, $p{Rotation}, $p{StartAngle}, $p{EndAngle}, $p{MaxAngleStepSizeDegrees});
2085             }
2086              
2087             sub As {
2088 6     6   12 my $self = shift;
2089 6         14 my $p = Geo::GDAL::named_parameters(\@_, Format => undef, ByteOrder => 'XDR', SRID => undef, Options => undef, AltitudeMode => undef);
2090 6         5 my $f = $p->{format};
2091 6 50       22 if ($f =~ /text/i) {
    50          
    0          
    0          
    0          
    0          
    0          
2092 0         0 return $self->AsText;
2093             } elsif ($f =~ /wkt/i) {
2094 6 50       7 if ($f =~ /iso/i) {
2095 6         61 return $self->ExportToIsoWkt;
2096             } else {
2097 0         0 return $self->AsText;
2098             }
2099             } elsif ($f =~ /binary/i) {
2100 0         0 return $self->ExportToWkb($p->{byteorder});
2101             } elsif ($f =~ /wkb/i) {
2102 0 0       0 if ($f =~ /iso/i) {
    0          
    0          
2103 0         0 $p->{byteorder} = Geo::GDAL::string2int($p->{byteorder}, \%Geo::OGR::Geometry::BYTE_ORDER_STRING2INT);
2104 0         0 return $self->ExportToIsoWkb($p->{byteorder});
2105             } elsif ($f =~ /ewkb/i) {
2106 0         0 return $self->AsHEXEWKB($p->{srid});
2107             } elsif ($f =~ /hex/i) {
2108 0         0 return $self->AsHEXWKB;
2109             } else {
2110 0         0 return $self->ExportToWkb($p->{byteorder});
2111             }
2112             } elsif ($f =~ /gml/i) {
2113 0         0 return $self->ExportToGML($p->{options});
2114             } elsif ($f =~ /kml/i) {
2115 0         0 return $self->ExportToKML($p->{altitudemode});
2116             } elsif ($f =~ /json/i) {
2117 0         0 return $self->AsJSON;
2118             } else {
2119 0         0 Geo::GDAL::error(1, $f, map {$_=>1} qw/Text WKT ISO_WKT ISO_WKB HEX_WKB HEX_EWKB Binary GML KML JSON/);
  0         0  
2120             }
2121             }
2122              
2123             sub AsHEXWKB {
2124 0     0   0 my ($self) = @_;
2125 0         0 my $wkb = _ExportToWkb($self, 1);
2126 0         0 my $hex = '';
2127 0         0 for (my $i = 0; $i < length($wkb); $i++) {
2128 0         0 my $x = sprintf("%x", ord(substr($wkb,$i,1)));
2129 0 0       0 $x = '0' . $x if length($x) == 1;
2130 0         0 $hex .= uc($x);
2131             }
2132 0         0 return $hex;
2133             }
2134              
2135             sub AsHEXEWKB {
2136 0     0   0 my ($self, $srid) = @_;
2137 0         0 my $hex = AsHEXWKB($self);
2138 0 0       0 if ($srid) {
2139 0         0 my $s = sprintf("%x", $srid);
2140 0         0 $srid = '';
2141 0         0 do {
2142 0 0       0 if (length($s) > 2) {
    0          
2143 0         0 $srid .= substr($s,-2,2);
2144 0         0 substr($s,-2,2) = '';
2145             } elsif (length($s) > 1) {
2146 0         0 $srid .= $s;
2147 0         0 $s = '';
2148             } else {
2149 0         0 $srid .= '0'.$s;
2150 0         0 $s = '';
2151             }
2152             } until $s eq '';
2153             } else {
2154 0         0 $srid = '00000000';
2155             }
2156 0         0 while (length($srid) < 8) {
2157 0         0 $srid .= '00';
2158             }
2159 0         0 substr($hex, 10, 0) = uc($srid);
2160 0         0 return $hex;
2161             }
2162              
2163             sub GeometryType {
2164 11     11   8 my $self = shift;
2165 11         98 return $TYPE_INT2STRING{$self->GetGeometryType};
2166             }
2167              
2168             sub CoordinateDimension {
2169             my $self = shift;
2170             SetCoordinateDimension($self, $_[0]) if @_;
2171             GetCoordinateDimension($self) if defined wantarray;
2172             }
2173              
2174             sub Extent {
2175 0     0   0 my $self = shift;
2176 0         0 return Geo::GDAL::Extent->new($self->GetEnvelope);
2177             }
2178              
2179             sub AddPoint {
2180 9     9   9 my $self = shift;
2181 9         18 my $t = $self->GetGeometryType;
2182 9         15 my $has_z = Geo::OGR::GT_HasZ($t);
2183 9         11 my $has_m = Geo::OGR::GT_HasM($t);
2184 9 50 33     30 if (!$has_z && !$has_m) {
    0 0        
    0 0        
2185 9         35 $self->AddPoint_2D(@_[0..1]);
2186             } elsif ($has_z && !$has_m) {
2187 0         0 $self->AddPoint_3D(@_[0..2]);
2188             } elsif (!$has_z && $has_m) {
2189 0         0 $self->AddPointM(@_[0..2]);
2190             } else {
2191 0         0 $self->AddPointZM(@_[0..3]);
2192             }
2193             }
2194              
2195             sub SetPoint {
2196 1     1   1 my $self = shift;
2197 1         3 my $t = $self->GetGeometryType;
2198 1         2 my $has_z = Geo::OGR::GT_HasZ($t);
2199 1         3 my $has_m = Geo::OGR::GT_HasM($t);
2200 1 50 33     7 if (!$has_z && !$has_m) {
    0 0        
    0 0        
2201 1         9 $self->SetPoint_2D(@_[0..2]);
2202             } elsif ($has_z && !$has_m) {
2203 0         0 $self->SetPoint_3D(@_[0..3]);
2204             } elsif (!$has_z && $has_m) {
2205 0         0 $self->SetPointM(@_[0..3]);
2206             } else {
2207 0         0 $self->SetPointZM(@_[0..4]);
2208             }
2209             }
2210              
2211             sub GetPoint {
2212 9     9   11 my($self, $i) = @_;
2213 9   100     19 $i //= 0;
2214 9         15 my $t = $self->GetGeometryType;
2215 9         13 my $has_z = Geo::OGR::GT_HasZ($t);
2216 9         10 my $has_m = Geo::OGR::GT_HasM($t);
2217 9         3 my $point;
2218 9 50 33     26 if (!$has_z && !$has_m) {
    0 0        
    0 0        
2219 9         23 $point = $self->GetPoint_2D($i);
2220             } elsif ($has_z && !$has_m) {
2221 0         0 $point = $self->GetPoint_3D($i);
2222             } elsif (!$has_z && $has_m) {
2223 0         0 $point = $self->GetPointZM($i);
2224 0         0 @$point = ($point->[0], $point->[1], $point->[3]);
2225             } else {
2226 0         0 $point = $self->GetPointZM($i);
2227             }
2228 9 100       21 return wantarray ? @$point : $point;
2229             }
2230              
2231             sub Point {
2232 2     2   34 my $self = shift;
2233 2         2 my $i;
2234 2 100       5 if (@_) {
2235 1         5 my $t = $self->GetGeometryType;
2236 1         1 my $i;
2237 1 50       9 if (Geo::OGR::GT_Flatten($t) == $Geo::OGR::wkbPoint) {
2238 1         3 my $has_z = Geo::OGR::GT_HasZ($t);
2239 1         3 my $has_m = Geo::OGR::GT_HasM($t);
2240 1 50 33     10 if (!$has_z && !$has_m) {
    0 0        
2241 1 50       4 shift if @_ > 2;
2242 1         1 $i = 0;
2243             } elsif ($has_z || $has_m) {
2244 0 0       0 shift if @_ > 3;
2245 0         0 $i = 0;
2246             } else {
2247 0 0       0 shift if @_ > 4;
2248 0         0 $i = 0;
2249             }
2250             }
2251 1 50       3 $i = shift unless defined $i;
2252 1         3 $self->SetPoint($i, @_);
2253             }
2254 2 100       4 return unless defined wantarray;
2255 1         4 my $point = $self->GetPoint;
2256 1 50       4 return wantarray ? @$point : $point;
2257             }
2258              
2259             sub Points {
2260 11     11   402 my $self = shift;
2261 11         31 my $t = $self->GetGeometryType;
2262 11         22 my $has_z = Geo::OGR::GT_HasZ($t);
2263 11         16 my $has_m = Geo::OGR::GT_HasM($t);
2264 11         11 my $postfix = '';
2265 11 50       21 $postfix .= 'Z' if Geo::OGR::GT_HasZ($t);
2266 11 50       22 $postfix .= 'M' if Geo::OGR::GT_HasM($t);
2267 11         34 $t = $TYPE_INT2STRING{Geo::OGR::GT_Flatten($t)};
2268 11         11 my $points = shift;
2269 11 100       18 if ($points) {
2270 7         36 Empty($self);
2271 7 50 33     55 if ($t eq 'Unknown' or $t eq 'None' or $t eq 'GeometryCollection') {
    100 33        
    50 33        
    0 33        
    0          
    0          
    0          
2272 0         0 Geo::GDAL::error("Can't set points of a geometry of type '$t'.");
2273             } elsif ($t eq 'Point') {
2274             # support both "Point" as a list of one point and one point
2275 6 50       10 if (ref($points->[0])) {
2276 0         0 $self->AddPoint(@{$points->[0]});
  0         0  
2277             } else {
2278 6         13 $self->AddPoint(@$points);
2279             }
2280             } elsif ($t eq 'LineString' or $t eq 'LinearRing' or $t eq 'CircularString') {
2281 1         3 for my $p (@$points) {
2282 3         5 $self->AddPoint(@$p);
2283             }
2284             } elsif ($t eq 'Polygon') {
2285 0         0 for my $r (@$points) {
2286 0         0 my $ring = Geo::OGR::Geometry->new('LinearRing');
2287 0 0       0 $ring->Set3D(1) if $has_z;
2288 0 0       0 $ring->SetMeasured(1) if $has_m;
2289 0         0 $ring->Points($r);
2290 0         0 $self->AddGeometryDirectly($ring);
2291             }
2292             } elsif ($t eq 'MultiPoint') {
2293 0         0 for my $p (@$points) {
2294 0         0 my $point = Geo::OGR::Geometry->new('Point'.$postfix);
2295 0         0 $point->Points($p);
2296 0         0 $self->AddGeometryDirectly($point);
2297             }
2298             } elsif ($t eq 'MultiLineString') {
2299 0         0 for my $l (@$points) {
2300 0         0 my $linestring = Geo::OGR::Geometry->new('LineString'.$postfix);
2301 0         0 $linestring->Points($l);
2302 0         0 $self->AddGeometryDirectly($linestring);
2303             }
2304             } elsif ($t eq 'MultiPolygon') {
2305 0         0 for my $p (@$points) {
2306 0         0 my $polygon = Geo::OGR::Geometry->new('Polygon'.$postfix);
2307 0         0 $polygon->Points($p);
2308 0         0 $self->AddGeometryDirectly($polygon);
2309             }
2310             }
2311             }
2312 11 100       20 return unless defined wantarray;
2313 4         9 $self->_GetPoints();
2314             }
2315              
2316             sub _GetPoints {
2317 4     4   3 my($self) = @_;
2318 4         4 my @points;
2319 4         9 my $n = $self->GetGeometryCount;
2320 4 50       6 if ($n) {
2321 0         0 for my $i (0..$n-1) {
2322 0         0 push @points, $self->GetGeometryRef($i)->_GetPoints();
2323             }
2324             } else {
2325 4         19 $n = $self->GetPointCount;
2326 4 100       8 if ($n == 1) {
2327 2         5 push @points, $self->GetPoint;
2328             } else {
2329 2         6 for my $i (0..$n-1) {
2330 6         8 push @points, scalar $self->GetPoint($i);
2331             }
2332             }
2333             }
2334 4         7 return \@points;
2335             }
2336              
2337             sub ExportToWkb {
2338 0     0   0 my($self, $bo) = @_;
2339 0         0 $bo = Geo::GDAL::string2int($bo, \%BYTE_ORDER_STRING2INT);
2340 0         0 return _ExportToWkb($self, $bo);
2341             }
2342              
2343             sub ForceTo {
2344 0     0   0 my $self = shift;
2345 0         0 my $type = shift;
2346 0         0 $type = Geo::GDAL::string2int($type, \%TYPE_STRING2INT);
2347 0         0 eval {
2348 0         0 $self = Geo::OGR::ForceTo($self, $type, @_);
2349             };
2350 0 0       0 confess Geo::GDAL->last_error if $@;
2351 0         0 return $self;
2352             }
2353              
2354             sub ForceToLineString {
2355 0     0   0 my $self = shift;
2356 0         0 return Geo::OGR::ForceToLineString($self);
2357             }
2358              
2359             sub ForceToMultiPoint {
2360 1     1   5 my $self = shift;
2361 1         19 $self = Geo::OGR::ForceToMultiPoint($self);
2362 1         3 for my $g (@_) {
2363 1         10 $self->AddGeometry($g);
2364             }
2365 1         2 return $self;
2366             }
2367              
2368             sub ForceToMultiLineString {
2369 1     1   2 my $self = shift;
2370 1         27 $self = Geo::OGR::ForceToMultiLineString($self);
2371 1         3 for my $g (@_) {
2372 1         8 $self->AddGeometry($g);
2373             }
2374 1         4 return $self;
2375             }
2376              
2377             sub ForceToMultiPolygon {
2378 1     1   1 my $self = shift;
2379 1         15 $self = Geo::OGR::ForceToMultiPolygon($self);
2380 1         3 for my $g (@_) {
2381 1         5 $self->AddGeometry($g);
2382             }
2383 1         3 return $self;
2384             }
2385              
2386             sub ForceToCollection {
2387 1     1   3 my $self = Geo::OGR::Geometry->new(GeometryType => 'GeometryCollection');
2388 1         2 for my $g (@_) {
2389 2         9 $self->AddGeometry($g);
2390             }
2391 1         2 return $self;
2392             }
2393             *Collect = *ForceToCollection;
2394              
2395             sub Dissolve {
2396 1     1   2 my $self = shift;
2397 1         1 my @c;
2398 1         19 my $n = $self->GetGeometryCount;
2399 1 50       3 if ($n > 0) {
2400 1         4 for my $i (0..$n-1) {
2401 2         23 push @c, $self->GetGeometryRef($i)->Clone;
2402             }
2403             } else {
2404 0         0 push @c, $self;
2405             }
2406 1         6 return @c;
2407             }
2408             *AsText = *ExportToWkt;
2409             *AsBinary = *ExportToWkb;
2410             *AsGML = *ExportToGML;
2411             *AsKML = *ExportToKML;
2412             *AsJSON = *ExportToJson;
2413             *BuildPolygonFromEdges = *Geo::OGR::BuildPolygonFromEdges;
2414             *ForceToPolygon = *Geo::OGR::ForceToPolygon;
2415              
2416              
2417             package Geo::OGR;
2418 19     19   90 use strict;
  19         24  
  19         386  
2419 19     19   65 use warnings;
  19         20  
  19         409  
2420 19     19   59 use Carp;
  19         15  
  19         10672  
2421              
2422             sub GeometryType {
2423 135     135 0 378 my($type) = @_;
2424 135 100       121 if (defined $type) {
2425 134         189 return Geo::GDAL::string2int($type, \%Geo::OGR::Geometry::TYPE_STRING2INT, \%Geo::OGR::Geometry::TYPE_INT2STRING);
2426             } else {
2427 1         18 return @Geo::OGR::Geometry::GEOMETRY_TYPES;
2428             }
2429             }
2430              
2431             sub GeometryTypeModify {
2432 0     0 0   my($type, $modifier) = @_;
2433 0 0         Geo::GDAL::error(1, $type, \%Geo::OGR::Geometry::TYPE_STRING2INT) unless exists $Geo::OGR::Geometry::TYPE_STRING2INT{$type};
2434 0           $type = $Geo::OGR::Geometry::TYPE_STRING2INT{$type};
2435 0 0         return $Geo::OGR::Geometry::TYPE_INT2STRING{GT_Flatten($type)} if $modifier =~ /flat/i;
2436 0 0         return $Geo::OGR::Geometry::TYPE_INT2STRING{GT_SetZ($type)} if $modifier =~ /z/i;
2437 0 0         return $Geo::OGR::Geometry::TYPE_INT2STRING{GT_GetCollection($type)} if $modifier =~ /collection/i;
2438 0 0         return $Geo::OGR::Geometry::TYPE_INT2STRING{GT_GetCurve($type)} if $modifier =~ /curve/i;
2439 0 0         return $Geo::OGR::Geometry::TYPE_INT2STRING{GT_GetLinear($type)} if $modifier =~ /linear/i;
2440 0           Geo::GDAL::error(1, $modifier, {Flatten => 1, SetZ => 1, GetCollection => 1, GetCurve => 1, GetLinear => 1});
2441             }
2442              
2443             sub GeometryTypeTest {
2444 0     0 0   my($type, $test, $type2) = @_;
2445 0 0         Geo::GDAL::error(1, $type, \%Geo::OGR::Geometry::TYPE_STRING2INT) unless exists $Geo::OGR::Geometry::TYPE_STRING2INT{$type};
2446 0           $type = $Geo::OGR::Geometry::TYPE_STRING2INT{$type};
2447 0 0         if (defined $type2) {
2448 0 0         Geo::GDAL::error(1, $type2, \%Geo::OGR::Geometry::TYPE_STRING2INT) unless exists $Geo::OGR::Geometry::TYPE_STRING2INT{$type2};
2449 0           $type2 = $Geo::OGR::Geometry::TYPE_STRING2INT{$type2};
2450             } else {
2451 0 0         Geo::GDAL::error("Usage: GeometryTypeTest(type1, 'is_subclass_of', type2).") if $test =~ /subclass/i;
2452             }
2453 0 0         return GT_HasZ($type) if $test =~ /z/i;
2454 0 0         return GT_IsSubClassOf($type, $type2) if $test =~ /subclass/i;
2455 0 0         return GT_IsCurve($type) if $test =~ /curve/i;
2456 0 0         return GT_IsSurface($type) if $test =~ /surface/i;
2457 0 0         return GT_IsNonLinear($type) if $test =~ /linear/i;
2458 0           Geo::GDAL::error(1, $test, {HasZ => 1, IsSubClassOf => 1, IsCurve => 1, IsSurface => 1, IsNonLinear => 1});
2459             }
2460              
2461       144 0   sub RELEASE_PARENTS {
2462             }
2463              
2464             *ByteOrders = *Geo::OGR::Geometry::ByteOrders;
2465             *GeometryTypes = *Geo::OGR::Geometry::GeometryTypes;
2466              
2467             1;