Pragmatic-1.7/0040700000175600010010000000000010215653316012375 5ustar binkleyNonePragmatic-1.7/ChangeLog0100644000175600010010000000000006767525051014157 0ustar binkleyNonePragmatic-1.7/lib/0040700000175600010010000000000010215653316013143 5ustar binkleyNonePragmatic-1.7/lib/Pragmatic.pm0100755000175600010010000001565610215653274015442 0ustar binkleyNonepackage Pragmatic; require 5.001; # ?? require Exporter; use strict; use vars qw (@ISA $VERSION); @ISA = qw (Exporter); # The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = '1.7'; my $rcs = '$Id: Pragmatic.pm 164 2005-03-15 21:42:20Z binkley $' ; sub import ($) { my $package = shift; return $package->export_to_level (1, $package, @_) if $package eq __PACKAGE__; my $warn = sub (;$) { require Carp; local $Carp::CarpLevel = 2; # relocate to calling package Carp::carp (@_); }; my $die = sub (;$) { require Carp; local $Carp::CarpLevel = 2; # relocate to calling package Carp::croak (@_); }; my @imports = grep /^[^-]/, @_; my @pragmata = map { substr($_, 1); } grep /^-/, @_; # Export first, for side-effects (e.g., importing globals, then # setting them with pragmata): $package->export_to_level (1, $package, @imports) if @imports; for (@pragmata) { no strict qw (refs); my ($pragma, $args) = split /=/, $_; my (@args) = split /,/, $args || ''; exists ${"$package\::PRAGMATA"}{$pragma} or &$die ("No such pragma '$pragma'"); if (ref ${"$package\::PRAGMATA"}{$pragma} eq 'CODE') { &{${"$package\::PRAGMATA"}{$pragma}} ($package, @args) or &$warn ("Pragma '$pragma' failed"); # Let inheritance work for barewords: } elsif (my $ref = $package->can (${"$package\::PRAGMATA"}{$pragma})) { &$ref ($package, @args) or &$warn ("Pragma '$pragma' failed"); } else { &$die ("Invalid pragma '$pragma'"); } } } 1; __END__ =head1 NAME Pragmatic - Adds pragmata to Exporter =head1 SYNOPSIS In module MyModule.pm: package MyModule; require Pragmatic; @ISA = qw (Pragmatic); %PRAGMATA = (mypragma => sub {...}); In other files which wish to use MyModule: use MyModule qw (-mypragma); # Execute pragma at import time use MyModule qw (-mypragma=1,2,3); # Pass pragma argument list =head1 DESCRIPTION B implements a default C method for processing pragmata before passing the rest of the import to B. Perl automatically calls the C method when processing a C statement for a module. Modules and C are documented in L and L. (Do not confuse B with I, such as I, I and the like. They are standalone pragmata, and are not associated with any other module.) =head2 Using Pragmatic Modules Using Pragmatic modules is very simple. To invoke any particular pragma for a given module, include it in the argument list to C preceded by a hyphen: use MyModule qw (-mypragma); C will filter out these arguments, and pass the remainder of the argument list from the C statement to C (actually, to C so that B is transparent). If you want to pass the pragma arguments, use syntax similar to that of the I<-M> switch to B (see L): use MyModule qw (-mypragma=abc,1,2,3); If there are any warnings or fatal errors, they will appear to come from the C statement, not from C. =head2 Writing Pragmatic Modules Writing Pragmatic modules with B is straight-forward. First, C (you could C it instead, but it exports nothing, so there is little to gain thereby). Declare a package global C<%PRAGMATA>, the keys of which are the names of the pragmata and their corresponding values the code references to invoke. Like this: package MyPackage; require Pragmatic; use strict; use vars qw (%PRAGMATA); sub something_else { 1; } %PRAGMATA = (first => sub { print "@_: first\n"; }, second => sub { $SOME_GLOBAL = 1; }, third => \&something_else, fourth => 'name_of_sub'); When a pragma is given in a C statement, the leading hyphen is removed, and the code reference corresponding to that key in C<%PRAGMATA>, or a subroutine with the value's name, is invoked with the name of the package as the first member of the argument list (this is the same as what happens with C). Additionally, any arguments given by the caller are included (see L, above). =head1 EXAMPLES =head2 Using Pragmatic Modules =over =item 1. Simple use: use MyModule; # no pragmas use MyModule qw (-abc); # invoke C use MyModule qw (-p1 -p2); # invoke C, then C =item 2. Using an argument list: use MyModule qw (-abc=1,2,3); # invoke C with (1, 2, 3) use MyModule qw (-p1 -p2=here); # invoke C, then C # with (1, 2, 3) =item 3. Mixing with arguments for B: (Please see L for a further explanatation.) use MyModule ( ); # no pragmas, no exports use MyModule qw (fun1 -abc fun2); # import C, invoke C, # then import C use MyModule qw (:set1 -abc=3); # import set C, invoke C # with (3) =back =head2 Writing Pragmatic Modules =over =item 1. Setting a package global: %PRAGMATA = (debug => sub { $DEBUG = 1; }); =item 2. Selecting a method: my $fred = sub { 'fred'; }; my $barney = sub { 'barney'; }; %PRAGMATA = (fred => sub { local $^W = 0; *flintstone = $fred; }, barney => sub { local $^W = 0; *flintstone = $barney; }); =item 3. Changing inheritance: %PRAGMATA = (super => sub { shift; push @ISA, @_; }); =item 4. Inheriting pragmata: package X; @ISA = qw(Pragmatic); %PRAGMATA = (debug => 'debug'); $DEBUG = 0; sub debug { ${"$_[0]::DEBUG"} = 1; } package Y: @ISA = qw(X); %PRAGMATA = (debug => 'debug'); $DEBUG = 0; =back =head1 SEE ALSO L B does all the heavy-lifting (and is a very interesting module to study) after B has stripped out the pragmata from the C. =head1 DIAGNOSTICS The following are the diagnostics generated by B. Items marked "(W)" are non-fatal (invoke C); those marked "(F)" are fatal (invoke C). =over =item No such pragma '%s' (F) The caller tried something like "use MyModule (-xxx)" where there was no pragma I defined for MyModule. =item Invalid pragma '%s' (F) The writer of the called package tried something like "%PRAGMATA = (xxx => not_a_sub)" and either assigned I a non-code reference, or I is not a method in that package. =item Pragma '%s' failed (W) The pramga returned a false value. The module is possibly in an inconsisten state after this. Proceed with caution. =back =head1 AUTHORS B. K. Oxley (binkley) Ebinkley@alumni.rice.eduE =head1 COPYRIGHT Copyright 1999-2005, B. K. Oxley. This library is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 THANKS Thanks to Kevin Caswick EKCaswick@wspackaging.comE for a great patch to run under Perl 5.8. =cut Pragmatic-1.7/Makefile.PL0100644000175600010010000000060610215652574014365 0ustar binkleyNonerequire 5.005; use strict; use ExtUtils::MakeMaker; WriteMakefile (AUTHOR => 'B. K. Oxley (binkley) ', ABSTRACT => 'Exporter with pragma support', NAME => 'Pragmatic', VERSION_FROM => 'lib/Pragmatic.pm'); package MY; # Auto-generate the README from lib/Pramatic.pm: sub postamble { q| README: $(VERSION_FROM) perldoc -t $< > $@ all:: README |; } Pragmatic-1.7/MANIFEST0100644000175600010010000000032310215653316013533 0ustar binkleyNonelib/Pragmatic.pm t/01load.t t/02simple.t t/03args.t t/04complex.t t/05isa.t t/06export.t ChangeLog MANIFEST Makefile.PL README TODO META.yml Module meta-data (added by MakeMaker) Pragmatic-1.7/META.yml0100644000175600010010000000045510215653316013661 0ustar binkleyNone# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Pragmatic version: 1.7 version_from: lib/Pragmatic.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Pragmatic-1.7/README0100644000175600010010000001325410215653310013263 0ustar binkleyNoneNAME Pragmatic - Adds pragmata to Exporter SYNOPSIS In module MyModule.pm: package MyModule; require Pragmatic; @ISA = qw (Pragmatic); %PRAGMATA = (mypragma => sub {...}); In other files which wish to use MyModule: use MyModule qw (-mypragma); # Execute pragma at import time use MyModule qw (-mypragma=1,2,3); # Pass pragma argument list DESCRIPTION Pragmatic implements a default "import" method for processing pragmata before passing the rest of the import to Exporter. Perl automatically calls the "import" method when processing a "use" statement for a module. Modules and "use" are documented in perlfunc and perlmod. (Do not confuse Pragmatic with *pragmatic modules*, such as *less*, *strict* and the like. They are standalone pragmata, and are not associated with any other module.) Using Pragmatic Modules Using Pragmatic modules is very simple. To invoke any particular pragma for a given module, include it in the argument list to "use" preceded by a hyphen: use MyModule qw (-mypragma); "Pragmatic::import" will filter out these arguments, and pass the remainder of the argument list from the "use" statement to "Exporter::import" (actually, to "Exporter::export_to_level" so that Pragmatic is transparent). If you want to pass the pragma arguments, use syntax similar to that of the *-M* switch to perl (see perlrun): use MyModule qw (-mypragma=abc,1,2,3); If there are any warnings or fatal errors, they will appear to come from the "use" statement, not from "Pragmatic::import". Writing Pragmatic Modules Writing Pragmatic modules with Pragmatic is straight-forward. First, "require Pragmatic" (you could "use" it instead, but it exports nothing, so there is little to gain thereby). Declare a package global %PRAGMATA, the keys of which are the names of the pragmata and their corresponding values the code references to invoke. Like this: package MyPackage; require Pragmatic; use strict; use vars qw (%PRAGMATA); sub something_else { 1; } %PRAGMATA = (first => sub { print "@_: first\n"; }, second => sub { $SOME_GLOBAL = 1; }, third => \&something_else, fourth => 'name_of_sub'); When a pragma is given in a "use" statement, the leading hyphen is removed, and the code reference corresponding to that key in %PRAGMATA, or a subroutine with the value's name, is invoked with the name of the package as the first member of the argument list (this is the same as what happens with "import"). Additionally, any arguments given by the caller are included (see "Using Pragmatic Modules", above). EXAMPLES Using Pragmatic Modules 1. Simple use: use MyModule; # no pragmas use MyModule qw (-abc); # invoke C use MyModule qw (-p1 -p2); # invoke C, then C 2. Using an argument list: use MyModule qw (-abc=1,2,3); # invoke C with (1, 2, 3) use MyModule qw (-p1 -p2=here); # invoke C, then C # with (1, 2, 3) 3. Mixing with arguments for Exporter: (Please see Exporter for a further explanatation.) use MyModule ( ); # no pragmas, no exports use MyModule qw (fun1 -abc fun2); # import C, invoke C, # then import C use MyModule qw (:set1 -abc=3); # import set C, invoke C # with (3) Writing Pragmatic Modules 1. Setting a package global: %PRAGMATA = (debug => sub { $DEBUG = 1; }); 2. Selecting a method: my $fred = sub { 'fred'; }; my $barney = sub { 'barney'; }; %PRAGMATA = (fred => sub { local $^W = 0; *flintstone = $fred; }, barney => sub { local $^W = 0; *flintstone = $barney; }); 3. Changing inheritance: %PRAGMATA = (super => sub { shift; push @ISA, @_; }); 4. Inheriting pragmata: package X; @ISA = qw(Pragmatic); %PRAGMATA = (debug => 'debug'); $DEBUG = 0; sub debug { ${"$_[0]::DEBUG"} = 1; } package Y: @ISA = qw(X); %PRAGMATA = (debug => 'debug'); $DEBUG = 0; SEE ALSO Exporter Exporter does all the heavy-lifting (and is a very interesting module to study) after Pragmatic has stripped out the pragmata from the "use". DIAGNOSTICS The following are the diagnostics generated by Pragmatic. Items marked "(W)" are non-fatal (invoke "Carp::carp"); those marked "(F)" are fatal (invoke "Carp::croak"). No such pragma '%s' (F) The caller tried something like "use MyModule (-xxx)" where there was no pragma *xxx* defined for MyModule. Invalid pragma '%s' (F) The writer of the called package tried something like "%PRAGMATA = (xxx => not_a_sub)" and either assigned *xxx* a non-code reference, or *xxx* is not a method in that package. Pragma '%s' failed (W) The pramga returned a false value. The module is possibly in an inconsisten state after this. Proceed with caution. AUTHORS B. K. Oxley (binkley) COPYRIGHT Copyright 1999-2005, B. K. Oxley. This library is free software; you may redistribute it and/or modify it under the same terms as Perl itself. THANKS Thanks to Kevin Caswick for a great patch to run under Perl 5.8. Pragmatic-1.7/t/0040700000175600010010000000000010215653316012640 5ustar binkleyNonePragmatic-1.7/t/01load.t0100644000175600010010000000020506771444342014122 0ustar binkleyNone# Emacs, this is -*-perl-*- code. BEGIN { use Test; plan tests => 1; } use strict; use Test; eval "use Pragmatic;"; ok (not $@); Pragmatic-1.7/t/02simple.t0100644000175600010010000000114006771444342014474 0ustar binkleyNone# Emacs, this is -*- perl -*- code. BEGIN { use Test; plan tests => 4; } use Test; # Test 1: eval join '', ; ok (not $@); # Test 2: eval { import X qw (-abc); }; ok (not $@); # Test 3, 4: eval { import Y qw (-def); }; ok (not $@); ok ($Y::DEBUG, 1); # Get rid of "used only once" warning: do { 1; } if $Y::DEBUG; __DATA__ package X; use strict; use vars qw(@ISA %PRAGMATA); require Pragmatic; @ISA = qw(Pragmatic); %PRAGMATA = (abc => sub { 1; }); 1; package Y; use strict; use vars qw ($DEBUG @ISA %PRAGMATA); $DEBUG = 0; @ISA = qw(X); %PRAGMATA = (def => sub { $DEBUG = 1; }); 1; Pragmatic-1.7/t/03args.t0100644000175600010010000000075206771444342014150 0ustar binkleyNone# Emacs, this is -*- perl -*- code. BEGIN { use Test; plan tests => 5; } use strict; use Test; # Test 1: eval join '', ; ok (not $@); # Test 2, 3: eval { import X qw (-abc); }; ok (not $@); ok ($X::DEBUG, 0); # Test 4, 5: eval { import X qw (-abc=fox); }; ok (not $@); ok ($X::DEBUG, 'fox'); __DATA__ package X; use strict; use vars qw($DEBUG @ISA %PRAGMATA); require Pragmatic; $DEBUG = 0; @ISA = qw(Pragmatic); %PRAGMATA = (abc => sub { $DEBUG = $_[1] || 0; 1; }); 1; Pragmatic-1.7/t/04complex.t0100644000175600010010000000220106771677332014662 0ustar binkleyNone# Emacs, this is -*- perl -*- code. BEGIN { use Test; plan tests => 11; } use Test; # Test 1: eval join '', ; ok (not $@); # Test 2, 3: eval { import X; }; ok (not $@); eval { X->flintstone; }; # die ok ($@); # Test 4, 5: eval { import X qw (-fred); }; ok (not $@); ok (X->flintstone, 'fred'); # Test 6, 7: eval { import X qw (-barney); }; ok (not $@); ok (X->flintstone, 'barney'); # Test 8, 9: eval { import X qw (-flintstone=wilma); }; ok (not $@); ok (X->flintstone, 'wilma'); # Test 10, 11: eval { import X qw (-flintstone=betty); }; ok (not $@); eval { X->flintstone; }; # die ok ($@); __DATA__ package X; use strict; use vars qw($DEBUG @ISA %PRAGMATA); require Pragmatic; $DEBUG = 0; @ISA = qw(Pragmatic); my $fred = sub { 'fred'; }; my $barney = sub { 'barney'; }; sub wilma { 'wilma'; } # no sub betty # Need to suppress 'Subroutine %s redefined' warnings: %PRAGMATA = (fred => sub { local $^W = 0; *flintstone = $fred; }, barney => sub { local $^W = 0; *flintstone = $barney; }, flintstone => sub { no strict qw(refs); local $^W = 0; *flintstone = *{$_[1]}; }); 1; Pragmatic-1.7/t/05isa.t0100644000175600010010000000112406771444342013764 0ustar binkleyNone# Emacs, this is -*- perl -*- code. BEGIN { use Test; plan tests => 5; } use strict; use Test; # Test 1: eval join '', ; ok (not $@); # Test 2, 3: eval { import X; }; ok (not $@); ok (X->physics, 'fun'); # Test 4, 5: eval { import X qw(-notso); }; ok (not $@); ok (X->physics, 'nofun'); __DATA__ package Truth; sub physics { 'fun'; } package Untruth; sub physics { 'nofun'; } package X; use strict; use vars qw(@ISA %PRAGMATA); require Pragmatic; @ISA = qw(Pragmatic Truth); %PRAGMATA = (notso => sub { @ISA = map { $_ eq 'Truth' and $_ = 'Untruth' } @ISA; }); 1; Pragmatic-1.7/t/06export.t0100644000175600010010000000077306771444342014543 0ustar binkleyNone# Emacs, this is -*- perl -*- code. BEGIN { use Test; plan tests => 5; } use strict; no strict qw(refs subs); # permit ${::}{...} use Test; # Test 1: eval join '', ; ok (not $@); # Test 2, 3: eval { import X; }; ok (not $@); ok (exists ${::}{abc}, ''); # Test 4, 5: eval { import X qw(abc); }; ok (not $@); ok (exists ${::}{abc}, 1); __DATA__ package X; use strict; use vars qw(@EXPORT_OK @ISA %PRAGMATA); require Pragmatic; @EXPORT_OK = qw(abc); @ISA = qw(Pragmatic); sub abc { 1; } 1; Pragmatic-1.7/TODO0100644000175600010010000000000006767525051013075 0ustar binkleyNone