File Coverage

blib/lib/Geo/GDAL.pm
Criterion Covered Total %
statement 961 1505 63.8
branch 256 580 44.1
condition 87 237 36.7
subroutine 199 307 64.8
pod 0 33 0.0
total 1503 2662 56.4


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::GDAL;
8 19     19   274497 use base qw(Exporter);
  19         25  
  19         1629  
9 19     19   85 use base qw(DynaLoader);
  19         21  
  19         17079  
10             require Geo::OGR;
11             require Geo::OSR;
12             package Geo::GDALc;
13             bootstrap Geo::GDAL;
14             package Geo::GDAL;
15             @EXPORT = qw();
16              
17             # ---------- BASE METHODS -------------
18              
19             package Geo::GDAL;
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 2511     2511   4008 my ($self,$field) = @_;
34 2511         2294 my $member_func = "swig_${field}_get";
35 2511         8430 $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::GDAL;
53              
54             *UseExceptions = *Geo::GDALc::UseExceptions;
55             *DontUseExceptions = *Geo::GDALc::DontUseExceptions;
56             *Debug = *Geo::GDALc::Debug;
57             *SetErrorHandler = *Geo::GDALc::SetErrorHandler;
58             *Error = *Geo::GDALc::Error;
59             *GOA2GetAuthorizationURL = *Geo::GDALc::GOA2GetAuthorizationURL;
60             *GOA2GetRefreshToken = *Geo::GDALc::GOA2GetRefreshToken;
61             *GOA2GetAccessToken = *Geo::GDALc::GOA2GetAccessToken;
62             *PushErrorHandler = *Geo::GDALc::PushErrorHandler;
63             *PopErrorHandler = *Geo::GDALc::PopErrorHandler;
64             *ErrorReset = *Geo::GDALc::ErrorReset;
65             *EscapeString = *Geo::GDALc::EscapeString;
66             *GetLastErrorNo = *Geo::GDALc::GetLastErrorNo;
67             *GetLastErrorType = *Geo::GDALc::GetLastErrorType;
68             *GetLastErrorMsg = *Geo::GDALc::GetLastErrorMsg;
69             *VSIGetLastErrorNo = *Geo::GDALc::VSIGetLastErrorNo;
70             *VSIGetLastErrorMsg = *Geo::GDALc::VSIGetLastErrorMsg;
71             *PushFinderLocation = *Geo::GDALc::PushFinderLocation;
72             *PopFinderLocation = *Geo::GDALc::PopFinderLocation;
73             *FinderClean = *Geo::GDALc::FinderClean;
74             *FindFile = *Geo::GDALc::FindFile;
75             *ReadDir = *Geo::GDALc::ReadDir;
76             *ReadDirRecursive = *Geo::GDALc::ReadDirRecursive;
77             *SetConfigOption = *Geo::GDALc::SetConfigOption;
78             *GetConfigOption = *Geo::GDALc::GetConfigOption;
79             *CPLBinaryToHex = *Geo::GDALc::CPLBinaryToHex;
80             *CPLHexToBinary = *Geo::GDALc::CPLHexToBinary;
81             *FileFromMemBuffer = *Geo::GDALc::FileFromMemBuffer;
82             *Unlink = *Geo::GDALc::Unlink;
83             *HasThreadSupport = *Geo::GDALc::HasThreadSupport;
84             *Mkdir = *Geo::GDALc::Mkdir;
85             *Rmdir = *Geo::GDALc::Rmdir;
86             *Rename = *Geo::GDALc::Rename;
87             *Stat = *Geo::GDALc::Stat;
88             *VSIFOpenL = *Geo::GDALc::VSIFOpenL;
89             *VSIFOpenExL = *Geo::GDALc::VSIFOpenExL;
90             *VSIFCloseL = *Geo::GDALc::VSIFCloseL;
91             *VSIFSeekL = *Geo::GDALc::VSIFSeekL;
92             *VSIFTellL = *Geo::GDALc::VSIFTellL;
93             *VSIFTruncateL = *Geo::GDALc::VSIFTruncateL;
94             *VSIFWriteL = *Geo::GDALc::VSIFWriteL;
95             *VSIFReadL = *Geo::GDALc::VSIFReadL;
96             *VSIStdoutSetRedirection = *Geo::GDALc::VSIStdoutSetRedirection;
97             *VSIStdoutUnsetRedirection = *Geo::GDALc::VSIStdoutUnsetRedirection;
98             *ParseCommandLine = *Geo::GDALc::ParseCommandLine;
99             *GDAL_GCP_GCPX_get = *Geo::GDALc::GDAL_GCP_GCPX_get;
100             *GDAL_GCP_GCPX_set = *Geo::GDALc::GDAL_GCP_GCPX_set;
101             *GDAL_GCP_GCPY_get = *Geo::GDALc::GDAL_GCP_GCPY_get;
102             *GDAL_GCP_GCPY_set = *Geo::GDALc::GDAL_GCP_GCPY_set;
103             *GDAL_GCP_GCPZ_get = *Geo::GDALc::GDAL_GCP_GCPZ_get;
104             *GDAL_GCP_GCPZ_set = *Geo::GDALc::GDAL_GCP_GCPZ_set;
105             *GDAL_GCP_GCPPixel_get = *Geo::GDALc::GDAL_GCP_GCPPixel_get;
106             *GDAL_GCP_GCPPixel_set = *Geo::GDALc::GDAL_GCP_GCPPixel_set;
107             *GDAL_GCP_GCPLine_get = *Geo::GDALc::GDAL_GCP_GCPLine_get;
108             *GDAL_GCP_GCPLine_set = *Geo::GDALc::GDAL_GCP_GCPLine_set;
109             *GDAL_GCP_Info_get = *Geo::GDALc::GDAL_GCP_Info_get;
110             *GDAL_GCP_Info_set = *Geo::GDALc::GDAL_GCP_Info_set;
111             *GDAL_GCP_Id_get = *Geo::GDALc::GDAL_GCP_Id_get;
112             *GDAL_GCP_Id_set = *Geo::GDALc::GDAL_GCP_Id_set;
113             *GCPsToGeoTransform = *Geo::GDALc::GCPsToGeoTransform;
114             *TermProgress_nocb = *Geo::GDALc::TermProgress_nocb;
115             *ComputeMedianCutPCT = *Geo::GDALc::ComputeMedianCutPCT;
116             *DitherRGB2PCT = *Geo::GDALc::DitherRGB2PCT;
117             *_ReprojectImage = *Geo::GDALc::_ReprojectImage;
118             *ComputeProximity = *Geo::GDALc::ComputeProximity;
119             *RasterizeLayer = *Geo::GDALc::RasterizeLayer;
120             *_Polygonize = *Geo::GDALc::_Polygonize;
121             *FPolygonize = *Geo::GDALc::FPolygonize;
122             *FillNodata = *Geo::GDALc::FillNodata;
123             *SieveFilter = *Geo::GDALc::SieveFilter;
124             *_RegenerateOverviews = *Geo::GDALc::_RegenerateOverviews;
125             *_RegenerateOverview = *Geo::GDALc::_RegenerateOverview;
126             *ContourGenerate = *Geo::GDALc::ContourGenerate;
127             *_AutoCreateWarpedVRT = *Geo::GDALc::_AutoCreateWarpedVRT;
128             *CreatePansharpenedVRT = *Geo::GDALc::CreatePansharpenedVRT;
129             *ApplyGeoTransform = *Geo::GDALc::ApplyGeoTransform;
130             *InvGeoTransform = *Geo::GDALc::InvGeoTransform;
131             *VersionInfo = *Geo::GDALc::VersionInfo;
132             *AllRegister = *Geo::GDALc::AllRegister;
133             *GDALDestroyDriverManager = *Geo::GDALc::GDALDestroyDriverManager;
134             *GetCacheMax = *Geo::GDALc::GetCacheMax;
135             *GetCacheUsed = *Geo::GDALc::GetCacheUsed;
136             *SetCacheMax = *Geo::GDALc::SetCacheMax;
137             *_GetDataTypeSize = *Geo::GDALc::_GetDataTypeSize;
138             *_DataTypeIsComplex = *Geo::GDALc::_DataTypeIsComplex;
139             *GetDataTypeName = *Geo::GDALc::GetDataTypeName;
140             *GetDataTypeByName = *Geo::GDALc::GetDataTypeByName;
141             *GetColorInterpretationName = *Geo::GDALc::GetColorInterpretationName;
142             *GetPaletteInterpretationName = *Geo::GDALc::GetPaletteInterpretationName;
143             *DecToDMS = *Geo::GDALc::DecToDMS;
144             *PackedDMSToDec = *Geo::GDALc::PackedDMSToDec;
145             *DecToPackedDMS = *Geo::GDALc::DecToPackedDMS;
146             *ParseXMLString = *Geo::GDALc::ParseXMLString;
147             *SerializeXMLTree = *Geo::GDALc::SerializeXMLTree;
148             *GetJPEG2000StructureAsString = *Geo::GDALc::GetJPEG2000StructureAsString;
149             *GetDriverCount = *Geo::GDALc::GetDriverCount;
150             *GetDriverByName = *Geo::GDALc::GetDriverByName;
151             *GetDriver = *Geo::GDALc::GetDriver;
152             *_Open = *Geo::GDALc::_Open;
153             *_OpenEx = *Geo::GDALc::_OpenEx;
154             *_OpenShared = *Geo::GDALc::_OpenShared;
155             *IdentifyDriver = *Geo::GDALc::IdentifyDriver;
156             *GeneralCmdLineProcessor = *Geo::GDALc::GeneralCmdLineProcessor;
157             *GDALInfo = *Geo::GDALc::GDALInfo;
158             *wrapper_GDALTranslate = *Geo::GDALc::wrapper_GDALTranslate;
159             *wrapper_GDALWarpDestDS = *Geo::GDALc::wrapper_GDALWarpDestDS;
160             *wrapper_GDALWarpDestName = *Geo::GDALc::wrapper_GDALWarpDestName;
161             *wrapper_GDALVectorTranslateDestDS = *Geo::GDALc::wrapper_GDALVectorTranslateDestDS;
162             *wrapper_GDALVectorTranslateDestName = *Geo::GDALc::wrapper_GDALVectorTranslateDestName;
163             *wrapper_GDALDEMProcessing = *Geo::GDALc::wrapper_GDALDEMProcessing;
164             *wrapper_GDALNearblackDestDS = *Geo::GDALc::wrapper_GDALNearblackDestDS;
165             *wrapper_GDALNearblackDestName = *Geo::GDALc::wrapper_GDALNearblackDestName;
166             *wrapper_GDALGrid = *Geo::GDALc::wrapper_GDALGrid;
167             *wrapper_GDALRasterizeDestDS = *Geo::GDALc::wrapper_GDALRasterizeDestDS;
168             *wrapper_GDALRasterizeDestName = *Geo::GDALc::wrapper_GDALRasterizeDestName;
169             *wrapper_GDALBuildVRT_objects = *Geo::GDALc::wrapper_GDALBuildVRT_objects;
170             *wrapper_GDALBuildVRT_names = *Geo::GDALc::wrapper_GDALBuildVRT_names;
171              
172             ############# Class : Geo::GDAL::MajorObject ##############
173              
174             package Geo::GDAL::MajorObject;
175 19     19   88 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         25  
  19         3216  
176             @ISA = qw( Geo::GDAL );
177             %OWNER = ();
178             *GetDescription = *Geo::GDALc::MajorObject_GetDescription;
179             *SetDescription = *Geo::GDALc::MajorObject_SetDescription;
180             *GetMetadataDomainList = *Geo::GDALc::MajorObject_GetMetadataDomainList;
181             *GetMetadata = *Geo::GDALc::MajorObject_GetMetadata;
182             *SetMetadata = *Geo::GDALc::MajorObject_SetMetadata;
183             *GetMetadataItem = *Geo::GDALc::MajorObject_GetMetadataItem;
184             *SetMetadataItem = *Geo::GDALc::MajorObject_SetMetadataItem;
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::GDAL::Driver ##############
199              
200             package Geo::GDAL::Driver;
201 19     19   69 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         28  
  19         3872  
202             @ISA = qw( Geo::GDAL::MajorObject Geo::GDAL );
203             %OWNER = ();
204             %ITERATORS = ();
205             *swig_ShortName_get = *Geo::GDALc::Driver_ShortName_get;
206             *swig_ShortName_set = *Geo::GDALc::Driver_ShortName_set;
207             *swig_LongName_get = *Geo::GDALc::Driver_LongName_get;
208             *swig_LongName_set = *Geo::GDALc::Driver_LongName_set;
209             *swig_HelpTopic_get = *Geo::GDALc::Driver_HelpTopic_get;
210             *swig_HelpTopic_set = *Geo::GDALc::Driver_HelpTopic_set;
211             *_Create = *Geo::GDALc::Driver__Create;
212             *_CreateCopy = *Geo::GDALc::Driver__CreateCopy;
213             *Delete = *Geo::GDALc::Driver_Delete;
214             *Rename = *Geo::GDALc::Driver_Rename;
215             *CopyFiles = *Geo::GDALc::Driver_CopyFiles;
216             *Register = *Geo::GDALc::Driver_Register;
217             *Deregister = *Geo::GDALc::Driver_Deregister;
218             sub DISOWN {
219 0     0   0 my $self = shift;
220 0         0 my $ptr = tied(%$self);
221 0         0 delete $OWNER{$ptr};
222             }
223              
224             sub ACQUIRE {
225 0     0   0 my $self = shift;
226 0         0 my $ptr = tied(%$self);
227 0         0 $OWNER{$ptr} = 1;
228             }
229              
230              
231             ############# Class : Geo::GDAL::GCP ##############
232              
233             package Geo::GDAL::GCP;
234 19     19   74 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         20  
  19         5908  
235             @ISA = qw( Geo::GDAL );
236             %OWNER = ();
237             %ITERATORS = ();
238             *swig_X_get = *Geo::GDALc::GCP_X_get;
239             *swig_X_set = *Geo::GDALc::GCP_X_set;
240             *swig_Y_get = *Geo::GDALc::GCP_Y_get;
241             *swig_Y_set = *Geo::GDALc::GCP_Y_set;
242             *swig_Z_get = *Geo::GDALc::GCP_Z_get;
243             *swig_Z_set = *Geo::GDALc::GCP_Z_set;
244             *swig_Column_get = *Geo::GDALc::GCP_Column_get;
245             *swig_Column_set = *Geo::GDALc::GCP_Column_set;
246             *swig_Row_get = *Geo::GDALc::GCP_Row_get;
247             *swig_Row_set = *Geo::GDALc::GCP_Row_set;
248             *swig_Info_get = *Geo::GDALc::GCP_Info_get;
249             *swig_Info_set = *Geo::GDALc::GCP_Info_set;
250             *swig_Id_get = *Geo::GDALc::GCP_Id_get;
251             *swig_Id_set = *Geo::GDALc::GCP_Id_set;
252             sub new {
253 18     18   264 my $pkg = shift;
254 18         123 my $self = Geo::GDALc::new_GCP(@_);
255 18 50       72 bless $self, $pkg if defined($self);
256             }
257              
258             sub DESTROY {
259 64     64   267 my $self = shift;
260 64 100       144 unless ($self->isa('SCALAR')) {
261 32 50       57 return unless $self->isa('HASH');
262 32         18 $self = tied(%{$self});
  32         29  
263 32 50       43 return unless defined $self;
264             }
265 64         54 my $code = $Geo::GDAL::stdout_redirection{$self};
266 64         42 delete $Geo::GDAL::stdout_redirection{$self};
267 64         44 delete $ITERATORS{$self};
268 64 100       89 if (exists $OWNER{$self}) {
269 32         85 Geo::GDALc::delete_GCP($self);
270 32         32 delete $OWNER{$self};
271             }
272 64         63 $self->RELEASE_PARENTS();
273 64 50       135 if ($code) {
274 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
275 0         0 $code->close;
276             }
277              
278             }
279              
280             sub DISOWN {
281 0     0   0 my $self = shift;
282 0         0 my $ptr = tied(%$self);
283 0         0 delete $OWNER{$ptr};
284             }
285              
286             sub ACQUIRE {
287 0     0   0 my $self = shift;
288 0         0 my $ptr = tied(%$self);
289 0         0 $OWNER{$ptr} = 1;
290             }
291              
292              
293             ############# Class : Geo::GDAL::AsyncReader ##############
294              
295             package Geo::GDAL::AsyncReader;
296 19     19   69 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         22  
  19         3549  
297             @ISA = qw( Geo::GDAL );
298             %OWNER = ();
299             %ITERATORS = ();
300             sub DESTROY {
301 0 0   0   0 return unless $_[0]->isa('HASH');
302 0         0 my $self = tied(%{$_[0]});
  0         0  
303 0 0       0 return unless defined $self;
304 0         0 delete $ITERATORS{$self};
305 0 0       0 if (exists $OWNER{$self}) {
306 0         0 Geo::GDALc::delete_AsyncReader($self);
307 0         0 delete $OWNER{$self};
308             }
309             }
310              
311             *GetNextUpdatedRegion = *Geo::GDALc::AsyncReader_GetNextUpdatedRegion;
312             *LockBuffer = *Geo::GDALc::AsyncReader_LockBuffer;
313             *UnlockBuffer = *Geo::GDALc::AsyncReader_UnlockBuffer;
314             sub DISOWN {
315 0     0   0 my $self = shift;
316 0         0 my $ptr = tied(%$self);
317 0         0 delete $OWNER{$ptr};
318             }
319              
320             sub ACQUIRE {
321 0     0   0 my $self = shift;
322 0         0 my $ptr = tied(%$self);
323 0         0 $OWNER{$ptr} = 1;
324             }
325              
326              
327             ############# Class : Geo::GDAL::Dataset ##############
328              
329             package Geo::GDAL::Dataset;
330 19     19   70 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         25  
  19         17935  
