Remove orphaned (and unused) Test::Simple test
[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 __END__
71
72 =head1 NAME
73
74 less - perl pragma to request less of something
75
76 =head1 SYNOPSIS
77
78     use less 'CPU';
79
80 =head1 DESCRIPTION
81
82 This is a user-pragma. If you're very lucky some code you're using
83 will know that you asked for less CPU usage or ram or fat or... we
84 just can't know. Consult your documentation on everything you're
85 currently using.
86
87 For general suggestions, try requesting C<CPU> or C<memory>.
88
89     use less 'memory';
90     use less 'CPU';
91     use less 'fat';
92
93 If you ask for nothing in particular, you'll be asking for C<less
94 'please'>.
95
96     use less 'please';
97
98 =head1 FOR MODULE AUTHORS
99
100 L<less> has been in the core as a "joke" module for ages now and it
101 hasn't had any real way to communicating any information to
102 anything. Thanks to Nicholas Clark we have user pragmas (see
103 L<perlpragma>) and now C<less> can do something.
104
105 You can probably expect your users to be able to guess that they can
106 request less CPU or memory or just "less" overall.
107
108 If the user didn't specify anything, it's interpreted as having used
109 the C<please> tag. It's up to you to make this useful.
110
111   # equivalent
112   use less;
113   use less 'please';
114
115 =head2 C<< BOOLEAN = less->of( FEATURE ) >>
116
117 The class method C<< less->of( NAME ) >> returns a boolean to tell you
118 whether your user requested less of something.
119
120   if ( less->of( 'CPU' ) ) {
121       ...
122   }
123   elsif ( less->of( 'memory' ) ) {
124
125   }
126
127 =head2 C<< FEATURES = less->of() >>
128
129 If you don't ask for any feature, you get the list of features that
130 the user requested you to be nice to. This has the nice side effect
131 that if you don't respect anything in particular then you can just ask
132 for it and use it like a boolean.
133
134   if ( less->of ) {
135       ...
136   }
137   else {
138       ...
139   }
140
141 =head1 CAVEATS
142
143 =over
144
145 =item This probably does nothing.
146
147 =item This works only on 5.10+
148
149 At least it's backwards compatible in not doing much.
150
151 =back
152
153 =cut
154
155 1;