OpenACS

gustafn
committed
oacs-5-9:gustafn:20160909081908
on 09 Sep 16
- reduce verbosity
/tcl/acs-developer-support-procs.tcl (+6 -4)
210 210                      because it is not mounted anywhere."
211 211          }
212 212
213 213          if { [nsv_exists ds_request $::ad_conn(request).db] } {
214 214              set total 0
215 215              set counter 0
216 216              foreach { handle command statement_name sql start end errno error } [nsv_get ds_request $::ad_conn(request).db] {
217 217                  set total [expr { $total + ($end - $start) }]
218 218                  if { [lindex $command 0] in { dml exec 1row 0or1row select } } {
219 219                      incr counter
220 220                  }
221 221              }
222 222              if { $counter > 0 } {
223 223                  append out "$counter database command[ad_decode $counter 1 " taking" "s totalling"] [format {%.f} $total] ms<br>"
224 224              }
225 225          }
226 226
227 227          if { [nsv_exists ds_request $::ad_conn(request).conn] } {
228 228              array set conn [nsv_get ds_request $::ad_conn(request).conn]
229 229              if { [info exists conn(startclicks)] } {
230                    append out "Page served in [format "%.f" [expr { ([clock clicks -milliseconds] - $conn(startclicks)) }]] ms<br>\n"
  230                  set time [format "%.f" [expr { ([clock clicks -microseconds] - $conn(startclicks))/1000.0 }]]
  231                  append out "Page served in $time ms<br>\n"
231 232              }
232 233          }
233 234
234 235          if { [parameter::get -package_id [ds_instance_id] -parameter ShowCommentsInlineP -default 0] } {
235 236              set href [export_vars -base ${ds_url}comments-toggle { { return_url [ad_return_url] } }]
236 237              append out [subst {
237 238                  Comments: <b>On</b> | <a href="[ns_quotehtml $href]">Off</a><br>
238 239              }]
239 240              if { [nsv_exists ds_request $::ad_conn(request).comment] } {
240 241                  foreach comment [nsv_get ds_request $::ad_conn(request).comment] {
241 242                      append out "<b>Comment:</b> $comment<br>\n"
242 243                  }
243 244              }
244 245          } else {
245 246              set href [export_vars -base ${ds_url}comments-toggle { { return_url [ad_return_url] } }]
246 247              append out [subst {
247 248                  Comments: <a href="[ns_quotehtml $href]">On</a> | <b>Off</b><br>
248 249              }]
249 250          }
250 251      }
 
