← Back to branch summary

~ubuntu-branches/debian/sid/gdal/sid

« back to all changes in this revision

Viewing changes to swig/include/perl/ogr_perl.i

  • Committer: Package Import Robot
  • Author(s): Francesco Paolo Lovergine
  • Date: 2012-05-07 15:04:42 UTC
  • mfrom: (5.5.16 experimental)
  • Revision ID: package-import@ubuntu.com-20120507150442-2eks97loeh6rq005
Tags: 1.9.0-1
* Ready for sid, starting transition.
* All symfiles updated to latest builds.
* Added dh_numpy call in debian/rules to depend on numpy ABI.
* Policy bumped to 3.9.3, no changes required.

Show diffs side-by-side

added added

removed removed

Lines of Context:
swig/include/perl/ogr_perl.i
64
64
 
65
65
  %rename (_UnsetField) UnsetField;
66
66
  %rename (_SetField) SetField;
 
67
  %rename (_SetFrom) SetFrom;
67
68
 
68
69
}
69
70
 
98
99
%rename (_SetGeometryDirectly) SetGeometryDirectly;
99
100
%rename (_ExportToWkb) ExportToWkb;
100
101
%rename (_GetDriver) GetDriver;
 
102
%rename (_TestCapability) TestCapability;
101
103
 