331             @ISA = qw( Geo::GDAL::MajorObject Geo::GDAL );
332             %OWNER = ();
333             %ITERATORS = ();
334             *swig_RasterXSize_get = *Geo::GDALc::Dataset_RasterXSize_get;
335             *swig_RasterXSize_set = *Geo::GDALc::Dataset_RasterXSize_set;
336             *swig_RasterYSize_get = *Geo::GDALc::Dataset_RasterYSize_get;
337             *swig_RasterYSize_set = *Geo::GDALc::Dataset_RasterYSize_set;
338             *swig_RasterCount_get = *Geo::GDALc::Dataset_RasterCount_get;
339             *swig_RasterCount_set = *Geo::GDALc::Dataset_RasterCount_set;
340             sub DESTROY {
341 122     122   2945 my $self = shift;
342 122 100       375 unless ($self->isa('SCALAR')) {
343 61 50       145 return unless $self->isa('HASH');
344 61         50 $self = tied(%{$self});
  61         74  
345 61 50       102 return unless defined $self;
346             }
347 122         144 my $code = $Geo::GDAL::stdout_redirection{$self};
348 122         102 delete $Geo::GDAL::stdout_redirection{$self};
349 122         98 delete $ITERATORS{$self};
350 122 100       221 if (exists $OWNER{$self}) {
351 60         2904 Geo::GDALc::delete_Dataset($self);
352 60         139 delete $OWNER{$self};
353             }
354 122         186 $self->RELEASE_PARENTS();
355 122 100       677 if ($code) {
356 1         2 Geo::GDAL::VSIStdoutUnsetRedirection();
357 1         3 $code->close;
358             }
359              
360             }
361              
362             *GetDriver = *Geo::GDALc::Dataset_GetDriver;
363             *_GetRasterBand = *Geo::GDALc::Dataset__GetRasterBand;
364             *GetProjection = *Geo::GDALc::Dataset_GetProjection;
365             *GetProjectionRef = *Geo::GDALc::Dataset_GetProjectionRef;
366             *SetProjection = *Geo::GDALc::Dataset_SetProjection;
367             *GetGeoTransform = *Geo::GDALc::Dataset_GetGeoTransform;
368             *SetGeoTransform = *Geo::GDALc::Dataset_SetGeoTransform;
369             *_BuildOverviews = *Geo::GDALc::Dataset__BuildOverviews;
370             *GetGCPCount = *Geo::GDALc::Dataset_GetGCPCount;
371             *GetGCPProjection = *Geo::GDALc::Dataset_GetGCPProjection;
372             *GetGCPs = *Geo::GDALc::Dataset_GetGCPs;
373             *SetGCPs = *Geo::GDALc::Dataset_SetGCPs;
374             *FlushCache = *Geo::GDALc::Dataset_FlushCache;
375             *_AddBand = *Geo::GDALc::Dataset__AddBand;
376             *_CreateMaskBand = *Geo::GDALc::Dataset__CreateMaskBand;
377             *GetFileList = *Geo::GDALc::Dataset_GetFileList;
378             *_WriteRaster = *Geo::GDALc::Dataset__WriteRaster;
379             *_ReadRaster = *Geo::GDALc::Dataset__ReadRaster;
380             *_CreateLayer = *Geo::GDALc::Dataset__CreateLayer;
381             *CopyLayer = *Geo::GDALc::Dataset_CopyLayer;
382             *_DeleteLayer = *Geo::GDALc::Dataset__DeleteLayer;
383             *GetLayerCount = *Geo::GDALc::Dataset_GetLayerCount;
384             *GetLayerByIndex = *Geo::GDALc::Dataset_GetLayerByIndex;
385             *GetLayerByName = *Geo::GDALc::Dataset_GetLayerByName;
386             *_TestCapability = *Geo::GDALc::Dataset__TestCapability;
387             *ExecuteSQL = *Geo::GDALc::Dataset_ExecuteSQL;
388             *_ReleaseResultSet = *Geo::GDALc::Dataset__ReleaseResultSet;
389             *GetStyleTable = *Geo::GDALc::Dataset_GetStyleTable;
390             *SetStyleTable = *Geo::GDALc::Dataset_SetStyleTable;
391             *StartTransaction = *Geo::GDALc::Dataset_StartTransaction;
392             *CommitTransaction = *Geo::GDALc::Dataset_CommitTransaction;
393             *RollbackTransaction = *Geo::GDALc::Dataset_RollbackTransaction;
394             sub DISOWN {
395 0     0   0 my $self = shift;
396 0         0 my $ptr = tied(%$self);
397 0         0 delete $OWNER{$ptr};
398             }
399              
400             sub ACQUIRE {
401 0     0   0 my $self = shift;
402 0         0 my $ptr = tied(%$self);
403 0         0 $OWNER{$ptr} = 1;
404             }
405              
406              
407             ############# Class : Geo::GDAL::Band ##############
408              
409             package Geo::GDAL::Band;
410 19     19   80 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         20  
  19         8660  
411             @ISA = qw( Geo::GDAL::MajorObject Geo::GDAL );
412             %OWNER = ();
413             %ITERATORS = ();
414             *swig_XSize_get = *Geo::GDALc::Band_XSize_get;
415             *swig_XSize_set = *Geo::GDALc::Band_XSize_set;
416             *swig_YSize_get = *Geo::GDALc::Band_YSize_get;
417             *swig_YSize_set = *Geo::GDALc::Band_YSize_set;
418             *swig_DataType_get = *Geo::GDALc::Band_DataType_get;
419             *swig_DataType_set = *Geo::GDALc::Band_DataType_set;
420             *GetDataset = *Geo::GDALc::Band_GetDataset;
421             *GetBand = *Geo::GDALc::Band_GetBand;
422             *GetBlockSize = *Geo::GDALc::Band_GetBlockSize;
423             *GetColorInterpretation = *Geo::GDALc::Band_GetColorInterpretation;
424             *GetRasterColorInterpretation = *Geo::GDALc::Band_GetRasterColorInterpretation;
425             *SetColorInterpretation = *Geo::GDALc::Band_SetColorInterpretation;
426             *SetRasterColorInterpretation = *Geo::GDALc::Band_SetRasterColorInterpretation;
427             *GetNoDataValue = *Geo::GDALc::Band_GetNoDataValue;
428             *SetNoDataValue = *Geo::GDALc::Band_SetNoDataValue;
429             *DeleteNoDataValue = *Geo::GDALc::Band_DeleteNoDataValue;
430             *GetUnitType = *Geo::GDALc::Band_GetUnitType;
431             *SetUnitType = *Geo::GDALc::Band_SetUnitType;
432             *GetRasterCategoryNames = *Geo::GDALc::Band_GetRasterCategoryNames;
433             *SetRasterCategoryNames = *Geo::GDALc::Band_SetRasterCategoryNames;
434             *GetMinimum = *Geo::GDALc::Band_GetMinimum;
435             *GetMaximum = *Geo::GDALc::Band_GetMaximum;
436             *GetOffset = *Geo::GDALc::Band_GetOffset;
437             *GetScale = *Geo::GDALc::Band_GetScale;
438             *SetOffset = *Geo::GDALc::Band_SetOffset;
439             *SetScale = *Geo::GDALc::Band_SetScale;
440             *GetStatistics = *Geo::GDALc::Band_GetStatistics;
441             *ComputeStatistics = *Geo::GDALc::Band_ComputeStatistics;
442             *SetStatistics = *Geo::GDALc::Band_SetStatistics;
443             *GetOverviewCount = *Geo::GDALc::Band_GetOverviewCount;
444             *_GetOverview = *Geo::GDALc::Band__GetOverview;
445             *Checksum = *Geo::GDALc::Band_Checksum;
446             *ComputeRasterMinMax = *Geo::GDALc::Band_ComputeRasterMinMax;
447             *ComputeBandStats = *Geo::GDALc::Band_ComputeBandStats;
448             *Fill = *Geo::GDALc::Band_Fill;
449             *_ReadRaster = *Geo::GDALc::Band__ReadRaster;
450             *_WriteRaster = *Geo::GDALc::Band__WriteRaster;
451             *FlushCache = *Geo::GDALc::Band_FlushCache;
452             *GetRasterColorTable = *Geo::GDALc::Band_GetRasterColorTable;
453             *GetColorTable = *Geo::GDALc::Band_GetColorTable;
454             *SetRasterColorTable = *Geo::GDALc::Band_SetRasterColorTable;
455             *SetColorTable = *Geo::GDALc::Band_SetColorTable;
456             *GetDefaultRAT = *Geo::GDALc::Band_GetDefaultRAT;
457             *SetDefaultRAT = *Geo::GDALc::Band_SetDefaultRAT;
458             *_GetMaskBand = *Geo::GDALc::Band__GetMaskBand;
459             *_GetMaskFlags = *Geo::GDALc::Band__GetMaskFlags;
460             *_CreateMaskBand = *Geo::GDALc::Band__CreateMaskBand;
461             *_GetHistogram = *Geo::GDALc::Band__GetHistogram;
462             *GetDefaultHistogram = *Geo::GDALc::Band_GetDefaultHistogram;
463             *SetDefaultHistogram = *Geo::GDALc::Band_SetDefaultHistogram;
464             *HasArbitraryOverviews = *Geo::GDALc::Band_HasArbitraryOverviews;
465             *GetCategoryNames = *Geo::GDALc::Band_GetCategoryNames;
466             *SetCategoryNames = *Geo::GDALc::Band_SetCategoryNames;
467             *ContourGenerate = *Geo::GDALc::Band_ContourGenerate;
468             sub DISOWN {
469 0     0   0 my $self = shift;
470 0         0 my $ptr = tied(%$self);
471 0         0 delete $OWNER{$ptr};
472             }
473              
474             sub ACQUIRE {
475 0     0   0 my $self = shift;
476 0         0 my $ptr = tied(%$self);
477 0         0 $OWNER{$ptr} = 1;
478             }
479              
480              
481             ############# Class : Geo::GDAL::ColorTable ##############
482              
483             package Geo::GDAL::ColorTable;
484 19     19   87 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         21  
  19         966  
485             @ISA = qw( Geo::GDAL );
486             %OWNER = ();
487 19     19   185 use Carp;
  19         18  
  19         5732  
488             sub new {
489 10     10   2776 my($pkg, $pi) = @_;
490 10   100     30 $pi //= 'RGB';
491 10         22 $pi = Geo::GDAL::string2int($pi, \%PALETTE_INTERPRETATION_STRING2INT);
492 10         117 my $self = Geo::GDALc::new_ColorTable($pi);
493 10 50       51 bless $self, $pkg if defined($self);
494             }
495              
496             sub DESTROY {
497 40     40   2638 my $self = shift;
498 40 100       134 unless ($self->isa('SCALAR')) {
499 20 50       43 return unless $self->isa('HASH');
500 20         20 $self = tied(%{$self});
  20         20  
501 20 50       35 return unless defined $self;
502             }
503 40         37 my $code = $Geo::GDAL::stdout_redirection{$self};
504 40         32 delete $Geo::GDAL::stdout_redirection{$self};
505 40         31 delete $ITERATORS{$self};
506 40 100       65 if (exists $OWNER{$self}) {
507 10         54 Geo::GDALc::delete_ColorTable($self);
508 10         14 delete $OWNER{$self};
509             }
510 40         62 $self->RELEASE_PARENTS();
511 40 50       148 if ($code) {
512 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
513 0         0 $code->close;
514             }
515              
516             }
517              
518             *Clone = *Geo::GDALc::ColorTable_Clone;
519             *_GetPaletteInterpretation = *Geo::GDALc::ColorTable__GetPaletteInterpretation;
520             *GetCount = *Geo::GDALc::ColorTable_GetCount;
521             *GetColorEntry = *Geo::GDALc::ColorTable_GetColorEntry;
522             *GetColorEntryAsRGB = *Geo::GDALc::ColorTable_GetColorEntryAsRGB;
523             *_SetColorEntry = *Geo::GDALc::ColorTable__SetColorEntry;
524             *CreateColorRamp = *Geo::GDALc::ColorTable_CreateColorRamp;
525             sub DISOWN {
526 0     0   0 my $self = shift;
527 0         0 my $ptr = tied(%$self);
528 0         0 delete $OWNER{$ptr};
529             }
530              
531             sub ACQUIRE {
532 0     0   0 my $self = shift;
533 0         0 my $ptr = tied(%$self);
534 0         0 $OWNER{$ptr} = 1;
535             }
536              
537              
538             ############# Class : Geo::GDAL::RasterAttributeTable ##############
539              
540             package Geo::GDAL::RasterAttributeTable;
541 19     19   69 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         17  
  19         6557  
542             @ISA = qw( Geo::GDAL );
543             %OWNER = ();
544             sub new {
545 3     3   375 my $pkg = shift;
546 3         61 my $self = Geo::GDALc::new_RasterAttributeTable(@_);
547 3 50       23 bless $self, $pkg if defined($self);
548             }
549              
550             sub DESTROY {
551 10     10   495 my $self = shift;
552 10 100       60 unless ($self->isa('SCALAR')) {
553 5 50       19 return unless $self->isa('HASH');
554 5         7 $self = tied(%{$self});
  5         9  
555 5 50       12 return unless defined $self;
556             }
557 10         14 my $code = $Geo::GDAL::stdout_redirection{$self};
558 10         10 delete $Geo::GDAL::stdout_redirection{$self};
559 10         9 delete $ITERATORS{$self};
560 10 100       21 if (exists $OWNER{$self}) {
561 3         28 Geo::GDALc::delete_RasterAttributeTable($self);
562 3         7 delete $OWNER{$self};
563             }
564 10         24 $self->RELEASE_PARENTS();
565 10 50       31 if ($code) {
566 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
567 0         0 $code->close;
568             }
569              
570             }
571              
572             *Clone = *Geo::GDALc::RasterAttributeTable_Clone;
573             *GetColumnCount = *Geo::GDALc::RasterAttributeTable_GetColumnCount;
574             *GetNameOfCol = *Geo::GDALc::RasterAttributeTable_GetNameOfCol;
575             *_GetUsageOfCol = *Geo::GDALc::RasterAttributeTable__GetUsageOfCol;
576             *_GetTypeOfCol = *Geo::GDALc::RasterAttributeTable__GetTypeOfCol;
577             *_GetColOfUsage = *Geo::GDALc::RasterAttributeTable__GetColOfUsage;
578             *GetRowCount = *Geo::GDALc::RasterAttributeTable_GetRowCount;
579             *GetValueAsString = *Geo::GDALc::RasterAttributeTable_GetValueAsString;
580             *GetValueAsInt = *Geo::GDALc::RasterAttributeTable_GetValueAsInt;
581             *GetValueAsDouble = *Geo::GDALc::RasterAttributeTable_GetValueAsDouble;
582             *SetValueAsString = *Geo::GDALc::RasterAttributeTable_SetValueAsString;
583             *SetValueAsInt = *Geo::GDALc::RasterAttributeTable_SetValueAsInt;
584             *SetValueAsDouble = *Geo::GDALc::RasterAttributeTable_SetValueAsDouble;
585             *SetRowCount = *Geo::GDALc::RasterAttributeTable_SetRowCount;
586             *_CreateColumn = *Geo::GDALc::RasterAttributeTable__CreateColumn;
587             *GetLinearBinning = *Geo::GDALc::RasterAttributeTable_GetLinearBinning;
588             *SetLinearBinning = *Geo::GDALc::RasterAttributeTable_SetLinearBinning;
589             *GetRowOfValue = *Geo::GDALc::RasterAttributeTable_GetRowOfValue;
590             *ChangesAreWrittenToFile = *Geo::GDALc::RasterAttributeTable_ChangesAreWrittenToFile;
591             *DumpReadable = *Geo::GDALc::RasterAttributeTable_DumpReadable;
592             sub DISOWN {
593 0     0   0 my $self = shift;
594 0         0 my $ptr = tied(%$self);
595 0         0 delete $OWNER{$ptr};
596             }
597              
598             sub ACQUIRE {
599 0     0   0 my $self = shift;
600 0         0 my $ptr = tied(%$self);
601 0         0 $OWNER{$ptr} = 1;
602             }
603              
604              
605             ############# Class : Geo::GDAL::Transformer ##############
606              
607             package Geo::GDAL::Transformer;
608 19     19   76 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         23  
  19         4132  
609             @ISA = qw( Geo::GDAL );
610             %OWNER = ();
611             %ITERATORS = ();
612             sub new {
613 0     0   0 my $pkg = shift;
614 0         0 my $self = Geo::GDALc::new_Transformer(@_);
615 0 0       0 bless $self, $pkg if defined($self);
616             }
617              
618             sub DESTROY {
619 0 0   0   0 return unless $_[0]->isa('HASH');
620 0         0 my $self = tied(%{$_[0]});
  0         0  
621 0 0       0 return unless defined $self;
622 0         0 delete $ITERATORS{$self};
623 0 0       0 if (exists $OWNER{$self}) {
624 0         0 Geo::GDALc::delete_Transformer($self);
625 0         0 delete $OWNER{$self};
626             }
627             }
628              
629             *TransformPoint = *Geo::GDALc::Transformer_TransformPoint;
630             *_TransformPoints = *Geo::GDALc::Transformer__TransformPoints;
631             *TransformGeolocations = *Geo::GDALc::Transformer_TransformGeolocations;
632             sub DISOWN {
633 0     0   0 my $self = shift;
634 0         0 my $ptr = tied(%$self);
635 0         0 delete $OWNER{$ptr};
636             }
637              
638             sub ACQUIRE {
639 0     0   0 my $self = shift;
640 0         0 my $ptr = tied(%$self);
641 0         0 $OWNER{$ptr} = 1;
642             }
643              
644              
645             ############# Class : Geo::GDAL::GDALInfoOptions ##############
646              
647             package Geo::GDAL::GDALInfoOptions;
648 19     19   72 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         21  
  19         3602  
649             @ISA = qw( Geo::GDAL );
650             %OWNER = ();
651             %ITERATORS = ();
652             sub new {
653 0     0   0 my $pkg = shift;
654 0         0 my $self = Geo::GDALc::new_GDALInfoOptions(@_);
655 0 0       0 bless $self, $pkg if defined($self);
656             }
657              
658             sub DESTROY {
659 0 0   0   0 return unless $_[0]->isa('HASH');
660 0         0 my $self = tied(%{$_[0]});
  0         0  
661 0 0       0 return unless defined $self;
662 0         0 delete $ITERATORS{$self};
663 0 0       0 if (exists $OWNER{$self}) {
664 0         0 Geo::GDALc::delete_GDALInfoOptions($self);
665 0         0 delete $OWNER{$self};
666             }
667             }
668              
669             sub DISOWN {
670 0     0   0 my $self = shift;
671 0         0 my $ptr = tied(%$self);
672 0         0 delete $OWNER{$ptr};
673             }
674              
675             sub ACQUIRE {
676 0     0   0 my $self = shift;
677 0         0 my $ptr = tied(%$self);
678 0         0 $OWNER{$ptr} = 1;
679             }
680              
681              
682             ############# Class : Geo::GDAL::GDALTranslateOptions ##############
683              
684             package Geo::GDAL::GDALTranslateOptions;
685 19     19   76 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         23  
  19         3514  
