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