File Coverage

blib/lib/Sub/HandlesVia/HandlerLibrary/Counter.pm
Criterion Covered Total %
statement 29 36 80.5
branch 0 4 0.0
condition 0 3 0.0
subroutine 14 16 87.5
pod 4 4 100.0
total 47 63 74.6


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