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   2845 use Mojo::Base -strict;
  56         1641  
  56         889  
3              
4 56     56   31140 use Hash::Util::FieldHash qw(fieldhash);
  56         53210  
  56         5191  
5 56     56   2647 use Mojo::Util qw(monkey_patch);
  56         84  
  56         9119  
6              
7             sub import {
8 382   100 382   2051 my ($flag, $caller) = ($_[1] // '', caller);
9 382 100       3940 return unless $flag eq '-dispatch';
10              
11 219         421 my $dyn_pkg = "${caller}::_Dynamic";
12 219         1738 my $caller_can = $caller->can('SUPER::can');
13             monkey_patch $dyn_pkg, 'can', sub {
14 273     273   833 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         933 my $can = $self->$caller_can($method, @rest);
18 273 100       1512 return undef unless $can;
19 56     56   325 no warnings 'once';
  56         138  
  56         3424  
20 56     56   297 my $h = do { no strict 'refs'; *{"${dyn_pkg}::${method}"}{CODE} };
  56         98  
  56         6789  
  235         293  
  235         250  
  235         1129  
21 235 100 100     1473 return $h && $h eq $can ? undef : $can;
22 219         1583 };
23              
24             {
25 56     56   256 no strict 'refs';
  56         94  
  56         10394  
  219         881  
26 219         601 unshift @{"${caller}::ISA"}, $dyn_pkg;
  219         89736  
27             }
28             }
29              
30             sub register {
31 19150     19150 1 23878 my ($target, $object, $name, $code) = @_;
32              
33 19150         16541 state %dyn_methods;
34 19150         16636 state $setup = do { fieldhash %dyn_methods; 1 };
  53         295  
  53         721  
35              
36 19150         18731 my $dyn_pkg = "${target}::_Dynamic";
37             monkey_patch($dyn_pkg, $name, $target->BUILD_DYNAMIC($name, \%dyn_methods))
38 56 100   56   287 unless do { no strict 'refs'; *{"${dyn_pkg}::${name}"}{CODE} };
  56         78  
  56         6745  
  19150         16627  
  19150         16231  
  19150         55288  
39 19150         47031 $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