Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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

In reply to Re^3: Moose - my new religion by cavac
in thread Moose - my new religion by jdrago999

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (3)
    As of 2021-02-27 06:53 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found