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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.45ms | 3.56ms | BEGIN@12 | Tapper::Base::
1 | 1 | 1 | 835µs | 1.54ms | BEGIN@11 | Tapper::Base::
1 | 1 | 1 | 256µs | 271µs | BEGIN@14 | Tapper::Base::
1 | 1 | 1 | 47µs | 98µs | BEGIN@16 | Tapper::Base::
1 | 1 | 1 | 10µs | 4.15ms | BEGIN@10 | Tapper::Base::
1 | 1 | 1 | 10µs | 10µs | BEGIN@2 | Tapper::Base::
1 | 1 | 1 | 9µs | 51µs | BEGIN@16.2 | Tapper::Base::
0 | 0 | 0 | 0s | 0s | kill_instance | Tapper::Base::
0 | 0 | 0 | 0s | 0s | log_and_exec | Tapper::Base::
0 | 0 | 0 | 0s | 0s | makedir | Tapper::Base::
0 | 0 | 0 | 0s | 0s | run_one | Tapper::Base::
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 | ||||
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 # 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 # 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 # 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 # 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 | 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__ |