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