Class | dc_args |
In: |
dc_args.f90
|
コマンドライン引数の解析を行います.
加えて, ヘルプメッセージの表示に関して便利なサブルーチンも 用意しています.
Open : | 構造型 ARGS 変数の初期化 |
Close : | 構造型 ARGS 変数の終了処理 |
Get : | コマンドライン引数の取得 |
Number : | コマンドライン引数の数を返す |
Option : | コマンドライン引数オプションを取得するための設定 |
Debug : | デバッグオプションの自動設定 |
Help : | ヘルプオプションの自動設定 |
HelpMsg : | ヘルプメッセージの設定 |
Strict : | 無効なオプションが指定された時に警告を表示するよう設定 |
PutLine : | 構造型 ARGS 変数の内容を印字 |
構造型 ARGS の変数を定義し, Open, Get を利用することで コマンドライン引数を取得することができます.
use dc_types use dc_string, only: StoA use dc_args implicit none type(ARGS) :: arg character(STRING), 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 :: ', Number(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 を 参照してください.
Fortran コンパイラのほとんどには IARGC, GETARG といった コマンドライン引数取得のための副プログラムが用意されている. これらの副プログラムの利用によって, コマンドラインの引数を 単に取得することは簡単である.
しかしこの IARGC, GETARG の使用に際し, 2 つほど面倒な点がある.
1 つはコンパイラ依存による IARGC, GETARG の仕様の違いである. これらの副プログラムは Fortran 規格に含まれないサービスルーチン であるため, たいていのコンパイラにはこの副プログラムは 存在するものの, 仕様が微妙に異なる場合がある. (大抵のコンパイラは GETARG の第一引数を 1 にすると一つ目の引数を取得するが, 古い HITACHI のコンパイラは第一引数を 2 にしないと一つ目の 引数を取得できない, など). そこで gt4f90io ライブラリでは これらのコンパイラ依存性を吸収する設計を行っている. dc_args モジュールを使用する際には, これらのコンパイラ依存は 気にしなくてよい. (なお, コンパイラ依存性を実際に 吸収しているのは sysdep モジュールである).
2 つ目は, コマンドライン引数におけるオプション引数 (-h や —version など) の取り扱いの不便さである. IARGC や GETARG は単に引数を取得するための副プログラムであり, Perl や Ruby などのインタプリタ言語のように, コマンドライン引数にオプション引数を処理するための ライブラリ (Getopt や OptionParser など) が用意されていない. dc_args モジュールは, Fortran プログラムでもオプション引数を 手軽に扱えるよう, オプション引数処理の ためのコーディングをできるだけ簡素にするべく整備したプログラムである.
設計思想は, オブジェクト指向スクリプト言語 Ruby の OptionParser を真似ており, OptionParser クラスのオブジェクトを 構造型 ARGS に, new (initialize) メソッドを Open サブルーチンに, on メソッドを Option サブルーチンに, parse メソッドを Get サブルーチンに見立てている. 言語仕様の違いにより実装や仕様は それなりに異なるが, 構造型 ARGS の変数をオブジェクトに見立て, この変数に対してサブルーチンを作用させることによって オブジェクトへの操作やオブジェクトからの引数情報の取得を行うという点では OptionParser と同様である.
おまけ的機能であるが, dc_trace モジュールとの連携も図られており, Debug サブルーチンを使用することにより (使用法は上記参照), 再コン パイルすることなく, プログラムの実行の際に "-D" オプションをつける ことでデバッグメッセージを表示するモードに変更することもできる.
Derived_Types | [] | ARGS, OPT_ENTRY, CMD_OPTS_INTERNAL |
Derived Type : | |||
opt_table(:) => null() : | type(OPT_ENTRY), pointer
| ||
initialized = .false. : | logical | ||
cmd_opts_list(:) => null() : | type(CMD_OPTS_INTERNAL),
pointer
| ||
helpmsg : | type(HASH) |
コマンドライン引数解析用の構造体です. 初期化には Open を, 終了処理には Close を用います. コマンドライン引数に与えられる引数や, プログラム内で Option, HelpMsg サブルーチンによって与えられた情報を 格納します.
詳しい使い方は dc_args の Usage を参照ください.
Subroutine : | |
arg : | type(ARGS), intent(inout) |
-D もしくは —debug が指定された際, 自動的に dc_trace#SetDebug を呼び出すよう arg を設定します.
Alias for DCArgsDebug
Subroutine : | |
arg : | type(ARGS), intent(inout) |
force : | logical, intent(in), optional |
-h, -H, —help のいづれかが指定された際, 自動的に arg 内に設定された 情報をヘルプメッセージとして表示した後, プログラムを終了させます. 原則的に, このサブルーチンよりも前に Option, Debug のサブルーチンを 呼んで下さい.
force に .true. が指定される場合, -H, —help オプションが与え られない場合でもヘルプメッセージを表示した後, プログラムを終了さ せます.
ヘルプメッセージに表示される情報は, Option, HelpMsg サブルーチン によって付加することが可能です.
Alias for 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(STRING), pointer :: argv(:) => null() integer :: i call Open(arg) call HelpMsg(arg, 'Title', 'dcargs $Revision: 1.11 $ :: 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 で与えたメッセージと, オプションの一覧 が標準出力に表示されます.
Alias for DCArgsHelpMsg
Function : | |
result : | integer |
arg : | type(ARGS), intent(inout) |
コマンドライン引数として与えられた引数の数を返します.
Alias for DCArgsNumber
Subroutine : | |
arg : | type(ARGS), intent(out) |
ARGS 型の変数を利用する際にはまずこのサブルーチンによって 初期化を行ってください.
このサブルーチンは, より下層のサブルーチン内で IARGC や GETARG を用いて得られたコマンドライン引数の情報を引数 arg へと格納します.
Alias for 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 |
Alias for DCArgsOption
Subroutine : | |
arg : | type(ARGS), intent(inout) |
severe : | logical, intent(in), optional |
コマンドライン引数のオプションとして指定されたものの内, Option サブルーチンで設定されていないものが存在する 場合には警告を返します. severe に .true. を指定すると エラーを返して終了します. このサブルーチンを呼ぶ前に, Option, Debug, Help サブルーチンを 呼んでください.
構造体 ARGS の変数に対してこのサブルーチンを適用しておく ことで, コマンドライン引数として与えたオプションが正しく プログラムが認識しているかどうかをチェックすることができます.
Alias for DCArgsStrict
Subroutine : |
モジュール sysdep の sysdep#SysdepArgCount, sysdep#ArgGet を呼び出し, その内容を argind_count と argstr_table に格納します.
既に一度でも呼ばれている場合, 何もせずに終了します.
subroutine BuildArgTable ! !=== 内部向け引数処理サブルーチン ! ! モジュール sysdep の sysdep#SysdepArgCount, sysdep#ArgGet ! を呼び出し, その内容を argind_count と argstr_table に格納します. ! ! 既に一度でも呼ばれている場合, 何もせずに終了します. ! use sysdep, only: SysdepArgCount, SysdepArgGet use dc_types, only: STRING implicit none integer:: i, narg, nargmax character(len = STRING):: value character(len = STRING), allocatable:: localtab(:) continue if (argind_count >= 0) return nargmax = SysdepArgCount() allocate(localtab(nargmax)) narg = 0 do, i = 1, nargmax call SysdepArgGet(i, value) narg = narg + 1 localtab(narg) = value enddo argind_count = narg allocate(argstr_table(narg)) argstr_table(1: narg) = localtab(1: narg) deallocate(localtab) end subroutine BuildArgTable
Derived Type : | |||
name : | character(STRING)
| ||
value : | character(STRING)
| ||
flag_called = .false. : | logical
|
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, STDOUT 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 = STDOUT 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(STRING), pointer :: argv(:) => null() integer :: i call Open(arg) call HelpMsg(arg, 'Title', 'dcargs $Revision: 1.11 $ :: 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(STRING), pointer :: argv(:) => null() ! integer :: i ! ! call Open(arg) ! call HelpMsg(arg, 'Title', 'dcargs $Revision: 1.11 $ :: 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
Function : | |
result : | integer |
arg : | type(ARGS), intent(inout) |
コマンドライン引数として与えられた引数の数を返します.
function DCArgsNumber(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 DCArgsNumber
Subroutine : | |
arg : | type(ARGS), intent(out) |
ARGS 型の変数を利用する際にはまずこのサブルーチンによって 初期化を行ってください.
このサブルーチンは, より下層のサブルーチン内で IARGC や GETARG を用いて得られたコマンドライン引数の情報を引数 arg へと格納します.
subroutine DCArgsOpen(arg) ! !=== ARGS の初期化用サブルーチン ! ! ARGS 型の変数を利用する際にはまずこのサブルーチンによって ! 初期化を行ってください. ! ! このサブルーチンは, より下層のサブルーチン内で IARGC や GETARG ! を用いて得られたコマンドライン引数の情報を引数 *arg* ! へと格納します. ! 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 = STRING) :: opt_name, opt_value, opt_full 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) !----- options の正規化 ----- do i = 1, options_size opt_full = arg % opt_table(table_size + 1) % options(i) if (DCOptionFormC(opt_full, opt_name, opt_value)) then arg % opt_table(table_size + 1) % options(i) = opt_name else if (len(trim(adjustl(opt_full))) < 2) then arg % opt_table(table_size + 1) % options(i) = '-' // trim(adjustl(opt_full)) else arg % opt_table(table_size + 1) % options(i) = '--' // trim(adjustl(opt_full)) end if end if end do ! 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(arg % opt_table(table_size + 1) % 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 DCArgsPutLine(arg) ! !=== 情報の印字 ! ! *arg* に関する情報を標準出力に表示します. ! use dc_types, only: STDOUT use dc_string, only: Printf, JoinChar implicit none type(ARGS), intent(in) :: arg integer :: i continue if (.not. arg % initialized) then call Printf(STDOUT, '#<ARGS:: @initialized=%y>', l=(/arg % initialized/)) return end if call Printf(STDOUT, '#<ARGS:: @initialized=%y,', l=(/arg % initialized/)) call Printf(STDOUT, ' @opt_table(:)=') do i = 1, size(arg % opt_table) call Printf(STDOUT, ' #<OPT_ENTRY:: ') call Printf(STDOUT, ' @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(STDOUT, ' >') end do call Printf(STDOUT, ' ,') call Printf(STDOUT, ' @cmd_opts_list(:)=') do i = 1, size(arg % cmd_opts_list) call Printf(STDOUT, ' #<CMD_OPTS_INTERNAL:: ') call Printf(STDOUT, ' @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(STDOUT, ' >') end do call Printf(STDOUT, ' ,') call Printf(STDOUT, ' @cmd_argv_list(:)=%c', c1=trim(JoinChar(cmd_argv_list))) call Printf(STDOUT, '>') end subroutine DCArgsPutLine
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
Function : | |
result : | logical |
argument : | character(len = *), intent(in) |
name : | character(len = *), intent(out) |
value : | character(len = *), intent(out) |
引数としてで得られた文字列を argument に渡すことで, それがオプションなのかそうでないのかを判別し, もしも オプションと判別した場合には戻り値に .true. を返し, name にオプション名, value にその値を返す. オプションに値が付加されない場合は value には空白を返す.
オプションではない場合は戻り値に .false. を返し, name, value には空白を返す.
オプションと判定されるのは以下の場合です.
オプションの値は, "=" よりも後ろの文字列になります.
argument : | name, value, 返り値 |
arg : | 空白, 空白, .false. |
-O : | -O, 空白, .true. |
-debug : | -d, 空白, .true. |
—debug : | —debug, 空白, .true. |
-I=/usr : | -I, /usr, .true. |
—include=/usr: | —include, /usr, .true. |
function DCOptionFormC(argument, name, value) result(result) ! ! 引数としてで得られた文字列を *argument* に渡すことで, ! それがオプションなのかそうでないのかを判別し, もしも ! オプションと判別した場合には戻り値に .true. を返し, ! name にオプション名, *value* にその値を返す. ! オプションに値が付加されない場合は *value* には空白を返す. ! ! オプションではない場合は戻り値に .false. を返し, ! *name*, *value* には空白を返す. ! ! オプションと判定されるのは以下の場合です. ! ! * 一文字目が '-' の場合. この場合は短いオプションとなり, '-' ! の次の一文字のみがオプションとして有効になります. ! ! * 1-2文字目が '--' の場合. この場合は長いオプションとなり, ! '--' 以降の文字列がオプションとして有効になります. ! ! オプションの値は, "=" よりも後ろの文字列になります. ! !=== 例 ! ! *argument* :: <b>name, value, 返り値</b> ! arg :: 空白, 空白, .false. ! -O :: -O, 空白, .true. ! -debug :: -d, 空白, .true. ! --debug :: --debug, 空白, .true. ! -I=/usr :: -I, /usr, .true. ! --include=/usr:: --include, /usr, .true. ! implicit none character(len = *), intent(in):: argument character(len = *), intent(out):: name, value logical :: result integer:: equal continue equal = index(argument, '=') if (argument(1:1) == '-' .and. argument(2:2) /= '-') then ! Short Option if (equal == 0) then name = argument(1:2) value = "" else name = argument(1:2) value = argument(equal+1: ) endif result = .true. elseif (argument(1:2) == '--') then ! Long Option if (equal == 0) then name = argument value = "" else name = argument(1:equal-1) value = argument(equal+1: ) endif result = .true. ! elseif (equal == 0 .and. & ! & verify(argument(1:equal-1), WORDCHARS) == 0) then ! ! ??? ! name = argument(1:equal-1) ! value = argument(equal+1: ) ! result = .true. else ! No Option (normal arguments) name = "" value = "" result = .false. endif end function DCOptionFormC
Derived Type : | |||
options(:) => null() : | character(STRING), pointer
| ||
help_message : | character(STRING)
| ||
optvalue_flag : | logical
|
Subroutine : | |||
unit : | integer, intent(in), optional
| ||
fmt : | character(*), intent(in) | ||
length : | integer, intent(in), optional
| ||
indent : | character(*), intent(in), optional
|
このモジュール内部で用いるためのサブルーチンです.
fmt に与えられた文章を文字数 length (指定されない場合 70) 以内に改行し, 出力します. 出力の際, indent が指定されていると その文字列を行頭に挿入して出力を行います. 出力先はデフォルトは標準出力となります. unit に出力装置番号 を設定することで出力先を変更できます.
subroutine PrintAutoLinefeed(unit, fmt, length, indent) ! !== 自動改行出力サブルーチン ! ! このモジュール内部で用いるためのサブルーチンです. ! ! *fmt* に与えられた文章を文字数 *length* (指定されない場合 70) ! 以内に改行し, 出力します. 出力の際, *indent* が指定されていると ! その文字列を行頭に挿入して出力を行います. ! 出力先はデフォルトは標準出力となります. *unit* に出力装置番号 ! を設定することで出力先を変更できます. ! use dc_types, only: STRING, STDOUT use dc_string, only: Split implicit none character(*), intent(in) :: fmt integer, intent(in), optional :: length ! 一行の長さ character(*), intent(in), optional :: indent ! 字下げ文字列 integer, intent(in), optional :: unit ! 出力装置 character(STRING), pointer :: carray_tmp(:) => null() character(STRING) :: store_str integer, parameter :: default_len = 70 integer :: i, split_len, indent_len, unit_num logical :: new_line_flag continue if (present(unit)) then unit_num = unit else unit_num = STDOUT end if if (present(indent)) then indent_len = len(indent) else indent_len = 0 end if if (present(length)) then split_len = length - indent_len else split_len = default_len - indent_len end if nullify(carray_tmp) call Split(fmt, carray_tmp, '') store_str = '' new_line_flag = .true. i = 1 do if (i > size(carray_tmp)) then write(unit_num, '(A)') trim(store_str) exit end if if (len(trim(store_str)) + len(trim(carray_tmp(i))) > split_len) then if (new_line_flag) then write(unit_num, '(A)') trim(carray_tmp(i)) i = i + 1 else write(unit_num, '(A)') trim(store_str) store_str = '' new_line_flag = .true. end if cycle end if if (new_line_flag .and. present(indent)) then store_str = indent // trim(carray_tmp(i)) else store_str = trim(store_str) // ' ' // trim(carray_tmp(i)) end if new_line_flag = .false. i = i + 1 end do end subroutine PrintAutoLinefeed
Subroutine : |
BuildArgTable で設定された argind_count, argstr_table を 用い, cmd_argv_list, cmd_opts_list を設定します.
既に一度でも呼ばれている場合, 何もせずに終了します.
subroutine SortArgTable ! !=== 内部向け引数振り分けサブルーチン ! ! BuildArgTable で設定された argind_count, argstr_table を ! 用い, cmd_argv_list, cmd_opts_list を設定します. ! ! 既に一度でも呼ばれている場合, 何もせずに終了します. ! use dc_types, only: STRING implicit none character(STRING):: raw_arg, name, value integer:: i, cmd_argv_count, cmd_opts_count, cmd_argv_max, cmd_opts_max continue if (allocated(cmd_opts_list)) return cmd_argv_count = 0 cmd_opts_count = 0 check_count: do, i = 1, argind_count raw_arg = argstr_table(i) if (DCOptionFormC(raw_arg, name, value)) then cmd_opts_count = cmd_opts_count + 1 else cmd_argv_count = cmd_argv_count + 1 end if end do check_count cmd_argv_max = cmd_argv_count cmd_opts_max = cmd_opts_count allocate(cmd_argv_list(cmd_argv_max)) allocate(cmd_opts_list(cmd_opts_max)) cmd_argv_count = 0 cmd_opts_count = 0 arg_get : do, i = 1, argind_count raw_arg = argstr_table(i) if (DCOptionFormC(raw_arg, name, value)) then cmd_opts_count = cmd_opts_count + 1 cmd_opts_list(cmd_opts_count) % name = name cmd_opts_list(cmd_opts_count) % value = value cmd_opts_list(cmd_opts_count) % flag_called = .false. else cmd_argv_count = cmd_argv_count + 1 cmd_argv_list(cmd_argv_count) = raw_arg end if end do arg_get end subroutine SortArgTable
Variable : | |||
argstr_table(:) : | character(STRING), allocatable, save
|
Variable : | |||
cmd_argv_list(:) : | character(STRING), allocatable, save
|
Variable : | |||
cmd_opts_list(:) : | type(CMD_OPTS_INTERNAL),
allocatable, save
|