This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #48355] Handling of RAWDATA broken badly in Attribute::Handlers in perl 5.10...
[perl5.git] / lib / less.pm
CommitLineData
a0d0e21e 1package less;
6d39ae0a
JJ
2use strict;
3use warnings;
f06db76b 4
6d39ae0a
JJ
5our $VERSION = '0.02';
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 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
36sub 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
47sub 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__
b75c8c73 71
f06db76b
AD
72=head1 NAME
73
6d39ae0a 74less - perl pragma to request less of something
cb1a09d0
AD
75
76=head1 SYNOPSIS
77
6d39ae0a 78 use less 'CPU';
f06db76b
AD
79
80=head1 DESCRIPTION
81
6d39ae0a
JJ
82This is a user-pragma. If you're very lucky some code you're using
83will know that you asked for less CPU usage or ram or fat or... we
84just can't know. Consult your documentation on everything you're
85currently using.
86
87For general suggestions, try requesting C<CPU> or C<memory>.
f06db76b
AD
88
89 use less 'memory';
90 use less 'CPU';
91 use less 'fat';
92
6d39ae0a
JJ
93If 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
100L<less> has been in the core as a "joke" module for ages now and it
101hasn't had any real way to communicating any information to
102anything. Thanks to Nicholas Clark we have user pragmas (see
103L<perlpragma>) and now C<less> can do something.
104
105You can probably expect your users to be able to guess that they can
106request less CPU or memory or just "less" overall.
107
108If the user didn't specify anything, it's interpreted as having used
109the 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
117The class method C<< less->of( NAME ) >> returns a boolean to tell you
118whether 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
129If you don't ask for any feature, you get the list of features that
130the user requested you to be nice to. This has the nice side effect
131that if you don't respect anything in particular then you can just ask
132for 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
149At least it's backwards compatible in not doing much.
150
151=back
f06db76b
AD
152
153=cut
154
a0d0e21e 1551;