Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Context-Sensitive Subroutine Dispatch

by chromatic (Archbishop)
on Dec 16, 2001 at 01:43 UTC ( #132261=snippet: print w/replies, xml ) Need Help??
Description: Here's a short module that provides something like "context polymorphism". That is, it dispatches to different subroutines depending on the calling context (list, scalar, or void). I'd like comments before submitting it to the CPAN -- especially if someone else has already put it there. (I didn't see anything.)

The latest version will generally be here.

Update: POD formatting improved based on jcwren's suggestions.

package Sub::Context;

use strict;

use vars qw( $VERSION );
$VERSION = '0.01';

sub import {
    my $class = shift;
     my $pkg = caller();

    while (@_) {
        my $subname = $pkg . '::' . shift;

        if (UNIVERSAL::isa($_[0], 'HASH')) {
            my $contexts = shift;

            if (defined &$subname) {
                for (qw( void list scalar )) {
                    $contexts->{$_} = \&$subname 
                        unless defined $contexts->{$_};
                }

                replace_glob($subname);
            }

            no strict 'refs';
            *{ $subname } = sub {
                my $context = wantarray();
                $context = (defined $context) ?
                    ($context ? 'list' : 'scalar') :
                    'void';

                my $error = "No sub for $context context";
                if (exists $contexts->{$context}) {
                    my $sub = $contexts->{$context};
                    if (defined &$sub) {
                        goto &$sub;
                    } else {
                        $error .= ": $sub";
                    }
                }
                require Carp;
                Carp::croak $error;
            };
        }
    }
}

sub replace_glob {
    my $glob = shift;
    local *NEWGLOB;

    no strict 'refs';
    foreach my $slot (qw ( SCALAR ARRAY FORMAT IO HASH ) ) {
        if (defined *{ $glob }{$slot}) {
            *NEWGLOB = *{ $glob }{$slot};
        }
    }
    *{ $glob } = *NEWGLOB;
}

'your message here, contact $AUTHOR for rates';

__END__
=head1 NAME

Sub::Context - Perl extension to dispatch subroutines based
on their calling context

=head1 SYNOPSIS

    use Sub::Context sensitive => {
        void    => \&whine,
        scalar    => \&cry,
        list    => \&weep,
    };

=head1 DESCRIPTION

Sub::Context automagically dispatches subroutine calls based 
on their calling context.  This can be handy for converting
return values or for throwing warnings or even fatal errors. 
For example, you can prohibit a function from being called
in void context.  Instead of playing around with
C<wantarray()> on your own, it's handled automatically.

=head2 EXPORT

None by default.  Simply C<use> the module and its custom
C<import()> function will handle things nicely for you.

=head1 IMPORTING

By convention, Sub::Context takes a list of arguments in
pairs.  The first item is always considered to be the name
of a subroutine.  The second item in the list is a reference 
to a hash of options for that subroutine.  For example, to create a ne
+w sub, in the calling package, named
C<penguinize>, with three existing subroutines for each of
the three types of context (void, list, and scalar), write:

    use Sub::Context
        penguinize => {
            void    => \&void_penguinize,
            list    => \&list_penguinize,
            scalar    => \&scalar_penguinize,
        };

You can provide your own subroutine references, of course:

    use Sub::Context
        daemonize => {
            list => sub { paint_red( penguinize() ) },
        };

If you are creating a new subroutine and do not provide a
subroutine reference for a context type, Sub::Context will
helpfully C<croak()> when you call the sub with the
unsupported context.  You can also provide a scalar instead
of a subref, which will be appended to the error message:

    use Sub::Context 
        daemonize => {
            list => sub { paint_red( penguinize(@_) ) },
            void => 'daemons get snippy in void context',
        };

You're not limited to creating new subs.  You can wrap
existing subs, as well.  In this release, they must be in
the calling package, but this may be fixed in
a future version.  Note that in this case, if you do not
provide a new behavior for a context type, the old behavior
will be preserved.  For example, if you have an existing sub 
that returns a string of words, you can say:

    use Sub::Context
        get_sentence => {
            list => sub { split(' ', get_sentence(@_) },
            void => 'results too good to throw away',
        };

Called in scalar context, C<get_sentence()> will behave like 
it always had.  In list context, it will return a list of
words (for whatever definition of 'words' the regex
provides).  In void context, it will croak with the provided
error message.

=head1 TODO

=over 4

=item Wrap subs in other packages

=item Allow unwrapping of wrapped subs (localized?)

=item World domination?


=back

=head1 HISTORY

=over 8

=item 0.01

Original version; created by h2xs 1.21 with options

  -C
    -A
    -X
    -n
    Sub::Context

=back

=head1 AUTHOR

chromatic, E<lt>chromatic@wgz.orgE<gt>

=head1 COPYRIGHT

Copyright 2001 by chromatic.

This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

=head1 SEE ALSO

L<perl>, C<wantarray>.

=cut
Replies are listed 'Best First'.
Re (tilly) 1: Context-Sensitive Subroutine Dispatch
by tilly (Archbishop) on Dec 16, 2001 at 03:29 UTC
    While I think this is a fun exercise, I would not want to use it. Why? Because what a function does should be similar enough in different contexts that there should be tremendous code duplication. Enough that I would discourage the unnecessary propagation of context, or the rewriting of essentially the same subroutine.

    But that philosophical issue aside, if you do put this on CPAN, I strongly suggest doing validation of the passed information. If someone accidentally types lsit instead of list, the import should catch that...

      I see the point you are making, and agree in many cases. On the other hand, I think it's interesting to play with the idea of context-sensitive polymorphism (in a sense). It's not a language feature available outside the core and magic variables, but it's emulatable. As thpfft points out, this idea lends itself to several things. This fills a slightly different niche than Want, though they could certainly be used together. Perhaps version 0.03?

      As a practical matter, I can see where it would be useful to disallow certain (expensive) functions to be called in void context, or to avoid certain operations. Maybe it's just the functional programmer in me. In most cases, it's certainly not necessary. When has that stopped us from doing something interesting?

      The point about verifying parameters is well taken, and I'll definitely add that. Thanks for the comments.

Re: Context-Sensitive Subroutine Dispatch
by thpfft (Chaplain) on Dec 16, 2001 at 03:35 UTC

    You should probably have a look at robin's Want. It's a muscular little XS module that i don't begin to understand, but it basically provides perl 6 want for perl 5. It might take the place of some of that hairy globbing, at least, and would allow you to detect list, boolean or hash context too.

(RhetTbull) Re: Context-Sensitive Subroutine Dispatch
by RhetTbull (Curate) on Dec 17, 2001 at 08:25 UTC
      Actually, if chromatic's agreeable, I'd very much like to steal the idea of contextual dispatch and roll it into the new version of Class::Multimethods that I'll be releasing early next year. With the appropriate blame attribution, of course! ;-)
        You're quite welcome to the idea. I think I'll put 0.02 up on the CPAN later in the interim and work on integrating optional Want support.

        As a side note, Class:Multimethods did lead me to this idea. :)

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2021-04-11 15:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?