Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Dynamically generate setter/getter methods

by stevieb (Canon)
on Dec 20, 2020 at 09:03 UTC ( #11125488=CUFP: print w/replies, xml ) Need Help??

This isn't really a cool use for Perl, but more of a cool use of Perl.

I was making some updates to my Hook::Output::Tiny software, in which I have a couple of subs that do the exact same thing, but the names are different. One thing I like to do in cases such as this is auto generate the subs dynamically.

For example... you've got a module that has subs one(), two(), three() etc, and they all do the same thing... accept an optional value to stash into the object (setter), and return the value (getter). Each sub has the same (or perhaps different) default values. I always use the old-fashioned Perl way of writing OO code, so that would look like this:

sub one { my ($self, $value) = @_; $self->{one} = $value if defined $value; return $self->{one} // 1; } sub two { my ($self, $value) = @_; $self->{two} = $value if defined $value; return $self->{two} // 2; } # and so on...

That gets tedious and frustrating, and is prone to mistypes and other mistakes. What I often do in cases such as this, is auto generate these types of subs within a BEGIN block dynamically, using the magical no strict 'refs';, which allows us to muck with the symbol table directly and do very dangerous stuff in ways that one shouldn't normally do. Here's an example module:

package Dynamic; use warnings; use strict; BEGIN { my %sub_info = ( one => 1, two => 2, three => 3, four => 4, five => 5, ); no strict 'refs'; for (keys %sub_info) { my $sub_name = $_; # Take a copy of the key, which is the sub +name *$_ = sub { my ($self, $value) = @_; $self->{$sub_name} = $value if defined $value; return $self->{$sub_name} // $sub_info{$sub_name}; }; } } sub new { return bless {}, $_[0]; } 1; __END__

First, we set things up near the top of the file so it's easily visible within a BEGIN block to ensure the code is compiled first. Here's what's happening:

  • %sub_info is a hash that contains each sub name as the key, and the default value we'll return if the user doesn't change it
  • We disable strict's reference checking with no strict 'refs' so that we can perform super-dangerous stuff, like using a string as a symbol reference
  • Iterate over the hash and copy the key name into a separate variable
  • Set the current key name as the name of the new subroutine by prepending an asterisk to signify a symbol table entry, and assign it a new anonymous sub
  • Just like any other method, we put the code in exactly as we would if we were manually writing it out. Note the use of $sub_name instead of using just $_. This is because we've clobbered $_ by assigning a sub to it. This is why we made a copy of it above
  • Done! Looks just like any other setter/getter, but instead of typing out five subs that look near identical, we've only typed it out once, and let Perl write them for us in a loop

Here's a script that puts the new module into action. Note that both the module and script are in the same directory for this demonstration:

use warnings; use strict; use feature 'say'; use lib '.'; use Dynamic; my $dyn = Dynamic->new; say "Manual calls"; say $dyn->one; say $dyn->two; # Or even say "Stringified calls"; for (qw(one two three four five)) { if ($_ eq 'three') { # Update the value of the 'three' method $dyn->three(99); } printf "sub $_: %d\n", $dyn->$_(); }


spek@scelia ~/repos/scripts/perl/dynamically_auto_generate_subs $ perl + Manual calls 1 2 Stringified calls sub one: 1 sub two: 2 sub three: 99 sub four: 4 sub five: 5

In closing, if you're only doing a couple of subs, it probably isn't worth the hassle, but when you are doing several, it makes things very simple, especially if you need to add new ones in the future. You simply have to enter a new record into the hash.

Here's the code section that I just wrote that inspired me to write this post. It's from my Hook::Output::Tiny distribution. I am dynamically creating four methods... stdout() and stderr() which effectively do the same thing but act on different things, and their helper counterparts _stdout() and _stderr():

BEGIN { # Auto generate the stdout() and stderr() methods, and their priva +te # helper counterparts no strict 'refs'; for ('stdout', 'stderr') { my $sub_name = $_; # Public *$_ = sub { my ($self) = @_; if (! wantarray) { warn "Calling $sub_name() in non-list context is depre +cated!\n"; } return defined $self->{$sub_name}{data} ? split /\n/, $self->{$sub_name}{data} : @{[ () ]}; # Empty list }; # Private my $private_sub_name = "_$sub_name"; *$private_sub_name = sub { my ($self) = @_; my $HANDLE = uc $sub_name; open $self->{$sub_name}{handle}, ">&$HANDLE" or die "can't hook " . uc $sub_name . ": $!"; close $HANDLE; open $HANDLE, '>>', \$self->{$sub_name}{data} or die $!; }; } }
Disclaimer: I'm not joking about hacking at the symbol table directly in ways perl doesn't normally allow being dangerous. It's very easy to clobber stuff far away in your code when you do these things.

Replies are listed 'Best First'.
Re: Dynamically generate setter/getter methods [Updated]
by jo37 (Hermit) on Dec 20, 2020 at 10:23 UTC

    You could use AUTOLOAD to avoid hacking the symbol table.

    One of our fellow monks asked for an example. So here is very simplified one.

    #!/usr/bin/perl use v5.12; use warnings FATAL => 'all'; package Attr; use Carp; my %attr = (one => 1, two => 2); sub new { my $class = shift; bless {}, $class; } our $AUTOLOAD; # Generic setter/getter sub AUTOLOAD { my $self = shift; my $called = $AUTOLOAD =~ s/.*:://r; croak "$AUTOLOAD: no such method" unless exists $attr{$called}; if (@_ > 0) { $self->{$called} = shift; } else { return $self->{$called}; } } package main; my $attr = Attr->new; $attr->one('uno'); say $attr->one; eval {say $attr->three}; say $@ if $@; __DATA__ uno Attr::three: no such method at /home/jo/Programs/play-scripts/pm-11125 line 38.


      The AUTOLOAD approach has some caveats to be aware of:

      1. It will be marginally slower because each call to the accessor will search the inheritance tree before calling AUTOLOAD

      2. Querying the object with can will return a false result, which is probably not what users of the object would expect.

        Thanks Arunbear. I thought about this a bit more, and I almost feel I dabbled with AUTOLOAD quite some years ago, but found deficiencies that prevented me from using it. That said, I very well could be off my rocker and thinking about something else. I will give it a try though and see how it goes.

      I learned and used the AUTOLOAD methodolgy for the first time when I was developing the Editor component for Win32::Mechanize::NotepadPlusPlus.

      For that, I was mapping a pre-defined list of function prototypes I was stealing from drawing on from the API for a Notepad++ plugin which used some other language for automating Notepad++, and mapping those prototypes to the underlying Windows messages for the Scintilla component of Notepad++; there were about 10 common mappings from function requirements to message requirements. So, when I saw I had hundreds (over a thousand, I think but I didn't re-count) of functions which were just going to follow the same 10 or so patterns, I wanted to obey DRY, so decided I had to finally figure out what AUTOLOAD was, and whether it would help me.

      If AUTOLOAD hadn't done what I wanted, I would have just manipulated the symbol table myself... but since AUTOLOAD was a feature of Perl that I hadn't explored, I wanted to see if I could make it work. In the end, AUTOLOAD wasn't that hard for me to learn, and it accomplished my goal pretty handily.

      I wouldn't call myself an AUTOLOAD expert, nor do I know all the times when it's benefits would really shine, but I found it a useful tool -- and now I have an example implementation that I should theoretically understand a few years down the road, the next time I want to try to AUTOLOAD.

      What's the fun in living if you're not living dangerously? ;)

      In all seriousness, thanks for posting this. In all my years, I never looked into AUTOLOAD, so 20 years in, and I'm still learning new things!



        ... I never looked into AUTOLOAD ...

        Have a look at this node for a slightly funny use of AUTOLOAD.

        perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2021-12-03 06:18 GMT
Find Nodes?
    Voting Booth?
    R or B?

    Results (28 votes). Check out past polls.