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 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