#========================================================
# 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;