Perl x Open Food Facts Hackathon: Paris, France - May 24-25 Learn more

TOBYINK / Sub-HandlesVia-0.050002 / lib / Sub / HandlesVia / HandlerLibrary / Counter.pm 

            

              
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.050002';
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;