File Coverage

blib/lib/Mojolicious/Plugin/Util/Callback.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	14	16	87.5
condition	19	29	65.5
subroutine	3	3	100.0
pod	1	1	100.0
total	67	79	84.8

package Mojolicious::Plugin::Util::Callback;
use Mojo::Base 'Mojolicious::Plugin';

our $VERSION = '0.05';

my %callback;

# Register the plugin
sub register {
  my ($plugin, $mojo) = @_;

  # Add 'callback' helper
  $mojo->helper(
    callback => sub {
      my $c = shift;
      my $name = shift;

      # Establish callbacks by array reference
      if (ref $name && ref $name eq 'ARRAY') {

        # Param hash reference
        my $param = shift;

        # -once flag
        my $flag  = shift;

        # For each given callback name
        foreach (@$name) {

          # Get callback
          my $cb = delete $param->{$_};

          # Get callback
          if ($cb) {

            # Establish callback
            if (ref $cb && ref $cb eq 'CODE') {
              $mojo->callback($_, $cb, $flag);
            };
          }

          elsif ($flag && $flag eq '-once') {

            # Only allow the next establishement
            $callback{$_} = [undef, 1];
          };
        };

        # Everything went fine
        return 1;
      }

      # Establish callback
      elsif (ref $_[0] && ref $_[0] eq 'CODE') {
        my $cb = shift;
        my $once = $_[0] && $_[0] eq '-once' ? 1 : 0;

        # Callback exists
        if (exists $callback{$name} &&   # Callback exists
              $callback{$name}->[0] &&   # Callback is defined
              $callback{$name}->[1]) { # Callback is -once
          $mojo->log->debug(
            qq{No allowance to redefine callback "$name"}
          );

          # Return nothing
          return;
        };

        # Establish callback
        for ($callback{$name} //= []) {
          $_->[0] = $cb;
          $_->[1] ||= $once;
        };

        return 1;
      }

      # Release callback
      else {

        # Release existing callback
        my $cb;
        if (exists $callback{$name} && ($cb = $callback{$name}->[0])) {
          return $cb->($c, @_) ;
        };

        # Return nothing
        return;
      };
    }
  );
};


1;


__END__