| Class | dc_args |
| In: |
dc_args.f90
|
コマンドライン引数の解析を行います.
加えて, ヘルプメッセージの表示に関して便利なサブルーチンも 用意しています.
| Open : | 構造型 ARGS 変数の初期化 |
| Close : | 構造型 ARGS 変数の終了処理 |
| Get : | コマンドライン引数の取得 |
| Size : | コマンドライン引数の数を返す |
| Option : | コマンドライン引数オプションを取得するための設定 |
| Debug : | デバッグオプションの自動設定 |
| Help : | ヘルプオプションの自動設定 |
| HelpMsg : | ヘルプメッセージの設定 |
| Strict : | 無効なオプションが指定された時に警告を表示するよう設定 |
| Put_Line : | 構造型 ARGS 変数の内容を印字 |
構造型 ARGS の変数を定義し, Open, Get を利用することで コマンドライン引数を取得することができます.
use dc_types
use dc_string, only: StoA
use dc_args
implicit none
type(ARGS) :: arg
character(TOKEN), pointer :: argv(:) => null()
integer :: i
call Open(arg)
call Debug(arg) ; call Help(arg) ; call Strict(arg)
call Get(arg, argv)
do i = 1, size(argv)
write(*,*) argv(i)
end do
deallocate(argv)
call Close(arg)
引数にオプションを指定したい場合には, Option サブルーチンを 利用してください. オプションの書式に関しては Option の 「オプションの書式」を参照してください.
use dc_types
use dc_string, only: StoA
use dc_args
implicit none
type(ARGS) :: arg
logical :: OPT_size
logical :: OPT_namelist
character(STRING) :: VAL_namelist
call Open(arg)
call Option(arg, StoA('-s', '--size'), &
& OPT_size, help="Return number of arguments")
call Option(arg, StoA('-N', '--namelist'), &
& OPT_namelist, VAL_namelist, help="Namelist filename")
call Debug(arg); call Help(arg) ; call Strict(arg)
if (OPT_size) then
write(*,*) 'number of arguments :: ', size(arg)
end if
if (OPT_namelist) then
write(*,*) '--namelist=', trim(VAL_namelist)
else
write(*,*) '--namelist is not found'
end if
call Close(arg)
コマンドライン引数に ’-h’, ’-H’, ’—help’ のいづれかのオプションを 指定することで, オプションの一覧が標準出力に表示されます.
ヘルプメッセージの内容を充実させたい場合には HelpMsg を 参照してください.
| Derived_Types | [] | ARGS |
| Subroutine : | |
| arg : | type(ARGS), intent(inout) |
ARGS 型の変数をクローズします.
subroutine DCArgsClose(arg)
!
!=== ARGS の終了サブルーチン
!
! ARGS 型の変数をクローズします.
!
use dc_hash, only: Delete
implicit none
type(ARGS), intent(inout) :: arg
integer :: i
continue
if (arg % initialized) then
do i = 1, size(arg % opt_table)
deallocate(arg % opt_table(i) % options)
end do
deallocate(arg % opt_table)
deallocate(arg % cmd_opts_list)
call Delete(arg % helpmsg)
end if
end subroutine DCArgsClose
| Subroutine : | |
| arg : | type(ARGS), intent(inout) |
-D もしくは —debug が指定された際, 自動的に dc_trace#SetDebug を呼び出すよう arg を設定します.
subroutine DCArgsDebug(arg)
!
!=== デバッグオプション自動設定サブルーチン
!
! -D もしくは --debug が指定された際, 自動的に
! dc_trace#SetDebug を呼び出すよう *arg* を設定します.
!
use dc_types, only: STRING
use dc_string, only: StoA, StoI
use dc_trace, only: SetDebug
use dc_message, only: MessageNotify
implicit none
type(ARGS), intent(inout) :: arg
logical :: OPT_debug
character(STRING) :: VAL_debug
character(len = *), parameter :: subname = 'DCArgsDebug'
continue
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Debug in dc_args.')
call DCArgsOpen(arg)
end if
call Option(arg, StoA('-D', '--debug'), OPT_debug, VAL_debug, help="call dc_trace#SetDebug (display a lot of messages for debug). " // "VAL is unit number (default is standard output)")
if (OPT_debug) then
if (trim(VAL_debug) == '') then
call SetDebug
else
call SetDebug(StoI(VAL_debug))
end if
end if
return
end subroutine DCArgsDebug
| Subroutine : | |||
| arg : | type(ARGS), intent(inout) | ||
| argv(:) : | character(*), pointer
|
コマンドライン引数のうち, オプションではないものを argv に返します.
argv は文字型配列のポインタです. 引数として与える場合には必ず空状態して与えてください.
subroutine DCArgsGet(arg, argv)
!
!=== 引数取得サブルーチン
!
! コマンドライン引数のうち, オプションではないものを
! *argv* に返します.
!
! *argv* は文字型配列のポインタです.
! 引数として与える場合には必ず空状態して与えてください.
!
use dc_types, only: STRING
use dc_string, only: StoA, StoI, Printf, Concat, JoinChar
use dc_present, only: present_and_true
use dc_message, only: MessageNotify
implicit none
type(ARGS), intent(inout) :: arg
character(*), pointer :: argv(:) !(out)
integer :: i, cmd_argv_max
character(len = *), parameter :: subname = 'DCArgsGet'
continue
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Help in dc_args.')
call DCArgsOpen(arg)
end if
cmd_argv_max = size(cmd_argv_list)
allocate(argv(cmd_argv_max))
do i = 1, cmd_argv_max
argv(i) = cmd_argv_list(i)
end do
end subroutine DCArgsGet
| Subroutine : | |
| arg : | type(ARGS), intent(inout) |
| force : | logical, intent(in), optional |
-h, -H, —help のいづれかが指定された際, 自動的に arg 内に設定された 情報をヘルプメッセージとして表示した後, プログラムを終了させます. 原則的に, このサブルーチンよりも前に Option, Debug のサブルーチンを 呼んで下さい.
force に .true. が指定される場合, -H, —help オプションが与え られない場合でもヘルプメッセージを表示した後, プログラムを終了さ せます.
ヘルプメッセージに表示される情報は, Option, HelpMsg サブルーチン によって付加することが可能です.
subroutine DCArgsHelp(arg, force)
!
!=== ヘルプオプション自動設定サブルーチン
!
! -h, -H, --help のいづれかが指定された際, 自動的に *arg* 内に設定された
! 情報をヘルプメッセージとして表示した後, プログラムを終了させます.
! 原則的に, このサブルーチンよりも前に Option, Debug のサブルーチンを
! 呼んで下さい.
!
! *force* に .true. が指定される場合, -H, --help オプションが与え
! られない場合でもヘルプメッセージを表示した後, プログラムを終了さ
! せます.
!
! ヘルプメッセージに表示される情報は, Option, HelpMsg サブルーチン
! によって付加することが可能です.
!
use dc_types, only: STRING
use dc_string, only: StoA, StoI, Printf, Concat, JoinChar, UChar, LChar
use dc_present, only: present_and_true
use dc_message, only: MessageNotify
use dc_hash, only: Get, Delete, Rewind, Next
implicit none
type(ARGS), intent(inout) :: arg
logical, intent(in), optional :: force
logical :: OPT_help, found, end
character(STRING) :: VAL_help, options_msg, help_msg, category
character(STRING), pointer :: localopts(:) => null()
integer :: unit, i
character(len = *), parameter :: subname = 'DCArgsHelp'
continue
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Help in dc_args.')
call DCArgsOpen(arg)
end if
call Option(arg, StoA('-h', '-H', '--help'), OPT_help, VAL_help, help="display this help and exit. " // "VAL is unit number (default is standard output)")
if (.not. OPT_help .and. .not. present_and_true(force)) then
return
end if
if (trim(VAL_help) == '') then
unit = 6
else
unit = StoI(VAL_help)
end if
call Printf(unit, '')
call Get(arg % helpmsg, 'TITLE', help_msg, found)
if (found) then
call Printf(unit, '%c', c1=trim(help_msg))
call Printf(unit, '')
call Delete(arg % helpmsg, 'TITLE')
end if
call Get(arg % helpmsg, 'OVERVIEW', help_msg, found)
if (found) then
call Printf(unit, 'Overview::')
call PrintAutoLinefeed(unit, help_msg, indent=' ')
call Printf(unit, '')
call Delete(arg % helpmsg, 'OVERVIEW')
end if
call Get(arg % helpmsg, 'USAGE', help_msg, found)
if (found) then
call Printf(unit, 'Usage::')
call PrintAutoLinefeed(unit, help_msg, indent=' ')
call Printf(unit, '')
call Delete(arg % helpmsg, 'USAGE')
end if
call Printf(unit, 'Options::')
do i = 1, size(arg % opt_table)
options_msg = ' '
if (arg % opt_table(i) % optvalue_flag) then
call Concat(arg % opt_table(i) % options, '=VAL', localopts)
else
allocate(localopts(size(arg % opt_table(i) % options)))
localopts = arg % opt_table(i) % options
end if
options_msg = trim(options_msg) // trim(JoinChar(localopts))
deallocate(localopts)
call Printf(unit, ' %c', c1=trim(options_msg))
call PrintAutoLinefeed(unit, arg % opt_table(i) % help_message, indent=' ')
call Printf(unit, '')
end do
call Rewind(arg % helpmsg)
do
call Next(arg % helpmsg, category, help_msg, end)
if (end) exit
call Printf(unit, '%c%c::', c1=trim(UChar(category(1:1))), c2=trim(LChar(category(2:))))
call PrintAutoLinefeed(unit, help_msg, indent=' ')
call Printf(unit, '')
enddo
call DCArgsClose(arg)
stop
end subroutine DCArgsHelp
| Subroutine : | |
| arg : | type(ARGS), intent(inout) |
| category : | character(*), intent(in) |
| msg : | character(*), intent(in) |
サブルーチン Help を使用した際に出力されるメッセージを 付加します. category に Title, Overview, Usage が 指定されたものは Options よりも上部に, それ以外のものは下部に表示されます. msg にはメッセージを与えてください.
use dc_types
use dc_string, only: StoA
use dc_args
implicit none
type(ARGS) :: arg
logical :: OPT_namelist
character(STRING) :: VAL_namelist
character(TOKEN), pointer :: argv(:) => null()
integer :: i
call Open(arg)
call HelpMsg(arg, 'Title', 'dcargs $Revision: 1.4 $ :: Test program of dc_args')
call HelpMsg(arg, 'Usage', 'dcargs [Options] arg1, arg2, ...')
call Option(arg, StoA('-N', '--namelist'), &
& OPT_namelist, VAL_namelist, help="Namelist filename")
call HelpMsg(arg, 'DESCRIPTION', &
& '(1) Define type "HASH". ' // &
& '(2) Open the variable. ' // &
& '(3) set HelpMsg. ' // &
& '(4) set Options. ' // &
& '(5) call Debug. ' // &
& '(6) call Help. ' // &
& '(7) call Strict.')
call HelpMsg(arg, 'Copyright', &
& 'Copyright (C) GFD Dennou Club, 2006. All rights reserved.')
call Debug(arg)
call Help(arg)
call Strict(arg)
call Get(arg, argv)
write(*,*) '--namelist=', trim(VAL_namelist)
do i = 1, size(argv)
write(*,*) argv(i)
end do
deallocate(argv)
call Close(arg)
コマンドライン引数に ’-h’, ’-H’, ’—help’ のいづれかのオプション を指定することで, HelpMsg で与えたメッセージと, オプションの一覧 が標準出力に表示されます.
subroutine DCArgsHelpMsg(arg, category, msg)
!
!=== ヘルプメッセージ追加サブルーチン
!
! サブルーチン Help を使用した際に出力されるメッセージを
! 付加します. *category* に +Title+, +Overview+, +Usage+ が
! 指定されたものは +Options+ よりも上部に,
! それ以外のものは下部に表示されます.
! *msg* にはメッセージを与えてください.
!
!==== 例
!
! use dc_types
! use dc_string, only: StoA
! use dc_args
! implicit none
! type(ARGS) :: arg
! logical :: OPT_namelist
! character(STRING) :: VAL_namelist
! character(TOKEN), pointer :: argv(:) => null()
! integer :: i
!
! call Open(arg)
! call HelpMsg(arg, 'Title', 'dcargs $Revision: 1.4 $ :: Test program of dc_args')
! call HelpMsg(arg, 'Usage', 'dcargs [Options] arg1, arg2, ...')
! call Option(arg, StoA('-N', '--namelist'), &
! & OPT_namelist, VAL_namelist, help="Namelist filename")
! call HelpMsg(arg, 'DESCRIPTION', &
! & '(1) Define type "HASH". ' // &
! & '(2) Open the variable. ' // &
! & '(3) set HelpMsg. ' // &
! & '(4) set Options. ' // &
! & '(5) call Debug. ' // &
! & '(6) call Help. ' // &
! & '(7) call Strict.')
! call HelpMsg(arg, 'Copyright', &
! & 'Copyright (C) GFD Dennou Club, 2006. All rights reserved.')
! call Debug(arg)
! call Help(arg)
! call Strict(arg)
! call Get(arg, argv)
! write(*,*) '--namelist=', trim(VAL_namelist)
! do i = 1, size(argv)
! write(*,*) argv(i)
! end do
! deallocate(argv)
! call Close(arg)
!
! コマンドライン引数に '-h', '-H', '--help' のいづれかのオプション
! を指定することで, HelpMsg で与えたメッセージと, オプションの一覧
! が標準出力に表示されます.
!
use dc_hash, only: Put
use dc_string, only: UChar
use dc_message, only: MessageNotify
implicit none
type(ARGS), intent(inout) :: arg
character(*), intent(in) :: category
character(*), intent(in) :: msg
character(len = *), parameter :: subname = 'DCArgsHelpMsg'
continue
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Help in dc_args.')
call DCArgsOpen(arg)
end if
call Put(arg % helpmsg, key=UChar(category), value=msg)
end subroutine DCArgsHelpMsg
| Subroutine : | |
| arg : | type(ARGS), intent(out) |
ARGS 型の変数を利用する際にはまずこのサブルーチンによって 初期化を行ってください.
subroutine DCArgsOpen(arg)
!
!=== ARGS の初期化用サブルーチン
!
! ARGS 型の変数を利用する際にはまずこのサブルーチンによって
! 初期化を行ってください.
!
use dc_message, only: MessageNotify
use dc_types, only: STRING
implicit none
type(ARGS), intent(out) :: arg
integer:: cmd_opts_max
character(len = *), parameter :: subname = 'DCArgsOpen'
continue
if (arg % initialized) then
call MessageNotify('W', subname, 'This argument (type ARGS) is already opend.')
return
end if
call BuildArgTable
call SortArgTable
cmd_opts_max = size(cmd_opts_list)
allocate(arg % cmd_opts_list(cmd_opts_max))
arg % cmd_opts_list = cmd_opts_list
allocate(arg % opt_table(0))
arg % initialized = .true.
end subroutine DCArgsOpen
| Subroutine : | |
| arg : | type(ARGS), intent(inout) |
| options(:) : | character(len = *), intent(in) |
| flag : | logical, intent(out) |
| value : | character(len = *), intent(out), optional |
| help : | character(len = *), intent(in), optional |
コマンドライン引数のうち, options に与えるオプションに関する情 報を flag と value に取得します. options がコマンドライン 引数に与えられていれば flag に .true. が, そうでない場合は .false. が返ります. オプションに値が指定される場合は value に その値が返ります. オプション自体が与えられていない場合には value には空文字が返ります.
help には options に関するヘルプメッセージを arg に 登録します. サブルーチン Help (または DCArgsHelp) を 用いた際に, このメッセージが出力されます. value を与えているかどうかでこのメッセージは変化します.
コマンドライン引数のうち, オプションと判定されるのは以下の場合です.
オプションの値は, "=" よりも後ろの文字列になります.
例
| コマンドライン引数 : | オプション名, 値 |
| -h : | -h, 無し |
| —help : | —help, 無し |
| -D=6 : | -D, 6 |
| -debug= : | -d, 無し |
| —include=/usr : | —include, /usr |
subroutine DCArgsOption(arg, options, flag, value, help)
!
!=== オプション情報の登録と取得
!
! コマンドライン引数のうち, *options* に与えるオプションに関する情
! 報を *flag* と *value* に取得します. *options* がコマンドライン
! 引数に与えられていれば *flag* に .true. が, そうでない場合は
! .false. が返ります. オプションに値が指定される場合は *value* に
! その値が返ります. オプション自体が与えられていない場合には
! *value* には空文字が返ります.
!
! *help* には *options* に関するヘルプメッセージを *arg* に
! 登録します. サブルーチン Help (または DCArgsHelp) を
! 用いた際に, このメッセージが出力されます.
! *value* を与えているかどうかでこのメッセージは変化します.
!
!==== オプションの書式
!
! コマンドライン引数のうち, オプションと判定されるのは以下の場合です.
!
! * 1 文字目が '-' の場合. この場合は短いオプションとなり, '-'
! の次の一文字のみがオプションとして有効になります.
!
! * 1-2文字目が '--' (ハイフン 2 文字) の場合.
! この場合は長いオプションとなり,
! '--' 以降の文字列がオプションとして有効になります.
!
! オプションの値は, "=" よりも後ろの文字列になります.
!
! 例
!
! <b>コマンドライン引数</b> :: <b>オプション名, 値 </b>
! -h :: -h, 無し
! --help :: --help, 無し
! -D=6 :: -D, 6
! -debug= :: -d, 無し
! --include=/usr :: --include, /usr
!
use dc_message, only: MessageNotify
implicit none
type(ARGS), intent(inout) :: arg
character(len = *), intent(in) :: options(:)
logical, intent(out) :: flag
character(len = *), intent(out), optional :: value
character(len = *), intent(in), optional :: help
integer :: i, j, options_size, table_size
type(OPT_ENTRY), allocatable :: local_tables(:)
character(len = *), parameter :: subname = 'DCArgsOption'
continue
flag = .false.
if (present(value)) value = ''
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Option in dc_args.')
call DCArgsOpen(arg)
end if
options_size = size(options)
if (options_size < 1) then
return
end if
!== 構造体 ARGS へのヘルプメッセージ用の情報登録
!=== まずはテーブル arg % opt_table を一つ広げる.
table_size = size(arg % opt_table)
allocate(local_tables(table_size))
local_tables(1:table_size) = arg % opt_table(1:table_size)
deallocate(arg % opt_table)
allocate(arg % opt_table(table_size + 1))
arg % opt_table(1:table_size) = local_tables(1:table_size)
deallocate(local_tables)
!=== 値の代入
allocate(arg % opt_table(table_size + 1) % options(options_size))
arg % opt_table(table_size + 1) % options = options
arg % opt_table(table_size + 1) % help_message = ''
if (present(help)) then
arg % opt_table(table_size + 1) % help_message = help
end if
arg % opt_table(table_size + 1) % optvalue_flag = present(value)
! arg % cmd_opts_list 内の探査と flag, value への代入
! 呼ばれたものに関しては arg % cmd_opts_list % flag_called を
! .true. に
do i = 1, options_size
do j = 1, size(arg % cmd_opts_list)
if (trim(options(i)) == trim(arg % cmd_opts_list(j) % name)) then
flag = .true.
if (present(value)) then
value = arg % cmd_opts_list(j) % value
end if
arg % cmd_opts_list(j) % flag_called = .true.
end if
end do
end do
end subroutine DCArgsOption
| Subroutine : | |
| arg : | type(ARGS), intent(in) |
arg に関する情報を標準出力に表示します.
subroutine DCArgsPut_Line(arg)
!
!=== 情報の印字
!
! *arg* に関する情報を標準出力に表示します.
!
use dc_string, only: Printf, JoinChar
implicit none
type(ARGS), intent(in) :: arg
integer :: i
continue
if (.not. arg % initialized) then
call Printf(6, '#<ARGS:: @initialized=%y>', l=(/arg % initialized/))
return
end if
call Printf(6, '#<ARGS:: @initialized=%y,', l=(/arg % initialized/))
call Printf(6, ' @opt_table(:)=')
do i = 1, size(arg % opt_table)
call Printf(6, ' #<OPT_ENTRY:: ')
call Printf(6, ' @options=%c, @help_message=%c, @optvalue_flag=%y', c1=trim(JoinChar(arg % opt_table(i) % options)), c2=trim(arg % opt_table(i) % help_message), l=(/arg % opt_table(i) % optvalue_flag/))
call Printf(6, ' >')
end do
call Printf(6, ' ,')
call Printf(6, ' @cmd_opts_list(:)=')
do i = 1, size(arg % cmd_opts_list)
call Printf(6, ' #<CMD_OPTS_INTERNAL:: ')
call Printf(6, ' @name=%c, @value=%c, @flag_called=%y', c1=trim(arg % cmd_opts_list(i) % name), c2=trim(arg % cmd_opts_list(i) % value), l=(/arg % cmd_opts_list(i) % flag_called/))
call Printf(6, ' >')
end do
call Printf(6, ' ,')
call Printf(6, ' @cmd_argv_list(:)=%c', c1=trim(JoinChar(cmd_argv_list)))
call Printf(6, '>')
end subroutine DCArgsPut_Line
| Function : | |
| result : | integer |
| arg : | type(ARGS), intent(inout) |
コマンドライン引数として与えられた引数の数を返します.
function DCArgsSize(arg) result(result)
!
!=== コマンドライン引数の数を返す
!
! コマンドライン引数として与えられた引数の数を返します.
!
use dc_message, only: MessageNotify
implicit none
type(ARGS), intent(inout) :: arg
integer :: result
character(len = *), parameter :: subname = 'DCArgsGet'
continue
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Help in dc_args.')
call DCArgsOpen(arg)
end if
result = size(cmd_argv_list)
end function DCArgsSize
| Subroutine : | |
| arg : | type(ARGS), intent(inout) |
| severe : | logical, intent(in), optional |
コマンドライン引数のオプションとして指定されたものの内, Option サブルーチンで設定されていないものが存在する 場合には警告を返します. severe に .true. を指定すると エラーを返して終了します. このサブルーチンを呼ぶ前に, Option, Debug, Help サブルーチンを 呼んでください.
構造体 ARGS の変数に対してこのサブルーチンを適用しておく ことで, コマンドライン引数として与えたオプションが正しく プログラムが認識しているかどうかをチェックすることができます.
subroutine DCArgsStrict(arg, severe)
!
!=== オプションチェックサブルーチン
!
! コマンドライン引数のオプションとして指定されたものの内,
! Option サブルーチンで設定されていないものが存在する
! 場合には警告を返します. *severe* に .true. を指定すると
! エラーを返して終了します.
! このサブルーチンを呼ぶ前に, Option, Debug, Help サブルーチンを
! 呼んでください.
!
! 構造体 ARGS の変数に対してこのサブルーチンを適用しておく
! ことで, コマンドライン引数として与えたオプションが正しく
! プログラムが認識しているかどうかをチェックすることができます.
!
!
use dc_types, only: STRING
use dc_present, only: present_and_true
use dc_message, only: MessageNotify
implicit none
type(ARGS), intent(inout) :: arg
logical, intent(in), optional :: severe
character(STRING) :: err_mess
integer :: i
character(len = *), parameter :: subname = 'DCArgsStrict'
continue
if (.not. arg % initialized) then
call MessageNotify('W', subname, 'Call Open before Help in dc_args.')
call DCArgsOpen(arg)
end if
do i = 1, size(arg % cmd_opts_list)
err_mess = trim(arg % cmd_opts_list(i) % name) // ' is invalid option.'
if (.not. arg % cmd_opts_list(i) % flag_called) then
if (present_and_true(severe)) then
call MessageNotify('E', subname, err_mess)
else
call MessageNotify('W', subname, err_mess)
end if
end if
end do
end subroutine DCArgsStrict