This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
B::Deparse.pm: Extract code into a function
[perl5.git] / lib / less.pm
CommitLineData
a0d0e21e 1package less;
6d39ae0a
JJ
2use strict;
3use warnings;
f06db76b 4
7eb1ae03 5our $VERSION = '0.03';
6d39ae0a
JJ
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
a725df95
RS
17sub stash_name { $_[0] }
18
6d39ae0a
JJ
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;
a725df95 27 @tags{ _unpack_tags( $hinthash->{ $class->stash_name } ) } = ();
6d39ae0a
JJ
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 @_;
12d0f8b2 40 my $stash = $class->stash_name;
6d39ae0a
JJ
41
42 @_ = 'please' if not @_;
43 my %tags;
12d0f8b2 44 @tags{ _unpack_tags( @_, $^H{ $stash } ) } = ();
6d39ae0a 45
12d0f8b2 46 $^H{$stash} = _pack_tags( keys %tags );
6d39ae0a
JJ
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 ) {
a725df95 60 delete $^H{ $class->stash_name };
6d39ae0a
JJ
61 }
62 else {
a725df95 63 $^H{ $class->stash_name } = $new;
6d39ae0a
JJ
64 }
65 }
66 else {
a725df95 67 delete $^H{ $class->stash_name };
6d39ae0a
JJ
68 }
69
70 return;
71}
72
aa96fdb0
RGS
731;
74
6d39ae0a 75__END__
b75c8c73 76
f06db76b
AD
77=head1 NAME
78
6d39ae0a 79less - perl pragma to request less of something
cb1a09d0
AD
80
81=head1 SYNOPSIS
82
6d39ae0a 83 use less 'CPU';
f06db76b
AD
84
85=head1 DESCRIPTION
86
6d39ae0a
JJ
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>.
f06db76b
AD
93
94 use less 'memory';
95 use less 'CPU';
96 use less 'fat';
97
6d39ae0a
JJ
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
f06db76b
AD
157
158=cut