如何使用現代的perl＆utf8默認設置「使用My :: defaults」？

Question

我希望做一個模塊，爲我自己的「默認使用」，例如：（主要是基於tchrist's後）

use My::perldefs; 

，內容如下

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; 

簡單地說，要實現一個use My::perldefs用於實現

• 完整正確的utf8支持和
• 打開所有現代Perl特徵。

基於recent question好的起點是uni :: perl。它是做幾乎所有的事情，我想要什麼，只需要添加：

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

我將用獎金獎勵的人誰將會與上述5線的延伸UNI :: perl的（inseretd波紋管），使用有效和正確的方式。

請幫助爲utf8和現代perl的使用做一個很好的樣板。謝謝。

---

貝婁是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 1

use feature qw(unicode_strings)很容易，只需$^H{feature_unicode}需要設置。其他模塊也不太難，只需使用require並明確調用必要的模塊功能（例如，Encode和Unicode::Normalize通過Exporter定義了一個export方法，該方法將調用包作爲參數）。棘手的是autodie，它確實嚴格按照caller的值，並且通常會將其功能注入到My::perldefs包中。我認爲這裏唯一的一個好的解決方案是（使用My::perldefs重新實現模塊），它使用goto - 這允許在不改變caller的情況下調用所需的方法，因此方法被注入到正確的名稱空間中。以下是我到底得了：

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;