#======================================================== # GetArg #======================================================== package GetArg; use Common; @ISA = qw(Common); #公開したいサブルーチン #@EXPORT = qw(DelSpace Reduce01 MakePath RegExpQuote); use strict; use Utils; #========================================== # 大域変数 #========================================== #HTMLタグをコードする変数 my @SafeDecodeHTMLTags = qw(UserSN Title Authors Abstract TextBody); #============================================================ # 変数等取得関数 #============================================================ sub App { return shift->{Application}; } sub Application { return shift->{Application}; } sub SetApplication { my ($this,$app)=@_; return $this->{Application} = $app; } sub AllowedArgs { return shift->{pAllowedArgs}; } sub Explanations { return shift->{pExplanations}; } sub DefaultValues { return shift->{pDefaultValues}; }; sub ArgArray { return shift->{pArgArray}; } sub FileNameArray { return shift->{pFileNameArray}; } sub AppName { return shift->{AppName}; } sub SetAppName { my ($this, $name) = @_; return $this->{'AppName'} = $name; } sub CGIForm { my ($this) = @_; if(!$this->{CGIForm}) { $this->{CGIForm} = new CGI; } return $this->{CGIForm}; } sub SetCGIForm { my ($this, $f) = @_; #print "form: $f
\n"; return $this->{CGIForm} = $f; } sub pIn { return shift->{'pIn'}; } sub GetArgHash { my ($this, $UseDefault) = @_; my %Args; #CGIフォーム変数 my $pIn = $this->pIn(); if($pIn) { foreach my $key (keys %$pIn) { $Args{$key} = $pIn->{$key}; } } #CGIフォーム変数 my $form = $this->CGIForm(); if($form) { my @params = $form->all_parameters(); foreach my $key (@params) { $Args{$key} = $form->param($key); } } #起動時引数 foreach my $key (keys %ARGV) { $Args{$key} = $ARGV{$key}; } my $pArgs = $this->ArgArray(); if($pArgs) { foreach my $key (keys %$pArgs) { if($pArgs->{$key}) { $Args{$key} = $pArgs->{$key}; } elsif($pArgs->{"--$key"}) { $Args{$key} = $pArgs->{"--$key"}; } } } foreach my $k (keys %Args) { if($k =~ /^--(.*)$/) { $Args{$1} = $Args{$k}; } } if($UseDefault) { my $def = $this->DefaultValues(); foreach my $k (keys %$def) { my $defval = $def->{$k}; $Args{$k} = $defval if(!defined $Args{$k}); if($k =~ /^--(.*)$/) { $Args{$1} = $Args{$k}; $Args{$1} = $defval if(!defined $Args{$1}); } } } foreach my $key (keys %Args) { next if(Utils::IsIncludedInArray($key, \@SafeDecodeHTMLTags)); $Args{$key} = Utils::InvalidateHTMLTags($Args{$key}); } return %Args; } sub MergeArgs { my ($this) = @_; my %hash; #最初に$thisに格納されている連想配列を抽出 foreach my $k (keys %$this) { $hash{$k} = $this->{$k}; } #CGIに格納されている連想配列を抽出 my $pIn = $this->pIn(); if($pIn) { foreach my $key (keys %$pIn) { $hash{$key} = $pIn->{$key}; } } my $form = $this->CGIForm(); if($form) { my @params = $form->all_parameters(); foreach my $key (@params) { $hash{$key} = $form->param($key); } } #起動時引数に格納されている連想配列を抽出 foreach my $key (keys %ARGV) { $hash{$key} = $ARGV{$key}; } my $args = $this->ArgArray(); if($args) { foreach my $key (keys %$args) { $hash{$key} = $args->{$key}; } } #ファイル名を連想配列に追加 my $files = $this->FileNameArray(); if($files) { for(my $i = 0 ; $i < @$files ; $i++) { my $f = $files->[$i]; $hash{"File$i"} = $f; } } return \%hash; } #============================================================ # コンストラクタ、デストラクタ #============================================================ sub new { my ($module, $app) = @_; my $this = {}; bless $this; $this->InitializeArgs(); $this->SetApplication($app) if($app); return $this; } sub DESTROY { my $this = shift; } #============================================================ # 一般関数 #============================================================ sub InitializeArgs { my ($this) = @_; $this->{pAllowedArgs} = {}; $this->{pExplanations} = {}; $this->{pDefaultValues} = {}; $this->{pArgArray} = {}; $this->{pIn} = {}; $this->InitializeFiles(); $this->{CheckAllowedArgs} = 1; } sub InitializeFiles { my ($this) = @_; $this->{'pFileNameArray'} = []; } #============================================================ # 一般関数 #============================================================ # parseInput(encoding) # encoding: 日本語コード(jis|sjis|euc) # Name=>Val のハッシュ(グロブ) # sub parseInput { my ($this, $charcode, $EscapeURL) = @_; $EscapeURL = 1 if(!defined $EscapeURL); #print "GetArg::parseInput
\n"; my ($method) = $ENV{'REQUEST_METHOD'}; #print "method: $method pIn: $this->{'pIn'}
\n"; my ($query, @in, $key, $val); my %in; #二重読み込みを防止する # return $this->{'pIn'} if(defined $this->{'pIn'}); # GETメソッドかPOSTメソッドかを判別する #print "method: $method
\n"; if ($method eq 'GET') { $query = $ENV{'QUERY_STRING'}; } # elsif ($method eq 'POST') { # read(STDIN, $query, $ENV{'CONTENT_LENGTH'}); # } # 入力データを分解する my (@query) = split(/&/, $query); # Name=Val を $in{'Name'} = 'Val' のハッシュにする。 foreach (@query) { # + を空白文字に変換 tr/+/ /; # Name=Val を分ける ($key, $val) = split(/=/); # %HH形式を元の文字にデコードする。 $key =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("c", hex($1))/ge; $val =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("c", hex($1))/ge; $val =~ s/\r\n/\n/g; # 日本語コードが指定されている場合は変換する。 Jcode::convert(\$key, $charcode) if ($charcode); Jcode::convert(\$val, $charcode) if ($charcode); # 連想配列(ハッシュ)にセット $val = Utils::InvalidateHTMLTags($val) if($EscapeURL and !Utils::IsIncludedInArray($val, \@SafeDecodeHTMLTags)); #print "$key: $val\n"; $in{$key} = $val; } # 連想配列のリファレンスを返す return $this->{'pIn'} = \%in; } sub SetUsage { my ($this, $p) = @_; $this->{UsageStr} = $p; return $p; } sub InvalidParameter { my ($this, $key, $point, $ShowUsage) = @_; my $App = $this->Application(); my $val = $this->GetGetArg($key); $App->print("\n"); if($point ne '') { $App->print("Error: Invalid $key [$val].\n"); } else { $App->print("Error in $point: Invalid $key [$val].\n"); } my $p = $this->Explanations(); my $expl = $p->{"--$key"}; $App->print(" $expl\n"); if($ShowUsage) { $App->Usage(); } $App->print("\n"); } sub ArgKeys { my ($this) = @_; my $allowed = $this->AllowedArgs(); return keys %$allowed; } sub SetDefault { my ($this, $UseArgOnly, $EscapeURL) = @_; my $allowed = $this->AllowedArgs(); # my $def = $this->DefaultValues(); # $defval = $def->{"--$varname"}; # my $args = $this->ArgArray(); # my $val = $args->{$varname}; foreach my $key (keys %$allowed) { my $val = $this->GetGetArg($key, 1, $UseArgOnly, $EscapeURL); #print "$key: $val\n"; $this->{pArgArray}{$key} = $val; $allowed->{$key} = $val; } } sub AddVar { my ($this, $key, $val) = @_; my $args = $this->ArgArray(); my $allowed = $this->AllowedArgs(); #my @keys = keys %$args; #print "keys: ", @keys, "\n"; $this->{pArgArray}{"--$key"} = $val; $allowed->{"--$key"} = $val; #print "add [$key]=$val\n"; } sub var { my ($this, $key) = @_; # my $args = $this->ArgArray(); my $allowed = $this->AllowedArgs(); return $allowed->{"--$key"}; } sub PrintArgs { my ($this, $format, $pkeys) = @_; $format = "%s: %s\n" if(!defined $format); if(!defined $pkeys) { $pkeys = {}; @$pkeys = $this->ArgKeys(); } #print "args: ", join(', ', @$pkeys), "\n"; my $App = $this->Application(); my $allowed = $this->AllowedArgs(); my $expl = $this->Explanations(); my %printed; for(my $i = 0 ; $i < @$pkeys ; $i++) { my $s = $pkeys->[$i]; $s =~ s/^\-\-//; #print "$i:$s\n"; next if($printed{$s}); # next if($s !~ /^\-\-/); my $val = $allowed->{"--$s"}; my $e = $expl->{"--$s"}; if($e eq '') { printf $format, $s, $val; } else { $e =~ s/^\-\-//; $e =~ s/\s*:.*$//; $e =~ s/\s*=.*$//; if($e eq $s) { printf $format, $s, $val; } else { printf $format, "$e ($s)", $val; } } $printed{$s}++; # $printed{"--$s"}++; } } sub Usage { my ($this) = @_; my $App = $this->Application(); my $AppName = $this->AppName(); $AppName = $this->App()->AppName() unless($AppName); $AppName = 'Application' unless($AppName); $App->print("\n"); if(defined $this->{UsageStr}) { print "usage: $this->{UsageStr}\n"; } elsif($App and defined $App->{UsageStr}) { print "usage: $App->{UsageStr}\n"; } else { print "usage: $AppName [options] File_Names\n"; } print " Options:\n"; my $allowed = $this->AllowedArgs(); my $expl = $this->Explanations(); my @key = keys %$allowed; for(my $i = 0 ; $i < @key ; $i++) { my $s = $key[$i]; my $e = $expl->{$s}; #print "s=[$s] e=[$e]\n"; $e = $s unless($e); print " $e\n"; } } sub SetCheckAllowedArgs { my ($this, $f) = @_; return $this->{CheckAllowedArgs} = $f; } sub CheckAllowedArgs { my ($this) = @_; $this->{CheckAllowedArgs} = 1 if(!defined $this->{CheckAllowedArgs}); return $this->{CheckAllowedArgs}; } sub IsIncluded { my ($this, $varname) = @_; my $allowed = $this->AllowedArgs(); $varname =~ s/^--//; # $varname = uc $varname; foreach my $s (keys %$allowed) { $s =~ s/^--//; # $s = uc $s; # return 1 if($varname eq $s); return 1 if($varname =~ /^$s$/i); } return 0; } sub BuildCommandLine { my ($this) = @_; my $args = $this->ArgArray(); my $App = $this->App(); my $command = $App->ProgramPath(); $command = '' unless($command); foreach my $s (keys %$args) { my $v = $args->{$s}; if(defined $v and $v ne '') { $command = "$command --$s=$v"; } else { $command = "$command --$s"; } } Utils::DelSpace($command); return $command; } sub ShowArgs { my ($this) = @_; my $args = $this->MergeArgs(); # my %hash = $this->GetArgHash(); # my $args = \%hash; $this->print("Arguments in command line:\n"); foreach my $s (keys %$args) { my $v = $args->{$s}; $this->print(" $s=$v\n") unless($v =~ /ARRAY\(0x/ or $v =~ /HASH\(0x/); } } #コマンドライン引数の文字列と値を設定する sub SetArgument { my ($this, $varname, $val) = @_; return undef unless($varname); my $args = $this->ArgArray(); #print "set v: $varname val: $val\n"; return $args->{$varname} = $val; } sub GetGetArg { my ($this, $varname0, $UseDefault, $UseArgOnly, $EscapeURL) = @_; $EscapeURL = 1 if(!defined $EscapeURL); # $UseDefault = 1 if(!defined $UseDefault); #Utils::InitHTML(); #print "e:$EscapeURL $varname0
\n"; my $varname = $varname0; $varname =~ s/^--//; $UseArgOnly = 0 if(!defined $UseArgOnly); #print "UD=$UseDefault [$varname0][$varname]\n"; my $defval; if($UseDefault and $varname !~ /^help$/i) { my $def = $this->DefaultValues(); #print "defval=", join(', ', %$def), "\n"; $defval = $def->{"--$varname"}; } #if(!defined $defval) { #print "def not defined: var def: $varname: $defval\n"; #} #else { #print "def defined: var def: $varname: $defval\n"; #} my $IsCGI = Utils::IsCGI(); #CGIフォーム変数 my $pIn = $this->pIn(); #$pIn = undef; #print "a: !$UseArgOnly and $pIn\n"; if(!$UseArgOnly and $pIn and $IsCGI) { my $val = $pIn->{$varname}; $val = $defval if($UseDefault and !defined $val); $val = Utils::InvalidateHTMLTags($val) if($EscapeURL and !Utils::IsIncludedInArray($val, \@SafeDecodeHTMLTags)); #print " 1: $val
\n"; return $val if(defined $val); } #CGIフォーム変数 my $form = $this->CGIForm(); #print "form=$form\n"; if(!$UseArgOnly and $form and $IsCGI) { my $val = $form->param($varname); $val = $defval if($UseDefault and !defined $val); $val = Utils::InvalidateHTMLTags($val) if($EscapeURL and !Utils::IsIncludedInArray($val, \@SafeDecodeHTMLTags)); #print " 2: $val
\n"; return $val if(defined $val); } #print "\naa [$varname0][$varname]\n"; #起動時引数 my $args = $this->ArgArray(); # 引数が整数だけのとき:ファイル名を返す if($varname0 =~ /^\d+$/) { my $pFiles = $this->FileNameArray(); return $pFiles->[$varname0]; } # その他:オプションを返す my $val = $args->{$varname}; $val = $args->{"--$varname"} unless(defined $val); $val = $defval if($UseDefault and !defined $val); $val = Utils::InvalidateHTMLTags($val) if($EscapeURL and !Utils::IsIncludedInArray($val, \@SafeDecodeHTMLTags)); #print "get v: $varname val: $val\n"; return $val; } sub GetFileNameArray { my ($this, $varname) = @_; my $files = $this->FileNameArray(); return @$files; } #受け取る引数の文字列を追加する sub AddArgument { my ($this, $arg, $explanation, $defval) = @_; my $allowed = $this->AllowedArgs(); # $defval = '' unless(defined $defval); $allowed->{$arg} = $defval; my $expl = $this->Explanations(); $expl->{$arg} = $explanation; my $def = $this->DefaultValues(); $def->{$arg} = $defval; #if(defined $defval) { #print "def defined: a[$arg][$explanation][$defval]\n"; #} #else { #print "def not defined: a[$arg][$explanation][$defval]\n"; #} } sub Read { my ($this, $pArgs, $StopFlag, $EscapeURL) = @_; $StopFlag = 1 unless(defined $StopFlag); $EscapeURL = 1 unless(defined $EscapeURL); #print "GetArg::Read SF=$StopFlag
\n"; #my $def = $this->DefaultValues(); #print "\nGetArg::Read: initial defval=", join(', ', %$def), "\n\n"; my @args = @$pArgs; @args = @ARGV if(@args == 0); my $allowed = $this->AllowedArgs(); my $files = $this->FileNameArray(); #print "nargs=", scalar @args, "
\n"; for(my $i = 0 ; $i < @args ; $i++) { my $s = $args[$i]; my ($name, $d, $val); if( ($name, $d, $val) = ( $s =~ /^--([^=]*)(=(.*))?$/ ) ) { #print "$i: $name=$d val=$val
\n"; Utils::DelSpace($name); $val = '' unless(defined $val); Utils::DelSpace($val); $val = Utils::InvalidateHTMLTags($val) if($EscapeURL and !Utils::IsIncludedInArray($val, \@SafeDecodeHTMLTags)); #print "name: $name val: $val
\n"; if($this->CheckAllowedArgs()) { #print "Check: $name val: $val
\n"; if($name and $this->IsIncluded($name)) { #print "$i: 1 (SetArgument $name, $val)
\n"; $this->SetArgument($name, $val); next; } elsif($StopFlag) { #print "stop\n"; print "\n"; print "Error: Invalid argument: $s\n"; $this->Usage(); return -1; } } else { #print "$i: 3 (SetArgument $name, $val)
\n"; $this->SetArgument($name, $val); next; } } push(@$files, $s); } #my $def = $this->DefaultValues(); #print "GetArg::Read: final defval=", join(', ', %$def), "\n"; my $help = $this->GetGetArg("help"); #if(!defined $help) { #print "not defined: help=$help\n"; #} #else { #print "defined: help=$help\n"; #} if(defined $help) { $this->Usage(); exit 2; } #print "f\n"; return 1; } 1;