Skip to content

A
acs-developer-support
Commit 17c2bf24 authored by Frank Bergmann's avatar Frank Bergmann
Browse files
Options

- Upgrade to V4.0

parent e02c62a5
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 847 additions and 608 deletions
acs-developer-support.info
View file @ 17c2bf24
......@@ -2,35 +2,39 @@
<!-- Generated by the OpenACS Package Manager -->
<package key="acs-developer-support" url="http://openacs.org/repository/apm/packages/acs-developer-support/" type="apm_service">
<license>GPL V2.0 or any later version</license>
<package-name>Developer Support</package-name>
<pretty-plural>Developer Support</pretty-plural>
<initial-install-p>f</initial-install-p>
<singleton-p>t</singleton-p>
<auto-mount>ds</auto-mount>
<version name="5.0d5" url="http://openacs.org/repository/download/apm/acs-developer-support-5.0d5.apm">
<version name="5.6.0d1" url="http://openacs.org/repository/download/apm/acs-developer-support-5.6.0d1.apm">
<owner url="mailto:lars@pinds.com">Lars Pind</owner>
<summary>Profiling for requests including database timing information.</summary>
<release-date>2003-11-10</release-date>
<release-date>2005-02-04</release-date>
<vendor url="http://openacs.org">OpenACS</vendor>
<description format="text/html">Developer support stores timing and other logged information for requests
to support debugging and tuning and supports user switching and a Tcl Sell to invoke arbitrary tcl code on the server.
to support debugging and tuning and supports user switching and a Tcl Shell to invoke arbitrary tcl code on the server.
</description>
<maturity>0</maturity>
<provides url="acs-developer-support" version="5.0d5"/>
<requires url="acs-kernel" version="4.6.2"/>
<provides url="acs-developer-support" version="5.6.0d1"/>
<requires url="acs-kernel" version="5.6.0d1"/>
<requires url="acs-templating" version="5.6.0d1"/>
<callbacks>
</callbacks>
<parameters>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="DatabaseEnabledP" default="0" description="Remember information about every database request?" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="AdpRevealEnabledP" default="0" description="Should a frame be put around each ADP file in the page, with an identifying title and hyperlink to api-doc." section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="DataLifetime" default="900" description="Number of seconds to keep connection data" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="DataSweepInterval" default="900" description="Number of seconds between sweeping for old data" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="ProfileEnabledP" default="0" description="Remember timing informaton of included templates?" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="DatabaseEnabledP" default="0" description="Remember information about every database request?" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="EnabledIPs" default="*" description="remember information for which client hosts?" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="EnabledOnStartupP" default="1" description="Remember information about connections, for developers' benefit" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="EnabledOnStartupP" default="0" description="Remember information about connections, for developers' benefit?" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="PackageWatchList" description="A space separated list of keys for packages that you are developing on and that will have full watches (automatic reloading of tcl libraries and xql files) activated on every server startup.
" section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="PageFragmentCacheP" default="0" description="Should page fragments generated be cached for searching and validation. This is potentially very expensive and should be used with caution given it's performance implications." section_name="developer-support"/>
<parameter datatype="number" min_n_values="1" max_n_values="1" name="ShowCommentsInlineP" default="0" description="Controls whether comments are shown inline in the ds_link." section_name="developer-support"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="UserSwitchingEnabledP" default="0" description="Will present a widget on every page that allows you to switch user" section_name="developer-support"/>
</parameters>
......
lib/footer.adp
View file @ 17c2bf24
<if @show_p@ true>
<if @comments:rowcount@ gt 0>
<div class="developer-support-footer">
<div class="developer-support-footer">
<if @errcount@ gt 0>
<p style="color: red">errors: @errcount@ <a href="@ds_url@send?output=@request@:error">view</a></p>
</if>
<if @comments:rowcount@ gt 0>
<multiple name="comments">
<b>Comment:</b> <pre style="display: inline;">@comments.text@</pre><br />
<b>Comment:</b> <pre style="display: inline;">@comments.text@</pre><br>
</multiple>
</div>
</if>
<if @user_switching_p@ true>
<form action="@set_user_url@">
@export_vars;noquote@
<div class="developer-support-footer">
Real user: @real_user_name@ (@real_user_email@) [user_id #@real_user_id@]<br />
<hr>
</if>
<if @user_switching_p@ true>
<form action="@set_user_url@">
@export_vars;noquote@
Real user: @real_user_name@ (@real_user_email@) [user_id #@real_user_id@]<br>
<if @real_user_id@ ne @fake_user_id@>
Faked user: @fake_user_name@ <if @fake_user_email@ not nil>(@fake_user_email@)</if> [user_id #@fake_user_id@] <a href="@unfake_url@">(Unfake)</a><br />
Faked user: @fake_user_name@ <if @fake_user_email@ not nil>(@fake_user_email@)</if> [user_id #@fake_user_id@] <a href="@unfake_url@">(Unfake)</a><br>
</if>
<else>
Faked user: <i>Not faking.</i><br />
Faked user: <i>Not faking.</i><br>
</else>
Change faked user: <if @search_p@ eq "0"><select name="user_id">
<multiple name="users">
......@@ -23,28 +25,8 @@
</multiple>
</select></if><else><input type="text" name="keyword"><input type="hidden" name="target" value="@target@"></else>
<input type="submit" value="Go">
</div>
</form>
</if>
<if @profiling:rowcount@ gt 0>
<div class="developer-support-footer">
<h3>Profiling Information</h3>
<table>
<tr>
<th>Tag</th>
<th># Iterations</th>
<th>Total time </th>
<th>Avg. time per iteration</th>
</tr>
<multiple name="profiling">
<tr>
<td>@profiling.tag@</td>
<td align="right">@profiling.num_iterations@</td>
<td align="right">@profiling.total_ms@ ms</td>
<td align="right">@profiling.ms_per_iteration@ ms</td>
</tr>
</multiple>
</table>
</div>
</if>
</form>
<hr>
</if>
</div>
</if>
lib/footer.tcl
View file @ 17c2bf24
set show_p [ds_show_p]
# TODO: Go through request-processor to see what other information should be exposed to developer-support
# TODO: Always show comments inline by default?
set request [ad_conn request]
if { [ds_show_p] } {
if { $show_p } {
set show_p 0
if {[ns_cache get ds_page_bits "$request:error" errors]} {
set errcount [llength $errors]
set show_p 1
} else {
set errcount 0
}
set page_fragment_cache_p [ds_page_fragment_cache_enabled_p]
set ds_url [ds_support_url]
......@@ -16,19 +26,21 @@ if { $show_p } {
if { $comments_p } {
foreach comment [ds_get_comments] {
multirow append comments $comment
set show_p 1
}
}
set user_switching_p [ds_user_switching_enabled_p]
if { $user_switching_p } {
set show_p 1
set fake_user_id [ad_get_user_id]
set real_user_id [ds_get_real_user_id]
if { $fake_user_id == 0 } {
set selected " selected"
set you_are "<small>You are currently <strong>not logged in</strong></small><br />"
set you_are_really "<small>You are really <strong>not logged in</strong></small><br />"
set you_are "<small>You are currently <strong>not logged in</strong></small><br>"
set you_are_really "<small>You are really <strong>not logged in</strong></small><br>"
} else {
set selected {}
}
......@@ -84,18 +96,4 @@ if { $show_p } {
}
}
# Profiling information
global ds_profile__total_ms ds_profile__iterations
multirow create profiling tag num_iterations total_ms ms_per_iteration
if { [info exists ds_profile__total_ms] } {
foreach tag [lsort [array names ds_profile__total_ms]] {
multirow append profiling $tag [set ds_profile__iterations($tag)] [lc_numeric [set ds_profile__total_ms($tag)]] \
[ad_decode [set ds_profile__iterations($tag)] 0 {} \
[lc_numeric [expr [set ds_profile__total_ms($tag)]/[set ds_profile__iterations($tag)]]]]
}
}
}
lib/toolbar.adp
View file @ 17c2bf24
<if @show_p@ true>
<table cellspacing="0" cellpadding="0" width="100%" border="0" id="developer-toolbar">
<tr>
<table width="100%" id="developer-toolbar">
<tr align="center">
<td>
<a href="@ds_url@">Developer Support</a>
<a href="@ds_url@" title="@ip_address@">Developer&nbsp;Support</a>
</td>
<td class="action-list">
<td class="actions">
<ul>
<li><a href="@user_switching_toggle_url@" class="@user_switching_on@" title="User switching">USR</a></li>
<li><a href="@db_toggle_url@" class="@db_on@" title="Database statistics">DB</a></li>
<li><a href="@translator_toggle_url@" class="@translator_on@" title="Translator mode">TRN</a></li>
<multiple name="ds_buttons">
<li><a href="@ds_buttons.toggle_url@" class="@ds_buttons.state@" title="@ds_buttons.title@">@ds_buttons.label@</a></li>
</multiple>
</ul>
</td>
<td align="center" class="action-list">
<td align="center" class="actions">
<ul>
<li><a href="@request_info_url@" title="View request information">@request_info_label@</a>
<span style="color: #cccccc;">|</span></li>
<span>|</span></li>
<li><a href="@oacs_shell_url@" title="Execute commands and see the result">Shell</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/acs-admin/apm/" title="Modify/reload packages">APM</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/admin/site-map/" title="Manage your package instances">Site Map</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/acs-admin/apm/?reload_links_p=1" title="Scan for changed library files">Changed</a>
<span style="color: #cccccc;">|</span></li>
<span>|</span></li>
<li><a href="@base_url@/acs-admin/apm/" title="Modify/reload packages">APM</a>
<span>|</span></li>
<li><a href="@base_url@/admin/site-map/" title="Manage your package instances">Site&nbsp;Map</a>
<span>|</span></li>
<li><a href="@base_url@/acs-admin/apm/?reload_links_p=1" title="Scan for changed library files">Changed</a>
<span>|</span></li>
<li><a href="@flush_url@" title="Flush entire util_memoize cache">Flush</a>
<span style="color: #cccccc;">|</span></li>
<span>|</span></li>
<li><a href="@auto_test_url@" title="Automated Testing Home">Test</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/acs-admin/users/" title="Add/edit/become users">Users</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/acs-lang/admin/" title="Add/edit message keys">I18n</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/doc/" title="View system documentation">Docs</a>
<span style="color: #cccccc;">|</span></li>
<li><a href="/api-doc/" title="View/search OpenACS Tcl API documentation">API doc</a></li>
<span>|</span></li>
<li><a href="@base_url@/acs-admin/users/" title="Add/edit/become users">Users</a>
<span>|</span></li>
<li><a href="@base_url@/acs-lang/admin/" title="Add/edit message keys">I18n</a>
<span>|</span></li>
<li><a href="@base_url@/doc/" title="View system documentation">Docs</a>
<span>|</span></li>
<li><a href="@base_url@/api-doc/" title="View/search OpenACS Tcl API documentation">API&nbsp;doc</a>
<if @rm_url@ ne ""><span>|</span></li>
<li><a href="@rm_url@" title="View requests in the request monitor">Requests</a></li>
</if><else>
</li>
</else>
</ul>
</td>
<form action="/api-doc/proc-search">
<input type="hidden" name="search_type" value="All+matches">
<input type="hidden" name="name_weight" value="5">
<input type="hidden" name="param_weight" value="3">
<input type="hidden" name="doc_weight" value="2">
<td align="right" style="padding-right: 4px;" id="search">
<td align="right" id="developer-search">
<form action="@base_url@/api-doc/proc-search">
<input type="hidden" name="search_type" value="All+matches">
<input type="hidden" name="name_weight" value="5">
<input type="hidden" name="param_weight" value="3">
<input type="hidden" name="doc_weight" value="2">
<input name="query_string" onfocus="if(this.value=='Search API')this.value='';" onblur="if(this.value=='')this.value='Search API';" value="Search API">
<input type="submit" value="Go">
</td>
</form>
</form>
</td>
</tr>
</table>
</if>
lib/toolbar.tcl
View file @ 17c2bf24
# TODO: Handle the case when developer-support is not mounted
set ip_address [ns_config ns/server/[ns_info server]/module/nssock address]
set show_p [ds_show_p]
if { $show_p } {
set ds_url [ds_support_url]
set comments_p [ds_comments_p]
set comments_toggle_url [export_vars -base "${ds_url}comments-toggle" { { return_url [ad_return_url] } }]
set comments_on [ad_decode $comments_p 1 "on" "off"]
set base_url [ad_url]
set num_comments [llength [ds_get_comments]]
set user_switching_p [ds_user_switching_enabled_p]
set user_switching_toggle_url [export_vars -base "${ds_url}set-user-switching-enabled" { { enabled_p {[expr !$user_switching_p]} } { return_url [ad_return_url] } }]
set user_switching_on [ad_decode $user_switching_p 1 "on" "off"]
multirow create ds_buttons label title toggle_url state
# multirow append ds_buttons COM \
"Display comments inline" \
[export_vars -base "${ds_url}comments-toggle" { { return_url [ad_return_url] } }] \
[ad_decode [ds_comments_p] 1 "on" "off"]
multirow append ds_buttons USR \
"Toggle user switching" \
[export_vars -base "${ds_url}set" { {field user} {enabled_p {[expr ![ds_user_switching_enabled_p]]}} {return_url [ad_return_url]} }] \
[ad_decode [ds_user_switching_enabled_p] 1 "on" "off"]
multirow append ds_buttons DB \
"Toggle DB data collection" \
[export_vars -base "${ds_url}set" { {field db} {enabled_p {[expr ![ds_database_enabled_p]]}} {return_url [ad_return_url]} }] \
[ad_decode [ds_database_enabled_p] 1 "on" "off"]
multirow append ds_buttons PRO \
"Toggle template profiling" \
[export_vars -base "${ds_url}set" { {field prof} {enabled_p {[expr ![ds_profiling_enabled_p]]}} {return_url [ad_return_url]} }] \
[ad_decode [ds_profiling_enabled_p] 1 "on" "off"]
multirow append ds_buttons FRG \
"Toggle caching page fragments" \
[export_vars -base "${ds_url}set" { {field frag} {enabled_p {[expr ![ds_page_fragment_cache_enabled_p]]}} {return_url [ad_return_url]} }] \
[ad_decode [ds_page_fragment_cache_enabled_p] 1 "on" "off"]
multirow append ds_buttons TRN \
"Toggle translation mode" \
[export_vars -base "[ad_url]/acs-lang/admin/translator-mode-toggle" { { return_url [ad_return_url] } }] \
[ad_decode [lang::util::translator_mode_p] 1 "on" "off"]
multirow append ds_buttons ADP \
"Toggle ADP reveal" \
{javascript:void(d=document);void(el=d.getElementsByTagName('span'));for(i=0;i<el.length;i++){if(el[i].className=='developer-support-adp-file-on'){void(el[i].className='developer-support-adp-file-off')}else{if(el[i].className=='developer-support-adp-file-off'){void(el[i].className='developer-support-adp-file-on')}}};void(el=d.getElementsByTagName('div'));for(i=0;i<el.length;i++){if(el[i].className=='developer-support-adp-box-on'){void(el[i].className='developer-support-adp-box-off')}else{if(el[i].className=='developer-support-adp-box-off'){void(el[i].className='developer-support-adp-box-on')}};if(el[i].className=='developer-support-adp-output-on'){void(el[i].className='developer-support-adp-output-off')}else{if(el[i].className=='developer-support-adp-output-off'){void(el[i].className='developer-support-adp-output-on')}};}} \
[ad_decode [ds_adp_reveal_enabled_p] 1 "on" "off"]
set db_p [ds_database_enabled_p]
set db_toggle_url [export_vars -base "${ds_url}set-database-enabled" { { enabled_p {[expr !$db_p]} } { return_url [ad_return_url] } }]
set db_on [ad_decode $db_p 1 "on" "off"]
multirow append ds_buttons FOT \
"Toggle Footer display" \
{javascript:void(d=document);void(el=d.getElementsByTagName('div'));for(i=0;i<el.length;i++){if(el[i].className=='developer-support-footer'){void(el[i].className='developer-support-footer-off')}else{if(el[i].className=='developer-support-footer-off'){void(el[i].className='developer-support-footer')}}};} \
off
set translator_p [lang::util::translator_mode_p]
set translator_toggle_url [export_vars -base "/acs-lang/admin/translator-mode-toggle" { { return_url [ad_return_url] } }]
set translator_on [ad_decode $translator_p 1 "on" "off"]
set oacs_shell_url "${ds_url}shell"
......@@ -38,7 +67,7 @@ if { $show_p } {
set db_num_cmds [lindex $db_info 0]
set db_num_ms [lc_numeric [lindex $db_info 1]]
set flush_url [export_vars -base "/acs-admin/cache/flush-cache" { { suffix util_memoize } { return_url [ad_return_url] } }]
set flush_url [export_vars -base "[ad_url]/acs-admin/cache/flush-cache" { { suffix util_memoize } { return_url [ad_return_url] } }]
if { [empty_string_p $page_ms] } {
set request_info_label "Request info"
......@@ -51,3 +80,32 @@ if { $show_p } {
}
}
# Retrieve all CSS files loaded on this page
# Generate the <link > tag multirow
variable ::template::head::links
set css_list [list]
if {[array exists links]} {
foreach name [array names links] {
foreach {rel href type media title lang} $links($name) {
if {$type eq "text/css"} {
lappend css_list $href
}
}
}
}
if {$css_list ne ""} {
multirow append ds_buttons CSS \
"Show CSS" \
[export_vars -base "/ds/css-list" { css_list { return_url [ad_return_url] } }] \
off
}
set rm_package_id [apm_package_id_from_key xotcl-request-monitor]
if {$rm_package_id > 0} {
set rm_url "${base_url}[apm_package_url_from_id $rm_package_id]"
} else {
set rm_url ""
}
tcl/acs-developer-support-init.tcl
View file @ 17c2bf24
......@@ -7,27 +7,36 @@
# Make sure we do the setup only once
if { ![nsv_exists ds_properties enabled_p] } {
ad_register_filter -critical t -priority 999999 trace * /* ds_trace_filter
ad_schedule_proc [ad_parameter -package_id [ds_instance_id] DataSweepInterval acs-developer-support 900] ds_sweep_data
ad_schedule_proc [parameter::get -package_id [ds_instance_id] -parameter DataSweepInterval -default 900] ds_sweep_data
nsv_array set ds_request [list]
nsv_set ds_properties enabled_p [ad_parameter -package_id [ds_instance_id] EnabledOnStartupP acs-developer-support 0]
nsv_set ds_properties enabled_p [parameter::get -package_id [ds_instance_id] -parameter EnabledOnStartupP -default 0]
# Take the IP list (space or comma seperated) and turn it into a tcl list.
set IPs [list]
foreach ip [split [ad_parameter -package_id [ds_instance_id] EnabledIPs acs-developer-support *] { ,}] {
if {[string equal $ip "*"]} {
foreach ip [lsort -unique [split [parameter::get -package_id [ds_instance_id] -parameter EnabledIPs -default *] { ,}]] {
if {[string equal $ip "*"]} {
# a star means anything will match so just use the * instead
set IPs "*"
break
} elseif {![empty_string_p $ip]} {
} elseif {![empty_string_p $ip]} {
lappend IPs $ip
}
}
nsv_set ds_properties enabled_ips $IPs
nsv_set ds_properties profiling_enabled_p [parameter::get -package_id [ds_instance_id] -parameter ProfilingEnabledP -default 0]
nsv_set ds_properties database_enabled_p [ad_parameter -package_id [ds_instance_id] DatabaseEnabledP developer-support 0]
ds_set_user_switching_enabled [ad_parameter -package_id [ds_instance_id] UserSwitchingEnabledP acs-developer-support 0]
nsv_set ds_properties database_enabled_p [parameter::get -package_id [ds_instance_id] -parameter DatabaseEnabledP -default 0]
nsv_set ds_properties adp_reveal_enabled_p [parameter::get -package_id [ds_instance_id] -parameter AdpRevealEnabledP -default 0]
nsv_set ds_properties page_fragment_cache_p [parameter::get -package_id [ds_instance_id] -parameter PageFragmentCacheP -default 0]
ds_set_user_switching_enabled [parameter::get -package_id [ds_instance_id] -parameter UserSwitchingEnabledP -default 0]
# JCD: used to cache rendered page bits. cap at 10mb for now.
ns_cache create ds_page_bits -size 10000000
}
ds_watch_packages
tcl/acs-developer-support-procs-postgresql.xql
View file @ 17c2bf24
......@@ -43,6 +43,7 @@
from users u,
parties p
where u.user_id = p.party_id
order by name
</querytext>
</fullquery>
......
tcl/acs-developer-support-procs.tcl
View file @ 17c2bf24
This diff is collapsed.
tcl/acs-developer-support-procs.xql
View file @ 17c2bf24
......@@ -10,7 +10,7 @@
from users u,
parties p
where u.user_id = p.party_id
order by name
</querytext>
</fullquery>
......
www/index.tcl
View file @ 17c2bf24
# File: index.tcl
# Package: developer-support
# Author: jsalz@mit.edu
# Date: 22 June 2000
# Description: Index page for developer support.
#
# $Id$
ad_page_variables {
{ request_limit 25 }
ad_page_contract {
Index page for developer support.
@author jsalz@mit.edu
@creation-date 22 June 2000
@cvs-id $Id$
} {
{request_limit:integer 25}
}
ds_require_permission [ad_conn package_id] "admin"
......@@ -15,6 +13,8 @@ ds_require_permission [ad_conn package_id] "admin"
set enabled_p [nsv_get ds_properties enabled_p]
set user_switching_enabled_p [nsv_get ds_properties user_switching_enabled_p]
set database_enabled_p [nsv_get ds_properties database_enabled_p]
set profiling_enabled_p [nsv_get ds_properties profiling_enabled_p]
set adp_reveal_enabled_p [nsv_get ds_properties adp_reveal_enabled_p]
set package_id [ad_conn package_id]
......@@ -26,8 +26,8 @@ append body "
<li><a href=\"shell.tcl\">OpenACS Shell</a>
<li>Developer support toolbar is currently
[ad_decode $enabled_p 1 \
"on (<a href=\"set-enabled?enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set-enabled?enabled_p=1\">turn it on</a>)"]
"on (<a href=\"set?field=ds&amp;enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set?field=ds&amp;enabled_p=1\">turn it on</a>)"]
<li>Developer support information is currently
restricted to the following IP addresses:
......@@ -59,8 +59,8 @@ set requests [nsv_array names ds_request]
append body "
</ul>
<li>Information is being swept every [ad_parameter DataSweepInterval "developer-support" 900] sec
and has a lifetime of [ad_parameter DataLifetime "developer-support" 900] sec
<li>Information is being swept every [parameter::get -parameter DataSweepInterval -default 900] sec
and has a lifetime of [parameter::get -parameter DataLifetime -default 900] sec
<li><a href=\"/shared/parameters?[export_vars { package_id { return_url {[ad_return_url]} } }]\">Set package parameters</a>
......@@ -68,14 +68,26 @@ and has a lifetime of [ad_parameter DataLifetime "developer-support" 900] sec
<li>User-switching is currently
[ad_decode $user_switching_enabled_p 1 \
"on (<a href=\"set-user-switching-enabled?enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set-user-switching-enabled?enabled_p=1\">turn it on</a>)"]
"on (<a href=\"set?field=user&amp;enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set?field=user&amp;enabled_p=1\">turn it on</a>)"]
<li>Database statistics is currently
[ad_decode $database_enabled_p 1 \
"on (<a href=\"set-database-enabled?enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set-database-enabled?enabled_p=1\">turn it on</a>)"]
"on (<a href=\"set?field=db&amp;enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set?field=db&amp;enabled_p=1\">turn it on</a>)"]
<li>Template profiling is currently
[ad_decode $profiling_enabled_p 1 \
"on (<a href=\"set?field=prof&amp;enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set?field=prof&amp;enabled_p=1\">turn it on</a>)"]
<li>ADP reveal is currently
[ad_decode $adp_reveal_enabled_p 1 \
"on (<a href=\"set?field=adp&amp;enabled_p=0\">turn it off</a>)" \
"off (<a href=\"set?field=adp&amp;enabled_p=1\">turn it on</a>)"]
<p>
<li> Help on <a href=\"doc/editlocal\">edit and code links</a>.
</ul>
<h3>Available Request Information</h3>
......@@ -117,7 +129,7 @@ if { [llength $requests] == 0 } {
}
if { [info exists conn(startclicks)] && [info exists conn(endclicks)] } {
set duration "[expr { ($conn(endclicks) - $conn(startclicks)) / 1000 }] ms"
set duration "[expr { ($conn(endclicks) - $conn(startclicks))}] ms"
} else {
set duration ""
}
......@@ -154,13 +166,17 @@ if { [llength $requests] == 0 } {
} else {
set query ""
}
if {[ns_cache get ds_page_bits $id:error dummy]} {
set elink " <a href=\"send?output=$id:error\" style=\"color: red\">Errors</span></a>"
} else {
set elink {}
}
append body "
<tr bgcolor=[lindex $colors [expr { $counter % [llength $colors] }]]>
<td align=center>&nbsp;$start&nbsp;</td>
<td align=right>&nbsp;$duration&nbsp;</td>
<td>&nbsp;$peeraddr&nbsp;</td>
<td><a href=\"request-info?request=$id\">[ns_quotehtml "$method $url$query"]</a></td>
<td><a href=\"request-info?request=$id\">[ns_quotehtml "$method $url$query"]</a>$elink</td>
</tr>
"
incr counter
......
www/request-info.adp
View file @ 17c2bf24
......@@ -2,9 +2,32 @@
<property name="title">@page_title;noquote@</property>
<property name="context">@context;noquote@</property>
<if @page_fragment_cache_p@ true>
<p>
<form name="searchfrags" action="/ds/search">
<input type="hidden" name="request" value="@request@">
<input type="text" name="expression" value="">
<input type="submit" name="search" value="Search">
</form>
</p></if>
@body;noquote@
<if @dbreqs:rowcount@ gt 0>
<listfilters name="dbreqs" style="inline-filters"></listfilters>
<listtemplate name="dbreqs"></listtemplate>
</if>
<if @profiling:rowcount@ gt 0>
<h3>Profiling Information</h3>
<listtemplate name="profiling"></listtemplate>
<if @page_fragment_cache_p@ true>
<p>
<form name="searchfrags" action="search">
<input type="hidden" name="request" value="@request@">
<input type="text" name="expression" value="">
<input type="submit" name="search" value="Search">
</form>
</p></if>
</if>
www/request-info.tcl
View file @ 17c2bf24
......@@ -16,6 +16,8 @@ ds_require_permission [ad_conn package_id] "admin"
set page_title "Request Information"
set context [list $page_title]
set page_fragment_cache_p [ds_page_fragment_cache_enabled_p]
foreach name [nsv_array names ds_request] {
ns_log Debug "DS: Checking request $request, $name."
if { [regexp {^([0-9]+)\.([a-z]+)$} $name "" m_request key] && $m_request == $request } {
......@@ -32,7 +34,7 @@ if { [info exists property(start)] } {
<tr><th align=left>Request Start Time:&nbsp;</th><td>[clock format [lindex $property(start) 0] -format "%Y-%m-%d %H:%M:%S"]\n"
} else {
append body "The information for this request is gone - either the server has been restarted, or
the request is more than [ad_parameter DeveloperSupportLifetime "" 900] seconds old.
the request is more than [parameter::get -parameter DeveloperSupportLifetime -default 900] seconds old.
[ad_admin_footer]"
return
}
......@@ -60,7 +62,7 @@ if { [info exists property(conn)] } {
set value "<pre>[ns_quotehtml $conn($key)]</pre>"
}
endclicks {
set value "[format "%.f" [expr { ($conn(endclicks) - $conn(startclicks)) / 1000 }]] ms"
set value "[format "%.f" [expr { ($conn(endclicks) - $conn(startclicks)) }]] ms"
}
end {
set value [clock format $conn($key) -format "%Y-%m-%d %H:%M:%S" ]
......@@ -104,14 +106,14 @@ if { [info exists property(rp)] } {
set action [lindex $rp 4]
set error [lindex $rp 5]
set duration "[format "%.1f" [expr { ($endclicks - $startclicks) / 1000.0 }]] ms"
set duration "[format "%.1f" [expr { ($endclicks - $startclicks) }]] ms"
if { [string equal $kind debug] && !$rp_show_debug_p } {
continue
}
if { [info exists conn(startclicks)] } {
append body "<li>[format "%+.1f" [expr { ($startclicks - $conn(startclicks)) / 1000.0 }]] ms: "
append body "<li>[format "%+06.1f" [expr { ($startclicks - $conn(startclicks)) }]] ms: "
} else {
append body "<li>"
}
......@@ -248,7 +250,7 @@ if { ![info exists property(db)] } {
set sql $new_sql
}
append value "$command $handle<pre>[ns_quotehtml $sql]</pre>"
append value "$command $statement_pool $handle<pre>[ns_quotehtml $sql]</pre>"
}
if { ![string equal $command "getrow"] || [template::util::is_true $getrow_p] } {
......@@ -257,7 +259,8 @@ if { ![info exists property(db)] } {
}
# TODO: Sort by duration, so you can see slowest queries at top
multirow sort dbreqs -integer -decreasing duration_ms
template::list::create \
-name dbreqs \
-sub_class narrow \
......@@ -291,4 +294,56 @@ if { ![info exists property(db)] } {
}
}
# Profiling information
global ds_profile__total_ms ds_profile__iterations
template::list::create -name profiling -multirow profiling -elements {
file_links {
label "Ops"
display_template {
@profiling.file_links;noquote@
}
}
tag {
label "Template"
}
total_ms {
label "Total time"
}
size {
label "Size"
}
}
multirow create profiling tag total_ms file_links size
if { [info exists property(prof)] } {
foreach {tag time} $property(prof) {
if {[file exists $tag]} {
set file_links "<a href=\"send?fname=[ns_urlencode $tag]\" title=\"edit\">e</a>"
append file_links " <a href=\"send?code=[ns_urlencode $tag]\" title=\"compiled code\">c</a>"
} else {
set file_links {}
}
if { $page_fragment_cache_p } {
if { [string match *.adp $tag]} {
append file_links " <a href=\"send?output=$request:[ns_urlencode $tag]\" title=\"output\">o</a>"
if {[ns_cache get ds_page_bits "$request:$tag" dummy]} {
set size [string length $dummy]
} else {
set size {?}
}
} else {
append file_links " x"
set size -
}
} else {
set size {}
}
set total_ms [lc_numeric $time]
multirow append profiling $tag $total_ms $file_links $size
}
}
www/shell.adp
View file @ 17c2bf24
......@@ -4,4 +4,10 @@
<formtemplate id="shell"></formtemplate>
<h3>Result</h3>
<pre style="border: 1px solid black; padding: 4px">@result@</pre>
<comment>The spaces below are intentional since in mozilla and some others extremely long strings in pre
tags will not display properly</comment>
<pre style="border: 1px solid black; padding: 4px">
@out@
</pre>
www/shell.tcl
View file @ 17c2bf24
ad_page_contract {
@Author Nis Jorgensen
@Author Nis Jorgensen
} {
{script:optional,allhtml {}}
} -properties {
result
{script:optional,allhtml {}}
} -properties {
out
}
ds_require_permission [ad_conn package_id] "admin"
set page_title "OpenACS Shell"
set context $page_title
if { ![acs_user::site_wide_admin_p] } {
ad_return_warning "Error" "Sorry, only site-wide admins may use this."
ad_script_abort
}
set result ""
set page_title "OpenACS Shell"
set context [list $page_title]
set out {}
ad_form -name shell -form {
{
script:text(textarea),nospell
{label {Input tcl_script}}
{html {cols 80 rows 10}}
script:text(textarea),nospell
{label {Input tcl_script}}
{html {cols 80 rows 10}}
}
} -on_submit {
if {[catch {set result [uplevel 1 $script]}]} {
global errorInfo
set result "ERROR:\n$errorInfo"
} -on_submit {
if { ![string equal POST [ns_conn method]] } {
set out "You cannot use GET to invoke a script on this page.\nClick OK to resubmit the form as a POST."
} else {
if {[catch {set out [uplevel 1 [string map {"\\\r\n" " "} $script]]}]} {
global errorInfo
set out "ERROR:\n$errorInfo"
}
}
}
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment