Profile of /project/perl/lib/UNIVERSAL/require.pm

File	/project/perl/lib/UNIVERSAL/require.pm
Statements Executed	10
Statement Execution Time	1.13ms

Subroutines — ordered by exclusive time
Exclusive Time	Inclusive Time	Subroutine
0s	0s	UNIVERSAL::::BEGIN UNIVERSAL::BEGIN
0s	0s	UNIVERSAL::::require UNIVERSAL::require
0s	0s	UNIVERSAL::require::::BEGINUNIVERSAL::require::BEGIN
0s	0s	UNIVERSAL::::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
1					package UNIVERSAL::require;
2	1	6µ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.
7	1	400µs			BEGIN { require UNIVERSAL }
8
9					package UNIVERSAL;
10
11	3	89µs	1	24µs	use strict; # spent 24µs making 1 call to strict::import
12
13	3	619µs	1	130µs	use vars qw($Level); # spent 130µs making 1 call to vars::import
14	1	5µ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
37					If you've ever had to do this...
38
39					eval "require $module";
40
41					to get around the bareword caveats on require(), this module is for
42					you. It creates a universal require() class method that will work
43					with every Perl module and its secure. So instead of doing some
44					arcane eval() work, you can do this:
45
46					$module->require;
47
48					It doesn't save you much typing, but it'll make alot more sense to
49					someone 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
58					This works exactly like Perl's require, except without the bareword
59					restriction, and it doesn't die. Since require() is placed in the
60					UNIVERSAL namespace, it will work on B<any> module. You just have to
61					use UNIVERSAL::require somewhere in your code.
62
63					Should the module require fail, or not be a high enough $version, it
64					will 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
71					sub 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"
93					CORE::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
124					Like C<UNIVERSAL::require>, this allows you to C<use> a $module without
125					having to eval to work around the bareword requirement. It returns the
126					same as require.
127
128					Should either the require or the import fail it will return false. The
129					error will be in $@.
130
131					If possible, call this inside a BEGIN block to emulate a normal C<use>
132					as closely as possible.
133
134					BEGIN { $module->use }
135
136					=cut
137
138					sub 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{
147					package $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
163					UNIVERSAL::require makes use of C<eval STRING>. In previous versions
164					of UNIVERSAL::require it was discovered that one could craft a class
165					name which would result in code being executed. This hole has been
166					closed. The only variables now exposed to C<eval STRING> are the
167					caller's package, filename and line which are not tainted.
168
169					UNIVERSAL::require is taint clean.
170
171
172					=head1 COPYRIGHT
173
174					Copyright 2001, 2005 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
175
176					This program is free software; you can redistribute it and/or
177					modify it under the same terms as Perl itself.
178
179					See F<http://www.perl.com/perl/misc/Artistic.html>
180
181
182					=head1 AUTHOR
183
184					Michael G Schwern <schwern@pobox.com>
185
186
187					=head1 SEE ALSO
188
189					L<Module::Load>, L<perlfunc/require>, L<http://dev.perl.org/rfc/253.pod>
190
191					=cut
192
193
194	1	12µs			1;