Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
PerlMonks finally supports : shared attribute, correctly?

by liz (Monsignor)
on Sep 27, 2003 at 07:18 UTC ( #294615=perlquestion: print w/ replies, xml ) Need Help??
liz has asked for the wisdom of the Perl Monks concerning the following question:

The forks module (drop-in replacement for Perl ithreads for unthreaded Perl 5.6 and higher) only missed one feature until this morning: the ": shared" attribute.

Some background: the forks::shared module already had a "_share" subroutine that only needs a reference to the variable (either a scalar, array or hash) to be shared. This subroutine basically does a tie on the variable.

sub _share { my $it = shift; my $ref = ref $it; if ($ref eq 'SCALAR') { tie ${$it},'threads::shared',{},${$it}; } elsif ($ref eq 'ARRAY') { tie @{$it},'threads::shared',{},@{$it}; } elsif ($ref eq 'HASH') { tie %{$it},'threads::shared',{},%{$it}; } elsif ($ref eq 'GLOB') { tie *{$it},'threads::shared',{},*{$it}; } else { _croak( "Don't know how to share '$it'" ); } } #_share

So the attribute handler only needed to get the reference and act on that. No further attribute data needs to be kept.

Yesterday, I finally grokked, particularly this bit:

This method is called with two fixed arguments, followed by the list of attributes from the relevant declaration. The two fixed arguments are the relevant package name and a reference to the declared subroutine or variable. The expected return value as a list of attributes which were not recognized by this handler. Note that this allows for a derived class to delegate a call to its base class, and then only examine the attributes which the base class didn't already handle for it.

and created the following code:

BEGIN { no strict 'refs'; # same handler for all types, so we loop through them foreach my $type (qw(SCALAR ARRAY HASH)) { my $name = "UNIVERSAL::MODIFY_${type}_ATTRIBUTES"; my $old = \&$name; # Install our new attribute handler *$name = sub { my ($package,$ref,@attribute) = @_; _share( $ref ) if grep m#^shared$#, @attribute; # handle other attributes, is this needed? if (@attribute = grep !m#^shared$#,@attribute) { @attribute = $old->( $package,$ref,@attribute ); } return @attribute; } #$name } } #BEGIN

Now, what I'm wondering about is whether I should capture the code reference of the "old" handler, and pass on the remaining attributes to it. Or whether that this is somehow handled automatically.

If it is not needed, I'd like to remove it of course. But if it is needed and people use other attribute handlers, than that may cause the other attribute handlers not to be called and thus break other modules.

If this is a piece of solid code, I was thinking of using this approach for other attributes and/or generalizing this into a module.

Finally, yes I know about Attribute::Handlers, but since I'm only interested in tieing the reference, it seems like overkill to me. Especially looking at the compactness of the code I've created now.


Comment on finally supports : shared attribute, correctly?
Select or Download Code
Replies are listed 'Best First'.
Re: finally supports : shared attribute, correctly?
by scrottie (Scribe) on Sep 28, 2003 at 12:47 UTC
    Hi, interesting module! I'll certainly have to check that out. Have you looked at Coro? I'm groovin' on that big time =)

    If you were working in your own package and not inheriting anything, there would never be anything there. Since you're doing this in main or someone elses package, they might, or they might be inheriting something else that does. That wouldn't show up as a symbol table entry - you'd have to do:
    - in addition to what you're doing - just to be safe. But this assumes that other people are playing by the rules, too. Exporting is messy business. I'm not an expert.

    In's import(), I'm doing:
    push @{$caller.'::ISA'}, 'typesafety';
    When people "use typesafety", their module is coerced into inherting from it as well, making my MODIFY_foo_ATTRIBUTES visible from their package without exporting it at all. However, something like you're doing would mask it and things would break. Other people with other modules that add attributes to other peoples code might be doing what you're looking for - exporting MODIFY_foo_ATTRIBUTES directly into the using module.

    Off on a tangent (as usual), reading Arthur Bergman's code in, I discovered a very nifty trick (actually a few!)

    Crawling the byte code tree using B/B::Generate,
    my $name = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$targ]; return unless $name->can('SvSTASH'); my $type = $name->SvSTASH->NAME;
    For any given targ ($opcode->targ(), the "target", or index of a lexical variable in the current padlist - in other words, a "my" variable), you can see which package it was declared as being in using the new "my" syntax:

    my FooBar $bar;
    Given the targ index of "$bar" in the current pad, we can find out that "$bar" is supposed to be a FooBar!

    Because of this, I'm able to drop use of attributes from typesafety (and Mr. Bergman was able to avoid them entirely in the first place).

    Of course, you probably aren't crawling the bytecode tree with B::Generate, but I thought this was an intersting footnote =)


Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://294615]
Approved by PodMaster
Front-paged by broquaint
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (6)
As of 2015-11-29 00:57 GMT
Find Nodes?
    Voting Booth?

    What would be the most significant thing to happen if a rope (or wire) tied the Earth and the Moon together?

    Results (746 votes), past polls