TensorflowとChainerのインストールの覚え書き

機械学習について興味があったので、とりあえずインストールしてサンプルを実行してみた。 インストール先は、Ubuntu 14.04 LTS (desktop版)。

事前準備

機械学習ではPythonが良く使われるらしく、pipを入れる。 あとPythonの実行環境を複数用意できるVirtualEnvを入れる。

sudo  apt-get install python-pip python-dev python-virtualenv

Tensorflow

Download and Setup ・・・本家サイト

手順

VirtualEnvで用意した環境(~/tensorflow)に入れてみる。

virtualenv --system-site-packages ~/tensorflow
source ~/tensorflow/bin/activate
# 「source .../activate」は、~/.bash_aliasesに定義しておくと便利か。
# deactivateで元の環境に戻れる。

インストール (cpu onlyの場合)

pip install --upgrade https://storage.googleapis.com/tensorflow/linux/cpu/tensorflow-0.7.1-cp27-none-linux_x86_64.whl

テスト

hello.pyを作成して実行する。

import tensorflow as tf
hello = tf.constant('Hello, TensorFlow!')
sess = tf.Session()
print sess.run(hello)
a = tf.constant(10)
b = tf.constant(32)
print sess.run(a + b)

MNIST

python -m tensorflow.models.image.mnist.convolutional

非力なPC*1のVirtualBox上でやってみたら、約１日半かかってしまった。

Chainer

Install Guide — Chainer 1.8.0 documentation ・・・ 本家サイト

手順

VirtualEnvで用意した環境(~/chainer)に入れてみる。

virtualenv --system-site-packages ~/chainer
source ~/chainer/bin/activate
# 「source .../activate」は、~/.bash_aliasesに定義しておくと便利か。
# deactivateで元の環境に戻れる。

インストール (cpu onlyの場合)

sudo apt-get install g++
# インストール済みだった。

pip install -U setuptools
# 最新だった

pip install chainer

MNIST

gitが必要なので、apt-getで入れる。

sudo apt-get install git

とりあえず、chainter_test というディレクトリに落とした。

mkdir chainer_test
cd chainer_test
git clone https://github.com/pfnet/chainer.git

実行してみる。

python chainer/examples/mnist/train_mnist.py

Tensorflowで懲りたので、もっと速いPC*2のVirtualBox上で実行したが、 結局のところ１日強かかってしまった。

コメント

機械学習はちゃんとPCを用意するか、AWSのGPUインスタンスを使うしかないか。

NVIDIA GTX750 Ti が１万ちょっとで入手可能のようだ。

参考サイト

ディープラーニングの有名ライブラリ5種を最短距離で試す半日コース（TensorFlow, Chainer, Caffe, DeepDream, 画風変換） - Over&Out その後

関連

CUDAとCaffeのインストール (Ubuntu 14.04 LTS) - umejanのブログ

*1:Celeron SU2300 1.2GB

*2:Core i5-2410M

Ubuntu 14.04 LTSインストールの覚え書き

VirtualBoxにUbuntu 14.04をインストールしてみた。

Ubuntu 14.04 LTS 日本語のインストール(desktop版)

サイト： https://www.ubuntulinux.jp/News/ubuntu1404-ja-remix

インストールメモ

• インストールの種類

  • Use LVM with the new Ubuntu installation にチェック。

• ターミナル起動方法

  • ALT+CTL+t

• その他

  • 初期設定ではパスワードが設定されてないとのこと。

vncサーバインストール

sudo apt-get install vnc4server

参考：http://server-setting.info/ubuntu/vnc-remote-desktop.html

• 利用ユーザにログイン(su)。

• vnc用のパスワード設定。

    vncpasswd
  

• 一度起動して、落とす。

    vncserver :1
    vncserver -kill :1
  

• ~/.vnc/xstartupの編集

最終行の「x-window-manager &」を 「gnome-session &」に変更。

→これだとエラーでデスクトップマネージャが起動しないみたい。

ちなみに、ubuntuのデフォルトのデスクトップマネージャは、unity(gnomeの一種？)というらしい。

http://askubuntu.com/questions/518041/unity-doesnt-work-on-vnc-server-under-14-04-lts

このサイトによると、追加のパッケージが必要とのことなので、 それをインストール。

sudo apt-get install gnome-panel gnome-settings-daemon metacity nautilus gnome-terminal

※gnome-terminalはインストール済みとのことなので不要のはず。

結局、xstartup を以下のように編集。

#!/bin/sh

# Uncomment the following two lines for normal desktop:
unset SESSION_MANAGER
#exec /etc/X11/xinit/xinitrc

