| File | /usr/share/perl/5.8/constant.pm | Statements Executed | 17 | Total Time | 4.4e-05 seconds |
| Calls | Inclusive Time | Subroutine | |
|---|---|---|---|
| 1 | 0.00007 | constant:: | import |
| 0 | 0 | constant:: | BEGIN |
| 0 | 0 | constant:: | __ANON__[:103] |
| 0 | 0 | constant:: | __ANON__[:106] |
| 0 | 0 | constant:: | __ANON__[:108] |
| 0 | 0 | constant:: | __ANON__[:99] |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package constant; | |||
| 2 | ||||
| 3 | use strict; | |||
| 4 | use 5.006_00; | |||
| 5 | use warnings::register; | |||
| 6 | ||||
| 7 | our($VERSION, %declared); | |||
| 8 | $VERSION = '1.05'; | |||
| 9 | ||||
| 10 | #======================================================================= | |||
| 11 | ||||
| 12 | # Some names are evil choices. | |||
| 13 | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; | |||
| 14 | ||||
| 15 | my %forced_into_main = map +($_, 1), | |||
| 16 | qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; | |||
| 17 | ||||
| 18 | my %forbidden = (%keywords, %forced_into_main); | |||
| 19 | ||||
| 20 | #======================================================================= | |||
| 21 | # import() - import symbols into user's namespace | |||
| 22 | # | |||
| 23 | # What we actually do is define a function in the caller's namespace | |||
| 24 | # which returns the value. The function we create will normally | |||
| 25 | # be inlined as a constant, thereby avoiding further sub calling | |||
| 26 | # overhead. | |||
| 27 | #======================================================================= | |||
| 28 | # spent 0.00007s within constant::import which was called:
# 1 times (0.00007s) by YAML::Syck::BEGIN at line 52 of /usr/lib/perl5/YAML/Syck.pm sub import { | |||
| 29 | 17 | 0.00004 | 3e-06 | my $class = shift; |
| 30 | return unless @_; # Ignore 'use constant;' | |||
| 31 | my %constants = (); | |||
| 32 | my $multiple = ref $_[0]; | |||
| 33 | ||||
| 34 | if ( $multiple ) { | |||
| 35 | if (ref $_[0] ne 'HASH') { | |||
| 36 | require Carp; | |||
| 37 | Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'"); | |||
| 38 | } | |||
| 39 | %constants = %{+shift}; | |||
| 40 | } else { | |||
| 41 | $constants{+shift} = undef; | |||
| 42 | } | |||
| 43 | ||||
| 44 | foreach my $name ( keys %constants ) { | |||
| 45 | unless (defined $name) { | |||
| 46 | require Carp; | |||
| 47 | Carp::croak("Can't use undef as constant name"); | |||
| 48 | } | |||
| 49 | my $pkg = caller; | |||
| 50 | ||||
| 51 | # Normal constant name | |||
| 52 | if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) { | |||
| 53 | # Everything is okay | |||
| 54 | ||||
| 55 | # Name forced into main, but we're not in main. Fatal. | |||
| 56 | } elsif ($forced_into_main{$name} and $pkg ne 'main') { | |||
| 57 | require Carp; | |||
| 58 | Carp::croak("Constant name '$name' is forced into main::"); | |||
| 59 | ||||
| 60 | # Starts with double underscore. Fatal. | |||
| 61 | } elsif ($name =~ /^__/) { | |||
| 62 | require Carp; | |||
| 63 | Carp::croak("Constant name '$name' begins with '__'"); | |||
| 64 | ||||
| 65 | # Maybe the name is tolerable | |||
| 66 | } elsif ($name =~ /^[A-Za-z_]\w*\z/) { | |||
| 67 | # Then we'll warn only if you've asked for warnings | |||
| 68 | if (warnings::enabled()) { | |||
| 69 | if ($keywords{$name}) { | |||
| 70 | warnings::warn("Constant name '$name' is a Perl keyword"); | |||
| 71 | } elsif ($forced_into_main{$name}) { | |||
| 72 | warnings::warn("Constant name '$name' is " . | |||
| 73 | "forced into package main::"); | |||
| 74 | } | |||
| 75 | } | |||
| 76 | ||||
| 77 | # Looks like a boolean | |||
| 78 | # use constant FRED == fred; | |||
| 79 | } elsif ($name =~ /^[01]?\z/) { | |||
| 80 | require Carp; | |||
| 81 | if (@_) { | |||
| 82 | Carp::croak("Constant name '$name' is invalid"); | |||
| 83 | } else { | |||
| 84 | Carp::croak("Constant name looks like boolean value"); | |||
| 85 | } | |||
| 86 | ||||
| 87 | } else { | |||
| 88 | # Must have bad characters | |||
| 89 | require Carp; | |||
| 90 | Carp::croak("Constant name '$name' has invalid characters"); | |||
| 91 | } | |||
| 92 | ||||
| 93 | { | |||
| 94 | no strict 'refs'; | |||
| 95 | my $full_name = "${pkg}::$name"; | |||
| 96 | $declared{$full_name}++; | |||
| 97 | if ($multiple) { | |||
| 98 | my $scalar = $constants{$name}; | |||
| 99 | *$full_name = sub () { $scalar }; | |||
| 100 | } else { | |||
| 101 | if (@_ == 1) { | |||
| 102 | my $scalar = $_[0]; | |||
| 103 | *$full_name = sub () { $scalar }; | |||
| 104 | } elsif (@_) { | |||
| 105 | my @list = @_; | |||
| 106 | *$full_name = sub () { @list }; | |||
| 107 | } else { | |||
| 108 | *$full_name = sub () { }; | |||
| 109 | } | |||
| 110 | } | |||
| 111 | } | |||
| 112 | } | |||
| 113 | } | |||
| 114 | ||||
| 115 | 1; | |||
| 116 | ||||
| 117 | __END__ | |||
| 118 |