All the Perl that's Practical to Extract and Report

$object-can_any(@methods);

Ovid on 2007-08-14T15:30:51

Recently I found myself writing this:

return [
    map { $_->can('string') ? $_->string : $_->heredoc }
      @{ $doc->find('Token::Quote')   || [] },
      @{ $doc->find('Token::HereDoc') || [] }
];

I didn't quite like that ternary operator there, so I thought the following might be useful:

if ( my $method = $object->can_any(qw(string as_string)) ) {
    $object->$method;
}
if ( my @method = $object->can_any(qw(string as_string)) ) {
    $object->$_ foreach @method;
}

That gives me this:

my @method = qw(string heredoc);
return [
    map { my $method = $_->can_any(@method); $_->$method }
      @{ $doc->find('Token::Quote')   || [] },
      @{ $doc->find('Token::HereDoc') || [] }
];

I'm not sure that's much better, but with a huge list of objects offering differing stringification methods (or other conceptually similar methods), maybe it would be useful?

Sure...

jk2addict on 2007-08-14T17:40:49

Just add can_any() in a patch to UNIVERSAL::can, and use Test::MockObject and you're set. ;-)

Re:Sure...

Ovid on 2007-08-14T17:57:21

Personally, I think if anyone wants generic functionality like this they should put it in something like a My::UNIVERSAL class and have all objects inherit from that instead. That way, you don't risk breaking CPAN classes which, by default, inherit from UNIVERSAL.

Useful? Dunno

ferreira on 2007-08-14T18:27:37

But amusing and too easy to write down. Well, my first implementation only did the scalar context case. The second left me hanging between a do-it-all implementation which was not very clear to read and another with auxiliary methods can_oneof and can_someof. The third implementation prevented me of using my @a; for ( @_ ) { ...; push @a, ... }; return @a instead of a proper map. This is it.

package USUAL;

sub can_any {
    return wantarray ? goto &can_someof : goto &can_oneof;
}

sub can_oneof {
    my $self = shift;
    for ( @_ ) {
        my $can = $self->can($_);
        return $can if $can;
    }
    return;
}

