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 53     53   1003 use Mojo::Base -strict;
  53         129  
  53         416  
3              
4 53     53   33478 use Hash::Util::FieldHash qw(fieldhash);
  53         54934  
  53         4023  
5 53     53   443 use Mojo::Util qw(monkey_patch);
  53         151  
  53         9181  
6              
7             sub import {
8 361   100 361   2414 my ($flag, $caller) = ($_[1] // '', caller);
9 361 100       4535 return unless $flag eq '-dispatch';
10              
11 207         655 my $dyn_pkg = "${caller}::_Dynamic";
12 207         2316 my $caller_can = $caller->can('SUPER::can');
13             monkey_patch $dyn_pkg, 'can', sub {
14 272     272   1208 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         1158 my $can = $self->$caller_can($method, @rest);
18 272 100       1373 return undef unless $can;
19 53     53   535 no warnings 'once';
  53         177  
  53         3460  
20 53     53   627 my $h = do { no strict 'refs'; *{"${dyn_pkg}::${method}"}{CODE} };
  53         198  
  53         7671  
  234         398  
  234         361  
  234         1359  
21 234 100 100     1707 return $h && $h eq $can ? undef : $can;
22 207         2203 };
23              
24             {
25 53     53   482 no strict 'refs';
  53         225  
  53         10993  
  207         530  
26 207         530 unshift @{"${caller}::ISA"}, $dyn_pkg;
  207         11331  
27             }
28             }
29              
30             sub register {
31 18448     18448 1 34326 my ($target, $object, $name, $code) = @_;
32              
33 18448         22241 state %dyn_methods;
34 18448         23436 state $setup = do { fieldhash %dyn_methods; 1 };
  50         351  
  50         997  
35              
36 18448         29847 my $dyn_pkg = "${target}::_Dynamic";
37             monkey_patch($dyn_pkg, $name, $target->BUILD_DYNAMIC($name, \%dyn_methods))
38 53 100   53   497 unless do { no strict 'refs'; *{"${dyn_pkg}::${name}"}{CODE} };
  53         176  
  53         6504  
  18448         22900  
  18448         21847  
  18448         85782  
39 18448         71855 $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