686             @ISA = qw( Geo::GDAL );
687             %OWNER = ();
688             %ITERATORS = ();
689             sub new {
690 0     0   0 my $pkg = shift;
691 0         0 my $self = Geo::GDALc::new_GDALTranslateOptions(@_);
692 0 0       0 bless $self, $pkg if defined($self);
693             }
694              
695             sub DESTROY {
696 0 0   0   0 return unless $_[0]->isa('HASH');
697 0         0 my $self = tied(%{$_[0]});
  0         0  
698 0 0       0 return unless defined $self;
699 0         0 delete $ITERATORS{$self};
700 0 0       0 if (exists $OWNER{$self}) {
701 0         0 Geo::GDALc::delete_GDALTranslateOptions($self);
702 0         0 delete $OWNER{$self};
703             }
704             }
705              
706             sub DISOWN {
707 0     0   0 my $self = shift;
708 0         0 my $ptr = tied(%$self);
709 0         0 delete $OWNER{$ptr};
710             }
711              
712             sub ACQUIRE {
713 0     0   0 my $self = shift;
714 0         0 my $ptr = tied(%$self);
715 0         0 $OWNER{$ptr} = 1;
716             }
717              
718              
719             ############# Class : Geo::GDAL::GDALWarpAppOptions ##############
720              
721             package Geo::GDAL::GDALWarpAppOptions;
722 19     19   66 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         17  
  19         3639  
723             @ISA = qw( Geo::GDAL );
724             %OWNER = ();
725             %ITERATORS = ();
726             sub new {
727 2     2   3 my $pkg = shift;
728 2         46 my $self = Geo::GDALc::new_GDALWarpAppOptions(@_);
729 2 50       13 bless $self, $pkg if defined($self);
730             }
731              
732             sub DESTROY {
733 4 100   4   23 return unless $_[0]->isa('HASH');
734 2         3 my $self = tied(%{$_[0]});
  2         4  
735 2 50       4 return unless defined $self;
736 2         3 delete $ITERATORS{$self};
737 2 50       6 if (exists $OWNER{$self}) {
738 2         10 Geo::GDALc::delete_GDALWarpAppOptions($self);
739 2         6 delete $OWNER{$self};
740             }
741             }
742              
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             ############# Class : Geo::GDAL::GDALVectorTranslateOptions ##############
757              
758             package Geo::GDAL::GDALVectorTranslateOptions;
759 19     19   66 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         16  
  19         3614  
760             @ISA = qw( Geo::GDAL );
761             %OWNER = ();
762             %ITERATORS = ();
763             sub new {
764 0     0   0 my $pkg = shift;
765 0         0 my $self = Geo::GDALc::new_GDALVectorTranslateOptions(@_);
766 0 0       0 bless $self, $pkg if defined($self);
767             }
768              
769             sub DESTROY {
770 0 0   0   0 return unless $_[0]->isa('HASH');
771 0         0 my $self = tied(%{$_[0]});
  0         0  
772 0 0       0 return unless defined $self;
773 0         0 delete $ITERATORS{$self};
774 0 0       0 if (exists $OWNER{$self}) {
775 0         0 Geo::GDALc::delete_GDALVectorTranslateOptions($self);
776 0         0 delete $OWNER{$self};
777             }
778             }
779              
780             sub DISOWN {
781 0     0   0 my $self = shift;
782 0         0 my $ptr = tied(%$self);
783 0         0 delete $OWNER{$ptr};
784             }
785              
786             sub ACQUIRE {
787 0     0   0 my $self = shift;
788 0         0 my $ptr = tied(%$self);
789 0         0 $OWNER{$ptr} = 1;
790             }
791              
792              
793             ############# Class : Geo::GDAL::GDALDEMProcessingOptions ##############
794              
795             package Geo::GDAL::GDALDEMProcessingOptions;
796 19     19   66 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         16  
  19         3840  
797             @ISA = qw( Geo::GDAL );
798             %OWNER = ();
799             %ITERATORS = ();
800             sub new {
801 0     0   0 my $pkg = shift;
802 0         0 my $self = Geo::GDALc::new_GDALDEMProcessingOptions(@_);
803 0 0       0 bless $self, $pkg if defined($self);
804             }
805              
806             sub DESTROY {
807 0 0   0   0 return unless $_[0]->isa('HASH');
808 0         0 my $self = tied(%{$_[0]});
  0         0  
809 0 0       0 return unless defined $self;
810 0         0 delete $ITERATORS{$self};
811 0 0       0 if (exists $OWNER{$self}) {
812 0         0 Geo::GDALc::delete_GDALDEMProcessingOptions($self);
813 0         0 delete $OWNER{$self};
814             }
815             }
816              
817             sub DISOWN {
818 0     0   0 my $self = shift;
819 0         0 my $ptr = tied(%$self);
820 0         0 delete $OWNER{$ptr};
821             }
822              
823             sub ACQUIRE {
824 0     0   0 my $self = shift;
825 0         0 my $ptr = tied(%$self);
826 0         0 $OWNER{$ptr} = 1;
827             }
828              
829              
830             ############# Class : Geo::GDAL::GDALNearblackOptions ##############
831              
832             package Geo::GDAL::GDALNearblackOptions;
833 19     19   68 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         18  
  19         3560  
834             @ISA = qw( Geo::GDAL );
835             %OWNER = ();
836             %ITERATORS = ();
837             sub new {
838 0     0   0 my $pkg = shift;
839 0         0 my $self = Geo::GDALc::new_GDALNearblackOptions(@_);
840 0 0       0 bless $self, $pkg if defined($self);
841             }
842              
843             sub DESTROY {
844 0 0   0   0 return unless $_[0]->isa('HASH');
845 0         0 my $self = tied(%{$_[0]});
  0         0  
846 0 0       0 return unless defined $self;
847 0         0 delete $ITERATORS{$self};
848 0 0       0 if (exists $OWNER{$self}) {
849 0         0 Geo::GDALc::delete_GDALNearblackOptions($self);
850 0         0 delete $OWNER{$self};
851             }
852             }
853              
854             sub DISOWN {
855 0     0   0 my $self = shift;
856 0         0 my $ptr = tied(%$self);
857 0         0 delete $OWNER{$ptr};
858             }
859              
860             sub ACQUIRE {
861 0     0   0 my $self = shift;
862 0         0 my $ptr = tied(%$self);
863 0         0 $OWNER{$ptr} = 1;
864             }
865              
866              
867             ############# Class : Geo::GDAL::GDALGridOptions ##############
868              
869             package Geo::GDAL::GDALGridOptions;
870 19     19   69 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         14  
  19         3442  
871             @ISA = qw( Geo::GDAL );
872             %OWNER = ();
873             %ITERATORS = ();
874             sub new {
875 0     0   0 my $pkg = shift;
876 0         0 my $self = Geo::GDALc::new_GDALGridOptions(@_);
877 0 0       0 bless $self, $pkg if defined($self);
878             }
879              
880             sub DESTROY {
881 0 0   0   0 return unless $_[0]->isa('HASH');
882 0         0 my $self = tied(%{$_[0]});
  0         0  
883 0 0       0 return unless defined $self;
884 0         0 delete $ITERATORS{$self};
885 0 0       0 if (exists $OWNER{$self}) {
886 0         0 Geo::GDALc::delete_GDALGridOptions($self);
887 0         0 delete $OWNER{$self};
888             }
889             }
890              
891             sub DISOWN {
892 0     0   0 my $self = shift;
893 0         0 my $ptr = tied(%$self);
894 0         0 delete $OWNER{$ptr};
895             }
896              
897             sub ACQUIRE {
898 0     0   0 my $self = shift;
899 0         0 my $ptr = tied(%$self);
900 0         0 $OWNER{$ptr} = 1;
901             }
902              
903              
904             ############# Class : Geo::GDAL::GDALRasterizeOptions ##############
905              
906             package Geo::GDAL::GDALRasterizeOptions;
907 19     19   64 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         19  
  19         3439  
908             @ISA = qw( Geo::GDAL );
909             %OWNER = ();
910             %ITERATORS = ();
911             sub new {
912 0     0   0 my $pkg = shift;
913 0         0 my $self = Geo::GDALc::new_GDALRasterizeOptions(@_);
914 0 0       0 bless $self, $pkg if defined($self);
915             }
916              
917             sub DESTROY {
918 0 0   0   0 return unless $_[0]->isa('HASH');
919 0         0 my $self = tied(%{$_[0]});
  0         0  
920 0 0       0 return unless defined $self;
921 0         0 delete $ITERATORS{$self};
922 0 0       0 if (exists $OWNER{$self}) {
923 0         0 Geo::GDALc::delete_GDALRasterizeOptions($self);
924 0         0 delete $OWNER{$self};
925             }
926             }
927              
928             sub DISOWN {
929 0     0   0 my $self = shift;
930 0         0 my $ptr = tied(%$self);
931 0         0 delete $OWNER{$ptr};
932             }
933              
934             sub ACQUIRE {
935 0     0   0 my $self = shift;
936 0         0 my $ptr = tied(%$self);
937 0         0 $OWNER{$ptr} = 1;
938             }
939              
940              
941             ############# Class : Geo::GDAL::GDALBuildVRTOptions ##############
942              
943             package Geo::GDAL::GDALBuildVRTOptions;
944 19     19   70 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  19         14  
  19         3579  
945             @ISA = qw( Geo::GDAL );
946             %OWNER = ();
947             %ITERATORS = ();
948             sub new {
949 0     0   0 my $pkg = shift;
950 0         0 my $self = Geo::GDALc::new_GDALBuildVRTOptions(@_);
951 0 0       0 bless $self, $pkg if defined($self);
952             }
953              
954             sub DESTROY {
955 0 0   0   0 return unless $_[0]->isa('HASH');
956 0         0 my $self = tied(%{$_[0]});
  0         0  
957 0 0       0 return unless defined $self;
958 0         0 delete $ITERATORS{$self};
959 0 0       0 if (exists $OWNER{$self}) {
960 0         0 Geo::GDALc::delete_GDALBuildVRTOptions($self);
961 0         0 delete $OWNER{$self};
962             }
963             }
964              
965             sub DISOWN {
966 0     0   0 my $self = shift;
967 0         0 my $ptr = tied(%$self);
968 0         0 delete $OWNER{$ptr};
969             }
970              
971             sub ACQUIRE {
972 0     0   0 my $self = shift;
973 0         0 my $ptr = tied(%$self);
974 0         0 $OWNER{$ptr} = 1;
975             }
976              
977              
978             # ------- VARIABLE STUBS --------
979              
980             package Geo::GDAL;
981              
982             *TermProgress = *Geo::GDALc::TermProgress;
983              
984              
985             package Geo::GDAL;
986             require 5.10.0; # we use //=
987 19     19   72 use strict;
  19         20  
  19         324  
988 19     19   52 use warnings;
  19         16  
  19         407  
989 19     19   48 use Carp;
  19         15  
  19         779  
990 19     19   8415 use Encode;
  19         121386  
  19         1120  
991 19     19   87 use Exporter 'import';
  19         20  
  19         368  
992 19     19   6374 use Geo::GDAL::Const;
  19         31  
  19         741  
993 19     19   9348 use Geo::OGR;
  19         42  
  19         1349  
994 19     19   96 use Geo::OSR;
  19         20  
  19         1319  
995             # $VERSION is the Perl module (CPAN) version number, which must be
996             # an increasing floating point number. $GDAL_VERSION is the
997             # version number of the GDAL that this module is a part of. It is
998             # used in build time to check the version of GDAL against which we
999             # build.
1000             # For GDAL 2.0 or above, GDAL X.Y.Z should then
1001             # VERSION = X + Y / 100.0 + Z / 10000.0
1002             # Note also the $VERSION in ogr_perl.i (required by pause.perl.org)
1003             # Note that the 1/100000 digits may be used to create more than one
1004             # CPAN release from one GDAL release.
1005              
1006             our $VERSION = '2.010301';
1007             our $GDAL_VERSION = '2.1.3';
1008              
1009             =pod
1010              
1011             =head1 NAME
1012              
1013             Geo::GDAL - Perl extension for the GDAL library for geospatial data
1014              
1015             =head1 SYNOPSIS
1016              
1017             use Geo::GDAL;
1018              
1019             my $raster_file = shift @ARGV;
1020              
1021             my $raster_dataset = Geo::GDAL::Open($file);
1022              
1023             my $raster_data = $dataset->GetRasterBand(1)->ReadTile;
1024              
1025             my $vector_datasource = Geo::OGR::Open('./');
1026              
1027             my $vector_layer = $datasource->Layer('borders'); # e.g. a shapefile borders.shp in current directory
1028              
1029             $vector_layer->ResetReading();
1030             while (my $feature = $vector_layer->GetNextFeature()) {
1031             my $geometry = $feature->GetGeometry();
1032             my $value = $feature->GetField($field);
1033             }
1034              
1035             =head1 DESCRIPTION
1036              
1037             This Perl module lets you to manage (read, analyse, write) geospatial
1038             data stored in several formats.
1039              
1040             =head2 EXPORT
1041              
1042             None by default.
1043              
1044             =head1 SEE ALSO
1045              
1046             The GDAL home page is L
1047              
1048             The documentation of this module is written in Doxygen format. See
1049             L
1050              
1051             =head1 AUTHOR
1052              
1053             Ari Jolma
1054              
1055             =head1 COPYRIGHT AND LICENSE
1056              
1057             Copyright (C) 2005- by Ari Jolma and GDAL bindings developers.
1058              
1059             This library is free software; you can redistribute it and/or modify
1060             it under the terms of MIT License
1061              
1062             L
1063              
1064             =head1 REPOSITORY
1065              
1066             L
1067              
1068             =cut
1069              
1070 19     19   74 use Scalar::Util 'blessed';
  19         21  
  19         1073  
1071 19         46197 use vars qw/
1072             @EXPORT_OK %EXPORT_TAGS
1073             @DATA_TYPES @OPEN_FLAGS @RESAMPLING_TYPES @RIO_RESAMPLING_TYPES @NODE_TYPES
1074             %TYPE_STRING2INT %TYPE_INT2STRING
1075             %OF_STRING2INT
1076             %RESAMPLING_STRING2INT %RESAMPLING_INT2STRING
1077             %RIO_RESAMPLING_STRING2INT %RIO_RESAMPLING_INT2STRING
1078             %NODE_TYPE_STRING2INT %NODE_TYPE_INT2STRING
1079             @error %stdout_redirection
1080 19     19   72 /;
  19         21  