sub can_someof {
    my $self = shift;
    return map { $self->can($_) // () } @_;
}

1;
Now insert USUAL into the @ISA array of the package to which belongs the object you are querying about. Yes, I resisted the sin of adding those methods into UNIVERSAL.

This asymmetrical implementation with a for for the scalar case and a map for the list context made me want a method which did the map job but got rid of the undefs and a scalar equivalent which returned the first defined result value. I reread the docs of List::Util and List::MoreUtils but they did not help me.

With such methods, the implementation above would look like:

sub can_oneof {
    my $self = shift;
    return first_defined_value { $self->can($_) } @_;
}

sub can_someof {
    my $self = shift;
    return defined_values { $self->can($_) } @_;
}

Now that's much more functional-stylish.

Approaches

Aristotle on 2007-08-14T19:59:23

The right way to do this would be Replace Conditional With Polymorphism… that is, if feasible/sensible, wrap the objects in other objects which all have a stringify method that delegates to the right method in the wrapped object.

But doing it for just this one instance, of course, is way too much effort.

And I find that can is often the wrong tool when I’m just trying to do something, regardless of how it gets done. Usually, eval is better suited to that job, although in this case it is so unwieldy that I’d reach for tricks:

sub try::method {
    my $self = shift;
    for my $method ( @_ ) {
        return sub { $self->$method( @_ ) } if $self->can( $method );
    }
    my $class = ref( $self ) || $self;
    croak qq{Can't locate any of the object methods "@$methods" via package "$class"};
}

return [
    map  { $_->try::method( qw( string heredoc ) )->() }
    map  { @$_ }
    grep { defined }
    map  { $doc->find( $_ ) }
    qw( Token::Quote Token::HereDoc ),
];

But in Perl 5.10, which is going to have defined-or, I’d write that without cleverness:

return [
    map  { eval { $_->string } // eval { $_->heredoc } }
    map  { @$_ }
    grep { defined }
    map  { $doc->find( $_ ) }
    qw( Token::Quote Token::HereDoc ),
];

Re:Approaches

Ovid on 2007-08-14T21:48:55

You know, that might make an interesting generic class. Something which, given a list of classes, can automatically set up common delegate methods to allow the language to work out the logic rather than the programmer. It reminds me of a few programmers I've spoken with who don't seem to understand the value of how many OO languages can properly dispatch on signature to identically named methods. Pushing conditional logic into the language's hands rather than the programmer's is definitely the way to go.

Re:Approaches

Aristotle on 2007-08-15T00:35:13

And matching on the signature alone is pretty rudimentary. Real magic happens when you do actual structural matching, à la Haskell f.ex.

Re:Approaches

Aristotle on 2007-08-19T17:36:19

Courtesy of Matt Trout here is an evil trick to enables a different kind of syntax…

sub try::method {
    my $self = shift;
    for my $method ( @_ ) {
        return \sub { $self->$method( @_ ) } if $self->can( $method );
    }
    my $class = ref( $self ) || $self;
    croak qq{Can't locate any of the object methods "@$methods" via package "$class"};
}

return [
    map  { $_->${try::method qw(string heredoc)}() }
    map  { @$_ }
    grep { defined }
    map  { $doc->find( $_ ) }
    qw( Token::Quote Token::HereDoc )
];

Re:Approaches

Ovid on 2007-08-19T19:47:29

When I wrote App::Pgrep, I chose a different route. I have a hash which resembles this (there are other keys in the hash which I've removed for clarity):

%HANDLER_FOR = (
    quote   => { stringify => sub { shift->string } },
    heredoc => {
        stringify => sub {

            # heredoc lines are terminated with newlines
            my @strings = shift->heredoc;
            return join '' => @strings;
        },
    },
    pod     => {
        stringify => sub {

            # pod lines lines are *not* terminated with newlines
            my @strings = shift->lines;
            return join "\n" => @strings;
        },
    },
    comment => { stringify => sub { shift->content } }
);

sub _to_string {
    my ( $class, $token_name, $token ) = @_;
    if  ( my $to_string = $class->handler_for($token_name)->{stringify} ) {
        return $to_string->($token);
    }
    $class->_croak("Cannot determine to_string method for ($token_name)");
}

And the code which uses it:

foreach my $token ( $self->look_for ) {
    my $class     = $self->_class_for($token);
    my @found = @{ $doc->find($class) || [] };
    my @results;
    foreach my $result (@found) {
        $result = $self->_to_string( $token, $result );
        next unless $result =~ $pattern;

        # a tiny optimization
        if ( $self->filename_only ) {
            return $found;
        }
        push @results => $result;
    }
    $found->add_results( $token => \@results ) if @results;
}

From there, when I want to add new things in Perl documents to search for, I just drop them in the hash and the ugliness goes away.

Re:Approaches

Aristotle on 2007-08-20T00:36:38

Hmm, I seem to remember muttering something to do with polymorphism on this thread…

sub TokenHandler::quote::stringify { shift->string }

sub TokenHandler::heredoc::stringify {
    # heredoc lines are terminated with newlines
    my @strings = shift->heredoc;
    return join '' => @strings;
}

sub TokenHandler::pod::stringify {
    # pod lines lines are *not* terminated with newlines
    my @strings = shift->lines;
    return join "\n" => @strings;
}

sub TokenHandler::comment::stringify { shift->content }

sub _to_string {
    my ( $class, $token_name, $token ) = @_;
    my $handler = "TokenHandler::$token_name";
    eval { return $handler->stringify($token) };
    $class->_croak("Cannot determine to_string method for ($token_name)");
}

:-)

Re:Approaches

Ovid on 2007-08-20T21:44:17

I was going to change the code when I remembered why I didn't go this route: I didn't want to add code directly to the classes. What if Adam adds a stringify method? What if I forget one and there's some crazy AUTOLOAD method? What if at some point in the future I wanted to swap in a class with an identical interface? By adding just a tiny bit of infrastructure, I can sidestep these issues. I wasn't terribly worried about them in the specific case of PPI, but in the general case, I'm extremely gun shy about reaching into classes I don't directly control.

Re:Approaches

Aristotle on 2007-08-20T22:57:16

What if Adam adds a stringify method?

Huh? What does that have to do with the code I wrote?

Re:Approaches

Ovid on 2007-08-21T06:00:42

Again, it's probably not an issue with the particular example in hand, but if I add methods directly to a class and someone else comes along and adds identically named methods, I have no guarantee that my method will behave the same way their method does. When their other methods try to call the method and get mine, who knows what happens?

Thus, I really don't feel comfortable reaching directly into another package (though traits are OK because you (mostly) get the compile-time safety).

Re:Approaches

Aristotle on 2007-08-21T06:23:44

I’m trying to follow what you are talking about. Who else than you would be adding methods to your own classes?

Re:Approaches

Ovid on 2007-08-21T06:54:18

Ah, sheesh. Now I see the disconnect. I skimmed your code (thinking that I had already seen stuff like this before) and I had read TokenHandler::pod::stringify as PPI::Token::Pod::stringify. Just shoot me now, will you? I was surprised that you had suggested this. Now I know why :)

Re:Approaches

Aristotle on 2007-08-22T09:34:29

Ah, now it makes sense.

Yeah, I definitely would not suggest that! (Considering how much I lambast the Ruby crowd for making a mindless habit of it…)

I just thought that, well, you need a dispatch at that point, and your table is static, so why not let Perl do the job? I find the resulting code a good deal less ugly too, although that is certainly debatable.