[RFC][PATCH] Enhanced small enhancement for Glib::Object::Subclass

[Jan Hudec <bulb ucw cz>]

Hello All,

I have created new, optimized, version of my previsous patch.

It keeps the semantics (except getters and setters can't be overriden by
inheritance -- well, that's what globs are for) of the previous patch.
That is default GET_PROPERTY/SET_PROPERTY will call GET_$propname resp.
SET_$propname, if they are defined. However, it is now optimized.

The basic idea is, that when we set GET_PROPERTY/SET_PROPERTY in
check-block generated by import, we can do the same with the individual
getters/settters.

The getters and setters are closures, so they don't need to call
->get_name second time. The GET/SET_PROPERTY are closures too, so they
know the right package (it can't be easily found from $self).

-------------------------------------------------------------------------------
                                                 Jan 'Bulb' Hudec <bulb ucw cz>

--- orig/Subclass.pm    2004-04-12 01:03:07.000000000 +0200
+++ mod/Subclass.pm     2004-05-11 22:55:38.000000000 +0200
@@ -143,10 +143,24 @@
 
 Get a property value, see C<SET_PROPERTY>.
 
-The default implementation looks like this:
+The default implementation calls function C<&{"GET_".$pspec->get_name}>.
 
-   my ($self, $pspec) = @_;
-   return $self->{$pspec->get_name};
+=item GET_$propname $self, $pspec                         [not a method]
+
+This will be called by default C<GET_PROPERTY> for property $propname. It
+should return the property value. $propname is exactly as given in the property
+declaration, including possible non-word characters. These functions are not
+used if you define C<GET_PROPERTY>.
+
+The default implementation just retrns:
+
+    $self->{$propname}
+
+Note, that $propname is not passed as argument.
+
+Also note, that perl can handle symbols with funny names (eg. containing C<->).
+Just you can only access them with symbolic references. The C<GET/SET_PROPERTY>
+do exactly that.
 
 =item SET_PROPERTY $self, $pspec, $newval                 [not a method]
 
@@ -162,10 +176,22 @@
 default get and set methods store property data in the object as hash
 values named for the parameter name.
 
-The default C<SET_PROPERTY> looks like this:
+The default implementation calls function C<&{"SET_".$pspec->get_name}>.
+
+=item SET_$propname $self, $newval, $pspec                [not a method]
+
+This will be called by default C<SET_PROPERTY> for property $propname. It
+should set new value of the property. $propname is exactly as given in the
+property declaration, including possible non-word characters. These functions
+are not used if you define C<SET_PROPERTY>.
 
-   my ($self, $pspec, $newval) = @_;
-   $self->{$pspec->get_name} = $newval;
+Default implementation does just:
+
+    $self->{$propname} = $newval
+
+Again, note that $propname is not passed as argument. Also note, that the order
+of arguments is reversed from C<SET_PROPERTY>, so you can simply ignore the
+$pspec.
 
 =item FINALIZE_INSTANCE $self                             [not a method]
 
@@ -198,26 +224,37 @@
 
 *new = \&Glib::Object::new;
 
-sub GET_PROPERTY {
-   my ($self, $pspec) = @_;
-   $self->{$pspec->get_name};
-}
-
-sub SET_PROPERTY {
-   my ($self, $pspec, $newval) = @_;
-   $self->{$pspec->get_name} = $newval;
-}
-
 sub import {
    my ($self, $superclass, %arg) = @_;
    my $class = caller;
 
+   my @props = map { $_->get_name(); } @{$arg{properties}};
    # the CHECK callback will be executed after the module is compiled
    my $check = sub {
       # "optionally" supply defaults
-      for (qw(new GET_PROPERTY SET_PROPERTY)) {
-         defined &{"$class\::$_"}
-            or *{"$class\::$_"} = \&$_;
+      # default for new...
+      *{"$class\::new"} = \&new unless(defined &{"$class\::new"});
+      # default for GET_PROPERTY ...
+      unless(defined &{"$class\::GET_PROPERTY"}) {
+        *{"$class\::GET_PROPERTY"} = sub { # (0:self, 1:pspec)
+           &{"$class\::GET_".$_[1]->get_name}(@_); 
+        };
+        # default GET_PROPERTY requires getters...
+        for my $p (@props) {
+           defined &{"$class\::GET_$p"}
+              or *{"$class\::GET_$p"} = sub { $_[0]->{$p}; };
+        }
+      }
+      # default for SET_PROPERTY  ...
+      unless(defined &{"$class\::SET_PROPERTY"}) {
+        *{"$class\::SET_PROPERTY"} = sub { # (0:self, 1:pspec, 2:newval)
+           &{"$class\::SET_".$_[1]->get_name}($_[0], $_[2], $_[1]);
+        };
+        # default SET_PROPERTY requires setters...
+        for my $p (@props) {
+           defined &{"$class\::SET_$p"}
+              or *{"$class\::SET_$p"} = sub { $_[0]->{$p} = $_[1]; };
+        }
       }
    };
    eval "package $class; CHECK { &\$check }";

Attachment: signature.asc
Description: Digital signature