1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
use 5.008;
use strict;
use warnings;
package Sub::HandlesVia::HandlerLibrary::Counter;
our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION = '0.052000';
use Sub::HandlesVia::HandlerLibrary;
our @ISA = 'Sub::HandlesVia::HandlerLibrary';
use Sub::HandlesVia::Handler qw( handler );
use Types::Standard qw( Optional Int Any Item Defined Num );
our @METHODS = qw( set inc dec reset );
sub _type_inspector {
my ($me, $type) = @_;
if ($type == Defined) {
return {
trust_mutated => 'always',
};
}
if ($type==Num or $type==Int) {
return {
trust_mutated => 'maybe',
value_type => $type,
};
}
return $me->SUPER::_type_inspector($type);
}
sub set {
handler
name => 'Counter:set',
args => 1,
signature => [Int],
template => '« $ARG »',
usage => '$value',
documentation => 'Sets the counter to the given value.',
_examples => sub {
my ( $class, $attr, $method ) = @_;
return join "",
" my \$object = $class\->new( $attr => 0 );\n",
" \$object->$method\( 5 );\n",
" say \$object->$attr; ## ==> 5\n",
"\n";
},
}
sub inc {
handler
name => 'Counter:inc',
min_args => 0,
max_args => 1,
signature => [Optional[Int]],
template => '« $GET + (#ARG ? $ARG : 1) »',
lvalue_template => '$GET += (#ARG ? $ARG : 1)',
usage => '$amount?',
documentation => 'Increments the counter by C<< $amount >>, or by 1 if no value is given.',
_examples => sub {
my ( $class, $attr, $method ) = @_;
return join "",
" my \$object = $class\->new( $attr => 0 );\n",
" \$object->$method;\n",
" \$object->$method;\n",
" say \$object->$attr; ## ==> 2\n",
" \$object->$method( 3 );\n",
" say \$object->$attr; ## ==> 5\n",
"\n";
},
}
sub dec {
handler
name => 'Counter:dec',
min_args => 0,
max_args => 1,
signature => [Optional[Int]],
template => '« $GET - (#ARG ? $ARG : 1) »',
lvalue_template => '$GET -= (#ARG ? $ARG : 1)',
usage => '$amount?',
documentation => 'Decrements the counter by C<< $amount >>, or by 1 if no value is given.',
_examples => sub {
my ( $class, $attr, $method ) = @_;
return join "",
" my \$object = $class\->new( $attr => 10 );\n",
" \$object->$method;\n",
" \$object->$method;\n",
" say \$object->$attr; ## ==> 8\n",
" \$object->$method( 5 );\n",
" say \$object->$attr; ## ==> 3\n",
"\n";
},
}
sub reset {
handler
name => 'Counter:reset',
args => 0,
template => '« $DEFAULT »',
default_for_reset => sub { 0 },
documentation => 'Sets the counter to its default value, or 0 if it has no default.',
_examples => sub {
my ( $class, $attr, $method ) = @_;
return join "",
" my \$object = $class\->new( $attr => 10 );\n",
" \$object->$method;\n",
" say \$object->$attr; ## ==> 0\n",
"\n";
},
}
1;
|
