lib/less.pm

   1 package less;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION = '0.02';
   6
   7 sub _pack_tags {
   8     return join ' ', @_;
   9 }
  10
  11 sub _unpack_tags {
  12     return grep { defined and length }
  13         map  { split ' ' }
  14         grep {defined} @_;
  15 }
  16
  17 sub stash_name { $_[0] }
  18
  19 sub 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
  38 sub import {
  39     my $class = shift @_;
  40
  41     @_ = 'please' if not @_;
  42     my %tags;
  43     @tags{ _unpack_tags( @_, $^H{ $class->stash_name } ) } = ();
  44
  45     $^H{$class} = _pack_tags( keys %tags );
  46     return;
  47 }
  48
  49 sub unimport {
  50     my $class = shift @_;
  51
  52     if (@_) {
  53         my %tags;
  54         @tags{ _unpack_tags( $^H{$class} ) } = ();
  55         delete @tags{ _unpack_tags(@_) };
  56         my $new = _pack_tags( keys %tags );
  57
  58         if ( not length $new ) {
  59             delete $^H{ $class->stash_name };
  60         }
  61         else {
  62             $^H{ $class->stash_name } = $new;
  63         }
  64     }
  65     else {
  66         delete $^H{ $class->stash_name };
  67     }
  68
  69     return;
  70 }
  71
  72 1;
  73
  74 __END__
  75
  76 =head1 NAME
  77
  78 less - perl pragma to request less of something
  79
  80 =head1 SYNOPSIS
  81
  82     use less 'CPU';
  83
  84 =head1 DESCRIPTION
  85
  86 This is a user-pragma. If you're very lucky some code you're using
  87 will know that you asked for less CPU usage or ram or fat or... we
  88 just can't know. Consult your documentation on everything you're
  89 currently using.
  90
  91 For general suggestions, try requesting C<CPU> or C<memory>.
  92
  93     use less 'memory';
  94     use less 'CPU';
  95     use less 'fat';
  96
  97 If you ask for nothing in particular, you'll be asking for C<less
  98 'please'>.
  99
 100     use less 'please';
 101
 102 =head1 FOR MODULE AUTHORS
 103
 104 L<less> has been in the core as a "joke" module for ages now and it
 105 hasn't had any real way to communicating any information to
 106 anything. Thanks to Nicholas Clark we have user pragmas (see
 107 L<perlpragma>) and now C<less> can do something.
 108
 109 You can probably expect your users to be able to guess that they can
 110 request less CPU or memory or just "less" overall.
 111
 112 If the user didn't specify anything, it's interpreted as having used
 113 the C<please> tag. It's up to you to make this useful.
 114
 115   # equivalent
 116   use less;
 117   use less 'please';
 118
 119 =head2 C<< BOOLEAN = less->of( FEATURE ) >>
 120
 121 The class method C<< less->of( NAME ) >> returns a boolean to tell you
 122 whether your user requested less of something.
 123
 124   if ( less->of( 'CPU' ) ) {
 125       ...
 126   }
 127   elsif ( less->of( 'memory' ) ) {
 128
 129   }
 130
 131 =head2 C<< FEATURES = less->of() >>
 132
 133 If you don't ask for any feature, you get the list of features that
 134 the user requested you to be nice to. This has the nice side effect
 135 that if you don't respect anything in particular then you can just ask
 136 for it and use it like a boolean.
 137
 138   if ( less->of ) {
 139       ...
 140   }
 141   else {
 142       ...
 143   }
 144
 145 =head1 CAVEATS
 146
 147 =over
 148
 149 =item This probably does nothing.
 150
 151 =item This works only on 5.10+
 152
 153 At least it's backwards compatible in not doing much.
 154
 155 =back
 156
 157 =cut