レガシーASP用のLog4jっぽい奴を書いてみた

ASP VBScript

敢えて命名すると、

Log4aspですかね。安直ですが。

ソースコードを晒しておく

'ログ出力レベル設定
Private Const LEVEL_DEBUG = 0
Private Const LEVEL_INFO  = 1
Private Const LEVEL_WARN  = 2
Private Const LEVEL_ERROR = 3
Private Const LEVEL_FATAL = 4

'シングルトンのLoggerインスタンスを返す
Dim singleton_logger__
Function Logger_getLogger
  If IsEmpty(singleton_logger__) Then Set singleton_logger__ = New Logger
  Set Logger_getLogger = singleton_logger__
End Function

'シングルトンのLoggerインスタンスを利用してLogger_Tracerインスタンスを返す
Function Logger_getTracer(ByVal sourceName, ByVal className, ByVal funcName)
  Set Logger_getTracer = Logger_getLogger.getTracer(sourceName, className, funcName)
End Function

Class Logger
  'Logger_Appenderインスタンス
  Private appender_
  'ログ出力レベル
  Private level_
  'サブルーチンコールのネスト数
  Private nest_

  'コンストラクタ
  Private Sub Class_Initialize()
    'Appenderの初期化
    Set appender_ = New Logger_Appender
    'ログ出レベルの初期化
    level_ = LEVEL_DEBUG
    'サブルーチンコールのネスト数
    nest_ = 0
  End Sub

  'デストラクタ
  Private Sub Class_Terminate()
    Set appender_ = Nothing
  End Sub
  
  'ログ出力レベル設定
  Public Sub setLevel(ByVal level)
    level_ = level
  End Sub

  'トレースインスタンス取得
  Public Function getTracer(ByVal sourceName, ByVal className, ByVal funcName)
    Dim trace : Set trace = New Logger_Tracer
    trace.setLogger Me
    trace.setTrace sourceName, className, funcName
    Set getTracer = trace
  End Function

  Public Function isDebugEnabled()
    isDebugEnabled  = ( level_ >= LEVEL_DEBUG )
  End Function

  Public Function isInfoEnabled()
    isInfoEnabled   = ( level_ >= LEVEL_INFO  )
  End Function

  Public Function isWarnEnabled()
    isWarnEnabled   = ( level_ >= LEVEL_WARN  )
  End Function

  Public Function isErrorEnabled()
    isErrorEnabled  = ( level_ >= LEVEL_ERROR )
  End Function

  Public Function isFatalEnabled()
    isFatalEnabled  = ( level_ >= LEVEL_FATAL )
  End Function

  'DEBUGログ出力
  Public Sub debug(ByVal msg)
    If Not isDebugEnabled Then Exit Sub
    Add "[DEBUG]:" & vbTab & msg
  End Sub

  'INFOログ出力
  Public Sub info(ByVal msg)
    If Not isInfoEnabled  Then Exit Sub
    Add "[INFO]:" & vbTab & msg
  End Sub

  'WARNログ出力
  Public Sub warn(ByVal msg)
    If Not isWarnEnabled  Then Exit Sub
    Add "[WARN]:" & vbTab & msg
  End Sub

  'ERRORログ出力
  Public Sub error(ByVal msg)
    If Not isErrorEnabled Then Exit Sub
    Add "[ERROR]:" & vbTab & msg
  End Sub

  'FATALログ出力
  Public Sub fatal(ByVal msg)
    If Not isFatalEnabled Then Exit Sub
    Add "[FATAL]:" & vbTab & msg
  End Sub

  'ログ出力実処理
  Private Sub Add(ByVal msg)
    If appender_ Is Nothing Then Exit Sub
    appender_.Add msg
  End Sub

  'サブルーチン開始
  Public Sub nextContext
    nest_ = nest_ + 1
  End Sub

  'サブルーチン終了
  Public Sub prevContext
    nest_ = nest_ - 1
  End Sub
  
  'サブルーチンコールのネストレベル取得
  Public Function nestContexts
    nestContexts = nest_
  End Function

End Class

'ログ出力レベルの定数のクラス
Class Logger_Level
  Public Property Get DEBUG
    DEBUG = LEVEL_DEBUG
  End Property

  Public Property Get INFO
    INFO = LEVEL_INFO
  End Property

  Public Property Get WARN
    WARN = LEVEL_WARN
  End Property

  Public Property Get ERROR
    ERROR = LEVEL_ERROR
  End Property

  Public Property Get FATAL
    FATAL = LEVEL_FATAL
  End Property
End Class

Dim Level : Set Level = New Logger_Level