unset DBUS_SESSION_BUS_ADDRESS
export GTK_IM_MODULE=ibus
export XMODIFIERS="@im=ibus"
export QT_IM_MODULE=ibus
/usr/bin/ibus-daemon -d -x

[ -x /etc/vnc/xstartup ] && exec /etc/vnc/xstartup
[ -r $HOME/.Xresources ] && xrdb $HOME/.Xresources
xsetroot -solid grey
vncconfig -iconic &

gnome-panel &
gnome-settings-daemon &
metacity &
nautilus &
gnome-terminal &

windowsのUltraVNC Viewerでつないでテストする。

一応、動いたがunityのデスクトップとは違う。gnomeデスクトップ？

/etc/rc.localに追加

su -l vncを利用するユーザ -c "vncserver :1 -geometry 1024x600 -depth 16"

VirtualBoxの仮想マシン起動時のエラー

起動時に以下のようなエラーが出てたので、それの対策。

SMBus base address uninitialized - upgrade BIOS or use force_addr=0xaddr

/etc/modprobe.d/modprobe.conf に、以下を追加。(sudo)

blacklist i2c_piix4

参考元：http://blog.portnumber53.com/2013/08/27/virtualbox-fixing-piix4_smbus-0000-00-07-0-smbus-base-address-uninitialized-upgrade-bios-or-use-force_addr0xaddr/

その他

• history にコマンド実行時刻を記録する。
  以下を .bashrc に追加。

    #HISTTIMEFORMAT='%Y-%m-%dT%T%z '
    HISTTIMEFORMAT='%Y-%m-%dT%T '
  

• aliasを追加する。
  .bash_aliases に追加。

コメント

ubuntuに限らず、linuxについていろいろ覚えないと。。。

その他参考サイト

http://www.server-world.info/query?os=Ubuntu_14.04&p=download

関連

Windows10のPCにUbuntu14.04 LTSを入れる（デュアルブート） - umejanのブログ

2016/04/14追記

管理者権限が必要なコマンドにsudoを付加した。

vbscriptでJSONをparse

json2.jsのjson_parse.jsを参考にJSONをvbcriptでparseする関数を作成してみた。

