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 52     52   919 use Mojo::Base -strict;
  52         147  
  52         437  
3              
4 52     52   32035 use Hash::Util::FieldHash qw(fieldhash);
  52         54758  
  52         3871  
5 52     52   468 use Mojo::Util qw(monkey_patch);
  52         159  
  52         9379  
6              
7             sub import {
8 354   100 354   2338 my ($flag, $caller) = ($_[1] // '', caller);
9 354 100       4876 return unless $flag eq '-dispatch';
10              
11 203         671 my $dyn_pkg = "${caller}::_Dynamic";
12 203         2262 my $caller_can = $caller->can('SUPER::can');
13             monkey_patch $dyn_pkg, 'can', sub {
14 272     272   1188 my ($self, $method, @rest) = @_;
        272      
        270      
        270      
        270      
15              
16             # Delegate to our parent's "can" if there is one, without breaking if not
17 272         1171 my $can = $self->$caller_can($method, @rest);
18 272 100       1306 return undef unless $can;
19 52     52   500 no warnings 'once';
  52         175  
  52         3753  
20 52     52   574 my $h = do { no strict 'refs'; *{"${dyn_pkg}::${method}"}{CODE} };
  52         168  
  52         7473  
  234         359  
  234         348  
  234         1227  
21 234 100 100     1631 return $h && $h eq $can ? undef : $can;
22 203         2162 };
23              
24             {
25 52     52   457 no strict 'refs';
  52         183  
  52         10535  
  203         573  
26 203         460 unshift @{"${caller}::ISA"}, $dyn_pkg;
  203         10892  
27             }
28             }
29              
30             sub register {
31 17640     17640 1 33625 my ($target, $object, $name, $code) = @_;
32              
33 17640         21158 state %dyn_methods;
34 17640         21998 state $setup = do { fieldhash %dyn_methods; 1 };
  49         397  
  49         1208  
35              
36 17640         27839 my $dyn_pkg = "${target}::_Dynamic";
37             monkey_patch($dyn_pkg, $name, $target->BUILD_DYNAMIC($name, \%dyn_methods))
38 52 100   52   479 unless do { no strict 'refs'; *{"${dyn_pkg}::${name}"}{CODE} };
  52         150  
  52         6497  
  17640         22660  
  17640         21181  
  17640         81909  
39 17640         69690 $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