← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libperl5i-perl/trusty-proposed

« back to all changes in this revision

Viewing changes to lib/perl5i/1.pm

  • Committer: Bazaar Package Importer
  • Author(s): Ivan Kohler
  • Date: 2010-05-08 17:42:00 UTC
  • Revision ID: james.westby@ubuntu.com-20100508174200-7ogg0zrimh9gvcuw
Tags: upstream-2.1.1
Import upstream version 2.1.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/perl5i/1.pm
 
1
# vi: set ts=4 sw=4 ht=4 et :
 
2
package perl5i::1;
 
3
 
 
4
use 5.010;
 
5
 
 
6
use strict;
 
7
use warnings;
 
8
use Module::Load;
 
9
use IO::Handle;
 
10
use Carp;
 
11
use perl5i::1::DateTime;
 
12
use Want;
 
13
use Try::Tiny;
 
14
use perl5i::1::Meta;
 
15
use Encode ();
 
16
use perl5i::1::autobox;
 
17
 
 
18
use perl5i::VERSION; our $VERSION = perl5i::VERSION->VERSION;
 
19
 
 
20
our $Latest = perl5i::VERSION->latest;
 
21
 
 
22
 
 
23
# This works around their lexical nature.
 
24
use parent 'autodie';
 
25
use parent 'perl5i::1::autobox';
 
26
use parent 'autovivification';
 
27
use parent 'utf8';
 
28
use parent 'open';
 
29
 
 
30
## no critic (Subroutines::RequireArgUnpacking)
 
31
sub import {
 
32
    my $class = shift;
 
33
 
 
34
    require File::stat;
 
35
 
 
36
    require Modern::Perl;
 
37
    Modern::Perl->import;
 
38
 
 
39
    my $caller = caller;
 
40
 
 
41
    # Modern::Perl won't pass this through to our caller.
 
42
    require mro;
 
43
    mro::set_mro( $caller, 'c3' );
 
44
 
 
45
    load_in_caller( $caller => (
 
46
        ["CLASS"], ["File::chdir"],
 
47
        [English => qw(-no_match_vars)],
 
48
        ["Want" => qw(want)], ["Try::Tiny"], ["Perl6::Caller"], ["Carp"]
 
49
    ) );
 
50
 
 
51
    # Have to call both or it won't work.
 
52
    perl5i::1::autobox::import($class);
 
53
    autovivification::unimport($class);
 
54
    utf8::import($class);
 
55
 
 
56
    open::import($class, ":encoding(utf8)");
 
57
    open::import($class, ":std");
 
58
 
 
59
    # Export our gmtime() and localtime()
 
60
    (\&{$Latest .'::DateTime::dt_gmtime'})->alias($caller, 'gmtime');
 
61
    (\&{$Latest .'::DateTime::dt_localtime'})->alias($caller, 'localtime');
 
62
    (\&{$Latest .'::DateTime::dt_time'})->alias($caller, 'time');
 
63
    (\&stat)->alias( $caller, 'stat' );
 
64
    (\&lstat)->alias( $caller, 'lstat' );
 
65
    (\&utf8_open)->alias($caller, 'open');
 
66
 
 
67
    # fix die so that it always returns 255
 
68
    *CORE::GLOBAL::die = sub {
 
69
        # Leave a single ref be
 
70
        local $! = 255;
 
71
        return CORE::die(@_) if @_ == 1 and ref $_[0];
 
72
 
 
73
        my $error = join '', @_;
 
74
        unless ($error =~ /\n$/) {
 
75
            my ($file, $line) = (caller)[1,2];
 
76
            $error .= " at $file line $line.\n";
 
77
        }
 
78
 
 
79
        local $! = 255;
 
80
        return CORE::die($error);
 
81
    };
 
82
 
 
83
 
 
84
    # utf8ify @ARGV
 
85
    $_ = Encode::decode('utf8', $_) for @ARGV;
 
86
 
 
87
 
 
88
    $^H{perl5i} = 1;
 
89
 
 
90
    # autodie needs a bit more convincing
 
91
    @_ = ( $class, ":all" );
 
92
    goto &autodie::import;
 
93
}
 
94
 
 
95
sub unimport { $^H{perl5i} = 0 }
 
96
 
 
97
sub utf8_open(*;$@) {  ## no critic (Subroutines::ProhibitSubroutinePrototypes)
 
98
    my $ret;
 
99
    if( @_ == 1 ) {
 
100
        $ret = CORE::open $_[0];
 
101
    }
 
102
    else {
 
103
        $ret = CORE::open $_[0], $_[1], @_[2..$#_];
 
104
    }
 
105
 
 
106
    # Don't try to binmode an unopened filehandle
 
107
    return $ret unless $ret;
 
108
 
 
109
    my $h = (caller 1)[10];
 
110
    binmode $_[0], ":encoding(utf8)" if $h->{perl5i};
 
111
    return $ret;
 
112
}
 
113
 
 
114
 
 
115
sub load_in_caller {
 
116
    my $caller  = shift;
 
117
    my @modules = @_;
 
118
 
 
119
    for my $spec (@modules) {
 
120
        my( $module, @args ) = @$spec;
 
121
 
 
122
        load($module);
 
123
        ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
124
        eval qq{
 
125
            package $caller;
 
126
            \$module->import(\@args);
 
127
            1;
 
128
        } or die "Error while perl5i loaded $module => @args: $@";
 
129
    }
 
130
 
 
131
    return;
 
132
}
 
133
 
 
134
 
 
135
# File::stat does not play nice in list context
 
136
sub stat {
 
137
    return CORE::stat(@_) if wantarray;
 
138
    return File::stat::stat(@_);
 
139
}
 
140
 
 
141
sub lstat {
 
142
    return CORE::lstat(@_) if wantarray;
 
143
    return File::stat::lstat(@_);
 
144
}
 
145
 
 
146
1;
 
147