Class Json2Vbs
    Private at, ch, escapee, text
    
    Private Sub Error(m)
        Err.Raise vbObject + 1, "json2vbs", m
    End Sub
    
    Private Function nextCh(c)
        If c & "" <> "" Then
            If c <> ch Then
                Error "Expected '" & c & "' instead of '" & ch & "'"
            End If
        End If
        
        ch = Mid(text, 1 + at, 1)
        at = at + 1
        nextCh = ch
    End Function
    
    Private Function number()
        Dim num, str
        str = ""
        
        If ch = "-" Then
            str = "-"
            nextCh "-"
        End If
        Do While ch >= "0" And ch <= "9"
            str = str & ch
            nextCh ""
        Loop
        If ch = "." Then
            str = str & "."
            nextCh ""
            Do While ch >= "0" And ch <= "9"
                str = str & ch
                nextCh ""
            Loop
        End If
        
        num = str - 0
        number = num
    End Function
    
    Private Function stringVal()
        Dim hex, i, str, uffff
        str = ""
        
        If ch = """" Then
            Do While nextCh("") <> ""
                If ch = """" Then
                    nextCh ""
                    stringVal = str
                    Exit Function
                End If
                If ch = "\" Then
                    nextCh ""
                    If ch = "u" Then
                        uffff = 0
                        For i = 0 To 4 - 1
                            hex = parseChrHexNum(nextCh(""))
                            uffff = uffff * 16 + hex
                        Next
                        str = str & fromUnicode(uffff)
                    ElseIf escapee.Exists(ch) Then
                        str = str & escapee(ch)
                    Else
                        Exit Do
                    End If
                Else
                    str = str & ch
                End If
            Loop
        End If
        Error "Bad string"
    End Function
    
    Private Function parseChrHexNum(hexCh)
        If hexCh >= "0" And hexCh <= "9" Then
            parseChrHexNum = hexCh - 0
            Exit Function
        End If
        parseChrHexNum = Asc(UCase(hexCh)) - &H41 + 10
    End Function
    
    Private Function fromUnicode(uffff)
        fromUnicode = ChrW(uffff)
    End Function
    
    Private Sub White()
        Do While ch <> "" And ch <= " "
            nextCh ""
        Loop
    End Sub
    
    Private Function Word()
        Select Case ch
            Case "t"
                nextCh "t"
                nextCh "r"
                nextCh "u"
                nextCh "e"
                Word = True
                Exit Function
            Case "f"
                nextCh "f"
                nextCh "a"
                nextCh "l"
                nextCh "s"
                nextCh "e"
                Word = False
                Exit Function
        End Select
        Error "Unexpected '" & ch & "' at:" & at
    End Function
    
    Private Function WordNull()
        Select Case ch
            Case "n"
                nextCh "n"
                nextCh "u"
                nextCh "l"
                nextCh "l"
                Set WordNull = Nothing
                Exit Function
        End Select
        Error "Unexpected '" & ch & "' at:" & at
    End Function
    
    
    Private Function ArrayVal()
        Dim arrVal, idx, val, isObj
        Set arrVal = CreateCollection()
        idx = 0
        
        If ch = "[" Then
            nextCh "["
            White
            If ch = "]" Then
                nextCh "]"
                Set ArrayVal = arrVal
                Exit Function
            End If
            
            Do While ch <> ""
                isObj = getVal(val)
                If isObj Then
                    Set arrVal(idx) = val
                Else
                    arrVal(idx) = val
                End If
                idx = idx + 1
                White
                
                If ch = "]" Then
                    nextCh "]"
                    Set ArrayVal = arrVal
                    Exit Function
                End If
                nextCh ","
                White
            Loop
        End If
        Error "Bad Array"
    End Function
    
    Private Function getObject()
        Dim key, obj
        Dim isObj, val
        Set obj = CreateCollection()
        
        If ch = "{" Then
            nextCh "{"
            White
            If ch = "}" Then
                nextCh "}"
                Set getObject = obj
                Exit Function
            End If
        End If
        
        Do While ch <> ""
            key = stringVal()
            White
            nextCh ":"
            isObj = getVal(val)
            obj.Add key, val
            White
            If ch = "}" Then
                nextCh "}"
                Set getObject = obj
                Exit Function
            End If
            nextCh ","
            White
        Loop
        Error "Bad Object"
    End Function
    
    Private Function getVal(val)
        Dim isObj
        White
        Select Case ch
            Case "{"
                isObj = True
                Set val = getObject()
                getVal = isObj
                Exit Function
            Case "["
                isObj = True
                Set val = ArrayVal()
                getVal = isObj
                Exit Function
            Case """"
                isObj = False
                val = stringVal()
                getVal = isObj
                Exit Function
            Case "-"
                isObj = False
                val = number()
                getVal = isObj
                Exit Function
            Case Else
                If ch >= "0" And ch <= "9" Then
                    isObj = False
                    val = number()
                ElseIf ch = "n" Then
                    isObj = True
                    Set val = WordNull()
                Else
                    isObj = False
                    val = Word()
                End If
                getVal = isObj
                Exit Function
        End Select
    End Function
    
    Private Sub ParseInit()
        at = 0
        ch = ""
        Set escapee = CreateCollection()
        escapee("""") = """"
        escapee("\") = "\"
        escapee("/") = "/"
        escapee("b") = Chr(&H8) ' backspace
        escapee("f") = Chr(&HC) ' form feed
        escapee("n") = Chr(&HA) ' line feed
        escapee("r") = Chr(&HD) ' carriage return
        escapee("t") = Chr(&H9) ' tab
        text = ""
        
    End Sub
    
    Public Function Parse(str)
        ParseInit
        
        text = str
        at = 0
        ch = " "
        
        Dim isObj, val
        isObj = getVal(val)
        If Not isObj Then
            Error "not object or array"
        End If
        White
        
        If ch <> "" Then
            Error "Syntax Error"
        End If
        
        Set Parse = val
    End Function
    
    Function CreateCollection()
        Set CreateCollection = WScript.CreateObject("Scripting.Dictionary")
    End Function
End Class

Class Vbs2Json
    Public Function ToJsonString(obj, options)
        Dim s, s1
        Dim ary()
        Dim vKey
        Dim col
        Dim vVarType
        Dim isArray
        Dim iMaxIdx
        Dim i
        Dim vKeys
        Dim sCr
        Dim formatting
        
        formatting = True
        
        If formatting Then
            sCr = Chr(13) & Chr(10)
        Else
            sCr = ""
        End If
        
        Set col = obj

        isArray = False
        If col.Count = 0 Then
            ToJsonString = "[]"
            Exit Function
        Else
            vKeys = col.Keys
            vVarType = VarType(vKeys(0))
            If vVarType = 2 Then        ' Integer
                isArray = True
            ElseIf vVarType = 3 Then    ' Long
                isArray = True
            End If
        End If
        
        If isArray Then
            iMaxIdx = -1
            For Each vKey In col
                If iMaxIdx < vKey Then
                    iMaxIdx = vKey
                End If
            Next
            Redim ary(iMaxIdx)
            
            For Each vKey In col
                If VarType(col(vKey)) = 9 Then    'Object
                    Set ary(vKey) = col(vKey)
                Else
                    ary(vKey) = col(vKey)
                End If
            Next
            
            s1 = ""
            For i = 0 To iMaxIdx
                If VarType(ary(i)) <> 9 Then 'vbObject
                    s1 = s1 & "," & FormatJsonValue(ary(i)) & ""
                Else
                    s1 = s1 & "," & sCr & ToJsonString(ary(i), options) & ""
                End If
            Next
            s = "[" & Mid(s1, 2) & "]" & sCr
        Else
            s1 = ""
            For Each vKey in col
                If VarType(col(vKey)) <> 9 Then 'vbObject
                    s1 = s1 & ",""" & vKey & """:" & FormatJsonValue(col(vKey)) & ""
                Else
                    s1 = s1 & "," & sCr & """" & vKey & """:" & sCr & ToJsonString(col(vKey), options) & ""
                End If
            Next
            s = "{" & Mid(s1, 2) & "}" & sCr
        End If

        ToJsonString  = s
    End Function
    
    Function FormatJsonValue(v)
        Dim s
        Select Case VarType(v)
            Case 2, 3, 4, 5 'vbInteger, vbLong, vbSingle, vbDouble
                s = v & ""
            Case 11 'Boolean
                If v Then
                    s = "true"
                Else
                    s = "false"
                End If
            Case Else
                s = """" & EscapeJsonValue(v) & """"
        End Select
        FormatJsonValue = s
    End Function
    
    Function EscapeJsonValue(v)
        Dim s
        If v & "" = "" Then
            s = ""
        Else
            s = Replace(v, "\"     , "\\")
            s = Replace(s, vbCrLf  , "\n")
            s = Replace(s, vbCr    , "\n")
            s = Replace(s, vbLf    , "\n")
            s = Replace(s, """"    , "\""")
            s = Replace(s, "/"     , "\/")
            s = Replace(s, Chr(&H8), "\b")
            s = Replace(s, Chr(&HC), "\f")
            s = Replace(s, Chr(&H9), "\t")
            s = Replace(s, Chr(&HB), "\u000b")
            
            s = Replace(s, "'"     , "\u0027")
            
            s = Replace(s, "&"     , "\u0026")
            s = Replace(s, "<"     , "\u003c")
            s = Replace(s, ">"     , "\u003e")
        End If
        EscapeJsonValue = s
    End Function
    
End Class

とりあえず作成してみたが、正しく動作するか検証が必要。

2016/01/19追記

いろいろとバグがあったので修正。 とりあえず、unicode、escape文字は正しく処理されるようになった。

vbscriptの単体テスト(unit test)

ScriptUnitを使うつもりだったが、WScriptオブジェクトが使えないのと単独のvbsファイル向けだったため、ほかにないか探してみた。

VBSでUnitTest - @yamagh

ここで紹介されていたvbslibが欲しい機能を備えていた。

vbslib - VBScript Portable Library and Utility - Google Project Hosting

vbslibの使い方

TestRunner.wsfにテストするvbsファイルを渡す。

vbsファイルをコマンドラインで指定する場合

cscript TestRunner.wsf test_foo.vbs test_bar.vbs

vbsファイルを標準入力で指定する場合

dir /b test_*.vbs | cscript TestRunner.wsf /stdin+

2つ目のやり方が使いやすく、vbslibのtestフォルダのrun.batがあるのでこれを修正して使うのがいいようだ。

run.bat

@echo off
setlocal
set testrunner=C:\Tools\vbslib-20090627\bin\TestRunner.wsf
set cscript=C:\Windows\SysWow64\cscript.exe
rem dir /b test_*.vbs | cscript %testrunner% //Job:ConsoleTestRunner /stdin+ %*
dir /b test_*.vbs | %cscript% %testrunner% //Job:ConsoleTestRunner /stdin+ %*
endlocal

補足

vbslibはScriptControlを使っているので、32bitで実行させる。
64bit版環境であれば（Windows7など）、C:\Windows\System32\cscript.exeでなく、C:\Windows\SysWow64\cscript.exeを使う。

sample01.vbs (テスト対象のスクリプト)

Function Foo1(para1)
    Foo1 = "Foo1 called. para1:" & para1
End Function

test_01.vbs (テストスクリプト)

' @import sample01.vbs

Sub SetUp()
'    WScript.Echo ""
'    WScript.Echo "SetUp() called."
End Sub
Sub TearDown()
'    WScript.Echo ""
'    WScript.Echo "TearDown() called."
End Sub

Sub TestEqual()
    AssertEqual "1", "1"
    AssertEqualWithMessage "2", "2", "メッセージ"
End Sub

Sub TestEqual2()
    AssertEqual "Foo1 called. para1:あ", Foo1("あ")
End Sub

Sub TestAssert()
    Assert 1 = 1
End Sub
Sub TestAssertNG()
    AssertWithMessage 1 = 2, "1 <> 2"
End Sub

Sub TestAssertSame()
    Dim o
    Set o = CreateObject("Scripting.Dictionary")
    AssertSame o, o
End Sub
Sub TestAssertSameNG()
    Dim o
    Set o = CreateObject("Scripting.Dictionary")
    AssertSameWithMessage o, CreateObject("Scripting.Dictionary"), "expect fail"
End Sub

Sub TestMatch()
    AssertMatch "^Foo1.*あ$", Foo1("あ")
End Sub
Sub TestMatchNG()
    AssertMatchWithMessage "^Foo1.*あ$", Foo1("あ1"), "AssertMatch test."
End Sub

Sub TestAssertFail()
    AssertFail
End Sub
Sub TestAssertFail2()
    AssertFailWithMessage "AssertFail test."
End Sub

Sub TestNG1()
    AssertEqual "1", "11"
End Sub
Sub TestNG2()
    AssertEqualWithMessage "1", "11", "NG test."
End Sub

@アノテーションを使い、テストしたいスクリプトファイルを読み込む。

NGがあれば、cscript TestRunner.wsfの戻り値として1が返る。 すべてOKであれば、0が返る。

これで、wsf用に作ったvbsの関数をテストできる。

作者の方に感謝します！

関連

クラシックASPのコーディング考慮点 その４ - umejanのブログ

「再起動の日時を設定するように通知する」のその後

以前、Windows10のWindows Updateの設定で、「再起動の日時を設定するように通知する」にしておいた。

約2週間前に再起動するよう通知が来ていたが、そのままほっとくとどうなるか確認してみた。

一応は再起動自体はしないようだが、いつのまにか単なる通知でなく全画面に再起動のスケジューリングのダイアログが表示されるようになった。再起動のスケジューリングをやらなければいけなさそうな状況になる。

このダイアログの「スケジュール」ボタンを押さないとWindowsの操作ができない。

それで、「スケジュール」ボタンをクリックして再起動のスケジューリングしようとしたら、「更新とセキュリティ」の画面がこんなことになっていた。

再起動の時刻(日付)が選べず、1時間半後(1時間くらい？)の時刻に再起動される設定になっていた。容赦なく再起動されることになる。

少し時間をあげるから、とにかく再起動しろ！とのことなのだろう。

以前、再起動の通知後に「更新とセキュリティ」の画面を見たところ、再起動の日時を指定できていたので、一定期間過ぎたら、スケジューリングできなくなるとのことなのだろう。

以前見たときの画面。

そのときに選べた日付は6日後までだった。

クラシックASPのコーディング考慮点 その４

ASPとWSHの関数の共用

ASPでは、「<%」と「%>」で囲んでコードを記述し、「#include」(SSI)で共通関数が記載されているファイルをインクルードして使うことが多い。

こうしてしまうと、WSHで同じ機能の関数を使いたい場合に、vbsのファイルにコピペして組み込むなど再利用するのに手間がかかってしまう。

やはり、WSHでも簡単に使えるように同じファイルをインクルードして使いたい。

こういう場合は、拡張子wsfでxml形式で記述すれば、ほかのファイルを取り込むことができる。

wsfファイルの書き方(WSH)

sample.wsf

<?xml version="1.0" encoding="utf-8"?>
<job id="sample">
  <script language="VBScript" src="sample.inc"></script>
  
  <script language="VBScript">
  <![CDATA[
    Option Explicit
    
    Dim s
    s = Foo("paramter")
    
    WScript.Echo s
  ]]>
  </script>
</job>

sample.inc

Function Foo(sPara)
    Foo = "Foo called. Parameter:" & sPara
End Function

インクルード方式の変更（<% %> から <script server=server>タグへ）

インクルードしたいファイルに、<% %>が使用されているので、これを取り除く必要がある。 そのため、共通関数から<% %>を取り除き、ASPのインクルードする方式を、SSIから <script language="VBScript" runat="server"> に変更する。

変更前ASP (SSI版)

<%@ LANGUAGE=VBScript %>
<!-- #include file="../common/inc/common.inc" -->

<%
    Dim s
    s = "テスト"
%>
<html>
<!-- 省略 -->
</html>

変更後ASP (script runat=server)

<%@ LANGUAGE=VBScript %>
<script language="VBScript" src="../common/inc/common_vbs.inc" runat="server"></script>

<%
    Dim s
    s = "テスト"
%>
<html>
<!-- 省略 -->
</html>

script runat=serverに変更するときの注意点

<% %>とscriptタグの関数定義の順番違う。

scriptタグに変更してわかったが、<% %>に定義されている関数のほうが先に処理される。

例えば、「Function Foo()」という関数がASP側の<% %>の中(①)とscriptタグでインクルードするファイル(②)の両方に定義がある場合、②のほうが有効になる。

単体テスト方法 (ScriptUnit)

scriptタグによる関数を別ファイルに定義することができたので、別ファイルに定義した関数の単体テストがしやすくなる。

JUnitのようなUnit Testフレームワークとして、VBScript(JScript)用にScriptUnitがあったのでこれを使ってみる。

ScriptUnit：http://xt1.org/scriptunit/

ScriptUnitのコマンドライン

scriptunit /Q フォルダもしくはファイル名 /log results.xml

/Q: GUIを表示しない
/log: xml形式のログを出力。指定しておかないと結果がわからない。
戻り値：Test NGのものがあっても、「errorlevel」は0だった。grepするなどしてエラーがあるかのチェックが必要。
フォルダを指定したとき、指定フォルダ配下のvbsファイルが処理対象となる。サブフォルダは対象とならなかった。

テスト対象

「Test」で始まる関数。大文字小文字区別なし。

サンプル

Sub setup()
    'テストごとの初期処理
    'assert.trace "setup"
End Sub
Sub teardown()
    'テストごとの終了処理
    'assert.trace "teardown"
End Sub

Sub TestSample1()
    Dim s
    s = "111"
    assert.Equals s, "111", "111 expected"
End Sub

Sub TestNothing()
    Dim o
    Set o = Nothing
    Assert.IsNothing o  'Nothingのテスト
End Sub

Sub TestSomething()
    Dim o
    Set o = CreateObject("Scripting.Dictionary")
    Assert.IsSomething o  'オブジェクトのテスト
End Sub

Sub TestErrRaise()
    Dim x
    ' エラー発生のテスト。
    ' 事前にエラーメッセージの一部をExpectErrorで設定しておく。
    'assert.ExpectError "0 で除算しました。"
    assert.ExpectError " で除算しました"
    x = 1 / 0
    Assert.Error "ここに来たらおかしい。"
End Sub

2015/09/12 追記

ScriptUnitの制限・注意事項

• WScriptオブジェクトが使えない。
• wsfが使えない。

単体のvbsファイルしか使えないので、aspのUnitTestには不向き。

2015/09/14 追記
vbslibというライブラリがあり、こちらのほうが目的に合致している。

関連

• ASPのエラーハンドリング、グローバル変数の集約、処理テンプレート化
  http://umejan.hatenablog.com/entry/2015/08/08/234631
• ASPの入力値の復元、javascriptのエスケープ処理
  http://umejan.hatenablog.com/entry/2015/08/09/123859
• ASPでのログ出力方法
  http://umejan.hatenablog.com/entry/2015/08/27/011503
• vbscriptの単体テスト(unit test)
  http://umejan.hatenablog.com/entry/2015/09/14/203940

クラシックASPのコーディング考慮点 その３

ASPでのログ出力方法について

VBScriptでのログ出力 (Scripting.FileSystemObject)

ファイル出力自体は、Scripting.FileSystemObject があるのでこれを利用するが、 マルチスレッド下での動作となるので同期処理（排他）が必要。

VBScriptでは、プロセス間も含めてスレッド間の同期方法がない。

SleepしてWaitすることも難しい。 WScript.Shell経由でSleepするコマンドを実行する手段がないこともないが、ログ出力時のWaitには合わないし重い。 そもそもSleepしてリトライはさせたくない。

ということで、VBScript単体で実装する場合は、出力対象のログファイルが使用中なら予備のログファイルに出力する方法くらいか。

ログ出力 VBScript版

Set fs_ = Server.CreateObject("Scripting.FileSystemObject")

Const ForAppending = 8 ' 追記モード
Sub WriteLog(fileNm, msg)
  Dim s
  Dim writer
  Dim i, wkFileNm, sExt, iPos
  
  s = GetTimestamp() & " " & msg
  On Error Resume Next
  Set writer = fs_.OpenTextFile(fileNm, ForAppending, True)
  If Err.Number <> 0 Then
    iPos = InStrRev(fileNm, ".")
    If iPos = 0 Then
      wkFileNm = fileNm
    Else
      wkFileNm = Mid(fileNm, 1, iPos - 1)
      sExt = Mid(fileNm, iPos)
    End If
    
    'エラーの場合、予備のログファイルへの出力
    For i = 0 To 20 - 1
      Err.Clear
      Set writer = fs_.OpenTextFile(wkFileNm & "-" & i & sExt, ForAppending, True)
      If Err.Number = 0 Then
        Exit For
      End If
    Next
  End If
  If Not writer Is Nothing Then
    writer.WriteLine s
    writer.Close
    Set writer = Nothing
  End If
  
End Sub

Function GetTimestamp()
  Dim ts, tmr
  Dim h,m,s,ms, wk
  ts = Now
  tmr = Timer
  wk = Fix(tmr)
  ms = Right("00" & Fix((tmr - wk)*1000), 3)
  s = wk Mod 60
  wk = (wk - s) \ 60
  m = wk Mod 60
  wk = (wk - m) \ 60
  h = wk Mod 60
  
  If m = 0 Then
    If h = 0 Then
      If Hour(ts) = 23 Then
        ts = DateAdd("d", 1, ts)
      End If
    End If
  End If
  
  GetTimestamp = Year(ts) & "/" & Right("0" & Month(ts), 2) & "/" & Right("0" & Day(ts), 2) _
    & " " & Right("0" & h, 2) & ":" & Right("0" & m, 2) & ":" & Right("0" & s, 2) & "." & ms
End Function

上記ではファイルオープン時にエラーが発生した場合、ファイル名を変えてオープンを試みている。20回も回しているが、ここまで切り替えが発生することはないだろう。

このログ出力関数を使う場合は、１サイトにつき１つのログファイルに出力するのでなく、ASPページ毎のログファイルに出力するなどの細かい単位で出力したほうがよい。

一応、実際のASPファイルに組み込んで、JMeterを使って負荷をかけたが問題なさそうではあった。 ノートPC上の仮想環境でテストしたのでどこまで信用できるか怪しいが。

GetTimestamp関数について補足。

1秒よりも細かい精度の時刻が欲しかったので、VBScriptのTimer関数を利用してミリ秒の出力を行っている。 ただ、精度としては10ミリ秒程度とのことらしい。

.NetFramework(C#)のCOM相互運用機能を使ってログ出力

COMと言えば.NetでないVBで実装していたが、現在ではもう使えないので.Netを使う。

.Netであれば、スレッド間の同期が可能なのでログ出力するのに悩まずにすむ。

.NetでCOMを実装するポイントは以下のとおり。

• クラスライブラリでプロジェクト作成。

• プロジェクトのプロパティ→アプリケーションタブ→アセンブリ情報→「アセンブリをCOM参照可能にする」にチェック。

• プロジェクトのプロパティ→ビルドタブ→「COM相互運用機能の登録」にチェック。

• プロジェクトのプロパティ→ビルドタブ→プラットフォームターゲットをx86に変更。

• インタフェースを用意して、インタフェース用のGUIDを割り当てる。

• クラスにはProgIdを設定する。クラス用のGUIDを割り当てる。インタフェースをデフォルトインタフェースにするため、ClassInterface(ClassInterfaceType.None)を指定する。

• COMを登録する場合は、「regasm 作成したdll /tlb /codebase」。「/codebase」はGACに登録しない場合は必須。

• COMを登録解除する場合は、「regasm 作成したdll /unregister」。

ログ出力 C# COM相互運用機能利用版

using System;
using System.Collections.Generic;
using System.IO;
using System.Runtime.InteropServices;

namespace MyScriptUtil
{
    [Guid("00EE6642-ED0E-49a2-B0F0-XXXXXXXXXXXX")] //←インタフェース用のGUID
    public interface ILogger
    {
        bool IsErrorEnabled { get; }
        bool IsWarnEnabled { get; }
        bool IsInfoEnabled { get; }
        bool IsTraceEnabled { get; }
        bool IsDebugEnabled { get; }
        void Error(string msg);
        void Warn(string msg);
        void Info(string msg);
        void Trace(string msg);
        void Debug(string msg);

        string LogFileName { get; set; }
        string SourceName { get; set; }
        void SetLevel(string level);
    }

    [ComVisible(true)]
    [ClassInterface(ClassInterfaceType.None)]
    [ProgId("MyScriptUtil.Logger")]
    [Guid("4AD76CEA-4361-4a6b-8BDC-XXXXXXXXXXXX")] //←クラス用のGUID
    public class Logger : ILogger
    {
        private string _logFileName = string.Empty;
        private string _sourceName = string.Empty;
        private bool _isErrorEnabled = false;
        private bool _isWarnEnabled = false;
        private bool _isInfoEnabled = false;
        private bool _isTraceEnabled = false;
        private bool _isDebugEnabled = false;
        private readonly static object _lock = new object();
        private readonly static Dictionary<string, object> _filelock = new Dictionary<string, object>();
        private readonly static Dictionary<string, TextWriter> _writer = new Dictionary<string, TextWriter>();
        private readonly static Dictionary<string, DateTime> _lastWrote = new Dictionary<string, DateTime>();
        private static System.Threading.Thread _closer = null;

        private readonly static ILogFormatter _defaultFormatter = new DefaultFormatter();
        private ILogFormatter _formatter = _defaultFormatter;

        public void SetFormatter(ILogFormatter formatter)
        {
            _formatter = formatter;
        }

        private void PutLog(string level, string msg)
        {
            DateTime ts = DateTime.Now;
            if (!_filelock.ContainsKey(_logFileName))
            {
                if (string.IsNullOrEmpty(_logFileName))
                {
                    return;
                }
                lock (_lock)
                {
                    if (!_filelock.ContainsKey(_logFileName))
                    {
                        _filelock.Add(_logFileName, new object());
                        _writer.Add(_logFileName, File.AppendText(_logFileName));
                        _lastWrote.Add(_logFileName, DateTime.MinValue);
                    }
                    if (_closer == null)
                    {
                        _closer = new System.Threading.Thread(new System.Threading.ThreadStart(FileCloser));
                        _closer.Start();
                    }
                }
            }
            lock (_filelock[_logFileName])
            {
                try
                {
                    //using (TextWriter writer = File.AppendText(_logFileName))
                    //{
                    //    _formatter.PutLog(writer, level, _sourceName, ts.ToString("yyyy/MM/dd HH:mm:ss.fff"), msg);
                    //}
                    TextWriter writer;
                    if (_writer[_logFileName] == null)
                    {
                        _writer[_logFileName] = File.AppendText(_logFileName);
                        writer = _writer[_logFileName];
                    }
                    else
                    {
                        writer = _writer[_logFileName];
                    }
                    _formatter.PutLog(writer, level, _sourceName, ts.ToString("yyyy/MM/dd HH:mm:ss.fff"), msg);
                    writer.Flush();
                    _lastWrote[_logFileName] = DateTime.Now;
                }
                catch (Exception e)
                {
                    e.ToString();
                    try
                    {
                        if (_writer[_logFileName] != null)
                        {
                            _writer[_logFileName].Close();
                            _writer[_logFileName] = null;
                        }
                    }
                    catch
                    {
                    }
                }
            }
        }
        private static void FileCloser()
        {
            while (true)
            {
                System.Threading.Thread.Sleep(1000);

                foreach (string key in _filelock.Keys)
                {
                    lock (_filelock[key])
                    {
                        if (DateTime.Now.Subtract(_lastWrote[key]).TotalSeconds > 10.0)
                        {
                            if (_writer[key] != null)
                            {
                                _writer[key].Close();
                            }
                            _writer[key] = null;
                        }
                    }
                }
            }
        }

        #region ILogger メンバ
        public void Debug(string msg)
        {
            if (_isDebugEnabled)
            {
                PutLog("DEBUG", msg);
            }
        }
        
        // 省略
        
        #endregion
    }

    [ComVisible(false)]
    public interface ILogFormatter
    {
        void PutLog(TextWriter writer, string level, string sourceName, string timestampStr, string msg);
    }

    [ComVisible(false)]
    [ClassInterface(ClassInterfaceType.None)]
    public class DefaultFormatter : ILogFormatter
    {
        public void PutLog(TextWriter writer, string level, string sourceName, string timestampStr, string msg)
        {
            writer.Write(timestampStr);
            writer.Write(",");
            writer.Write(level);
            writer.Write(",");
            writer.Write(sourceName);
            writer.Write(",");
            writer.Write(System.Threading.Thread.CurrentThread.ManagedThreadId);
            writer.Write(" ");
            writer.WriteLine(msg);
        }
    }
}

補足

ログファイルは別スレッドにて10秒間書き込みがなければCloseするようにした。 しかし、IISでこのように勝手にスレッドを作るのは作法的によくないかもしれない。

ストリームをOpenしっぱなしにするか、書き込みごとにOpen、Closeするのが無難だろう。

ファイル出力の同期については、ファイルごとにstaticオブジェクトを割り当てそれをlockステートメントで排他制御を行っている。 ストリームをOpenしたままにするのであれば、TextWriter.Synchronizedが利用できるらしい。その場合はTextWriterをstaticにする必要がある。

参考サイト

http://kwski.net/architecture/539/

http://hp.vector.co.jp/authors/VA007219/rtc_pic.html

http://internetcom.jp/developer/20060627/25.html

http://needtec.exblog.jp/21522702/

https://msdn.microsoft.com/ja-jp/library/aa288456%28v=vs.71%29.aspx