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

Re^3: Moose - my new religion

by cavac (Chaplain)
on Jan 08, 2012 at 16:00 UTC ( #946877=note: print w/ replies, xml ) Need Help??


in reply to Re^2: Moose - my new religion
in thread Moose - my new religion

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).

"Believe me, Mike, I calculated the odds of this succeeding against the odds I was doing something incredibly stupidů and I went ahead anyway." (Crow in "MST3K The Movie")


Comment on Re^3: Moose - my new religion
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://946877]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (7)
As of 2014-07-12 06:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (238 votes), past polls