14a4f25f9Sdownsjpackage less; 2850e2753Smillertuse strict; 3850e2753Smillertuse warnings; 44a4f25f9Sdownsj 5*b39c5158Smillertour $VERSION = '0.03'; 6850e2753Smillert 7850e2753Smillertsub _pack_tags { 8850e2753Smillert return join ' ', @_; 9850e2753Smillert} 10850e2753Smillert 11850e2753Smillertsub _unpack_tags { 12850e2753Smillert return grep { defined and length } 13850e2753Smillert map { split ' ' } 14850e2753Smillert grep {defined} @_; 15850e2753Smillert} 16850e2753Smillert 17*b39c5158Smillertsub stash_name { $_[0] } 18*b39c5158Smillert 19850e2753Smillertsub of { 20850e2753Smillert my $class = shift @_; 21850e2753Smillert 22850e2753Smillert # If no one wants the result, don't bother computing it. 23850e2753Smillert return unless defined wantarray; 24850e2753Smillert 25850e2753Smillert my $hinthash = ( caller 0 )[10]; 26850e2753Smillert my %tags; 27*b39c5158Smillert @tags{ _unpack_tags( $hinthash->{ $class->stash_name } ) } = (); 28850e2753Smillert 29850e2753Smillert if (@_) { 30850e2753Smillert exists $tags{$_} and return !!1 for @_; 31850e2753Smillert return; 32850e2753Smillert } 33850e2753Smillert else { 34850e2753Smillert return keys %tags; 35850e2753Smillert } 36850e2753Smillert} 37850e2753Smillert 38850e2753Smillertsub import { 39850e2753Smillert my $class = shift @_; 40*b39c5158Smillert my $stash = $class->stash_name; 41850e2753Smillert 42850e2753Smillert @_ = 'please' if not @_; 43850e2753Smillert my %tags; 44*b39c5158Smillert @tags{ _unpack_tags( @_, $^H{ $stash } ) } = (); 45850e2753Smillert 46*b39c5158Smillert $^H{$stash} = _pack_tags( keys %tags ); 47850e2753Smillert return; 48850e2753Smillert} 49850e2753Smillert 50850e2753Smillertsub unimport { 51850e2753Smillert my $class = shift @_; 52850e2753Smillert 53850e2753Smillert if (@_) { 54850e2753Smillert my %tags; 55850e2753Smillert @tags{ _unpack_tags( $^H{$class} ) } = (); 56850e2753Smillert delete @tags{ _unpack_tags(@_) }; 57850e2753Smillert my $new = _pack_tags( keys %tags ); 58850e2753Smillert 59850e2753Smillert if ( not length $new ) { 60*b39c5158Smillert delete $^H{ $class->stash_name }; 61850e2753Smillert } 62850e2753Smillert else { 63*b39c5158Smillert $^H{ $class->stash_name } = $new; 64850e2753Smillert } 65850e2753Smillert } 66850e2753Smillert else { 67*b39c5158Smillert delete $^H{ $class->stash_name }; 68850e2753Smillert } 69850e2753Smillert 70850e2753Smillert return; 71850e2753Smillert} 72850e2753Smillert 73850e2753Smillert1; 74850e2753Smillert 75850e2753Smillert__END__ 7655745691Smillert 774a4f25f9Sdownsj=head1 NAME 784a4f25f9Sdownsj 79850e2753Smillertless - perl pragma to request less of something 804a4f25f9Sdownsj 814a4f25f9Sdownsj=head1 SYNOPSIS 824a4f25f9Sdownsj 83850e2753Smillert use less 'CPU'; 844a4f25f9Sdownsj 854a4f25f9Sdownsj=head1 DESCRIPTION 864a4f25f9Sdownsj 87850e2753SmillertThis is a user-pragma. If you're very lucky some code you're using 88850e2753Smillertwill know that you asked for less CPU usage or ram or fat or... we 89850e2753Smillertjust can't know. Consult your documentation on everything you're 90850e2753Smillertcurrently using. 91850e2753Smillert 92850e2753SmillertFor general suggestions, try requesting C<CPU> or C<memory>. 934a4f25f9Sdownsj 944a4f25f9Sdownsj use less 'memory'; 954a4f25f9Sdownsj use less 'CPU'; 964a4f25f9Sdownsj use less 'fat'; 974a4f25f9Sdownsj 98850e2753SmillertIf you ask for nothing in particular, you'll be asking for C<less 99850e2753Smillert'please'>. 100850e2753Smillert 101850e2753Smillert use less 'please'; 102850e2753Smillert 103850e2753Smillert=head1 FOR MODULE AUTHORS 104850e2753Smillert 105850e2753SmillertL<less> has been in the core as a "joke" module for ages now and it 106850e2753Smillerthasn't had any real way to communicating any information to 107850e2753Smillertanything. Thanks to Nicholas Clark we have user pragmas (see 108850e2753SmillertL<perlpragma>) and now C<less> can do something. 109850e2753Smillert 110850e2753SmillertYou can probably expect your users to be able to guess that they can 111850e2753Smillertrequest less CPU or memory or just "less" overall. 112850e2753Smillert 113850e2753SmillertIf the user didn't specify anything, it's interpreted as having used 114850e2753Smillertthe C<please> tag. It's up to you to make this useful. 115850e2753Smillert 116850e2753Smillert # equivalent 117850e2753Smillert use less; 118850e2753Smillert use less 'please'; 119850e2753Smillert 120850e2753Smillert=head2 C<< BOOLEAN = less->of( FEATURE ) >> 121850e2753Smillert 122850e2753SmillertThe class method C<< less->of( NAME ) >> returns a boolean to tell you 123850e2753Smillertwhether your user requested less of something. 124850e2753Smillert 125850e2753Smillert if ( less->of( 'CPU' ) ) { 126850e2753Smillert ... 127850e2753Smillert } 128850e2753Smillert elsif ( less->of( 'memory' ) ) { 129850e2753Smillert 130850e2753Smillert } 131850e2753Smillert 132850e2753Smillert=head2 C<< FEATURES = less->of() >> 133850e2753Smillert 134850e2753SmillertIf you don't ask for any feature, you get the list of features that 135850e2753Smillertthe user requested you to be nice to. This has the nice side effect 136850e2753Smillertthat if you don't respect anything in particular then you can just ask 137850e2753Smillertfor it and use it like a boolean. 138850e2753Smillert 139850e2753Smillert if ( less->of ) { 140850e2753Smillert ... 141850e2753Smillert } 142850e2753Smillert else { 143850e2753Smillert ... 144850e2753Smillert } 145850e2753Smillert 146850e2753Smillert=head1 CAVEATS 147850e2753Smillert 148850e2753Smillert=over 149850e2753Smillert 150850e2753Smillert=item This probably does nothing. 151850e2753Smillert 152850e2753Smillert=item This works only on 5.10+ 153850e2753Smillert 154850e2753SmillertAt least it's backwards compatible in not doing much. 155850e2753Smillert 156850e2753Smillert=back 1574a4f25f9Sdownsj 1584a4f25f9Sdownsj=cut 159