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