lib/less.pm

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