| 1 |  |  |  |  | =head1 NAME | 
| 2 |  |  |  |  |  | 
| 3 |  |  |  |  | Module::Runtime - runtime module handling | 
| 4 |  |  |  |  |  | 
| 5 |  |  |  |  | =head1 SYNOPSIS | 
| 6 |  |  |  |  |  | 
| 7 |  |  |  |  |         use Module::Runtime qw( | 
| 8 |  |  |  |  |                 $module_name_rx is_module_name check_module_name | 
| 9 |  |  |  |  |                 module_notional_filename require_module | 
| 10 |  |  |  |  |         ); | 
| 11 |  |  |  |  |  | 
| 12 |  |  |  |  |         if($module_name =~ /\A$module_name_rx\z/o) { ... | 
| 13 |  |  |  |  |         if(is_module_name($module_name)) { ... | 
| 14 |  |  |  |  |         check_module_name($module_name); | 
| 15 |  |  |  |  |  | 
| 16 |  |  |  |  |         $notional_filename = module_notional_filename($module_name); | 
| 17 |  |  |  |  |         require_module($module_name); | 
| 18 |  |  |  |  |  | 
| 19 |  |  |  |  |         use Module::Runtime qw(use_module use_package_optimistically); | 
| 20 |  |  |  |  |  | 
| 21 |  |  |  |  |         $bi = use_module("Math::BigInt", 1.31)->new("1_234"); | 
| 22 |  |  |  |  |         $widget = use_package_optimistically("Local::Widget")->new; | 
| 23 |  |  |  |  |  | 
| 24 |  |  |  |  |         use Module::Runtime qw( | 
| 25 |  |  |  |  |                 $top_module_spec_rx $sub_module_spec_rx | 
| 26 |  |  |  |  |                 is_module_spec check_module_spec | 
| 27 |  |  |  |  |                 compose_module_name | 
| 28 |  |  |  |  |         ); | 
| 29 |  |  |  |  |  | 
| 30 |  |  |  |  |         if($spec =~ /\A$top_module_spec_rx\z/o) { ... | 
| 31 |  |  |  |  |         if($spec =~ /\A$sub_module_spec_rx\z/o) { ... | 
| 32 |  |  |  |  |         if(is_module_spec("Standard::Prefix", $spec)) { ... | 
| 33 |  |  |  |  |         check_module_spec("Standard::Prefix", $spec); | 
| 34 |  |  |  |  |  | 
| 35 |  |  |  |  |         $module_name = | 
| 36 |  |  |  |  |                 compose_module_name("Standard::Prefix", $spec); | 
| 37 |  |  |  |  |  | 
| 38 |  |  |  |  | =head1 DESCRIPTION | 
| 39 |  |  |  |  |  | 
| 40 |  |  |  |  | The functions exported by this module deal with runtime handling of | 
| 41 |  |  |  |  | Perl modules, which are normally handled at compile time.  This module | 
| 42 |  |  |  |  | avoids using any other modules, so that it can be used in low-level | 
| 43 |  |  |  |  | infrastructure. | 
| 44 |  |  |  |  |  | 
| 45 |  |  |  |  | The parts of this module that work with module names apply the same syntax | 
| 46 |  |  |  |  | that is used for barewords in Perl source.  In principle this syntax | 
| 47 |  |  |  |  | can vary between versions of Perl, and this module applies the syntax of | 
| 48 |  |  |  |  | the Perl on which it is running.  In practice the usable syntax hasn't | 
| 49 |  |  |  |  | changed yet.  There's some intent for Unicode module names to be supported | 
| 50 |  |  |  |  | in the future, but this hasn't yet amounted to any consistent facility. | 
| 51 |  |  |  |  |  | 
| 52 |  |  |  |  | The functions of this module whose purpose is to load modules include | 
| 53 |  |  |  |  | workarounds for three old Perl core bugs regarding C<require>.  These | 
| 54 |  |  |  |  | workarounds are applied on any Perl version where the bugs exist, except | 
| 55 |  |  |  |  | for a case where one of the bugs cannot be adequately worked around in | 
| 56 |  |  |  |  | pure Perl. | 
| 57 |  |  |  |  |  | 
| 58 |  |  |  |  | =head2 Module name syntax | 
| 59 |  |  |  |  |  | 
| 60 |  |  |  |  | The usable module name syntax has not changed from Perl 5.000 up to | 
| 61 |  |  |  |  | Perl 5.19.8.  The syntax is composed entirely of ASCII characters. | 
| 62 |  |  |  |  | From Perl 5.6 onwards there has been some attempt to allow the use of | 
| 63 |  |  |  |  | non-ASCII Unicode characters in Perl source, but it was fundamentally | 
| 64 |  |  |  |  | broken (like the entirety of Perl 5.6's Unicode handling) and remained | 
| 65 |  |  |  |  | pretty much entirely unusable until it got some attention in the Perl | 
| 66 |  |  |  |  | 5.15 series.  Although Unicode is now consistently accepted by the | 
| 67 |  |  |  |  | parser in some places, it remains broken for module names.  Furthermore, | 
| 68 |  |  |  |  | there has not yet been any work on how to map Unicode module names into | 
| 69 |  |  |  |  | filenames, so in that respect also Unicode module names are unusable. | 
| 70 |  |  |  |  |  | 
| 71 |  |  |  |  | The module name syntax is, precisely: the string must consist of one or | 
| 72 |  |  |  |  | more segments separated by C<::>; each segment must consist of one or more | 
| 73 |  |  |  |  | identifier characters (ASCII alphanumerics plus "_"); the first character | 
| 74 |  |  |  |  | of the string must not be a digit.  Thus "C<IO::File>", "C<warnings>", | 
| 75 |  |  |  |  | and "C<foo::123::x_0>" are all valid module names, whereas "C<IO::>" | 
| 76 |  |  |  |  | and "C<1foo::bar>" are not.  C<'> separators are not permitted by this | 
| 77 |  |  |  |  | module, though they remain usable in Perl source, being translated to | 
| 78 |  |  |  |  | C<::> in the parser. | 
| 79 |  |  |  |  |  | 
| 80 |  |  |  |  | =head2 Core bugs worked around | 
| 81 |  |  |  |  |  | 
| 82 |  |  |  |  | The first bug worked around is core bug [perl #68590], which causes | 
| 83 |  |  |  |  | lexical state in one file to leak into another that is C<require>d/C<use>d | 
| 84 |  |  |  |  | from it.  This bug is present from Perl 5.6 up to Perl 5.10, and is | 
| 85 |  |  |  |  | fixed in Perl 5.11.0.  From Perl 5.9.4 up to Perl 5.10.0 no satisfactory | 
| 86 |  |  |  |  | workaround is possible in pure Perl.  The workaround means that modules | 
| 87 |  |  |  |  | loaded via this module don't suffer this pollution of their lexical | 
| 88 |  |  |  |  | state.  Modules loaded in other ways, or via this module on the Perl | 
| 89 |  |  |  |  | versions where the pure Perl workaround is impossible, remain vulnerable. | 
| 90 |  |  |  |  | The module L<Lexical::SealRequireHints> provides a complete workaround | 
| 91 |  |  |  |  | for this bug. | 
| 92 |  |  |  |  |  | 
| 93 |  |  |  |  | The second bug worked around causes some kinds of failure in module | 
| 94 |  |  |  |  | loading, principally compilation errors in the loaded module, to be | 
| 95 |  |  |  |  | recorded in C<%INC> as if they were successful, so later attempts to load | 
| 96 |  |  |  |  | the same module immediately indicate success.  This bug is present up | 
| 97 |  |  |  |  | to Perl 5.8.9, and is fixed in Perl 5.9.0.  The workaround means that a | 
| 98 |  |  |  |  | compilation error in a module loaded via this module won't be cached as | 
| 99 |  |  |  |  | a success.  Modules loaded in other ways remain liable to produce bogus | 
| 100 |  |  |  |  | C<%INC> entries, and if a bogus entry exists then it will mislead this | 
| 101 |  |  |  |  | module if it is used to re-attempt loading. | 
| 102 |  |  |  |  |  | 
| 103 |  |  |  |  | The third bug worked around causes the wrong context to be seen at | 
| 104 |  |  |  |  | file scope of a loaded module, if C<require> is invoked in a location | 
| 105 |  |  |  |  | that inherits context from a higher scope.  This bug is present up to | 
| 106 |  |  |  |  | Perl 5.11.2, and is fixed in Perl 5.11.3.  The workaround means that | 
| 107 |  |  |  |  | a module loaded via this module will always see the correct context. | 
| 108 |  |  |  |  | Modules loaded in other ways remain vulnerable. | 
| 109 |  |  |  |  |  | 
| 110 |  |  |  |  | =cut | 
| 111 |  |  |  |  |  | 
| 112 |  |  |  |  | package Module::Runtime; | 
| 113 |  |  |  |  |  | 
| 114 |  |  |  |  | # Don't "use 5.006" here, because Perl 5.15.6 will load feature.pm if | 
| 115 |  |  |  |  | # the version check is done that way. | 
| 116 |  |  |  |  | BEGIN { require 5.006; } | 
| 117 |  |  |  |  | # Don't "use warnings" here, to avoid dependencies.  Do standardise the | 
| 118 |  |  |  |  | # warning status by lexical override; unfortunately the only safe bitset | 
| 119 |  |  |  |  | # to build in is the empty set, equivalent to "no warnings". | 
| 120 |  |  |  |  | BEGIN { ${^WARNING_BITS} = ""; } | 
| 121 |  |  |  |  | # Don't "use strict" here, to avoid dependencies. | 
| 122 |  |  |  |  |  | 
| 123 |  |  |  |  | our $VERSION = "0.014"; | 
| 124 |  |  |  |  |  | 
| 125 |  |  |  |  | # Don't use Exporter here, to avoid dependencies. | 
| 126 |  |  |  |  | our @EXPORT_OK = qw( | 
| 127 |  |  |  |  |         $module_name_rx is_module_name is_valid_module_name check_module_name | 
| 128 |  |  |  |  |         module_notional_filename require_module | 
| 129 |  |  |  |  |         use_module use_package_optimistically | 
| 130 |  |  |  |  |         $top_module_spec_rx $sub_module_spec_rx | 
| 131 |  |  |  |  |         is_module_spec is_valid_module_spec check_module_spec | 
| 132 |  |  |  |  |         compose_module_name | 
| 133 |  |  |  |  | ); | 
| 134 |  |  |  |  | my %export_ok = map { ($_ => undef) } @EXPORT_OK; | 
| 135 |  |  |  |  | sub import { | 
| 136 |  |  |  |  |         my $me = shift; | 
| 137 |  |  |  |  |         my $callpkg = caller(0); | 
| 138 |  |  |  |  |         my $errs = ""; | 
| 139 |  |  |  |  |         foreach(@_) { | 
| 140 |  |  |  |  |                 if(exists $export_ok{$_}) { | 
| 141 |  |  |  |  |                         # We would need to do "no strict 'refs'" here | 
| 142 |  |  |  |  |                         # if we had enabled strict at file scope. | 
| 143 |  |  |  |  |                         if(/\A\$(.*)\z/s) { | 
| 144 |  |  |  |  |                                 *{$callpkg."::".$1} = \$$1; | 
| 145 |  |  |  |  |                         } else { | 
| 146 |  |  |  |  |                                 *{$callpkg."::".$_} = \&$_; | 
| 147 |  |  |  |  |                         } | 
| 148 |  |  |  |  |                 } else { | 
| 149 |  |  |  |  |                         $errs .= "\"$_\" is not exported by the $me module\n"; | 
| 150 |  |  |  |  |                 } | 
| 151 |  |  |  |  |         } | 
| 152 |  |  |  |  |         if($errs ne "") { | 
| 153 |  |  |  |  |                 die "${errs}Can't continue after import errors ". | 
| 154 |  |  |  |  |                         "at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n"; | 
| 155 |  |  |  |  |         } | 
| 156 |  |  |  |  | } | 
| 157 |  |  |  |  |  | 
| 158 |  |  |  |  | # Logic duplicated from Params::Classify.  Duplicating it here avoids | 
| 159 |  |  |  |  | # an extensive and potentially circular dependency graph. | 
| 160 |  |  |  |  | sub _is_string($) { | 
| 161 |  |  |  |  |         my($arg) = @_; | 
| 162 |  |  |  |  |         return defined($arg) && ref(\$arg) eq "SCALAR"; | 
| 163 |  |  |  |  | } | 
| 164 |  |  |  |  |  | 
| 165 |  |  |  |  | =head1 REGULAR EXPRESSIONS | 
| 166 |  |  |  |  |  | 
| 167 |  |  |  |  | These regular expressions do not include any anchors, so to check | 
| 168 |  |  |  |  | whether an entire string matches a syntax item you must supply the | 
| 169 |  |  |  |  | anchors yourself. | 
| 170 |  |  |  |  |  | 
| 171 |  |  |  |  | =over | 
| 172 |  |  |  |  |  | 
| 173 |  |  |  |  | =item $module_name_rx | 
| 174 |  |  |  |  |  | 
| 175 |  |  |  |  | Matches a valid Perl module name in bareword syntax. | 
| 176 |  |  |  |  |  | 
| 177 |  |  |  |  | =cut | 
| 178 |  |  |  |  |  | 
| 179 |  |  |  |  | our $module_name_rx = qr/[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/; | 
| 180 |  |  |  |  |  | 
| 181 |  |  |  |  | =item $top_module_spec_rx | 
| 182 |  |  |  |  |  | 
| 183 |  |  |  |  | Matches a module specification for use with L</compose_module_name>, | 
| 184 |  |  |  |  | where no prefix is being used. | 
| 185 |  |  |  |  |  | 
| 186 |  |  |  |  | =cut | 
| 187 |  |  |  |  |  | 
| 188 |  |  |  |  | my $qual_module_spec_rx = | 
| 189 |  |  |  |  |         qr#(?:/|::)[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#; | 
| 190 |  |  |  |  |  | 
| 191 |  |  |  |  | my $unqual_top_module_spec_rx = | 
| 192 |  |  |  |  |         qr#[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#; | 
| 193 |  |  |  |  |  | 
| 194 |  |  |  |  | our $top_module_spec_rx = qr/$qual_module_spec_rx|$unqual_top_module_spec_rx/o; | 
| 195 |  |  |  |  |  | 
| 196 |  |  |  |  | =item $sub_module_spec_rx | 
| 197 |  |  |  |  |  | 
| 198 |  |  |  |  | Matches a module specification for use with L</compose_module_name>, | 
| 199 |  |  |  |  | where a prefix is being used. | 
| 200 |  |  |  |  |  | 
| 201 |  |  |  |  | =cut | 
| 202 |  |  |  |  |  | 
| 203 |  |  |  |  | my $unqual_sub_module_spec_rx = qr#[0-9A-Z_a-z]+(?:(?:/|::)[0-9A-Z_a-z]+)*#; | 
| 204 |  |  |  |  |  | 
| 205 |  |  |  |  | our $sub_module_spec_rx = qr/$qual_module_spec_rx|$unqual_sub_module_spec_rx/o; | 
| 206 |  |  |  |  |  | 
| 207 |  |  |  |  | =back | 
| 208 |  |  |  |  |  | 
| 209 |  |  |  |  | =head1 FUNCTIONS | 
| 210 |  |  |  |  |  | 
| 211 |  |  |  |  | =head2 Basic module handling | 
| 212 |  |  |  |  |  | 
| 213 |  |  |  |  | =over | 
| 214 |  |  |  |  |  | 
| 215 |  |  |  |  | =item is_module_name(ARG) | 
| 216 |  |  |  |  |  | 
| 217 |  |  |  |  | Returns a truth value indicating whether I<ARG> is a plain string | 
| 218 |  |  |  |  | satisfying Perl module name syntax as described for L</$module_name_rx>. | 
| 219 |  |  |  |  |  | 
| 220 |  |  |  |  | =cut | 
| 221 |  |  |  |  |  | 
| 222 |  |  |  |  | sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o } | 
| 223 |  |  |  |  |  | 
| 224 |  |  |  |  | =item is_valid_module_name(ARG) | 
| 225 |  |  |  |  |  | 
| 226 |  |  |  |  | Deprecated alias for L</is_module_name>. | 
| 227 |  |  |  |  |  | 
| 228 |  |  |  |  | =cut | 
| 229 |  |  |  |  |  | 
| 230 |  |  |  |  | *is_valid_module_name = \&is_module_name; | 
| 231 |  |  |  |  |  | 
| 232 |  |  |  |  | =item check_module_name(ARG) | 
| 233 |  |  |  |  |  | 
| 234 |  |  |  |  | Check whether I<ARG> is a plain string | 
| 235 |  |  |  |  | satisfying Perl module name syntax as described for L</$module_name_rx>. | 
| 236 |  |  |  |  | Return normally if it is, or C<die> if it is not. | 
| 237 |  |  |  |  |  | 
| 238 |  |  |  |  | =cut | 
| 239 |  |  |  |  |  | 
| 240 |  |  |  |  | sub check_module_name($) { | 
| 241 |  |  |  |  |         unless(&is_module_name) { | 
| 242 |  |  |  |  |                 die +(_is_string($_[0]) ? "`$_[0]'" : "argument"). | 
| 243 |  |  |  |  |                         " is not a module name\n"; | 
| 244 |  |  |  |  |         } | 
| 245 |  |  |  |  | } | 
| 246 |  |  |  |  |  | 
| 247 |  |  |  |  | =item module_notional_filename(NAME) | 
| 248 |  |  |  |  |  | 
| 249 |  |  |  |  | Generates a notional relative filename for a module, which is used in | 
| 250 |  |  |  |  | some Perl core interfaces. | 
| 251 |  |  |  |  | The I<NAME> is a string, which should be a valid module name (one or | 
| 252 |  |  |  |  | more C<::>-separated segments).  If it is not a valid name, the function | 
| 253 |  |  |  |  | C<die>s. | 
| 254 |  |  |  |  |  | 
| 255 |  |  |  |  | The notional filename for the named module is generated and returned. | 
| 256 |  |  |  |  | This filename is always in Unix style, with C</> directory separators | 
| 257 |  |  |  |  | and a C<.pm> suffix.  This kind of filename can be used as an argument to | 
| 258 |  |  |  |  | C<require>, and is the key that appears in C<%INC> to identify a module, | 
| 259 |  |  |  |  | regardless of actual local filename syntax. | 
| 260 |  |  |  |  |  | 
| 261 |  |  |  |  | =cut | 
| 262 |  |  |  |  |  | 
| 263 |  |  |  |  | sub module_notional_filename($) { | 
| 264 |  |  |  |  |         &check_module_name; | 
| 265 |  |  |  |  |         my($name) = @_; | 
| 266 |  |  |  |  |         $name =~ s!::!/!g; | 
| 267 |  |  |  |  |         return $name.".pm"; | 
| 268 |  |  |  |  | } | 
| 269 |  |  |  |  |  | 
| 270 |  |  |  |  | =item require_module(NAME) | 
| 271 |  |  |  |  |  | 
| 272 |  |  |  |  | This is essentially the bareword form of C<require>, in runtime form. | 
| 273 |  |  |  |  | The I<NAME> is a string, which should be a valid module name (one or | 
| 274 |  |  |  |  | more C<::>-separated segments).  If it is not a valid name, the function | 
| 275 |  |  |  |  | C<die>s. | 
| 276 |  |  |  |  |  | 
| 277 |  |  |  |  | The module specified by I<NAME> is loaded, if it hasn't been already, | 
| 278 |  |  |  |  | in the manner of the bareword form of C<require>.  That means that a | 
| 279 |  |  |  |  | search through C<@INC> is performed, and a byte-compiled form of the | 
| 280 |  |  |  |  | module will be used if available. | 
| 281 |  |  |  |  |  | 
| 282 |  |  |  |  | The return value is as for C<require>.  That is, it is the value returned | 
| 283 |  |  |  |  | by the module itself if the module is loaded anew, or C<1> if the module | 
| 284 |  |  |  |  | was already loaded. | 
| 285 |  |  |  |  |  | 
| 286 |  |  |  |  | =cut | 
| 287 |  |  |  |  |  | 
| 288 |  |  |  |  | # Don't "use constant" here, to avoid dependencies. | 
| 289 |  |  |  |  | BEGIN { | 
| 290 |  |  |  |  |         *_WORK_AROUND_HINT_LEAKAGE = | 
| 291 |  |  |  |  |                 "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001) | 
| 292 |  |  |  |  |                         ? sub(){1} : sub(){0}; | 
| 293 |  |  |  |  |         *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; | 
| 294 |  |  |  |  | } | 
| 295 |  |  |  |  |  | 
| 296 |  |  |  |  | BEGIN { if(_WORK_AROUND_BROKEN_MODULE_STATE) { eval q{ | 
| 297 |  |  |  |  |         sub Module::Runtime::__GUARD__::DESTROY { | 
| 298 |  |  |  |  |                 delete $INC{$_[0]->[0]} if @{$_[0]}; | 
| 299 |  |  |  |  |         } | 
| 300 |  |  |  |  |         1; | 
| 301 |  |  |  |  | }; die $@ if $@ ne ""; } } | 
| 302 |  |  |  |  |  | 
| 303 |  |  |  |  | sub require_module($) { | 
| 304 |  |  |  |  |         # Localise %^H to work around [perl #68590], where the bug exists | 
| 305 |  |  |  |  |         # and this is a satisfactory workaround.  The bug consists of | 
| 306 |  |  |  |  |         # %^H state leaking into each required module, polluting the | 
| 307 |  |  |  |  |         # module's lexical state. | 
| 308 |  |  |  |  |         local %^H if _WORK_AROUND_HINT_LEAKAGE; | 
| 309 |  |  |  |  |         if(_WORK_AROUND_BROKEN_MODULE_STATE) { | 
| 310 |  |  |  |  |                 my $notional_filename = &module_notional_filename; | 
| 311 |  |  |  |  |                 my $guard = bless([ $notional_filename ], | 
| 312 |  |  |  |  |                                 "Module::Runtime::__GUARD__"); | 
| 313 |  |  |  |  |                 my $result = CORE::require($notional_filename); | 
| 314 |  |  |  |  |                 pop @$guard; | 
| 315 |  |  |  |  |                 return $result; | 
| 316 |  |  |  |  |         } else { | 
| 317 | 1 | 10µs |  |  |                 return scalar(CORE::require(&module_notional_filename)); | 
| 318 |  |  |  |  |         } | 
| 319 |  |  |  |  | } | 
| 320 |  |  |  |  |  | 
| 321 |  |  |  |  | =back | 
| 322 |  |  |  |  |  | 
| 323 |  |  |  |  | =head2 Structured module use | 
| 324 |  |  |  |  |  | 
| 325 |  |  |  |  | =over | 
| 326 |  |  |  |  |  | 
| 327 |  |  |  |  | =item use_module(NAME[, VERSION]) | 
| 328 |  |  |  |  |  | 
| 329 |  |  |  |  | This is essentially C<use> in runtime form, but without the importing | 
| 330 |  |  |  |  | feature (which is fundamentally a compile-time thing).  The I<NAME> is | 
| 331 |  |  |  |  | handled just like in C<require_module> above: it must be a module name, | 
| 332 |  |  |  |  | and the named module is loaded as if by the bareword form of C<require>. | 
| 333 |  |  |  |  |  | 
| 334 |  |  |  |  | If a I<VERSION> is specified, the C<VERSION> method of the loaded module is | 
| 335 |  |  |  |  | called with the specified I<VERSION> as an argument.  This normally serves to | 
| 336 |  |  |  |  | ensure that the version loaded is at least the version required.  This is | 
| 337 |  |  |  |  | the same functionality provided by the I<VERSION> parameter of C<use>. | 
| 338 |  |  |  |  |  | 
| 339 |  |  |  |  | On success, the name of the module is returned.  This is unlike | 
| 340 |  |  |  |  | L</require_module>, and is done so that the entire call to L</use_module> | 
| 341 |  |  |  |  | can be used as a class name to call a constructor, as in the example in | 
| 342 |  |  |  |  | the synopsis. | 
| 343 |  |  |  |  |  | 
| 344 |  |  |  |  | =cut | 
| 345 |  |  |  |  |  | 
| 346 |  |  |  |  | sub use_module($;$) { | 
| 347 |  |  |  |  |         my($name, $version) = @_; | 
| 348 |  |  |  |  |         require_module($name); | 
| 349 |  |  |  |  |         $name->VERSION($version) if @_ >= 2; | 
| 350 |  |  |  |  |         return $name; | 
| 351 |  |  |  |  | } | 
| 352 |  |  |  |  |  | 
| 353 |  |  |  |  | =item use_package_optimistically(NAME[, VERSION]) | 
| 354 |  |  |  |  |  | 
| 355 |  |  |  |  | This is an analogue of L</use_module> for the situation where there is | 
| 356 |  |  |  |  | uncertainty as to whether a package/class is defined in its own module | 
| 357 |  |  |  |  | or by some other means.  It attempts to arrange for the named package to | 
| 358 |  |  |  |  | be available, either by loading a module or by doing nothing and hoping. | 
| 359 |  |  |  |  |  | 
| 360 |  |  |  |  | An attempt is made to load the named module (as if by the bareword form | 
| 361 |  |  |  |  | of C<require>).  If the module cannot be found then it is assumed that | 
| 362 |  |  |  |  | the package was actually already loaded by other means, and no error | 
| 363 |  |  |  |  | is signalled.  That's the optimistic bit. | 
| 364 |  |  |  |  |  | 
| 365 |  |  |  |  | This is mostly the same operation that is performed by the L<base> pragma | 
| 366 |  |  |  |  | to ensure that the specified base classes are available.  The behaviour | 
| 367 |  |  |  |  | of L<base> was simplified in version 2.18, and later improved in version | 
| 368 |  |  |  |  | 2.20, and on both occasions this function changed to match. | 
| 369 |  |  |  |  |  | 
| 370 |  |  |  |  | If a I<VERSION> is specified, the C<VERSION> method of the loaded package is | 
| 371 |  |  |  |  | called with the specified I<VERSION> as an argument.  This normally serves | 
| 372 |  |  |  |  | to ensure that the version loaded is at least the version required. | 
| 373 |  |  |  |  | On success, the name of the package is returned.  These aspects of the | 
| 374 |  |  |  |  | function work just like L</use_module>. | 
| 375 |  |  |  |  |  | 
| 376 |  |  |  |  | =cut | 
| 377 |  |  |  |  |  | 
| 378 |  |  |  |  | sub use_package_optimistically($;$) { | 
| 379 |  |  |  |  |         my($name, $version) = @_; | 
| 380 |  |  |  |  |         my $fn = module_notional_filename($name); | 
| 381 |  |  |  |  |         eval { local $SIG{__DIE__}; require_module($name); }; | 
| 382 |  |  |  |  |         die $@ if $@ ne "" && | 
| 383 |  |  |  |  |                 ($@ !~ /\ACan't locate \Q$fn\E .+ at \Q@{[__FILE__]}\E line/s || | 
| 384 |  |  |  |  |                  $@ =~ /^Compilation\ failed\ in\ require | 
| 385 |  |  |  |  |                          \ at\ \Q@{[__FILE__]}\E\ line/xm); | 
| 386 |  |  |  |  |         $name->VERSION($version) if @_ >= 2; | 
| 387 |  |  |  |  |         return $name; | 
| 388 |  |  |  |  | } | 
| 389 |  |  |  |  |  | 
| 390 |  |  |  |  | =back | 
| 391 |  |  |  |  |  | 
| 392 |  |  |  |  | =head2 Module name composition | 
| 393 |  |  |  |  |  | 
| 394 |  |  |  |  | =over | 
| 395 |  |  |  |  |  | 
| 396 |  |  |  |  | =item is_module_spec(PREFIX, SPEC) | 
| 397 |  |  |  |  |  | 
| 398 |  |  |  |  | Returns a truth value indicating | 
| 399 |  |  |  |  | whether I<SPEC> is valid input for L</compose_module_name>. | 
| 400 |  |  |  |  | See below for what that entails.  Whether a I<PREFIX> is supplied affects | 
| 401 |  |  |  |  | the validity of I<SPEC>, but the exact value of the prefix is unimportant, | 
| 402 |  |  |  |  | so this function treats I<PREFIX> as a truth value. | 
| 403 |  |  |  |  |  | 
| 404 |  |  |  |  | =cut | 
| 405 |  |  |  |  |  | 
| 406 |  |  |  |  | sub is_module_spec($$) { | 
| 407 |  |  |  |  |         my($prefix, $spec) = @_; | 
| 408 |  |  |  |  |         return _is_string($spec) && | 
| 409 |  |  |  |  |                 $spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o : | 
| 410 |  |  |  |  |                                     qr/\A$top_module_spec_rx\z/o); | 
| 411 |  |  |  |  | } | 
| 412 |  |  |  |  |  | 
| 413 |  |  |  |  | =item is_valid_module_spec(PREFIX, SPEC) | 
| 414 |  |  |  |  |  | 
| 415 |  |  |  |  | Deprecated alias for L</is_module_spec>. | 
| 416 |  |  |  |  |  | 
| 417 |  |  |  |  | =cut | 
| 418 |  |  |  |  |  | 
| 419 |  |  |  |  | *is_valid_module_spec = \&is_module_spec; | 
| 420 |  |  |  |  |  | 
| 421 |  |  |  |  | =item check_module_spec(PREFIX, SPEC) | 
| 422 |  |  |  |  |  | 
| 423 |  |  |  |  | Check whether I<SPEC> is valid input for L</compose_module_name>. | 
| 424 |  |  |  |  | Return normally if it is, or C<die> if it is not. | 
| 425 |  |  |  |  |  | 
| 426 |  |  |  |  | =cut | 
| 427 |  |  |  |  |  | 
| 428 |  |  |  |  | sub check_module_spec($$) { | 
| 429 |  |  |  |  |         unless(&is_module_spec) { | 
| 430 |  |  |  |  |                 die +(_is_string($_[1]) ? "`$_[1]'" : "argument"). | 
| 431 |  |  |  |  |                         " is not a module specification\n"; | 
| 432 |  |  |  |  |         } | 
| 433 |  |  |  |  | } | 
| 434 |  |  |  |  |  | 
| 435 |  |  |  |  | =item compose_module_name(PREFIX, SPEC) | 
| 436 |  |  |  |  |  | 
| 437 |  |  |  |  | This function is intended to make it more convenient for a user to specify | 
| 438 |  |  |  |  | a Perl module name at runtime.  Users have greater need for abbreviations | 
| 439 |  |  |  |  | and context-sensitivity than programmers, and Perl module names get a | 
| 440 |  |  |  |  | little unwieldy.  I<SPEC> is what the user specifies, and this function | 
| 441 |  |  |  |  | translates it into a module name in standard form, which it returns. | 
| 442 |  |  |  |  |  | 
| 443 |  |  |  |  | I<SPEC> has syntax approximately that of a standard module name: it | 
| 444 |  |  |  |  | should consist of one or more name segments, each of which consists | 
| 445 |  |  |  |  | of one or more identifier characters.  However, C</> is permitted as a | 
| 446 |  |  |  |  | separator, in addition to the standard C<::>.  The two separators are | 
| 447 |  |  |  |  | entirely interchangeable. | 
| 448 |  |  |  |  |  | 
| 449 |  |  |  |  | Additionally, if I<PREFIX> is not C<undef> then it must be a module | 
| 450 |  |  |  |  | name in standard form, and it is prefixed to the user-specified name. | 
| 451 |  |  |  |  | The user can inhibit the prefix addition by starting I<SPEC> with a | 
| 452 |  |  |  |  | separator (either C</> or C<::>). | 
| 453 |  |  |  |  |  | 
| 454 |  |  |  |  | =cut | 
| 455 |  |  |  |  |  | 
| 456 |  |  |  |  | sub compose_module_name($$) { | 
| 457 |  |  |  |  |         my($prefix, $spec) = @_; | 
| 458 |  |  |  |  |         check_module_name($prefix) if defined $prefix; | 
| 459 |  |  |  |  |         &check_module_spec; | 
| 460 |  |  |  |  |         if($spec =~ s#\A(?:/|::)##) { | 
| 461 |  |  |  |  |                 # OK | 
| 462 |  |  |  |  |         } else { | 
| 463 |  |  |  |  |                 $spec = $prefix."::".$spec if defined $prefix; | 
| 464 |  |  |  |  |         } | 
| 465 |  |  |  |  |         $spec =~ s#/#::#g; | 
| 466 |  |  |  |  |         return $spec; | 
| 467 |  |  |  |  | } | 
| 468 |  |  |  |  |  | 
| 469 |  |  |  |  | =back | 
| 470 |  |  |  |  |  | 
| 471 |  |  |  |  | =head1 BUGS | 
| 472 |  |  |  |  |  | 
| 473 |  |  |  |  | On Perl versions 5.7.2 to 5.8.8, if C<require> is overridden by the | 
| 474 |  |  |  |  | C<CORE::GLOBAL> mechanism, it is likely to break the heuristics used by | 
| 475 |  |  |  |  | L</use_package_optimistically>, making it signal an error for a missing | 
| 476 |  |  |  |  | module rather than assume that it was already loaded.  From Perl 5.8.9 | 
| 477 |  |  |  |  | onwards, and on 5.7.1 and earlier, this module can avoid being confused | 
| 478 |  |  |  |  | by such an override.  On the affected versions, a C<require> override | 
| 479 |  |  |  |  | might be installed by L<Lexical::SealRequireHints>, if something requires | 
| 480 |  |  |  |  | its bugfix but for some reason its XS implementation isn't available. | 
| 481 |  |  |  |  |  | 
| 482 |  |  |  |  | =head1 SEE ALSO | 
| 483 |  |  |  |  |  | 
| 484 |  |  |  |  | L<Lexical::SealRequireHints>, | 
| 485 |  |  |  |  | L<base>, | 
| 486 |  |  |  |  | L<perlfunc/require>, | 
| 487 |  |  |  |  | L<perlfunc/use> | 
| 488 |  |  |  |  |  | 
| 489 |  |  |  |  | =head1 AUTHOR | 
| 490 |  |  |  |  |  | 
| 491 |  |  |  |  | Andrew Main (Zefram) <zefram@fysh.org> | 
| 492 |  |  |  |  |  | 
| 493 |  |  |  |  | =head1 COPYRIGHT | 
| 494 |  |  |  |  |  | 
| 495 |  |  |  |  | Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012, 2014 | 
| 496 |  |  |  |  | Andrew Main (Zefram) <zefram@fysh.org> | 
| 497 |  |  |  |  |  | 
| 498 |  |  |  |  | =head1 LICENSE | 
| 499 |  |  |  |  |  | 
| 500 |  |  |  |  | This module is free software; you can redistribute it and/or modify it | 
| 501 |  |  |  |  | under the same terms as Perl itself. | 
| 502 |  |  |  |  |  | 
| 503 |  |  |  |  | =cut | 
| 504 |  |  |  |  |  | 
| 505 |  |  |  |  | 1; |