| Filename | /usr/share/perl5/YAML/Types.pm | 
| Statements | Executed 32 statements in 2.25ms | 
| Calls | P | F | Exclusive Time | Inclusive Time | Subroutine | 
|---|---|---|---|---|---|
| 1 | 1 | 1 | 49.4ms | 51.7ms | YAML::Type::code::BEGIN@137 | 
| 1 | 1 | 1 | 52µs | 136µs | YAML::Type::regexp::BEGIN@200 | 
| 1 | 1 | 1 | 22µs | 29µs | YAML::Types::BEGIN@3 | 
| 1 | 1 | 1 | 18µs | 49µs | YAML::Type::blessed::BEGIN@22 | 
| 1 | 1 | 1 | 16µs | 38µs | YAML::Type::glob::BEGIN@97 | 
| 1 | 1 | 1 | 15µs | 46µs | YAML::Types::BEGIN@6 | 
| 1 | 1 | 1 | 15µs | 38µs | YAML::Types::BEGIN@4 | 
| 1 | 1 | 1 | 12µs | 59µs | YAML::Types::BEGIN@5 | 
| 1 | 1 | 1 | 11µs | 46µs | YAML::Type::blessed::BEGIN@16 | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::blessed::yaml_dump | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::code::__ANON__[:163] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::code::__ANON__[:171] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::code::__ANON__[:172] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::code::yaml_dump | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::code::yaml_load | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::glob::yaml_dump | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::glob::yaml_load | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::ref::yaml_dump | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::ref::yaml_load | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:201] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:202] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:203] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:204] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:205] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:206] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:207] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:208] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:209] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:210] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:211] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:212] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:213] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:214] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:215] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:216] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::__ANON__[:225] | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::yaml_dump | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::regexp::yaml_load | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::undef::yaml_dump | 
| 0 | 0 | 0 | 0s | 0s | YAML::Type::undef::yaml_load | 
| Line | State ments | Time on line | Calls | Time in subs | Code | 
|---|---|---|---|---|---|
| 1 | package YAML::Types; | ||||
| 2 | |||||
| 3 | 3 | 37µs | 2 | 36µs | # spent 29µs (22+7) within YAML::Types::BEGIN@3 which was called:
#    once (22µs+7µs) by YAML::Loader::BEGIN@7 at line 3 # spent    29µs making 1 call to YAML::Types::BEGIN@3
# spent     7µs making 1 call to strict::import | 
| 4 | 3 | 30µs | 2 | 62µs | # spent 38µs (15+24) within YAML::Types::BEGIN@4 which was called:
#    once (15µs+24µs) by YAML::Loader::BEGIN@7 at line 4 # spent    38µs making 1 call to YAML::Types::BEGIN@4
# spent    24µs making 1 call to warnings::import | 
| 5 | 3 | 31µs | 2 | 107µs | # spent 59µs (12+47) within YAML::Types::BEGIN@5 which was called:
#    once (12µs+47µs) by YAML::Loader::BEGIN@7 at line 5 # spent    59µs making 1 call to YAML::Types::BEGIN@5
# spent    48µs making 1 call to Exporter::import | 
| 6 | 3 | 69µs | 2 | 78µs | # spent 46µs (15+31) within YAML::Types::BEGIN@6 which was called:
#    once (15µs+31µs) by YAML::Loader::BEGIN@7 at line 6 # spent    46µs making 1 call to YAML::Types::BEGIN@6
# spent    31µs making 1 call to Exporter::import | 
| 7 | |||||
| 8 | 1 | 2µs | our $VERSION = '0.71'; | ||
| 9 | 1 | 19µs | our @ISA = 'YAML::Base'; | ||
| 10 | |||||
| 11 | # XXX These classes and their APIs could still use some refactoring, | ||||
| 12 | # but at least they work for now. | ||||
| 13 | #------------------------------------------------------------------------------- | ||||
| 14 | package YAML::Type::blessed; | ||||
| 15 | |||||
| 16 | 3 | 67µs | 2 | 82µs | # spent 46µs (11+36) within YAML::Type::blessed::BEGIN@16 which was called:
#    once (11µs+36µs) by YAML::Loader::BEGIN@7 at line 16 # spent    46µs making 1 call to YAML::Type::blessed::BEGIN@16
# spent    36µs making 1 call to Exporter::import | 
| 17 | |||||
| 18 | sub yaml_dump { | ||||
| 19 | my $self = shift; | ||||
| 20 | my ($value) = @_; | ||||
| 21 | my ($class, $type) = YAML::Base->node_info($value); | ||||
| 22 | 3 | 517µs | 2 | 80µs | # spent 49µs (18+31) within YAML::Type::blessed::BEGIN@22 which was called:
#    once (18µs+31µs) by YAML::Loader::BEGIN@7 at line 22     # spent    49µs making 1 call to YAML::Type::blessed::BEGIN@22
    # spent    31µs making 1 call to strict::unimport | 
| 23 | my $kind = lc($type) . ':'; | ||||
| 24 | my $tag = ${$class . '::ClassTag'} || | ||||
| 25 | "!perl/$kind$class"; | ||||
| 26 | if ($type eq 'REF') { | ||||
| 27 | YAML::Node->new( | ||||
| 28 | {(&YAML::VALUE, ${$_[0]})}, $tag | ||||
| 29 | ); | ||||
| 30 | } | ||||
| 31 | elsif ($type eq 'SCALAR') { | ||||
| 32 | $_[1] = $$value; | ||||
| 33 | YAML::Node->new($_[1], $tag); | ||||
| 34 | } else { | ||||
| 35 | YAML::Node->new($value, $tag); | ||||
| 36 | } | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | #------------------------------------------------------------------------------- | ||||
| 40 | package YAML::Type::undef; | ||||
| 41 | |||||
| 42 | sub yaml_dump { | ||||
| 43 | my $self = shift; | ||||
| 44 | } | ||||
| 45 | |||||
| 46 | sub yaml_load { | ||||
| 47 | my $self = shift; | ||||
| 48 | } | ||||
| 49 | |||||
| 50 | #------------------------------------------------------------------------------- | ||||
| 51 | package YAML::Type::glob; | ||||
| 52 | |||||
| 53 | sub yaml_dump { | ||||
| 54 | my $self = shift; | ||||
| 55 | my $ynode = YAML::Node->new({}, '!perl/glob:'); | ||||
| 56 | for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) { | ||||
| 57 | my $value = *{$_[0]}{$type}; | ||||
| 58 | $value = $$value if $type eq 'SCALAR'; | ||||
| 59 | if (defined $value) { | ||||
| 60 | if ($type eq 'IO') { | ||||
| 61 | my @stats = qw(device inode mode links uid gid rdev size | ||||
| 62 | atime mtime ctime blksize blocks); | ||||
| 63 | undef $value; | ||||
| 64 | $value->{stat} = YAML::Node->new({}); | ||||
| 65 | map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]}); | ||||
| 66 | $value->{fileno} = fileno(*{$_[0]}); | ||||
| 67 | { | ||||
| 68 | local $^W; | ||||
| 69 | $value->{tell} = tell(*{$_[0]}); | ||||
| 70 | } | ||||
| 71 | } | ||||
| 72 | $ynode->{$type} = $value; | ||||
| 73 | } | ||||
| 74 | } | ||||
| 75 | return $ynode; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | sub yaml_load { | ||||
| 79 | my $self = shift; | ||||
| 80 | my ($node, $class, $loader) = @_; | ||||
| 81 | my ($name, $package); | ||||
| 82 | if (defined $node->{NAME}) { | ||||
| 83 | $name = $node->{NAME}; | ||||
| 84 | delete $node->{NAME}; | ||||
| 85 | } | ||||
| 86 | else { | ||||
| 87 | $loader->warn('YAML_LOAD_WARN_GLOB_NAME'); | ||||
| 88 | return undef; | ||||
| 89 | } | ||||
| 90 | if (defined $node->{PACKAGE}) { | ||||
| 91 | $package = $node->{PACKAGE}; | ||||
| 92 | delete $node->{PACKAGE}; | ||||
| 93 | } | ||||
| 94 | else { | ||||
| 95 | $package = 'main'; | ||||
| 96 | } | ||||
| 97 | 3 | 365µs | 2 | 60µs | # spent 38µs (16+22) within YAML::Type::glob::BEGIN@97 which was called:
#    once (16µs+22µs) by YAML::Loader::BEGIN@7 at line 97     # spent    38µs making 1 call to YAML::Type::glob::BEGIN@97
    # spent    22µs making 1 call to strict::unimport | 
| 98 | if (exists $node->{SCALAR}) { | ||||
| 99 | *{"${package}::$name"} = \$node->{SCALAR}; | ||||
| 100 | delete $node->{SCALAR}; | ||||
| 101 | } | ||||
| 102 | for my $elem (qw(ARRAY HASH CODE IO)) { | ||||
| 103 | if (exists $node->{$elem}) { | ||||
| 104 | if ($elem eq 'IO') { | ||||
| 105 | $loader->warn('YAML_LOAD_WARN_GLOB_IO'); | ||||
| 106 | delete $node->{IO}; | ||||
| 107 | next; | ||||
| 108 | } | ||||
| 109 | *{"${package}::$name"} = $node->{$elem}; | ||||
| 110 | delete $node->{$elem}; | ||||
| 111 | } | ||||
| 112 | } | ||||
| 113 | for my $elem (sort keys %$node) { | ||||
| 114 | $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem); | ||||
| 115 | } | ||||
| 116 | return *{"${package}::$name"}; | ||||
| 117 | } | ||||
| 118 | |||||
| 119 | #------------------------------------------------------------------------------- | ||||
| 120 | package YAML::Type::code; | ||||
| 121 | |||||
| 122 | 1 | 600ns | my $dummy_warned = 0; | ||
| 123 | 1 | 500ns | my $default = '{ "DUMMY" }'; | ||
| 124 | |||||
| 125 | sub yaml_dump { | ||||
| 126 | my $self = shift; | ||||
| 127 | my $code; | ||||
| 128 | my ($dumpflag, $value) = @_; | ||||
| 129 | my ($class, $type) = YAML::Base->node_info($value); | ||||
| 130 | my $tag = "!perl/code"; | ||||
| 131 | $tag .= ":$class" if defined $class; | ||||
| 132 | if (not $dumpflag) { | ||||
| 133 | $code = $default; | ||||
| 134 | } | ||||
| 135 | else { | ||||
| 136 | bless $value, "CODE" if $class; | ||||
| 137 | 3 | 887µs | 1 | 51.7ms | # spent 51.7ms (49.4+2.31) within YAML::Type::code::BEGIN@137 which was called:
#    once (49.4ms+2.31ms) by YAML::Loader::BEGIN@7 at line 137         # spent  51.7ms making 1 call to YAML::Type::code::BEGIN@137 | 
| 138 | return if $@; | ||||
| 139 | my $deparse = B::Deparse->new(); | ||||
| 140 | eval { | ||||
| 141 | local $^W = 0; | ||||
| 142 | $code = $deparse->coderef2text($value); | ||||
| 143 | }; | ||||
| 144 | if ($@) { | ||||
| 145 | warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W; | ||||
| 146 | $code = $default; | ||||
| 147 | } | ||||
| 148 | bless $value, $class if $class; | ||||
| 149 | chomp $code; | ||||
| 150 | $code .= "\n"; | ||||
| 151 | } | ||||
| 152 | $_[2] = $code; | ||||
| 153 | YAML::Node->new($_[2], $tag); | ||||
| 154 | } | ||||
| 155 | |||||
| 156 | sub yaml_load { | ||||
| 157 | my $self = shift; | ||||
| 158 | my ($node, $class, $loader) = @_; | ||||
| 159 | if ($loader->load_code) { | ||||
| 160 | my $code = eval "package main; sub $node"; | ||||
| 161 | if ($@) { | ||||
| 162 | $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@); | ||||
| 163 | return sub {}; | ||||
| 164 | } | ||||
| 165 | else { | ||||
| 166 | CORE::bless $code, $class if $class; | ||||
| 167 | return $code; | ||||
| 168 | } | ||||
| 169 | } | ||||
| 170 | else { | ||||
| 171 | return CORE::bless sub {}, $class if $class; | ||||
| 172 | return sub {}; | ||||
| 173 | } | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | #------------------------------------------------------------------------------- | ||||
| 177 | package YAML::Type::ref; | ||||
| 178 | |||||
| 179 | sub yaml_dump { | ||||
| 180 | my $self = shift; | ||||
| 181 | YAML::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref') | ||||
| 182 | } | ||||
| 183 | |||||
| 184 | sub yaml_load { | ||||
| 185 | my $self = shift; | ||||
| 186 | my ($node, $class, $loader) = @_; | ||||
| 187 | $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr') | ||||
| 188 | unless exists $node->{&YAML::VALUE}; | ||||
| 189 | return \$node->{&YAML::VALUE}; | ||||
| 190 | } | ||||
| 191 | |||||
| 192 | #------------------------------------------------------------------------------- | ||||
| 193 | package YAML::Type::regexp; | ||||
| 194 | |||||
| 195 | # XXX Be sure to handle blessed regexps (if possible) | ||||
| 196 | sub yaml_dump { | ||||
| 197 | die "YAML::Type::regexp::yaml_dump not currently implemented"; | ||||
| 198 | } | ||||
| 199 | |||||
| 200 | # spent 136µs (52+84) within YAML::Type::regexp::BEGIN@200 which was called:
#    once (52µs+84µs) by YAML::Loader::BEGIN@7 at line 217 | ||||
| 201 | '' => sub { qr{$_[0]} }, | ||||
| 202 | x => sub { qr{$_[0]}x }, | ||||
| 203 | i => sub { qr{$_[0]}i }, | ||||
| 204 | s => sub { qr{$_[0]}s }, | ||||
| 205 | m => sub { qr{$_[0]}m }, | ||||
| 206 | ix => sub { qr{$_[0]}ix }, | ||||
| 207 | sx => sub { qr{$_[0]}sx }, | ||||
| 208 | mx => sub { qr{$_[0]}mx }, | ||||
| 209 | si => sub { qr{$_[0]}si }, | ||||
| 210 | mi => sub { qr{$_[0]}mi }, | ||||
| 211 | ms => sub { qr{$_[0]}sm }, | ||||
| 212 | six => sub { qr{$_[0]}six }, | ||||
| 213 | mix => sub { qr{$_[0]}mix }, | ||||
| 214 | msx => sub { qr{$_[0]}msx }, | ||||
| 215 | msi => sub { qr{$_[0]}msi }, | ||||
| 216 | msix => sub { qr{$_[0]}msix }, | ||||
| 217 | 3 | 221µs | 2 | 220µs | }; # spent   136µs making 1 call to YAML::Type::regexp::BEGIN@200
# spent    84µs making 1 call to constant::import | 
| 218 | |||||
| 219 | sub yaml_load { | ||||
| 220 | my $self = shift; | ||||
| 221 | my ($node, $class) = @_; | ||||
| 222 | return qr{$node} unless $node =~ /^\(\?([\-xism]*):(.*)\)\z/s; | ||||
| 223 | my ($flags, $re) = ($1, $2); | ||||
| 224 | $flags =~ s/-.*//; | ||||
| 225 | my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} }; | ||||
| 226 | my $qr = &$sub($re); | ||||
| 227 | bless $qr, $class if length $class; | ||||
| 228 | return $qr; | ||||
| 229 | } | ||||
| 230 | |||||
| 231 | 1 | 6µs | 1; | ||
| 232 | |||||
| 233 | __END__ |