File Coverage

blib/lib/Params/Callbacks.pm

Criterion	Covered	Total	%
statement	41	45	91.1
branch	7	12	58.3
condition	6	9	66.6
subroutine	11	11	100.0
pod	5	5	100.0
total	70	82	85.3

package Params::Callbacks;

# Copyright (c) 2012-2015 Iain Campbell. All rights reserved.
#
# This work may be used and modified freely, but I ask that the copyright
# notice remain attached to the file. You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

=pod

=encoding utf-8

=head1 NAME

Params::Callbacks - Make your subroutines accept blocking callbacks

=head1 VERSION

version 2.002004

=head1 SYNOPSIS

    use Params::Callbacks 'callbacks', 'callback';  # Or use ':all' tag
    use Data::Dumper;

    $Data::Dumper::Indent = 0;
    $Data::Dumper::Terse  = 1;

    sub foo
    {
        my ( $callbacks, @params ) = &callbacks;
        # If &callbacks makes the hairs
        # on your neck standp, then use
        # a cleaner alternative:
        #
        # - callbacks(@_), or ...
        # - Params::Callbacks->new(@_)

        return $callbacks->transform(@params);
    }

    # No callbacks; no change to result!
    my @result_1 = foo( 0, 1, 2, 3 );
    print Dumper( [@result_1] ), "\n";  # [0,1,2,3]

    # With callback, result is transformed before being returned!
    my @result_2 = foo( 0, 1, 2, 3, callback { 0 + 2 ** $_ } );
    print Dumper( [@result_2] ), "\n";  # [1,2,4,8]

    # With multiple callbacks, result is transformed in multiple stages
    my @result_3 = foo( 0, 1, 2, 3, callback { 0 + 2 ** $_ }
                                    callback { 0 + 10 * $_ });
    print Dumper( [@result_3] ), "\n";  # [10,20,40,80];

=head1 DESCRIPTION

Use this module to enable a function or method to accept optional blocking
callbacks. Perhaps you would like to allow the caller to accept your function's
return value as is, or to intercept, change, eliminate, or otherwise process that
result before it is finally returned.

=head2 How callbacks are identified and processed

Callbacks are passed to your function by placing them at the end of the call's
argument list. This module provides you with a means to identify and separate any
callbacks from your function's arguments. It also provides dispatchers that will
pass the return value into the callback chain and capture the result, ready to
pass it back up to the caller.

Callbacks work simply enough. Like any function, they accept input in C<@_>
and their output is returned explicitly or as the result of their terminal
expression. When chaining together multiple callbacks, the dispatcher takes
the function's return value and passes it to the first callback; the output
from that callback is then passed to the following callback, and so on until
their are no more callbacks to process the value. The result of the final
callback is returned to the program ready to be returned to the caller.

As a convenience, a callback also receives a copy of the input value in C<$_>.

If an empty list is returned then the value is discarded and the callback
chain is terminated for that value.

=head2 Creating and passing callbacks into a function

    ##################################
    # We define our MyModule.pm file #
    ##################################

    package MyModule;
    use Exporter;
    use Params::Callbacks 'callbacks';
    use namespace::clean;
    use Params::Callbacks 'callback';
    our @EXPORT = 'callback';
    our @EXPORT_OK = 'awesome';
    our @ISA = 'Exporter';

    sub awesome {
        my ( $callbacks, @names ) = &callbacks;
        return $callbacks->transform(@names);
    }

    1;

    #############################
    # Meanwhile, back in main:: #
    #############################

    # No callbacks ...
    #
    use MyModule 'awesome';
    my @team = awesome('Imran', 'Merlyn', 'Iain');
    print "$_\n" for @team;
    #
    # Imran
    # Merlyn
    # Iain
    #
    # (Not so awesome.)


    # With a callback ...
    #
    use MyModule 'awesome';
    my @team = awesome('Imran', 'Merlyn', 'Iain', callback {
        "$_, you're awesome!"
    });
    print "$_\n" for @team;
    #
    # Imran, you're awesome!
    # Merlyn, you're awesome!
    # Iain, you're awesome!
    #
    # (This time with added awesome!)


    # With two callbacks ...
    #
    use MyModule 'awesome';
    my @team = awesome('Imran', 'Merlyn', 'Iain', callback {
        "$_, you're awesome!"
    } # Comma is optional here.
    callback {
        print "$_[0]\n";
        return $_[0];
    });
    #
    # Imran, you're awesome!
    # Merlyn, you're awesome!
    # Iain, you're awesome!
    #
    # (Moar awesome!)

=cut

use strict;
use warnings;

use Exporter ();
use Scalar::Util qw(blessed);
use Carp qw(confess);
use namespace::clean;

