Author: spadkins
Date: Wed Nov 25 11:28:41 2009
New Revision: 13610
Modified:
p5ee/trunk/App-Context/lib/App/Context.pm
p5ee/trunk/App-Context/lib/App/Context/HTTP.pm
Log:
added support for the profiler_log
Modified: p5ee/trunk/App-Context/lib/App/Context.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/Context.pm (original)
+++ p5ee/trunk/App-Context/lib/App/Context.pm Wed Nov 25 11:28:41 2009
@@ -12,6 +12,7 @@
use Carp qw(confess shortmess);
use Date::Format;
+use Time::HiRes;
use IO::Handle; # for the STDOUT->autoflush() method
use IO::Socket;
use IO::Socket::INET;
@@ -421,6 +422,13 @@
sub _init {
&App::sub_entry if ($App::trace);
my ($self, $options) = @_;
+
+ my $profiler = $options->{"app.Context.profiler"};
+ if ($profiler) {
+ $self->profile_start("main");
+ $self->start_profiler_log();
+ }
+
&App::sub_exit() if ($App::trace);
}
@@ -1725,120 +1733,6 @@
&App::sub_exit() if ($App::trace);
}
-sub profile_start {
- my ($self, $key) = @_;
- my $profile_state = $self->{profile_state};
- if (!$profile_state) {
- $profile_state = {
- last_timeofday => [ Time::HiRes::gettimeofday() ],
- key_stack => [],
- key_started => 1,
- };
- $self->{profile_state} = $profile_state;
- }
- my $profile_stats = $self->{profile_stats};
- if (!$profile_stats) {
- $profile_stats = {};
- $self->{profile_stats} = $profile_stats;
- }
- my $last_timeofday = $profile_state->{last_timeofday};
- my $key_stack = $profile_state->{key_stack};
- my $key_started = $profile_state->{key_started};
- my $last_key = ($#$key_stack > -1) ? $key_stack->[$#$key_stack] : "";
- my @timeofday = Time::HiRes::gettimeofday();
- if ($last_key) {
- my $time_elapsed = Time::HiRes::tv_interval($last_timeofday,
\...@timeofday);
- $self->_profile_accumulate($profile_stats, $last_key, $time_elapsed,
$key_started);
- }
- if ($#$key_stack > 100) {
- splice(@$key_stack, 0, 50);
- }
- push(@$key_stack, $key);
- $profile_state->{key_started} = 1;
- $profile_state->{last_timeofday} = \...@timeofday;
-}
-
-sub profile_stop {
- my ($self, $key) = @_;
- my $profile_state = $self->{profile_state};
- my $profile_stats = $self->{profile_stats};
- if ($profile_state && $profile_stats) {
- my $last_timeofday = $profile_state->{last_timeofday};
- my $key_stack = $profile_state->{key_stack};
- my $key_started = $profile_state->{key_started};
- my $last_key = ($#$key_stack > -1) ? $key_stack->[$#$key_stack]
: "";
- my @timeofday = Time::HiRes::gettimeofday();
- my $time_elapsed = Time::HiRes::tv_interval($last_timeofday,
\...@timeofday);
- $profile_state->{last_timeofday} = \...@timeofday;
- $self->_profile_accumulate($profile_stats, $last_key, $time_elapsed,
$key_started);
- while ($#$key_stack > -1) {
- my $last_key = pop(@$key_stack);
- last if ($last_key eq $key);
- }
- $profile_state->{key_started} = 0;
- }
-}
-
-sub _profile_accumulate {
- my ($self, $profile_stats, $key, $time_elapsed, $key_started) = @_;
- my $stats = $profile_stats->{$key};
- if (!defined $stats) {
- $stats = {
- count => 1,
- cumul_time => $time_elapsed,
- min_time => $time_elapsed,
- max_time => $time_elapsed,
- sample_time => $time_elapsed,
- };
- $profile_stats->{$key} = $stats;
- }
- else {
- $stats->{cumul_time} += $time_elapsed;
- if ($key_started) {
- $stats->{count}++;
- my $sample_time = $stats->{sample_time};
- if ($sample_time > 0) {
- $stats->{min_time} = $sample_time if ($sample_time <
$stats->{min_time});
- $stats->{max_time} = $sample_time if ($sample_time >
$stats->{max_time});
- }
- $stats->{sample_time} = $time_elapsed;
- }
- else {
- $stats->{sample_time} += $time_elapsed;
- }
- }
-}
-
-sub profile_stats {
- my ($self) = @_;
- return($self->{profile_stats} || {});
-}
-
-sub profile_clear {
- my ($self) = @_;
- delete $self->{profile_stats};
- delete $self->{profile_state};
-}
-
-sub profile_log {
- my ($self) = @_;
- my $profile_stats = $self->profile_stats();
- $self->log("PROFILE: cumultime count avgtime mintime maxtime
key\n");
- my ($stats);
- foreach my $key (sort { $profile_stats->{$b}{cumul_time} <=>
$profile_stats->{$a}{cumul_time} } keys %$profile_stats) {
- $stats = $profile_stats->{$key};
- if ($stats->{count}) {
- $self->log("PROFILE: %10.4f %10d %8.4f %8.4f %8.4f %s\n",
- $stats->{cumul_time},
- $stats->{count},
- $stats->{cumul_time}/$stats->{count},
- $stats->{min_time},
- $stats->{max_time},
- $key);
- }
- }
-}
-
#############################################################################
# user()
#############################################################################
@@ -2924,23 +2818,38 @@
my ($conf, $repdef, $repname, $instance);
my ($class, $method, $args, $argidx, $repcache);
- $self->dbgprint("Context->shutdown()")
- if ($App::DEBUG && $self->dbg(1));
+ if (!$self->{shutdown_complete}) {
+ my $options = $self->{options};
+ my $profiler = $options->{"app.Context.profiler"};
+ if ($profiler) {
+ $self->profile_stop("main");
+ $self->finish_profiler_log();
+ }
- $repcache = $self->{session}{cache}{Repository};
- if (defined $repcache && ref($repcache) eq "HASH") {
- foreach $repname (keys %$repcache) {
- $instance = $repcache->{$repname};
+ $self->dbgprint("Context->shutdown()")
+ if ($App::DEBUG && $self->dbg(1));
+
+ $repcache = $self->{session}{cache}{Repository};
+ if (defined $repcache && ref($repcache) eq "HASH") {
+ foreach $repname (keys %$repcache) {
+ $instance = $repcache->{$repname};
- $self->dbgprint("Context->shutdown(): $instance->_disconnect()")
- if ($App::DEBUG && $self->dbg(1));
+ $self->dbgprint("Context->shutdown():
$instance->_disconnect()")
+ if ($App::DEBUG && $self->dbg(1));
- $instance->_disconnect();
- delete $repcache->{$repname};
+ $instance->_disconnect();
+ delete $repcache->{$repname};
+ }
}
+ $self->{shutdown_complete} = 1;
}
}
+sub DESTROY {
+ my ($self) = @_;
+ $self->shutdown();
+}
+
#############################################################################
# response()
#############################################################################
@@ -2985,6 +2894,336 @@
return($response);
}
+#############################################################################
+# CONTROLLING THE profiler_log
+#############################################################################
+
+sub start_profiler_log {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @_;
+
+ my $options = $self->{options};
+ my $app = $options->{app} || "app";
+ my $context_abbr = ref($self);
+ $context_abbr =~ s/^App::Context:://;
+ my $host = $options->{host} || "localhost";
+ my $username = $self->user();
+ #my $events = $self->{events};
+ #my $events_str = $events ? (join("|", @$events)) : "";
+ my $profile_state = $self->{profile_state};
+ my $time = $profile_state->{last_timeofday}[0] || time();
+ my $start_dttm = time2str("%Y-%m-%d %H:%M:%S", $time);
+ my $info = $self->get_proc_info2();
+ my $pinfo = $info->{$$};
+ my $start_mem_mb = $pinfo->{vsize}/1048576;
+
+ my $repname = $options->{"app.Context.profiler_repository"};
+ my $rep = $repname ? $self->repository($repname) : undef;
+
+ if ($rep) {
+ eval {
+ $rep->insert("app_profiler_log",
+ ["context", "host", "username", "app", "start_dttm",
"start_mem_mb"],
+ [$context_abbr, $host, $username, $app, $start_dttm,
$start_mem_mb],
+ { last_inserted_id => 1 });
+ $profile_state->{profiler_log_id} = $rep->last_inserted_id();
+ };
+ }
+ else {
+ $self->log("Start : (Mem %.1f MB) %s [...@%s:%s]\n", $start_mem_mb,
$context_abbr, $username, $host, $app);
+ }
+
+ &App::sub_exit() if ($App::trace);
+}
+
+sub update_profiler_log {
+ &App::sub_entry if ($App::trace);
+ my ($self, $app_scope, $app_scope_id, $content_name) = @_;
+
+ my $options = $self->{options};
+ my $repname = $options->{"app.Context.profiler_repository"};
+ my $rep = $repname ? $self->repository($repname) : undef;
+
+ my $profile_state = $self->{profile_state};
+ my $profiler_log_id = $profile_state->{profiler_log_id};
+
+ if (defined $app_scope) {
+ $profile_state->{app_scope} = $app_scope;
+ }
+ elsif (defined $profile_state->{app_scope}) {
+ $app_scope = $profile_state->{app_scope};
+ }
+
+ if (defined $app_scope_id) {
+ $profile_state->{app_scope_id} = $app_scope_id;
+ }
+ elsif (defined $profile_state->{app_scope_id}) {
+ $app_scope_id = $profile_state->{app_scope_id};
+ }
+
+ if (defined $content_name) {
+ $profile_state->{content_name} = $content_name;
+ }
+ elsif (defined $profile_state->{content_name}) {
+ $content_name = $profile_state->{content_name};
+ }
+
+ if ($rep) {
+ if ($profiler_log_id) {
+ eval {
+ $rep->update("app_profiler_log", { "profiler_log_id.eq" =>
$profiler_log_id },
+ ["app_scope", "app_scope_id", "content_name"],
+ [$app_scope, $app_scope_id, $content_name]);
+ };
+ }
+ }
+ else {
+ $self->log("Update: %s (%s) [%s]\n", $app_scope, $app_scope_id,
$content_name);
+ }
+
+ &App::sub_exit() if ($App::trace);
+}
+
+sub finish_profiler_log {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @_;
+
+ my $profile_state = $self->{profile_state};
+ my $profile_stats = $self->profile_stats();
+ my $profiler_log_id = $profile_state->{profiler_log_id};
+ my $app_scope = $profile_state->{app_scope};
+ my $app_scope_id = $profile_state->{app_scope_id};
+ my $content_name = $profile_state->{content_name};
+ my $content_length = $profile_state->{content_length} || 0;
+
+ my $time = $profile_state->{last_timeofday}[0] || time();
+ my $end_dttm = time2str("%Y-%m-%d %H:%M:%S", $time);
+ my $run_main_time = $profile_stats->{main}{cumul_time} || 0; #
DONE
+ my $run_event_time = $profile_stats->{event}{cumul_time} || 0; #
DONE:HTTP, TBD:Context
+ my $run_file_time = $profile_stats->{file}{cumul_time} || 0; #
TBD (application)
+ my $run_db_time = $profile_stats->{db}{cumul_time} || 0; #
TBD
+ my $run_net_time = $profile_stats->{net}{cumul_time} || 0; #
TBD (application)
+
+ my $run_aux1_label = $profile_state->{aux1_label};
+ my $run_aux2_label = $profile_state->{aux2_label};
+ my ($run_aux1_time, $run_aux2_time);
+ $run_aux1_time = $run_aux1_label ?
($profile_stats->{$run_aux1_label}{cumul_time} || 0) : 0;
+ $run_aux2_time = $run_aux2_label ?
($profile_stats->{$run_aux2_label}{cumul_time} || 0) : 0;
+ my $run_xfer_time = $profile_stats->{xfer}{cumul_time} || 0; #
DONE
+ my $num_net_calls = $profile_stats->{net}{count} || 0; #
DONE
+ my $num_db_calls = $profile_stats->{db}{count} || 0; #
TBD
+ my $num_db_rows_read = $profile_stats->{db}{nrows_read} || 0; #
TBD
+ my $num_db_rows_write = $profile_stats->{db}{nrows_write} || 0; #
TBD
+ my $info = $self->get_proc_info2();
+ my $pinfo = $info->{$$};
+ my $end_mem_mb = $pinfo->{vsize}/1048576;
+ my $cpu_time = ($pinfo->{cutime} + $pinfo->{cstime}) || 0;
+ my $run_time = $self->profile_run_time();
+ my $run_other_time = $run_time - ($run_event_time + $run_main_time +
$run_db_time + $run_file_time + $run_net_time + $run_xfer_time + $run_aux1_time
+ $run_aux2_time);
+ $run_other_time = 0 if ($run_other_time < 0);
+
+ my $options = $self->{options};
+ my $repname = $options->{"app.Context.profiler_repository"};
+ my $rep = $repname ? $self->repository($repname) : undef;
+
+ if ($rep) {
+ if ($profiler_log_id) {
+ eval {
+ $rep->update("app_profiler_log", { "profiler_log_id.eq" =>
$profiler_log_id },
+ ["app_scope", "app_scope_id", "content_name",
+ "end_dttm", "end_mem_mb", "cpu_time",
+ "run_time", "run_main_time", "run_event_time",
+ "run_db_time", "run_file_time", "run_net_time",
+ "run_aux1_time", "run_aux2_time", "run_other_time",
+ "run_xfer_time", "content_length", "num_net_calls",
+ "num_db_calls", "num_db_rows_read", "num_db_rows_write"],
+ [$app_scope, $app_scope_id, $content_name,
+ $end_dttm, $end_mem_mb, $cpu_time,
+ $run_time, $run_main_time, $run_event_time,
+ $run_db_time, $run_file_time, $run_net_time,
+ $run_aux1_time, $run_aux2_time, $run_other_time,
+ $run_xfer_time, $content_length, $num_net_calls,
+ $num_db_calls, $num_db_rows_read, $num_db_rows_write]);
+ };
+ }
+ }
+ else {
+ my $aux_fmt = "";
+ my (@aux_values);
+ if ($run_aux1_label) {
+ $aux_fmt .= " $run_aux1_label=%.2f";
+ push(@aux_values, $run_aux1_time);
+ }
+ if ($run_aux2_label) {
+ $aux_fmt .= " $run_aux2_label=%.2f";
+ push(@aux_values, $run_aux2_time);
+ }
+ $self->log("Finish: (Mem %.1f MB) cpu=%.2f run=%.2f run[main=%.2f
event=%.2f db=%.2f/%d(r%d:w%d) file=%.2f net=%.2f/%d${aux_fmt} other=%.2f
xfer=%.2f] (Content %s bytes)\n",
+ $end_mem_mb, $cpu_time, $run_time, $run_main_time, $run_event_time,
+ $run_db_time, $num_db_calls, $num_db_rows_read,
$num_db_rows_write, $run_file_time, $run_net_time, $num_net_calls,
+ @aux_values, $run_other_time, $run_xfer_time, $content_length);
+ }
+
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
+# PROFILING
+# $context->profile_start($key, $replace);
+# $context->profile_stop($key);
+# $context->profile_run_time();
+# $context->profile_stats();
+# $context->profile_clear();
+# $context->profile_log();
+# $context->set_profile_state_value($state_var, $state_value);
+# $context->_profile_accumulate($profile_stats, $key, $time_elapsed,
$key_started);
+#############################################################################
+
+sub profile_start {
+ my ($self, $key, $replace) = @_;
+
+ my $timeofday = [ Time::HiRes::gettimeofday() ];
+
+ my $profile_state = $self->{profile_state};
+ if (!$profile_state) {
+ $profile_state = {
+ first_timeofday => $timeofday,
+ last_timeofday => $timeofday,
+ key_stack => [],
+ key_started => 1,
+ };
+ $self->{profile_state} = $profile_state;
+ }
+
+ my $profile_stats = $self->{profile_stats};
+ if (!$profile_stats) {
+ $profile_stats = { db => { nrows_read => 0, nrows_write => 0 }, };
+ $self->{profile_stats} = $profile_stats;
+ }
+
+ my $last_timeofday = $profile_state->{last_timeofday};
+ my $key_stack = $profile_state->{key_stack};
+ my $key_started = $profile_state->{key_started};
+ my $last_key = ($#$key_stack > -1) ? $key_stack->[$#$key_stack] : "";
+ if ($last_key) {
+ my $time_elapsed = Time::HiRes::tv_interval($last_timeofday,
$timeofday);
+ $self->_profile_accumulate($profile_stats, $last_key, $time_elapsed,
$key_started);
+ }
+ if ($#$key_stack > 100) {
+ splice(@$key_stack, 0, 50);
+ }
+ if (!$replace || $#$key_stack == -1) {
+ push(@$key_stack, $key);
+ }
+ else {
+ $key_stack->[$#$key_stack] = $key;
+ }
+ $profile_state->{key_started} = 1;
+ $profile_state->{last_timeofday} = $timeofday;
+}
+
+sub profile_stop {
+ my ($self, $key) = @_;
+ my $profile_state = $self->{profile_state};
+ my $profile_stats = $self->{profile_stats};
+ if ($profile_state && $profile_stats) {
+ my $last_timeofday = $profile_state->{last_timeofday};
+ my $key_stack = $profile_state->{key_stack};
+ my $key_started = $profile_state->{key_started};
+ my $last_key = ($#$key_stack > -1) ? $key_stack->[$#$key_stack]
: "";
+ my $timeofday = [ Time::HiRes::gettimeofday() ];
+ my $time_elapsed = Time::HiRes::tv_interval($last_timeofday,
$timeofday);
+ $profile_state->{last_timeofday} = $timeofday;
+ $self->_profile_accumulate($profile_stats, $last_key, $time_elapsed,
$key_started);
+ while ($#$key_stack > -1) {
+ my $last_key = pop(@$key_stack);
+ last if ($last_key eq $key);
+ }
+ $profile_state->{key_started} = 0;
+ }
+}
+
+sub _profile_accumulate {
+ my ($self, $profile_stats, $key, $time_elapsed, $key_started) = @_;
+ my $stats = $profile_stats->{$key};
+ if (!defined $stats) {
+ $stats = {
+ count => 1,
+ cumul_time => $time_elapsed,
+ min_time => $time_elapsed,
+ max_time => $time_elapsed,
+ sample_time => $time_elapsed,
+ };
+ $profile_stats->{$key} = $stats;
+ }
+ else {
+ $stats->{cumul_time} += $time_elapsed;
+ if ($key_started) {
+ $stats->{count}++;
+ my $sample_time = $stats->{sample_time};
+ if ($sample_time > 0) {
+ $stats->{min_time} = $sample_time if ($sample_time <
$stats->{min_time});
+ $stats->{max_time} = $sample_time if ($sample_time >
$stats->{max_time});
+ }
+ $stats->{sample_time} = $time_elapsed;
+ }
+ else {
+ $stats->{sample_time} += $time_elapsed;
+ }
+ }
+}
+
+sub profile_run_time {
+ my ($self) = @_;
+ my $profile_state = $self->{profile_state};
+ my $time_elapsed = 0;
+ if ($profile_state) {
+ my $first_timeofday = $profile_state->{first_timeofday};
+ my $last_timeofday = $profile_state->{last_timeofday};
+ $time_elapsed = Time::HiRes::tv_interval($first_timeofday,
$last_timeofday);
+ }
+ return($time_elapsed);
+}
+
+sub profile_stats {
+ my ($self) = @_;
+ return($self->{profile_stats} || {});
+}
+
+sub profile_clear {
+ my ($self) = @_;
+ delete $self->{profile_stats};
+ delete $self->{profile_state};
+}
+
+sub set_profile_state_value {
+ my ($self, $state_var, $state_value) = @_;
+ $self->{profile_state}{$state_var} = $state_value;
+}
+
+sub profile_log {
+ my ($self) = @_;
+ my $profile_stats = $self->profile_stats();
+ $self->log("PROFILE: cumultime count avgtime mintime maxtime
key\n");
+ my ($stats);
+ foreach my $key (sort { $profile_stats->{$b}{cumul_time} <=>
$profile_stats->{$a}{cumul_time} } keys %$profile_stats) {
+ $stats = $profile_stats->{$key};
+ if ($stats->{count}) {
+ $self->log("PROFILE: %10.4f %10d %8.4f %8.4f %8.4f %s\n",
+ $stats->{cumul_time},
+ $stats->{count},
+ $stats->{cumul_time}/$stats->{count},
+ $stats->{min_time},
+ $stats->{max_time},
+ $key);
+ }
+ }
+}
+
+#############################################################################
+# SYSTEM AND PROCESS INFORMATION
+#############################################################################
+
# /proc/meminfo
# total: used: free: shared: buffers: cached:
# Mem: 525942784 468914176 57028608 0 69124096 51593216
@@ -3095,5 +3334,70 @@
return($procs);
}
+# http://www.comptechdoc.org/os/linux/howlinuxworks/linux_hlproc.html
+#stat - Status information about the process used by the ps(1) command. Fields
are:
+# 31137 (bash) S 19885 31137 31137 34841 651
0 1450
+# 185030 316 14024 1 3 687 715 14
0 0
+# 0 1792102651 4403200 361 4294967295 134512640 135217536
3221217344 3221216648 1074425592
+# 0 65536 3686404 1266761467 3222400107 0 0 17
2
+# 1. pid - Process id
+# 2. comm - The executable filename
+# 3. state - R (running), S(sleeping interruptable), D(sleeping), Z(zombie),
or T(stopped on a signal).
+# 4. ppid - Parent process ID
+# 5. pgrp - Process group ID
+# 6. session - The process session ID.
+# 7. tty - The tty the process is using
+# 8. tpgid - The process group ID of the owning process of the tty the
current process is connected to.
+# 9. flags - Process flags, currently with bugs
+# 10. minflt - Minor faults the process has made
+# 11. cminflt - Minor faults the process and its children have made.
+# 12. majflt
+# 13. cmajflt
+# 14. utime - The number of jiffies (processor time) that this process has
been scheduled in user mode
+# 15. stime - in kernel mode
+# 16. cutime - This process and its children in user mode
+# 17. cstime - in kernel mode
+# 18. counter - The maximum time of this processes next time slice.
+# 19. priority - The priority of the nice(1) (process priority) value plus
fifteen.
+# 20. timeout - The time in jiffies of the process's next timeout.
+# 21. itrealvalue - The time in jiffies before the next SIGALRM is sent to
the process because of an internal timer.
+# 22. starttime - Time the process started after system boot
+# 23. vsize - Virtual memory size
+# 24. rlim - Current limit in bytes of the rss of the process.
+# 25. startcode - The address above which program text can run.
+# 26. endcode - The address below which program text can run.
+# 27. startstack - The address of the start of the stack
+# 28. kstkesp - The current value of esp for the process as found in the
kernel stack page.
+# 29. kstkeip - The current 32 bit instruction pointer, EIP.
+# 30. signal - The bitmap of pending signals
+# 31. blocked - The bitmap of blocked signals
+# 32. sigignore - The bitmap of ignored signals
+# 33. sigcatch - The bitmap of catched signals
+# 34. wchan - The channel in which the process is waiting. The "ps -l"
command gives somewhat of a list.
+
+sub get_proc_info2 {
+ my ($self, @pids) = @_;
+ @pids = ($$) if ($#pids == -1);
+ my ($pid, $proc);
+ my $procs = {};
+ foreach $pid (@pids) {
+ $proc = {};
+ $procs->{$pid} = $proc;
+ # print "FILE: /proc/$$/status\n";
+ if (open(App::Context::FILE, "/proc/$$/stat")) {
+ my $line = <App::Context::FILE>;
+ my @f = split(/ +/, $line);
+ close(App::Context::FILE);
+ $proc->{cutime} = $f[15];
+ $proc->{cstime} = $f[16];
+ $proc->{vsize} = $f[22];
+ }
+ else {
+ $self->log("ERROR: Can't open /proc/$$/stat: $!");
+ }
+ }
+ return($procs);
+}
+
1;
Modified: p5ee/trunk/App-Context/lib/App/Context/HTTP.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/Context/HTTP.pm (original)
+++ p5ee/trunk/App-Context/lib/App/Context/HTTP.pm Wed Nov 25 11:28:41 2009
@@ -88,10 +88,14 @@
&App::sub_entry if ($App::trace);
my ($self, $args) = @_;
$args = {} if (!defined $args);
+
eval {
$self->{user_agent} = App::UserAgent->new($self);
};
$self->add_message("Context::HTTP::_init(): $@") if ($@);
+
+ $self->SUPER::_init($args);
+
&App::sub_exit() if ($App::trace);
}
@@ -134,35 +138,44 @@
&App::sub_entry if ($App::trace);
my ($self) = @_;
- my $timer = $self->{options}{"app.Context.timer"};
- my $app = $self->{options}{app};
+ my ($content_length);
my $content_description = "Unknown";
- $self->start_timer() if ($timer);
$self->dispatch_events_begin();
+ my $events = $self->{events};
+
+ my $options = $self->{options};
+ my $app = $options->{app} || "app";
+ my $profiler = $options->{"app.Context.profiler"};
+ my ($app_scope, $app_scope_id, $content_name);
eval {
my $user = $self->user();
my $authorization = $self->authorization();
- my $events = $self->{events};
my ($event, $service_type, $service_name, $method, $args,
$return_results, $return_event_results, $event_results);
my $results = "";
# my $display_current_widget = 1;
- while ($#$events > -1) {
- $event = shift(@$events);
- ($service_type, $service_name, $method, $args,
$return_event_results) = @$event;
- if
($authorization->is_authorized("/App/$service_type/$service_name/$method",
$user)) {
- $event_results = $self->call($service_type, $service_name,
$method, $args);
- if ($return_event_results) {
- $results = $event_results;
- $return_results = 1;
- }
- if ($timer) {
- my $args_str = (ref($args) eq "ARRAY") ? join(",", @$args)
: $args;
-
$self->lap_timer("$service_type($service_name).$method($args_str)");
+ if ($#$events > -1) {
+ if ($profiler) {
+ $self->profile_start("event");
+ }
+ while ($#$events > -1) {
+ $event = shift(@$events);
+ ($service_type, $service_name, $method, $args,
$return_event_results) = @$event;
+ if
($authorization->is_authorized("/App/$service_type/$service_name/$method",
$user)) {
+ $event_results = $self->call($service_type, $service_name,
$method, $args);
+ if ($return_event_results) {
+ $results = $event_results;
+ $return_results = 1;
+ }
+ $user = $self->user();
}
- $user = $self->user();
+ }
+ if ($profiler) {
+ my $args_str = (ref($args) eq "ARRAY") ? join(",", @$args) :
$args;
+ $app_scope =
"$service_type($service_name).$method($args_str)";
+ $self->profile_stop("event");
}
}
$service_type = $self->so_get("default","ctype","SessionObject");
@@ -185,25 +198,44 @@
my $response = $self->response();
my $ref = ref($results);
if (!$ref || $ref eq "ARRAY" || $ref eq "HASH") {
+ $app_scope = "results [$ref]";
+ if ($profiler) {
+ $self->update_profiler_log($app_scope, $app_scope_id,
$service_name);
+ }
$response->content($results);
- $content_description = "results [$ref]";
}
elsif ($results->isa("App::Service")) {
+ ($app_scope, $app_scope_id) = $results->content_description();
+ if ($profiler) {
+ $self->update_profiler_log($app_scope, $app_scope_id,
$service_name);
+ }
$response->content($results->content());
$response->content_type($results->content_type());
- $content_description = $results->content_description();
}
else {
+ $app_scope = "$service_type($service_name).internals()";
+ if ($profiler) {
+ $self->update_profiler_log($app_scope, $app_scope_id,
$service_name);
+ }
$response->content($results->internals());
- $content_description = "$service_type($service_name).internals()";
}
- $self->send_response();
- $self->stop_timer($content_description) if ($timer);
+ if ($profiler) {
+ $self->profile_start("xfer", 1);
+ }
+ $content_length = $self->send_response();
+
+ if ($profiler) {
+ $self->{profile_state}{app_scope} = $app_scope;
+ $self->{profile_state}{content_length} = $content_length;
+ }
};
if ($@) {
- $self->send_error($@);
- $self->stop_timer("ERROR [$content_description]: $@") if ($timer); #
before we shut down database connections
+ $content_length = $self->send_error($@);
+ if ($profiler) {
+ $self->{profile_state}{app_scope} = "ERROR [$app_scope]: $@";
+ $self->{profile_state}{content_length} = $content_length;
+ }
}
if ($self->{options}{debug_context}) {
@@ -225,7 +257,7 @@
sub send_error {
&App::sub_entry if ($App::trace);
my ($self, $errmsg) = @_;
- print <<EOF;
+ my $str = <<EOF;
Content-type: text/plain
-----------------------------------------------------------------------------
@@ -238,7 +270,10 @@
-----------------------------------------------------------------------------
$self->{messages}
EOF
- &App::sub_exit() if ($App::trace);
+ my $content_length = length($str);
+ print $str;
+ &App::sub_exit($content_length) if ($App::trace);
+ return($content_length);
}
#############################################################################
@@ -321,7 +356,7 @@
&App::sub_entry if ($App::trace);
my $self = shift;
- my ($serializer, $response, $content, $content_type, $headers);
+ my ($serializer, $response, $content, $content_type, $content_length,
$headers);
$response = $self->response();
$content = $response->content();
@@ -353,6 +388,7 @@
$content = Compress::Zlib::memGzip($content);
}
}
+ $content_length = length($content);
if ($self->{messages}) {
my $msg = $self->{messages};
@@ -363,7 +399,8 @@
else {
print $headers, "\n", $content;
}
- &App::sub_exit() if ($App::trace);
+ &App::sub_exit($content_length) if ($App::trace);
+ return($content_length);
}
#############################################################################
@@ -532,83 +569,5 @@
&App::sub_exit() if ($App::trace);
}
-#04899 000.000000 000.000000 Start 2006/06/28 21:56:52.827139 GET
[222.252.72.65] localhost
-#04899 000.023569 000.023569 MarketVision[8] Controller code loaded
-#04899 000.394568 000.418137 MarketVision[666] code loaded, vars initialized
-#04899 000.025432 000.443569 MarketVision[671] CGI vars read [handaeww]
[handaeww]
-#04899 000.000243 000.443812 MarketVision[673] announcement checked
-#04899 000.011994 000.455806 MarketVision[676] db open
-#04899 000.328063 000.783869 MarketVision[689] Context+Repository open
-#04899 000.115011 000.898880 MarketVision[706] got orgs
-#04899 000.054074 000.952954 Controller.pm[262] screen transitions presel=3
sel=3 prescreen=main :
-#04899 000.000101 000.953055 Controller.pm[292] none executed []
-#04899 001.501768 002.454823 Controller.pm[300] screen shown [main]
-#04899 000.000084 002.454907 MarketVision[771] dispatched events
-#04899 000.000560 002.455467 MarketVision[787] db disconnected.
-#04899 000.000050 002.455517 End 2006/06/28 21:56:55.282656 usr0.8s sys0.1s
ops:0
-
-sub start_timer {
- &App::sub_entry if ($App::trace);
- my ($self) = @_;
-
- my $app = $self->{options}{app} || "app";
- open(App::Context::TIMELOG, ">> $app.log");
-
- #my $old_handle = select(App::Context::TIMELOG); # "select" TIMELOG and
save previously selected handle
- #$| = 1; # set to non-buffered
output (perform flush) after each write
- #select ($old_handle); # restore previously
selected handle
-
- my $time = [ gettimeofday ];
- $self->{time_start} = $time;
- $self->{time_lap} = $time;
-
- printf App::Context::TIMELOG "$$ %010.6f %010.6f Start : %s %s [...@%s]\n",
- 0, 0,
- time2str("%Y-%m-%d %H:%M:%S",$time->[0]),
- $ENV{REQUEST_METHOD},
- $ENV{REMOTE_USER},
- $ENV{REMOTE_ADDR};
-
- &App::sub_exit() if ($App::trace);
-}
-
-sub lap_timer {
- &App::sub_entry if ($App::trace);
- my ($self, $desc) = @_;
-
- my $time = [ gettimeofday ];
-
- printf App::Context::TIMELOG "$$ %010.6f %010.6f * $desc\n",
- tv_interval($self->{time_start}, $time),
- tv_interval($self->{time_lap}, $time);
-
- $self->{time_lap} = $time;
-
- &App::sub_exit() if ($App::trace);
-}
-
-sub stop_timer {
- &App::sub_entry if ($App::trace);
- my ($self, $desc) = @_;
-
- my $time = [ gettimeofday ];
-
- printf App::Context::TIMELOG "$$ %010.6f %010.6f End : $desc\n",
- tv_interval($self->{time_start}, $time),
- tv_interval($self->{time_lap}, $time);
-
- # time2str("%Y-%m-%d %H:%M:%S",$time->[0]),
- # $ENV{REQUEST_METHOD},
- # $ENV{REMOTE_USER},
- # $ENV{REMOTE_ADDR};
-
- delete $self->{time_start};
- delete $self->{time_lap};
-
- close(App::Context::TIMELOG);
-
- &App::sub_exit() if ($App::trace);
-}
-
1;
