[Summary view] [Print] [Text view]

   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 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  
  36  sub 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  
  47  sub 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  1;
  71  
  72  __END__
  73  
  74  =head1 NAME
  75  
  76  less - perl pragma to request less of something
  77  
  78  =head1 SYNOPSIS
  79  
  80      use less 'CPU';
  81  
  82  =head1 DESCRIPTION
  83  
  84  This is a user-pragma. If you're very lucky some code you're using
  85  will know that you asked for less CPU usage or ram or fat or... we
  86  just can't know. Consult your documentation on everything you're
  87  currently using.
  88  
  89  For general suggestions, try requesting C<CPU> or C<memory>.
  90  
  91      use less 'memory';
  92      use less 'CPU';
  93      use less 'fat';
  94  
  95  If 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  
 102  L<less> has been in the core as a "joke" module for ages now and it
 103  hasn't had any real way to communicating any information to
 104  anything. Thanks to Nicholas Clark we have user pragmas (see
 105  L<perlpragma>) and now C<less> can do something.
 106  
 107  You can probably expect your users to be able to guess that they can
 108  request less CPU or memory or just "less" overall.
 109  
 110  If the user didn't specify anything, it's interpreted as having used
 111  the 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  
 119  The class method C<< less->of( NAME ) >> returns a boolean to tell you
 120  whether 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  
 131  If you don't ask for any feature, you get the list of features that
 132  the user requested you to be nice to. This has the nice side effect
 133  that if you don't respect anything in particular then you can just ask
 134  for 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  
 151  At least it's backwards compatible in not doing much.
 152  
 153  =back
 154  
 155  =cut