jm666 jm666 - 5 months ago 12
Perl Question

How to make "use My::defaults" with modern perl & utf8 defaults?

I want make a module for my own "default use", e.g.:

use My::perldefs;


with the following content (mostly based on tchrist's post.)

use 5.014;
use strict;
use features qw(switch say state);

no warnings;
use warnings qw(FATAL closed threads internal debugging pack substr malloc
unopened portable prototype inplace io pipe unpack regexp
deprecated exiting glob digit printf utf8 layer
reserved parenthesis taint closure semicolon);
no warnings qw(exec newline);

use utf8;
use open qw(:std :utf8);
use charnames qw(:full);
use feature qw(unicode_strings);
use Encode qw(encode decode);
use Unicode::Normalize qw(NFD NFC);
use Carp qw(carp croak confess cluck);
use autodie;


Simply, want achieve one
use My::perldefs
for achieving


  • full and correct utf8 support, and with

  • all modern perl features turned on.



Based on recent question the good start-point is uni::perl. It is do nearly all things what I want, only need add:

use feature qw(unicode_strings);
use charnames qw(:full);
use Encode qw(encode decode);
use Unicode::Normalize qw(NFD NFC);
use autodie;


I will award with the bounty someone who will extend the uni::perl (inseretd bellow) with the above 5 lines, using an effective and correct way.

Please, HELP make an good boilerplate for utf8 and modern perl use. Thanks.




Bellow is the copy of uni::perl.

package My::perldefs;

use 5.014;
BEGIN {
${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03";
$^H |= 0x00000602;
}
m{
use strict;
use warnings;
}x;
use mro ();

BEGIN {
for my $sub (qw(carp croak confess)) {
no strict 'refs';
*$sub = sub {
my $caller = caller;
local *__ANON__ = $caller .'::'. $sub;
require Carp;
*{ $caller.'::'.$sub } = \&{ 'Carp::'.$sub };
goto &{ 'Carp::'.$sub };
};
}
}

sub import {
my $me = shift;
my $caller = caller;
${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03";

$^H |=
0x00000602 # strict
| 0x00800000 # utf8
;

# use feature
$^H{feature_switch} =
$^H{feature_say} =
$^H{feature_state} = 1;

# use mro 'c3';
mro::set_mro($caller, 'c3');

#use open (:utf8 :std);
${^OPEN} = ":utf8\0:utf8";
binmode(STDIN, ":utf8");
binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");

for my $sub (qw(carp croak confess)) {
no strict 'refs';
*{ $caller .'::'. $sub } = \&$sub;
}
while (@_) {
my $feature = shift;
if ($feature =~ s/^://) {
my $package = $me. '::'. $feature;
eval "require $package; 1" or croak( "$@" );
$package->load( $caller );
}
}
}

1;


Ps:

All of the above is (C): Mons Anderson, C<< <mons at cpan.org> >>

Answer

use feature qw(unicode_strings) is easy, $^H{feature_unicode} simply needs to be set. The other modules aren't too hard as well, one simply needs to use require and call the necessary module functions explicitly (e.g. Encode and Unicode::Normalize define an export method via Exporter that takes the calling package as a parameter). The tricky one is autodie, it really goes strictly by the value of caller and will normally inject its functions into My::perldefs package. I think the only good solution here (short of reimplementing the module in My::perldefs) is using goto - this allows calling the required method without changing caller, so the methods are injected into the correct namespace. Here is what I got in the end:

package My::perldefs;

use 5.014;
BEGIN {
    ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03";
    $^H |= 0x00000602;
}
m{
use strict;
use warnings;
}x;
use mro ();

BEGIN {
    for my $sub (qw(carp croak confess)) {
        no strict 'refs';
        *$sub = sub {
            my $caller = caller;
            local *__ANON__ = $caller .'::'. $sub;
            require Carp;
            *{ $caller.'::'.$sub } = \&{ 'Carp::'.$sub };
            goto &{ 'Carp::'.$sub };
        };
    }
}

sub import {
    my $me = shift;
    my $caller = caller;
    ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03";

    $^H |=
          0x00000602 # strict
        | 0x00800000 # utf8
    ;

    # use feature
    $^H{feature_switch} =
    $^H{feature_say}    =
    $^H{feature_state}  =
    $^H{feature_unicode}= 1;

    # use mro 'c3';
    mro::set_mro($caller, 'c3');

    #use open (:utf8 :std);
    ${^OPEN} = ":utf8\0:utf8";
    binmode(STDIN,   ":utf8");
    binmode(STDOUT,  ":utf8");
    binmode(STDERR,  ":utf8");

    #use charnames qw(:full)
    require charnames;
    charnames->import(":full");

    #use Encode qw(encode decode)
    require Encode;
    Encode->export($caller, "encode", "decode");

    #use Unicode::Normalize qw(NFC NFD)
    require Unicode::Normalize;
    Unicode::Normalize->export($caller, "NFC", "NFD");

    for my $sub (qw(carp croak confess)) {
        no strict 'refs';
        *{ $caller .'::'. $sub } = \&$sub;
    }
    while (@_) {
        my $feature = shift;
        if ($feature =~ s/^://) {
            my $package = $me. '::'. $feature;
            eval "require $package; 1" or croak( "$@" );
            $package->load( $caller );
        }
    }

    #use autodie qw(:default)
    #goto needs to be used here to make sure that caller doesn't change
    require autodie;
    @_ = ("autodie", ":default");
    goto &autodie::import;
}

1;