our $TODO should be local $::TODO, revealing a bug in the de-commenting regexp.
[perl.git] / lib / less.pm
1 package less;
2 use strict;
3 use warnings;
4
5 our $VERSION = '0.02';
6
7 sub _pack_tags {
8     return join ' ', @_;
9 }
10
11 sub _unpack_tags {
12     return grep { defined and length }
13         map  { split ' ' }
14         grep {defined} @_;
15 }
16
17 sub of {
18     my $class = shift @_;
19
20     # If no one wants the result, don't bother computing it.
21     return unless defined wantarray;
22
23     my $hinthash = ( caller 0 )[10];
24     my %tags;
25     @tags{ _unpack_tags( $hinthash->{$class} ) } = ();
26
27     if (@_) {
28         exists $tags{$_} and return !!1 for @_;
29         return;
30     }
31     else {
32         return keys %tags;
33     }
34 }
35
36 sub import {
37     my $class = shift @_;
38
39     @_ = 'please' if not @_;
40     my %tags;
41     @tags{ _unpack_tags( @_, $^H{$class} ) } = ();
42
43     $^H{$class} = _pack_tags( keys %tags );
44     return;
45 }
46
47 sub unimport {
48     my $class = shift @_;
49
50     if (@_) {
51         my %tags;
52         @tags{ _unpack_tags( $^H{$class} ) } = ();
53         delete @tags{ _unpack_tags(@_) };
54         my $new = _pack_tags( keys %tags );
55
56         if ( not length $new ) {
57             delete $^H{$class};
58         }
59         else {
60             $^H{$class} = $new;
61         }
62     }
63     else {
64         delete $^H{$class};
65     }
66
67     return;
68 }
69
70 1;
71
72 __END__
73
74 =head1 NAME
75
76 less - perl pragma to request less of something
77
78 =head1 SYNOPSIS
79
80     use less 'CPU';
81
82 =head1 DESCRIPTION
83
84 This is a user-pragma. If you're very lucky some code you're using
85 will know that you asked for less CPU usage or ram or fat or... we
86 just can't know. Consult your documentation on everything you're
87 currently using.
88
89 For general suggestions, try requesting C<CPU> or C<memory>.
90
91     use less 'memory';
92     use less 'CPU';
93     use less 'fat';
94
95 If you ask for nothing in particular, you'll be asking for C<less
96 'please'>.
97
98     use less 'please';
99
100 =head1 FOR MODULE AUTHORS
101
102 L<less> has been in the core as a "joke" module for ages now and it
103 hasn't had any real way to communicating any information to
104 anything. Thanks to Nicholas Clark we have user pragmas (see
105 L<perlpragma>) and now C<less> can do something.
106
107 You can probably expect your users to be able to guess that they can
108 request less CPU or memory or just "less" overall.
109
110 If the user didn't specify anything, it's interpreted as having used
111 the C<please> tag. It's up to you to make this useful.
112
113   # equivalent
114   use less;
115   use less 'please';
116
117 =head2 C<< BOOLEAN = less->of( FEATURE ) >>
118
119 The class method C<< less->of( NAME ) >> returns a boolean to tell you
120 whether your user requested less of something.
121
122   if ( less->of( 'CPU' ) ) {
123       ...
124   }
125   elsif ( less->of( 'memory' ) ) {
126
127   }
128
129 =head2 C<< FEATURES = less->of() >>
130
131 If you don't ask for any feature, you get the list of features that
132 the user requested you to be nice to. This has the nice side effect
133 that if you don't respect anything in particular then you can just ask
134 for it and use it like a boolean.
135
136   if ( less->of ) {
137       ...
138   }
139   else {
140       ...
141   }
142
143 =head1 CAVEATS
144
145 =over
146
147 =item This probably does nothing.
148
149 =item This works only on 5.10+
150
151 At least it's backwards compatible in not doing much.
152
153 =back
154
155 =cut