| | 872 | } |
| | 873 | |
| | 874 | { |
| | 875 | my ($memory_start); |
| | 876 | sub log_times { |
| | 877 | my $pkg = shift; |
| | 878 | |
| | 879 | my $timer = $pkg->get_timer; |
| | 880 | return unless $timer; |
| | 881 | |
| | 882 | my $memory; |
| | 883 | my $cmd = $pkg->config->ProcessMemoryCommand; |
| | 884 | if ($cmd) { |
| | 885 | my $re; |
| | 886 | if (ref($cmd) eq 'HASH') { |
| | 887 | $re = $cmd->{regex}; |
| | 888 | $cmd = $cmd->{command}; |
| | 889 | } |
| | 890 | $cmd =~ s/\$\$/$$/g; |
| | 891 | $memory = `$cmd`; |
| | 892 | if ($re) { |
| | 893 | if ($memory =~ m/$re/) { |
| | 894 | $memory = $1; |
| | 895 | $memory =~ s/\D//g; |
| | 896 | } |
| | 897 | } else { |
| | 898 | $memory =~ s/\s+//gs; |
| | 899 | } |
| | 900 | } |
| | 901 | |
| | 902 | # Called at the start of the process; so we're only recording |
| | 903 | # the memory usage at the start of the app right now. |
| | 904 | unless ($timer->{elapsed}) { |
| | 905 | $memory_start = $memory; |
| | 906 | return; |
| | 907 | } |
| | 908 | |
| | 909 | my $log_file; |
| | 910 | |
| | 911 | # Log filename calcluation; changes daily, so we don't cache this |
| | 912 | require File::Spec; |
| | 913 | my $dir = File::Spec->catdir( MT->instance->static_file_path, |
| | 914 | 'support', 'logs'); |
| | 915 | if (! -d $dir) { |
| | 916 | require File::Path; |
| | 917 | eval { File::Path::mkpath([$dir], 0, 0777) }; |
| | 918 | if ($@) { |
| | 919 | $log_file = 0; |
| | 920 | return; |
| | 921 | } |
| | 922 | } |
| | 923 | my @time = localtime(time); |
| | 924 | my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]); |
| | 925 | $log_file = File::Spec->catfile( $dir, $file ); |
| | 926 | |
| | 927 | my $first_write = ! -f $log_file; |
| | 928 | |
| | 929 | local *PERFLOG; |
| | 930 | open PERFLOG, ">>$log_file"; |
| | 931 | require Fcntl; |
| | 932 | flock(PERFLOG, Fcntl::LOCK_EX()); |
| | 933 | |
| | 934 | if ($first_write) { |
| | 935 | require Config; |
| | 936 | my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers}); |
| | 937 | print PERFLOG "# Operating System: $osname/$osvers\n"; |
| | 938 | print PERFLOG "# Platform: $^O\n"; |
| | 939 | my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] ); |
| | 940 | print PERFLOG "# Perl Version: $ver\n"; |
| | 941 | print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n"; |
| | 942 | require MT::Object; |
| | 943 | my $driver = MT::Object->driver; |
| | 944 | if ($driver) { |
| | 945 | my $dbh = $driver->r_handle; |
| | 946 | if ($dbh) { |
| | 947 | my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME |
| | 948 | my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER |
| | 949 | if ($dbname && $dbver) { |
| | 950 | print PERFLOG "# Database: $dbname/$dbver\n"; |
| | 951 | } |
| | 952 | } |
| | 953 | } |
| | 954 | my ($drname, $drh) = each %DBI::installed_drh; |
| | 955 | print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n"; |
| | 956 | if ($ENV{MOD_PERL}) { |
| | 957 | print PERFLOG "# App Mode: mod_perl\n"; |
| | 958 | } |
| | 959 | elsif ($ENV{FAST_CGI}) { |
| | 960 | print PERFLOG "# App Mode: FastCGI\n"; |
| | 961 | } |
| | 962 | else { |
| | 963 | print PERFLOG "# App Mode: CGI\n"; |
| | 964 | } |
| | 965 | } |
| | 966 | |
| | 967 | if ($memory) { |
| | 968 | print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory"); |
| | 969 | } else { |
| | 970 | print PERFLOG $timer->dump_line(); |
| | 971 | } |
| | 972 | |
| | 973 | close PERFLOG; |
| | 974 | } |
| | 975 | } |
| | 976 | |
| | 977 | sub get_timer { |
| | 978 | my $mt = shift; |
| | 979 | $mt = MT->instance unless ref $mt; |
| | 980 | my $timer = $mt->request('timer'); |
| | 981 | unless ($timer) { |
| | 982 | my $uri; |
| | 983 | if ($mt->isa('MT::App')) { |
| | 984 | $uri = $mt->uri( args => { $mt->param_hash } ); |
| | 985 | } |
| | 986 | require MT::Util::ReqTimer; |
| | 987 | $timer = MT::Util::ReqTimer->new( $uri ); |
| | 988 | $mt->request('timer', $timer); |
| | 989 | } |
| | 990 | return $timer; |
| | 991 | } |
| | 992 | |
| | 993 | sub time_this { |
| | 994 | my $mt = shift; |
| | 995 | my ($str, $code) = @_; |
| | 996 | my $timer = $mt->get_timer(); |
| | 997 | my $ret; |
| | 998 | if ($timer) { |
| | 999 | $timer->pause_partial(); |
| | 1000 | $ret = $code->(); |
| | 1001 | $timer->mark($str); |
| | 1002 | } else { |
| | 1003 | $ret = $code->(); |
| | 1004 | } |
| | 1005 | return $ret; |