102
104
%perlcode %{
103
105
    use strict;
104
106
    use Carp;
105
107
    {
106
 
        package Geo::OGR::Driver;
 
108
        package Geo::OGR;
 
109
    }
 
110
    {
 
111
        package Geo::OGR::Driver;
107
112
        use strict;
108
 
        use vars qw /@CAPABILITIES/;
109
 
        for my $s (qw/CreateDataSource DeleteDataSource/) {
 
113
        use vars qw /@CAPABILITIES %CAPABILITIES/;
 
114
        @CAPABILITIES = qw/CreateDataSource DeleteDataSource/; 
 
115
        for my $s (@CAPABILITIES) {
110
116
            my $cap = eval "\$Geo::OGR::ODrC$s";
111
 
            push @CAPABILITIES, $cap;
 
117
            $CAPABILITIES{$s} = $cap;
112
118
        }
113
119
        sub Capabilities {
114
120
            return @CAPABILITIES if @_ == 0;
115
121
            my $self = shift;
116
122
            my @cap;
117
123
            for my $cap (@CAPABILITIES) {
118
 
                push @cap, $cap if TestCapability($self, $cap);
 
124
                push @cap, $cap if _TestCapability($self, $CAPABILITIES{$cap});
119
125
            }
120
126
            return @cap;
121
127
        }
 
128
        sub TestCapability {
 
129
            my($self, $cap) = @_;
 
130
            return _TestCapability($self, $CAPABILITIES{$cap});
 
131
        }
122
132
        *Create = *CreateDataSource;
123
133
        *Copy = *CopyDataSource;
124
134
        *OpenDataSource = *Open;
127
137
        package Geo::OGR::DataSource;
128
138
        use Carp;
129
139
        use strict;
130
 
        use vars qw /@CAPABILITIES %LAYERS/;
131
 
        for my $s (qw/CreateLayer DeleteLayer/) {
 
140
        use vars qw /@CAPABILITIES %CAPABILITIES %LAYERS/;
 
141
        @CAPABILITIES = qw/CreateLayer DeleteLayer/;
 
142
        for my $s (@CAPABILITIES) {
132
143
            my $cap = eval "\$Geo::OGR::ODsC$s";
133
 
            push @CAPABILITIES, $cap;
 
144
            $CAPABILITIES{$s} = $cap;
134
145
        }
135
146
        sub Capabilities {
136
147
            return @CAPABILITIES if @_ == 0;
137
148
            my $self = shift;
138
149
            my @cap;
139
150
            for my $cap (@CAPABILITIES) {
140
 
                push @cap, $cap if TestCapability($self, $cap);
 
151
                push @cap, $cap if _TestCapability($self, $CAPABILITIES{$cap});
141
152
            }
142
153
            return @cap;
143
154
        }
 
155
        sub TestCapability {
 
156
            my($self, $cap) = @_;
 
157
            return _TestCapability($self, $CAPABILITIES{$cap});
 
158
        }
144
159
        *GetDriver = *_GetDriver;
145
160
        sub new {
146
161
            my $pkg = shift;
157
172
            my $layer;
158
173
            if (defined $name) {
159
174
                $layer = _GetLayerByName($self, "$name");
 
175
                $layer = _GetLayerByIndex($self, $name) unless $layer;
160
176
            } else {
161
 
                $name = 0;
 
177
                $layer = _GetLayerByIndex($self, 0);
162
178
            }
163
 
            $layer = _GetLayerByIndex($self, $name) if !$layer and $name =~ /^\d+$/;
164
 
            return unless $layer;
 
179
            croak "No such layer: $name\n" unless $layer;
165
180
            $LAYERS{tied(%$layer)} = $self;
166
181
            return $layer;
167
182
        }
178
193
            my($self, $index) = @_;
179
194
            $index = 0 unless defined $index;
180
195
            my $layer = _GetLayerByIndex($self, $index+0);
181
 
            return unless $layer;
 
196
            croak "No such layer: $index\n" unless $layer;
182
197
            $LAYERS{tied(%$layer)} = $self;
183
198
            return $layer;
184
199
        }
185
200
        sub GetLayerByName {
186
201
            my($self, $name) = @_;
187
 
            my $layer = _GetLayerByName($self, $name);
188
 
            return unless $layer;
 
202
            my $layer = _GetLayerByName($self, "$name");
 
203
            croak "No such layer: $name\n" unless $layer;
189
204
            $LAYERS{tied(%$layer)} = $self;
190
205
            return $layer;
191
206
        }
236
251
 
237
252
        package Geo::OGR::Layer;
238
253
        use strict;
239
 
        use vars qw /@CAPABILITIES/;
240
 
        for my $s (qw/RandomRead SequentialWrite RandomWrite 
 
254
        use vars qw /@CAPABILITIES %CAPABILITIES/;
 
255
        @CAPABILITIES = qw/RandomRead SequentialWrite RandomWrite 
241
256
                   FastSpatialFilter FastFeatureCount FastGetExtent 
242
 
                   CreateField Transactions DeleteFeature FastSetNextByIndex/) {
 
257
                   CreateField DeleteField ReorderFields AlterFieldDefn
 
258
                   Transactions DeleteFeature FastSetNextByIndex
 
259
                   StringsAsUTF8 IgnoreFields/;
 
260
        for my $s (@CAPABILITIES) {
243
261
            my $cap = eval "\$Geo::OGR::OLC$s";
244
 
            push @CAPABILITIES, $cap;
 
262
            $CAPABILITIES{$s} = $cap;
245
263
        }
246
264
        sub DESTROY {
247
265
            my $self;
267
285
            my $self = shift;
268
286
            my @cap;
269
287
            for my $cap (@CAPABILITIES) {
270
 
                push @cap, $cap if TestCapability($self, $cap);
 
288
                push @cap, $cap if _TestCapability($self, $CAPABILITIES{$cap});
271
289
            }
272
290
            return @cap;
273
291
        }
 
292
        sub TestCapability {
 
293
            my($self, $cap) = @_;
 
294
            return _TestCapability($self, $CAPABILITIES{$cap});
 
295
        }
274
296
        sub Schema {
275
297
            my $self = shift;
276
298
            if (@_) {
280
302
                    if (ref($fd) eq 'HASH') {
281
303
                        $fd = Geo::OGR::FieldDefn->create(%$fd);
282
304
                    }
 
305
                    $schema{ApproxOK} = 1 unless defined $schema{ApproxOK};
283
306
                    CreateField($self, $fd, $schema{ApproxOK});
284
307
                }
285
308
            }
305
328
            for my $fn (keys %row) {
306
329
                next if $fn eq 'FID';
307
330
                next if $fn eq 'Geometry';
308
 
                if (defined $row{$fn}) {
309
 
                    $f->SetField($fn, $row{$fn});
310
 
                } else {
311
 
                    $f->UnsetField($fn);
312
 
                }
 
331
                $f->SetField($fn, $row{$fn});
313
332
                $changed = 1;
314
333
            }
315
334
            $self->SetFeature($f) if $changed;
350
369
                for my $field (@{$s->{Fields}}) {
351
370
                    my $v = shift;
352
371
                    my $n = $field->{Name};
353
 
                    defined $v ? $f->SetField($n, $v) : $f->UnsetField($n);
 
372
                    $f->SetField($n, $v);
354
373
                }
355
374
                $changed = 1;
356
375
            }
388
407
            }
389
408
            $self->CreateFeature($f);
390
409
        }
 
410
        sub GeometryType {
 
411
            my $self = shift;
 
412
            return $Geo::OGR::Geometry::TYPE_INT2STRING{GetGeomType($self)};
 
413
        }
391
414
 
392
415
        package Geo::OGR::FeatureDefn;
393
416
        use strict;
 
417
        use Encode;
 
418
        sub create {
 
419
            my $pkg = shift;
 
420
            my %schema;
 
421
            if (@_ == 1) {
 
422
                %schema = %{$_[0]};
 
423
            } else {
 
424
                %schema = @_;
 
425
            }
 
426
            my $self = Geo::OGRc::new_FeatureDefn($schema{Name});
 
427
            bless $self, $pkg;
 
428
            $self->GeometryType($schema{GeometryType});
 
429
            for my $fd (@{$schema{Fields}}) {
 
430
                if (ref($fd) eq 'HASH') {
 
431
                    $fd = Geo::OGR::FieldDefn->create(%$fd);
 
432
                }
 
433
                AddFieldDefn($self, $fd);
 
434
            }
 
435
            return $self;
 
436
        }
 
437
        *Name = *GetName;
394
438
        sub Schema {
395
439
            my $self = shift;
396
440
            my %schema;
410
454
            $schema{GeometryType} = $self->GeomType();
411
455
            $schema{Fields} = [];
412
456
            for my $i (0..$self->GetFieldCount-1) {
413
 
                push @{$schema{Fields}}, $self->GetFieldDefn($i)->Schema;
 
457
                my $s = $self->GetFieldDefn($i)->Schema;
 
458
                $s->{Index} = $i;
 
459
                push @{$schema{Fields}}, $s;
414
460
            }
415
 
            return \%schema;
 
461
            return wantarray ? %schema : \%schema;
416
462
        }
417
463
        sub GeomType {
418
464
            my($self, $type) = @_;
424
470
            return $Geo::OGR::Geometry::TYPE_INT2STRING{GetGeomType($self)} if defined wantarray;
425
471
        }
426
472
        *GeometryType = *GeomType;
 
473
        sub GeometryIgnored {
 
474
            my $self = shift;
 
475
            SetGeometryIgnored($self, $_[0]) if @_;
 
476
            IsGeometryIgnored($self) if defined wantarray;
 
477
        }
 
478
        sub StyleIgnored {
 
479
            my $self = shift;
 
480
            SetStyleIgnored($self, $_[0]) if @_;
 
481
            IsStyleIgnored($self) if defined wantarray;
 
482
        }
427
483
 
428
484
        package Geo::OGR::Feature;
429
485
        use strict;
430
486
        use vars qw /%GEOMETRIES/;
431
487
        use Carp;
 
488
        use Encode;
 
489
        sub create {
 
490
            my $pkg = shift;
 
491
            $pkg->new(Geo::OGR::FeatureDefn->create(@_));
 
492
        }
 
493
        sub FETCH {
 
494
            my($self, $index) = @_;
 
495
            $self->GetField($index);
 
496
        }
 
497
        sub STORE {
 
498
            my $self = shift;
 
499
            $self->SetField(@_);
 
500
        }
432
501
        sub FID {
433
502
            my $self = shift;
434
503
            $self->SetFID($_[0]) if @_;
450
519
                    if (ref($fd) eq 'HASH') {
451
520
                        $fd = Geo::OGR::FieldDefn->create(%$fd);
452
521
                    }
 
522
                    $schema{ApproxOK} = 1 unless defined $schema{ApproxOK};
453
523
                    CreateField($self, $fd, $schema{ApproxOK});
454
524
                }
455
525
            }
