package Cpanel::Easy::Utils::PerlProf;

# cpanel10 - Cpanel/Easy/Utils/PerlProf.pm   Copyright(c) 2005-2007 cPanel, Inc.
#                                                           All rights Reserved.
# copyright@cpanel.net                                         http://cpanel.net
# This code is subject to the cpanel license. Unauthorized copying is prohibited

use strict;
use warnings;
no warnings qw(redefine);

sub perl_profile_init {
    my ($self) = @_;
    if ( $self->get_param('perl-devel-profiler') ) {
        $self->{'_'}{'perl-devel-profiler'} = 1;
    }
    else {
        $self->{'_'}{'perl-devel-profiler'} = 0;
    }
}

sub perl_profile_stat {
    my ( $self, $label, $pid ) = @_;

    if ( $self->{'_'}{'perl-devel-profiler'} ) {
        $pid = $$ if !defined $pid || $pid !~ m{ \A \d+ \z }xms;
        $label = join( ' ', ( caller(1) )[ 0 .. 3 ] ) if !$label;

        my $line = ( $self->{'pid_obj'}->_raw_ps( 'u', '-p', $pid ) )[1] or return;
        my @info = split( /\s+/, $line );
        $info[4] = $self->_pretty_bytes( $info[4] * 1024 );
        $info[5] = $self->_pretty_bytes( $info[5] * 1024 );
        $self->print_alert( q{ PID: '[_1]' CPU: '[_2]', MEM: '[_3]', VSZ: '[_4]', RSS: '[_5]' ([_6])}, @info[ 1 .. 5 ], $label );
    }
}

sub _pretty_bytes {
    my ( $self, $size ) = @_;
    foreach my $abbr (qw( b kb mb gb tb pb )) {
        return sprintf( '%.2f', $size ) . $abbr if $size < 1024;
        $size /= 1024;
    }
}

sub perl_profiler_reexec_check {
    my ($self) = @_;

    if ( $self->get_param('perl-devel-profiler') && !$INC{'Devel/FastProf.pm'} ) {
        return if $self->get_param('perl-devel-profiler') ne 'fprof';

        if ( eval 'require Devel::FastProf' ) {
            require Cpanel::FileUtils;
            require File::Spec;
            my $script_abs = File::Spec->rel2abs( Cpanel::FileUtils::cleanpath($0) );
            chdir $self->{'opt_mod_src_dir'} or die 'Could not chdir for profiling reexec';
            my $out = "$self->{'opt_mod_src_dir'}/fastprof.out";
            unlink $out;

            $ENV{'FASTPROF_CONFIG'} = "canfork,usecputime,filename=$out";
            my @re_cmd = ( '/usr/bin/perl', '-d:FastProf', '--', $script_abs, @ARGV );

            $self->debug( { 'message' => [ q{re-exec for perl profiling ([_1]), CWD is '[_2]'}, join( ' ', @re_cmd ), $self->cwd(), ], } );

            exec @re_cmd;
            exit;    # just in case
        }
        else {
            $self->print_alert( q{Expand '[_1]' by installing '[_2]'}, '--perl-devel-profiler', 'Devel::FastProf' );
        }
    }
}

sub perl_profiler_post_check {
    my ($self) = @_;

    if ( $INC{'Devel/FastProf.pm'} ) {
        $self->print_alert( qq{\nA dprof file suitable for examination by fprofpp is at: '[_1]'\nSee `perldoc fprofpp` for details.\n}, "$self->{'opt_mod_src_dir'}/fastprof.out", );
    }
}

1;

__END__

if ( $self->{'_'}{'perl-devel-profiler'} ) {
    # its on!
}

local $self->{'_'}{'perl-devel-profiler'} = 0; # turn it off in this spot