← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:14 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/CPAN/InfoObj.pm
StatementsExecuted 637672 statements in 875ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
21254311507ms507msCPAN::InfoObj::::newCPAN::InfoObj::new
771205µs782µsCPAN::InfoObj::::safe_chdirCPAN::InfoObj::safe_chdir
108334µs34µsCPAN::InfoObj::::idCPAN::InfoObj::id
62125µs25µsCPAN::InfoObj::::roCPAN::InfoObj::ro
0000s0sCPAN::InfoObj::::BEGINCPAN::InfoObj::BEGIN
0000s0sCPAN::InfoObj::::as_glimpseCPAN::InfoObj::as_glimpse
0000s0sCPAN::InfoObj::::as_stringCPAN::InfoObj::as_string
0000s0sCPAN::InfoObj::::cpan_useridCPAN::InfoObj::cpan_userid
0000s0sCPAN::InfoObj::::dumpCPAN::InfoObj::dump
0000s0sCPAN::InfoObj::::fullnameCPAN::InfoObj::fullname
0000s0sCPAN::InfoObj::::setCPAN::InfoObj::set
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2# vim: ts=4 sts=4 sw=4:
3package CPAN::InfoObj;
4use strict;
5
6use CPAN::Debug;
7@CPAN::InfoObj::ISA = qw(CPAN::Debug);
8
9use Cwd qw(chdir);
10
11use vars qw(
12 $VERSION
13);
14$VERSION = "5.5";
15
16
# spent 25µs within CPAN::InfoObj::ro which was called 6 times, avg 4µs/call: # 3 times (19µs+0s) by CPAN::Module::cpan_file at line 366 of CPAN/Module.pm, avg 6µs/call # 3 times (6µs+0s) by CPAN::Module::cpan_file at line 369 of CPAN/Module.pm, avg 2µs/call
sub ro {
1762µs my $self = shift;
18627µs exists $self->{RO} and return $self->{RO};
19}
20
21#-> sub CPAN::InfoObj::cpan_userid
22sub cpan_userid {
23 my $self = shift;
24 my $ro = $self->ro;
25 if ($ro) {
26 return $ro->{CPAN_USERID} || "N/A";
27 } else {
28 $self->debug("ID[$self->{ID}]");
29 # N/A for bundles found locally
30 return "N/A";
31 }
32}
33
341069µs
# spent 34µs within CPAN::InfoObj::id which was called 10 times, avg 3µs/call: # 3 times (14µs+0s) by CPAN::Distribution::is_dot_dist at line 62 of CPAN/Distribution.pm, avg 5µs/call # once (5µs+0s) by CPAN::Shell::rematein at line 1764 of CPAN/Shell.pm # once (4µs+0s) by CPAN::Distribution::look at line 1282 of CPAN/Distribution.pm # once (3µs+0s) by CPAN::Distribution::verifyCHECKSUM at line 1409 of CPAN/Distribution.pm # once (2µs+0s) by CPAN::Module::rematein at line 449 of CPAN/Module.pm # once (2µs+0s) by CPAN::Module::rematein at line 431 of CPAN/Module.pm # once (2µs+0s) by CPAN::Distribution::pretty_id at line 158 of CPAN/Distribution.pm # once (2µs+0s) by CPAN::Distribution::get_file_onto_local_disk at line 430 of CPAN/Distribution.pm
sub id { shift->{ID}; }
35
36#-> sub CPAN::InfoObj::new ;
37
# spent 507ms within CPAN::InfoObj::new which was called 212543 times, avg 2µs/call: # 212543 times (507ms+0s) by CPAN::Index::read_metadata_cache at line 601 of CPAN/Index.pm, avg 2µs/call
sub new {
38212543132ms my $this = bless {}, shift;
39212543190ms %$this = @_;
40212543552ms $this
41}
42
43# The set method may only be used by code that reads index data or
44# otherwise "objective" data from the outside world. All session
45# related material may do anything else with instance variables but
46# must not touch the hash under the RO attribute. The reason is that
47# the RO hash gets written to Metadata file and is thus persistent.
48
49#-> sub CPAN::InfoObj::safe_chdir ;
50
# spent 782µs (205+577) within CPAN::InfoObj::safe_chdir which was called 7 times, avg 112µs/call: # once (45µs+169µs) by CPAN::Distribution::run_preps_on_packagedir at line 589 of CPAN/Distribution.pm # once (39µs+84µs) by CPAN::Distribution::look at line 1315 of CPAN/Distribution.pm # once (61µs+57µs) by CPAN::Distribution::run_preps_on_packagedir at line 472 of CPAN/Distribution.pm # once (31µs+83µs) by CPAN::Distribution::look at line 1294 of CPAN/Distribution.pm # once (10µs+95µs) by CPAN::Distribution::run_preps_on_packagedir at line 489 of CPAN/Distribution.pm # once (14µs+64µs) by CPAN::Distribution::run_preps_on_packagedir at line 592 of CPAN/Distribution.pm # once (5µs+25µs) by CPAN::Distribution::run_preps_on_packagedir at line 594 of CPAN/Distribution.pm
sub safe_chdir {
51737µs my($self,$todir) = @_;
52 # we die if we cannot chdir and we are debuggable
53729µs Carp::confess("safe_chdir called without todir argument")
54 unless defined $todir and length $todir;
557134µs7577µs if (chdir $todir) {
# spent 577µs making 7 calls to Cwd::chdir, avg 82µs/call
56 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
57 if $CPAN::DEBUG;
58 } else {
59 if (-e $todir) {
60 unless (-x $todir) {
61 unless (chmod 0755, $todir) {
62 my $cwd = CPAN::anycwd();
63 $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
64 "permission to change the permission; cannot ".
65 "chdir to '$todir'\n");
66 $CPAN::Frontend->mysleep(5);
67 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
68 qq{to todir[$todir]: $!});
69 }
70 }
71 } else {
72 $CPAN::Frontend->mydie("Directory '$todir' has gone. Cannot continue.\n");
73 }
74 if (chdir $todir) {
75 $self->debug(sprintf "changed directory to %s", CPAN::anycwd())
76 if $CPAN::DEBUG;
77 } else {
78 my $cwd = CPAN::anycwd();
79 $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }.
80 qq{to todir[$todir] (a chmod has been issued): $!});
81 }
82 }
83}
84
85#-> sub CPAN::InfoObj::set ;
86sub set {
87 my($self,%att) = @_;
88 my $class = ref $self;
89
90 # This must be ||=, not ||, because only if we write an empty
91 # reference, only then the set method will write into the readonly
92 # area. But for Distributions that spring into existence, maybe
93 # because of a typo, we do not like it that they are written into
94 # the readonly area and made permanent (at least for a while) and
95 # that is why we do not "allow" other places to call ->set.
96 unless ($self->id) {
97 CPAN->debug("Bug? Empty ID, rejecting");
98 return;
99 }
100 my $ro = $self->{RO} =
101 $CPAN::META->{readonly}{$class}{$self->id} ||= {};
102
103 while (my($k,$v) = each %att) {
104 $ro->{$k} = $v;
105 }
106}
107
108#-> sub CPAN::InfoObj::as_glimpse ;
109sub as_glimpse {
110 my($self) = @_;
111 my(@m);
112 my $class = ref($self);
113 $class =~ s/^CPAN:://;
114 my $id = $self->can("pretty_id") ? $self->pretty_id : $self->{ID};
115 push @m, sprintf "%-15s %s\n", $class, $id;
116 join "", @m;
117}
118
119#-> sub CPAN::InfoObj::as_string ;
120sub as_string {
121 my($self) = @_;
122 my(@m);
123 my $class = ref($self);
124 $class =~ s/^CPAN:://;
125 push @m, $class, " id = $self->{ID}\n";
126 my $ro;
127 unless ($ro = $self->ro) {
128 if (substr($self->{ID},-1,1) eq ".") { # directory
129 $ro = +{};
130 } else {
131 $CPAN::Frontend->mywarn("Unknown object $self->{ID}\n");
132 $CPAN::Frontend->mysleep(5);
133 return;
134 }
135 }
136 for (sort keys %$ro) {
137 # next if m/^(ID|RO)$/;
138 my $extra = "";
139 if ($_ eq "CPAN_USERID") {
140 $extra .= " (";
141 $extra .= $self->fullname;
142 my $email; # old perls!
143 if ($email = $CPAN::META->instance("CPAN::Author",
144 $self->cpan_userid
145 )->email) {
146 $extra .= " <$email>";
147 } else {
148 $extra .= " <no email>";
149 }
150 $extra .= ")";
151 } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion
152 push @m, sprintf " %-12s %s\n", $_, $self->fullname;
153 next;
154 }
155 next unless defined $ro->{$_};
156 push @m, sprintf " %-12s %s%s\n", $_, $ro->{$_}, $extra;
157 }
158 KEY: for (sort keys %$self) {
159 next if m/^(ID|RO)$/;
160 unless (defined $self->{$_}) {
161 delete $self->{$_};
162 next KEY;
163 }
164 if (ref($self->{$_}) eq "ARRAY") {
165 push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}";
166 } elsif (ref($self->{$_}) eq "HASH") {
167 my $value;
168 if (/^CONTAINSMODS$/) {
169 $value = join(" ",sort keys %{$self->{$_}});
170 } elsif (/^prereq_pm$/) {
171 my @value;
172 my $v = $self->{$_};
173 for my $x (sort keys %$v) {
174 my @svalue;
175 for my $y (sort keys %{$v->{$x}}) {
176 push @svalue, "$y=>$v->{$x}{$y}";
177 }
178 push @value, "$x\:" . join ",", @svalue if @svalue;
179 }
180 $value = join ";", @value;
181 } else {
182 $value = $self->{$_};
183 }
184 push @m, sprintf(
185 " %-12s %s\n",
186 $_,
187 $value,
188 );
189 } else {
190 push @m, sprintf " %-12s %s\n", $_, $self->{$_};
191 }
192 }
193 join "", @m, "\n";
194}
195
196#-> sub CPAN::InfoObj::fullname ;
197sub fullname {
198 my($self) = @_;
199 $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname;
200}
201
202#-> sub CPAN::InfoObj::dump ;
203sub dump {
204 my($self, $what) = @_;
205 unless ($CPAN::META->has_inst("Data::Dumper")) {
206 $CPAN::Frontend->mydie("dump command requires Data::Dumper installed");
207 }
208 local $Data::Dumper::Sortkeys;
209 $Data::Dumper::Sortkeys = 1;
210 my $out = Data::Dumper::Dumper($what ? eval $what : $self);
211 if (length $out > 100000) {
212 my $fh_pager = FileHandle->new;
213 local($SIG{PIPE}) = "IGNORE";
214 my $pager = $CPAN::Config->{'pager'} || "cat";
215 $fh_pager->open("|$pager")
216 or die "Could not open pager $pager\: $!";
217 $fh_pager->print($out);
218 close $fh_pager;
219 } else {
220 $CPAN::Frontend->myprint($out);
221 }
222}
223
2241;
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.