This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_hv_placeholders_get() actually takes a const HV *hv.
[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
aa96fdb0
RGS
701;
71
6d39ae0a 72__END__
b75c8c73 73
f06db76b
AD
74=head1 NAME
75
6d39ae0a 76less - perl pragma to request less of something
cb1a09d0
AD
77
78=head1 SYNOPSIS
79
6d39ae0a 80 use less 'CPU';
f06db76b
AD
81
82=head1 DESCRIPTION
83
6d39ae0a
JJ
84This is a user-pragma. If you're very lucky some code you're using
85will know that you asked for less CPU usage or ram or fat or... we
86just can't know. Consult your documentation on everything you're
87currently using.
88
89For general suggestions, try requesting C<CPU> or C<memory>.
f06db76b
AD
90
91 use less 'memory';
92 use less 'CPU';
93 use less 'fat';
94
6d39ae0a
JJ
95If you ask for nothing in particular, you'll be asking for C<less
96'please'>.
97
98 use less 'please';
99
100=head1 FOR MODULE AUTHORS
101
102L<less> has been in the core as a "joke" module for ages now and it
103hasn't had any real way to communicating any information to
104anything. Thanks to Nicholas Clark we have user pragmas (see
105L<perlpragma>) and now C<less> can do something.
106
107You can probably expect your users to be able to guess that they can
108request less CPU or memory or just "less" overall.
109
110If the user didn't specify anything, it's interpreted as having used
111the C<please> tag. It's up to you to make this useful.
112
113 # equivalent
114 use less;
115 use less 'please';
116
117=head2 C<< BOOLEAN = less->of( FEATURE ) >>
118
119The class method C<< less->of( NAME ) >> returns a boolean to tell you
120whether your user requested less of something.
121
122 if ( less->of( 'CPU' ) ) {
123 ...
124 }
125 elsif ( less->of( 'memory' ) ) {
126
127 }
128
129=head2 C<< FEATURES = less->of() >>
130
131If you don't ask for any feature, you get the list of features that
132the user requested you to be nice to. This has the nice side effect
133that if you don't respect anything in particular then you can just ask
134for it and use it like a boolean.
135
136 if ( less->of ) {
137 ...
138 }
139 else {
140 ...
141 }
142
143=head1 CAVEATS
144
145=over
146
147=item This probably does nothing.
148
149=item This works only on 5.10+
150
151At least it's backwards compatible in not doing much.
152
153=back
f06db76b
AD
154
155=cut