File Coverage

blib/lib/Geo/GDAL.pm
Criterion Covered Total %
statement 938 1461 64.2
branch 248 558 44.4
condition 86 206 41.7
subroutine 197 307 64.1
pod 0 33 0.0
total 1469 2565 57.2


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 18     18   259223 use base qw(Exporter);
  18         24  
  18         1548  
9 18     18   72 use base qw(DynaLoader);
  18         18  
  18         16098  
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   3931 my ($self,$field) = @_;
34 2511         2240 my $member_func = "swig_${field}_get";
35 2511         7304 $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 18     18   76 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         30  
  18         2983  
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 18     18   70 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         22  
  18         3430  
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 18     18   75 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         20  
  18         5759  
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   267 my $pkg = shift;
254 18         97 my $self = Geo::GDALc::new_GCP(@_);
255 18 50       75 bless $self, $pkg if defined($self);
256             }
257              
258             sub DESTROY {
259 64     64   272 my $self = shift;
260 64 100       133 unless ($self->isa('SCALAR')) {
261 32 50       54 return unless $self->isa('HASH');
262 32         19 $self = tied(%{$self});
  32         28  
263 32 50       52 return unless defined $self;
264             }
265 64         48 my $code = $Geo::GDAL::stdout_redirection{$self};
266 64         52 delete $Geo::GDAL::stdout_redirection{$self};
267 64         42 delete $ITERATORS{$self};
268 64 100       87 if (exists $OWNER{$self}) {
269 32         72 Geo::GDALc::delete_GCP($self);
270 32         30 delete $OWNER{$self};
271             }
272 64         67 $self->RELEASE_PARENTS();
273 64 50       127 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 18     18   71 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         15  
  18         3179  
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 18     18   67 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         21  
  18         15230  
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   2666 my $self = shift;
342 122 100       374 unless ($self->isa('SCALAR')) {
343 61 50       135 return unless $self->isa('HASH');
344 61         57 $self = tied(%{$self});
  61         80  
345 61 50       109 return unless defined $self;
346             }
347 122         143 my $code = $Geo::GDAL::stdout_redirection{$self};
348 122         100 delete $Geo::GDAL::stdout_redirection{$self};
349 122         111 delete $ITERATORS{$self};
350 122 100       219 if (exists $OWNER{$self}) {
351 60         3424 Geo::GDALc::delete_Dataset($self);
352 60         145 delete $OWNER{$self};
353             }
354 122         195 $self->RELEASE_PARENTS();
355 122 100       678 if ($code) {
356 1         4 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 18     18   74 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         1222  
  18         7646  
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 18     18   77 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         21  
  18         1011  
485             @ISA = qw( Geo::GDAL );
486             %OWNER = ();
487 18     18   168 use Carp;
  18         18  
  18         5467  
488             sub new {
489 10     10   2837 my($pkg, $pi) = @_;
490 10   100     28 $pi //= 'RGB';
491 10         23 $pi = Geo::GDAL::string2int($pi, \%PALETTE_INTERPRETATION_STRING2INT);
492 10         109 my $self = Geo::GDALc::new_ColorTable($pi);
493 10 50       45 bless $self, $pkg if defined($self);
494             }
495              
496             sub DESTROY {
497 40     40   2663 my $self = shift;
498 40 100       139 unless ($self->isa('SCALAR')) {
499 20 50       41 return unless $self->isa('HASH');
500 20         17 $self = tied(%{$self});
  20         28  
501 20 50       31 return unless defined $self;
502             }
503 40         48 my $code = $Geo::GDAL::stdout_redirection{$self};
504 40         29 delete $Geo::GDAL::stdout_redirection{$self};
505 40         27 delete $ITERATORS{$self};
506 40 100       64 if (exists $OWNER{$self}) {
507 10         40 Geo::GDALc::delete_ColorTable($self);
508 10         12 delete $OWNER{$self};
509             }
510 40         62 $self->RELEASE_PARENTS();
511 40 50       146 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 18     18   66 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         17  
  18         6032  
542             @ISA = qw( Geo::GDAL );
543             %OWNER = ();
544             sub new {
545 3     3   402 my $pkg = shift;
546 3         50 my $self = Geo::GDALc::new_RasterAttributeTable(@_);
547 3 50       22 bless $self, $pkg if defined($self);
548             }
549              
550             sub DESTROY {
551 10     10   571 my $self = shift;
552 10 100       48 unless ($self->isa('SCALAR')) {
553 5 50       16 return unless $self->isa('HASH');
554 5         5 $self = tied(%{$self});
  5         11  
555 5 50       10 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         12 delete $ITERATORS{$self};
560 10 100       22 if (exists $OWNER{$self}) {
561 3         30 Geo::GDALc::delete_RasterAttributeTable($self);
562 3         6 delete $OWNER{$self};
563             }
564 10         19 $self->RELEASE_PARENTS();
565 10 50       33 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 18     18   67 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         15  
  18         3900  
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 18     18   65 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         17  
  18         3426  
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 18     18   80 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         18  
  18         3236  
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 18     18   68 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         17  
  18         3404  
723             @ISA = qw( Geo::GDAL );
724             %OWNER = ();
725             %ITERATORS = ();
726             sub new {
727 2     2   3 my $pkg = shift;
728 2         47 my $self = Geo::GDALc::new_GDALWarpAppOptions(@_);
729 2 50       11 bless $self, $pkg if defined($self);
730             }
731              
732             sub DESTROY {
733 4 100   4   25 return unless $_[0]->isa('HASH');
734 2         3 my $self = tied(%{$_[0]});
  2         3  
735 2 50       7 return unless defined $self;
736 2         2 delete $ITERATORS{$self};
737 2 50       6 if (exists $OWNER{$self}) {
738 2         13 Geo::GDALc::delete_GDALWarpAppOptions($self);
739 2         7 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 18     18   66 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         15  
  18         3231  
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 18     18   60 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         18  
  18         3375  
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 18     18   63 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         13  
  18         3108  
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 18     18   64 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         14  
  18         3210  
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 18     18   59 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         18  
  18         3164  
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 18     18   64 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
  18         18  
  18         3317  
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 18     18   64 use strict;
  18         19  
  18         331  
988 18     18   47 use warnings;
  18         22  
  18         372  
989 18     18   52 use Carp;
  18         19  
  18         723  
990 18     18   8004 use Encode;
  18         111311  
  18         1050  
991 18     18   84 use Exporter 'import';
  18         19  
  18         347  
992 18     18   6109 use Geo::GDAL::Const;
  18         26  
  18         693  
993 18     18   9519 use Geo::OGR;
  18         38  
  18         1218  
994 18     18   90 use Geo::OSR;
  18         18  
  18         1172  
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.010004';
1007             our $GDAL_VERSION = '2.1.0';
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 18     18   65 use Scalar::Util 'blessed';
  18         18  
  18         989  
1071 18         42806 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 18     18   65 /;
  18         20  
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             sub error {
1118 13 50   13 0 27 if (@_) {
1119 13         12 my $error;
1120 13 100       25 if (@_ == 3) {
1121 2         3 my ($ecode, $offender, $ex) = @_;
1122 2 50       5 if ($ecode == 1) {
    0          
1123 2         13 my @k = sort keys %$ex;
1124 2 50       9 $error = "Unknown value: '$offender'. " if defined $offender;
1125 2         9 $error .= "Expected one of ".join(', ', @k).".";
1126             } elsif ($ecode == 2) {
1127 0         0 $error = "$ex not found: '$offender'.";
1128             } else {
1129 0         0 die("error in error: $ecode, $offender, $ex");
1130             }
1131             } else {
1132 11         10 $error = shift;
1133             }
1134 13         17 push @error, $error;
1135 13         1557 confess($error);
1136             }
1137 0         0 my @stack = @error;
1138 0         0 chomp(@stack);
1139 0         0 @error = ();
1140 0 0       0 return wantarray ? @stack : join("\n", @stack);
1141             }
1142              
1143             sub last_error {
1144 1   50 1 0 5 my $error = $error[$#error] // '';
1145 1         2 chomp($error);
1146 1         75 return $error;
1147             }
1148              
1149             sub errstr {
1150 3     3 0 685 my @stack = @error;
1151 3         4 chomp(@stack);
1152 3         4 @error = ();
1153 3         8 return join("\n", @stack);
1154             }
1155              
1156             # usage: named_parameters(\@_, key value list of default parameters);
1157             # returns parameters in a hash with low-case-without-_ keys
1158             sub named_parameters {
1159 758     758 0 1933 my $parameters = shift;
1160 758         2266 my %defaults = @_;
1161 758         539 my %c;
1162 758         1478 for my $k (keys %defaults) {
1163 7208         5303 my $c = lc($k); $c =~ s/_//g;
  7208         4787  
1164 7208         6287 $c{$c} = $k;
1165             }
1166 758         809 my %named;
1167 758 100       2128 my @p = ref($parameters->[0]) eq 'HASH' ? %{$parameters->[0]} : @$parameters;
  2         7  
1168 758 100       1165 if (@p) {
1169 745   50     1218 my $c = lc($p[0] // ''); $c =~ s/_//g;
  745         632  
1170 745 100 66     1823 if (@p % 2 == 0 && defined $c && exists $c{$c}) {
      66        
1171 66         152 for (my $i = 0; $i < @p; $i+=2) {
1172 205         441 my $c = lc($p[$i]); $c =~ s/_//g;
  205         178  
1173 205 50 33     623 error(1, $p[$i], \%defaults) unless defined $c{$c} && exists $defaults{$c{$c}};
1174 205         454 $named{$c} = $p[$i+1];
1175             }
1176             } else {
1177 679         1076 for (my $i = 0; $i < @p; $i++) {
1178 3373         2890 my $c = lc($_[$i*2]); $c =~ s/_//g;
  3373         2363  
1179 3373         2647 my $t = ref($defaults{$c{$c}});
1180 3373 50 66     9598 if (!blessed($p[$i]) and (ref($p[$i]) ne $t)) {
1181 0 0       0 $t = $t eq '' ? 'SCALAR' : "a reference to $t";
1182 0         0 error("parameter '$p[$i]' is not $t as it should for parameter $c{$c}.");
1183             }
1184 3373         5665 $named{$c} = $p[$i]; # $p[$i] could be a sub ...
1185             }
1186             }
1187             }
1188 758         1295 for my $k (keys %defaults) {
1189 7208         4728 my $c = lc($k); $c =~ s/_//g;
  7208         4637  
1190 7208   100     12728 $named{$c} //= $defaults{$k};
1191             }
1192 758         2276 return \%named;
1193             }
1194              
1195             sub string2int {
1196 1124     1124 0 2799 my ($string, $string2int_hash, $int2string_hash, $default) = @_;
1197 1124 100 66     1727 $string = $default if defined $default && !defined $string;
1198 1124 100       1291 return unless defined $string;
1199 1123 100 66     2179 return $string if $int2string_hash && exists $int2string_hash->{$string};
1200 1036 100       1413 error(1, $string, $string2int_hash) unless exists $string2int_hash->{$string};
1201 1034         1283 $string2int_hash->{$string};
1202             }
1203              
1204       104 0   sub RELEASE_PARENTS {
1205             }
1206              
1207             sub FindFile {
1208             if (@_ == 1) {
1209             _FindFile('', @_);
1210             } else {
1211             _FindFile(@_);
1212             }
1213             }
1214              
1215             sub DataTypes {
1216 4     4 0 1840 return @DATA_TYPES;
1217             }
1218              
1219             sub OpenFlags {
1220 0     0 0 0 return @DATA_TYPES;
1221             }
1222              
1223             sub ResamplingTypes {
1224 1     1 0 282 return @RESAMPLING_TYPES;
1225             }
1226              
1227             sub RIOResamplingTypes {
1228 2     2 0 300 return @RIO_RESAMPLING_TYPES;
1229             }
1230              
1231             sub NodeTypes {
1232 1     1 0 319 return @NODE_TYPES;
1233             }
1234              
1235             sub NodeType {
1236 307     307 0 518 my $type = shift;
1237 307 50       817 return $NODE_TYPE_INT2STRING{$type} if $type =~ /^\d/;
1238 0         0 return $NODE_TYPE_STRING2INT{$type};
1239             }
1240              
1241             sub NodeData {
1242 301     301 0 195 my $node = shift;
1243 301         255 return (Geo::GDAL::NodeType($node->[0]), $node->[1]);
1244             }
1245              
1246             sub Children {
1247 36     36 0 28 my $node = shift;
1248 36         61 return @$node[2..$#$node];
1249             }
1250              
1251             sub Child {
1252 150     150 0 101 my($node, $child) = @_;
1253 150         171 return $node->[2+$child];
1254             }
1255              
1256             sub GetDataTypeSize {
1257 32     32 0 360 return _GetDataTypeSize(string2int(shift, \%TYPE_STRING2INT, \%TYPE_INT2STRING));
1258             }
1259              
1260             sub DataTypeValueRange {
1261 12     12 0 26 my $t = shift;
1262 12 50       22 Geo::GDAL::error(1, $t, \%TYPE_STRING2INT) unless exists $TYPE_STRING2INT{$t};
1263             # these values are from gdalrasterband.cpp
1264 12 100       27 return (0,255) if $t =~ /Byte/;
1265 11 100       20 return (0,65535) if $t =~/UInt16/;
1266 10 100       20 return (-32768,32767) if $t =~/Int16/;
1267 8 100       304 return (0,4294967295) if $t =~/UInt32/;
1268 7 100       16 return (-2147483648,2147483647) if $t =~/Int32/;
1269 5 100       15 return (-4294967295.0,4294967295.0) if $t =~/Float32/;
1270 3 100       11 return (-4294967295.0,4294967295.0) if $t =~/Float64/;
1271             }
1272              
1273             sub DataTypeIsComplex {
1274 12     12 0 6861 return _DataTypeIsComplex(string2int(shift, \%TYPE_STRING2INT));
1275             }
1276              
1277             sub PackCharacter {
1278 55     55 0 1388 my $t = shift;
1279 55 100       143 $t = $TYPE_INT2STRING{$t} if exists $TYPE_INT2STRING{$t};
1280 55 50       94 Geo::GDAL::error(1, $t, \%TYPE_STRING2INT) unless exists $TYPE_STRING2INT{$t};
1281 55         474 my $is_big_endian = unpack("h*", pack("s", 1)) =~ /01/; # from Programming Perl
1282 55 100       184 return 'C' if $t =~ /^Byte$/;
1283 31 50       75 return ($is_big_endian ? 'n': 'v') if $t =~ /^UInt16$/;
    100          
1284 29 100       54 return 's' if $t =~ /^Int16$/;
1285 27 50       44 return ($is_big_endian ? 'N' : 'V') if $t =~ /^UInt32$/;
    100          
1286 26 100       62 return 'l' if $t =~ /^Int32$/;
1287 16 100       38 return 'f' if $t =~ /^Float32$/;
1288 14 100       49 return 'd' if $t =~ /^Float64$/;
1289             }
1290              
1291             sub GetDriverNames {
1292 2     2 0 35453 my @names;
1293 2         17 for my $i (0..GetDriverCount()-1) {
1294 306         665 my $driver = GetDriver($i);
1295 306 100       362 push @names, $driver->Name if $driver->TestCapability('RASTER');
1296             }
1297 2         58 return @names;
1298             }
1299             *DriverNames = *GetDriverNames;
1300              
1301             sub Drivers {
1302 1     1 0 1031 my @drivers;
1303 1         20 for my $i (0..GetDriverCount()-1) {
1304 153         310 my $driver = GetDriver($i);
1305 153 100       151 push @drivers, $driver if $driver->TestCapability('RASTER');
1306             }
1307 1         9 return @drivers;
1308             }
1309              
1310             sub Driver {
1311 60 100   60 0 8542 return 'Geo::GDAL::Driver' unless @_;
1312 57         1130 return GetDriver(@_);
1313             }
1314              
1315             sub AccessTypes {
1316 1     1 0 11 return qw/ReadOnly Update/;
1317             }
1318              
1319             sub Open {
1320 2     2 0 11 my $p = Geo::GDAL::named_parameters(\@_, Name => '.', Access => 'ReadOnly', Type => 'Any', Options => {}, Files => []);
1321 2         3 my @flags;
1322 2         4 my %o = (READONLY => 1, UPDATE => 1);
1323 2 50       9 Geo::GDAL::error(1, $p->{access}, \%o) unless $o{uc($p->{access})};
1324 2         4 push @flags, uc($p->{access});
1325 2         4 %o = (RASTER => 1, VECTOR => 1, ANY => 1);
1326 2 50       6 Geo::GDAL::error(1, $p->{type}, \%o) unless $o{uc($p->{type})};
1327 2 50       3 push @flags, uc($p->{type}) unless uc($p->{type}) eq 'ANY';
1328 2         5 my $dataset = OpenEx(Name => $p->{name}, Flags => \@flags, Options => $p->{options}, Files => $p->{files});
1329 2 50       5 unless ($dataset) {
1330 0         0 my $t = "Failed to open $p->{name}.";
1331 0 0       0 $t .= " Is it a ".lc($p->{type})." dataset?" unless uc($p->{type}) eq 'ANY';
1332 0         0 error($t);
1333             }
1334 2         8 return $dataset;
1335             }
1336              
1337             sub OpenShared {
1338 2     2 0 268 my @p = @_; # name, update
1339 2         3 my @flags = qw/RASTER SHARED/;
1340 2   50     4 $p[1] //= 'ReadOnly';
1341 2 50 33     5 Geo::GDAL::error(1, $p[1], {ReadOnly => 1, Update => 1}) unless ($p[1] eq 'ReadOnly' or $p[1] eq 'Update');
1342 2 50       6 push @flags, qw/READONLY/ if $p[1] eq 'ReadOnly';
1343 2 50       3 push @flags, qw/UPDATE/ if $p[1] eq 'Update';
1344 2         3 my $dataset = OpenEx($p[0], \@flags);
1345 2 50       5 error("Failed to open $p[0]. Is it a raster dataset?") unless $dataset;
1346 2         5 return $dataset;
1347             }
1348              
1349             sub OpenEx {
1350 6     6 0 39 my $p = Geo::GDAL::named_parameters(\@_, Name => '.', Flags => [], Drivers => [], Options => {}, Files => []);
1351 6 50       13 unless ($p) {
1352 0   0     0 my $name = shift // '';
1353 0         0 my @flags = @_;
1354 0         0 $p = {name => $name, flags => \@flags, drivers => [], options => {}, files => []};
1355             }
1356 6 50       11 if ($p->{flags}) {
1357 6         3 my $f = 0;
1358 6         5 for my $flag (@{$p->{flags}}) {
  6         9  
1359 8 50       11 Geo::GDAL::error(1, $flag, \%OF_STRING2INT) unless exists $OF_STRING2INT{$flag};
1360 8         8 $f |= $Geo::GDAL::OF_STRING2INT{$flag};
1361             }
1362 6         7 $p->{flags} = $f;
1363             }
1364 6         548 return _OpenEx($p->{name}, $p->{flags}, $p->{drivers}, $p->{options}, $p->{files});
1365             }
1366              
1367             sub Polygonize {
1368 0     0 0 0 my @params = @_;
1369 0 0       0 $params[3] = $params[2]->GetLayerDefn->GetFieldIndex($params[3]) unless $params[3] =~ /^\d/;
1370 0         0 _Polygonize(@params);
1371             }
1372              
1373             sub RegenerateOverviews {
1374 1     1 0 2 my @p = @_;
1375 1 50       2 $p[2] = uc($p[2]) if $p[2]; # see overview.cpp:2030
1376 1         867 _RegenerateOverviews(@p);
1377             }
1378              
1379             sub RegenerateOverview {
1380 2     2 0 191 my @p = @_;
1381 2 100       8 $p[2] = uc($p[2]) if $p[2]; # see overview.cpp:2030
1382 2         839 _RegenerateOverview(@p);
1383             }
1384              
1385             sub ReprojectImage {
1386 0     0 0 0 my @p = @_;
1387 0         0 $p[4] = string2int($p[4], \%RESAMPLING_STRING2INT);
1388 0         0 return _ReprojectImage(@p);
1389             }
1390              
1391             sub AutoCreateWarpedVRT {
1392 0     0 0 0 my @p = @_;
1393 0         0 for my $i (1..2) {
1394 0 0 0     0 if (defined $p[$i] and ref($p[$i])) {
1395 0         0 $p[$i] = $p[$i]->ExportToWkt;
1396             }
1397             }
1398 0         0 $p[3] = string2int($p[3], \%RESAMPLING_STRING2INT, undef, 'NearestNeighbour');
1399 0         0 return _AutoCreateWarpedVRT(@p);
1400             }
1401              
1402             sub make_processing_options {
1403 2     2 0 4 my ($o) = @_;
1404 2 50       7 if (ref $o eq 'HASH') {
1405 2         7 for my $key (keys %$o) {
1406 2 50       5 unless ($key =~ /^-/) {
1407 2         6 $o->{'-'.$key} = $o->{$key};
1408 2         5 delete $o->{$key};
1409             }
1410             }
1411 2         5 $o = [%$o];
1412             }
1413 2         12 return $o;
1414             }
1415              
1416              
1417              
1418              
1419             package Geo::GDAL::MajorObject;
1420 18     18   101 use strict;
  18         18  
  18         425  
1421 18     18   66 use warnings;
  18         23  
  18         578  
1422 18     18   57 use vars qw/@DOMAINS/;
  18         23  
  18         2701  
1423              
1424             sub Domains {
1425 0     0   0 return @DOMAINS;
1426             }
1427              
1428             sub Description {
1429 0     0   0 my($self, $desc) = @_;
1430 0 0       0 SetDescription($self, $desc) if defined $desc;
1431 0 0       0 GetDescription($self) if defined wantarray;
1432             }
1433              
1434             sub Metadata {
1435 0 0   0   0 my $self = shift,
1436             my $metadata = ref $_[0] ? shift : undef;
1437 0   0     0 my $domain = shift // '';
1438 0 0       0 SetMetadata($self, $metadata, $domain) if defined $metadata;
1439 0 0       0 GetMetadata($self, $domain) if defined wantarray;
1440             }
1441              
1442              
1443              
1444              
1445             package Geo::GDAL::Driver;
1446 18     18   72 use strict;
  18         25  
  18         332  
1447 18     18   57 use warnings;
  18         19  
  18         362  
1448 18     18   63 use Carp;
  18         17  
  18         928  
1449 18     18   63 use Scalar::Util 'blessed';
  18         22  
  18         668  
1450              
1451 18     18   64 use vars qw/@CAPABILITIES @DOMAINS/;
  18         19  
  18         14736  
1452             for (keys %Geo::GDAL::Const::) {
1453             next if /TypeCount/;
1454             push(@CAPABILITIES, $1), next if /^DCAP_(\w+)/;
1455             }
1456              
1457             sub Domains {
1458 2     2   226 return @DOMAINS;
1459             }
1460              
1461             sub Name {
1462 334     334   1269 my $self = shift;
1463 334         676 return $self->{ShortName};
1464             }
1465              
1466             sub Capabilities {
1467 3     3   16 my $self = shift;
1468 3 100       23 return @CAPABILITIES unless $self;
1469 2         52 my $h = $self->GetMetadata;
1470 2         3 my @cap;
1471 2         6 for my $cap (@CAPABILITIES) {
1472 18         29 my $test = $h->{'DCAP_'.uc($cap)};
1473 18 100 66     44 push @cap, $cap if defined($test) and $test eq 'YES';
1474             }
1475 2         11 return @cap;
1476             }
1477              
1478             sub TestCapability {
1479 620     620   18609 my($self, $cap) = @_;
1480 620         3848 my $h = $self->GetMetadata->{'DCAP_'.uc($cap)};
1481 620 100 66     2724 return (defined($h) and $h eq 'YES') ? 1 : undef;
1482             }
1483              
1484             sub Extension {
1485 1     1   2 my $self = shift;
1486 1         16 my $h = $self->GetMetadata;
1487 1         5 return $h->{DMD_EXTENSION};
1488             }
1489              
1490             sub MIMEType {
1491 1     1   2 my $self = shift;
1492 1         15 my $h = $self->GetMetadata;
1493 1         4 return $h->{DMD_MIMETYPE};
1494             }
1495              
1496             sub CreationOptionList {
1497 1     1   1 my $self = shift;
1498 1         2 my @options;
1499 1         16 my $h = $self->GetMetadata->{DMD_CREATIONOPTIONLIST};
1500 1 50       9 if ($h) {
1501 1         213 $h = Geo::GDAL::ParseXMLString($h);
1502 1         4 my($type, $value) = Geo::GDAL::NodeData($h);
1503 1 50       3 if ($value eq 'CreationOptionList') {
1504 1         3 for my $o (Geo::GDAL::Children($h)) {
1505 35         16 my %option;
1506 35         35 for my $a (Geo::GDAL::Children($o)) {
1507 150         127 my(undef, $key) = Geo::GDAL::NodeData($a);
1508 150         155 my(undef, $value) = Geo::GDAL::NodeData(Geo::GDAL::Child($a, 0));
1509 150 100       187 if ($key eq 'Value') {
1510 39         23 push @{$option{$key}}, $value;
  39         58  
1511             } else {
1512 111         141 $option{$key} = $value;
1513             }
1514             }
1515 35         52 push @options, \%option;
1516             }
1517             }
1518             }
1519 1         36 return @options;
1520             }
1521              
1522             sub CreationDataTypes {
1523 1     1   2 my $self = shift;
1524 1         16 my $h = $self->GetMetadata;
1525 1 50       13 return split /\s+/, $h->{DMD_CREATIONDATATYPES} if $h->{DMD_CREATIONDATATYPES};
1526             }
1527              
1528             sub stdout_redirection_wrapper {
1529 52     52   94 my ($self, $name, $sub, @params) = @_;
1530 52         49 my $object = 0;
1531 52 100 100     595 if ($name && blessed $name) {
1532 1         2 $object = $name;
1533 1         5 my $ref = $object->can('write');
1534 1         7 Geo::GDAL::VSIStdoutSetRedirection($ref);
1535 1         1 $name = '/vsistdout/';
1536             }
1537 52         54 my $ds;
1538 52         63 eval {
1539 52         18926 $ds = $sub->($self, $name, @params);
1540             };
1541 52 100       1552 if ($object) {
1542 1 50       6 if ($ds) {
1543 1         3 $Geo::GDAL::stdout_redirection{tied(%$ds)} = $object;
1544             } else {
1545 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
1546 0         0 $object->close;
1547             }
1548             }
1549 52 100       122 confess(Geo::GDAL->last_error) if $@;
1550 51 50       100 confess("Failed. Use Geo::OGR::Driver for vector drivers.") unless $ds;
1551 51         353 return $ds;
1552             }
1553              
1554             sub Create {
1555 50     50   3844 my $self = shift;
1556 50         180 my $p = Geo::GDAL::named_parameters(\@_, Name => 'unnamed', Width => 256, Height => 256, Bands => 1, Type => 'Byte', Options => {});
1557 50         129 my $type = Geo::GDAL::string2int($p->{type}, \%Geo::GDAL::TYPE_STRING2INT);
1558             return $self->stdout_redirection_wrapper(
1559             $p->{name},
1560             $self->can('_Create'),
1561             $p->{width}, $p->{height}, $p->{bands}, $type, $p->{options}
1562 50         396 );
1563             }
1564             *CreateDataset = *Create;
1565              
1566             sub Copy {
1567 2     2   4 my $self = shift;
1568 2         8 my $p = Geo::GDAL::named_parameters(\@_, Name => 'unnamed', Src => undef, Strict => 1, Options => {}, Progress => undef, ProgressData => undef);
1569             return $self->stdout_redirection_wrapper(
1570             $p->{name},
1571             $self->can('_CreateCopy'),
1572 2         13 $p->{src}, $p->{strict}, $p->{options}, $p->{progress}, $p->{progressdata});
1573             }
1574             *CreateCopy = *Copy;
1575              
1576             sub Open {
1577 0     0   0 my $self = shift;
1578 0         0 my @p = @_; # name, update
1579 0         0 my @flags = qw/RASTER/;
1580 0 0       0 push @flags, qw/READONLY/ if $p[1] eq 'ReadOnly';
1581 0 0       0 push @flags, qw/UPDATE/ if $p[1] eq 'Update';
1582 0         0 my $dataset = Geo::GDAL::OpenEx($p[0], \@flags, [$self->Name()]);
1583 0 0       0 Geo::GDAL::error("Failed to open $p[0]. Is it a raster dataset?") unless $dataset;
1584 0         0 return $dataset;
1585             }
1586              
1587              
1588              
1589              
1590             package Geo::GDAL::Dataset;
1591 18     18   86 use strict;
  18         20  
  18         337  
1592 18     18   55 use warnings;
  18         21  
  18         453  
1593 18     18   9546 use POSIX qw/floor ceil/;
  18         90300  
  18         85  
1594 18     18   15264 use Scalar::Util 'blessed';
  18         23  
  18         651  
1595 18     18   65 use Carp;
  18         33  
  18         722  
1596 18     18   60 use Exporter 'import';
  18         17  
  18         500  
1597              
1598 18     18   114 use vars qw/@EXPORT @DOMAINS @CAPABILITIES %CAPABILITIES %BANDS %LAYERS %RESULT_SET/;
  18         18  
  18         48516  
1599             @EXPORT = qw/BuildVRT/;
1600             @DOMAINS = qw/IMAGE_STRUCTURE SUBDATASETS GEOLOCATION/;
1601              
1602             sub RELEASE_PARENTS {
1603 122     122   117 my $self = shift;
1604 122         137 delete $BANDS{$self};
1605             }
1606              
1607             sub Dataset {
1608 1     1   5 my $self = shift;
1609 1         3 return $BANDS{tied(%$self)};
1610             }
1611              
1612             sub Domains {
1613 2     2   9 return @DOMAINS;
1614             }
1615              
1616             *Open = *Geo::GDAL::Open;
1617             *OpenShared = *Geo::GDAL::OpenShared;
1618              
1619             sub TestCapability {
1620 1     1   744 return _TestCapability(@_);
1621             }
1622              
1623             sub Size {
1624 8     8   29 my $self = shift;
1625 8         35 return ($self->{RasterXSize}, $self->{RasterYSize});
1626             }
1627              
1628             sub Bands {
1629 5     5   10 my $self = shift;
1630 5         7 my @bands;
1631 5         26 for my $i (1..$self->{RasterCount}) {
1632 12         19 push @bands, GetRasterBand($self, $i);
1633             }
1634 5         18 return @bands;
1635             }
1636              
1637             sub GetRasterBand {
1638 52     52   1235 my ($self, $index) = @_;
1639 52   100     111 $index //= 1;
1640 52         218 my $band = _GetRasterBand($self, $index);
1641 52 50       120 Geo::GDAL::error(2, $index, 'Band') unless $band;
1642 52         49 $BANDS{tied(%{$band})} = $self;
  52         117  
1643 52         100 return $band;
1644             }
1645             *Band = *GetRasterBand;
1646              
1647             sub AddBand {
1648 3     3   213 my ($self, $type, $options) = @_;
1649 3   50     8 $type //= 'Byte';
1650 3         8 $type = Geo::GDAL::string2int($type, \%Geo::GDAL::TYPE_STRING2INT);
1651 3         31 $self->_AddBand($type, $options);
1652 3 50       9 return unless defined wantarray;
1653 0         0 return $self->GetRasterBand($self->{RasterCount});
1654             }
1655              
1656             sub CreateMaskBand {
1657 0     0   0 return _CreateMaskBand(@_);
1658             }
1659              
1660             sub ExecuteSQL {
1661             my $self = shift;
1662             my $layer = $self->_ExecuteSQL(@_);
1663             $LAYERS{tied(%$layer)} = $self;
1664             $RESULT_SET{tied(%$layer)} = 1;
1665             return $layer;
1666             }
1667              
1668       0     sub ReleaseResultSet {
1669             # a no-op, _ReleaseResultSet is called from Layer::DESTROY
1670             }
1671              
1672             sub GetLayer {
1673 0     0   0 my($self, $name) = @_;
1674 0 0       0 my $layer = defined $name ? GetLayerByName($self, "$name") : GetLayerByIndex($self, 0);
1675 0   0     0 $name //= '';
1676 0 0       0 Geo::GDAL::error(2, $name, 'Layer') unless $layer;
1677 0         0 $LAYERS{tied(%$layer)} = $self;
1678 0         0 return $layer;
1679             }
1680             *Layer = *GetLayer;
1681              
1682             sub GetLayerNames {
1683 2     2   7 my $self = shift;
1684 2         3 my @names;
1685 2         12 for my $i (0..$self->GetLayerCount-1) {
1686 5         17 my $layer = GetLayerByIndex($self, $i);
1687 5         19 push @names, $layer->GetName;
1688             }
1689 2         7 return @names;
1690             }
1691             *Layers = *GetLayerNames;
1692              
1693             sub CreateLayer {
1694 16     16   3472 my $self = shift;
1695 16         53 my $p = Geo::GDAL::named_parameters(\@_,
1696             Name => 'unnamed',
1697             SRS => undef,
1698             GeometryType => 'Unknown',
1699             Options => {},
1700             Schema => undef,
1701             Fields => undef,
1702             ApproxOK => 1);
1703 16 50 66     68 Geo::GDAL::error("The 'Fields' argument must be an array reference.") if $p->{fields} && ref($p->{fields}) ne 'ARRAY';
1704 16 50       30 if (defined $p->{schema}) {
1705 0         0 my $s = $p->{schema};
1706 0 0       0 $p->{geometrytype} = $s->{GeometryType} if exists $s->{GeometryType};
1707 0 0       0 $p->{fields} = $s->{Fields} if exists $s->{Fields};
1708 0 0       0 $p->{name} = $s->{Name} if exists $s->{Name};
1709             }
1710 16 100       40 $p->{fields} = [] unless ref($p->{fields}) eq 'ARRAY';
1711             # if fields contains spatial fields, then do not create default one
1712 16         15 for my $f (@{$p->{fields}}) {
  16         30  
1713 13 100 66     59 if ($f->{GeometryType} or exists $Geo::OGR::Geometry::TYPE_STRING2INT{$f->{Type}}) {
1714 3         7 $p->{geometrytype} = 'None';
1715 3         5 last;
1716             }
1717             }
1718 16         33 my $gt = Geo::GDAL::string2int($p->{geometrytype}, \%Geo::OGR::Geometry::TYPE_STRING2INT);
1719 16         360 my $layer = _CreateLayer($self, $p->{name}, $p->{srs}, $gt, $p->{options});
1720 16         76 $LAYERS{tied(%$layer)} = $self;
1721 16         16 for my $f (@{$p->{fields}}) {
  16         30  
1722 13         34 $layer->CreateField($f);
1723             }
1724 16         64 return $layer;
1725             }
1726              
1727             sub DeleteLayer {
1728 1     1   5 my ($self, $name) = @_;
1729 1         2 my $index;
1730 1         6 for my $i (0..$self->GetLayerCount-1) {
1731 2         7 my $layer = GetLayerByIndex($self, $i);
1732 2 100       13 $index = $i, last if $layer->GetName eq $name;
1733             }
1734 1 50       4 Geo::GDAL::error(2, $name, 'Layer') unless defined $index;
1735 1         13 _DeleteLayer($self, $index);
1736             }
1737              
1738             sub Projection {
1739 0     0   0 my($self, $proj) = @_;
1740 0 0       0 SetProjection($self, $proj) if defined $proj;
1741 0 0       0 GetProjection($self) if defined wantarray;
1742             }
1743              
1744             sub SpatialReference {
1745 0     0   0 my($self, $sr) = @_;
1746 0 0       0 SetProjection($self, $sr->As('WKT')) if defined $sr;
1747 0 0       0 if (defined wantarray) {
1748 0         0 my $p = GetProjection($self);
1749 0 0       0 return unless $p;
1750 0         0 return Geo::OSR::SpatialReference->new(WKT => $p);
1751             }
1752             }
1753              
1754             sub GeoTransform {
1755 7     7   27 my $self = shift;
1756 7         13 eval {
1757 7 100       22 if (@_ == 1) {
    100          
1758 4         33 SetGeoTransform($self, $_[0]);
1759             } elsif (@_ > 1) {
1760 1         9 SetGeoTransform($self, \@_);
1761             }
1762             };
1763 7 50       18 confess(Geo::GDAL->last_error) if $@;
1764 7 100       13 return unless defined wantarray;
1765 4         22 my $t = GetGeoTransform($self);
1766 4 50       14 if (wantarray) {
1767 0         0 return @$t;
1768             } else {
1769 4         19 return Geo::GDAL::GeoTransform->new($t);
1770             }
1771             }
1772              
1773             sub Extent {
1774 0     0   0 my $self = shift;
1775 0         0 return $self->GeoTransform->Extent($self->Size);
1776             }
1777              
1778             sub Tile { # $xoff, $yoff, $xsize, $ysize, assuming strict north up
1779 0     0   0 my ($self, $e) = @_;
1780 0         0 my ($w, $h) = $self->Size;
1781             #print "sz $w $h\n";
1782 0         0 my $gt = $self->GeoTransform;
1783             #print "gt @$gt\n";
1784 0 0       0 confess "GeoTransform is not \"north up\"." unless $gt->NorthUp;
1785 0         0 my $x = $gt->Extent($w, $h);
1786 0         0 my $xoff = floor(($e->[0] - $gt->[0])/$gt->[1]);
1787 0 0       0 $xoff = 0 if $xoff < 0;
1788 0         0 my $yoff = floor(($gt->[3] - $e->[3])/(-$gt->[5]));
1789 0 0       0 $yoff = 0 if $yoff < 0;
1790 0         0 my $xsize = ceil(($e->[2] - $gt->[0])/$gt->[1]) - $xoff;
1791 0 0       0 $xsize = $w - $xoff if $xsize > $w - $xoff;
1792 0         0 my $ysize = ceil(($gt->[3] - $e->[1])/(-$gt->[5])) - $yoff;
1793 0 0       0 $ysize = $h - $yoff if $ysize > $h - $yoff;
1794 0         0 return ($xoff, $yoff, $xsize, $ysize);
1795             }
1796              
1797             sub GCPs {
1798 0     0   0 my $self = shift;
1799 0 0       0 if (@_ > 0) {
1800 0         0 my $proj = pop @_;
1801 0 0 0     0 $proj = $proj->Export('WKT') if $proj and ref($proj);
1802 0         0 SetGCPs($self, \@_, $proj);
1803             }
1804 0 0       0 return unless defined wantarray;
1805 0         0 my $proj = Geo::OSR::SpatialReference->new(GetGCPProjection($self));
1806 0         0 my $GCPs = GetGCPs($self);
1807 0         0 return (@$GCPs, $proj);
1808             }
1809              
1810             sub ReadTile {
1811 0     0   0 my ($self, $xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $alg) = @_;
1812 0         0 my @data;
1813 0         0 for my $i (0..$self->Bands-1) {
1814 0         0 $data[$i] = $self->Band($i+1)->ReadTile($xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $alg);
1815             }
1816 0         0 return \@data;
1817             }
1818              
1819             sub WriteTile {
1820 0     0   0 my ($self, $data, $xoff, $yoff) = @_;
1821 0   0     0 $xoff //= 0;
1822 0   0     0 $yoff //= 0;
1823 0         0 for my $i (0..$self->Bands-1) {
1824 0         0 $self->Band($i+1)->WriteTile($data->[$i], $xoff, $yoff);
1825             }
1826             }
1827              
1828             sub ReadRaster {
1829 1     1   5 my $self = shift;
1830 1         4 my ($width, $height) = $self->Size;
1831 1         3 my ($type) = $self->Band->DataType;
1832 1         2 my $p = Geo::GDAL::named_parameters(\@_,
1833             XOff => 0,
1834             YOff => 0,
1835             XSize => $width,
1836             YSize => $height,
1837             BufXSize => undef,
1838             BufYSize => undef,
1839             BufType => $type,
1840             BandList => [1],
1841             BufPixelSpace => 0,
1842             BufLineSpace => 0,
1843             BufBandSpace => 0,
1844             ResampleAlg => 'NearestNeighbour',
1845             Progress => undef,
1846             ProgressData => undef
1847             );
1848 1         3 $p->{resamplealg} = Geo::GDAL::string2int($p->{resamplealg}, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
1849 1         4 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
1850 1         32 $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});
1851             }
1852              
1853             sub WriteRaster {
1854 2     2   419 my $self = shift;
1855 2         4 my ($width, $height) = $self->Size;
1856 2         6 my ($type) = $self->Band->DataType;
1857 2         5 my $p = Geo::GDAL::named_parameters(\@_,
1858             XOff => 0,
1859             YOff => 0,
1860             XSize => $width,
1861             YSize => $height,
1862             Buf => undef,
1863             BufXSize => undef,
1864             BufYSize => undef,
1865             BufType => $type,
1866             BandList => [1],
1867             BufPixelSpace => 0,
1868             BufLineSpace => 0,
1869             BufBandSpace => 0
1870             );
1871 2         5 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
1872 2         26 $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});
1873             }
1874              
1875             sub BuildOverviews {
1876 1     1   7 my $self = shift;
1877 1         2 my @p = @_;
1878 1 50       3 $p[0] = uc($p[0]) if $p[0];
1879 1         2 eval {
1880 1         1048 $self->_BuildOverviews(@p);
1881             };
1882 1 50       7 confess(Geo::GDAL->last_error) if $@;
1883             }
1884              
1885             sub stdout_redirection_wrapper {
1886 2     2   5 my ($self, $name, $sub, @params) = @_;
1887 2         2 my $object = 0;
1888 2 50 33     10 if ($name && blessed $name) {
1889 0         0 $object = $name;
1890 0         0 my $ref = $object->can('write');
1891 0         0 Geo::GDAL::VSIStdoutSetRedirection($ref);
1892 0         0 $name = '/vsistdout/';
1893             }
1894 2         2 my $ds;
1895 2         3 eval {
1896 2         1019 $ds = $sub->($name, $self, @params); # self and name opposite to what is in Geo::GDAL::Driver!
1897             };
1898 2 50       8 if ($object) {
1899 0 0       0 if ($ds) {
1900 0         0 $Geo::GDAL::stdout_redirection{tied(%$ds)} = $object;
1901             } else {
1902 0         0 Geo::GDAL::VSIStdoutUnsetRedirection();
1903 0         0 $object->close;
1904             }
1905             }
1906 2 50       3 confess(Geo::GDAL->last_error) if $@;
1907 2         12 return $ds;
1908             }
1909              
1910             sub DEMProcessing {
1911 0     0   0 my ($self, $dest, $Processing, $ColorFilename, $options, $progress, $progress_data) = @_;
1912 0         0 $options = Geo::GDAL::GDALDEMProcessingOptions->new(Geo::GDAL::make_processing_options($options));
1913 0         0 return $self->stdout_redirection_wrapper(
1914             $dest,
1915             \&Geo::GDAL::wrapper_GDALDEMProcessing,
1916             $Processing, $ColorFilename, $options, $progress, $progress_data
1917             );
1918             }
1919              
1920             sub Nearblack {
1921 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
1922 0         0 $options = Geo::GDAL::GDALNearblackOptions->new(Geo::GDAL::make_processing_options($options));
1923 0         0 my $b = blessed($dest);
1924 0 0 0     0 if ($b && $b eq 'Geo::GDAL::Dataset') {
1925 0         0 Geo::GDAL::wrapper_GDALNearblackDestDS($dest, $self, $options, $progress, $progress_data);
1926             } else {
1927 0         0 return $self->stdout_redirection_wrapper(
1928             $dest,
1929             \&Geo::GDAL::wrapper_GDALNearblackDestName,
1930             $options, $progress, $progress_data
1931             );
1932             }
1933             }
1934              
1935             sub Translate {
1936 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
1937             return $self->stdout_redirection_wrapper(
1938             $dest,
1939             sub {
1940 0     0   0 my ($dest, $self) = @_;
1941 0         0 my $ds;
1942 0 0       0 if ($self->_GetRasterBand(1)) {
1943 0         0 $options = Geo::GDAL::GDALTranslateOptions->new(Geo::GDAL::make_processing_options($options));
1944 0         0 $ds = Geo::GDAL::wrapper_GDALTranslate($dest, $self, $options, $progress, $progress_data);
1945             } else {
1946 0         0 $options = Geo::GDAL::GDALVectorTranslateOptions->new(Geo::GDAL::make_processing_options($options));
1947 0         0 Geo::GDAL::wrapper_GDALVectorTranslateDestDS($dest, $self, $options, $progress, $progress_data);
1948 0         0 $ds = Geo::GDAL::wrapper_GDALVectorTranslateDestName($dest, $self, $options, $progress, $progress_data);
1949             }
1950 0         0 return $ds;
1951             }
1952 0         0 );
1953             }
1954              
1955             sub Warped {
1956 1     1   6 my $self = shift;
1957 1         4 my $p = Geo::GDAL::named_parameters(\@_, SrcSRS => undef, DstSRS => undef, ResampleAlg => 'NearestNeighbour', MaxError => 0);
1958 1         2 for my $srs (qw/srcsrs dstsrs/) {
1959 2 50 33     6 $p->{$srs} = $p->{$srs}->ExportToWkt if $p->{$srs} && blessed $p->{$srs};
1960             }
1961 1         4 $p->{resamplealg} = Geo::GDAL::string2int($p->{resamplealg}, \%Geo::GDAL::RESAMPLING_STRING2INT);
1962 1         176 my $warped = Geo::GDAL::_AutoCreateWarpedVRT($self, $p->{srcsrs}, $p->{dstsrs}, $p->{resamplealg}, $p->{maxerror});
1963 1 50       4 $BANDS{tied(%{$warped})} = $self if $warped; # self must live as long as warped
  1         3  
1964 1         4 return $warped;
1965             }
1966              
1967             sub Warp {
1968 2     2   21 my ($self, $dest, $options, $progress, $progress_data) = @_;
1969 2         6 $options = Geo::GDAL::GDALWarpAppOptions->new(Geo::GDAL::make_processing_options($options));
1970 2         5 my $b = blessed($dest);
1971 2 100       7 $self = [$self] unless ref $self eq 'ARRAY';
1972 2 50 33     7 if ($b && $b eq 'Geo::GDAL::Dataset') {
1973 0         0 Geo::GDAL::wrapper_GDALWarpDestDS($dest, $self, $options, $progress, $progress_data);
1974             } else {
1975 2         7 return stdout_redirection_wrapper(
1976             $self,
1977             $dest,
1978             \&Geo::GDAL::wrapper_GDALWarpDestName,
1979             $options, $progress, $progress_data
1980             );
1981             }
1982             }
1983              
1984             sub Info {
1985 0     0   0 my ($self, $o) = @_;
1986 0         0 $o = Geo::GDAL::GDALInfoOptions->new(Geo::GDAL::make_processing_options($o));
1987 0         0 return Geo::GDAL::GDALInfo($self, $o);
1988             }
1989              
1990             sub Grid {
1991 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
1992 0         0 $options = Geo::GDAL::GDALGridOptions->new(Geo::GDAL::make_processing_options($options));
1993 0         0 return $self->stdout_redirection_wrapper(
1994             $dest,
1995             \&Geo::GDAL::wrapper_GDALGrid,
1996             $options, $progress, $progress_data
1997             );
1998             }
1999              
2000             sub Rasterize {
2001 0     0   0 my ($self, $dest, $options, $progress, $progress_data) = @_;
2002 0         0 $options = Geo::GDAL::GDALRasterizeOptions->new(Geo::GDAL::make_processing_options($options));
2003 0         0 my $b = blessed($dest);
2004 0 0 0     0 if ($b && $b eq 'Geo::GDAL::Dataset') {
2005 0         0 Geo::GDAL::wrapper_GDALRasterizeDestDS($dest, $self, $options, $progress, $progress_data);
2006             } else {
2007 0         0 return $self->stdout_redirection_wrapper(
2008             $dest,
2009             \&Geo::GDAL::wrapper_GDALRasterizeDestName,
2010             $options, $progress, $progress_data
2011             );
2012             }
2013             }
2014              
2015             sub BuildVRT {
2016 0     0   0 my ($dest, $sources, $options, $progress, $progress_data) = @_;
2017 0         0 $options = Geo::GDAL::GDALBuildVRTOptions->new(Geo::GDAL::make_processing_options($options));
2018 0 0 0     0 Geo::GDAL::error("Usage: Geo::GDAL::DataSet::BuildVRT(\$vrt_file_name, \\\@sources)")
2019             unless ref $sources eq 'ARRAY' && defined $sources->[0];
2020 0 0       0 unless (blessed($dest)) {
2021 0 0       0 if (blessed($sources->[0])) {
2022 0         0 return Geo::GDAL::wrapper_GDALBuildVRT_objects($dest, $sources, $options, $progress, $progress_data);
2023             } else {
2024 0         0 return Geo::GDAL::wrapper_GDALBuildVRT_names($dest, $sources, $options, $progress, $progress_data);
2025             }
2026             } else {
2027 0 0       0 if (blessed($sources->[0])) {
2028 0         0 return stdout_redirection_wrapper(
2029             $sources, $dest,
2030             \&Geo::GDAL::wrapper_GDALBuildVRT_objects,
2031             $options, $progress, $progress_data);
2032             } else {
2033 0         0 return stdout_redirection_wrapper(
2034             $sources, $dest,
2035             \&Geo::GDAL::wrapper_GDALBuildVRT_names,
2036             $options, $progress, $progress_data);
2037             }
2038             }
2039             }
2040              
2041             sub ComputeColorTable {
2042 1     1   2 my $self = shift;
2043 1         5 my $p = Geo::GDAL::named_parameters(\@_,
2044             Red => undef,
2045             Green => undef,
2046             Blue => undef,
2047             NumColors => 256,
2048             Progress => undef,
2049             ProgressData => undef,
2050             Method => 'MedianCut');
2051 1         3 for my $b ($self->Bands) {
2052 3         6 for my $cion ($b->ColorInterpretation) {
2053 3 100 33     6 if ($cion eq 'RedBand') { $p->{red} //= $b; last; }
  1         3  
  1         4  
2054 2 100 33     4 if ($cion eq 'GreenBand') { $p->{green} //= $b; last; }
  1         3  
  1         2  
2055 1 50 33     3 if ($cion eq 'BlueBand') { $p->{blue} //= $b; last; }
  1         3  
  1         2  
2056             }
2057             }
2058 1         2 my $ct = Geo::GDAL::ColorTable->new;
2059             Geo::GDAL::ComputeMedianCutPCT($p->{red},
2060             $p->{green},
2061             $p->{blue},
2062             $p->{numcolors},
2063             $ct, $p->{progress},
2064 1         740 $p->{progressdata});
2065 1         9 return $ct;
2066             }
2067              
2068             sub Dither {
2069 1     1   2 my $self = shift;
2070 1         5 my $p = Geo::GDAL::named_parameters(\@_,
2071             Red => undef,
2072             Green => undef,
2073             Blue => undef,
2074             Dest => undef,
2075             ColorTable => undef,
2076             Progress => undef,
2077             ProgressData => undef);
2078 1         7 for my $b ($self->Bands) {
2079 3         6 for my $cion ($b->ColorInterpretation) {
2080 3 100 33     5 if ($cion eq 'RedBand') { $p->{red} //= $b; last; }
  1         7  
  1         3  
2081 2 100 33     6 if ($cion eq 'GreenBand') { $p->{green} //= $b; last; }
  1         5  
  1         2  
2082 1 50 33     3 if ($cion eq 'BlueBand') { $p->{blue} //= $b; last; }
  1         7  
  1         1  
2083             }
2084             }
2085 1         4 my ($w, $h) = $self->Size;
2086 1   33     11 $p->{dest} //= Geo::GDAL::Driver('MEM')->Create(Name => 'dithered',
2087             Width => $w,
2088             Height => $h,
2089             Type => 'Byte')->Band;
2090             $p->{colortable}
2091             //= $p->{dest}->ColorTable
2092             // $self->ComputeColorTable(Red => $p->{red},
2093             Green => $p->{green},
2094             Blue => $p->{blue},
2095             Progress => $p->{progress},
2096 1   33     11 ProgressData => $p->{progressdata});
      33        
2097             Geo::GDAL::DitherRGB2PCT($p->{red},
2098             $p->{green},
2099             $p->{blue},
2100             $p->{dest},
2101             $p->{colortable},
2102             $p->{progress},
2103 1         10531 $p->{progressdata});
2104 1         20 $p->{dest}->ColorTable($p->{colortable});
2105 1         13 return $p->{dest};
2106             }
2107              
2108              
2109              
2110              
2111             package Geo::GDAL::Band;
2112 18     18   96 use strict;
  18         31  
  18         403  
2113 18     18   64 use warnings;
  18         20  
  18         478  
2114 18     18   64 use POSIX;
  18         18  
  18         63  
2115 18     18   24763 use Carp;
  18         24  
  18         853  
2116 18     18   66 use Scalar::Util 'blessed';
  18         22  
  18         670  
2117              
2118 18         46180 use vars qw/ %RATS
2119             @COLOR_INTERPRETATIONS
2120             %COLOR_INTERPRETATION_STRING2INT %COLOR_INTERPRETATION_INT2STRING @DOMAINS
2121             %MASK_FLAGS
2122 18     18   59 /;
  18         17  
2123             for (keys %Geo::GDAL::Const::) {
2124             next if /TypeCount/;
2125             push(@COLOR_INTERPRETATIONS, $1), next if /^GCI_(\w+)/;
2126             }
2127             for my $string (@COLOR_INTERPRETATIONS) {
2128             my $int = eval "\$Geo::GDAL::Constc::GCI_$string";
2129             $COLOR_INTERPRETATION_STRING2INT{$string} = $int;
2130             $COLOR_INTERPRETATION_INT2STRING{$int} = $string;
2131             }
2132             @DOMAINS = qw/IMAGE_STRUCTURE RESAMPLING/;
2133             %MASK_FLAGS = (AllValid => 1, PerDataset => 2, Alpha => 4, NoData => 8);
2134              
2135             sub Domains {
2136 1     1   3 return @DOMAINS;
2137             }
2138              
2139             sub ColorInterpretations {
2140 1     1   7 return @COLOR_INTERPRETATIONS;
2141             }
2142              
2143             sub MaskFlags {
2144 1     1   8 my @f = sort {$MASK_FLAGS{$a} <=> $MASK_FLAGS{$b}} keys %MASK_FLAGS;
  5         7  
2145 1         4 return @f;
2146             }
2147              
2148             sub DESTROY {
2149 108     108   4382 my $self = shift;
2150 108 100       316 unless ($self->isa('SCALAR')) {
2151 54 50       107 return unless $self->isa('HASH');
2152 54         40 $self = tied(%{$self});
  54         82  
2153 54 50       92 return unless defined $self;
2154             }
2155 108         128 delete $ITERATORS{$self};
2156 108 50       159 if (exists $OWNER{$self}) {
2157 0         0 delete $OWNER{$self};
2158             }
2159 108         126 $self->RELEASE_PARENTS();
2160             }
2161              
2162             sub RELEASE_PARENTS {
2163 108     108   78 my $self = shift;
2164 108         1419 delete $Geo::GDAL::Dataset::BANDS{$self};
2165             }
2166              
2167             sub Dataset {
2168 2     2   6 my $self = shift;
2169 2         2 return $Geo::GDAL::Dataset::BANDS{tied(%{$self})};
  2         6  
2170             }
2171              
2172             sub Size {
2173 664     664   841 my $self = shift;
2174 664         1400 return ($self->{XSize}, $self->{YSize});
2175             }
2176              
2177             sub DataType {
2178 668     668   470 my $self = shift;
2179 668         1001 return $Geo::GDAL::TYPE_INT2STRING{$self->{DataType}};
2180             }
2181              
2182             sub PackCharacter {
2183 1     1   6 my $self = shift;
2184 1         3 return Geo::GDAL::PackCharacter($self->DataType);
2185             }
2186              
2187             sub NoDataValue {
2188 8     8   855 my $self = shift;
2189 8 100       25 if (@_ > 0) {
2190 2 50       6 if (defined $_[0]) {
2191 2         11 SetNoDataValue($self, $_[0]);
2192             } else {
2193 0         0 SetNoDataValue($self, POSIX::FLT_MAX); # hopefully an "out of range" value
2194             }
2195             }
2196 8         36 GetNoDataValue($self);
2197             }
2198              
2199             sub Unit {
2200 2     2   380 my $self = shift;
2201 2 100       6 if (@_ > 0) {
2202 1         1 my $unit = shift;
2203 1   50     3 $unit //= '';
2204 1         10 SetUnitType($self, $unit);
2205             }
2206 2 100       4 return unless defined wantarray;
2207 1         5 GetUnitType($self);
2208             }
2209              
2210             sub ScaleAndOffset {
2211 2     2   3 my $self = shift;
2212 2 100 66     14 SetScale($self, $_[0]) if @_ > 0 and defined $_[0];
2213 2 100 66     11 SetOffset($self, $_[1]) if @_ > 1 and defined $_[1];
2214 2 100       3 return unless defined wantarray;
2215 1         4 my $scale = GetScale($self);
2216 1         3 my $offset = GetOffset($self);
2217 1         3 return ($scale, $offset);
2218             }
2219              
2220             sub ReadTile {
2221 19     19   626 my($self, $xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $alg) = @_;
2222 19   100     66 $xoff //= 0;
2223 19   100     46 $yoff //= 0;
2224 19   66     94 $xsize //= $self->{XSize} - $xoff;
2225 19   66     78 $ysize //= $self->{YSize} - $yoff;
2226 19   33     67 $w_tile //= $xsize;
2227 19   33     57 $h_tile //= $ysize;
2228 19   50     56 $alg //= 'NearestNeighbour';
2229 19         42 my $t = $self->{DataType};
2230 19         50 $alg = Geo::GDAL::string2int($alg, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
2231 19         1168 my $buf = $self->_ReadRaster($xoff, $yoff, $xsize, $ysize, $w_tile, $h_tile, $t, 0, 0, $alg);
2232 19         44 my $pc = Geo::GDAL::PackCharacter($t);
2233 19         39 my $w = $w_tile * Geo::GDAL::GetDataTypeSize($t)/8;
2234 19         29 my $offset = 0;
2235 19         17 my @data;
2236 19         46 for my $y (0..$h_tile-1) {
2237 509         5222 my @d = unpack($pc."[$w_tile]", substr($buf, $offset, $w));
2238 509         1454 push @data, \@d;
2239 509         455 $offset += $w;
2240             }
2241 19         45 return \@data;
2242             }
2243              
2244             sub WriteTile {
2245 15     15   173054 my($self, $data, $xoff, $yoff) = @_;
2246 15   100     52 $xoff //= 0;
2247 15   100     48 $yoff //= 0;
2248 15         13 my $xsize = @{$data->[0]};
  15         26  
2249 15 50       58 if ($xsize > $self->{XSize} - $xoff) {
2250 0         0 warn "Buffer XSize too large ($xsize) for this raster band (width = $self->{XSize}, offset = $xoff).";
2251 0         0 $xsize = $self->{XSize} - $xoff;
2252             }
2253 15         22 my $ysize = @{$data};
  15         16  
2254 15 50       40 if ($ysize > $self->{YSize} - $yoff) {
2255 0         0 $ysize = $self->{YSize} - $yoff;
2256 0         0 warn "Buffer YSize too large ($ysize) for this raster band (height = $self->{YSize}, offset = $yoff).";
2257             }
2258 15         45 my $pc = Geo::GDAL::PackCharacter($self->{DataType});
2259 15         40 for my $i (0..$ysize-1) {
2260 459         562 my $scanline = pack($pc."[$xsize]", @{$data->[$i]});
  459         1805  
2261 459         784 $self->WriteRaster( $xoff, $yoff+$i, $xsize, 1, $scanline );
2262             }
2263             }
2264              
2265             sub ColorInterpretation {
2266 26     26   1733 my($self, $ci) = @_;
2267 26 100       48 if (defined $ci) {
2268 11         25 $ci = Geo::GDAL::string2int($ci, \%COLOR_INTERPRETATION_STRING2INT);
2269 11         46 SetRasterColorInterpretation($self, $ci);
2270             }
2271 26 100       44 return unless defined wantarray;
2272 15         74 $COLOR_INTERPRETATION_INT2STRING{GetRasterColorInterpretation($self)};
2273             }
2274              
2275             sub ColorTable {
2276 18     18   39 my $self = shift;
2277 18 100 66     95 SetRasterColorTable($self, $_[0]) if @_ and defined $_[0];
2278 18 100       35 return unless defined wantarray;
2279 10         46 GetRasterColorTable($self);
2280             }
2281              
2282             sub CategoryNames {
2283 0     0   0 my $self = shift;
2284 0 0       0 SetRasterCategoryNames($self, \@_) if @_;
2285 0 0       0 return unless defined wantarray;
2286 0         0 my $n = GetRasterCategoryNames($self);
2287 0         0 return @$n;
2288             }
2289              
2290             sub AttributeTable {
2291 3     3   7 my $self = shift;
2292 3 100 66     43 SetDefaultRAT($self, $_[0]) if @_ and defined $_[0];
2293 3 100       8 return unless defined wantarray;
2294 2         10 my $r = GetDefaultRAT($self);
2295 2 50       10 $RATS{tied(%$r)} = $self if $r;
2296 2         4 return $r;
2297             }
2298             *RasterAttributeTable = *AttributeTable;
2299              
2300             sub GetHistogram {
2301 3     3   639 my $self = shift;
2302 3         12 my $p = Geo::GDAL::named_parameters(\@_,
2303             Min => -0.5,
2304             Max => 255.5,
2305             Buckets => 256,
2306             IncludeOutOfRange => 0,
2307             ApproxOK => 0,
2308             Progress => undef,
2309             ProgressData => undef);
2310 3 50 33     14 $p->{progressdata} = 1 if $p->{progress} and not defined $p->{progressdata};
2311             _GetHistogram($self, $p->{min}, $p->{max}, $p->{buckets},
2312             $p->{includeoutofrange}, $p->{approxok},
2313 3         1121 $p->{progress}, $p->{progressdata});
2314             }
2315              
2316             sub Contours {
2317 0     0   0 my $self = shift;
2318 0         0 my $p = Geo::GDAL::named_parameters(\@_,
2319             DataSource => undef,
2320             LayerConstructor => {Name => 'contours'},
2321             ContourInterval => 100,
2322             ContourBase => 0,
2323             FixedLevels => [],
2324             NoDataValue => undef,
2325             IDField => -1,
2326             ElevField => -1,
2327             Progress => undef,
2328             ProgressData => undef);
2329 0   0     0 $p->{datasource} //= Geo::OGR::GetDriver('Memory')->CreateDataSource('ds');
2330 0   0     0 $p->{layerconstructor}->{Schema} //= {};
2331 0   0     0 $p->{layerconstructor}->{Schema}{Fields} //= [];
2332 0         0 my %fields;
2333 0 0 0     0 unless ($p->{idfield} =~ /^[+-]?\d+$/ or $fields{$p->{idfield}}) {
2334 0         0 push @{$p->{layerconstructor}->{Schema}{Fields}}, {Name => $p->{idfield}, Type => 'Integer'};
  0         0  
2335             }
2336 0 0 0     0 unless ($p->{elevfield} =~ /^[+-]?\d+$/ or $fields{$p->{elevfield}}) {
2337 0 0       0 my $type = $self->DataType() =~ /Float/ ? 'Real' : 'Integer';
2338 0         0 push @{$p->{layerconstructor}->{Schema}{Fields}}, {Name => $p->{elevfield}, Type => $type};
  0         0  
2339             }
2340 0         0 my $layer = $p->{datasource}->CreateLayer($p->{layerconstructor});
2341 0         0 my $schema = $layer->GetLayerDefn;
2342 0         0 for ('idfield', 'elevfield') {
2343 0 0       0 $p->{$_} = $schema->GetFieldIndex($p->{$_}) unless $p->{$_} =~ /^[+-]?\d+$/;
2344             }
2345 0 0 0     0 $p->{progressdata} = 1 if $p->{progress} and not defined $p->{progressdata};
2346             ContourGenerate($self, $p->{contourinterval}, $p->{contourbase}, $p->{fixedlevels},
2347             $p->{nodatavalue}, $layer, $p->{idfield}, $p->{elevfield},
2348 0         0 $p->{progress}, $p->{progressdata});
2349 0         0 return $layer;
2350             }
2351              
2352             sub FillNodata {
2353 2     2   193 my $self = shift;
2354 2         3 my $mask = shift;
2355 2 100       8 $mask = $self->GetMaskBand unless $mask;
2356 2         4 my @p = @_;
2357 2   50     10 $p[0] //= 10;
2358 2   50     7 $p[1] //= 0;
2359 2         8899 Geo::GDAL::FillNodata($self, $mask, @p);
2360             }
2361             *FillNoData = *FillNodata;
2362             *GetBandNumber = *GetBand;
2363              
2364             sub ReadRaster {
2365 1     1   1721 my $self = shift;
2366 1         3 my ($width, $height) = $self->Size;
2367 1         3 my ($type) = $self->DataType;
2368 1         7 my $p = Geo::GDAL::named_parameters(\@_,
2369             XOff => 0,
2370             YOff => 0,
2371             XSize => $width,
2372             YSize => $height,
2373             BufXSize => undef,
2374             BufYSize => undef,
2375             BufType => $type,
2376             BufPixelSpace => 0,
2377             BufLineSpace => 0,
2378             ResampleAlg => 'NearestNeighbour',
2379             Progress => undef,
2380             ProgressData => undef
2381             );
2382 1         7 $p->{resamplealg} = Geo::GDAL::string2int($p->{resamplealg}, \%Geo::GDAL::RIO_RESAMPLING_STRING2INT);
2383 1         3 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
2384 1         663 $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});
2385             }
2386              
2387             sub WriteRaster {
2388 660     660   8191 my $self = shift;
2389 660         751 my ($width, $height) = $self->Size;
2390 660         1069 my ($type) = $self->DataType;
2391 660         1324 my $p = Geo::GDAL::named_parameters(\@_,
2392             XOff => 0,
2393             YOff => 0,
2394             XSize => $width,
2395             YSize => $height,
2396             Buf => undef,
2397             BufXSize => undef,
2398             BufYSize => undef,
2399             BufType => $type,
2400             BufPixelSpace => 0,
2401             BufLineSpace => 0
2402             );
2403 660 50       959 confess "Usage: \$band->WriteRaster( Buf => \$data, ... )" unless defined $p->{buf};
2404 660         982 $p->{buftype} = Geo::GDAL::string2int($p->{buftype}, \%Geo::GDAL::TYPE_STRING2INT, \%Geo::GDAL::TYPE_INT2STRING);
2405 660         4952 $self->_WriteRaster($p->{xoff},$p->{yoff},$p->{xsize},$p->{ysize},$p->{buf},$p->{bufxsize},$p->{bufysize},$p->{buftype},$p->{bufpixelspace},$p->{buflinespace});
2406             }
2407              
2408             sub GetMaskFlags {
2409 2     2   206 my $self = shift;
2410 2         33 my $f = $self->_GetMaskFlags;
2411 2         3 my @f;
2412 2         6 for my $flag (keys %MASK_FLAGS) {
2413 8 100       16 push @f, $flag if $f & $MASK_FLAGS{$flag};
2414             }
2415 2 50       8 return wantarray ? @f : $f;
2416             }
2417              
2418             sub CreateMaskBand {
2419 1     1   229 my $self = shift;
2420 1         2 my $f = 0;
2421 1 50 33     8 if (@_ and $_[0] =~ /^\d$/) {
2422 0         0 $f = shift;
2423             } else {
2424 1         5 for my $flag (@_) {
2425 1 50       3 carp "Unknown mask flag: '$flag'." unless $MASK_FLAGS{$flag};
2426 1         3 $f |= $MASK_FLAGS{$flag};
2427             }
2428             }
2429 1         264 $self->_CreateMaskBand($f);
2430             }
2431              
2432             sub Piddle {
2433 0     0   0 my $self = shift; # should use named parameters for read raster and band
2434             # add Piddle sub to dataset too to make N x M x n piddles
2435 0         0 my ($w, $h) = $self->Size;
2436 0         0 my $data = $self->ReadRaster;
2437 0         0 my $pdl = PDL->new;
2438 0         0 my %map = (
2439             Byte => 0,
2440             UInt16 => 2,
2441             Int16 => 1,
2442             UInt32 => -1,
2443             Int32 => 3,
2444             Float32 => 5,
2445             Float64 => 6,
2446             CInt16 => -1,
2447             CInt32 => -1,
2448             CFloat32 => -1,
2449             CFloat64 => -1
2450             );
2451 0         0 my $datatype = $map{$self->DataType};
2452 0 0       0 croak "there is no direct mapping between the band datatype and PDL" if $datatype < 0;
2453 0         0 $pdl->set_datatype($datatype);
2454 0         0 $pdl->setdims([1,$w,$h]);
2455 0         0 my $dref = $pdl->get_dataref();
2456 0         0 $$dref = $data;
2457 0         0 $pdl->upd_data;
2458 0         0 return $pdl;
2459             }
2460              
2461             sub GetMaskBand {
2462 1     1   1 my $self = shift;
2463 1         11 my $band = _GetMaskBand($self);
2464 1         1 $Geo::GDAL::Dataset::BANDS{tied(%{$band})} = $self;
  1         3  
2465 1         2 return $band;
2466             }
2467              
2468             sub GetOverview {
2469 1     1   222 my ($self, $index) = @_;
2470 1         6 my $band = _GetOverview($self, $index);
2471 1         1 $Geo::GDAL::Dataset::BANDS{tied(%{$band})} = $self;
  1         3  
2472 1         2 return $band;
2473             }
2474              
2475             sub RegenerateOverview {
2476 1     1   6 my $self = shift;
2477             #Geo::GDAL::Band overview, scalar resampling, subref callback, scalar callback_data
2478 1         2 my @p = @_;
2479 1         3 Geo::GDAL::RegenerateOverview($self, @p);
2480             }
2481              
2482             sub RegenerateOverviews {
2483 1     1   5 my $self = shift;
2484             #arrayref overviews, scalar resampling, subref callback, scalar callback_data
2485 1         2 my @p = @_;
2486 1         3 Geo::GDAL::RegenerateOverviews($self, @p);
2487             }
2488              
2489             sub Polygonize {
2490 1     1   6 my $self = shift;
2491 1         4 my $p = Geo::GDAL::named_parameters(\@_, Mask => undef, OutLayer => undef, PixValField => 'val', Options => undef, Progress => undef, ProgressData => undef);
2492 1         3 my $dt = $self->DataType;
2493 1         5 my %leInt32 = (Byte => 1, Int16 => 1, Int32 => 1, UInt16 => 1);
2494 1         1 my $leInt32 = $leInt32{$dt};
2495 1 50       4 $dt = $dt =~ /Float/ ? 'Real' : 'Integer';
2496 1   33     7 $p->{outlayer} //= Geo::OGR::Driver('Memory')->Create()->
2497             CreateLayer(Name => 'polygonized',
2498             Fields => [{Name => 'val', Type => $dt},
2499             {Name => 'geom', Type => 'Polygon'}]);
2500 1         16 $p->{pixvalfield} = $p->{outlayer}->GetLayerDefn->GetFieldIndex($p->{pixvalfield});
2501 1 50       3 $p->{options}{'8CONNECTED'} = $p->{options}{Connectedness} if $p->{options}{Connectedness};
2502 1 50 33     6 if ($leInt32 || $p->{options}{ForceIntPixel}) {
2503 1         588 Geo::GDAL::_Polygonize($self, $p->{mask}, $p->{outlayer}, $p->{pixvalfield}, $p->{options}, $p->{progress}, $p->{progressdata});
2504             } else {
2505 0         0 Geo::GDAL::FPolygonize($self, $p->{mask}, $p->{outlayer}, $p->{pixvalfield}, $p->{options}, $p->{progress}, $p->{progressdata});
2506             }
2507             set the srs of the outlayer if it was created here
2508 1 0       44 return $p->{outlayer};
2509             }
2510              
2511             sub Sieve {
2512 1     1   7 my $self = shift;
2513 1         5 my $p = Geo::GDAL::named_parameters(\@_, Mask => undef, Dest => undef, Threshold => 10, Options => undef, Progress => undef, ProgressData => undef);
2514 1 50       4 unless ($p->{dest}) {
2515 1         3 my ($w, $h) = $self->Size;
2516 1         3 $p->{dest} = Geo::GDAL::Driver('MEM')->Create(Name => 'sieved', Width => $w, Height => $h, Type => $self->DataType)->Band;
2517             }
2518 1         4 my $c = 8;
2519 1 50       4 if ($p->{options}{Connectedness}) {
2520 1         2 $c = $p->{options}{Connectedness};
2521 1         1 delete $p->{options}{Connectedness};
2522             }
2523 1         51 Geo::GDAL::SieveFilter($self, $p->{mask}, $p->{dest}, $p->{threshold}, $c, $p->{options}, $p->{progress}, $p->{progressdata});
2524 1         4 return $p->{dest};
2525             }
2526              
2527             sub Distance {
2528 1     1   8 my $self = shift;
2529 1         4 my $p = Geo::GDAL::named_parameters(\@_, Distance => undef, Options => undef, Progress => undef, ProgressData => undef);
2530 1         2 for my $key (keys %{$p->{options}}) {
  1         4  
2531 1         5 $p->{options}{uc($key)} = $p->{options}{$key};
2532             }
2533 1   0     4 $p->{options}{TYPE} //= $p->{options}{DATATYPE} //= 'Float32';
      33        
2534 1 50       2 unless ($p->{distance}) {
2535 1         3 my ($w, $h) = $self->Size;
2536 1         5 $p->{distance} = Geo::GDAL::Driver('MEM')->Create(Name => 'distance', Width => $w, Height => $h, Type => $p->{options}{TYPE})->Band;
2537             }
2538 1         3466 Geo::GDAL::ComputeProximity($self, $p->{distance}, $p->{options}, $p->{progress}, $p->{progressdata});
2539 1         17 return $p->{distance};
2540             }
2541              
2542              
2543              
2544              
2545             package Geo::GDAL::ColorTable;
2546 18     18   104 use strict;
  18         24  
  18         373  
2547 18     18   56 use warnings;
  18         20  
  18         464  
2548 18     18   66 use Carp;
  18         21  
  18         858  
2549              
2550 18     18   73 use vars qw/%PALETTE_INTERPRETATION_STRING2INT %PALETTE_INTERPRETATION_INT2STRING/;
  18         23  
  18         6365  
2551             for (keys %Geo::GDAL::Const::) {
2552             if (/^GPI_(\w+)/) {
2553             my $int = eval "\$Geo::GDAL::Const::GPI_$1";
2554             $PALETTE_INTERPRETATION_STRING2INT{$1} = $int;
2555             $PALETTE_INTERPRETATION_INT2STRING{$int} = $1;
2556             }
2557             }
2558              
2559             sub GetPaletteInterpretation {
2560 0     0   0 my $self = shift;
2561 0         0 return $PALETTE_INTERPRETATION_INT2STRING{GetPaletteInterpretation($self)};
2562             }
2563              
2564             sub SetColorEntry {
2565 12     12   28 my $self = shift;
2566 12         10 my $index = shift;
2567 12         8 my $color;
2568 12 100       24 if (ref($_[0]) eq 'ARRAY') {
2569 11         11 $color = shift;
2570             } else {
2571 1         1 $color = [@_];
2572             }
2573 12         11 eval {
2574 12         33 $self->_SetColorEntry($index, $color);
2575             };
2576 12 50       21 confess(Geo::GDAL->last_error) if $@;
2577             }
2578              
2579             sub ColorEntry {
2580 267     267   170 my $self = shift;
2581 267   50     295 my $index = shift // 0;
2582 267 100       287 SetColorEntry($self, $index, @_) if @_;
2583 267 100       282 return unless defined wantarray;
2584 262 50       906 return wantarray ? GetColorEntry($self, $index) : [GetColorEntry($self, $index)];
2585             }
2586             *Color = *ColorEntry;
2587              
2588             sub ColorTable {
2589 5     5   206 my $self = shift;
2590 5 100       14 if (@_) {
2591 2         2 my $index = 0;
2592 2         3 for my $color (@_) {
2593 4         6 ColorEntry($self, $index, $color);
2594 4         4 $index++;
2595             }
2596             }
2597 5 50       12 return unless defined wantarray;
2598 5         6 my @table;
2599 5         26 for (my $index = 0; $index < GetCount($self); $index++) {
2600 262         246 push @table, [ColorEntry($self, $index)];
2601             }
2602 5         49 return @table;
2603             }
2604             *ColorEntries = *ColorTable;
2605             *Colors = *ColorTable;
2606              
2607              
2608              
2609              
2610             package Geo::GDAL::RasterAttributeTable;
2611 18     18   80 use strict;
  18         21  
  18         311  
2612 18     18   54 use warnings;
  18         25  
  18         363  
2613 18     18   54 use Carp;
  18         18  
  18         967  
2614              
2615 18         11625 use vars qw/
2616             @FIELD_TYPES @FIELD_USAGES
2617             %FIELD_TYPE_STRING2INT %FIELD_TYPE_INT2STRING
2618             %FIELD_USAGE_STRING2INT %FIELD_USAGE_INT2STRING
2619 18     18   61 /;
  18         20  
2620             for (keys %Geo::GDAL::Const::) {
2621             next if /TypeCount/;
2622             push(@FIELD_TYPES, $1), next if /^GFT_(\w+)/;
2623             push(@FIELD_USAGES, $1), next if /^GFU_(\w+)/;
2624             }
2625             for my $string (@FIELD_TYPES) {
2626             my $int = eval "\$Geo::GDAL::Constc::GFT_$string";
2627             $FIELD_TYPE_STRING2INT{$string} = $int;
2628             $FIELD_TYPE_INT2STRING{$int} = $string;
2629             }
2630             for my $string (@FIELD_USAGES) {
2631             my $int = eval "\$Geo::GDAL::Constc::GFU_$string";
2632             $FIELD_USAGE_STRING2INT{$string} = $int;
2633             $FIELD_USAGE_INT2STRING{$int} = $string;
2634             }
2635              
2636             sub FieldTypes {
2637 1     1   8 return @FIELD_TYPES;
2638             }
2639              
2640             sub FieldUsages {
2641 1     1   9 return @FIELD_USAGES;
2642             }
2643              
2644             sub RELEASE_PARENTS {
2645 10     10   11 my $self = shift;
2646 10         16 delete $Geo::GDAL::Band::RATS{$self};
2647             }
2648              
2649             sub Band {
2650 1     1   3 my $self = shift;
2651 1         5 return $Geo::GDAL::Band::RATS{tied(%$self)};
2652             }
2653              
2654             sub GetUsageOfCol {
2655 57     57   10286 my($self, $col) = @_;
2656 57         265 $FIELD_USAGE_INT2STRING{_GetUsageOfCol($self, $col)};
2657             }
2658              
2659             sub GetColOfUsage {
2660 0     0   0 my($self, $usage) = @_;
2661 0         0 _GetColOfUsage($self, $FIELD_USAGE_STRING2INT{$usage});
2662             }
2663              
2664             sub GetTypeOfCol {
2665 57     57   9373 my($self, $col) = @_;
2666 57         251 $FIELD_TYPE_INT2STRING{_GetTypeOfCol($self, $col)};
2667             }
2668              
2669             sub Columns {
2670 0     0   0 my $self = shift;
2671 0         0 my %columns;
2672 0 0       0 if (@_) { # create columns
2673 0         0 %columns = @_;
2674 0         0 for my $name (keys %columns) {
2675 0         0 $self->CreateColumn($name, $columns{$name}{Type}, $columns{$name}{Usage});
2676             }
2677             }
2678 0         0 %columns = ();
2679 0         0 for my $c (0..$self->GetColumnCount-1) {
2680 0         0 my $name = $self->GetNameOfCol($c);
2681 0         0 $columns{$name}{Type} = $self->GetTypeOfCol($c);
2682 0         0 $columns{$name}{Usage} = $self->GetUsageOfCol($c);
2683             }
2684 0         0 return %columns;
2685             }
2686              
2687             sub CreateColumn {
2688 57     57   242 my($self, $name, $type, $usage) = @_;
2689 57         52 for my $color (qw/Red Green Blue Alpha/) {
2690 228 100 100     1240 carp "RAT column type will be 'Integer' for usage '$color'." if $usage eq $color and $type ne 'Integer';
2691             }
2692 57         127 $type = Geo::GDAL::string2int($type, \%FIELD_TYPE_STRING2INT);
2693 57         57 $usage = Geo::GDAL::string2int($usage, \%FIELD_USAGE_STRING2INT);
2694 57         173 _CreateColumn($self, $name, $type, $usage);
2695             }
2696              
2697             sub Value {
2698 57     57   9847 my($self, $row, $column) = @_;
2699 57 50       376 SetValueAsString($self, $row, $column, $_[3]) if defined $_[3];
2700 57 50       93 return unless defined wantarray;
2701 57         282 GetValueAsString($self, $row, $column);
2702             }
2703              
2704             sub LinearBinning {
2705 0     0   0 my $self = shift;
2706 0 0       0 SetLinearBinning($self, @_) if @_ > 0;
2707 0 0       0 return unless defined wantarray;
2708 0         0 my @a = GetLinearBinning($self);
2709 0 0       0 return $a[0] ? ($a[1], $a[2]) : ();
2710             }
2711              
2712              
2713              
2714              
2715             package Geo::GDAL::GCP;
2716              
2717             *swig_Pixel_get = *Geo::GDALc::GCP_Column_get;
2718             *swig_Pixel_set = *Geo::GDALc::GCP_Column_set;
2719             *swig_Line_get = *Geo::GDALc::GCP_Row_get;
2720             *swig_Line_set = *Geo::GDALc::GCP_Row_set;
2721              
2722              
2723              
2724             package Geo::GDAL::VSIF;
2725 18     18   87 use strict;
  18         21  
  18         333  
2726 18     18   58 use warnings;
  18         21  
  18         352  
2727 18     18   56 use Carp;
  18         21  
  18         9491  
2728             require Exporter;
2729             our @ISA = qw(Exporter);
2730              
2731             our @EXPORT_OK = qw(Open Close Write Read Seek Tell Truncate MkDir ReadDir ReadDirRecursive Rename RmDir Stat Unlink);
2732             our %EXPORT_TAGS = (all => \@EXPORT_OK);
2733              
2734             sub Open {
2735 3     3   17 my ($path, $mode) = @_;
2736 3         32 my $self = Geo::GDAL::VSIFOpenL($path, $mode);
2737 3         8 bless $self, 'Geo::GDAL::VSIF';
2738             }
2739              
2740             sub Write {
2741 2     2   322 my ($self, $data) = @_;
2742 2         23 Geo::GDAL::VSIFWriteL($data, $self);
2743             }
2744              
2745             sub Close {
2746 3     3   293 my ($self, $data) = @_;
2747 3         9 Geo::GDAL::VSIFCloseL($self);
2748             }
2749              
2750             sub Read {
2751 1     1   10 my ($self, $count) = @_;
2752 1         6 Geo::GDAL::VSIFReadL($count, $self);
2753             }
2754              
2755             sub Seek {
2756 0     0   0 my ($self, $offset, $whence) = @_;
2757 0         0 Geo::GDAL::VSIFSeekL($self, $offset, $whence);
2758             }
2759              
2760             sub Tell {
2761 0     0   0 my ($self) = @_;
2762 0         0 Geo::GDAL::VSIFTellL($self);
2763             }
2764              
2765             sub Truncate {
2766 0     0   0 my ($self, $new_size) = @_;
2767 0         0 Geo::GDAL::VSIFTruncateL($self, $new_size);
2768             }
2769              
2770             sub MkDir {
2771 3     3   1377 my ($path) = @_;
2772             # mode unused in CPL
2773 3         382 Geo::GDAL::Mkdir($path, 0);
2774             }
2775             *Mkdir = *MkDir;
2776              
2777             sub ReadDir {
2778 8     8   16722 my ($path) = @_;
2779 8         360 Geo::GDAL::ReadDir($path);
2780             }
2781              
2782             sub ReadDirRecursive {
2783 3     3   9 my ($path) = @_;
2784 3         45 Geo::GDAL::ReadDirRecursive($path);
2785             }
2786              
2787             sub Rename {
2788 1     1   328 my ($old, $new) = @_;
2789 1         20 Geo::GDAL::Rename($old, $new);
2790             }
2791              
2792             sub RmDir {
2793 2     2   297 my ($dirname, $recursive) = @_;
2794 2         3 eval {
2795 2 100       5 if (!$recursive) {
2796 1         6 Geo::GDAL::Rmdir($dirname);
2797             } else {
2798 1         3 for my $f (ReadDir($dirname)) {
2799 1 50 33     13 next if $f eq '..' or $f eq '.';
2800 1         5 my @s = Stat($dirname.'/'.$f);
2801 1 50       4 if ($s[0] eq 'f') {
    0          
2802 1         4 Unlink($dirname.'/'.$f);
2803             } elsif ($s[0] eq 'd') {
2804 0         0 Rmdir($dirname.'/'.$f, 1);
2805 0         0 Rmdir($dirname.'/'.$f);
2806             }
2807             }
2808 1         4 RmDir($dirname);
2809             }
2810             };
2811 2 50       4 if ($@) {
2812 0 0       0 my $r = $recursive ? ' recursively' : '';
2813 0         0 Geo::GDAL::error("Cannot remove directory \"$dirname\"$r.");
2814             }
2815             }
2816             *Rmdir = *RmDir;
2817              
2818             sub Stat {
2819 1     1   1 my ($path) = @_;
2820 1         7 Geo::GDAL::Stat($path);
2821             }
2822              
2823             sub Unlink {
2824 8     8   10363 my ($filename) = @_;
2825 8         419 Geo::GDAL::Unlink($filename);
2826             }
2827              
2828              
2829              
2830              
2831             package Geo::GDAL::GeoTransform;
2832 18     18   80 use strict;
  18         30  
  18         320  
2833 18     18   60 use warnings;
  18         21  
  18         386  
2834 18     18   61 use Carp;
  18         21  
  18         763  
2835 18     18   67 use Scalar::Util 'blessed';
  18         24  
  18         7891  
2836              
2837             sub new {
2838 8     8   1847 my $class = shift;
2839 8         8 my $self;
2840 8 100       35 if (@_ == 0) {
    100          
2841 2         6 $self = [0,1,0,0,0,1];
2842             } elsif (@_ == 1) {
2843 4         5 $self = $_[0];
2844             } else {
2845 2         6 my @a = @_;
2846 2         4 $self = \@a;
2847             }
2848 8         14 bless $self, $class;
2849 8         20 return $self;
2850             }
2851              
2852             sub NorthUp {
2853 0     0   0 my $self = shift;
2854 0   0     0 return $self->[2] == 0 && $self->[4] == 0;
2855             }
2856              
2857             sub FromGCPs {
2858 2     2   195 my $gcps;
2859 2         3 my $p = shift;
2860 2 100       7 if (ref $p eq 'ARRAY') {
2861 1         2 $gcps = $p;
2862             } else {
2863 1         2 $gcps = [];
2864 1   66     10 while ($p && blessed $p) {
2865 4         6 push @$gcps, $p;
2866 4         11 $p = shift;
2867             }
2868             }
2869 2   100     6 my $approx_ok = shift // 1;
2870 2 50       5 Geo::GDAL::error('Usage: Geo::GDAL::GeoTransform::FromGCPs(\@gcps, $approx_ok)') unless @$gcps;
2871 2         25 my $self = Geo::GDAL::GCPsToGeoTransform($gcps, $approx_ok);
2872 2         7 bless $self, 'Geo::GDAL::GetTransform';
2873 2         4 return $self;
2874             }
2875              
2876             sub Apply {
2877 0     0     my ($self, $columns, $rows) = @_;
2878 0           my (@x, @y);
2879 0           for my $i (0..$#$columns) {
2880 0           ($x[$i], $y[$i]) =
2881             Geo::GDAL::ApplyGeoTransform($self, $columns->[$i], $rows->[$i]);
2882             }
2883 0           return (\@x, \@y);
2884             }
2885              
2886             sub Inv {
2887 0     0     my $self = shift;
2888 0           my @inv = Geo::GDAL::InvGeoTransform($self);
2889 0 0         return new(@inv) if defined wantarray;
2890 0           @$self = @inv;
2891             }
2892              
2893             sub Extent {
2894 0     0     my ($self, $w, $h) = @_;
2895 0           my $e = Geo::GDAL::Extent->new($self->[0], $self->[3], $self->[0], $self->[3]);
2896 0           for my $x ($self->[0] + $self->[1]*$w, $self->[0] + $self->[2]*$h, $self->[0] + $self->[1]*$w + $self->[2]*$h) {
2897 0 0         $e->[0] = $x if $x < $e->[0];
2898 0 0         $e->[2] = $x if $x > $e->[2];
2899             }
2900 0           for my $y ($self->[3] + $self->[4]*$w, $self->[3] + $self->[5]*$h, $self->[3] + $self->[4]*$w + $self->[5]*$h) {
2901 0 0         $e->[1] = $y if $y < $e->[1];
2902 0 0         $e->[3] = $y if $y > $e->[3];
2903             }
2904 0           return $e;
2905             }
2906              
2907             package Geo::GDAL::Extent; # array 0=xmin|left, 1=ymin|bottom, 2=xmax|right, 3=ymax|top
2908              
2909 18     18   83 use strict;
  18         18  
  18         329  
2910 18     18   58 use warnings;
  18         17  
  18         392  
2911 18     18   53 use Carp;
  18         16  
  18         824  
2912 18     18   70 use Scalar::Util 'blessed';
  18         21  
  18         5441  
2913              
2914             sub new {
2915 0     0     my $class = shift;
2916 0           my $self;
2917 0 0         if (@_ == 0) {
    0          
2918 0           $self = [0,0,0,0];
2919             } elsif (ref $_[0]) {
2920 0           @$self = @{$_[0]};
  0            
2921             } else {
2922 0           @$self = @_;
2923             }
2924 0           bless $self, $class;
2925 0           return $self;
2926             }
2927              
2928             sub Size {
2929 0     0     my $self = shift;
2930 0           return ($self->[2] - $self->[0], $self->[3] - $self->[1]);
2931             }
2932              
2933             sub Overlaps {
2934 0     0     my ($self, $e) = @_;
2935 0   0       return $self->[0] < $e->[2] && $self->[2] > $e->[0] && $self->[1] < $e->[3] && $self->[3] > $e->[1];
2936             }
2937              
2938             sub Overlap {
2939 0     0     my ($self, $e) = @_;
2940 0 0         return undef unless $self->Overlaps($e);
2941 0           my $ret = Geo::GDAL::Extent->new($self);
2942 0 0         $ret->[0] = $e->[0] if $self->[0] < $e->[0];
2943 0 0         $ret->[1] = $e->[1] if $self->[1] < $e->[1];
2944 0 0         $ret->[2] = $e->[2] if $self->[2] > $e->[2];
2945 0 0         $ret->[3] = $e->[3] if $self->[3] > $e->[3];
2946 0           return $ret;
2947             }
2948              
2949             sub ExpandToInclude {
2950 0     0     my ($self, $e) = @_;
2951 0 0         $self->[0] = $e->[0] if $e->[0] < $self->[0];
2952 0 0         $self->[1] = $e->[1] if $e->[1] < $self->[1];
2953 0 0         $self->[2] = $e->[2] if $e->[2] > $self->[2];
2954 0 0         $self->[3] = $e->[3] if $e->[3] > $self->[3];
2955             }
2956              
2957             package Geo::GDAL::XML;
2958              
2959 18     18   68 use strict;
  18         23  
  18         322  
2960 18     18   53 use warnings;
  18         19  
  18         357  
2961 18     18   54 use Carp;
  18         19  
  18         6517  
2962              
2963             # XML related subs in Geo::GDAL
2964              
2965             #Geo::GDAL::Child
2966             #Geo::GDAL::Children
2967             #Geo::GDAL::NodeData
2968             #Geo::GDAL::NodeType
2969             #Geo::GDAL::NodeTypes
2970             #Geo::GDAL::ParseXMLString
2971             #Geo::GDAL::SerializeXMLTree
2972              
2973             sub new {
2974 0     0     my $class = shift;
2975 0   0       my $xml = shift // '';
2976 0           my $self = Geo::GDAL::ParseXMLString($xml);
2977 0           bless $self, $class;
2978 0     0     $self->traverse(sub {my $node = shift; bless $node, $class});
  0            
  0            
2979 0           return $self;
2980             }
2981              
2982             sub traverse {
2983 0     0     my ($self, $sub) = @_;
2984 0           my $type = $self->[0];
2985 0           my $data = $self->[1];
2986 0           $type = Geo::GDAL::NodeType($type);
2987 0           $sub->($self, $type, $data);
2988 0           for my $child (@{$self}[2..$#$self]) {
  0            
2989 0           traverse($child, $sub);
2990             }
2991             }
2992              
2993             sub serialize {
2994 0     0     my $self = shift;
2995 0           return Geo::GDAL::SerializeXMLTree($self);
2996             }
2997              
2998             1;