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