1081             @EXPORT_OK = qw/Driver Open BuildVRT/;
1082             %EXPORT_TAGS = (all => [qw(Driver Open BuildVRT)]);
1083             *BuildVRT = *Geo::GDAL::Dataset::BuildVRT;
1084             for (keys %Geo::GDAL::Const::) {
1085             next if /TypeCount/;
1086             push(@DATA_TYPES, $1), next if /^GDT_(\w+)/;
1087             push(@OPEN_FLAGS, $1), next if /^OF_(\w+)/;
1088             push(@RESAMPLING_TYPES, $1), next if /^GRA_(\w+)/;
1089             push(@RIO_RESAMPLING_TYPES, $1), next if /^GRIORA_(\w+)/;
1090             push(@NODE_TYPES, $1), next if /^CXT_(\w+)/;
1091             }
1092             for my $string (@DATA_TYPES) {
1093             my $int = eval "\$Geo::GDAL::Const::GDT_$string";
1094             $TYPE_STRING2INT{$string} = $int;
1095             $TYPE_INT2STRING{$int} = $string;
1096             }
1097             for my $string (@OPEN_FLAGS) {
1098             my $int = eval "\$Geo::GDAL::Const::OF_$string";
1099             $OF_STRING2INT{$string} = $int;
1100             }
1101             for my $string (@RESAMPLING_TYPES) {
1102             my $int = eval "\$Geo::GDAL::Const::GRA_$string";
1103             $RESAMPLING_STRING2INT{$string} = $int;
1104             $RESAMPLING_INT2STRING{$int} = $string;
1105             }
1106             for my $string (@RIO_RESAMPLING_TYPES) {
1107             my $int = eval "\$Geo::GDAL::Const::GRIORA_$string";
1108             $RIO_RESAMPLING_STRING2INT{$string} = $int;
1109             $RIO_RESAMPLING_INT2STRING{$int} = $string;
1110             }
1111             for my $string (@NODE_TYPES) {
1112             my $int = eval "\$Geo::GDAL::Const::CXT_$string";
1113             $NODE_TYPE_STRING2INT{$string} = $int;
1114             $NODE_TYPE_INT2STRING{$int} = $string;
1115             }
1116              
1117             our $HAVE_PDL;
1118             eval 'require PDL';
1119             $HAVE_PDL = 1 unless $@;
1120              
1121             sub error {
1122 13 50   13 0 26 if (@_) {
1123 13         10 my $error;
1124 13 100       28 if (@_ == 3) {
1125 2         3 my ($ecode, $offender, $ex) = @_;
1126 2 50       5 if ($ecode == 1) {
    0          
1127 2         19 my @k = sort keys %$ex;
1128 2 50       10 $error = "Unknown value: '$offender'. " if defined $offender;
1129 2         9 $error .= "Expected one of ".join(', ', @k).".";
1130             } elsif ($ecode == 2) {
1131 0         0 $error = "$ex not found: '$offender'.";
1132             } else {
1133 0         0 die("error in error: $ecode, $offender, $ex");
1134             }
1135             } else {
1136 11         9 $error = shift;
1137             }
1138 13         19 push @error, $error;
1139 13         1542 confess($error);
1140             }
1141 0         0 my @stack = @error;
1142 0         0 chomp(@stack);
1143 0         0 @error = ();
1144 0 0       0 return wantarray ? @stack : join("\n", @stack);
1145             }
1146              
1147             sub last_error {
1148 1   50 1 0 3 my $error = $error[$#error] // '';
1149 1         3 chomp($error);
1150 1         72 return $error;
1151             }
1152              
1153             sub errstr {
1154 3     3 0 529 my @stack = @error;
1155 3         4 chomp(@stack);
1156 3         3 @error = ();
1157 3         7 return join("\n", @stack);
1158             }
1159              
1160             # usage: named_parameters(\@_, key value list of default parameters);
1161             # returns parameters in a hash with low-case-without-_ keys
1162             sub named_parameters {
1163 758     758 0 1408 my $parameters = shift;
1164 758         2283 my %defaults = @_;
1165 758         539 my %c;
1166 758         1789 for my $k (keys %defaults) {
1167 7208         4839 my $c = lc($k); $c =~ s/_//g;
  7208         4707  
1168 7208         6452 $c{$c} = $k;
1169             }
1170 758         751 my %named;
1171 758 100       1938 my @p = ref($parameters->[0]) eq 'HASH' ? %{$parameters->[0]} : @$parameters;
  2         7  
1172 758 100       1115 if (@p) {
1173 745   50     1226 my $c = lc($p[0] // ''); $c =~ s/_//g;
  745         652  
1174 745 100 66     1858 if (@p % 2 == 0 && defined $c && exists $c{$c}) {
      66        
1175 66         142 for (my $i = 0; $i < @p; $i+=2) {
1176 205         235 my $c = lc($p[$i]); $c =~ s/_//g;
  205         164  
1177 205 50 33     623 error(1, $p[$i], \%defaults) unless defined $c{$c} && exists $defaults{$c{$c}};
1178 205         417 $named{$c} = $p[$i+1];
1179             }
1180             } else {
1181 679         1114 for (my $i = 0; $i < @p; $i++) {
1182 3373         3010 my $c = lc($_[$i*2]); $c =~ s/_//g;
  3373         2341  
1183 3373         2742 my $t = ref($defaults{$c{$c}});
1184 3373 50 66     9782 if (!blessed($p[$i]) and (ref($p[$i]) ne $t)) {
1185 0 0       0 $t = $t eq '' ? 'SCALAR' : "a reference to $t";
1186 0         0 error("parameter '$p[$i]' is not $t as it should for parameter $c{$c}.");
1187             }
1188 3373         5663 $named{$c} = $p[$i]; # $p[$i] could be a sub ...
1189             }
1190             }
1191             }
1192 758         1358 for my $k (keys %defaults) {
1193 7208         4926 my $c = lc($k); $c =~ s/_//g;
  7208         4684  
1194 7208   100     13081 $named{$c} //= $defaults{$k};
1195             }
1196 758         2357 return \%named;
1197             }
1198              
1199             sub string2int {
1200 1124     1124 0 2087 my ($string, $string2int_hash, $int2string_hash, $default) = @_;
1201 1124 100 66     1766 $string = $default if defined $default && !defined $string;
1202 1124 100       1355 return unless defined $string;
1203 1123 100 66     2289 return $string if $int2string_hash && exists $int2string_hash->{$string};
1204 1036 100       1464 error(1, $string, $string2int_hash) unless exists $string2int_hash->{$string};
1205 1034         1255 $string2int_hash->{$string};
1206             }
1207              
1208       104 0   sub RELEASE_PARENTS {
1209             }
1210              
1211             sub FindFile {
1212             if (@_ == 1) {
1213             _FindFile('', @_);
1214             } else {
1215             _FindFile(@_);
1216             }
1217             }
1218              
1219             sub DataTypes {
1220 4     4 0 1292 return @DATA_TYPES;
1221             }
1222              
1223             sub OpenFlags {
1224 0     0 0 0 return @DATA_TYPES;
1225             }
1226              
1227             sub ResamplingTypes {
1228 1     1 0 174 return @RESAMPLING_TYPES;
1229             }
1230              
1231             sub RIOResamplingTypes {
1232 2     2 0 224 return @RIO_RESAMPLING_TYPES;
1233             }
1234              
1235             sub NodeTypes {
1236 1     1 0 214 return @NODE_TYPES;
1237             }
1238              
1239             sub NodeType {
1240 307     307 0 427 my $type = shift;
1241 307 50       679 return $NODE_TYPE_INT2STRING{$type} if $type =~ /^\d/;
1242 0         0 return $NODE_TYPE_STRING2INT{$type};
1243             }
1244              
1245             sub NodeData {
1246 301     301 0 206 my $node = shift;
1247 301         241 return (Geo::GDAL::NodeType($node->[0]), $node->[1]);
1248             }
1249              
1250             sub Children {
1251 36     36 0 24 my $node = shift;
1252 36         59 return @$node[2..$#$node];
1253             }
1254              
1255             sub Child {
1256 150     150 0 100 my($node, $child) = @_;
1257 150         143 return $node->[2+$child];
1258             }
1259              
1260             sub GetDataTypeSize {
1261 32     32 0 274 return _GetDataTypeSize(string2int(shift, \%TYPE_STRING2INT, \%TYPE_INT2STRING));
1262             }
1263              
1264             sub DataTypeValueRange {
1265 12     12 0 23 my $t = shift;
1266 12 50       18 Geo::GDAL::error(1, $t, \%TYPE_STRING2INT) unless exists $TYPE_STRING2INT{$t};
1267             # these values are from gdalrasterband.cpp
1268 12 100       26 return (0,255) if $t =~ /Byte/;
1269 11 100       16 return (0,65535) if $t =~/UInt16/;
1270 10 100       18 return (-32768,32767) if $t =~/Int16/;
1271 8 100       15 return (0,4294967295) if $t =~/UInt32/;
1272 7 100       15 return (-2147483648,2147483647) if $t =~/Int32/;
1273 5 100       13 return (-4294967295.0,4294967295.0) if $t =~/Float32/;
1274 3 100       13 return (-4294967295.0,4294967295.0) if $t =~/Float64/;
1275             }
1276              
1277             sub DataTypeIsComplex {
1278 12     12 0 3838 return _DataTypeIsComplex(string2int(shift, \%TYPE_STRING2INT));
1279             }
1280              
1281             sub PackCharacter {
1282 55     55 0 1371 my $t = shift;
1283 55 100       143 $t = $TYPE_INT2STRING{$t} if exists $TYPE_INT2STRING{$t};
1284 55 50       98 Geo::GDAL::error(1, $t, \%TYPE_STRING2INT) unless exists $TYPE_STRING2INT{$t};
1285 55         199 my $is_big_endian = unpack("h*", pack("s", 1)) =~ /01/; # from Programming Perl
1286 55 100       167 return 'C' if $t =~ /^Byte$/;
1287 31 50       55 return ($is_big_endian ? 'n': 'v') if $t =~ /^UInt16$/;
    100          
1288 29 100       49 return 's' if $t =~ /^Int16$/;
1289 27 50       45 return ($is_big_endian ? 'N' : 'V') if $t =~ /^UInt32$/;
    100          
1290 26 100       69 return 'l' if $t =~ /^Int32$/;
1291 16 100       38 return 'f' if $t =~ /^Float32$/;
1292 14 100       54 return 'd' if $t =~ /^Float64$/;
1293             }
1294              
1295             sub GetDriverNames {
1296 2     2 0 20435 my @names;
1297 2         23 for my $i (0..GetDriverCount()-1) {
1298 306         825 my $driver = GetDriver($i);
1299 306 100       302 push @names, $driver->Name if $driver->TestCapability('RASTER');
1300             }
1301 2         54 return @names;
1302             }
1303             *DriverNames = *GetDriverNames;
1304              
1305             sub Drivers {
1306 1     1 0 1018 my @drivers;
1307 1         30 for my $i (0..GetDriverCount()-1) {
1308 153         378 my $driver = GetDriver($i);
1309 153 100       150 push @drivers, $driver if $driver->TestCapability('RASTER');
1310             }
1311 1         7 return @drivers;
1312             }
1313              
1314             sub Driver {
1315 61 100   61 0 9647 return 'Geo::GDAL::Driver' unless @_;
1316 58         1206 return GetDriver(@_);
1317             }
1318              
1319             sub AccessTypes {
1320 1     1 0 9 return qw/ReadOnly Update/;
1321             }
1322              
1323             sub Open {
1324 2     2 0 14 my $p = Geo::GDAL::named_parameters(\@_, Name => '.', Access => 'ReadOnly', Type => 'Any', Options => {}, Files => []);
1325 2         3 my @flags;
1326 2         4 my %o = (READONLY => 1, UPDATE => 1);
1327 2 50       5 Geo::GDAL::error(1, $p->{access}, \%o) unless $o{uc($p->{access})};
1328 2         5 push @flags, uc($p->{access});
1329 2         5 %o = (RASTER => 1, VECTOR => 1, ANY => 1);
1330 2 50       4 Geo::GDAL::error(1, $p->{type}, \%o) unless $o{uc($p->{type})};
1331 2 50       5 push @flags, uc($p->{type}) unless uc($p->{type}) eq 'ANY';
1332 2         6 my $dataset = OpenEx(Name => $p->{name}, Flags => \@flags, Options => $p->{options}, Files => $p->{files});
1333 2 50       6 unless ($dataset) {
1334 0         0 my $t = "Failed to open $p->{name}.";
1335 0 0       0 $t .= " Is it a ".lc($p->{type})." dataset?" unless uc($p->{type}) eq 'ANY';
1336 0         0 error($t);
1337             }
1338 2         6 return $dataset;
1339             }
1340              
1341             sub OpenShared {
1342 2     2 0 551 my @p = @_; # name, update
1343 2         4 my @flags = qw/RASTER SHARED/;
1344 2   50     6 $p[1] //= 'ReadOnly';
1345 2 50 33     6 Geo::GDAL::error(1, $p[1], {ReadOnly => 1, Update => 1}) unless ($p[1] eq 'ReadOnly' or $p[1] eq 'Update');
1346 2 50       4 push @flags, qw/READONLY/ if $p[1] eq 'ReadOnly';
1347 2 50       3 push @flags, qw/UPDATE/ if $p[1] eq 'Update';
1348 2         5 my $dataset = OpenEx($p[0], \@flags);
1349 2 50       6 error("Failed to open $p[0]. Is it a raster dataset?") unless $dataset;
1350 2         4 return $dataset;
1351             }
1352              
1353             sub OpenEx {
1354 6     6 0 103 my $p = Geo::GDAL::named_parameters(\@_, Name => '.', Flags => [], Drivers => [], Options => {}, Files => []);
1355 6 50       11 unless ($p) {
1356 0   0     0 my $name = shift // '';
1357 0         0 my @flags = @_;
1358 0         0 $p = {name => $name, flags => \@flags, drivers => [], options => {}, files => []};
1359             }
1360 6 50       10 if ($p->{flags}) {
1361 6         6 my $f = 0;
1362 6         5 for my $flag (@{$p->{flags}}) {
  6         10  
1363 8 50       11 Geo::GDAL::error(1, $flag, \%OF_STRING2INT) unless exists $OF_STRING2INT{$flag};
1364 8         9 $f |= $Geo::GDAL::OF_STRING2INT{$flag};
1365             }
1366 6         8 $p->{flags} = $f;
1367             }
1368 6         568 return _OpenEx($p->{name}, $p->{flags}, $p->{drivers}, $p->{options}, $p->{files});
1369             }
1370              
1371             sub Polygonize {
1372 0     0 0 0 my @params = @_;
1373 0 0       0 $params[3] = $params[2]->GetLayerDefn->GetFieldIndex($params[3]) unless $params[3] =~ /^\d/;
1374 0         0 _Polygonize(@params);
1375             }
1376              
1377             sub RegenerateOverviews {
1378 1     1 0 2 my @p = @_;
1379 1 50       3 $p[2] = uc($p[2]) if $p[2]; # see overview.cpp:2030
1380 1         943 _RegenerateOverviews(@p);
1381             }
1382              
1383             sub RegenerateOverview {
1384 2     2 0 286 my @p = @_;
1385 2 100       7 $p[2] = uc($p[2]) if $p[2]; # see overview.cpp:2030
1386 2         1003 _RegenerateOverview(@p);
1387             }
1388              
1389             sub ReprojectImage {
1390 0     0 0 0 my @p = @_;
1391 0         0 $p[4] = string2int($p[4], \%RESAMPLING_STRING2INT);
1392 0         0 return _ReprojectImage(@p);
1393             }
1394              
1395             sub AutoCreateWarpedVRT {
1396 0     0 0 0 my @p = @_;
1397 0         0 for my $i (1..2) {
1398 0 0 0     0 if (defined $p[$i] and ref($p[$i])) {
1399 0         0 $p[$i] = $p[$i]->ExportToWkt;
1400             }
1401             }
1402 0         0 $p[3] = string2int($p[3], \%RESAMPLING_STRING2INT, undef, 'NearestNeighbour');
1403 0         0 return _AutoCreateWarpedVRT(@p);
1404             }
1405              
1406             sub make_processing_options {
1407 2     2 0 3 my ($o) = @_;
1408 2 50       6 if (ref $o eq 'HASH') {
1409 2         5 for my $key (keys %$o) {
1410 2 50       4 unless ($key =~ /^-/) {
1411 2         5 $o->{'-'.$key} = $o->{$key};
1412 2         5 delete $o->{$key};
1413             }
1414             }
1415 2         4 $o = [%$o];
1416             }
1417 2         11 return $o;
1418             }
1419              
1420              
1421              
1422              
1423             package Geo::GDAL::MajorObject;
1424 19     19   106 use strict;
  19         21  
  19         455  
1425 19     19   73 use warnings;
  19         22  
  19         668  
1426 19     19   67 use vars qw/@DOMAINS/;
  19         22  
  19         2759  
1427              
1428             sub Domains {
1429 0     0   0 return @DOMAINS;
1430             }
1431              
1432             sub Description {
1433 0     0   0 my($self, $desc) = @_;
1434 0 0       0 SetDescription($self, $desc) if defined $desc;
1435 0 0       0 GetDescription($self) if defined wantarray;
1436             }
1437              
1438             sub Metadata {
1439 0 0   0   0 my $self = shift,
1440             my $metadata = ref $_[0] ? shift : undef;
1441 0   0     0 my $domain = shift // '';
1442 0 0       0 SetMetadata($self, $metadata, $domain) if defined $metadata;
1443 0 0       0 GetMetadata($self, $domain) if defined wantarray;
1444             }
1445              
1446              
1447              
1448              
1449             package Geo::GDAL::Driver;
1450 19     19   75 use strict;
  19         27  
  19         317  
1451 19     19   61 use warnings;
  19         20  
  19         374  
1452 19     19   56 use Carp;
  19         30  
  19         1005  
1453 19     19   67 use Scalar::Util 'blessed';
  19         23  
  19         650  
1454              
1455 19     19   62 use vars qw/@CAPABILITIES @DOMAINS/;
  19         19  
  19         17926  
1456             for (keys %Geo::GDAL::Const::) {
1457             next if /TypeCount/;
1458             push(@CAPABILITIES, $1), next if /^DCAP_(\w+)/;
1459             }
1460              
1461             sub Domains {
1462 2     2   276 return @DOMAINS;
1463             }
1464              
1465             sub Name {
1466 334     334   1081 my $self = shift;
1467 334         633 return $self->{ShortName};
1468             }
1469              
1470             sub Capabilities {
1471 3     3   14 my $self = shift;
1472 3 100       22 return @CAPABILITIES unless $self;
1473 2         65 my $h = $self->GetMetadata;
1474 2         3 my @cap;
1475 2         5 for my $cap (@CAPABILITIES) {
1476 18         27 my $test = $h->{'DCAP_'.uc($cap)};
1477 18 100 66     46 push @cap, $cap if defined($test) and $test eq 'YES';
1478             }
1479 2         11 return @cap;
1480             }
1481              
1482             sub TestCapability {
1483 620     620   18336 my($self, $cap) = @_;
1484 620         4290 my $h = $self->GetMetadata->{'DCAP_'.uc($cap)};
1485 620 100 66     2698 return (defined($h) and $h eq 'YES') ? 1 : undef;
1486             }
1487              
1488             sub Extension {
1489 2     2   3 my $self = shift;
1490 2         33 my $h = $self->GetMetadata;
1491 2 100       6 if (wantarray) {
1492 1         2 my $e = $h->{DMD_EXTENSIONS};
1493 1         3 my @e = split / /, $e;
1494 1 50       5 @e = split /\//, $e if $e =~ /\//; # ILWIS returns mpr/mpl
1495 1         3 for my $i (0..$#e) {
1496 2         4 $e[$i] =~ s/^\.//; # CALS returns extensions with a dot prefix
1497             }
1498 1         6 return @e;
1499             } else {
1500 1         2 my $e = $h->{DMD_EXTENSION};
1501 1 50       4 return '' if $e =~ /\//; # ILWIS returns mpr/mpl
1502 1         2 $e =~ s/^\.//;
1503 1         4 return $e;
1504             }
1505             }
1506              
1507             sub MIMEType {
1508 1     1   2 my $self = shift;
1509 1         16 my $h = $self->GetMetadata;
1510 1         4 return $h->{DMD_MIMETYPE};
1511             }
1512              
1513             sub CreationOptionList {
1514 1     1   2 my $self = shift;
1515 1         2 my @options;
1516 1         17 my $h = $self->GetMetadata->{DMD_CREATIONOPTIONLIST};
1517 1 50       4 if ($h) {
1518 1         212 $h = Geo::GDAL::ParseXMLString($h);
1519 1         6 my($type, $value) = Geo::GDAL::NodeData($h);
1520 1 50       3 if ($value eq 'CreationOptionList') {
1521 1         3 for my $o (Geo::GDAL::Children($h)) {
1522 35         17 my %option;
1523 35         33 for my $a (Geo::GDAL::Children($o)) {
1524 150         118 my(undef, $key) = Geo::GDAL::NodeData($a);
1525 150         147 my(undef, $value) = Geo::GDAL::NodeData(Geo::GDAL::Child($a, 0));
1526 150 100       159 if ($key eq 'Value') {
1527 39         22 push @{$option{$key}}, $value;
  39         48  
1528             } else {
1529 111         134 $option{$key} = $value;
1530             }
1531             }
1532 35         44 push @options, \%option;
1533             }
1534             }
1535             }
1536 1         35 return @options;
1537             }
1538              
1539             sub CreationDataTypes {
1540 1     1   2 my $self = shift;
1541 1         16 my $h = $self->GetMetadata;
1542 1 50       13 return split /\s+/, $h->{DMD_CREATIONDATATYPES} if $h->{DMD_CREATIONDATATYPES};
1543             }
1544              
1545             sub stdout_redirection_wrapper {
1546 52     52   100 my ($self, $name, $sub, @params) = @_;
1547 52         48 my $object = 0;
1548 52 100 100     309 if ($name && blessed $name) {
1549 1         2 $object = $name;
1550 1         4 my $ref = $object->can('write');
1551 1         11 Geo::GDAL::VSIStdoutSetRedirection($ref);
1552 1         1 $name = '/vsistdout/';
1553             }
1554 52         51 my $ds;
1555 52         63 eval {
1556 52         11738 $ds = $sub->($self, $name, @params);
1557             };
1558 52 100       491 if ($object) {
1559 1 50       2 if ($ds) {
1560 1         3 $Geo::GDAL::stdout_redirection{tied(%$ds)} = $object;
1561             } else {
1562 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
1563 0         0 $object->close;
1564             }
1565             }
1566 52 100       104 confess(Geo::GDAL->last_error) if $@;
1567 51 50       84 confess("Failed. Use Geo::OGR::Driver for vector drivers.") unless $ds;
1568 51         307 return $ds;
1569             }
1570              
1571             sub Create {
1572 50     50   4805 my $self = shift;
1573 50         154 my $p = Geo::GDAL::named_parameters(\@_, Name => 'unnamed', Width => 256, Height => 256, Bands => 1, Type => 'Byte', Options => {});
1574 50         136 my $type = Geo::GDAL::string2int($p->{type}, \%Geo::GDAL::TYPE_STRING2INT);
1575             return $self->stdout_redirection_wrapper(
1576             $p->{name},
1577             $self->can('_Create'),
1578             $p->{width}, $p->{height}, $p->{bands}, $type, $p->{options}
1579 50         361 );
1580             }
1581             *CreateDataset = *Create;
1582              
1583             sub Copy {
1584 2     2   4 my $self = shift;
1585 2         7 my $p = Geo::GDAL::named_parameters(\@_, Name => 'unnamed', Src => undef, Strict => 1, Options => {}, Progress => undef, ProgressData => undef);
1586             return $self->stdout_redirection_wrapper(
1587             $p->{name},
1588             $self->can('_CreateCopy'),
1589 2         12 $p->{src}, $p->{strict}, $p->{options}, $p->{progress}, $p->{progressdata});
1590             }
1591             *CreateCopy = *Copy;
1592              
1593             sub Open {
1594 0     0   0 my $self = shift;
1595 0         0 my @p = @_; # name, update
1596 0         0 my @flags = qw/RASTER/;
1597 0 0       0 push @flags, qw/READONLY/ if $p[1] eq 'ReadOnly';
1598 0 0       0 push @flags, qw/UPDATE/ if $p[1] eq 'Update';
1599 0         0 my $dataset = Geo::GDAL::OpenEx($p[0], \@flags, [$self->Name()]);
1600 0 0       0 Geo::GDAL::error("Failed to open $p[0]. Is it a raster dataset?") unless $dataset;
1601 0         0 return $dataset;
1602             }
1603              
1604              
1605              
1606              
1607             package Geo::GDAL::Dataset;
1608 19     19   87 use strict;
  19         20  
  19         306  
1609 19     19   57 use warnings;
  19         19  
  19         446  
1610 19     19   10301 use POSIX qw/floor ceil/;
  19         96483  
  19         84  
1611 19     19   16991 use Scalar::Util 'blessed';
  19         22  
  19         643  
1612 19     19   59 use Carp;
  19         16  
  19         690  
1613 19     19   55 use Exporter 'import';
  19         19  
  19         511  
1614              
1615 19     19   53 use vars qw/@EXPORT @DOMAINS @CAPABILITIES %CAPABILITIES %BANDS %LAYERS %RESULT_SET/;
  19         31  
  19         51653  
1616             @EXPORT = qw/BuildVRT/;
1617             @DOMAINS = qw/IMAGE_STRUCTURE SUBDATASETS GEOLOCATION/;
1618              
1619             sub RELEASE_PARENTS {
1620 122     122   105 my $self = shift;
1621 122         137 delete $BANDS{$self};
1622             }
1623              
1624             sub Dataset {
1625 1     1   5 my $self = shift;
1626 1         3 return $BANDS{tied(%$self)};
1627             }
1628              
1629             sub Domains {
1630 2     2   12 return @DOMAINS;
1631             }
1632              
1633             *Open = *Geo::GDAL::Open;
1634             *OpenShared = *Geo::GDAL::OpenShared;
1635              
1636             sub TestCapability {
1637 1     1   546 return _TestCapability(@_);
1638             }
1639              
1640             sub Size {
1641 8     8   26 my $self = shift;
1642 8         33 return ($self->{RasterXSize}, $self->{RasterYSize});
1643             }
1644              
1645             sub Bands {
1646 5     5   11 my $self = shift;
1647 5         5 my @bands;
1648 5         22 for my $i (1..$self->{RasterCount}) {
1649 12         16 push @bands, GetRasterBand($self, $i);
1650             }
1651 5         43 return @bands;
1652             }
1653              
1654             sub GetRasterBand {
1655 52     52   1660 my ($self, $index) = @_;
1656 52   100     118 $index //= 1;
1657 52         290 my $band = _GetRasterBand($self, $index);
1658 52 50       114 Geo::GDAL::error(2, $index, 'Band') unless $band;
1659 52         50 $BANDS{tied(%{$band})} = $self;
  52         116  
1660 52         105 return $band;
1661             }
1662             *Band = *GetRasterBand;
1663              
1664             sub AddBand {
1665 3     3   236 my ($self, $type, $options) = @_;
1666 3   50     8 $type //= 'Byte';
1667 3         9 $type = Geo::GDAL::string2int($type, \%Geo::GDAL::TYPE_STRING2INT);
1668 3         53 $self->_AddBand($type, $options);
1669 3 50       10 return unless defined wantarray;
1670 0         0 return $self->GetRasterBand($self->{RasterCount});
1671             }
1672              
1673             sub CreateMaskBand {
1674 0     0   0 return _CreateMaskBand(@_);
1675             }
1676              
1677             sub ExecuteSQL {
1678             my $self = shift;
1679             my $layer = $self->_ExecuteSQL(@_);
1680             $LAYERS{tied(%$layer)} = $self;
1681             $RESULT_SET{tied(%$layer)} = 1;
1682             return $layer;
1683             }
1684              
1685       0     sub ReleaseResultSet {
1686             # a no-op, _ReleaseResultSet is called from Layer::DESTROY
1687             }
1688              
1689             sub GetLayer {
1690 0     0   0 my($self, $name) = @_;
1691 0 0       0 my $layer = defined $name ? GetLayerByName($self, "$name") : GetLayerByIndex($self, 0);
1692 0   0     0 $name //= '';
1693 0 0       0 Geo::GDAL::error(2, $name, 'Layer') unless $layer;
1694 0         0 $LAYERS{tied(%$layer)} = $self;
1695 0         0 return $layer;
1696             }
1697             *Layer = *GetLayer;
1698              
1699             sub GetLayerNames {
1700 2     2   8 my $self = shift;
1701 2         2 my @names;
1702 2         22 for my $i (0..$self->GetLayerCount-1) {
1703 5         16 my $layer = GetLayerByIndex($self, $i);
1704 5         26 push @names, $layer->GetName;
1705             }
1706 2         7 return @names;
1707             }
1708             *Layers = *GetLayerNames;
1709              
1710             sub CreateLayer {
1711 16     16   2507 my $self = shift;
1712 16         41 my $p = Geo::GDAL::named_parameters(\@_,
1713             Name => 'unnamed',
1714             SRS => undef,
1715             GeometryType => 'Unknown',
1716             Options => {},
1717             Schema => undef,
1718             Fields => undef,
1719             ApproxOK => 1);
1720 16 50 66     63 Geo::GDAL::error("The 'Fields' argument must be an array reference.") if $p->{fields} && ref($p->{fields}) ne 'ARRAY';
1721 16 50       29 if (defined $p->{schema}) {
1722 0         0 my $s = $p->{schema};
1723 0 0       0 $p->{geometrytype} = $s->{GeometryType} if exists $s->{GeometryType};
1724 0 0       0 $p->{fields} = $s->{Fields} if exists $s->{Fields};
1725 0 0       0 $p->{name} = $s->{Name} if exists $s->{Name};
1726             }
1727 16 100       39 $p->{fields} = [] unless ref($p->{fields}) eq 'ARRAY';
1728             # if fields contains spatial fields, then do not create default one
1729 16         17 for my $f (@{$p->{fields}}) {
  16         29  
1730 13 100 66     58 if ($f->{GeometryType} or exists $Geo::OGR::Geometry::TYPE_STRING2INT{$f->{Type}}) {
1731 3         5 $p->{geometrytype} = 'None';
1732 3         6 last;
1733             }
1734             }
1735 16         32 my $gt = Geo::GDAL::string2int($p->{geometrytype}, \%Geo::OGR::Geometry::TYPE_STRING2INT);
1736 16         398 my $layer = _CreateLayer($self, $p->{name}, $p->{srs}, $gt, $p->{options});
1737 16         74 $LAYERS{tied(%$layer)} = $self;
1738 16         16 for my $f (@{$p->{fields}}) {
  16         28  
1739 13         35 $layer->CreateField($f);
1740             }
1741 16         55 return $layer;
1742             }
1743              
1744             sub DeleteLayer {
1745 1     1   5 my ($self, $name) = @_;
1746 1         1 my $index;
1747 1         6 for my $i (0..$self->GetLayerCount-1) {
1748 2         8 my $layer = GetLayerByIndex($self, $i);
1749 2 100       13 $index = $i, last if $layer->GetName eq $name;
1750             }
1751 1 50       3 Geo::GDAL::error(2, $name, 'Layer') unless defined $index;
1752 1         12 _DeleteLayer($self, $index);
1753             }
1754              
1755             sub Projection {
1756 0     0   0 my($self, $proj) = @_;
1757 0 0       0 SetProjection($self, $proj) if defined $proj;
1758 0 0       0 GetProjection($self) if defined wantarray;
1759             }
1760              
1761             sub SpatialReference {
1762 0     0   0 my($self, $sr) = @_;
1763 0 0       0 SetProjection($self, $sr->As('WKT')) if defined $sr;
1764 0 0       0 if (defined wantarray) {
1765 0         0 my $p = GetProjection($self);
1766 0 0       0 return unless $p;
1767 0         0 return Geo::OSR::SpatialReference->new(WKT => $p);
1768             }
1769             }
1770              
1771             sub GeoTransform {
1772 7     7   32 my $self = shift;
1773 7         10 eval {
1774 7 100       23 if (@_ == 1) {
    100          
1775 4         59 SetGeoTransform($self, $_[0]);
1776             } elsif (@_ > 1) {
1777 1         17 SetGeoTransform($self, \@_);
1778             }
1779             };
1780 7 50       17 confess(Geo::GDAL->last_error) if $@;
1781 7 100       19 return unless defined wantarray;
1782 4         26 my $t = GetGeoTransform($self);
1783 4 50       10 if (wantarray) {
1784 0         0 return @$t;
1785             } else {
1786 4         18 return Geo::GDAL::GeoTransform->new($t);
1787             }
1788             }
1789              
1790             sub Extent {
1791 0     0   0 my $self = shift;
1792 0         0 return $self->GeoTransform->Extent($self->Size);
1793             }
1794              
1795             sub Tile { # $xoff, $yoff, $xsize, $ysize, assuming strict north up
1796 0     0   0 my ($self, $e) = @_;
1797 0         0 my ($w, $h) = $self->Size;
1798             #print "sz $w $h\n";
1799 0         0 my $gt = $self->GeoTransform;
1800             #print "gt @$gt\n";
1801 0 0       0 confess "GeoTransform is not \"north up\"." unless $gt->NorthUp;
1802 0         0 my $x = $gt->Extent($w, $h);
1803 0         0 my $xoff = floor(($e->[0] - $gt->[0])/$gt->[1]);
1804 0 0       0 $xoff = 0 if $xoff < 0;
1805 0         0 my $yoff = floor(($gt->[3] - $e->[3])/(-$gt->[5]));
1806 0 0       0 $yoff = 0 if $yoff < 0;
1807 0         0 my $xsize = ceil(($e->[2] - $gt->[0])/$gt->[1]) - $xoff;
1808 0 0       0 $xsize = $w - $xoff if $xsize > $w - $xoff;
1809 0         0 my $ysize = ceil(($gt->[3] - $e->[1])/(-$gt->[5])) - $yoff;
1810 0 0       0 $ysize = $h - $yoff if $ysize > $h - $yoff;
1811 0         0 return ($xoff, $yoff, $xsize, $ysize);
1812             }
1813              
1814             sub GCPs {
1815 0     0   0 my $self = shift;
1816 0 0       0 if (@_ > 0) {
1817 0         0 my $proj = pop @_;
1818 0 0 0     0 $proj = $proj->Export('WKT') if $proj and ref($proj);
1819 0         0 SetGCPs($self, \@_, $proj);
1820             }
1821 0 0       0 return unless defined wantarray;
1822 0         0 my $proj = Geo::OSR::SpatialReference->new(GetGCPProjection($self));
1823 0         0 my $GCPs = GetGCPs($self);
1824 0         0 return (@$GCPs, $proj);
1825             }
1826              
1827             sub ReadTile {
1828 0     0   0 my ($self, $xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $alg) = @_;
1829 0         0 my @data;
1830 0         0 for my $i (0..$self->Bands-1) {
1831 0         0 $data[$i] = $self->Band($i+1)->ReadTile($xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $alg);
1832             }
1833 0         0 return \@data;
1834             }
1835              
1836             sub WriteTile {
1837 0     0   0 my ($self, $data, $xoff, $yoff) = @_;
1838 0   0     0 $xoff //= 0;
1839 0   0     0 $yoff //= 0;
1840 0         0 for my $i (0..$self->Bands-1) {
1841 0         0 $self->Band($i+1)->WriteTile($data->[$i], $xoff, $yoff);
1842             }
1843             }
1844              
1845             sub ReadRaster {
1846 1     1   6 my $self = shift;
1847 1         3 my ($width, $height) = $self->Size;
1848 1         4 my ($type) = $self->Band->DataType;
1849 1         2 my $p = Geo::GDAL::named_parameters(\@_,
1850             XOff => 0,
1851             YOff => 0,
1852             XSize => $width,
1853             YSize => $height,
1854             BufXSize => undef,
1855             BufYSize => undef,
1856             BufType => $type,
1857             BandList => [1],
1858             BufPixelSpace => 0,
1859             BufLineSpace => 0,
1860             BufBandSpace => 0,
1861             ResampleAlg => 'NearestNeighbour',
1862             Progress => undef,
1863             ProgressData => undef
1864             );
1865 1         4 $p->{resamplealg} = Geo::GDAL::string2int($p->{resamplealg}, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
1866 1         3 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
1867 1         41 $self->_ReadRaster($p->{xoff},$p->{yoff},$p->{xsize},$p->{ysize},$p->{bufxsize},$p->{bufysize},$p->{buftype},$p->{bandlist},$p->{bufpixelspace},$p->{buflinespace},$p->{bufbandspace},$p->{resamplealg},$p->{progress},$p->{progressdata});
1868             }
1869              
1870             sub WriteRaster {
1871 2     2   661 my $self = shift;
1872 2         4 my ($width, $height) = $self->Size;
1873 2         5 my ($type) = $self->Band->DataType;
1874 2         4 my $p = Geo::GDAL::named_parameters(\@_,
1875             XOff => 0,
1876             YOff => 0,
1877             XSize => $width,
1878             YSize => $height,
1879             Buf => undef,
1880             BufXSize => undef,
1881             BufYSize => undef,
1882             BufType => $type,
1883             BandList => [1],
1884             BufPixelSpace => 0,
1885             BufLineSpace => 0,
1886             BufBandSpace => 0
1887             );
1888 2         7 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
1889 2         36 $self->_WriteRaster($p->{xoff},$p->{yoff},$p->{xsize},$p->{ysize},$p->{buf},$p->{bufxsize},$p->{bufysize},$p->{buftype},$p->{bandlist},$p->{bufpixelspace},$p->{buflinespace},$p->{bufbandspace});
1890             }
1891              
1892             sub BuildOverviews {
1893 1     1   9 my $self = shift;
1894 1         2 my @p = @_;
1895 1 50       4 $p[0] = uc($p[0]) if $p[0];
1896 1         1 eval {
1897 1         1058 $self->_BuildOverviews(@p);
1898             };
1899 1 50       7 confess(Geo::GDAL->last_error) if $@;
1900             }
1901              
1902             sub stdout_redirection_wrapper {
1903 2     2   3 my ($self, $name, $sub, @params) = @_;
1904 2         3 my $object = 0;
1905 2 50 33     9 if ($name && blessed $name) {
1906 0         0 $object = $name;
1907 0         0 my $ref = $object->can('write');
1908 0         0 Geo::GDAL::VSIStdoutSetRedirection($ref);
1909 0         0 $name = '/vsistdout/';
1910             }
1911 2         43 my $ds;
1912 2         4 eval {
1913 2         809 $ds = $sub->($name, $self, @params); # self and name opposite to what is in Geo::GDAL::Driver!
1914             };
1915 2 50       7 if ($object) {
1916 0 0       0 if ($ds) {
1917 0         0 $Geo::GDAL::stdout_redirection{tied(%$ds)} = $object;
1918             } else {
1919 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
1920 0         0 $object->close;
1921             }
1922             }
1923 2 50       5 confess(Geo::GDAL->last_error) if $@;
1924 2         10 return $ds;
1925             }
1926              
1927             sub DEMProcessing {
1928 0     0   0 my ($self, $dest, $Processing, $ColorFilename, $options, $progress, $progress_data) = @_;
1929 0         0 $options = Geo::GDAL::GDALDEMProcessingOptions->new(Geo::GDAL::make_processing_options($options));
1930 0         0 return $self->stdout_redirection_wrapper(
1931             $dest,
1932             \&Geo::GDAL::wrapper_GDALDEMProcessing,
1933             $Processing, $ColorFilename, $options, $progress, $progress_data
1934             );
1935             }
1936              
1937             sub Nearblack {
1938 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
1939 0         0 $options = Geo::GDAL::GDALNearblackOptions->new(Geo::GDAL::make_processing_options($options));
1940 0         0 my $b = blessed($dest);
1941 0 0 0     0 if ($b && $b eq 'Geo::GDAL::Dataset') {
1942 0         0 Geo::GDAL::wrapper_GDALNearblackDestDS($dest, $self, $options, $progress, $progress_data);
1943             } else {
1944 0         0 return $self->stdout_redirection_wrapper(
1945             $dest,
1946             \&Geo::GDAL::wrapper_GDALNearblackDestName,
1947             $options, $progress, $progress_data
1948             );
1949             }
1950             }
1951              
1952             sub Translate {
1953 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
1954             return $self->stdout_redirection_wrapper(
1955             $dest,
1956             sub {
1957 0     0   0 my ($dest, $self) = @_;
1958 0         0 my $ds;
1959 0 0       0 if ($self->_GetRasterBand(1)) {
1960 0         0 $options = Geo::GDAL::GDALTranslateOptions->new(Geo::GDAL::make_processing_options($options));
1961 0         0 $ds = Geo::GDAL::wrapper_GDALTranslate($dest, $self, $options, $progress, $progress_data);
1962             } else {
1963 0         0 $options = Geo::GDAL::GDALVectorTranslateOptions->new(Geo::GDAL::make_processing_options($options));
1964 0         0 Geo::GDAL::wrapper_GDALVectorTranslateDestDS($dest, $self, $options, $progress, $progress_data);
1965 0         0 $ds = Geo::GDAL::wrapper_GDALVectorTranslateDestName($dest, $self, $options, $progress, $progress_data);
1966             }
1967 0         0 return $ds;
1968             }
1969 0         0 );
1970             }
1971              
1972             sub Warped {
1973 1     1   5 my $self = shift;
1974 1         3 my $p = Geo::GDAL::named_parameters(\@_, SrcSRS => undef, DstSRS => undef, ResampleAlg => 'NearestNeighbour', MaxError => 0);
1975 1         3 for my $srs (qw/srcsrs dstsrs/) {
1976 2 50 33     5 $p->{$srs} = $p->{$srs}->ExportToWkt if $p->{$srs} && blessed $p->{$srs};
1977             }
1978 1         4 $p->{resamplealg} = Geo::GDAL::string2int($p->{resamplealg}, \%Geo::GDAL::RESAMPLING_STRING2INT);
1979 1         188 my $warped = Geo::GDAL::_AutoCreateWarpedVRT($self, $p->{srcsrs}, $p->{dstsrs}, $p->{resamplealg}, $p->{maxerror});
1980 1 50       4 $BANDS{tied(%{$warped})} = $self if $warped; # self must live as long as warped
  1         3  
1981 1         4 return $warped;
1982             }
1983              
1984             sub Warp {
1985 2     2   19 my ($self, $dest, $options, $progress, $progress_data) = @_;
1986             # can be run as object method (one dataset) and as package sub (a list of datasets)
1987 2         7 $options = Geo::GDAL::GDALWarpAppOptions->new(Geo::GDAL::make_processing_options($options));
1988 2         6 my $b = blessed($dest);
1989 2 100       7 $self = [$self] unless ref $self eq 'ARRAY';
1990 2 50 33     6 if ($b && $b eq 'Geo::GDAL::Dataset') {
1991 0         0 Geo::GDAL::wrapper_GDALWarpDestDS($dest, $self, $options, $progress, $progress_data);
1992             } else {
1993 2         7 return stdout_redirection_wrapper(
1994             $self,
1995             $dest,
1996             \&Geo::GDAL::wrapper_GDALWarpDestName,
1997             $options, $progress, $progress_data
1998             );
1999             }
2000             }
2001              
2002             sub Info {
2003 0     0   0 my ($self, $o) = @_;
2004 0         0 $o = Geo::GDAL::GDALInfoOptions->new(Geo::GDAL::make_processing_options($o));
2005 0         0 return Geo::GDAL::GDALInfo($self, $o);
2006             }
2007              
2008             sub Grid {
2009 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
2010 0         0 $options = Geo::GDAL::GDALGridOptions->new(Geo::GDAL::make_processing_options($options));
2011 0         0 return $self->stdout_redirection_wrapper(
2012             $dest,
2013             \&Geo::GDAL::wrapper_GDALGrid,
2014             $options, $progress, $progress_data
2015             );
2016             }
2017              
2018             sub Rasterize {
2019 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
2020 0         0 $options = Geo::GDAL::GDALRasterizeOptions->new(Geo::GDAL::make_processing_options($options));
2021 0         0 my $b = blessed($dest);
2022 0 0 0     0 if ($b && $b eq 'Geo::GDAL::Dataset') {
2023 0         0 Geo::GDAL::wrapper_GDALRasterizeDestDS($dest, $self, $options, $progress, $progress_data);
2024             } else {
2025 0         0 return $self->stdout_redirection_wrapper(
2026             $dest,
2027             \&Geo::GDAL::wrapper_GDALRasterizeDestName,
2028             $options, $progress, $progress_data
2029             );
2030             }
2031             }
2032              
2033             sub BuildVRT {
2034 0     0   0 my ($dest, $sources, $options, $progress, $progress_data) = @_;
2035 0         0 $options = Geo::GDAL::GDALBuildVRTOptions->new(Geo::GDAL::make_processing_options($options));
2036 0 0 0     0 Geo::GDAL::error("Usage: Geo::GDAL::DataSet::BuildVRT(\$vrt_file_name, \\\@sources)")
2037             unless ref $sources eq 'ARRAY' && defined $sources->[0];
2038 0 0       0 unless (blessed($dest)) {
2039 0 0       0 if (blessed($sources->[0])) {
2040 0         0 return Geo::GDAL::wrapper_GDALBuildVRT_objects($dest, $sources, $options, $progress, $progress_data);
2041             } else {
2042 0         0 return Geo::GDAL::wrapper_GDALBuildVRT_names($dest, $sources, $options, $progress, $progress_data);
2043             }
2044             } else {
2045 0 0       0 if (blessed($sources->[0])) {
2046 0         0 return stdout_redirection_wrapper(
2047             $sources, $dest,
2048             \&Geo::GDAL::wrapper_GDALBuildVRT_objects,
2049             $options, $progress, $progress_data);
2050             } else {
2051 0         0 return stdout_redirection_wrapper(
2052             $sources, $dest,
2053             \&Geo::GDAL::wrapper_GDALBuildVRT_names,
2054             $options, $progress, $progress_data);
2055             }
2056             }
2057             }
2058              
2059             sub ComputeColorTable {
2060 1     1   2 my $self = shift;
2061 1         4 my $p = Geo::GDAL::named_parameters(\@_,
2062             Red => undef,
2063             Green => undef,
2064             Blue => undef,
2065             NumColors => 256,
2066             Progress => undef,
2067             ProgressData => undef,
2068             Method => 'MedianCut');
2069 1         4 for my $b ($self->Bands) {
2070 3         4 for my $cion ($b->ColorInterpretation) {
2071 3 100 33     7 if ($cion eq 'RedBand') { $p->{red} //= $b; last; }
  1         3  
  1         1  
2072 2 100 33     6 if ($cion eq 'GreenBand') { $p->{green} //= $b; last; }
  1         3  
  1         1  
2073 1 50 33     3 if ($cion eq 'BlueBand') { $p->{blue} //= $b; last; }
  1         9  
  1         2  
2074             }
2075             }
2076 1         3 my $ct = Geo::GDAL::ColorTable->new;
2077             Geo::GDAL::ComputeMedianCutPCT($p->{red},
2078             $p->{green},
2079             $p->{blue},
2080             $p->{numcolors},
2081             $ct, $p->{progress},
2082 1         799 $p->{progressdata});
2083 1         8 return $ct;
2084             }
2085              
2086             sub Dither {
2087 1     1   2 my $self = shift;
2088 1         4 my $p = Geo::GDAL::named_parameters(\@_,
2089             Red => undef,
2090             Green => undef,
2091             Blue => undef,
2092             Dest => undef,
2093             ColorTable => undef,
2094             Progress => undef,
2095             ProgressData => undef);
2096 1         4 for my $b ($self->Bands) {
2097 3         6 for my $cion ($b->ColorInterpretation) {
2098 3 100 33     5 if ($cion eq 'RedBand') { $p->{red} //= $b; last; }
  1         5  
  1         2  
2099 2 100 33     6 if ($cion eq 'GreenBand') { $p->{green} //= $b; last; }
  1         5  
  1         1  
2100 1 50 33     3 if ($cion eq 'BlueBand') { $p->{blue} //= $b; last; }
  1         5  
  1         1  
2101             }
2102             }
2103 1         4 my ($w, $h) = $self->Size;
2104 1   33     7 $p->{dest} //= Geo::GDAL::Driver('MEM')->Create(Name => 'dithered',
2105             Width => $w,
2106             Height => $h,
2107             Type => 'Byte')->Band;
2108             $p->{colortable}
2109             //= $p->{dest}->ColorTable
2110             // $self->ComputeColorTable(Red => $p->{red},
2111             Green => $p->{green},
2112             Blue => $p->{blue},
2113             Progress => $p->{progress},
2114 1   33     7 ProgressData => $p->{progressdata});
      33        
2115             Geo::GDAL::DitherRGB2PCT($p->{red},
2116             $p->{green},
2117             $p->{blue},
2118             $p->{dest},
2119             $p->{colortable},
2120             $p->{progress},
2121 1         10376 $p->{progressdata});
2122 1         7 $p->{dest}->ColorTable($p->{colortable});
2123 1         4 return $p->{dest};
2124             }
2125              
2126              
2127              
2128              
2129             package Geo::GDAL::Band;
2130 19     19   100 use strict;
  19         22  
  19         389  
2131 19     19   60 use warnings;
  19         18  
  19         480  
2132 19     19   58 use POSIX;
  19         18  
  19         69  
2133 19     19   24215 use Carp;
  19         25  
  19         813  
2134 19     19   65 use Scalar::Util 'blessed';
  19         18  
  19         702  
2135              
2136 19         55726 use vars qw/ %RATS
2137             @COLOR_INTERPRETATIONS
2138             %COLOR_INTERPRETATION_STRING2INT %COLOR_INTERPRETATION_INT2STRING @DOMAINS
2139             %MASK_FLAGS %DATATYPE2PDL %PDL2DATATYPE
2140 19     19   65 /;
  19         21  
2141             for (keys %Geo::GDAL::Const::) {
2142             next if /TypeCount/;
2143             push(@COLOR_INTERPRETATIONS, $1), next if /^GCI_(\w+)/;
2144             }
2145             for my $string (@COLOR_INTERPRETATIONS) {
2146             my $int = eval "\$Geo::GDAL::Constc::GCI_$string";
2147             $COLOR_INTERPRETATION_STRING2INT{$string} = $int;
2148             $COLOR_INTERPRETATION_INT2STRING{$int} = $string;
2149             }
2150             @DOMAINS = qw/IMAGE_STRUCTURE RESAMPLING/;
2151             %MASK_FLAGS = (AllValid => 1, PerDataset => 2, Alpha => 4, NoData => 8);
2152             if ($Geo::GDAL::HAVE_PDL) {
2153             require PDL;
2154             require PDL::Types;
2155             %DATATYPE2PDL = (
2156             $Geo::GDAL::Const::GDT_Byte => $PDL::Types::PDL_B,
2157             $Geo::GDAL::Const::GDT_Int16 => $PDL::Types::PDL_S,
2158             $Geo::GDAL::Const::GDT_UInt16 => $PDL::Types::PDL_US,
2159             $Geo::GDAL::Const::GDT_Int32 => $PDL::Types::PDL_L,
2160             $Geo::GDAL::Const::GDT_UInt32 => -1,
2161             #$PDL_IND,
2162             #$PDL_LL,
2163             $Geo::GDAL::Const::GDT_Float32 => $PDL::Types::PDL_F,
2164             $Geo::GDAL::Const::GDT_Float64 => $PDL::Types::PDL_D,
2165             $Geo::GDAL::Const::GDT_CInt16 => -1,
2166             $Geo::GDAL::Const::GDT_CInt32 => -1,
2167             $Geo::GDAL::Const::GDT_CFloat32 => -1,
2168             $Geo::GDAL::Const::GDT_CFloat64 => -1
2169             );
2170             %PDL2DATATYPE = (
2171             $PDL::Types::PDL_B => $Geo::GDAL::Const::GDT_Byte,
2172             $PDL::Types::PDL_S => $Geo::GDAL::Const::GDT_Int16,
2173             $PDL::Types::PDL_US => $Geo::GDAL::Const::GDT_UInt16,
2174             $PDL::Types::PDL_L => $Geo::GDAL::Const::GDT_Int32,
2175             $PDL::Types::PDL_IND => -1,
2176             $PDL::Types::PDL_LL => -1,
2177             $PDL::Types::PDL_F => $Geo::GDAL::Const::GDT_Float32,
2178             $PDL::Types::PDL_D => $Geo::GDAL::Const::GDT_Float64
2179             );
2180             }
2181              
2182             sub Domains {
2183 1     1   4 return @DOMAINS;
2184             }
2185              
2186             sub ColorInterpretations {
2187 1     1   11 return @COLOR_INTERPRETATIONS;
2188             }
2189              
2190             sub MaskFlags {
2191 1     1   11 my @f = sort {$MASK_FLAGS{$a} <=> $MASK_FLAGS{$b}} keys %MASK_FLAGS;
  5         11  
2192 1         4 return @f;
2193             }
2194              
2195             sub DESTROY {
2196 108     108   4178 my $self = shift;
2197 108 100       315 unless ($self->isa('SCALAR')) {
2198 54 50       101 return unless $self->isa('HASH');
2199 54         44 $self = tied(%{$self});
  54         56  
2200 54 50       78 return unless defined $self;
2201             }
2202 108         101 delete $ITERATORS{$self};
2203 108 50       157 if (exists $OWNER{$self}) {
2204 0         0 delete $OWNER{$self};
2205             }
2206 108         114 $self->RELEASE_PARENTS();
2207             }
2208              
2209             sub RELEASE_PARENTS {
2210 108     108   83 my $self = shift;
2211 108         1360 delete $Geo::GDAL::Dataset::BANDS{$self};
2212             }
2213              
2214             sub Dataset {
2215 2     2   6 my $self = shift;
2216 2         1 return $Geo::GDAL::Dataset::BANDS{tied(%{$self})};
  2         4  
2217             }
2218              
2219             sub Size {
2220 664     664   879 my $self = shift;
2221 664         1431 return ($self->{XSize}, $self->{YSize});
2222             }
2223              
2224             sub DataType {
2225 668     668   477 my $self = shift;
2226 668         993 return $Geo::GDAL::TYPE_INT2STRING{$self->{DataType}};
2227             }
2228              
2229             sub PackCharacter {
2230 1     1   7 my $self = shift;
2231 1         4 return Geo::GDAL::PackCharacter($self->DataType);
2232             }
2233              
2234             sub NoDataValue {
2235 8     8   866 my $self = shift;
2236 8 100       19 if (@_ > 0) {
2237 2 50       10 if (defined $_[0]) {
2238 2         18 SetNoDataValue($self, $_[0]);
2239             } else {
2240 0         0 SetNoDataValue($self, POSIX::FLT_MAX); # hopefully an "out of range" value
2241             }
2242             }
2243 8         44 GetNoDataValue($self);
2244             }
2245              
2246             sub Unit {
2247 2     2   378 my $self = shift;
2248 2 100       6 if (@_ > 0) {
2249 1         1 my $unit = shift;
2250 1   50     2 $unit //= '';
2251 1         18 SetUnitType($self, $unit);
2252             }
2253 2 100       4 return unless defined wantarray;
2254 1         8 GetUnitType($self);
2255             }
2256              
2257             sub ScaleAndOffset {
2258 2     2   2 my $self = shift;
2259 2 100 66     23 SetScale($self, $_[0]) if @_ > 0 and defined $_[0];
2260 2 100 66     11 SetOffset($self, $_[1]) if @_ > 1 and defined $_[1];
2261 2 100       4 return unless defined wantarray;
2262 1         7 my $scale = GetScale($self);
2263 1         4 my $offset = GetOffset($self);
2264 1         3 return ($scale, $offset);
2265             }
2266              
2267             sub ReadTile {
2268 19     19   323 my($self, $xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $alg) = @_;
2269 19   100     67 $xoff //= 0;
2270 19   100     47 $yoff //= 0;
2271 19   66     83 $xsize //= $self->{XSize} - $xoff;
2272 19   66     68 $ysize //= $self->{YSize} - $yoff;
2273 19   33     63 $w_tile //= $xsize;
2274 19   33     49 $h_tile //= $ysize;
2275 19   50     57 $alg //= 'NearestNeighbour';
2276 19         39 my $t = $self->{DataType};
2277 19         48 $alg = Geo::GDAL::string2int($alg, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
2278 19         1167 my $buf = $self->_ReadRaster($xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $t, 0, 0, $alg);
2279 19         44 my $pc = Geo::GDAL::PackCharacter($t);
2280 19         39 my $w = $w_tile * Geo::GDAL::GetDataTypeSize($t)/8;
2281 19         21 my $offset = 0;
2282 19         20 my @data;
2283 19         36 for my $y (0..$h_tile-1) {
2284 509         5290 my @d = unpack($pc."[$w_tile]", substr($buf, $offset, $w));
2285 509         1467 push @data, \@d;
2286 509         426 $offset += $w;
2287             }
2288 19         46 return \@data;
2289             }
2290              
2291             sub WriteTile {
2292 15     15   167160 my($self, $data, $xoff, $yoff) = @_;
2293 15   100     56 $xoff //= 0;
2294 15   100     40 $yoff //= 0;
2295 15         13 my $xsize = @{$data->[0]};
  15         28  
2296 15 50       72 if ($xsize > $self->{XSize} - $xoff) {
2297 0         0 warn "Buffer XSize too large ($xsize) for this raster band (width = $self->{XSize}, offset = $xoff).";
2298 0         0 $xsize = $self->{XSize} - $xoff;
2299             }
2300 15         27 my $ysize = @{$data};
  15         23  
2301 15 50       31 if ($ysize > $self->{YSize} - $yoff) {
2302 0         0 $ysize = $self->{YSize} - $yoff;
2303 0         0 warn "Buffer YSize too large ($ysize) for this raster band (height = $self->{YSize}, offset = $yoff).";
2304             }
2305 15         44 my $pc = Geo::GDAL::PackCharacter($self->{DataType});
2306 15         37 for my $i (0..$ysize-1) {
2307 459         578 my $scanline = pack($pc."[$xsize]", @{$data->[$i]});
  459         1812  
2308 459         738 $self->WriteRaster( $xoff, $yoff+$i, $xsize, 1, $scanline );
2309             }
2310             }
2311              
2312             sub ColorInterpretation {
2313 26     26   1782 my($self, $ci) = @_;
2314 26 100       43 if (defined $ci) {
2315 11         27 $ci = Geo::GDAL::string2int($ci, \%COLOR_INTERPRETATION_STRING2INT);
2316 11         69 SetRasterColorInterpretation($self, $ci);
2317             }
2318 26 100       46 return unless defined wantarray;
2319 15         75 $COLOR_INTERPRETATION_INT2STRING{GetRasterColorInterpretation($self)};
2320             }
2321              
2322             sub ColorTable {
2323 18     18   38 my $self = shift;
2324 18 100 66     93 SetRasterColorTable($self, $_[0]) if @_ and defined $_[0];
2325 18 100       36 return unless defined wantarray;
2326 10         55 GetRasterColorTable($self);
2327             }
2328              
2329             sub CategoryNames {
2330 0     0   0 my $self = shift;
2331 0 0       0 SetRasterCategoryNames($self, \@_) if @_;
2332 0 0       0 return unless defined wantarray;
2333 0         0 my $n = GetRasterCategoryNames($self);
2334 0         0 return @$n;
2335             }
2336              
2337             sub AttributeTable {
2338 3     3   8 my $self = shift;
2339 3 100 66     58 SetDefaultRAT($self, $_[0]) if @_ and defined $_[0];
2340 3 100       9 return unless defined wantarray;
2341 2         15 my $r = GetDefaultRAT($self);
2342 2 50       10 $RATS{tied(%$r)} = $self if $r;
2343 2         4 return $r;
2344             }
2345             *RasterAttributeTable = *AttributeTable;
2346              
2347             sub GetHistogram {
2348 3     3   1070 my $self = shift;
2349 3         12 my $p = Geo::GDAL::named_parameters(\@_,
2350             Min => -0.5,
2351             Max => 255.5,
2352             Buckets => 256,
2353             IncludeOutOfRange => 0,
2354             ApproxOK => 0,
2355             Progress => undef,
2356             ProgressData => undef);
2357 3 50 33     12 $p->{progressdata} = 1 if $p->{progress} and not defined $p->{progressdata};
2358             _GetHistogram($self, $p->{min}, $p->{max}, $p->{buckets},
2359             $p->{includeoutofrange}, $p->{approxok},
2360 3         926 $p->{progress}, $p->{progressdata});
2361             }
2362              
2363             sub Contours {
2364 0     0   0 my $self = shift;
2365 0         0 my $p = Geo::GDAL::named_parameters(\@_,
2366             DataSource => undef,
2367             LayerConstructor => {Name => 'contours'},
2368             ContourInterval => 100,
2369             ContourBase => 0,
2370             FixedLevels => [],
2371             NoDataValue => undef,
2372             IDField => -1,
2373             ElevField => -1,
2374             Progress => undef,
2375             ProgressData => undef);
2376 0   0     0 $p->{datasource} //= Geo::OGR::GetDriver('Memory')->CreateDataSource('ds');
2377 0   0     0 $p->{layerconstructor}->{Schema} //= {};
2378 0   0     0 $p->{layerconstructor}->{Schema}{Fields} //= [];
2379 0         0 my %fields;
2380 0 0 0     0 unless ($p->{idfield} =~ /^[+-]?\d+$/ or $fields{$p->{idfield}}) {
2381 0         0 push @{$p->{layerconstructor}->{Schema}{Fields}}, {Name => $p->{idfield}, Type => 'Integer'};
  0         0  
2382             }
2383 0 0 0     0 unless ($p->{elevfield} =~ /^[+-]?\d+$/ or $fields{$p->{elevfield}}) {
2384 0 0       0 my $type = $self->DataType() =~ /Float/ ? 'Real' : 'Integer';
2385 0         0 push @{$p->{layerconstructor}->{Schema}{Fields}}, {Name => $p->{elevfield}, Type => $type};
  0         0  
2386             }
2387 0         0 my $layer = $p->{datasource}->CreateLayer($p->{layerconstructor});
2388 0         0 my $schema = $layer->GetLayerDefn;
2389 0         0 for ('idfield', 'elevfield') {
2390 0 0       0 $p->{$_} = $schema->GetFieldIndex($p->{$_}) unless $p->{$_} =~ /^[+-]?\d+$/;
2391             }
2392 0 0 0     0 $p->{progressdata} = 1 if $p->{progress} and not defined $p->{progressdata};
2393             ContourGenerate($self, $p->{contourinterval}, $p->{contourbase}, $p->{fixedlevels},
2394             $p->{nodatavalue}, $layer, $p->{idfield}, $p->{elevfield},
2395 0         0 $p->{progress}, $p->{progressdata});
2396 0         0 return $layer;
2397             }
2398              
2399             sub FillNodata {
2400 2     2   185 my $self = shift;
2401 2         4 my $mask = shift;
2402 2 100       9 $mask = $self->GetMaskBand unless $mask;
2403 2         5 my @p = @_;
2404 2   50     12 $p[0] //= 10;
2405 2   50     9 $p[1] //= 0;
2406 2         6307 Geo::GDAL::FillNodata($self, $mask, @p);
2407             }
2408             *FillNoData = *FillNodata;
2409             *GetBandNumber = *GetBand;
2410              
2411             sub ReadRaster {
2412 1     1   1684 my $self = shift;
2413 1         3 my ($width, $height) = $self->Size;
2414 1         3 my ($type) = $self->DataType;
2415 1         6 my $p = Geo::GDAL::named_parameters(\@_,
2416             XOff => 0,
2417             YOff => 0,
2418             XSize => $width,
2419             YSize => $height,
2420             BufXSize => undef,
2421             BufYSize => undef,
2422             BufType => $type,
2423             BufPixelSpace => 0,
2424             BufLineSpace => 0,
2425             ResampleAlg => 'NearestNeighbour',
2426             Progress => undef,
2427             ProgressData => undef
2428             );
2429 1         4 $p->{resamplealg} = Geo::GDAL::string2int($p->{resamplealg}, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
2430 1         5 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
2431 1         645 $self->_ReadRaster($p->{xoff},$p->{yoff},$p->{xsize},$p->{ysize},$p->{bufxsize},$p->{bufysize},$p->{buftype},$p->{bufpixelspace},$p->{buflinespace},$p->{resamplealg},$p->{progress},$p->{progressdata});
2432             }
2433              
2434             sub WriteRaster {
2435 660     660   8237 my $self = shift;
2436 660         750 my ($width, $height) = $self->Size;
2437 660         1017 my ($type) = $self->DataType;
2438 660         1351 my $p = Geo::GDAL::named_parameters(\@_,
2439             XOff => 0,
2440             YOff => 0,
2441             XSize => $width,
2442             YSize => $height,
2443             Buf => undef,
2444             BufXSize => undef,
2445             BufYSize => undef,
2446             BufType => $type,
2447             BufPixelSpace => 0,
2448             BufLineSpace => 0
2449             );
2450 660 50       1627 confess "Usage: \$band->WriteRaster( Buf => \$data, ... )" unless defined $p->{buf};
2451 660         927 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
2452 660         5774 $self->_WriteRaster($p->{xoff},$p->{yoff},$p->{xsize},$p->{ysize},$p->{buf},$p->{bufxsize},$p->{bufysize},$p->{buftype},$p->{bufpixelspace},$p->{buflinespace});
2453             }
2454              
2455             sub GetMaskFlags {
2456 2     2   199 my $self = shift;
2457 2         45 my $f = $self->_GetMaskFlags;
2458 2         3 my @f;
2459 2         6 for my $flag (keys %MASK_FLAGS) {
2460 8 100       17 push @f, $flag if $f & $MASK_FLAGS{$flag};
2461             }
2462 2 50       9 return wantarray ? @f : $f;
2463             }
2464              
2465             sub CreateMaskBand {
2466 1     1   204 my $self = shift;
2467 1         2 my $f = 0;
2468 1 50 33     8 if (@_ and $_[0] =~ /^\d$/) {
2469 0         0 $f = shift;
2470             } else {
2471 1         2 for my $flag (@_) {
2472 1 50       4 carp "Unknown mask flag: '$flag'." unless $MASK_FLAGS{$flag};
2473 1         3 $f |= $MASK_FLAGS{$flag};
2474             }
2475             }
2476 1         287 $self->_CreateMaskBand($f);
2477             }
2478              
2479             sub Piddle {
2480             # TODO: add Piddle sub to dataset too to make Width x Height x Bands piddles
2481 0 0   0   0 Geo::GDAL::error("PDL is not available.") unless $Geo::GDAL::HAVE_PDL;
2482 0         0 my $self = shift;
2483 0         0 my $t = $self->{DataType};
2484 0 0       0 unless (defined wantarray) {
2485 0         0 my $pdl = shift;
2486 0 0       0 Geo::GDAL::error("The datatype of the Piddle and the band do not match.") unless $PDL2DATATYPE{$pdl->get_datatype} == $t;
2487 0         0 my ($xoff, $yoff, $xsize, $ysize) = @_;
2488 0   0     0 $xoff //= 0;
2489 0   0     0 $yoff //= 0;
2490 0         0 my $data = $pdl->get_dataref();
2491 0         0 my ($xdim, $ydim) = $pdl->dims();
2492 0 0       0 if ($xdim > $self->{XSize} - $xoff) {
2493 0         0 warn "Piddle XSize too large ($xdim) for this raster band (width = $self->{XSize}, offset = $xoff).";
2494 0         0 $xdim = $self->{XSize} - $xoff;
2495             }
2496 0 0       0 if ($ydim > $self->{YSize} - $yoff) {
2497 0         0 $ydim = $self->{YSize} - $yoff;
2498 0         0 warn "Piddle YSize too large ($ydim) for this raster band (height = $self->{YSize}, offset = $yoff).";
2499             }
2500 0   0     0 $xsize //= $xdim;
2501 0   0     0 $ysize //= $ydim;
2502 0         0 $self->_WriteRaster($xoff, $yoff, $xsize, $ysize, $data, $xdim, $ydim, $t, 0, 0);
2503 0         0 return;
2504             }
2505 0         0 my ($xoff, $yoff, $xsize, $ysize, $xdim, $ydim, $alg) = @_;
2506 0   0     0 $xoff //= 0;
2507 0   0     0 $yoff //= 0;
2508 0   0     0 $xsize //= $self->{XSize} - $xoff;
2509 0   0     0 $ysize //= $self->{YSize} - $yoff;
2510 0   0     0 $xdim //= $xsize;
2511 0   0     0 $ydim //= $ysize;
2512 0   0     0 $alg //= 'NearestNeighbour';
2513 0         0 $alg = Geo::GDAL::string2int($alg, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
2514 0         0 my $buf = $self->_ReadRaster($xoff, $yoff, $xsize, $ysize, $xdim, $ydim, $t, 0, 0, $alg);
2515 0         0 my $pdl = PDL->new;
2516 0         0 my $datatype = $DATATYPE2PDL{$t};
2517 0 0       0 Geo::GDAL::error("The band datatype is not supported by PDL.") if $datatype < 0;
2518 0         0 $pdl->set_datatype($datatype);
2519 0         0 $pdl->setdims([$xdim, $ydim]);
2520 0         0 my $data = $pdl->get_dataref();
2521 0         0 $$data = $buf;
2522 0         0 $pdl->upd_data;
2523             # FIXME: we want approximate equality since no data value can be very large floating point value
2524 0         0 my $bad = GetNoDataValue($self);
2525 0 0       0 return $pdl->setbadif($pdl == $bad) if defined $bad;
2526 0         0 return $pdl;
2527             }
2528              
2529             sub GetMaskBand {
2530 1     1   1 my $self = shift;
2531 1         8 my $band = _GetMaskBand($self);
2532 1         2 $Geo::GDAL::Dataset::BANDS{tied(%{$band})} = $self;
  1         3  
2533 1         1 return $band;
2534             }
2535              
2536             sub GetOverview {
2537 1     1   216 my ($self, $index) = @_;
2538 1         8 my $band = _GetOverview($self, $index);
2539 1         2 $Geo::GDAL::Dataset::BANDS{tied(%{$band})} = $self;
  1         3  
2540 1         3 return $band;
2541             }
2542              
2543             sub RegenerateOverview {
2544 1     1   6 my $self = shift;
2545             #Geo::GDAL::Band overview, scalar resampling, subref callback, scalar callback_data
2546 1         3 my @p = @_;
2547 1         4 Geo::GDAL::RegenerateOverview($self, @p);
2548             }
2549              
2550             sub RegenerateOverviews {
2551 1     1   5 my $self = shift;
2552             #arrayref overviews, scalar resampling, subref callback, scalar callback_data
2553 1         2 my @p = @_;
2554 1         3 Geo::GDAL::RegenerateOverviews($self, @p);
2555             }
2556              
2557             sub Polygonize {
2558 1     1   6 my $self = shift;
2559 1         5 my $p = Geo::GDAL::named_parameters(\@_, Mask => undef, OutLayer => undef, PixValField => 'val', Options => undef, Progress => undef, ProgressData => undef);
2560 1         5 my %known_options = (Connectedness => 1, ForceIntPixel => 1, DATASET_FOR_GEOREF => 1, '8CONNECTED' => 1);
2561 1         2 for my $option (keys %{$p->{options}}) {
  1         3  
2562 0 0       0 Geo::GDAL::error(1, $option, \%known_options) unless exists $known_options{$option};
2563             }
2564 1         2 my $dt = $self->DataType;
2565 1         4 my %leInt32 = (Byte => 1, Int16 => 1, Int32 => 1, UInt16 => 1);
2566 1         3 my $leInt32 = $leInt32{$dt};
2567 1 50       4 $dt = $dt =~ /Float/ ? 'Real' : 'Integer';
2568 1   33     9 $p->{outlayer} //= Geo::OGR::Driver('Memory')->Create()->
2569             CreateLayer(Name => 'polygonized',
2570             Fields => [{Name => 'val', Type => $dt},
2571             {Name => 'geom', Type => 'Polygon'}]);
2572 1         23 $p->{pixvalfield} = $p->{outlayer}->GetLayerDefn->GetFieldIndex($p->{pixvalfield});
2573 1 50 33     4 $p->{options}{'8CONNECTED'} = 1 if $p->{options}{Connectedness} && $p->{options}{Connectedness} == 8;
2574 1 50 33     6 if ($leInt32 || $p->{options}{ForceIntPixel}) {
2575 1         154 Geo::GDAL::_Polygonize($self, $p->{mask}, $p->{outlayer}, $p->{pixvalfield}, $p->{options}, $p->{progress}, $p->{progressdata});
2576             } else {
2577 0         0 Geo::GDAL::FPolygonize($self, $p->{mask}, $p->{outlayer}, $p->{pixvalfield}, $p->{options}, $p->{progress}, $p->{progressdata});
2578             }
2579             set the srs of the outlayer if it was created here
2580 1 0       6 return $p->{outlayer};
2581             }
2582              
2583             sub Sieve {
2584 1     1   8 my $self = shift;
2585 1         4 my $p = Geo::GDAL::named_parameters(\@_, Mask => undef, Dest => undef, Threshold => 10, Options => undef, Progress => undef, ProgressData => undef);
2586 1 50       4 unless ($p->{dest}) {
2587 1         2 my ($w, $h) = $self->Size;
2588 1         5 $p->{dest} = Geo::GDAL::Driver('MEM')->Create(Name => 'sieved', Width => $w, Height => $h, Type => $self->DataType)->Band;
2589             }
2590 1         4 my $c = 8;
2591 1 50       4 if ($p->{options}{Connectedness}) {
2592 1         1 $c = $p->{options}{Connectedness};
2593 1         2 delete $p->{options}{Connectedness};
2594             }
2595 1         60 Geo::GDAL::SieveFilter($self, $p->{mask}, $p->{dest}, $p->{threshold}, $c, $p->{options}, $p->{progress}, $p->{progressdata});
2596 1         4 return $p->{dest};
2597             }
2598              
2599             sub Distance {
2600 1     1   8 my $self = shift;
2601 1         5 my $p = Geo::GDAL::named_parameters(\@_, Distance => undef, Options => undef, Progress => undef, ProgressData => undef);
2602 1         2 for my $key (keys %{$p->{options}}) {
  1         4  
2603 1         4 $p->{options}{uc($key)} = $p->{options}{$key};
2604             }
2605 1   0     4 $p->{options}{TYPE} //= $p->{options}{DATATYPE} //= 'Float32';
      33        
2606 1 50       3 unless ($p->{distance}) {
2607 1         3 my ($w, $h) = $self->Size;
2608 1         4 $p->{distance} = Geo::GDAL::Driver('MEM')->Create(Name => 'distance', Width => $w, Height => $h, Type => $p->{options}{TYPE})->Band;
2609             }
2610 1         1375 Geo::GDAL::ComputeProximity($self, $p->{distance}, $p->{options}, $p->{progress}, $p->{progressdata});
2611 1         6 return $p->{distance};
2612             }
2613              
2614              
2615              
2616              
2617             package Geo::GDAL::ColorTable;
2618 19     19   96 use strict;
  19         23  
  19         346  
2619 19     19   60 use warnings;
  19         20  
  19         443  
2620 19     19   55 use Carp;
  19         20  
  19         839  
2621              
2622 19     19   65 use vars qw/%PALETTE_INTERPRETATION_STRING2INT %PALETTE_INTERPRETATION_INT2STRING/;
  19         21  
  19         6183  
2623             for (keys %Geo::GDAL::Const::) {
2624             if (/^GPI_(\w+)/) {
2625             my $int = eval "\$Geo::GDAL::Const::GPI_$1";
2626             $PALETTE_INTERPRETATION_STRING2INT{$1} = $int;
2627             $PALETTE_INTERPRETATION_INT2STRING{$int} = $1;
2628             }
2629             }
2630              
2631             sub GetPaletteInterpretation {
2632 0     0   0 my $self = shift;
2633 0         0 return $PALETTE_INTERPRETATION_INT2STRING{GetPaletteInterpretation($self)};
2634             }
2635              
2636             sub SetColorEntry {
2637 12     12   31 my $self = shift;
2638 12         12 my $index = shift;
2639 12         9 my $color;
2640 12 100       26 if (ref($_[0]) eq 'ARRAY') {
2641 11         13 $color = shift;
2642             } else {
2643 1         2 $color = [@_];
2644             }
2645 12         11 eval {
2646 12         63 $self->_SetColorEntry($index, $color);
2647             };
2648 12 50       22 confess(Geo::GDAL->last_error) if $@;
2649             }
2650              
2651             sub ColorEntry {
2652 267     267   153 my $self = shift;
2653 267   50     278 my $index = shift // 0;
2654 267 100       296 SetColorEntry($self, $index, @_) if @_;
2655 267 100       289 return unless defined wantarray;
2656 262 50       973 return wantarray ? GetColorEntry($self, $index) : [GetColorEntry($self, $index)];
2657             }
2658             *Color = *ColorEntry;
2659              
2660             sub ColorTable {
2661 5     5   231 my $self = shift;
2662 5 100       23 if (@_) {
2663 2         3 my $index = 0;
2664 2         3 for my $color (@_) {
2665 4         8 ColorEntry($self, $index, $color);
2666 4         8 $index++;
2667             }
2668             }
2669 5 50       12 return unless defined wantarray;
2670 5         8 my @table;
2671 5         59 for (my $index = 0; $index < GetCount($self); $index++) {
2672 262         228 push @table, [ColorEntry($self, $index)];
2673             }
2674 5         33 return @table;
2675             }
2676             *ColorEntries = *ColorTable;
2677             *Colors = *ColorTable;
2678              
2679              
2680              
2681              
2682             package Geo::GDAL::RasterAttributeTable;
2683 19     19   79 use strict;
  19         23  
  19         316  
2684 19     19   56 use warnings;
  19         21  
  19         371  
2685 19     19   61 use Carp;
  19         23  
  19         1013  
2686              
2687 19         11805 use vars qw/
2688             @FIELD_TYPES @FIELD_USAGES
2689             %FIELD_TYPE_STRING2INT %FIELD_TYPE_INT2STRING
2690             %FIELD_USAGE_STRING2INT %FIELD_USAGE_INT2STRING
2691 19     19   69 /;
  19         18  
2692             for (keys %Geo::GDAL::Const::) {
2693             next if /TypeCount/;
2694             push(@FIELD_TYPES, $1), next if /^GFT_(\w+)/;
2695             push(@FIELD_USAGES, $1), next if /^GFU_(\w+)/;
2696             }
2697             for my $string (@FIELD_TYPES) {
2698             my $int = eval "\$Geo::GDAL::Constc::GFT_$string";
2699             $FIELD_TYPE_STRING2INT{$string} = $int;
2700             $FIELD_TYPE_INT2STRING{$int} = $string;
2701             }
2702             for my $string (@FIELD_USAGES) {
2703             my $int = eval "\$Geo::GDAL::Constc::GFU_$string";
2704             $FIELD_USAGE_STRING2INT{$string} = $int;
2705             $FIELD_USAGE_INT2STRING{$int} = $string;
2706             }
2707              
2708             sub FieldTypes {
2709 1     1   9 return @FIELD_TYPES;
2710             }
2711              
2712             sub FieldUsages {
2713 1     1   14 return @FIELD_USAGES;
2714             }
2715              
2716             sub RELEASE_PARENTS {
2717 10     10   10 my $self = shift;
2718 10         16 delete $Geo::GDAL::Band::RATS{$self};
2719             }
2720              
2721             sub Band {
2722 1     1   4 my $self = shift;
2723 1         4 return $Geo::GDAL::Band::RATS{tied(%$self)};
2724             }
2725              
2726             sub GetUsageOfCol {
2727 57     57   10686 my($self, $col) = @_;
2728 57         304 $FIELD_USAGE_INT2STRING{_GetUsageOfCol($self, $col)};
2729             }
2730              
2731             sub GetColOfUsage {
2732 0     0   0 my($self, $usage) = @_;
2733 0         0 _GetColOfUsage($self, $FIELD_USAGE_STRING2INT{$usage});
2734             }
2735              
2736             sub GetTypeOfCol {
2737 57     57   9968 my($self, $col) = @_;
2738 57         294 $FIELD_TYPE_INT2STRING{_GetTypeOfCol($self, $col)};
2739             }
2740              
2741             sub Columns {
2742 0     0   0 my $self = shift;
2743 0         0 my %columns;
2744 0 0       0 if (@_) { # create columns
2745 0         0 %columns = @_;
2746 0         0 for my $name (keys %columns) {
2747 0         0 $self->CreateColumn($name, $columns{$name}{Type}, $columns{$name}{Usage});
2748             }
2749             }
2750 0         0 %columns = ();
2751 0         0 for my $c (0..$self->GetColumnCount-1) {
2752 0         0 my $name = $self->GetNameOfCol($c);
2753 0         0 $columns{$name}{Type} = $self->GetTypeOfCol($c);
2754 0         0 $columns{$name}{Usage} = $self->GetUsageOfCol($c);
2755             }
2756 0         0 return %columns;
2757             }
2758              
2759             sub CreateColumn {
2760 57     57   265 my($self, $name, $type, $usage) = @_;
2761 57         54 for my $color (qw/Red Green Blue Alpha/) {
2762 228 100 100     1317 carp "RAT column type will be 'Integer' for usage '$color'." if $usage eq $color and $type ne 'Integer';
2763             }
2764 57         127 $type = Geo::GDAL::string2int($type, \%FIELD_TYPE_STRING2INT);
2765 57         69 $usage = Geo::GDAL::string2int($usage, \%FIELD_USAGE_STRING2INT);
2766 57         208 _CreateColumn($self, $name, $type, $usage);
2767             }
2768              
2769             sub Value {
2770 57     57   10267 my($self, $row, $column) = @_;
2771 57 50       411 SetValueAsString($self, $row, $column, $_[3]) if defined $_[3];
2772 57 50       90 return unless defined wantarray;
2773 57         282 GetValueAsString($self, $row, $column);
2774             }
2775              
2776             sub LinearBinning {
2777 0     0   0 my $self = shift;
2778 0 0       0 SetLinearBinning($self, @_) if @_ > 0;
2779 0 0       0 return unless defined wantarray;
2780 0         0 my @a = GetLinearBinning($self);
2781 0 0       0 return $a[0] ? ($a[1], $a[2]) : ();
2782             }
2783              
2784              
2785              
2786              
2787             package Geo::GDAL::GCP;
2788              
2789             *swig_Pixel_get = *Geo::GDALc::GCP_Column_get;
2790             *swig_Pixel_set = *Geo::GDALc::GCP_Column_set;
2791             *swig_Line_get = *Geo::GDALc::GCP_Row_get;
2792             *swig_Line_set = *Geo::GDALc::GCP_Row_set;
2793              
2794              
2795              
2796             package Geo::GDAL::VSIF;
2797 19     19   88 use strict;
  19         27  
  19         299  
2798 19     19   65 use warnings;
  19         22  
  19         368  
2799 19     19   59 use Carp;
  19         25  
  19         9821  
2800             require Exporter;
2801             our @ISA = qw(Exporter);
2802              
2803             our @EXPORT_OK = qw(Open Close Write Read Seek Tell Truncate MkDir ReadDir ReadDirRecursive Rename RmDir Stat Unlink);
2804             our %EXPORT_TAGS = (all => \@EXPORT_OK);
2805              
2806             sub Open {
2807 3     3   334 my ($path, $mode) = @_;
2808 3         48 my $self = Geo::GDAL::VSIFOpenL($path, $mode);
2809 3         10 bless $self, 'Geo::GDAL::VSIF';
2810             }
2811              
2812             sub Write {
2813 2     2   184 my ($self, $data) = @_;
2814 2         22 Geo::GDAL::VSIFWriteL($data, $self);
2815             }
2816              
2817             sub Close {
2818 3     3   177 my ($self, $data) = @_;
2819 3         14 Geo::GDAL::VSIFCloseL($self);
2820             }
2821              
2822             sub Read {
2823 1     1   12 my ($self, $count) = @_;
2824 1         6 Geo::GDAL::VSIFReadL($count, $self);
2825             }
2826              
2827             sub Seek {
2828 0     0   0 my ($self, $offset, $whence) = @_;
2829 0         0 Geo::GDAL::VSIFSeekL($self, $offset, $whence);
2830             }
2831              
2832             sub Tell {
2833 0     0   0 my ($self) = @_;
2834 0         0 Geo::GDAL::VSIFTellL($self);
2835             }
2836              
2837             sub Truncate {
2838 0     0   0 my ($self, $new_size) = @_;
2839 0         0 Geo::GDAL::VSIFTruncateL($self, $new_size);
2840             }
2841              
2842             sub MkDir {
2843 3     3   822 my ($path) = @_;
2844             # mode unused in CPL
2845 3         447 Geo::GDAL::Mkdir($path, 0);
2846             }
2847             *Mkdir = *MkDir;
2848              
2849             sub ReadDir {
2850 8     8   17808 my ($path) = @_;
2851 8         403 Geo::GDAL::ReadDir($path);
2852             }
2853              
2854             sub ReadDirRecursive {
2855 3     3   8 my ($path) = @_;
2856 3         43 Geo::GDAL::ReadDirRecursive($path);
2857             }
2858              
2859             sub Rename {
2860 1     1   171 my ($old, $new) = @_;
2861 1         19 Geo::GDAL::Rename($old, $new);
2862             }
2863              
2864             sub RmDir {
2865 2     2   195 my ($dirname, $recursive) = @_;
2866 2         2 eval {
2867 2 100       5 if (!$recursive) {
2868 1         5 Geo::GDAL::Rmdir($dirname);
2869             } else {
2870 1         6 for my $f (ReadDir($dirname)) {
2871 1 50 33     8 next if $f eq '..' or $f eq '.';
2872 1         5 my @s = Stat($dirname.'/'.$f);
2873 1 50       4 if ($s[0] eq 'f') {
    0          
2874 1         3 Unlink($dirname.'/'.$f);
2875             } elsif ($s[0] eq 'd') {
2876 0         0 Rmdir($dirname.'/'.$f, 1);
2877 0         0 Rmdir($dirname.'/'.$f);
2878             }
2879             }
2880 1         4 RmDir($dirname);
2881             }
2882             };
2883 2 50       6 if ($@) {
2884 0 0       0 my $r = $recursive ? ' recursively' : '';
2885 0         0 Geo::GDAL::error("Cannot remove directory \"$dirname\"$r.");
2886             }
2887             }
2888             *Rmdir = *RmDir;
2889              
2890             sub Stat {
2891 1     1   2 my ($path) = @_;
2892 1         7 Geo::GDAL::Stat($path);
2893             }
2894              
2895             sub Unlink {
2896 8     8   9628 my ($filename) = @_;
2897 8         769 Geo::GDAL::Unlink($filename);
2898             }
2899              
2900              
2901              
2902              
2903             package Geo::GDAL::GeoTransform;
2904 19     19   79 use strict;
  19         21  
  19         309  
2905 19     19   55 use warnings;
  19         26  
  19         407  
2906 19     19   61 use Carp;
  19         19  
  19         807  
2907 19     19   68 use Scalar::Util 'blessed';
  19         24  
  19         8447  
2908              
2909             sub new {
2910 11     11   4113 my $class = shift;
2911 11         14 my $self;
2912 11 100       53 if (@_ == 0) {
    100          
2913 2         6 $self = [0,1,0,0,0,1];
2914             } elsif (@_ == 1) {
2915 4         6 $self = $_[0];
2916             } else {
2917 5         13 my @a = @_;
2918 5         7 $self = \@a;
2919             }
2920 11         14 bless $self, $class;
2921 11         22 return $self;
2922             }
2923              
2924             sub NorthUp {
2925 0     0   0 my $self = shift;
2926 0   0     0 return $self->[2] == 0 && $self->[4] == 0;
2927             }
2928              
2929             sub FromGCPs {
2930 2     2   247 my $gcps;
2931 2         3 my $p = shift;
2932 2 100       5 if (ref $p eq 'ARRAY') {
2933 1         1 $gcps = $p;
2934             } else {
2935 1         2 $gcps = [];
2936 1   66     13 while ($p && blessed $p) {
2937 4         5 push @$gcps, $p;
2938 4         11 $p = shift;
2939             }
2940             }
2941 2   100     5 my $approx_ok = shift // 1;
2942 2 50       5 Geo::GDAL::error('Usage: Geo::GDAL::GeoTransform::FromGCPs(\@gcps, $approx_ok)') unless @$gcps;
2943 2         28 my $self = Geo::GDAL::GCPsToGeoTransform($gcps, $approx_ok);
2944 2         8 bless $self, 'Geo::GDAL::GetTransform';
2945 2         5 return $self;
2946             }
2947              
2948             sub Apply {
2949 6     6   23 my ($self, $columns, $rows) = @_;
2950 6 100       40 return Geo::GDAL::ApplyGeoTransform($self, $columns, $rows) unless ref($columns) eq 'ARRAY';
2951 1         2 my (@x, @y);
2952 1         2 for my $i (0..$#$columns) {
2953 1         6 ($x[$i], $y[$i]) =
2954             Geo::GDAL::ApplyGeoTransform($self, $columns->[$i], $rows->[$i]);
2955             }
2956 1         3 return (\@x, \@y);
2957             }
2958              
2959             sub Inv {
2960 2     2   188 my $self = shift;
2961 2         11 my @inv = Geo::GDAL::InvGeoTransform($self);
2962 2 100       7 return Geo::GDAL::GeoTransform->new(@inv) if defined wantarray;
2963 1         5 @$self = @inv;
2964             }
2965              
2966             sub Extent {
2967 0     0     my ($self, $w, $h) = @_;
2968 0           my $e = Geo::GDAL::Extent->new($self->[0], $self->[3], $self->[0], $self->[3]);
2969 0           for my $x ($self->[0] + $self->[1]*$w, $self->[0] + $self->[2]*$h, $self->[0] + $self->[1]*$w + $self->[2]*$h) {
2970 0 0         $e->[0] = $x if $x < $e->[0];
2971 0 0         $e->[2] = $x if $x > $e->[2];
2972             }
2973 0           for my $y ($self->[3] + $self->[4]*$w, $self->[3] + $self->[5]*$h, $self->[3] + $self->[4]*$w + $self->[5]*$h) {
2974 0 0         $e->[1] = $y if $y < $e->[1];
2975 0 0         $e->[3] = $y if $y > $e->[3];
2976             }
2977 0           return $e;
2978             }
2979              
2980             package Geo::GDAL::Extent; # array 0=xmin|left, 1=ymin|bottom, 2=xmax|right, 3=ymax|top
2981              
2982 19     19   79 use strict;
  19         23  
  19         304  
2983 19     19   52 use warnings;
  19         18  
  19         371  
2984 19     19   57 use Carp;
  19         14  
  19         816  
2985 19     19   69 use Scalar::Util 'blessed';
  19         22  
  19         5664  
2986              
2987             sub new {
2988 0     0     my $class = shift;
2989 0           my $self;
2990 0 0         if (@_ == 0) {
    0          
2991 0           $self = [0,0,0,0];
2992             } elsif (ref $_[0]) {
2993 0           @$self = @{$_[0]};
  0            
2994             } else {
2995 0           @$self = @_;
2996             }
2997 0           bless $self, $class;
2998 0           return $self;
2999             }
3000              
3001             sub Size {
3002 0     0     my $self = shift;
3003 0           return ($self->[2] - $self->[0], $self->[3] - $self->[1]);
3004             }
3005              
3006             sub Overlaps {
3007 0     0     my ($self, $e) = @_;
3008 0   0       return $self->[0] < $e->[2] && $self->[2] > $e->[0] && $self->[1] < $e->[3] && $self->[3] > $e->[1];
3009             }
3010              
3011             sub Overlap {
3012 0     0     my ($self, $e) = @_;
3013 0 0         return undef unless $self->Overlaps($e);
3014 0           my $ret = Geo::GDAL::Extent->new($self);
3015 0 0         $ret->[0] = $e->[0] if $self->[0] < $e->[0];
3016 0 0         $ret->[1] = $e->[1] if $self->[1] < $e->[1];
3017 0 0         $ret->[2] = $e->[2] if $self->[2] > $e->[2];
3018 0 0         $ret->[3] = $e->[3] if $self->[3] > $e->[3];
3019 0           return $ret;
3020             }
3021              
3022             sub ExpandToInclude {
3023 0     0     my ($self, $e) = @_;
3024 0 0         $self->[0] = $e->[0] if $e->[0] < $self->[0];
3025 0 0         $self->[1] = $e->[1] if $e->[1] < $self->[1];
3026 0 0         $self->[2] = $e->[2] if $e->[2] > $self->[2];
3027 0 0         $self->[3] = $e->[3] if $e->[3] > $self->[3];
3028             }
3029              
3030             package Geo::GDAL::XML;
3031              
3032 19     19   75 use strict;
  19         20  
  19         301  
3033 19     19   52 use warnings;
  19         22  
  19         360  
3034 19     19   51 use Carp;
  19         24  
  19         7365  
3035              
3036             # XML related subs in Geo::GDAL
3037              
3038             #Geo::GDAL::Child
3039             #Geo::GDAL::Children
3040             #Geo::GDAL::NodeData
3041             #Geo::GDAL::NodeType
3042             #Geo::GDAL::NodeTypes
3043             #Geo::GDAL::ParseXMLString
3044             #Geo::GDAL::SerializeXMLTree
3045              
3046             sub new {
3047 0     0     my $class = shift;
3048 0   0       my $xml = shift // '';
3049 0           my $self = Geo::GDAL::ParseXMLString($xml);
3050 0           bless $self, $class;
3051 0     0     $self->traverse(sub {my $node = shift; bless $node, $class});
  0            
  0            
3052 0           return $self;
3053             }
3054              
3055             sub traverse {
3056 0     0     my ($self, $sub) = @_;
3057 0           my $type = $self->[0];
3058 0           my $data = $self->[1];
3059 0           $type = Geo::GDAL::NodeType($type);
3060 0           $sub->($self, $type, $data);
3061 0           for my $child (@{$self}[2..$#$self]) {
  0            
3062 0           traverse($child, $sub);
3063             }
3064             }
3065              
3066             sub serialize {
3067 0     0     my $self = shift;
3068 0           return Geo::GDAL::SerializeXMLTree($self);
3069             }
3070              
3071             1;