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 159