[mapserver-commits] r7252 - in trunk/mapserver/mapscript/perl: .
examples
svn at osgeo.org
svn at osgeo.org
Thu Jan 10 09:37:00 EST 2008
Author: unicoletti
Date: 2008-01-10 09:37:00 -0500 (Thu, 10 Jan 2008)
New Revision: 7252
Added:
trunk/mapserver/mapscript/perl/examples/RFC24.pl
Modified:
trunk/mapserver/mapscript/perl/plmodule.i
Log:
#2442: implementation of RFC24, item 3.2 for perl
Added: trunk/mapserver/mapscript/perl/examples/RFC24.pl
===================================================================
--- trunk/mapserver/mapscript/perl/examples/RFC24.pl (rev 0)
+++ trunk/mapserver/mapscript/perl/examples/RFC24.pl 2008-01-10 14:37:00 UTC (rev 7252)
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+use mapscript;
+$file=$ARGV[0];
+
+# utility
+sub assertNotNull {
+ my ($o, $test) = @_;
+ if ($o) {
+ print $test . " PASSED\n";
+ } else {
+ print $test . " FAILED\n";
+ }
+}
+
+sub dumpHash {
+ my ($hashmap) = @_;
+ print "Dumping hashmap: $hashmap\n";
+ for my $k ( keys %$hashmap ) {
+ print "\t".$k.": ".$hashmap{$k}."\n";
+ }
+}
+
+# layerObj
+sub testGetLayerObj {
+ my $map = new mapscript::mapObj($file);
+ my $layer = $map->getLayer(1);
+ $map = undef;
+ assertNotNull( $layer->{map} , "testGetLayerObj");
+ #$layer->{map}->draw()->save("/tmp/map.png");
+}
+
+sub testGetLayerObjByName {
+ my $map = new mapscript::mapObj($file);
+ my $layer = $map->getLayerByName("POLYGON");
+ $map = undef;
+ assertNotNull( $layer->{map} , "testGetLayerObjByName");
+}
+
+sub testLayerObj {
+ my $map = new mapscript::mapObj($file);
+ my $layer = new mapscript::layerObj($map);
+ $map = undef;
+ assertNotNull( $layer->{map} , "testLayerObj");
+}
+
+sub testInsertLayerObj {
+ my $map = new mapscript::mapObj($file);
+ my $layer = new mapscript::layerObj(undef);
+ my $position = $map->insertLayer($layer);
+ $map = undef;
+ assertNotNull( $position == 7 , "testInsertLayerObj position");
+ assertNotNull( $layer->{map} , "testInsertLayerObj notnull");
+}
+
+# classObj
+sub testGetClassObj {
+ #dumpHash(mapscript::getPARENT_PTRS());
+ my $map = new mapscript::mapObj($file);
+ my $layer = $map->getLayer(1);
+ my $clazz = $layer->getClass(0);
+ #dumpHash(mapscript::getPARENT_PTRS());
+ #$clazz->{layer}->{map}->draw()->save("/tmp/map1.png");
+ #print "parent layer=".$clazz->{layer}."\n";
+ $map = undef; $layer=undef;
+ #print "parent layer=".$clazz->{layer}."\n";
+ assertNotNull( $clazz->{layer} , "testGetClassObj");
+ #$clazz->{layer}->{map}->draw()->save("/tmp/map2.png");
+ #dumpHash(mapscript::getPARENT_PTRS());
+}
+
+sub testClassObj {
+ my $map = new mapscript::mapObj($file);
+ my $layer = $map->getLayer(1);
+ my $clazz = new mapscript::classObj($layer);
+ $map = undef; $layer=undef;
+ assertNotNull( $clazz->{layer} , "testClassObj");
+}
+
+sub testInsertClassObj {
+ my $map = new mapscript::mapObj($file);
+ my $layer = $map->getLayer(1);
+ my $clazz = new mapscript::classObj(undef);
+ my $position = $layer->insertClass($clazz);
+ $map = undef; $layer=undef;
+ assertNotNull( $position == 2 , "testInsertClassObj position");
+ assertNotNull( $clazz->{layer} , "testInsertClassObj notnull");
+}
+
+if ( ! $file ) {
+ print "Usage: RFC24.pl file.map\n";
+ exit 1;
+}
+
+testGetLayerObj;
+testGetLayerObjByName;
+testLayerObj;
+testInsertLayerObj;
+testGetClassObj;
+testClassObj;
+testInsertClassObj;
+
+$hashmap=mapscript::getPARENT_PTRS();
+assertNotNull( keys( %$hashmap )==0 , "checking that hashmap of parent ptrs is empty");
+print "No of keys:".keys( %$hashmap )."\n";
+dumpHash($hashmap);
+
Modified: trunk/mapserver/mapscript/perl/plmodule.i
===================================================================
--- trunk/mapserver/mapscript/perl/plmodule.i 2008-01-08 17:04:53 UTC (rev 7251)
+++ trunk/mapserver/mapscript/perl/plmodule.i 2008-01-10 14:37:00 UTC (rev 7252)
@@ -23,3 +23,153 @@
msSetError(MS_MISCERR, "Error initializing MapServer/Mapscript.", "msSetup()");
}
%}
+
+/*
+===============================================================================
+RFC-24 implementation follows
+===============================================================================
+ Modified constructor according to:
+ - cache population and sync, item 3.2
+ - reference counter since Perl does not obey %newobject
+*/
+%allowexception;
+
+%exception layer {
+ /* Accessing layer */
+ $action;
+ MS_REFCNT_INCR(result);
+}
+%exception map {
+ /* Accessing map */
+ $action;
+ MS_REFCNT_INCR(result);
+}
+
+%feature("shadow") layerObj(mapObj *map)
+%{
+sub new {
+ my $pkg = shift;
+ my $self = mapscriptc::new_layerObj(@_);
+ bless $self, $pkg if defined($self);
+ if (defined($_[0])) {
+ # parent reference
+ mapscript::RFC24_ADD_PARENT_REF( tied(%$self), $_[0]);
+ }
+ return $self;
+}
+%}
+
+%feature("shadow") getLayer(int i)
+%{
+sub getLayer {
+ my $layer = mapscriptc::mapObj_getLayer(@_);
+ if (defined($layer)) {
+ # parent reference
+ #print "l=$layer,m=$_[0]\n";
+ mapscript::RFC24_ADD_PARENT_REF( tied(%$layer) , $_[0]);
+ }
+ return $layer;
+}
+%}
+
+%feature("shadow") getLayerByName(char* name)
+%{
+sub getLayerByName {
+ my $layer = mapscriptc::mapObj_getLayerByName(@_);
+ if (defined($layer)) {
+ # parent reference
+ #print "l=$layer,m=$_[0]\n";
+ mapscript::RFC24_ADD_PARENT_REF( tied(%$layer) , $_[0]);
+ }
+ return $layer;
+}
+%}
+
+%feature("shadow") insertLayer
+%{
+sub insertLayer {
+ my $idx = mapscriptc::mapObj_insertLayer(@_);
+ my $layer=$_[1];
+ # parent reference
+ mapscript::RFC24_ADD_PARENT_REF(tied(%$layer), $_[0]);
+ return $idx;
+}
+%}
+
+%feature("shadow") ~layerObj()
+%{
+sub DESTROY {
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ return unless defined $self;
+ delete $ITERATORS{$self};
+ mapscriptc::delete_layerObj($self);
+ # remove parent reference
+ mapscript::RFC24_DEL_PARENT_REF($self);
+}
+%}
+
+%feature("shadow") classObj(layerObj *layer)
+%{
+sub new {
+ my $pkg = shift;
+ my $self = mapscriptc::new_classObj(@_);
+ bless $self, $pkg if defined($self);
+ if (defined($_[0])) {
+ # parent reference
+ mapscript::RFC24_ADD_PARENT_REF( tied(%$self), $_[0]);
+ }
+ return $self;
+}
+%}
+
+%feature("shadow") getClass(int i)
+%{
+sub getClass {
+ my $clazz = mapscriptc::layerObj_getClass(@_);
+ if (defined($clazz)) {
+ # parent reference
+ mapscript::RFC24_ADD_PARENT_REF( tied(%$clazz) , $_[0]);
+ }
+ return $clazz;
+}
+%}
+%feature("shadow") insertClass
+%{
+sub insertClass {
+ my $idx = mapscriptc::layerObj_insertClass(@_);
+ my $clazz=$_[1];
+ # parent reference
+ mapscript::RFC24_ADD_PARENT_REF(tied(%$clazz), $_[0]);
+ return $idx;
+}
+%}
+
+%feature("shadow") ~classObj()
+%{
+sub DESTROY {
+ return unless $_[0]->isa('HASH');
+ my $self = tied(%{$_[0]});
+ return unless defined $self;
+ delete $ITERATORS{$self};
+ mapscriptc::delete_classObj($self);
+ # remove parent reference
+ mapscript::RFC24_DEL_PARENT_REF($self);
+}
+%}
+%perlcode %{
+ %PARENT_PTRS=();
+ sub RFC24_ADD_PARENT_REF {
+ my ($child, $parent)=@_;
+ $PARENT_PTRS{ $$child }=$parent;
+ }
+ sub RFC24_DEL_PARENT_REF {
+ my ($child)=@_;
+ delete $PARENT_PTRS{ $$child };
+ }
+
+ # USE THIS function only for debugging!
+ sub getPARENT_PTRS {
+ return \%PARENT_PTRS;
+ }
+%}
More information about the mapserver-commits
mailing list