File Coverage

blib/lib/Venus/Role/Proxyable.pm
Criterion Covered Total %
statement 24 26 92.3
branch 3 6 50.0
condition 2 6 33.3
subroutine 7 7 100.0
pod 0 2 0.0
total 36 47 76.6


line stmt bran cond sub pod time code
1             package Venus::Role::Proxyable;
2              
3 37     37   676 use 5.018;
  37         152  
4              
5 37     37   241 use strict;
  37         87  
  37         787  
6 37     37   241 use warnings;
  37         86  
  37         1150  
7              
8 37     37   249 use Venus::Role 'with';
  37         93  
  37         352  
9              
10             # METHODS
11              
12             sub AUTOLOAD {
13 32     32   3969 require Venus::Error;
14              
15 32         249 my ($package, $method) = our $AUTOLOAD =~ m[^(.+)::(.+)$];
16              
17 32         216 my $build = $package->can('BUILDPROXY');
18              
19 32         103 my $error = qq(Can't locate object method "$method" via package "$package");
20              
21 32 50 33     188 Venus::Error->throw($error) unless $build && ref($build) eq 'CODE';
22              
23 32         100 my $proxy = $build->($package, $method, @_);
24              
25 32 50 33     146 Venus::Error->throw($error) unless $proxy && ref($proxy) eq 'CODE';
26              
27 32         118 goto &$proxy;
28             }
29              
30             sub BUILDPROXY {
31 32     32 0 116 require Venus::Error;
32              
33 32         83 my ($package, $method, $self, @args) = @_;
34              
35 32         89 my $build = $self->can('build_proxy');
36              
37 32 50       143 return $build->($self, $package, $method, @args) if $build;
38              
39 0         0 my $error = qq(Can't locate object method "build_proxy" via package "$package");
40              
41 0         0 Venus::Error->throw($error);
42             }
43              
44             # EXPORTS
45              
46             sub EXPORT {
47 41     41 0 185 ['AUTOLOAD', 'BUILDPROXY']
48             }
49              
50             1;
51              
52              
53              
54             =head1 NAME
55              
56             Venus::Role::Proxyable - Proxyable Role
57              
58             =cut
59              
60             =head1 ABSTRACT
61              
62             Proxyable Role for Perl 5
63              
64             =cut
65              
66             =head1 SYNOPSIS
67              
68             package Example;
69              
70             use Venus::Class;
71              
72             with 'Venus::Role::Proxyable';
73              
74             attr 'test';
75              
76             sub build_proxy {
77             my ($self, $package, $method, @args) = @_;
78             return sub { [$self, $package, $method, @args] } if $method eq 'anything';
79             return undef;
80             }
81              
82             package main;
83              
84             my $example = Example->new(test => time);
85              
86             # $example->anything(1..4);
87              
88             =cut
89              
90             =head1 DESCRIPTION
91              
92             This package provides a hook into method dispatch resoluton via a wrapper
93             around the C routine which processes calls to routines which don't
94             exist.
95              
96             =cut
97              
98             =head1 METHODS
99              
100             This package provides the following methods:
101              
102             =cut
103              
104             =head2 build_proxy
105              
106             build_proxy(Str $package, Str $method, Any @args) (CodeRef | Undef)
107              
108             The build_proxy method should return a code reference to fulfill the method
109             dispatching request, or undef to result in a method not found error.
110              
111             I>
112              
113             =over 4
114              
115             =item build_proxy example 1
116              
117             package main;
118              
119             my $example = Example->new(test => 123);
120              
121             my $build_proxy = $example->build_proxy('Example', 'everything', 1..4);
122              
123             # undef
124              
125             =back
126              
127             =over 4
128              
129             =item build_proxy example 2
130              
131             package main;
132              
133             my $example = Example->new(test => 123);
134              
135             my $build_proxy = $example->build_proxy('Example', 'anything', 1..4);
136              
137             # sub { ... }
138              
139             =back
140              
141             =cut
142              
143             =head1 AUTHORS
144              
145             Awncorp, C
146              
147             =cut
148              
149             =head1 LICENSE
150              
151             Copyright (C) 2000, Al Newkirk.
152              
153             This program is free software, you can redistribute it and/or modify it under
154             the terms of the Apache license version 2.0.
155              
156             =cut