259 260
260 261  ad_proc ds_show_p {} {
261 262      Should we show developer-support on the current connection.
262 263  } {
263 264      if { [ds_enabled_p] && [ds_permission_p] } {
264 265          return 1
265 266      }
266 267      return 0
267 268  }
268 269
269 270  ad_proc -public ds_get_page_serve_time_ms {} {
270 271      Returns the number of miliseconds passed since this request thread was started.
271 272
272 273      Returns the empty string if this information is not available.
273 274  } {
274 275      set result {}
275 276      if { [ds_enabled_p] && [ds_collection_enabled_p] } {
276 277          if { [nsv_exists ds_request $::ad_conn(request).conn] } {
277 278              array set conn [nsv_get ds_request $::ad_conn(request).conn]
278 279              if { [info exists conn(startclicks)] } {
279                    set result [format "%.f" [expr { ([clock clicks -milliseconds] - $conn(startclicks)) }]]
  280                  set result [format "%.f" [expr { ([clock clicks -microseconds] - $conn(startclicks))/1000.0 }]]
280 281              }
281 282          }
282 283      }
283 284      return $result
284 285  }
285 286
286 287  ad_proc -public ds_get_db_command_info {} {
287 288      Get a Tcl list with { num_commands total_ms } for the database commands for the request.
288 289
289 290      @return list containing num_commands and total_ms, or empty string if the information is not available.
290 291  } {
291 292      set result {}
292 293      if { [ds_enabled_p] && [ds_collection_enabled_p] } {
293 294          if { [nsv_exists ds_request $::ad_conn(request).db] } {
294 295              set total 0
295 296              set counter 0
296 297              foreach { handle command statement_name sql start end errno error } [nsv_get ds_request $::ad_conn(request).db] {
297 298                  set total [expr { $total + ($end - $start) }]
298 299                  if { [lindex $command 0] in { dml exec 1row 0or1row select } } {
299 300                      incr counter
300 301                  }
301 302              }
302 303              set result [list $counter $total]
303 304          }
304 305      }
305 306      return $result
306 307  }
307 308
308 309  ad_proc -private ds_collect_connection_info {} {
309 310      Collects information about the current connection.
310 311      Should be called only at the very beginning of the request processor handler.
311 312  } {
312 313      # JCD: check recursion_count to ensure adding headers only one time.
313 314      if { [ds_enabled_p] && [ds_collection_enabled_p] && ![ad_conn recursion_count]} {
314 315          ##This is expensive, but easy.  Otherwise we need to do it in every interpreter
315 316          ds_replace_get_user_procs [ds_user_switching_enabled_p]
316 317
317 318          ds_add start [ns_time]
318 319          ds_add conn startclicks [ad_conn start_clicks]
  320
319 321          for { set i 0 } { $i < [ns_set size [ad_conn headers]] } { incr i } {
320 322              ds_add headers [ns_set key [ad_conn headers] $i] [ns_set value [ad_conn headers] $i]
321 323          }
322 324          foreach param { method url query request peeraddr } {
323 325              ds_add conn $param [ad_conn $param]
324 326          }
325 327      }
326 328  }   
327 329
328 330  ad_proc -private ds_collect_db_call { db command statement_name sql start_time errno error } {
329 331      if { [ds_enabled_p] && [ds_collection_enabled_p] && [ds_database_enabled_p] } {
330 332          set bound_sql $sql
331 333
332 334          # It is very useful to be able to see the bind variable values displayed in the
333 335          # ds output. For postgresql we have a way of doing this with the proc db_bind_var_substitution
334 336          # but this proc does not work for Oracle
335 337
336 338          # JCD: don't bind if there was an error since this can potentially mess up the traceback
337 339          # making bugs much harder to track down
338 340          if { ($errno == 0 || $errno == 2) && [db_type] eq "postgresql" } {
 
649 651     time between the 'ds_profile start' and 'ds_profile stop' invocations inserted by the
650 652     template engine).
651 653
652 654     @param command Must be "start" or "stop".
653 655     @param tag In practice, the path to the template being profiled.
654 656    
655 657     <ul>
656 658       <li><b>start</b> marks the beginning of a block.
657 659       <li><b>stop</b> marks the end of a block. Start and stops must match.
658 660     </ul>
659 661    
660 662 } {
661 663     if {![ds_enabled_p]} {
662 664         error "DS not enabled"
663 665     }
664 666     switch $command {
665 667         start {
666 668             if { $tag eq "" } {
667 669                 error "Tag parameter is required"
668 670             }
669               set ::ds_profile__start_clock($tag) [clock clicks -milliseconds]
  671             set ::ds_profile__start_clock($tag) [clock clicks -microeconds]
670 672         }
671 673         stop {
672 674             if { [info exists ::ds_profile__start_clock($tag)]
673 675                  && $::ds_profile__start_clock($tag) ne "" } {
674 676                 ds_add prof $tag \
675                       [expr {[clock clicks -milliseconds] - $::ds_profile__start_clock($tag)}]
  677                     [expr {[clock clicks -microseconds] - $::ds_profile__start_clock($tag)}]
676 678                 unset ::ds_profile__start_clock($tag)
677 679             } else {
678 680                 ns_log Warning "ds_profile stop called without a corresponding call to ds_profile start, with tag $tag"
679 681             }
680 682         }
681 683         default {
682 684             error "Invalid command. Valid commands are 'start', 'stop', and 'log'."
683 685         }
684 686     }
685 687 }
686 688
687 689 ad_proc -public ds_init { } {
688 690
689 691     Perform setup for the developer support for a single request.  We
690 692     save the state in global variables to avoid highly redundant
691 693     computations (up to 50 times per page on openacs.org)
692 694
693 695 } {
694 696     #ns_log notice "ds_init called [::ds_enabled_p]"
695 697