source: tol/tolsh/tolsh.vfs/lib/tcllib1.10/log/loggerUtils.tcl @ 8597867d

1941-docker-image-to-testdevel
Last change on this file since 8597867d was 8597867d, checked in by Jorge Pérez <josp.jorge@…>, 16 years ago

closes #976, se incluye tcllib1.10, base64 debe eliminarse del raiz de lib ya que esta incluido en tcllib

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@2556 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 12.0 KB
Line 
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: ***
Note: See TracBrowser for help on using the repository browser.