← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:52 2010

File /project/perl/lib/UNIVERSAL/require.pm
Statements Executed 10
Statement Execution Time 1.13ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sUNIVERSAL::::BEGIN UNIVERSAL::BEGIN
0000s0sUNIVERSAL::::require UNIVERSAL::require
0000s0sUNIVERSAL::require::::BEGINUNIVERSAL::require::BEGIN
0000s0sUNIVERSAL::::use UNIVERSAL::use
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package UNIVERSAL::require;
216µs$UNIVERSAL::require::VERSION = '0.11';
3
4# We do this because UNIVERSAL.pm uses CORE::require(). We're going
5# to put our own require() into UNIVERSAL and that makes an ambiguity.
6# So we load it up beforehand to avoid that.
71400µsBEGIN { require UNIVERSAL }
8
9package UNIVERSAL;
10
11389µs124µsuse strict;
# spent 24µs making 1 call to strict::import
12
133619µs1130µsuse vars qw($Level);
# spent 130µs making 1 call to vars::import
1415µs$Level = 0;
15
16=pod
17
18=head1 NAME
19
20 UNIVERSAL::require - require() modules from a variable
21
22=head1 SYNOPSIS
23
24 # This only needs to be said once in your program.
25 require UNIVERSAL::require;
26
27 # Same as "require Some::Module"
28 my $module = 'Some::Module';
29 $module->require or die $@;
30
31 # Same as "use Some::Module"
32 BEGIN { $module->use or die $@ }
33
34
35=head1 DESCRIPTION
36
37If you've ever had to do this...
38
39 eval "require $module";
40
41to get around the bareword caveats on require(), this module is for
42you. It creates a universal require() class method that will work
43with every Perl module and its secure. So instead of doing some
44arcane eval() work, you can do this:
45
46 $module->require;
47
48It doesn't save you much typing, but it'll make alot more sense to
49someone who's not a ninth level Perl acolyte.
50
51=head1 Methods
52
53=head3 require
54
55 my $return_val = $module->require or die $@;
56 my $return_val = $module->require($version) or die $@;
57
58This works exactly like Perl's require, except without the bareword
59restriction, and it doesn't die. Since require() is placed in the
60UNIVERSAL namespace, it will work on B<any> module. You just have to
61use UNIVERSAL::require somewhere in your code.
62
63Should the module require fail, or not be a high enough $version, it
64will simply return false and B<not die>. The error will be in
65$@ as well as $UNIVERSAL::require::ERROR.
66
67 $module->require or die $@;
68
69=cut
70
71sub require {
72 my($module, $want_version) = @_;
73
74 $UNIVERSAL::require::ERROR = '';
75
76 die("UNIVERSAL::require() can only be run as a class method")
77 if ref $module;
78
79 die("UNIVERSAL::require() takes no or one arguments") if @_ > 2;
80
81 my($call_package, $call_file, $call_line) = caller($Level);
82
83 # Load the module.
84 my $file = $module . '.pm';
85 $file =~ s{::}{/}g;
86
87 # For performance reasons, check if its already been loaded. This makes
88 # things about 4 times faster.
89 return 1 if $INC{$file};
90
91 my $return = eval qq{
92#line $call_line "$call_file"
93CORE::require(\$file);
94};
95
96 # Check for module load failure.
97 if( $@ ) {
98 $UNIVERSAL::require::ERROR = $@;
99 return $return;
100 }
101
102 # Module version check.
103 if( @_ == 2 ) {
104 eval qq{
105#line $call_line "$call_file"
106\$module->VERSION($want_version);
107};
108
109 if( $@ ) {
110 $UNIVERSAL::require::ERROR = $@;
111 return 0;
112 }
113 }
114
115 return $return;
116}
117
118
119=head3 use
120
121 my $require_return = $module->use or die $@;
122 my $require_return = $module->use(@imports) or die $@;
123
124Like C<UNIVERSAL::require>, this allows you to C<use> a $module without
125having to eval to work around the bareword requirement. It returns the
126same as require.
127
128Should either the require or the import fail it will return false. The
129error will be in $@.
130
131If possible, call this inside a BEGIN block to emulate a normal C<use>
132as closely as possible.
133
134 BEGIN { $module->use }
135
136=cut
137
138sub use {
139 my($module, @imports) = @_;
140
141 local $Level = 1;
142 my $return = $module->require or return 0;
143
144 my($call_package, $call_file, $call_line) = caller;
145
146 eval qq{
147package $call_package;
148#line $call_line "$call_file"
149\$module->import(\@imports);
150};
151
152 if( $@ ) {
153 $UNIVERSAL::require::ERROR = $@;
154 return 0;
155 }
156
157 return $return;
158}
159
160
161=head1 SECURITY NOTES
162
163UNIVERSAL::require makes use of C<eval STRING>. In previous versions
164of UNIVERSAL::require it was discovered that one could craft a class
165name which would result in code being executed. This hole has been
166closed. The only variables now exposed to C<eval STRING> are the
167caller's package, filename and line which are not tainted.
168
169UNIVERSAL::require is taint clean.
170
171
172=head1 COPYRIGHT
173
174Copyright 2001, 2005 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
175
176This program is free software; you can redistribute it and/or
177modify it under the same terms as Perl itself.
178
179See F<http://www.perl.com/perl/misc/Artistic.html>
180
181
182=head1 AUTHOR
183
184Michael G Schwern <schwern@pobox.com>
185
186
187=head1 SEE ALSO
188
189L<Module::Load>, L<perlfunc/require>, L<http://dev.perl.org/rfc/253.pod>
190
191=cut
192
193
194112µs1;