This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bisect-runner.pl should fix 5.7.x to export Perl_cxinc on AIX.
[perl5.git] / lib / less.pm
... / ...
CommitLineData
1package less;
2use strict;
3use warnings;
4
5our $VERSION = '0.03';
6
7sub _pack_tags {
8 return join ' ', @_;
9}
10
11sub _unpack_tags {
12 return grep { defined and length }
13 map { split ' ' }
14 grep {defined} @_;
15}
16
17sub stash_name { $_[0] }
18
19sub 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
38sub 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
50sub 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
731;
74
75__END__
76
77=head1 NAME
78
79less - perl pragma to request less of something
80
81=head1 SYNOPSIS
82
83 use less 'CPU';
84
85=head1 DESCRIPTION
86
87This is a user-pragma. If you're very lucky some code you're using
88will know that you asked for less CPU usage or ram or fat or... we
89just can't know. Consult your documentation on everything you're
90currently using.
91
92For general suggestions, try requesting C<CPU> or C<memory>.
93
94 use less 'memory';
95 use less 'CPU';
96 use less 'fat';
97
98If 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
105L<less> has been in the core as a "joke" module for ages now and it
106hasn't had any real way to communicating any information to
107anything. Thanks to Nicholas Clark we have user pragmas (see
108L<perlpragma>) and now C<less> can do something.
109
110You can probably expect your users to be able to guess that they can
111request less CPU or memory or just "less" overall.
112
113If the user didn't specify anything, it's interpreted as having used
114the 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
122The class method C<< less->of( NAME ) >> returns a boolean to tell you
123whether 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
134If you don't ask for any feature, you get the list of features that
135the user requested you to be nice to. This has the nice side effect
136that if you don't respect anything in particular then you can just ask
137for 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
154At least it's backwards compatible in not doing much.
155
156=back
157
158=cut