1##Library Header 2# 3# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $ 4# Copyright (c) 2005 Cisco Systems, Inc. 5# 6# Name: 7# ::logger::utils:: 8# 9# Purpose: 10# an extension to the tcllib logger module 11# 12# Author: 13# Aamer Akhter / aakhter@cisco.com 14# 15# Support Alias: 16# aakhter@cisco.com 17# 18# Usage: 19# package require logger::utils 20# 21# Description: 22# this extension adds template based appenders 23# 24# Requirements: 25# package require logger 26# 27# Variables: 28# namespace ::logger::utils:: 29# id: CVS ID: keyword extraction 30# version: current version of package 31# packageDir: directory where package is located 32# log: instance log 33# 34# Notes: 35# 1. 36# 37# Keywords: 38# 39# 40# Category: 41# 42# 43# End of Header 44 45package require Tcl 8.4 46package require logger 47package require logger::appender 48package require msgcat 49 50namespace eval ::logger::utils { 51 52 variable packageDir [file dirname [info script]] 53 variable log [logger::init logger::utils] 54 55 logger::import -force -namespace log logger::utils 56 57 # @mdgen OWNER: msgs/*.msg 58 ::msgcat::mcload [file join $packageDir msgs] 59} 60 61##Internal Procedure Header 62# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $ 63# Copyright (c) 2005 Cisco Systems, Inc. 64# 65# Name: 66# ::logger::utils::createFormatCmd 67# 68# Purpose: 69# 70# 71# Synopsis: 72# ::logger::utils::createFormatCmd <formatString> 73# 74# Arguments: 75# <formatString> 76# string composed of formatting chars (see description) 77# 78# 79# Return Values: 80# a runnable command 81# 82# Description: 83# createFormatCmd translates <formatString> into an expandable 84# command string. 85# 86# The following are the known substitutions (from log4perl): 87# %c category of the logging event 88# %C fully qualified name of logging event 89# %d current date in yyyy/MM/dd hh:mm:ss 90# %H hostname 91# %m message to be logged 92# %M method where logging event was issued 93# %p priority of logging event 94# %P pid of current process 95# 96# 97# Examples: 98# ::logger::new param1 99# ::logger::new param2 100# ::logger::new param3 <option1> 101# 102# 103# Sample Input: 104# (Optional) Sample of input to the proc provided by its argument values. 105# 106# Sample Output: 107# (Optional) For procs that output to files, provide 108# sample of format of output produced. 109# Notes: 110# 1. 111# 112# End of Procedure Header 113 114 115proc ::logger::utils::createFormatCmd {text args} { 116 variable log 117 array set opt $args 118 119 regsub -all -- \ 120 {%P} \ 121 $text \ 122 [pid] \ 123 text 124 125 regsub -all -- \ 126 {%H} \ 127 $text \ 128 [info hostname] \ 129 text 130 131 132 #the %d subst has to happen at the end 133 regsub -all -- \ 134 {%d} \ 135 $text \ 136 {[clock format [clock seconds] -format {%Y/%m/%d %H:%M:%S}]} \ 137 text 138 139 if {[info exists opt(-category)]} { 140 regsub -all -- \ 141 {%c} \ 142 $text \ 143 $opt(-category) \ 144 text 145 146 regsub -all -- \ 147 {%C} \ 148 $text \ 149 [lindex [split $opt(-category) :: ] 0] \ 150 text 151 } 152 153 if {[info exists opt(-priority)]} { 154 regsub -all -- \ 155 {%p} \ 156 $text \ 157 $opt(-priority) \ 158 text 159 } 160 161 return $text 162} 163 164 165 166##Procedure Header 167# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $ 168# Copyright (c) 2005 Cisco Systems, Inc. 169# 170# Name: 171# ::logger::utils::createLogProc 172# 173# Purpose: 174# 175# 176# Synopsis: 177# ::logger::utils::createLogProc -procName <procName> [options] 178# 179# Arguments: 180# -procName <procName> 181# name of proc to create 182# -conversionPattern <pattern> 183# see createFormatCmd for <pattern> 184# -category <category> 185# the category (service) 186# -priority <priority> 187# the priority (level) 188# -outputChannel <channel> 189# channel to output on (default stdout) 190# 191# 192# Return Values: 193# a runnable command 194# 195# Description: 196# createFormatCmd translates <formatString> into an expandable 197# command string. 198# 199# The following are the known substitutions (from log4perl): 200# %c category of the logging event 201# %C fully qualified name of logging event 202# %d current date in yyyy/MM/dd hh:mm:ss 203# %H hostname 204# %m message to be logged 205# %M method where logging event was issued 206# %p priority of logging event 207# %P pid of current process 208# 209# 210# Examples: 211# 212# 213# Sample Input: 214# (Optional) Sample of input to the proc provided by its argument values. 215# 216# Sample Output: 217# (Optional) For procs that output to files, provide 218# sample of format of output produced. 219# Notes: 220# 1. 221# 222# End of Procedure Header 223 224 225proc ::logger::utils::createLogProc {args} { 226 variable log 227 array set opt $args 228 229 set formatText "" 230 set methodText "" 231 if {[info exists opt(-conversionPattern)]} { 232 set text $opt(-conversionPattern) 233 234 regsub -all -- \ 235 {%P} \ 236 $text \ 237 [pid] \ 238 text 239 240 regsub -all -- \ 241 {%H} \ 242 $text \ 243 [info hostname] \ 244 text 245 246 if {[info exists opt(-category)]} { 247 regsub -all -- \ 248 {%c} \ 249 $text \ 250 $opt(-category) \ 251 text 252 253 regsub -all -- \ 254 {%C} \ 255 $text \ 256 [lindex [split $opt(-category) :: ] 0] \ 257 text 258 } 259 260 if {[info exists opt(-priority)]} { 261 regsub -all -- \ 262 {%p} \ 263 $text \ 264 $opt(-priority) \ 265 text 266 } 267 268 269 if {[regexp {%M} $text]} { 270 set methodText { 271 if {[info level] < 2} { 272 set method "global" 273 } else { 274 set method [lindex [info level -1] 0] 275 } 276 277 } 278 279 regsub -all -- \ 280 {%M} \ 281 $text \ 282 {$method} \ 283 text 284 } 285 286 regsub -all -- \ 287 {%m} \ 288 $text \ 289 {$text} \ 290 text 291 292 regsub -all -- \ 293 {%d} \ 294 $text \ 295 {[clock format [clock seconds] -format {%Y/%m/%d %H:%M:%S}]} \ 296 text 297 298 } 299 300 if {[info exists opt(-outputChannel)]} { 301 set outputChannel $opt(-outputChannel) 302 } else { 303 set outputChannel stdout 304 } 305 306 set formatText $text 307 set outputCommand puts 308 309 set procText { 310 proc $opt(-procName) {text} { 311 $methodText 312 $outputCommand $outputChannel \"$formatText\" 313 } 314 } 315 316 set procText [subst $procText] 317 return $procText 318} 319 320 321##Procedure Header 322# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $ 323# Copyright (c) 2005 Cisco Systems, Inc. 324# 325# Name: 326# ::logger::utils::applyAppender 327# 328# Purpose: 329# 330# 331# Synopsis: 332# ::logger::utils::applyAppender -appender <appenderType> [options] 333# 334# Arguments: 335# -service <logger service names> 336# -serviceCmd <logger serviceCmds> 337# name of logger instance to modify 338# -serviceCmd takes as input the return of logger::init 339# 340# -appender <appenderType> 341# type of appender to use 342# console|colorConsole... 343# 344# -conversionPattern <pattern> 345# see createLogProc for format 346# if not provided the default pattern 347# is used: 348# {\[%d\] \[%c\] \[%M\] \[%p\] %m} 349# 350# -levels <levels to apply to> 351# list of levels to apply this appender to 352# by default all levels are applied to 353# 354# Return Values: 355# 356# 357# Description: 358# applyAppender will create an appender for the specified 359# logger services. If not service is specified then the 360# appender will be added as the default appender for 361# the specified levels. If no levels are specified, then 362# all levels are assumed. 363# 364# The following are the known substitutions (from log4perl): 365# %c category of the logging event 366# %C fully qualified name of logging event 367# %d current date in yyyy/MM/dd hh:mm:ss 368# %H hostname 369# %m message to be logged 370# %M method where logging event was issued 371# %p priority of logging event 372# %P pid of current process 373# 374# 375# Examples: 376# % set log [logger::init testLog] 377# ::logger::tree::testLog 378# % logger::utils::applyAppender -appender console -serviceCmd $log 379# % ${log}::error "this is error" 380# [2005/08/22 10:14:13] [testLog] [global] [error] this is error 381# 382# 383# End of Procedure Header 384 385 386proc ::logger::utils::applyAppender {args} { 387 set usage {logger::utils::applyAppender 388 -appender appender 389 ?-instance? 390 ?-levels levels? 391 ?-appenderArgs appenderArgs? 392 } 393 set levels [logger::levels] 394 set appenderArgs {} 395 set bargs $args 396 while {[llength $args] > 1} { 397 set opt [lindex $args 0] 398 set args [lrange $args 1 end] 399 switch -exact -- $opt { 400 -appender { set appender [lindex $args 0] 401 set args [lrange $args 1 end] 402 } 403 -serviceCmd { set serviceCmd [lindex $args 0] 404 set args [lrange $args 1 end] 405 } 406 -service { set serviceCmd [logger::servicecmd [lindex $args 0]] 407 set args [lrange $args 1 end] 408 } 409 -levels { set levels [lindex $args 0] 410 set args [lrange $args 1 end] 411 } 412 -appenderArgs { 413 set appenderArgs [lindex $args 0] 414 set args [lrange $args 1 end] 415 } 416 default { 417 return -code error [msgcat::mc "Unknown argument: \"%s\" :\nUsage:\ 418 %s" $opt $usage] 419 } 420 } 421 } 422 423 set appender ::logger::appender::${appender} 424 if {[info commands $appender] == {}} { 425 return -code error [msgcat::mc "could not find appender '%s'" $appender] 426 } 427 428 #if service is not specified make all future services with this appender 429 # spec 430 if {![info exists serviceCmd]} { 431 set ::logger::utils::autoApplyAppenderArgs $bargs 432 #add trace 433 #check to see if trace is already set 434 if {[lsearch [trace info execution logger::init] \ 435 {leave ::logger::utils::autoApplyAppender} ] == -1} { 436 trace add execution ::logger::init leave ::logger::utils::autoApplyAppender 437 } 438 return 439 } 440 441 442 #foreach service specified, apply the appender for each of the levels 443 # specified 444 foreach srvCmd $serviceCmd { 445 446 foreach lvl $levels { 447 set procText [$appender -appenderArgs $appenderArgs \ 448 -level $lvl \ 449 -service [${srvCmd}::servicename] \ 450 -procNameVar procName 451 ] 452 eval $procText 453 ${srvCmd}::logproc $lvl $procName 454 } 455 } 456} 457 458 459##Internal Procedure Header 460# $Id: loggerUtils.tcl,v 1.6 2007/03/20 16:22:16 andreas_kupries Exp $ 461# Copyright (c) 2005 Cisco Systems, Inc. 462# 463# Name: 464# ::logger::utils::autoApplyAppender 465# 466# Purpose: 467# 468# 469# Synopsis: 470# ::logger::utils::autoApplyAppender <command> <command-string> <log> <op> <args> 471# 472# Arguments: 473# <command> 474# <command-string> 475# <log> 476# servicecmd generated by logger:init 477# <op> 478# <args> 479# 480# Return Values: 481# <log> 482# 483# Description: 484# autoApplyAppender is designed to be added via trace leave 485# to logger::init calls 486# 487# autoApplyAppender will look at preconfigred state (via applyAppender) 488# to autocreate appenders for newly created logger instances 489# 490# Examples: 491# logger::utils::applyAppender -appender console 492# set log [logger::init applyAppender-3] 493# ${log}::error "this is error" 494# 495# 496# Sample Input: 497# 498# Sample Output: 499# 500# Notes: 501# 1. 502# 503# End of Procedure Header 504 505 506proc ::logger::utils::autoApplyAppender {command command-string log op args} { 507 variable autoApplyAppenderArgs 508 set bAppArgs $autoApplyAppenderArgs 509 set levels [logger::levels] 510 set appenderArgs {} 511 while {[llength $bAppArgs] > 1} { 512 set opt [lindex $bAppArgs 0] 513 set bAppArgs [lrange $bAppArgs 1 end] 514 switch -exact -- $opt { 515 -appender { set appender [lindex $bAppArgs 0] 516 set bAppArgs [lrange $bAppArgs 1 end] 517 } 518 -levels { set levels [lindex $bAppArgs 0] 519 set bAppArgs [lrange $bAppArgs 1 end] 520 } 521 -appenderArgs { 522 set appenderArgs [lindex $bAppArgs 0] 523 set bAppArgs [lrange $bAppArgs 1 end] 524 } 525 default { 526 return -code error [msgcat::mc "Unknown argument: \"%s\" :\nUsage:\ 527 %s" $opt $usage] 528 } 529 } 530 } 531 if {![info exists appender]} { 532 return -code error [msgcat::mc "need to specify -appender"] 533 } 534 logger::utils::applyAppender -appender $appender -serviceCmd $log \ 535 -levels $levels -appenderArgs $appenderArgs 536 return $log 537} 538 539 540package provide logger::utils 1.3 541 542# ;;; Local Variables: *** 543# ;;; mode: tcl *** 544# ;;; End: *** 545