Profile of Tapper/Base.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:51 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Tapper/Base.pm
Statements | Executed 23 statements in 1.08ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 2.45ms | 3.56ms | Tapper::Base::::BEGIN@12Tapper::Base::BEGIN@12
1 | 1 | 1 | 835µs | 1.54ms | Tapper::Base::::BEGIN@11Tapper::Base::BEGIN@11
1 | 1 | 1 | 256µs | 271µs | Tapper::Base::::BEGIN@14Tapper::Base::BEGIN@14
1 | 1 | 1 | 47µs | 98µs | Tapper::Base::::BEGIN@16Tapper::Base::BEGIN@16
1 | 1 | 1 | 10µs | 4.15ms | Tapper::Base::::BEGIN@10Tapper::Base::BEGIN@10
1 | 1 | 1 | 10µs | 10µs | Tapper::Base::::BEGIN@2Tapper::Base::BEGIN@2
1 | 1 | 1 | 9µs | 51µs | Tapper::Base::::BEGIN@16.2Tapper::Base::BEGIN@16.2
0 | 0 | 0 | 0s | 0s | Tapper::Base::::kill_instanceTapper::Base::kill_instance
0 | 0 | 0 | 0s | 0s | Tapper::Base::::log_and_execTapper::Base::log_and_exec
0 | 0 | 0 | 0s | 0s | Tapper::Base::::makedirTapper::Base::makedir
0 | 0 | 0 | 0s | 0s | Tapper::Base::::run_oneTapper::Base::run_one

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Tapper::Base;
2 |  |  |  |  | # spent 10µs within Tapper::Base::BEGIN@2 which was called: # once (10µs+0s) by base::import at line 4 BEGIN {
3 | 1 | 4µs |  |  | $Tapper::Base::AUTHORITY = 'cpan:AMD';
4 | 1 | 24µs | 1 | 10µs | } # spent 10µs making 1 call to Tapper::Base::BEGIN@2
5 |  |  |  |  | {
6 | 2 | 1µs |  |  | $Tapper::Base::VERSION = '4.1.3';
7 |  |  |  |  | }
8 |  |  |  |  | # ABSTRACT: Tapper - Common functions for all Tapper classes
9 |  |  |  |  |
10 | 3 | 53µs | 2 | 8.30ms | # spent 4.15ms (10µs+4.14) within Tapper::Base::BEGIN@10 which was called: # once (10µs+4.14ms) by base::import at line 10 use Moose; # spent 4.15ms making 1 call to Tapper::Base::BEGIN@10 # spent 4.14ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:492]
11 | 3 | 155µs | 2 | 1.84ms | # spent 1.54ms (835µs+701µs) within Tapper::Base::BEGIN@11 which was called: # once (835µs+701µs) by base::import at line 11 use Fcntl; # spent 1.54ms making 1 call to Tapper::Base::BEGIN@11 # spent 307µs making 1 call to Exporter::import
12 | 3 | 116µs | 2 | 3.58ms | # spent 3.56ms (2.45+1.11) within Tapper::Base::BEGIN@12 which was called: # once (2.45ms+1.11ms) by base::import at line 12 use LockFile::Simple; # spent 3.56ms making 1 call to Tapper::Base::BEGIN@12 # spent 22µs making 1 call to Exporter::import
13 |  |  |  |  |
14 | 3 | 267µs | 2 | 286µs | # spent 271µs (256+15) within Tapper::Base::BEGIN@14 which was called: # once (256µs+15µs) by base::import at line 14 use common::sense; # spent 271µs making 1 call to Tapper::Base::BEGIN@14 # spent 15µs making 1 call to common::sense::import
15 |  |  |  |  |
16 | 6 | 451µs | 3 | 191µs | # spent 51µs (9+42) within Tapper::Base::BEGIN@16.2 which was called: # once (9µs+42µs) by Tapper::Base::BEGIN@16 at line 16 # spent 98µs (47+51) within Tapper::Base::BEGIN@16 which was called: # once (47µs+51µs) by base::import at line 16 use 5.010; # spent 98µs making 1 call to Tapper::Base::BEGIN@16 # spent 51µs making 1 call to Tapper::Base::BEGIN@16.2 # spent 42µs making 1 call to feature::import
17 |  |  |  |  |
18 | 1 | 4µs | 1 | 43.5ms | with 'MooseX::Log::Log4perl'; # spent 43.5ms making 1 call to Moose::with
19 |  |  |  |  |
20 |  |  |  |  |
21 |  |  |  |  | sub kill_instance
22 |  |  |  |  | {
23 |  |  |  |  | my ($self, $pid_file) = @_;
24 |  |  |  |  |
25 |  |  |  |  | # try to kill previous incarnations
26 |  |  |  |  | if ((-e $pid_file) and open(my $fh, "<", $pid_file)) {{
27 |  |  |  |  | my $pid = do {local $\; <$fh>}; # slurp
28 |  |  |  |  | ($pid) = $pid =~ m/(\d+)/;
29 |  |  |  |  | last unless $pid;
30 |  |  |  |  | kill 15, $pid;
31 |  |  |  |  | sleep(2);
32 |  |  |  |  | kill 9, $pid;
33 |  |  |  |  | close $fh;
34 |  |  |  |  | }}
35 |  |  |  |  | return 0;
36 |  |  |  |  |
37 |  |  |  |  | }
38 |  |  |  |  |
39 |  |  |  |  |
40 |  |  |  |  | sub run_one
41 |  |  |  |  | {
42 |  |  |  |  | my ($self, $conf) = @_;
43 |  |  |  |  |
44 |  |  |  |  | my $command = $conf->{command};
45 |  |  |  |  | my $pid_file = $conf->{pid_file};
46 |  |  |  |  | my @argv = @{$conf->{argv} // [] } ;
47 |  |  |  |  |
48 |  |  |  |  | $self->kill_instance($pid_file);
49 |  |  |  |  |
50 |  |  |  |  | return qq(Can not execute "$command" because it's not an executable) unless -x $command;
51 |  |  |  |  | my $pid = fork();
52 |  |  |  |  | return qq(Can not execute "$command". Fork failed: $!) unless defined $pid;
53 |  |  |  |  |
54 |  |  |  |  | if ($pid == 0) {
55 |  |  |  |  | exec $command, @argv;
56 |  |  |  |  | exit 0;
57 |  |  |  |  | }
58 |  |  |  |  |
59 |  |  |  |  | return 0 unless $pid_file;
60 |  |  |  |  | open(my $fh, ">", $pid_file) or return qq(Can not open "$pid_file" for pid $pid:$!);
61 |  |  |  |  | print $fh $pid;
62 |  |  |  |  | close $fh;
63 |  |  |  |  | return 0;
64 |  |  |  |  | }
65 |  |  |  |  |
- - |  |  |  |  |
69 |  |  |  |  | sub makedir
70 |  |  |  |  | {
71 |  |  |  |  | my ($self, $dir) = @_;
72 |  |  |  |  | return 0 if -d $dir;
73 |  |  |  |  | if (-e $dir and not -d $dir) {
74 |  |  |  |  | unlink $dir;
75 |  |  |  |  | }
76 |  |  |  |  | system("mkdir","-p",$dir) == 0 or return "Can't create $dir:$!";
77 |  |  |  |  | return 0;
78 |  |  |  |  | }
79 |  |  |  |  |
- - |  |  |  |  |
82 |  |  |  |  | sub log_and_exec
83 |  |  |  |  | {
84 |  |  |  |  | my ($self, @cmd) = @_;
85 |  |  |  |  | my $cmd = join " ",@cmd;
86 |  |  |  |  | $self->log->debug( $cmd );
87 |  |  |  |  | my $output=`$cmd 2>&1`;
88 |  |  |  |  | my $retval=$?;
89 |  |  |  |  | if (not defined($output)) {
90 |  |  |  |  | $output = "Executing $cmd failed";
91 |  |  |  |  | $retval = 1;
92 |  |  |  |  | }
93 |  |  |  |  | chomp $output if $output;
94 |  |  |  |  | if ($retval) {
95 |  |  |  |  | return ($retval >> 8, $output) if wantarray;
96 |  |  |  |  | return $output;
97 |  |  |  |  | }
98 |  |  |  |  | return (0, $output) if wantarray;
99 |  |  |  |  | return 0;
100 |  |  |  |  | }
101 |  |  |  |  |
102 | 1 | 9µs |  |  | 1; # End of Tapper::Base
103 |  |  |  |  |
104 |  |  |  |  | __END__