1use v5.10; 2use strict; 3use warnings; 4 5my $gdal_src_root = shift @ARGV; 6 7my @h_files = ( 8 'gcore/gdal.h', 9 'ogr/ogr_api.h', 10 'ogr/ogr_srs_api.h', 11 'apps/gdal_utils.h' 12 ); 13 14my %pre = ( 15 CPL_C_START => '', 16 CPL_DLL => '', 17 CPL_STDCALL => '', 18 CPL_WARN_UNUSED_RESULT => '', 19 CPL_RESTRICT => '' 20 ); 21 22my %constants = ( 23 GDALDataType => 1, 24 GDALAsyncStatusType => 1, 25 GDALColorInterp => 1, 26 GDALPaletteInterp => 1, 27 GDALAccess => 1, 28 GDALRWFlag => 1, 29 OGRwkbGeometryType => 1, 30 GDALRATFieldUsage => 1, 31 GDALRATFieldType => 1, 32 GDALRATTableType => 1, 33 GDALTileOrganization => 1, 34 OGRwkbByteOrder => 1, 35 OGRFieldType => 1, 36 OGRFieldSubType => 1, 37 OGRJustification => 1, 38 OGRSTClassId => 1, 39 OGRSTUnitId => 1, 40 OGRAxisOrientation => 1, 41 GDALGridAlgorithm => 1, 42 ); 43 44my %callbacks = ( 45 CPLErrorHandler => 1, 46 GDALProgressFunc => 1, 47 GDALDerivedPixelFunc => 1, 48 GDALTransformerFunc => 1, 49 GDALContourWriter => 1, 50 ); 51 52my %char_p_p_ok = ( 53 OGR_G_CreateFromWkt => 1, 54 OGR_G_ImportFromWkt => 1, 55 OGR_G_ExportToWkt => 1, 56 OGR_G_ExportToIsoWkt => 1, 57 OSRExportToWkt => 1, 58 OSRExportToPrettyWkt => 1, 59 OSRExportToProj4 => 1, 60 OSRExportToPCI => 1, 61 OSRExportToXML => 1, 62 OSRExportToMICoordSys => 1, 63 ); 64 65my %use_CSL = ( 66 GDALCreate => 1, 67 GDALOpenEx => 1, 68 GDALCreateCopy => 1, 69 GDALGetMetadataDomainList => 1, 70 GDALIdentifyDriver => 1, 71 GDALIdentifyDriverEx => 1, 72 GDALValidateCreationOptions => 1, 73 GDALGetMetadata => 1, 74 GDALSetMetadata => 1, 75 GDALGetFileList => 1, 76 GDALAddBand => 1, 77 GDALDatasetCreateLayer => 1, 78 GDALDatasetCopyLayer => 1, 79 OGR_DS_CreateLayer => 1, 80 OGR_DS_CopyLayer => 1, 81 GDALGetRasterCategoryNames => 1, 82 OGR_F_GetFieldAsStringList => 1, 83 OGR_F_SetFieldStringList => 1, 84 OGR_G_ExportToGMLEx => 1, 85 OGR_G_ExportToJsonEx => 1, 86 GDALInfoOptionsNew => 1, 87 GDALTranslateOptionsNew => 1, 88 GDALWarpAppOptionsNew => 1, 89 GDALVectorTranslateOptionsNew => 1, 90 GDALDEMProcessingOptionsNew => 1, 91 GDALNearblackOptionsNew => 1, 92 GDALGridOptionsNew => 1, 93 GDALRasterizeOptionsNew => 1, 94 GDALBuildVRTOptionsNew => 1, 95 GDALBuildVRT => 1, 96 OGR_L_Intersection => 1, 97 OGR_L_Union => 1, 98 OGR_L_SymDifference => 1, 99 OGR_L_Identity => 1, 100 OGR_L_Update => 1, 101 OGR_L_Clip => 1, 102 OGR_L_Erase => 1, 103 ); 104 105# these return strings which must be freed 106my %use_ret_opaque = ( 107 OGR_G_ExportToGML => 1, 108 OGR_G_ExportToGMLEx => 1, 109 OGR_G_ExportToKML => 1, 110 OGR_G_ExportToJson => 1, 111 OGR_G_ExportToJsonEx => 1, 112 ); 113 114my %ret_string_ok = ( 115 GDALGetDataTypeName => 1, 116 GDALGetAsyncStatusTypeName => 1, 117 GDALGetColorInterpretationName => 1, 118 GDALGetPaletteInterpretationName => 1, 119 GDALGetDriverShortName => 1, 120 GDALGetDriverLongName => 1, 121 GDALGetDriverHelpTopic => 1, 122 GDALGetDriverCreationOptionList => 1, 123 GDALGetMetadataItem => 1, 124 GDALGetDescription => 1, 125 GDALGetProjectionRef => 1, 126 GDALGetGCPProjection => 1, 127 GDALGetRasterUnitType => 1, 128 GDALDecToDMS => 1, 129 OGR_G_GetGeometryName => 1, 130 ); 131 132my %use_array = ( 133 OGR_F_SetFieldIntegerList => 1, 134 OGR_F_SetFieldInteger64List => 1, 135 OGR_F_SetFieldDoubleList => 1, 136 ); 137 138my %use_opaque_array = ( 139 GDALWarp => 1, 140 GDALVectorTranslate => 1, 141 GDALBuildVRT => 1, 142 ); 143 144my %use_ret_pointer = ( 145 OGR_F_GetFieldAsIntegerList => 1, 146 OGR_F_GetFieldAsInteger64List => 1, 147 OGR_F_GetFieldAsDoubleList => 1, 148 ); 149 150my %use_string = ( 151 OGR_G_CreateFromWkb => 1, 152 OGR_G_CreateFromFgf => 1, 153 OGR_G_ImportFromWkb => 1, 154 ); 155 156my %opaque_pointers = ( 157 GDAL_GCP => 1, 158 GDALRPCInfo => 1, 159 CPLXMLNode => 1, 160 GDALRasterIOExtraArg => 1, 161 GDALGridContext => 1, 162 CPLVirtualMem => 1, 163 OGRField => 1, 164 GDALInfoOptions => 1, 165 GDALInfoOptionsForBinary => 1, 166 GDALTranslateOptions => 1, 167 GDALTranslateOptionsForBinary => 1, 168 GDALWarpAppOptions => 1, 169 GDALWarpAppOptionsForBinary => 1, 170 GDALVectorTranslateOptions => 1, 171 GDALVectorTranslateOptionsForBinary => 1, 172 GDALDEMProcessingOptions => 1, 173 GDALDEMProcessingOptionsForBinary => 1, 174 GDALNearblackOptions => 1, 175 GDALNearblackOptionsForBinary => 1, 176 GDALGridOptions => 1, 177 GDALGridOptionsForBinary => 1, 178 GDALRasterizeOptions => 1, 179 GDALRasterizeOptionsForBinary => 1, 180 GDALBuildVRTOptions => 1, 181 GDALBuildVRTOptionsForBinary => 1, 182 ); 183 184my %defines; 185my %enums; 186my %structs; 187 188say "# generated with parse_h.pl"; 189for my $f (@h_files) { 190 say "# from $f"; 191 parse_h($gdal_src_root . '/' . $f); 192} 193say "# end of generated code"; 194 195sub parse_h { 196 my $f = shift; 197 open(my $fh, '<', $f) or die "can't open $f: $!"; 198 my $s = ''; 199 while (1) { 200 my $n = pre_process($fh); 201 #say STDERR "top: ",$n; 202 last unless defined $n; 203 $s .= ' '.$n; 204 next unless $s =~ /;/; 205 $s =~ s/^\s+//; 206 $s =~ s/\s+$//; 207 $s =~ tr/ //s; 208 if ($s =~ /^typedef enum/) { 209 $enums{$s} = 1; 210 $s = ''; 211 next; 212 } 213 if ($s =~ /^typedef struct .*?\{/) { 214 my $struct = $s; 215 while (1) { 216 my $n = pre_process($fh); 217 die "eof while parsing typedef struct" unless defined $n; 218 # look for "} name;" 219 $struct .= ' '.$n; 220 if ($struct =~ /\} \w+;/) { 221 last; 222 } 223 } 224 $structs{$struct} = 1; 225 $s = ''; 226 next; 227 } 228 if ($s =~ /^typedef/) { 229 $s = ''; 230 next; 231 } 232 if ($s =~ /^struct/) { 233 $s = ''; 234 next; 235 } 236 # now $s should be a function 237 #say 'line: ',$s; 238 if ($s =~ /(\w+)\s*\((.*?)\)/) { 239 my $name = $1; 240 my $args = $2; 241 my $ret = $s; 242 $ret =~ s/$name.*//; 243 $ret = parse_type($name, $ret, 'ret'); 244 my @args = split /\s*,\s*/, $args; 245 my $qw = 1; 246 for my $arg (@args) { 247 $arg = parse_type($name, $arg, 'arg'); 248 $qw = 0 if $arg =~ /\s/; 249 } 250 #say "ret: $ret"; 251 #say "name: $name"; 252 #say "args: @args"; 253 if (@args == 1 && $args[0] eq 'void') { 254 $args = ''; 255 } elsif ($qw) { 256 $args = "qw/@args/"; 257 } else { 258 $args = "'".join("','", @args)."'"; 259 } 260 say "eval{\$ffi->attach('$name' => [$args] => '$ret');};"; 261 } else { 262 die "can't parse $s as function"; 263 } 264 $s = ''; 265 } 266 close $fh; 267} 268 269sub parse_type { 270 my ($name, $arg, $mode) = @_; 271 $arg =~ s/^\s+//; 272 $arg =~ s/\s+$//; 273 for my $c (keys %constants) { 274 if ($arg =~ /^$c/ or $arg =~ /^const $c/) { 275 $arg = 'unsigned int'; 276 } 277 } 278 for my $c (keys %callbacks) { 279 if ($arg =~ /^$c/) { 280 return $c; 281 } 282 } 283 for my $c (keys %opaque_pointers) { 284 if ($arg =~ /$c\s*\*/) { 285 return 'opaque'; 286 } 287 } 288 if ($arg =~ /^\w+?H\s*\*/) { 289 if ($use_opaque_array{$name}) { 290 $arg = 'opaque[]'; 291 } else { 292 $arg = 'uint64*'; 293 } 294 } elsif ($arg =~ /^\w+?H/) { 295 $arg = 'opaque'; 296 } elsif ($arg =~ /^const \w+?H/) { 297 $arg = 'opaque'; 298 } elsif ($arg =~ /GDALColorEntry\s*\*/) { 299 $arg = 'short[4]'; 300 } elsif ($arg =~ /OGREnvelope\s*\*/) { 301 $arg = 'double[4]'; 302 } elsif ($arg =~ /OGREnvelope3D\s*\*/) { 303 $arg = 'double[6]'; 304 } elsif ($arg =~ /GDALTriangulation/) { 305 $arg = 'opaque'; # todo: actually a record 306 } elsif ($arg =~ /^FILE\s*\*/) { 307 $arg = 'opaque'; 308 } elsif ($arg =~ /void\s*\*/) { 309 for my $c (keys %use_string) { 310 if ($c eq $name) { 311 say STDERR "$name returns a string" if $mode eq 'ret' && !$ret_string_ok{$name}; 312 return 'string'; 313 } 314 } 315 $arg = 'opaque'; 316 } elsif ($arg =~ /^char\s*\*\*/ or $arg =~ /^const char\s*\*\s*const\s*\*/) { 317 if ($use_CSL{$name}) { 318 $arg = 'opaque'; 319 } else { 320 say STDERR "char ** in $name" unless $char_p_p_ok{$name}; 321 $arg = 'string_pointer'; 322 } 323 } elsif ($arg =~ /char\s*\*/) { 324 if ($mode eq 'ret' && $use_ret_opaque{$name}) { 325 $arg = 'opaque'; 326 } else { 327 say STDERR "$name returns a string" if $mode eq 'ret' && !$ret_string_ok{$name}; 328 $arg = 'string'; 329 } 330 } elsif ($arg =~ /^unsigned char\s*\*/) { 331 $arg = 'pointer'; 332 } elsif ($arg =~ /int\s*\*/) { 333 if ($use_array{$name}) { 334 $arg = 'int[]'; 335 } elsif ($mode eq 'ret' && $use_ret_pointer{$name}) { 336 $arg = 'pointer'; 337 } else { 338 $arg = 'int*'; 339 } 340 } elsif ($arg =~ /^int/) { 341 $arg = 'int'; 342 } elsif ($arg =~ /^unsigned int\s*\*/) { 343 $arg = 'unsigned int*'; 344 } elsif ($arg =~ /^unsigned int/) { 345 $arg = 'unsigned int'; 346 } elsif ($arg =~ /^long\s*\*/) { 347 $arg = 'long*'; 348 } elsif ($arg =~ /^long/) { 349 $arg = 'long'; 350 } elsif ($arg =~ /double\s*\*/) { 351 if ($name eq 'GDALGetGeoTransform' or $name eq 'GDALSetGeoTransform') { 352 $arg = 'double[6]'; 353 } elsif ($use_array{$name}) { 354 $arg = 'double[]'; 355 } elsif ($mode eq 'ret' && $use_ret_pointer{$name}) { 356 $arg = 'pointer'; 357 } else { 358 $arg = 'double*'; 359 } 360 } elsif ($arg =~ /^double/) { 361 $arg = 'double'; 362 } elsif ($arg =~ /float\s*\*/) { 363 $arg = 'float*'; 364 } elsif ($arg =~ /float/) { 365 $arg = 'float'; 366 } elsif ($arg =~ /^CPLErr/) { 367 $arg = 'int'; 368 } elsif ($arg =~ /^OGRErr\s*\*/) { 369 $arg = 'int*'; 370 } elsif ($arg =~ /^OGRErr/) { 371 $arg = 'int'; 372 } elsif ($arg =~ /^size_t/) { 373 $arg = 'size_t'; 374 } elsif ($arg =~ /^const size_t/) { 375 $arg = 'size_t'; 376 } elsif ($arg =~ /GByte\s*\*/) { 377 $arg = 'pointer'; 378 } elsif ($arg =~ /^GUInt32\s*\*/) { 379 $arg = 'uint32*'; 380 } elsif ($arg =~ /^GUInt32/) { 381 $arg = 'uint32'; 382 } elsif ($arg =~ /^const GInt64\s*\*/) { 383 $arg = 'int64'; 384 } elsif ($arg =~ /^GUInt64/) { 385 $arg = 'uint64'; 386 } elsif ($arg =~ /^const GUInt64\s*\*/) { 387 $arg = 'uint64*'; 388 } elsif ($arg =~ /^GUIntBig\s*\*/) { 389 $arg = 'uint64*'; 390 } elsif ($arg =~ /^GUIntBig/) { 391 $arg = 'uint64'; 392 } elsif ($arg =~ /GIntBig\s*\*/) { 393 if ($use_array{$name}) { 394 $arg = 'sint64[]'; 395 } elsif ($mode eq 'ret' && $use_ret_pointer{$name}) { 396 $arg = 'pointer'; 397 } else { 398 $arg = 'sint64*'; 399 } 400 } elsif ($arg =~ /^GIntBig/ or $arg =~ /^GSpacing/) { 401 $arg = 'sint64'; 402 } elsif ($arg =~ /^void/) { 403 $arg = 'void'; 404 } elsif ($arg =~ /^CSLConstList/) { 405 $arg = 'opaque'; 406 } elsif ($arg =~ /^GPtrDiff_t/) { 407 $arg = 'int'; 408 } elsif ($arg =~ /^const GPtrDiff_t\s*\*/) { 409 $arg = 'int*'; 410 } elsif ($arg =~ /^GDALExtendedDataTypeClass/) { 411 $arg = 'int'; 412 } elsif ($arg =~ /^OSRAxisMappingStrategy/) { 413 $arg = 'int'; 414 } elsif ($arg =~ /^OSRCRSInfo/) { 415 $arg = 'opaque'; 416 } elsif ($arg =~ /^(const )?OSRCRSListParameters/) { 417 $arg = 'opaque'; 418 } elsif ($arg =~ /^(const )?GDALMultiDimInfoOptions/) { 419 $arg = 'opaque'; 420 } elsif ($arg =~ /^(const )?GDALMultiDimTranslateOptions/) { 421 $arg = 'opaque'; 422 } else { 423 die "can't parse arg '$arg'"; 424 } 425 return $arg; 426} 427 428sub pre_process { 429 state $skip = 0; 430 my $fh = shift; 431 while (1) { 432 my $s = ''; 433 while (1) { 434 my $n = get_line($fh); 435 #say STDERR "got: ",$n; 436 return if !defined($n) && $s eq ''; 437 return $s unless defined $n; 438 $s .= ' '.$n; 439 last unless $s =~ /\\$/; 440 } 441 $s =~ s/^\s+//; 442 $s =~ s/\s+$//; 443 $s =~ tr/ //s; 444 $s =~ s/^#\s+/#/; 445 if ($s =~ /^#ifndef (\w+)/) { 446 next; 447 } 448 if ($s =~ /^#ifdef (\w+)/ or $s =~ /^#if defined\((\w+)\)/) { 449 if ( 450 $1 eq 'DEBUG' 451 or $1 eq 'undef' 452 or $1 eq 'GDAL_COMPILATION' 453 or $1 eq 'USE_DEPRECATED_SRS_WKT_WGS84' 454 ) { 455 $skip = 1; 456 next; 457 } 458 } 459 if ($s =~ /^#else/) { 460 $skip = 0 if $skip; 461 next; 462 } 463 if ($s =~ /^#define (\w+) (.*)/) { 464 $defines{$1} = $2; 465 next; 466 } 467 # skip all other defines 468 if ($s =~ /^#define/) { 469 next; 470 } 471 if ($s =~ /^#include/) { 472 next; 473 } 474 if ($s =~ /^#endif/) { 475 $skip = 0 if $skip; 476 next; 477 } 478 next if $skip; 479 return $s; 480 } 481} 482 483sub get_line { 484 state $state = ''; 485 my $fh = shift; 486 my $s = <$fh>; 487 return unless $s; 488 chomp $s; 489 #say STDERR 'line: ',$s; 490 if ($state eq 'comment') { 491 if ($s =~ /\*\//) { 492 $s =~ s/.*?\*\///; 493 $state = ''; 494 } else { 495 return ''; 496 } 497 } 498 # replace pre-defined constants 499 for my $def (keys %pre) { 500 $s =~ s/$def/$pre{$def}/; 501 } 502 # remove on-line comments 503 if ($s =~ /\/\*/ and $s =~ /\*\//) { 504 $s =~ s/\/\*.*?\*\///; 505 } 506 $s =~ s/\/\/.*//; 507 # remove starting comment and set state 508 if ($s =~ /\/\*/) { 509 $s =~ s/\/\*.*//; 510 $state = 'comment'; 511 } 512 return $s; 513} 514