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

后端 未结 1 1748
故里飘歌
故里飘歌 2020-12-01 18:36

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.)<

相关标签:
1条回答
  • 2020-12-01 19:11

    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;
    
    0 讨论(0)
提交回复
热议问题