Re^3: Moose - my new religion

[cavac]

I value your input. Thanks!

Update: Seems like this reply is getting the odd negative vote. I agree that this post may not be to the likings of everybody. And you're in your rights to give me negative votes. But i'll ask you to add a comment explaining what you didn't like about it so i can use it as a learning experience.

My programs usually have very few traditional getter/setter constructs. These days, i mostly work with multiple processes (prefork stuff), so i do more or less all data exchange though DBI or Memcached (depending on if the data needs to be valid all the time or is just for debugging or non-critical single user settings).

If i need to add multiple similar functions (in this case specifying a modular plugin API) i do something like this:

# Somewhere very visible...
my @autosubs;
BEGIN {
    @autosubs = qw(blacklist floodcheck viruscheck spamcheck headers s
+ubject body sender recievers);
}

# At the end of the package...
BEGIN {
    # READ THIS CAREFULLY
    #
    # Auto-magically generate a number of similar plugin register func
+tions without
    # actually writing them down one-by-one. This makes consistent cha
+nges much easier,
    # but you need Perl wizardry level +12 to understand how it works.
    #
    # Since *you* don't actually exist at the time of writing (me, cav
+ac, being the only
    # team member), it is *your* fault for not showing up and writing 
+a better solution ;-)

    no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStr
+ict)
    
    # -- Deep magic begins here...
    
    for my $a (@autosubs){
        *{__PACKAGE__ . "::add_$a"} =
            sub {
                my %conf = (
                    Module  => $_[1],
                    Function=> $_[2],
                );
                push @{$_[0]->{plugins}->{$a}}, \%conf;
            };
    }
    # ... and ends here
}

I agree, it's a little more cryptic than the Moose getter/setter example, but it's quite flexible. Here's a more complex (but much older) example on how i add many (not all!) functions for PostgreSQL access to a Maplat::Worker BaseModule. This does a little bit more that just passing arguments - it automatically tries to reconnect to the database in case of error and stores the handle as the new persistent connection. This would probably a good candidate for trying out the "before $method" system you explained.

BEGIN {
    my @stdFuncs = qw(prepare prepare_cached do quote);
    my @simpleFuncs = qw(commit rollback errstr);
    my @varSetFuncs = qw(AutoCommit RaiseError);
    my @varGetFuncs = qw();

    for my $a (@simpleFuncs){
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitN
+oStrict)
        *{__PACKAGE__ . "::$a"} = sub { $_[0]->checkDBH(); return $_[0
+]->{mdbh}->$a(); };
    }
        
    for my $a (@stdFuncs){
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitN
+oStrict)
        *{__PACKAGE__ . "::$a"} = sub { $_[0]->checkDBH(); return $_[0
+]->{mdbh}->$a($_[1]); };
    }

    for my $a (@varSetFuncs){
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitN
+oStrict)
        *{__PACKAGE__ . "::$a"} = sub { $_[0]->checkDBH(); return $_[0
+]->{mdbh}->{$a} = $_[1]; };
    }
    
    for my $a (@varGetFuncs){
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitN
+oStrict)
        *{__PACKAGE__ . "::$a"} = sub { $_[0]->checkDBH(); return $_[0
+]->{mdbh}->{$a}; };
    }
    
    ### BLOB handling primitives ###
    my @blobFuncs = qw(write read lseek tell close unlink import expor
+t);
    {
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitN
+oStrict)

        *{__PACKAGE__ . "::pg_lo_creat"} = sub {
            $_[0]->checkDBH();
            return $_[0]->{mdbh}->pg_lo_creat($BLOBMODE);
        };

        *{__PACKAGE__ . "::pg_lo_open"} = sub {
            $_[0]->checkDBH();
            return $_[0]->{mdbh}->pg_lo_open($_[1], $BLOBMODE);
        };

    }
     
    for my $a (@blobFuncs){
        no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitN
+oStrict)
        $a = "pg_lo_$a";
        *{__PACKAGE__ . "::$a"} = sub {
            my ($self, @args) = @_;
            $self->checkDBH();
            return $self->{mdbh}->$a(@args);
        };
    }
}

Again, this does not "look as nice as Moose", but it gets the job done and it's very flexible.

As for a look at my "more typical" getter/setter pair for passing around data, here's a simple example that implements a PostgreSQL backed MemCache data store (there's more to it, here's just the core functionality):

sub get {
    my ($self, $key) = @_;
    
    $key = $self->sanitize_key($key);

    my $dbh = $self->{server}->{modules}->{$self->{db}};
    my $memh = $self->{server}->{modules}->{$self->{memcache}};

   # Try memcached first
    my $dataref = $memh->get($key);
    if(defined($dataref)) {
        return Maplat::Helpers::DBSerialize::dbthaw($dataref);
    }

   # Ok, try DB
   my $sth = $dbh->prepare_cached("SELECT yamldata FROM memcachedb WHE
+RE mckey = ?")
         or croak($dbh->errstr);
   $sth->execute($key) or croak($dbh->errstr);
   while((my @line = $sth->fetchrow_array)) {
      $dataref = $line[0];
      last;
   }
   $sth->finish;
   $dbh->rollback;

   # Ok, now also store data in memcached
   if(defined($dataref)) {
      $memh->set($key, $dataref);
      return Maplat::Helpers::DBSerialize::dbthaw($dataref);
   }

   return;
}

sub set { ## no critic (NamingConventions::ProhibitAmbiguousNames)
    my ($self, $key, $data) = @_;

    $key = $self->sanitize_key($key);
    my $dbh = $self->{server}->{modules}->{$self->{db}};
    my $memh = $self->{server}->{modules}->{$self->{memcache}};

    my $yamldata = Maplat::Helpers::DBSerialize::dbfreeze($data);

    # Check if it already matches the key we have
    my $olddata = $memh->get($key);
    if(defined($olddata) && $olddata eq $yamldata) {
        return 1;
    }
 
    $memh->set($key, $yamldata);   
       
    my $sth = $dbh->prepare_cached("SELECT merge_memcachedb(?, ?)")
            or return;
    my $count = 0;
    my $ok = 0;
    while($count < $RETRY_COUNT) {
        # print STDERR "WORKER: Merge $key\n";
        if($sth->execute($key, $yamldata)) {
            $ok = 1;
            $sth->finish;
            $dbh->commit;
            last;
        } else {
            $count++;
            $sth->finish;
            $dbh->rollback;
            if($count < $RETRY_COUNT) {
                sleep($RETRY_WAIT); # try again in a short time
            }
        }
    }
    if(!$ok) {
        croak($dbh->errstr);
    }
    
    return 1;
}

Disclaimer: I am aware that there is a possibility that the data can get out of sync, this is only used for fast sharing of non-critical data like custom user settings. Speed is more important than perfection here. But the user would have to post the same form at the same time from multiple tabs with different settings and the first process to update the data would have to hand long enough between execute() and commit() for the second process to time out...

Update 2: Added readmore tags

I don't think i have more than a dozen really classical getter/setters in my 40.000+ lines of Maplat Perl code (OSS + DarkPAN).