File Coverage

blib/lib/Mojo/DynamicMethods.pm
Criterion Covered Total %
statement 46 46 100.0
branch 8 8 100.0
condition 5 5 100.0
subroutine 14 14 100.0
pod 1 1 100.0
total 74 74 100.0


line stmt bran cond sub pod time code
1             package Mojo::DynamicMethods;
2 56     56   1094 use Mojo::Base -strict;
  56         406  
  56         489  
3              
4 56     56   38625 use Hash::Util::FieldHash qw(fieldhash);
  56         73202  
  56         6887  
5 56     56   6267 use Mojo::Util qw(monkey_patch);
  56         1702  
  56         13071  
6              
7             sub import {
8 382   100 382   3209 my ($flag, $caller) = ($_[1] // '', caller);
9 382 100       6941 return unless $flag eq '-dispatch';
10              
11 219         659 my $dyn_pkg = "${caller}::_Dynamic";
12 219         2936 my $caller_can = $caller->can('SUPER::can');
13             monkey_patch $dyn_pkg, 'can', sub {
14 273     273   1225 my ($self, $method, @rest) = @_;
        273      
        271      
        271      
        271      
15              
16             # Delegate to our parent's "can" if there is one, without breaking if not
17 273         1345 my $can = $self->$caller_can($method, @rest);
18 273 100       2541 return undef unless $can;
19 56     56   745 no warnings 'once';
  56         133  
  56         4644  
20 56     56   400 my $h = do { no strict 'refs'; *{"${dyn_pkg}::${method}"}{CODE} };
  56         136  
  56         10244  
  235         435  
  235         401  
  235         1546  
21 235 100 100     1846 return $h && $h eq $can ? undef : $can;
22 219         2770 };
23              
24             {
25 56     56   427 no strict 'refs';
  56         120  
  56         15832  
  219         563  
26 219         446 unshift @{"${caller}::ISA"}, $dyn_pkg;
  219         17797  
27             }
28             }
29              
30             sub register {
31 19146     19146 1 42859 my ($target, $object, $name, $code) = @_;
32              
33 19146         26352 state %dyn_methods;
34 19146         26051 state $setup = do { fieldhash %dyn_methods; 1 };
  53         395  
  53         1012  
35              
36 19146         31180 my $dyn_pkg = "${target}::_Dynamic";
37             monkey_patch($dyn_pkg, $name, $target->BUILD_DYNAMIC($name, \%dyn_methods))
38 56 100   56   432 unless do { no strict 'refs'; *{"${dyn_pkg}::${name}"}{CODE} };
  56         122  
  56         9487  
  19146         25687  
  19146         27573  
  19146         101543  
39 19146         87339 $dyn_methods{$object}{$name} = $code;
40             }
41              
42             "Ph'nglui mglw'nafh Cthulhu R'lyeh wgah'nagl fhtagn";
43              
44             =encoding utf8
45              
46             =head1 NAME
47              
48             Mojo::DynamicMethods - Fast dynamic method dispatch
49              
50             =head1 SYNOPSIS
51              
52             package MyClass;
53             use Mojo::Base -base, -signatures;
54              
55             use Mojo::DynamicMethods -dispatch;
56              
57             sub BUILD_DYNAMIC ($class, $method, $dyn_methods) {
58             return sub {...};
59             }
60              
61             sub add_helper ($self, $name, $cb) {
62             Mojo::DynamicMethods::register 'MyClass', $self, $name, $cb;
63             }
64              
65             package main;
66              
67             # Generate methods dynamically (and hide them from "$obj->can(...)")
68             my $obj = MyClass->new;
69             $obj->add_helper(foo => sub { warn 'Hello Helper!' });
70             $obj->foo;
71              
72             =head1 DESCRIPTION
73              
74             L provides dynamic method dispatch for per-object helper methods without requiring use of
75             C.
76              
77             To opt your class into dynamic dispatch simply pass the C<-dispatch> flag.
78              
79             use Mojo::DynamicMethods -dispatch;
80              
81             And then implement a C method in your class, making sure that the key you use to lookup methods in
82             C<$dyn_methods> is the same thing you pass as C<$ref> to L.
83              
84             sub BUILD_DYNAMIC ($class, $method, $dyn_methods) {
85             return sub ($self, @args) {
86             my $dynamic = $dyn_methods->{$self}{$method};
87             return $self->$dynamic(@args) if $dynamic;
88             my $package = ref $self;
89             croak qq{Can't locate object method "$method" via package "$package"};
90             };
91             }
92              
93             Note that this module will summon B, use it at your own risk!
94              
95             =head1 FUNCTIONS
96              
97             L implements the following functions.
98              
99             =head2 register
100              
101             Mojo::DynamicMethods::register $class, $ref, $name, $cb;
102              
103             Registers the method C<$name> as eligible for dynamic dispatch for C<$class>, and sets C<$cb> to be looked up for
104             C<$name> by reference C<$ref> in a dynamic method constructed by C.
105              
106             =head1 SEE ALSO
107              
108             L, L, L.
109              
110             =cut