Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'issue/228'

Adding the ability to skip loading features.  For #228
  • Loading branch information...
commit 58376b4271794a12358c2b24b1499daa7a71abbb 2 parents 912a95c + 4afdb78
@schwern schwern authored
View
20 lib/perl5i.pm
@@ -1135,6 +1135,26 @@ If you write a one-liner without using this program, saying C<-Mperl5i> means
C<-Mperl5i::latest>. Please see L</"Using perl5i"> and L</VERSIONING> for
details.
+=head1 C<import>
+
+This subroutine is called automatically, see L<perlfunc/import>.
+
+When you write an exporting module that itself uses perl5i, you may want to
+disable some features that perl5i exports because they conflict with the
+additional modules you load. For example, when you load L<TryCatch> which
+provides its own C<try> keyword (exported subroutine, really), Perl will
+show the mandatory warning L<perldiag/"Prototype mismatch: %s vs %s">.
+You can avoid the name clash by passing to C<import> a parameter pair,
+where the key is the string C<-skip> and the value is an arrayref of
+strings that describe features that are not going to be activated, e.g.:
+
+ use perl5i::latest -skip => [qw(Try::Tiny)];
+
+The feature strings are: C<autobox>, C<autodie>, C<autovivification>,
+C<capture>, C<Carp::Fix::1_25>, C<Child>, C<CLASS>, C<die>, C<English>,
+C<File::chdir>, C<indirect>, C<list>, C<Meta>, C<Modern::Perl>,
+C<Perl6::Caller>, C<Signatures>, C<stat>, C<time>, C<true>, C<Try::Tiny>,
+C<utf8::all>, C<Want>.
=head1 BUGS
View
214 lib/perl5i/2.pm
@@ -9,92 +9,174 @@ use warnings;
#This should come first
use perl5i::2::RequireMessage;
-use IO::Handle;
use Carp::Fix::1_25;
-use perl5i::2::DateTime;
-use Want;
-use Try::Tiny;
-use perl5i::2::Meta;
-use Encode ();
use perl5i::2::autobox;
-use true;
use perl5i::VERSION; our $VERSION = perl5i::VERSION->VERSION;
our $Latest = perl5i::VERSION->latest;
-
-# This works around their lexical nature.
+my %Features = (
+ # A stub for autodie. It's handled specially in import().
+ autodie => sub {},
+ autobox => sub {
+ my ($class, $caller) = @_;
+
+ perl5i::2::autobox::import($class);
+ },
+ autovivification => sub {
+ my ($class, $caller) = @_;
+
+ # no autovivification;
+ require autovivification;
+ autovivification::unimport($class);
+ },
+ capture => sub {
+ my ($class, $caller) = @_;
+ (\&capture)->alias($caller, "capture");
+ },
+ "Carp::Fix::1_25" => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ["Carp::Fix::1_25"]);
+ },
+ Child => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['Child' => qw(child)]);
+ },
+ CLASS => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['CLASS']);
+ },
+ die => sub {
+ my ($class, $caller) = @_;
+ (\&perl5i_die)->alias($caller, "die");
+ },
+ English => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['English' => qw(-no_match_vars)]);
+ },
+ 'File::chdir' => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['File::chdir']);
+ },
+ indirect => sub {
+ my ($class, $caller) = @_;
+
+ # no indirect ':fatal'
+ require indirect;
+ indirect::unimport($class, ":fatal");
+ },
+ list => sub {
+ my ($class, $caller) = @_;
+ (\&force_list_context)->alias($caller, 'list');
+ },
+ Meta => sub {
+ require perl5i::2::Meta;
+ },
+ 'Modern::Perl' => sub {
+ my ($class, $caller) = @_;
+
+ # use Modern::Perl
+ require Modern::Perl;
+ Modern::Perl::import($caller);
+
+ # no strict vars for oneliners - GH #63
+ strict::unimport($class, 'vars')
+ if $class eq 'perl5i::cmd'
+ or $0 eq '-e';
+
+ # Modern::Perl won't pass this through to our caller.
+ require mro;
+ mro::set_mro($caller, 'c3');
+ },
+ 'Perl6::Caller' => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['Perl6::Caller']);
+ },
+ Signatures => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['perl5i::2::Signatures']);
+ },
+ stat => sub {
+ my ($class, $caller) = @_;
+
+ require File::stat;
+ # Export our stat and lstat
+ (\&stat)->alias($caller, 'stat');
+ (\&lstat)->alias($caller, 'lstat');
+ },
+ time => sub {
+ my ($class, $caller) = @_;
+
+ require perl5i::2::DateTime;
+ # Export our gmtime() and localtime()
+ (\&perl5i::2::DateTime::dt_gmtime)->alias($caller, 'gmtime');
+ (\&perl5i::2::DateTime::dt_localtime)->alias($caller, 'localtime');
+ (\&perl5i::2::DateTime::dt_time)->alias($caller, 'time');
+ },
+ true => sub {
+ my ($class, $caller) = @_;
+
+ # use true
+ require true;
+ true::import($class);
+ },
+ 'Try::Tiny' => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['Try::Tiny']);
+ },
+ 'utf8::all' => sub {
+ my ($class, $caller) = @_;
+
+ # use utf8::all
+ require utf8::all;
+ utf8::all::import($class);
+ },
+ Want => sub {
+ my ($class, $caller) = @_;
+ load_in_caller($caller, ['Want' => qw(want)]);
+ },
+);
+
+# This is necessary for autodie to work and be lexical
use parent 'autodie';
-use parent 'perl5i::2::autobox';
-use parent 'autovivification';
-use parent 'indirect';
-use parent 'utf8::all';
## no critic (Subroutines::RequireArgUnpacking)
sub import {
my $class = shift;
+ my %import = @_;
- require File::stat;
+ my $caller = caller;
- require Modern::Perl;
- Modern::Perl->import;
+ # Read the skip list and turn it into a hash
+ my $skips = delete $import{-skip} || [];
+ $skips = { map { $_ => 1 } @$skips };
- my $caller = caller;
+ # Any remaining import parameters are unknown
+ if( keys %import ) {
+ croak sprintf "Unknown parameters '%s' in import list",
+ join(", ", map { "$_ => $import{$_}" } keys %import);
+ }
- # Modern::Perl won't pass this through to our caller.
- require mro;
- mro::set_mro( $caller, 'c3' );
-
- load_in_caller( $caller => (
- ['CLASS'],
- ['File::chdir'],
- ['English' => qw(-no_match_vars)],
- ['Want' => qw(want)],
- ['Try::Tiny'],
- ['Perl6::Caller'],
- ['Carp::Fix::1_25'],
- ['perl5i::2::Signatures'],
- ['Child' => qw(child)],
- ) );
- # no strict vars for oneliners - GH #63
- strict::unimport($class, 'vars')
- if $class eq 'perl5i::cmd'
- or $0 eq '-e';
-
- # Have to call both or it won't work.
- true::import($class);
- perl5i::2::autobox::import($class);
- autovivification::unimport($class);
- indirect::unimport($class, ":fatal");
-
- utf8::all::import($class);
- (\&perl5i::latest::open)->alias($caller, 'open');
-
- # Export our gmtime() and localtime()
- (\&{$Latest .'::DateTime::dt_gmtime'})->alias($caller, 'gmtime');
- (\&{$Latest .'::DateTime::dt_localtime'})->alias($caller, 'localtime');
- (\&{$Latest .'::DateTime::dt_time'})->alias($caller, 'time');
-
- # Export our stat and lstat
- (\&stat)->alias( $caller, 'stat' );
- (\&lstat)->alias( $caller, 'lstat' );
-
- # Export our fixed die
- (\&perl5i_die)->alias($caller, "die");
-
- # Export capture()
- (\&capture)->alias($caller, "capture");
-
- # Export list()
- (\&force_list_context)->alias($caller, 'list');
+ # Check all the skipped features are valid
+ for my $f ( grep { !exists $Features{$_} } keys %$skips ) {
+ croak "Unknown feature '$f' in skip list";
+ }
# Current lexically active major version of perl5i.
$^H{perl5i} = 2;
+ # Load all the features.
+ for my $feature (keys %Features) {
+ next if $skips->{$feature};
+ $Features{$feature}->($class, $caller);
+ }
+
# autodie needs a bit more convincing
- @_ = ( $class, ":all" );
- goto &autodie::import;
+ if( !$skips->{autodie} ) {
+ @_ = ( $class, ":all" );
+ goto &autodie::import;
+ }
}
sub unimport { $^H{perl5i} = 0 }
@@ -177,3 +259,5 @@ sub capture(&;@) {
sub force_list_context(@) {
return @_;
}
+
+1;
View
5 lib/perl5i/cmd.pm
@@ -6,7 +6,10 @@ use strict;
use parent 'perl5i::latest';
sub import {
- my($class, $name) = @_;
+ my $class = $_[0];
+
+ # Remove the name from the import list before passing it along to perl5i.
+ my $name = splice(@_, 1, 1);
# Make the program identify as perl5i
$^X = $name;
View
23 t/lexical.t
@@ -28,3 +28,26 @@ TODO: {
{
ok eval { open my $fh, "dlkfjal;kdj"; 1 } or diag $@;
}
+
+
+# lexical autovivification
+{
+ my $hash;
+ my $val = $hash->{key};
+ is_deeply $hash, {}, "no autovivification is lexical";
+}
+
+
+# lexical autobox
+{
+ my $thing = [];
+ ok !eval { []->isa("ARRAY"); };
+}
+
+
+# lexical no indirect
+{
+ package Some::Thing;
+ sub method { 42 }
+ ::is( method Some::Thing, 42 );
+}
View
43 t/skip.t
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use Test::More;
+
+note "skipping a feature";
+{
+ # Needs its own package because perl5i is not always lexical
+ package Foo1;
+
+ use perl5i::latest -skip => ['Signatures'];
+
+ ::ok !eval q[method foo { 42 }; 1];
+ ::ok !defined &foo;
+}
+
+note "skipping autodie";
+{
+ # Needs its own package because perl5i is not always lexical
+ package Foo2;
+
+ use perl5i::latest -skip => ["autodie"];
+ open my $fh, "/i/do/not/exist/alfkjaldjlf";
+ ::pass("autodie is disabled");
+}
+
+note "unknown feature error";
+{
+ my $feature = 'Orbital Mind Control Lasers';
+ ok !eval {
+ perl5i::latest->import( -skip => [$feature] );
+ };
+ is $@, sprintf "Unknown feature '%s' in skip list at %s line %d.\n", $feature, $0, __LINE__-2;
+}
+
+note "unknown import parameter";
+{
+ ok !eval {
+ perl5i::latest->import( wibble => "what" );
+ };
+ is $@, sprintf "Unknown parameters 'wibble => what' in import list at %s line %d.\n", $0, __LINE__-2;
+}
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.