our $VERSION = '2.002003';
$VERSION = eval $VERSION;
our @ISA         = qw(Exporter);
our @EXPORT_OK   = qw(callbacks callback);
our %EXPORT_TAGS = ( all => \@EXPORT_OK, ALL => \@EXPORT_OK );

=head1 METHODS

=cut

=head2 new

Takes a list of scalar values, strips away any trailing callbacks and returns
a new list containing a blessed array reference (the callback chain) followed
by any values from the original list that weren't callbacks.

A typical use case would be processing a function's argument list C<@_>:

    sub my_function
    {
        ( $callbacks, @params ) = Params::Callbacks->new(@_);
        ...
    }

It is also possible to pass in a pre-prepared callback chain instead of
individual callbacks, in which case that value will be returned as the callback
chain, without inspecting the list for individual callbacks E this behaviour
is useful when the ability to efficiently forward callbacks onto a more deeply
nested call is required.

The output list is packaged in such a way as to make parsing the argument list
as easy as possible.

=cut


sub new
{
    my ( $class, @params ) = @_;
    my @callbacks;

    if ( blessed( $params[-1] ) ) {
        if ( $params[-1]->isa(__PACKAGE__) ) {
            my $callback_chain = pop(@params);
            return ( bless( $callback_chain, $class ), @params );
        }
        else {
            while (    @params
                    && blessed( $params[-1] )
                    && $params[-1]->isa('Params::Callbacks::Callback') )
            {
                unshift @callbacks, pop(@params);
            }

        }
    }

    return ( bless( \@callbacks, $class ), @params );
}

=head2 transform

Transform a result set by passing it through all the stages of the callbacks
pipeline. The transformation terminates if the result set is reduced to
nothing, and an empty result set is returned.

Empty or not, this method always returns a list.

=cut


sub transform
{
    my ( $callbacks, @data ) = @_;

    confess
      'E-PARAMS-CALLBACKS-001 Expected Params::Callbacks object reference as first argument'
      unless ref($callbacks) && $callbacks->isa(__PACKAGE__);

    for my $callback (@$callbacks) {
        last unless @data;
        @data = map { $callback->($_) } @data;
    }

    return @data;
}

=head2 smart_transform

Transform a result set by passing it through all the stages of the callbacks
pipeline. The transformation terminates if the result set is reduced to
nothing, and an empty result set is returned.

Empty or not, this method always returns a list if a list was wanted.

If a scalar is required, a scalar is returned. If the result set contains a
single element then the value of that element will be returned, otherwise a
count of the number of elements is returned.

=cut


sub smart_transform
{
    my @data = &transform;

    unless (wantarray) {
        my $result;

        if ( @data != 1 ) {
            $result = scalar(@data);
        }
        else {
            $result = $data[0];
        }

        return $result;
    }

    return @data;
}

=head1 EXPORTS

Nothing is exported by default.

The following functions are exported individually upon request; they may all be
imported at once using the import tags C<:all> and C<:ALL>.

=cut

=head2 callbacks

Takes a list of scalar values, strips away any trailing callbacks and returns
a new list containing a blessed array reference (the callback chain) followed
by any values from the original list that weren't callbacks. The typical
imagined use case is in processing a function's argument list C<@_>:

    sub my_function
    {
        ( $callbacks, @params ) = callbacks(@_);
        ...
    }

    sub my_function
    {
        ( $callbacks, @params ) = &callbacks;
        ...
    }

It is also possible to pass in a pre-prepared callback chain instead of
individual callbacks, in which case this function will return that value
as its own callback chain, without inspecting the list for individual
callbacks. This behaviour is useful when forwarding callbacks onto a
more deeply nested call.

The output list is packaged in such a way as to make parsing the argument list
as easy as possible.

=cut


sub callbacks
{
    return __PACKAGE__->new(@_);
}

=head2 callback

A simple piece of syntactic sugar that announces a callback. The code
reference it precedes is blessed as a C
object, disambiguating it from unblessed subs that are being passed as
standard arguments.

Multiple callbacks may be chained together with or without comma
separators:

    callback { ... }, callback { ... }, callback { ... }    # Valid
    callback { ... }  callback { ... }  callback { ... }    # Valid, too!

=cut


sub callback (&;@)
{
    my ( $callback, @params ) = @_;
    return ( bless( $callback, 'Params::Callbacks::Callback' ), @params );
}

1;

=head1 REPOSITORY

=over 2

=item * L

=item * L

=back

=head1 BUG REPORTS

Please report any bugs to L

=head1 AUTHOR

Iain Campbell

=head1 COPYRIGHT AND LICENCE

Copyright (C) 2012-2015 by Iain Campbell

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

=cut