Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Journal of jjore (6662)

Thursday December 07, 2006
03:39 PM

pragma.pm plays well with others

[ #31842 ]

For kicks I wrote the pragma pragma which just mucks with other user pragmas. I'm not sure what good this is except that I wanted a simple API to poke at other people's pragmas. I might even upload this to CPAN just so it's handy.

package pragma;
use strict;
use warnings;
 
our $VERSION = ~0;
 
=head1 NAME
 
pragma - A pragma for controlling other user pragmas
 
=head1 DESCRIPTION
 
The C<pragma> pragma is a module which influences other user pragmata
such as L<lint>. With Perl 5.10 you can create user pragmata and the
C<pragma> pragma can modify and peek at other pragmata.
 
=head1 A basic example
 
Assume you're using the C<myint> pragma mentioned in
L<perlpragma>. For ease, that pragma is duplicated here.
 
    package myint;
 
    use strict;
    use warnings;
 
    sub import {
        $^H{myint} = 1;
    }
 
    sub unimport {
        $^H{myint} = 0;
    }
 
    sub value {
        my $level = shift // 0;
        my $hinthash = (caller($level))[10];
        return $hinthash->{myint};
    }
 
    1;
 
Other code might casually wish to dip into C<myint>:
 
    no pragma 'myint';      # delete $^H{myint}
    use pragma myint => 42; # $^H{myint} = 42
 
    print pragma->peek( 'myint' ); # prints '42'
 
=cut
 
=head1 CLASS METHODS
 
=over
 
=item C<< use pragma PRAGMA => VALUE >>
 
=item C<< pragma->import( PRAGMA => VALUE ) >>
 
=item C<< pragma->poke( PRAGMA => VALUE ) >>
 
Sets C<PRAGMA>'s value to C<VALUE>.
 
=cut
 
sub import {
    my ( undef, $pragma, $value ) = @_;
 
    $^H{$pragma} = $value;
    return;
}
*poke = \&import;
 
=item C<< no pragma PRAGMA >>
 
=item C<< pragma->unimport( PRAGMA ) >>
 
Unsets C<PRAGMA>.
 
=cut
 
sub unimport {
    my ( undef, $pragma ) = @_;
 
    delete $^H{$pragma} if exists $^H{$pragma};
    return;
}
 
=item C<< pragma->peek( PRAGMA ) >>
 
Returns the current value of C<PRAGMA>.
 
=cut
 
sub peek {
    my ( undef, $pragma ) = @_;
 
    return $^H{$pragma};
}
 
=back
 
=head1 SUBCLASSING
 
All methods may be subclassed.
 
=cut
 
q[And I don't think an entire stallion of horses, or a tank, could stop you two from getting married.];

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.