xref: /openbsd-src/gnu/usr.bin/perl/lib/less.pm (revision b39c515898423c8d899e35282f4b395f7cad3298)
14a4f25f9Sdownsjpackage less;
2850e2753Smillertuse strict;
3850e2753Smillertuse warnings;
44a4f25f9Sdownsj
5*b39c5158Smillertour $VERSION = '0.03';
6850e2753Smillert
7850e2753Smillertsub _pack_tags {
8850e2753Smillert    return join ' ', @_;
9850e2753Smillert}
10850e2753Smillert
11850e2753Smillertsub _unpack_tags {
12850e2753Smillert    return grep { defined and length }
13850e2753Smillert        map  { split ' ' }
14850e2753Smillert        grep {defined} @_;
15850e2753Smillert}
16850e2753Smillert
17*b39c5158Smillertsub stash_name { $_[0] }
18*b39c5158Smillert
19850e2753Smillertsub of {
20850e2753Smillert    my $class = shift @_;
21850e2753Smillert
22850e2753Smillert    # If no one wants the result, don't bother computing it.
23850e2753Smillert    return unless defined wantarray;
24850e2753Smillert
25850e2753Smillert    my $hinthash = ( caller 0 )[10];
26850e2753Smillert    my %tags;
27*b39c5158Smillert    @tags{ _unpack_tags( $hinthash->{ $class->stash_name } ) } = ();
28850e2753Smillert
29850e2753Smillert    if (@_) {
30850e2753Smillert        exists $tags{$_} and return !!1 for @_;
31850e2753Smillert        return;
32850e2753Smillert    }
33850e2753Smillert    else {
34850e2753Smillert        return keys %tags;
35850e2753Smillert    }
36850e2753Smillert}
37850e2753Smillert
38850e2753Smillertsub import {
39850e2753Smillert    my $class = shift @_;
40*b39c5158Smillert    my $stash = $class->stash_name;
41850e2753Smillert
42850e2753Smillert    @_ = 'please' if not @_;
43850e2753Smillert    my %tags;
44*b39c5158Smillert    @tags{ _unpack_tags( @_, $^H{ $stash } ) } = ();
45850e2753Smillert
46*b39c5158Smillert    $^H{$stash} = _pack_tags( keys %tags );
47850e2753Smillert    return;
48850e2753Smillert}
49850e2753Smillert
50850e2753Smillertsub unimport {
51850e2753Smillert    my $class = shift @_;
52850e2753Smillert
53850e2753Smillert    if (@_) {
54850e2753Smillert        my %tags;
55850e2753Smillert        @tags{ _unpack_tags( $^H{$class} ) } = ();
56850e2753Smillert        delete @tags{ _unpack_tags(@_) };
57850e2753Smillert        my $new = _pack_tags( keys %tags );
58850e2753Smillert
59850e2753Smillert        if ( not length $new ) {
60*b39c5158Smillert            delete $^H{ $class->stash_name };
61850e2753Smillert        }
62850e2753Smillert        else {
63*b39c5158Smillert            $^H{ $class->stash_name } = $new;
64850e2753Smillert        }
65850e2753Smillert    }
66850e2753Smillert    else {
67*b39c5158Smillert        delete $^H{ $class->stash_name };
68850e2753Smillert    }
69850e2753Smillert
70850e2753Smillert    return;
71850e2753Smillert}
72850e2753Smillert
73850e2753Smillert1;
74850e2753Smillert
75850e2753Smillert__END__
7655745691Smillert
774a4f25f9Sdownsj=head1 NAME
784a4f25f9Sdownsj
79850e2753Smillertless - perl pragma to request less of something
804a4f25f9Sdownsj
814a4f25f9Sdownsj=head1 SYNOPSIS
824a4f25f9Sdownsj
83850e2753Smillert    use less 'CPU';
844a4f25f9Sdownsj
854a4f25f9Sdownsj=head1 DESCRIPTION
864a4f25f9Sdownsj
87850e2753SmillertThis is a user-pragma. If you're very lucky some code you're using
88850e2753Smillertwill know that you asked for less CPU usage or ram or fat or... we
89850e2753Smillertjust can't know. Consult your documentation on everything you're
90850e2753Smillertcurrently using.
91850e2753Smillert
92850e2753SmillertFor general suggestions, try requesting C<CPU> or C<memory>.
934a4f25f9Sdownsj
944a4f25f9Sdownsj    use less 'memory';
954a4f25f9Sdownsj    use less 'CPU';
964a4f25f9Sdownsj    use less 'fat';
974a4f25f9Sdownsj
98850e2753SmillertIf you ask for nothing in particular, you'll be asking for C<less
99850e2753Smillert'please'>.
100850e2753Smillert
101850e2753Smillert    use less 'please';
102850e2753Smillert
103850e2753Smillert=head1 FOR MODULE AUTHORS
104850e2753Smillert
105850e2753SmillertL<less> has been in the core as a "joke" module for ages now and it
106850e2753Smillerthasn't had any real way to communicating any information to
107850e2753Smillertanything. Thanks to Nicholas Clark we have user pragmas (see
108850e2753SmillertL<perlpragma>) and now C<less> can do something.
109850e2753Smillert
110850e2753SmillertYou can probably expect your users to be able to guess that they can
111850e2753Smillertrequest less CPU or memory or just "less" overall.
112850e2753Smillert
113850e2753SmillertIf the user didn't specify anything, it's interpreted as having used
114850e2753Smillertthe C<please> tag. It's up to you to make this useful.
115850e2753Smillert
116850e2753Smillert  # equivalent
117850e2753Smillert  use less;
118850e2753Smillert  use less 'please';
119850e2753Smillert
120850e2753Smillert=head2 C<< BOOLEAN = less->of( FEATURE ) >>
121850e2753Smillert
122850e2753SmillertThe class method C<< less->of( NAME ) >> returns a boolean to tell you
123850e2753Smillertwhether your user requested less of something.
124850e2753Smillert
125850e2753Smillert  if ( less->of( 'CPU' ) ) {
126850e2753Smillert      ...
127850e2753Smillert  }
128850e2753Smillert  elsif ( less->of( 'memory' ) ) {
129850e2753Smillert
130850e2753Smillert  }
131850e2753Smillert
132850e2753Smillert=head2 C<< FEATURES = less->of() >>
133850e2753Smillert
134850e2753SmillertIf you don't ask for any feature, you get the list of features that
135850e2753Smillertthe user requested you to be nice to. This has the nice side effect
136850e2753Smillertthat if you don't respect anything in particular then you can just ask
137850e2753Smillertfor it and use it like a boolean.
138850e2753Smillert
139850e2753Smillert  if ( less->of ) {
140850e2753Smillert      ...
141850e2753Smillert  }
142850e2753Smillert  else {
143850e2753Smillert      ...
144850e2753Smillert  }
145850e2753Smillert
146850e2753Smillert=head1 CAVEATS
147850e2753Smillert
148850e2753Smillert=over
149850e2753Smillert
150850e2753Smillert=item This probably does nothing.
151850e2753Smillert
152850e2753Smillert=item This works only on 5.10+
153850e2753Smillert
154850e2753SmillertAt least it's backwards compatible in not doing much.
155850e2753Smillert
156850e2753Smillert=back
1574a4f25f9Sdownsj
1584a4f25f9Sdownsj=cut
159