'ログ出力クラス
Class Logger_Appender
  'Scripting.FileSystemObject
  Private fso_
  'Scripting.FileSystemObject.TextStream
  Private file_
  
  'コンストラクタ
  Private Sub Class_Initialize()
    'ログファイルパスの組み立て
    Set fso_ = Server.CreateObject("Scripting.FileSystemObject")
    Dim root : root = Replace(Server.MapPath("/"), "wwwroot", "wwwdebug")
    Dim leaf : leaf = Replace(Replace(Request.ServerVariables("URL"), "/", "\"), ".asp", ".log")
    Const ForAppending = 8
    Dim path : path = root & leaf
    Set file_ = fso_.OpenTextFile(path, ForAppending, True)
    Add "[LOGGER]:" & vbTab & "Opened: " & path
  End Sub

  Private Sub Class_terminate()
    If Not IsObject(file_) Then
      file_.Close
      Set file_ = Nothing
    End If
    
    If Not IsObject(fso_) Then
      Set fso_ = Nothing
    End If
  End Sub

  Public Sub Add(ByVal msg)
    file_.WriteLine GetDate() & vbTab & msg
  End Sub

  Private Function GetDate()
    Dim dateTimer : dateTimer = Timer
    GetDate = CStr(Now) & "." & Right("000" & Fix((dateTimer - Fix(dateTimer)) * 1000), 3)
  End Function

End Class

'トレースログクラス
Class Logger_Tracer
  Private logger_
  Private source_
  Private class_
  Private function_
  Private nest_
  Private context_

  'コンストラクタ
  Private Sub Class_Initialize()
  End Sub

  'デストラクタ
  Private Sub Class_Terminate()
    logger_.debug fmt("#### " & function_ & " EXITED <<<<<<<<")
    logger_.prevContext
  End Sub

  'Loggerインスタンスの設定
  Public Sub setLogger(ByVal log)
    Set logger_ = log
    logger_.nextContext
    nest_ = String(logger_.nestContexts, ">") & " "
  End Sub

  'トレース出力情報の設定  
  Public Sub setTrace(ByVal sourceName, ByVal className, ByVal functionName)
    source_   = IIf(sourceName    = "", "{unknown}", sourceName)
    class_    = IIf(className     = "", "{global}",  className)
    function_ = IIf(functionName  = "", "{global}",  functionName)

    context_  = Left("[" & source_ & "]" & class_ & "." & function_ & String(63, " "), 63) & vbTab
    logger_.debug fmt("#### " & function_ & " ENTERED >>>>>>>>")
  End Sub

  'DEBUGログ出力
  Public Sub debug(ByVal msg)
    If Not logger_.isDebugEnabled Then Exit Sub
    logger_.debug fmt(msg)
  End Sub

  'INFOログ出力
  Public Sub info(ByVal msg)
    If Not logger_.isInfoEnabled  Then Exit Sub
    logger_.info fmt(msg)
  End Sub

  'WARNログ出力
  Public Sub warn(ByVal msg)
    If Not logger_.isWarnEnabled  Then Exit Sub
    logger_.warn fmt(msg)
  End Sub

  'ERRORログ出力
  Public Sub error(ByVal msg)
    If Not logger_.isErrorEnabled Then Exit Sub
    logger_.warn fmt(msg)
  End Sub

  'FATALログ出力
  Public Sub fatal(ByVal msg)
    If Not logger_.isFatalEnabled Then Exit Sub
  End Sub
  
  'ログ出力メッセージの編集
  Private Function fmt(ByVal msg)
    fmt = context_ & nest_ & msg
  End Function

  Private Function IIf(i,j,k)
    If i Then IIf = j Else IIf = k
  End Function

End Class

事前準備

ログファイルを出力するディレクトリを掘っておきます。この場所に*.aspの拡張子を*.logに変えたファイル名で同じレベルのディレクトリにログを吐きます。

Inetpub\wwwrootの隣にwwwdebugってディレクトリを掘って*1、IIS実行アカウント（IWAM-MACHINE-NAME, IUSR-MACHINE-NAME）にフルコントロールのアクセス権を与えてください*2。

なお、ディレクトリ構成が複数にネストしてても、この子は勝手にディレクトリ掘ったりしないので、予め掘っておいてください。

使い方

<!-- #include virtual="/log4asp.asp" -->
<%
Sub Main
  Dim trace : Set trace = Logger_getTracer("logger_test.asp", "", "Main")
  trace.debug "零番目だよー"
  SubTest1
End Sub

Sub SubTest1
  Dim trace : Set trace = Logger_getTracer("logger_test.asp", "", "SubTest1")
  trace.debug "壱番目だよー"
  SubTest2
End Sub

Sub SubTest2
  Dim trace : Set trace = Logger_getTracer("logger_test.asp", "", "SubTest2")
  trace.debug "弐番目だよー"
  SubTest3
End Sub

Sub SubTest3
  Dim trace : Set trace = Logger_getTracer("logger_test.asp", "", "SubTest3")
  trace.debug "参番目だよー"
End Sub

Main
%>

こんなログを吐く

2011/06/08 15:58:12.035	[LOGGER]:	Opened: C:\Inetpub\wwwdebug\logger_test.log
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.Main                                 	> #### Main ENTERED >>>>>>>>
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.Main                                 	> 零番目だよー
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest1                             	>> #### SubTest1 ENTERED >>>>>>>>
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest1                             	>> 壱番目だよー
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest2                             	>>> #### SubTest2 ENTERED >>>>>>>>
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest2                             	>>> 弐番目だよー
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest3                             	>>>> #### SubTest3 ENTERED >>>>>>>>
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest3                             	>>>> 参番目だよー
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest3                             	>>>> #### SubTest3 EXITED <<<<<<<<
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest2                             	>>> #### SubTest2 EXITED <<<<<<<<
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.SubTest1                             	>> #### SubTest1 EXITED <<<<<<<<
2011/06/08 15:58:12.035	[DEBUG]:	[logger_test.asp]{global}.Main                                 	> #### Main EXITED <<<<<<<<

で、ほしい機能があったら言ってください。可能ならば対応しますw

[改訂版] VBScriptポケットリファレンス (POCKET REFERENCE)

[改訂版] VBScriptポケットリファレンス (POCKET REFERENCE)

*1:ディフォルトの場合、C:\Inetpub\wwwdebugですね。

*2:NTFSの場合