Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

OO automatic accessor generation

by Neighbour (Friar)
on Nov 11, 2009 at 13:21 UTC ( [id://806486]=perlmeditation: print w/replies, xml ) Need Help??

So I've been reading up on perltoot and perltooc and have been trying to create my very first perl class.. It started like this:
package DataTable; sub new { my $class = shift; my $self = {}; $self->{tablename} = undef; $self->{columns} = []; $self->{indices} = {}; bless($self, $class); return $self; } sub tablename { my $self = shift; if (@_) { $self->{tablename} = shift; } return $self->{tablename}; } sub columns { my $self = shift; if (@_) { @{$self->{columns}} = @_; } return @{$self->{columns}}; } sub indices { my $self = shift; if (@_) { %{$self->{indices}} = @_; } return %{$self->{indices}}; } 1;
But then, after having to add more array properties (datatypes, lengths, decimals, allownull, default) and copypasting the accessor subs, something itched. So I revised it to..
package DataTable; sub new { my $class = shift; my $self = {}; $self->{tablename} = undef; $self->{columns} = []; $self->{indices} = {}; $self->{datatypes} = []; $self->{lengths} = []; $self->{decimals} = []; $self->{signed} = []; $self->{allownull} = []; $self->{default} = []; $self->{usequote} = []; } bless($self, $class); return $self; } # Accessor methods sub ArrayAccessor { my $arrayname = shift; my $self = shift; if (@_) { @{$self->{$arrayname}} = @_; } return @{$self->{$arrayname}}; } sub HashAccessor { my $hashname = shift; my $self = shift; if (@_) { %{$self->{$hashname}} = @_; } return %{$self->{$hashname}}; } sub ScalarAccessor { my $scalarname = shift; my $self = shift; if (@_) { $self->{$scalarname} = shift; } return $self->{$scalarname}; } sub tablename { return ScalarAccessor("tablename", @_); } sub columns { return ArrayAccessor("columns", @_); } sub indices { return HashAccessor("indices", @_); } sub datatypes { return ArrayAccessor("datatypes", @_); } sub lengths { return ArrayAccessor("lengths", @_); } sub decimals { return ArrayAccessor("decimals", @_); } sub signed { return ArrayAccessor("signed", @_); } sub allownull { return ArrayAccessor("allownull", @_); } sub default { return ArrayAccessor("default", @_); } sub usequote { return ArrayAccessor("usequote", @_); } 1;
However, seeing the long list of accessor function calls, I still found the need for even more abstraction:
package DataTable; sub new { my $class = shift; my $self = {}; $self->{tablename} = undef; $self->{columns} = []; $self->{indices} = {}; $self->{datatypes} = []; $self->{lengths} = []; $self->{decimals} = []; $self->{signed} = []; $self->{allownull} = []; $self->{default} = []; $self->{usequote} = []; # Automatically create Accessor methods foreach (keys(%{$self})) { my ($type, $prefix, $suffix) = (ref($self->{$_}), "", ""); if ($type eq "ARRAY") { $prefix = '@{'; $suffix = '}'; } if ($type eq "HASH") { $prefix = '%{'; $suffix = '}'; } eval("sub $_ { " . 'my $self = shift; if (@_) { ' . $prefix . '$self->{' . $_ . '}' . $suffix . +' = @_; } return ' . $prefix . '$self->{' . $_ . '}' . $suffix . '; }'); } bless($self, $class); return $self; } 1;
However, since this is my first attempt at OO-perl, I humbly submit this to the monks for comments :)

Replies are listed 'Best First'.
Re: OO automatic accessor generation
by WizardOfUz (Friar) on Nov 11, 2009 at 14:17 UTC

    You shouldn't add the accessor generation code to the constructor (unless you really want to redefine your accessor methods each time you instantiate DataTable).

    Try this:

    package DataTable;
    # Important!
    use strict;
    use warnings;
    my @ATTRIBUTES_ARRAY = qw(
    my @ATTRIBUTES_HASH = qw(
    sub new {
        my $class = shift;
        my $self = bless {}, $class;
        $self->{$_} = undef for @ATTRIBUTES_SCALAR;
        $self->{$_} = []    for @ATTRIBUTES_ARRAY;
        $self->{$_} = {}    for @ATTRIBUTES_HASH;
        return $self;
        no strict 'refs';
        for ( @ATTRIBUTES_SCALAR ) {
            my $attribute = $_;
            *{ __PACKAGE__ . '::' . $attribute } = sub {
                my $self = shift;
                $self->{$attribute} = shift if @_;
                return $self->{$attribute};
        for ( @ATTRIBUTES_ARRAY ) {
            my $attribute = $_;
            *{ __PACKAGE__ . '::' . $attribute } = sub {
                my $self = shift;
                @{$self->{$attribute}} = @_ if @_;
                return @{$self->{$attribute}};
        for ( @ATTRIBUTES_HASH ) {
            my $attribute = $_;
            *{ __PACKAGE__ . '::' . $attribute } = sub {
                my $self = shift;
                %{$self->{$attribute}} = @_ if @_;
                return %{$self->{$attribute}};

    Update: Fixed a typo

      You're right, after actually getting around to testing it with multiple instances, perl started to complain about sub redefinitions, so the constructor is not the best place to do this :)

      I've now made a base class by shamelessly copying your code :P and made a Datatable class that inherits the base class and adds SQLquery-generating subs.

      Unfortunately, it seems I will need to try both methods of OO-programming...the manual method to further my understanding of things, and using Moose to leave maintainable code for my colleagues :)

      Also, right now the automatically generated accessors don't check anything about the data they are given. This is not how it is supposed to end up (at which point I will probably have to take them out of the autogenerated batch or try something like reassigning a new sub whenever the need arises) but just to get started.

Re: OO automatic accessor generation
by Jenda (Abbot) on Nov 11, 2009 at 15:34 UTC

    Moose. And do not let the "postmodern" blurb scare you away.

    There is also Mouse and Class::Accessor.

    Enoch was right!
    Enjoy the last years of Rome.

      I really don't think that referring beginners (who want to learn OO programming in Perl) to Moose is such a good idea. In doing so, they will learn nothing (well, almost nothing) because Moose quite effectively hides Perl's OO concepts/mechanisms from them.

        I'll disagree. There's two levels of "learning" here. If you want to get stuff done, and you need to use objects and Perl, Moose is the perfect solution. If you want to learn the guts of Perl, and you know that Perl has some cool low-level technology for method dispatch, then yes, Moose is for later, not for now.

        -- Randal L. Schwartz, Perl hacker

        The key words "MUST", "MUST NOT", "REQUIRED", "SHALL", "SHALL NOT", "SHOULD", "SHOULD NOT", "RECOMMENDED", "MAY", and "OPTIONAL" in this document are to be interpreted as described in RFC 2119.

        I can think of a simple way to put it. When someone's coding class method generators, it's time to point them in another direction.
        What this guy's talking about is not simple OO. It's great to do this- write your own accessor generator- I've done this a few times. Awesome- learned a ton- but really.. I wouldn't say that writing a class construction helper is part of knowing how to write a class! :-)

Re: OO automatic accessor generation
by gnosti (Chaplain) on Nov 13, 2009 at 05:43 UTC
    Hi Neighbor,

    You write that the code you post is your first attempt at a Perl class. As a learning exercise, I think it's valuable to experiment with rolling (or stealing) your own. Perl has a minimal, to me elegant way to get object behavior.

    If you'll be playing around a bit, you might like rewriting you class a few different ways. For my simple-minded application, Audio::Nama, I found Object::Tiny's accessors and class creation to be a good starting point. I filled out Alias++'s basic code with simple set() and dump() methods, spent a few days hacking together some YAML-based serialization routines and was on my way. I may change over to Mouse or Moose at some future time.

    I found that a good environment to learn the types of compile and runtime errors I would get, how subclassing works, etc.

    Regarding your code, first, redefining a subroutine is no big deal: if it's convenient to do so, do it and suppress the warning:  no warnings 'redefine'. It's your first class, after all.

    Also you may like a more legible format for your default initializations:

    package DataTable; sub new { my $class = shift; my $self = { tablename => undef, columns => [], indices => {}, datatypes => [], lengths => [], ... }; return bless $self, $class; }

    All with a grain of salt and some monastery-brewed beer. When it comes to coding style, I am a youngster here.

OT: Random Enthusiasm
by misterwhipple (Monk) on Nov 12, 2009 at 19:12 UTC
    This is an excellent thread. This sort of civil and informative discourse is what keeps me coming back to PerlMonks. Thank you, Neighbour, for beginning it, and the rest of you for your contributions.

    Any sufficiently interesting Perl project will depend upon at least one module that doen't work on Windows.

      Well, OK, maybe not entirely civil. Mostly pretty good, though.

      Your left-hand veeblefetzer is calibrated to the wrong Frammistan coefficient. Pass me that finklegruber.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://806486]
Approved by marto
Front-paged by oha
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-06-22 13:29 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.