472
542
            for my $fn (keys %row) {
473
543
                next if $fn eq 'FID';
474
544
                next if $fn eq 'Geometry';
475
 
                if (defined $row{$fn}) {
476
 
                    $self->SetField($fn, $row{$fn});
477
 
                } else {
478
 
                    $self->UnsetField($fn);
479
 
                }
 
545
                $self->SetField($fn, $row{$fn});
480
546
            }
481
547
            return unless defined wantarray;
482
548
            %row = ();
512
578
                for my $field (@{$s->{Fields}}) {
513
579
                    my $v = shift;
514
580
                    my $n = $field->{Name};
515
 
                    defined $v ? $self->SetField($n, $v) : $self->UnsetField($n);
 
581
                    $self->SetField($n, $v);
516
582
                }
517
583
            }
518
584
            return unless defined wantarray;
529
595
        }
530
596
        sub GetFieldType {
531
597
            my($self, $field) = @_;
 
598
            my $index = GetFieldIndex($self, "$field");
 
599
            $field = $index unless $index == -1;
 
600
            croak "No such field: $field" if $field < 0 or $field >= GetFieldCount($self);
532
601
            return $Geo::OGR::FieldDefn::TYPE_INT2STRING{_GetFieldType($self, $field)};
533
602
        }
534
603
        sub FieldIsList {
535
604
            my($self, $field) = @_;
536
 
            my $count = GetFieldCount($self);
537
 
            $field = GetFieldIndex($self, $field) unless $field =~ /^\d+$/;
538
 
            croak("no such field: $_[1]") if $field < 0 or $field >= $count;
 
605
            my $index = GetFieldIndex($self, "$field");
 
606
            $field = $index unless $index == -1;
 
607
            croak "No such field: $field" if $field < 0 or $field >= GetFieldCount($self);
539
608
            my $type = _GetFieldType($self, $field);
540
609
            return 1 if ($type == $Geo::OGR::OFTIntegerList or
541
610
                         $type == $Geo::OGR::OFTRealList or
547
616
        }
548
617
        sub GetField {
549
618
            my($self, $field) = @_;
550
 
            my $count = GetFieldCount($self);
551
 
            $field = GetFieldIndex($self, $field) unless $field =~ /^\d+$/;
552
 
            croak("no such field: $_[1]") if $field < 0 or $field >= $count;
 
619
            my $index = GetFieldIndex($self, "$field");
 
620
            $field = $index unless $index == -1;
 
621
            croak "No such field: $field" if $field < 0 or $field >= GetFieldCount($self);
553
622
            return undef unless IsFieldSet($self, $field);
554
623
            my $type = _GetFieldType($self, $field);
555
624
            if ($type == $Geo::OGR::OFTInteger) {
563
632
            }
564
633
            if ($type == $Geo::OGR::OFTIntegerList) {
565
634
                my $ret = GetFieldAsIntegerList($self, $field);
566
 
                return @$ret;
 
635
                return wantarray ? @$ret : $ret;
567
636
            } 
568
637
            if ($type == $Geo::OGR::OFTRealList) {
569
638
                my $ret = GetFieldAsDoubleList($self, $field);
570
 
                return @$ret;
 
639
                return wantarray ? @$ret : $ret;
571
640
            }
572
641
            if ($type == $Geo::OGR::OFTStringList) {
573
642
                my $ret = GetFieldAsStringList($self, $field);
574
 
                return @$ret;
 
643
                return wantarray ? @$ret : $ret;
575
644
            }
576
645
            if ($type == $Geo::OGR::OFTBinary) {
577
646
                return GetFieldAsString($self, $field);
579
648
            if ($type == $Geo::OGR::OFTDate) {
580
649
                my @ret = GetFieldAsDateTime($self, $field);
581
650
                # year, month, day, hour, minute, second, timezone
582
 
                return @ret[0..2];
 
651
                return wantarray ? @ret[0..2] : [@ret[0..2]];
583
652
            }
584
653
            if ($type == $Geo::OGR::OFTTime) {
585
654
                my @ret = GetFieldAsDateTime($self, $field);
586
 
                return @ret[3..6];
 
655
                return wantarray ? @ret[3..6] : [@ret[3..6]];
587
656
            }
588
657
            if ($type == $Geo::OGR::OFTDateTime) {
589
658
                return GetFieldAsDateTime($self, $field);
592
661
        }
593
662
        sub UnsetField {
594
663
            my($self, $field) = @_;
595
 
            my $type = _GetFieldType($self, $field);
596
 
            my $count = GetFieldCount($self);
597
 
            $field = GetFieldIndex($self, $field) unless $field =~ /^\d+$/;
598
 
            croak("no such field: $_[1]") if $field < 0 or $field >= $count;
 
664
            my $index = GetFieldIndex($self, "$field");
 
665
            $field = $index unless $index == -1;
 
666
            croak "No such field: $field" if $field < 0 or $field >= GetFieldCount($self);
599
667
            _UnsetField($self, $field);
600
668
        }
601
669
        sub SetField {
602
670
            my $self = shift;
603
671
            my $field = $_[0];
604
 
            my $count = GetFieldCount($self);
605
 
            $field = GetFieldIndex($self, $field) unless $field =~ /^\d+$/;
606
 
            croak("no such field: $_[0]") if $field < 0 or $field >= $count;
 
672
            my $index = GetFieldIndex($self, "$field");
 
673
            $field = $index unless $index == -1;
 
674
            croak "No such field: $field" if $field < 0 or $field >= GetFieldCount($self);
607
675
            shift;
608
676
            if (@_ == 0 or !defined($_[0])) {
609
677
                _UnsetField($self, $field);
611
679
            }
612
680
            my $list = ref($_[0]) ? $_[0] : [@_];
613
681
            my $type = _GetFieldType($self, $field);
614
 
            if ($type == $Geo::OGR::OFTInteger or 
615
 
                $type == $Geo::OGR::OFTReal or 
 
682
            if ($type == $Geo::OGR::OFTInteger or
 
683
                $type == $Geo::OGR::OFTReal or
616
684
                $type == $Geo::OGR::OFTString or
617
 
                $type == $Geo::OGR::OFTBinary) 
 
685
                $type == $Geo::OGR::OFTBinary)
618
686
            {
619
687
                _SetField($self, $field, $_[0]);
620
688
            } 
643
711
                _SetField($self, $field, @$list[0..6]);
644
712
            } 
645
713
            else {
646
 
                carp "unknown/unsupported field type: $type";
 
714
                carp "unknown or unsupported field type: $type";
647
715
            }
648
716
        }
649
717
        sub Field {
668
736
            $GEOMETRIES{tied(%$geom)} = $self if $geom;
669
737
            return $geom;
670
738
        }
 
739
        sub ReferenceGeometry {
 
740
            my $self = shift;
 
741
            SetGeometryDirectly($self, $_[0]) if @_;
 
742
            if (defined wantarray) {
 
743
                my $geometry = GetGeometry($self);
 
744
                return $geometry->Clone() if $geometry;
 
745
            }
 
746
        }
 
747
        sub SetFrom {
 
748
            my($self, $other) = @_;
 
749
            _SetFrom($self, $other), return if @_ <= 2;
 
750
            my $forgiving = $_[2];
 
751
            _SetFrom($self, $other, $forgiving), return if @_ <= 3;         
 
752
            my $map = $_[3];
 
753
            my @list;
 
754
            for my $i (1..GetFieldCount($self)) {
 
755
                push @list, ($map->{$i} || -1);
 
756
            }
 
757
            SetFromWithMap($self, $other, 1, \@list);
 
758
        }
671
759
 
672
760
        package Geo::OGR::FieldDefn;
673
761
        use strict;
674
762
        use vars qw /
 
763
            @FIELD_TYPES @JUSTIFY_TYPES
675
764
            %TYPE_STRING2INT %TYPE_INT2STRING
676
765
            %JUSTIFY_STRING2INT %JUSTIFY_INT2STRING
677
766
            /;
678
 
        for my $string (qw/Integer IntegerList Real RealList String StringList 
679
 
                        WideString WideStringList Binary Date Time DateTime/) {
 
767
        use Encode;
 
768
        @FIELD_TYPES = qw/Integer IntegerList Real RealList String StringList 
 
769
                        WideString WideStringList Binary Date Time DateTime/;
 
770
        @JUSTIFY_TYPES = qw/Undefined Left Right/;
 
771
        for my $string (@FIELD_TYPES) {
680
772
            my $int = eval "\$Geo::OGR::OFT$string";
681
773
            $TYPE_STRING2INT{$string} = $int;
682
774
            $TYPE_INT2STRING{$int} = $string;
683
775
        }
684
 
        for my $string (qw/Undefined Left Right/) {
 
776
        for my $string (@JUSTIFY_TYPES) {
685
777
            my $int = eval "\$Geo::OGR::OJ$string";
686
778
            $JUSTIFY_STRING2INT{$string} = $int;
687
779
            $JUSTIFY_INT2STRING{$int} = $string;
704
796
                    }
705
797
                }
706
798
            }
707
 
            $param{Type} = $TYPE_STRING2INT{$param{Type}} if defined $param{Type} and exists $TYPE_STRING2INT{$param{Type}};
 
799
            $param{Type} = $TYPE_STRING2INT{$param{Type}} 
 
800
            if defined $param{Type} and exists $TYPE_STRING2INT{$param{Type}};
 
801
            $param{Justify} = $JUSTIFY_STRING2INT{$param{Justify}} 
 
802
            if defined $param{Justify} and exists $JUSTIFY_STRING2INT{$param{Justify}};
708
803
            my $self = Geo::OGRc::new_FieldDefn($param{Name}, $param{Type});
709
804
            if (defined($self)) {
710
805
                bless $self, $pkg;
745
840
            SetPrecision($self, $_[0]) if @_;
746
841
            GetPrecision($self) if defined wantarray;
747
842
        }
 
843
        sub Ignored {
 
844
            my $self = shift;
 
845
            SetIgnored($self, $_[0]) if @_;
 
846
            IsIgnored($self) if defined wantarray;
 
847
        }
748
848
        sub Schema {
749
849
            my $self = shift;
750
850
            if (@_) {
756
856
                $self->Precision($param{Precision}) if exists $param{Precision};
757
857
            }
758
858
            return unless defined wantarray;
759
 
            return { Name => $self->Name, 
760
 
                     Type  => $self->Type,
761
 
                     Justify  => $self->Justify,
762
 
                     Width  => $self->Width,
763
 
                     Precision => $self->Precision };
 
859
            my %schema = ( Name => $self->Name, 
 
860
                           Type  => $self->Type,
 
861
                           Justify  => $self->Justify,
 
862
                           Width  => $self->Width,
 
863
                           Precision => $self->Precision );
 
864
            return wantarray ? %schema : \%schema;
764
865
        }
765
866
 
766
867
        package Geo::OGR::Geometry;
767
868
        use strict;
768
869
        use Carp;
769
870
        use vars qw /
 
871
            @GEOMETRY_TYPES @BYTE_ORDER_TYPES
770
872
            %TYPE_STRING2INT %TYPE_INT2STRING
771
873
            %BYTE_ORDER_STRING2INT %BYTE_ORDER_INT2STRING
772
874
            /;
773
 
        for my $string (qw/Unknown 
 
875
        @GEOMETRY_TYPES = qw/Unknown 
774
876
                        Point LineString Polygon 
775
877
                        MultiPoint MultiLineString MultiPolygon GeometryCollection 
776
878
                        None LinearRing
777
879
                        Point25D LineString25D Polygon25D 
778
 
                        MultiPoint25D MultiLineString25D MultiPolygon25D GeometryCollection25D/) {
 
880
                        MultiPoint25D MultiLineString25D MultiPolygon25D GeometryCollection25D/;
 
881
        for my $string (@GEOMETRY_TYPES) {
779
882
            my $int = eval "\$Geo::OGR::wkb$string";
780
883
            $TYPE_STRING2INT{$string} = $int;
781
884
            $TYPE_INT2STRING{$int} = $string;
782
885
        }
783
 
        for my $string (qw/XDR NDR/) {
 
886
        @BYTE_ORDER_TYPES = qw/XDR NDR/;
 
887
        for my $string (@BYTE_ORDER_TYPES) {
784
888
            my $int = eval "\$Geo::OGR::wkb$string";
785
889
            $BYTE_ORDER_STRING2INT{$string} = $int;
786
890
            $BYTE_ORDER_INT2STRING{$int} = $string;
789
893
            my $self = shift;
790
894
            delete $Geo::OGR::Feature::GEOMETRIES{$self};
791
895
        }
792
 
        sub create { # alternative constructor since swig created new can't be overridden(?)
 
896
        sub create { # alternative constructor since swig created new cannot be overridden(?)
793
897
            my $pkg = shift;
794
 
            my($type, $wkt, $wkb, $gml, $json, $srs, $points);
 
898
            my($type, $wkt, $wkb, $gml, $json, $srs, $points, $arc);
795
899
            if (@_ == 1) {
796
900
                $type = shift;
797
901
            } else {
800
904
                $srs = ($param{srs} or $param{SRS});
801
905
                $wkt = ($param{wkt} or $param{WKT});
802
906
                $wkb = ($param{wkb} or $param{WKB});
803
 
                my $hex = ($param{hexwkb} or $param{HEXWKB});
 
907
                my $hex = ($param{hexewkb} or $param{HEXEWKB}); # PostGIS HEX EWKB
 
908
                substr($hex, 10, 8) = '' if $hex; # remove SRID
 
909
                $hex = ($param{hexwkb} or $param{HEXWKB}) unless $hex;
804
910
                if ($hex) {
805
911
                    $wkb = '';
806
912
                    for (my $i = 0; $i < length($hex); $i+=2) {
810
916
                $gml = ($param{gml} or $param{GML});
811
917
                $json = ($param{geojson} or $param{GeoJSON});
812
918
                $points = $param{Points};
 
919
                $arc = ($param{arc} or $param{Arc});
813
920
            }
814
921
            $type = $TYPE_STRING2INT{$type} if defined $type and exists $TYPE_STRING2INT{$type};
815
922
            my $self;
816
 
            if (defined $type) {
817
 
                croak "unknown GeometryType: $type" unless 
818
 
                    exists($TYPE_STRING2INT{$type}) or exists($TYPE_INT2STRING{$type});
819
 
                $self = Geo::OGRc::new_Geometry($type);
820
 
            } elsif (defined $wkt) {
 
923
            if (defined $wkt) {
821
924
                $self = Geo::OGRc::CreateGeometryFromWkt($wkt, $srs);
822
925
            } elsif (defined $wkb) {
823
926
                $self = Geo::OGRc::CreateGeometryFromWkb($wkb, $srs);
825
928
                $self = Geo::OGRc::CreateGeometryFromGML($gml);
826
929
            } elsif (defined $json) {
827
930
                $self = Geo::OGRc::CreateGeometryFromJson($json);
 
931
            } elsif (defined $type) {
 
932
                croak "unknown GeometryType: $type" unless 
 
933
                    exists($TYPE_STRING2INT{$type}) or exists($TYPE_INT2STRING{$type});
 
934
                $self = Geo::OGRc::new_Geometry($type);
 
935
            } elsif (defined $arc) {
 
936
                $self = Geo::OGRc::ApproximateArcAngles(@$arc);
828
937
            } else {
829
938
                croak "missing GeometryType, WKT, WKB, GML, or GeoJSON parameter in Geo::OGR::Geometry::create";
830
939
            }
832
941
            $self->Points($points) if $points;
833
942
            return $self;
834
943
        }
 
944
        sub AsHEXWKB {
 
945
            my($self) = @_;
 
946
            my $wkb = _ExportToWkb($self, 1);
 
947
            my $hex = '';
 
948
            for (my $i = 0; $i < length($wkb); $i++) {
 
949
                my $x = sprintf("%x", ord(substr($wkb,$i,1)));
 
950
                $x = '0' . $x if length($x) == 1;
 
951
                $hex .= uc($x);
 
952
            }
 
953
            return $hex;
 
954
        }
 
955
        sub AsHEXEWKB {
 
956
            my($self, $srid) = @_;
 
957
            my $hex = AsHEXWKB($self);
 
958
            if ($srid) {
 
959
                my $s = sprintf("%x", $srid);
 
960
                $srid = '';
 
961
                do {
 
962
                    if (length($s) > 2) {
 
963
                        $srid .= substr($s,-2,2);
 
964
                        substr($s,-2,2) = '';
 
965
                    } elsif (length($s) > 1) {
 
966
                        $srid .= $s;
 
967
                        $s = '';
 
968
                    } else {
 
969
                        $srid .= '0'.$s;
 
970
                        $s = '';
 
971
                    }
 
972
                } until $s eq '';
 
973
            } else {
 
974
                $srid = '00000000';
 
975
            }
 
976
            while (length($srid) < 8) {
 
977
                $srid .= '00';
 
978
            }
 
979
            substr($hex, 10, 0) = uc($srid);
 
980
            return $hex;
 
981
        }
835
982
        sub GeometryType {
836
983
            my $self = shift;
837
984
            return $TYPE_INT2STRING{$self->GetGeometryType};
882
1029
                if ($t eq 'Unknown' or $t eq 'None' or $t eq 'GeometryCollection') {
883
1030
                    croak("Can't set points of a geometry of type: $t");
884
1031
                } elsif ($t eq 'Point') {
885
 
                    $flat ? AddPoint_2D($self, @$points[0..1]) : AddPoint_3D($self, @$points[0..2]);
 
1032
                    # support both "Point" as a list of one point and one point
 
1033
                    if (ref($points->[0])) {
 
1034
                        $flat ? 
 
1035
                            AddPoint_2D($self, @{$points->[0]}[0..1]) : 
 
1036
                            AddPoint_3D($self, @{$points->[0]}[0..2]);
 
1037
                    } else {
 
1038
                        $flat ? 
 
1039
                            AddPoint_2D($self, @$points[0..1]) : 
 
1040
                            AddPoint_3D($self, @$points[0..2]);
 
1041
                    }
886
1042
                } elsif ($t eq 'LineString' or $t eq 'LinearRing') {
887
1043
                    if ($flat) {
888
1044
                        for my $p (@$points) {
934
1090
            } else {
935
1091
                $n = $self->GetPointCount;
936
1092
                if ($n == 1) {
937
 
                    push @points, $flat ? GetPoint_2D($self) : GetPoint_3D($self);
 
1093
                    push @points, $flat ? scalar GetPoint_2D($self) : scalar GetPoint_3D($self);
938
1094
                } else {
939
1095
                    my $i;
940
1096
                    if ($flat) {
941
1097
                        for my $i (0..$n-1) {
942
 
                            push @points, GetPoint_2D($self, $i);
 
1098
                            push @points, scalar GetPoint_2D($self, $i);
943
1099
                        }
944
1100
                    } else {
945
1101
                        for my $i (0..$n-1) {
946
 
                            push @points, GetPoint_3D($self, $i);
 
1102
                            push @points, scalar GetPoint_3D($self, $i);
947
1103
                        }
948
1104
                    }
949
1105
                }
955
1111
            $bo = $BYTE_ORDER_STRING2INT{$bo} if defined $bo and exists $BYTE_ORDER_STRING2INT{$bo};
956
1112
            return _ExportToWkb($self, $bo);
957
1113
        }
 
1114
        sub ForceToMultiPoint {
 
1115
            my $self = shift;
 
1116
            $self = Geo::OGR::ForceToMultiPoint($self);
 
1117
            for my $g (@_) {
 
1118
                $self->AddGeometry($g);
 
1119
            }
 
1120
            return $self;
 
1121
        }
 
1122
        sub ForceToMultiLineString {
 
1123
            my $self = shift;
 
1124
            $self = Geo::OGR::ForceToMultiLineString($self);
 
1125
            for my $g (@_) {
 
1126
                $self->AddGeometry($g);
 
1127
            }
 
1128
            return $self;
 
1129
        }
 
1130
        sub ForceToMultiPolygon {
 
1131
            my $self = shift;
 
1132
            $self = Geo::OGR::ForceToMultiPolygon($self);
 
1133
            for my $g (@_) {
 
1134
                $self->AddGeometry($g);
 
1135
            }
 
1136
            return $self;
 
1137
        }
 
1138
        sub ForceToCollection {
 
1139
            my $self = Geo::OGR::Geometry->create(GeometryType => 'GeometryCollection');
 
1140
            for my $g (@_) {
 
1141
                $self->AddGeometry($g);
 
1142
            }
 
1143
            return $self;
 
1144
        }
 
1145
        *Collect = *ForceToCollection;
 
1146
        sub Dissolve {
 
1147
            my $self = shift;
 
1148
            my @c;
 
1149
            my $n = $self->GetGeometryCount;
 
1150
            if ($n > 0) {
 
1151
                for my $i (0..$n-1) {
 
1152
                    push @c, $self->GetGeometryRef($i)->Clone;
 
1153
                }
 
1154
            } else {
 
1155
                push @c, $self;
 
1156
            }
 
1157
            return @c;
 
1158
        }
958
1159
        *AsText = *ExportToWkt;
959
1160
        *AsBinary = *ExportToWkb;
960
1161
        *AsGML = *ExportToGML;
961
1162
        *AsKML = *ExportToKML;
 
1163
        *AsJSON = *ExportToJson;
 
1164
        *BuildPolygonFromEdges = *Geo::OGR::BuildPolygonFromEdges;
 
1165
        *ForceToPolygon = *Geo::OGR::ForceToPolygon;
 
1166
        
962
1167
    }
963
1168
    sub GeometryType {
964
1169
        my($type_or_name) = @_;
985
1190
        return @drivers;
986
1191
    }
987
1192
    sub GetDriver {
988
 
        my($name_or_number) = @_;
989
 
        return _GetDriver($name_or_number) if $name_or_number =~ /^\d/;
990
 
        return GetDriverByName("$name_or_number");
 
1193
        my($name) = @_;
 
1194
        my $driver = GetDriverByName("$name");
 
1195
        $driver = _GetDriver($name) unless $driver;
 
1196
        croak "No such OGR driver: $name\n" unless $driver;
 
1197
        return $driver;
991
1198
    }
992
1199
    *Driver = *GetDriver;
993
1200
%}