summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/less.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/less.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/less.pm158
1 files changed, 158 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/less.pm b/Master/tlpkg/tlperl/lib/less.pm
new file mode 100644
index 00000000000..d2528dfeaf9
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/less.pm
@@ -0,0 +1,158 @@
+package less;
+use strict;
+use warnings;
+
+our $VERSION = '0.03';
+
+sub _pack_tags {
+ return join ' ', @_;
+}
+
+sub _unpack_tags {
+ return grep { defined and length }
+ map { split ' ' }
+ grep {defined} @_;
+}
+
+sub stash_name { $_[0] }
+
+sub of {
+ my $class = shift @_;
+
+ # If no one wants the result, don't bother computing it.
+ return unless defined wantarray;
+
+ my $hinthash = ( caller 0 )[10];
+ my %tags;
+ @tags{ _unpack_tags( $hinthash->{ $class->stash_name } ) } = ();
+
+ if (@_) {
+ exists $tags{$_} and return !!1 for @_;
+ return;
+ }
+ else {
+ return keys %tags;
+ }
+}
+
+sub import {
+ my $class = shift @_;
+ my $stash = $class->stash_name;
+
+ @_ = 'please' if not @_;
+ my %tags;
+ @tags{ _unpack_tags( @_, $^H{ $stash } ) } = ();
+
+ $^H{$stash} = _pack_tags( keys %tags );
+ return;
+}
+
+sub unimport {
+ my $class = shift @_;
+
+ if (@_) {
+ my %tags;
+ @tags{ _unpack_tags( $^H{$class} ) } = ();
+ delete @tags{ _unpack_tags(@_) };
+ my $new = _pack_tags( keys %tags );
+
+ if ( not length $new ) {
+ delete $^H{ $class->stash_name };
+ }
+ else {
+ $^H{ $class->stash_name } = $new;
+ }
+ }
+ else {
+ delete $^H{ $class->stash_name };
+ }
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+less - perl pragma to request less of something
+
+=head1 SYNOPSIS
+
+ use less 'CPU';
+
+=head1 DESCRIPTION
+
+This is a user-pragma. If you're very lucky some code you're using
+will know that you asked for less CPU usage or ram or fat or... we
+just can't know. Consult your documentation on everything you're
+currently using.
+
+For general suggestions, try requesting C<CPU> or C<memory>.
+
+ use less 'memory';
+ use less 'CPU';
+ use less 'fat';
+
+If you ask for nothing in particular, you'll be asking for C<less
+'please'>.
+
+ use less 'please';
+
+=head1 FOR MODULE AUTHORS
+
+L<less> has been in the core as a "joke" module for ages now and it
+hasn't had any real way to communicating any information to
+anything. Thanks to Nicholas Clark we have user pragmas (see
+L<perlpragma>) and now C<less> can do something.
+
+You can probably expect your users to be able to guess that they can
+request less CPU or memory or just "less" overall.
+
+If the user didn't specify anything, it's interpreted as having used
+the C<please> tag. It's up to you to make this useful.
+
+ # equivalent
+ use less;
+ use less 'please';
+
+=head2 C<< BOOLEAN = less->of( FEATURE ) >>
+
+The class method C<< less->of( NAME ) >> returns a boolean to tell you
+whether your user requested less of something.
+
+ if ( less->of( 'CPU' ) ) {
+ ...
+ }
+ elsif ( less->of( 'memory' ) ) {
+
+ }
+
+=head2 C<< FEATURES = less->of() >>
+
+If you don't ask for any feature, you get the list of features that
+the user requested you to be nice to. This has the nice side effect
+that if you don't respect anything in particular then you can just ask
+for it and use it like a boolean.
+
+ if ( less->of ) {
+ ...
+ }
+ else {
+ ...
+ }
+
+=head1 CAVEATS
+
+=over
+
+=item This probably does nothing.
+
+=item This works only on 5.10+
+
+At least it's backwards compatible in not doing much.
+
+=back
+
+=cut