| 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 | Tapper::Base::BEGIN@12 |
| 1 | 1 | 1 | 835µs | 1.54ms | Tapper::Base::BEGIN@11 |
| 1 | 1 | 1 | 256µs | 271µs | Tapper::Base::BEGIN@14 |
| 1 | 1 | 1 | 47µs | 98µs | Tapper::Base::BEGIN@16 |
| 1 | 1 | 1 | 10µs | 4.15ms | Tapper::Base::BEGIN@10 |
| 1 | 1 | 1 | 10µs | 10µs | Tapper::Base::BEGIN@2 |
| 1 | 1 | 1 | 9µs | 51µs | Tapper::Base::BEGIN@16.2 |
| 0 | 0 | 0 | 0s | 0s | Tapper::Base::kill_instance |
| 0 | 0 | 0 | 0s | 0s | Tapper::Base::log_and_exec |
| 0 | 0 | 0 | 0s | 0s | Tapper::Base::makedir |
| 0 | 0 | 0 | 0s | 0s | Tapper::Base::run_one |
| 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__ |