File Coverage

blib/lib/Venus/Role/Accessible.pm
Criterion Covered Total %
statement 22 23 95.6
branch 5 8 62.5
condition n/a
subroutine 8 8 100.0
pod 2 4 50.0
total 37 43 86.0


line stmt bran cond sub pod time code
1             package Venus::Role::Accessible;
2              
3 96     96   1683 use 5.018;
  96         391  
4              
5 96     96   646 use strict;
  96         265  
  96         3392  
6 96     96   511 use warnings;
  96         272  
  96         2900  
7              
8 96     96   594 use Venus::Role 'fault';
  96         273  
  96         655  
9              
10             # AUDITS
11              
12             sub AUDIT {
13 266     266 0 1234 my ($self, $from) = @_;
14              
15 266 50       2498 if (!$from->isa('Venus::Core')) {
16 0         0 fault "${self} requires ${from} to derive from Venus::Core";
17             }
18              
19 266         694 return $self;
20             }
21              
22             # METHODS
23              
24             sub access {
25 10     10 1 34 my ($self, $name, @args) = @_;
26              
27 10 100       26 return if !$name;
28              
29 9         31 return $self->$name(@args);
30             }
31              
32             sub assign {
33 4     4 1 17 my ($self, $name, $code, @args) = @_;
34              
35 4 50       11 return if !$name;
36 4 50       14 return if !$code;
37              
38 4         78 return $self->access($name, $self->$code(@args));
39             }
40              
41             # EXPORTS
42              
43             sub EXPORT {
44 266     266 0 1121 ['access', 'assign']
45             }
46              
47             1;
48              
49              
50              
51             =head1 NAME
52              
53             Venus::Role::Accessible - Accessible Role
54              
55             =cut
56              
57             =head1 ABSTRACT
58              
59             Accessible Role for Perl 5
60              
61             =cut
62              
63             =head1 SYNOPSIS
64              
65             package Example;
66              
67             use Venus::Class;
68              
69             with 'Venus::Role::Accessible';
70              
71             attr 'value';
72              
73             sub downcase {
74             lc $_[0]->value
75             }
76              
77             sub upcase {
78             uc $_[0]->value
79             }
80              
81             package main;
82              
83             my $example = Example->new(value => 'hello, there');
84              
85             # $example->value;
86              
87             =cut
88              
89             =head1 DESCRIPTION
90              
91             This package modifies the consuming package and provides the C method
92             for getting and setting attributes.
93              
94             =cut
95              
96             =head1 METHODS
97              
98             This package provides the following methods:
99              
100             =cut
101              
102             =head2 access
103              
104             access(string $name, any $value) (any)
105              
106             The access method gets or sets the class attribute specified.
107              
108             I>
109              
110             =over 4
111              
112             =item access example 1
113              
114             # given: synopsis
115              
116             package main;
117              
118             my $access = $example->access;
119              
120             # undef
121              
122             =back
123              
124             =over 4
125              
126             =item access example 2
127              
128             # given: synopsis
129              
130             package main;
131              
132             my $access = $example->access('value');
133              
134             # "hello, there"
135              
136             =back
137              
138             =over 4
139              
140             =item access example 3
141              
142             # given: synopsis
143              
144             package main;
145              
146             my $access = $example->access('value', 'something');
147              
148             # "something"
149              
150             =back
151              
152             =over 4
153              
154             =item access example 4
155              
156             # given: synopsis
157              
158             package main;
159              
160             my $instance = $example;
161              
162             # bless({}, "Example")
163              
164             $example->access('value', 'something');
165              
166             # "something"
167              
168             $instance = $example;
169              
170             # bless({value => "something"}, "Example")
171              
172             =back
173              
174             =cut
175              
176             =head2 assign
177              
178             assign(string $name, string | coderef $code, any @args) (any)
179              
180             The assign method dispatches the method call or executes the callback, sets the
181             class attribute specified to the result, and returns the result.
182              
183             I>
184              
185             =over 4
186              
187             =item assign example 1
188              
189             # given: synopsis
190              
191             package main;
192              
193             my $assign = $example->assign('value', 'downcase');
194              
195             # "hello, there"
196              
197             =back
198              
199             =over 4
200              
201             =item assign example 2
202              
203             # given: synopsis
204              
205             package main;
206              
207             my $assign = $example->assign('value', 'upcase');
208              
209             # "HELLO, THERE"
210              
211             =back
212              
213             =over 4
214              
215             =item assign example 3
216              
217             # given: synopsis
218              
219             package main;
220              
221             my $instance = $example;
222              
223             # bless({value => "hello, there"}, "Example")
224              
225             my $assign = $example->assign('value', 'downcase');
226              
227             # "hello, there"
228              
229             $instance = $example;
230              
231             # bless({value => "hello, there"}, "Example")
232              
233             =back
234              
235             =cut
236              
237             =head1 AUTHORS
238              
239             Awncorp, C
240              
241             =cut
242              
243             =head1 LICENSE
244              
245             Copyright (C) 2000, Awncorp, C.
246              
247             This program is free software, you can redistribute it and/or modify it under
248             the terms of the Apache license version 2.0.
249              
250             =cut