#============================================================ # MyApplication #============================================================ package MyApplication; use Common; @ISA = qw(Common); use strict; use English; use File::Path; use File::Basename; use File::Find; use CGI; #use UTF8Code; use Deps; use Utils; use JFile; use IniFile; use GetArg; use Template; my $PermitDebugPrint = 1; #============================================================ # 静的関数 #============================================================ #============================================================ # 変数等取得関数 #============================================================ sub Debug { return shift->{Debug}; } sub PermitDebugPrint { return $PermitDebugPrint; } sub pParams { return shift->{pParams}; } sub GetApplication { return shift; } sub Application { return shift; } sub App { return shift; } sub SetAppName { my ($this,$p) = @_; my $Args = $this->Args(); $this->{AppName} = $p; $Args->SetAppName($p) if($Args); return $p; }sub GetDocument { return shift->{Document}; } sub Document { return shift->{Document}; } sub Doc { return shift->{Document}; } sub GetIniFile { return shift->{IniFile}; } #sub IniFile { return shift->{'IniFile'}; } sub Ini { return shift->{IniFile}; } sub Args { return shift->{Args}; } sub CGIForm { my ($this) = @_; return $this->Args()->CGIForm() if($this->Args()->CGIForm()); return $this->{CGIForm} if($this->{CGIForm}); return undef; } sub MainWindow { return shift->{MainWindow}; } sub SetMainWindow { my ($this,$mw)=@_; return shift->{MainWindow} = $mw; } sub mw { return shift->{MainWindow}; } sub SetUsage { my ($this, $p) = @_; my $Args = $this->Args(); $this->{UsageStr} = $p; $Args->SetUsage($p) if($Args); return $p; } sub Usage { return shift->Args()->Usage(); } sub InvalidParameter { return shift->Args()->InvalidParameter(@_); } sub WorkDir { return shift->{WorkDir}; } #sub SetWorkDir($path); sub SetDebug { my ($this, $f) = @_; $f = 0 if(!defined $f); if($f == 1 or $f =~ /on/i) { return $this->{Debug} = 1; } elsif($f =~ /\+/) { return $this->{Debug}++; } elsif($f =~ /-/) { return $this->{Debug}--; } } sub DoConfirm { return shift->{'DoConfirm'}; } sub PrintLevel { return shift->{'PrintLevel'}; } sub stdio { return shift->{'stdio'}; } #sub printf #sub print #sub DebugPrint sub set { my ($this, $key, $val) = @_; return $this->{$key} = $val; } sub get { my ($this, $key, $defval) = @_; return $this->{$key} if(defined $this->{$key}); return $defval; } #sub GetGetArg #sub ReadSetting { return shift->App()->ReadSetting(); } #sub SaveSetting { return shift->App()->SaveSetting(); } sub RegLF { return shift->{RegLF}; } sub LF { return shift->{LF}; } sub SetLF { my ($this, $LF) = @_; $this->{'LF'} = $LF; $this->{'RegLF'} = Utils::RegExpQuote($LF); return $LF; } sub Space { return shift->{Space}; } sub SetSpace { my ($this, $Space) = @_; $this->{'Space'} = $Space; $this->{'RegSpace'} = Utils::RegExpQuote($Space); return $Space; } sub DirectorySeparator { return shift->{'DirectorySeparator'}; } sub OS { return shift->{'OS'}; } sub AppName { return shift->{AppName}; } sub Program { return shift->{Program}; } sub SetProgram { my ($this,$p) = @_; return $this->{Program} = $p; } sub ProgramPath { return shift->{ProgramPath}; } sub SetProgramPath { my ($this,$p) = @_; return $this->{ProgramPath} = $p; } sub ProgramName { my ($this) = @_; return $this->{ProgramName}; } sub SetProgramName { my ($this,$p) = @_; return $this->{ProgramName} = $p; } sub Version { return shift->{Version}; } sub SetVersion { my ($this,$p) = @_; return $this->{'Version'} = $p; } sub AppTitle { return shift->{Title}; } sub GetTitle { return shift->{Title}; } sub Title { return shift->{Title}; } sub SetTitle { my ($this,$p) = @_; return $this->{'Title'} = $p; } sub SetPrintCharCode { my ($this, $c) = @_; $this->{PrintCharCode} = $c; if($this->{stdio}) { $this->{stdio}->Close(); delete $this->{stdio}; } $this->{stdio} = new JFile; unless( $this->{stdio}->Open("con", "rw", $this->{PrintCharCode} ) ) { print "Can not open STDIN/STDOUT.\n"; return -1; } return $c; } sub ConversionMode { my ($this) = @_; return $this->{ConversionMode}; } sub SetConversionMode { my ($this, $mode) = @_; return $this->ConversionMode() if($mode eq ''); if($mode eq 'none') { $this->{stdio}->SetSuppressCharCodeConversion(1); } else { $this->{stdio}->SetSuppressCharCodeConversion(0); } my $prev = $this->{ConversionMode}; $this->{ConversionMode} = $mode; return $prev; } sub FileSystemCharCode { return shift->{FileSystemCharCode}; } sub PrintCharCode { return shift->{PrintCharCode}; } sub PerlCharCode { return shift->{PerlCharCode}; } sub SQLCharCode { return shift->{SQLCharCode}; } sub OSCharCode { return shift->{'OSCharCode'}; } sub SetOSCharCode { my($this,$c)=@_; return $this->{'OSCharCode'}=$c; } sub ProgramCharCode { return shift->{'ProgramCharCode'}; } sub FileCharCode { return shift->{'FileCharCode'}; } sub WebCharCode { return shift->{WebCharCode}; } #sub WebCharSet { return shift->{WebCharSet}; } sub WebCharSet { my ($App) = @_; #print "C2: ", $App->{WebCharSet}, "
\n"; $App->{WebCharSet} = "iso-8859-1" if(!defined $App->{'WebCharSet'}); return $App->{'WebCharSet'}; } sub SetProgramCharCode { my($this,$c)=@_; return $this->{'ProrgramCharCode'}=$c; } sub SetPerlCharCode { my($this,$c)=@_; return $this->{'PerlCharCode'}=$c; } sub SetFileSystemCharCode { my($this,$c)=@_; return $this->{'FileSystemCharCode'}=$c; } sub SetFileCharCode { my($this,$c)=@_; return $this->{'FileCharCode'}=$c; } sub SetSQLCharCode { my($this,$c)=@_; return $this->{'SQLCharCode'}=$c; } sub SetWebCharCode { my ($this, $c) = @_; $this->{'WebCharCode'} = $c; $this->SetWebCharSet(GetWebCharSetByCharCode($c)); return $this->{'WebCharCode'}; } sub SetWebCharSet { my ($this, $c) = @_; return $this->{WebCharSet} = $c; } sub GetWebCharSetByCharCode { my ($WebCharCode) = @_; return "iso-2022-jp" if($WebCharCode =~ /^jis$/i); return "euc-jp" if($WebCharCode =~ /^euc$/i); return "iso-8859-1" if($WebCharCode =~ /^en$/i); return "x-$WebCharCode"; } sub GetWebCharSet { my ($Language, $WebCharCode) = @_; $Language = '' if(!defined $Language); $WebCharCode = '' if(!defined $WebCharCode); return "iso-8859-1" if($Language =~ /English/i); return "iso-2022-jp" if($WebCharCode =~ /^jis$/i); return "euc-jp" if($WebCharCode =~ /^euc$/i); return "iso-8859-1" if($WebCharCode =~ /^en$/i); return "x-$WebCharCode"; } sub CSVCharCode { return shift->{CSVCharCode}; } sub SetCSVCharCode { my ($this, $c) = @_; return $this->{CSVCharCode} = $c; } #============================================================ # コンストラクタ、デストラクタ #============================================================ BEGIN { } sub new { my ($module, $app) = @_; my $this = {}; bless $this; $this->{IniFileVariables} = {}; $this->{IniFileDefaultVariables} = {}; $this->SetLanguage('Japanese'); $this->SetOutputMode('console'); return $this; } sub DESTROY { my $this = shift; $this->SaveSetting(); if($this->{pOUTJFile}) { $this->{pOUTJFile}->Close(); } if($this->{pINJFile}) { $this->{pINJFile}->Close(); } # $this->SUPER::DESTROY(@_); } #============================================================ # 継承クラスで定義しなおす関数 #============================================================ #============================================================ # 一般関数 #============================================================ sub convert { my ($this, $pStr, $targetcharcode, $sourcecharcode) = @_; return $$pStr if($this->{ConversionMode} eq 'none'); Utils::convert($pStr, $targetcharcode, $sourcecharcode); } sub UpdateParams { my ($this, $pParams) = @_; return $pParams; } sub BuildParameterHash { my ($this) = @_; return $this->{pParams} if($this->{pParams}); return $this->{pParams} = {}; } sub Initialize { my ($this) = @_; my $pParams = $this->BuildParameterHash(); #=============================================== # デバッグ関係変数 #=============================================== $this->{'Debug'} = 0; $this->{'DoConfirm'} = 0; #$PrintLevelが大きいほど、情報が詳しくなる $this->{'PrintLevel'} = 0; #出力先: console, HTML $this->{'OutputMode'} = 'console'; #=============================================== # 文字コード関係変数 #=============================================== # sjis, euc, jis, noconv, utf8 $this->{'OSCharCode'} = Deps::OSCharCode(); $this->{'PrintCharCode'} = Deps::OSCharCode(); $this->{'FileSystemCharCode'} = Deps::FileSystemCharCode(); $this->{'FileCharCode'} = Deps::FileCharCode(); $this->{'PerlCharCode'} = Deps::PerlCharCode(); $this->{'MySQLCharCode'} = Deps::MySQLCharCode(); $this->{'WebCharCode'} = Deps::WebCharCode(); $this->{'WebCharSet'} = Deps::WebCharSet(); $this->{stdio} = new JFile; unless( $this->{stdio}->Open("con", "rw", $this->{PrintCharCode} ) ) { print "Can not open STDIN/STDOUT.\n"; return -1; } #=============================================== # スクリプト大域変数 #=============================================== $this->SetLF(Deps::LF()); $this->{DirectorySeparator} = Deps::DirectorySeparator(); $this->{OS} = Deps::OS(); $this->{Program} = basename($0); #=============================================== # プログラム実行情報 #=============================================== # $this->{StartTime} = time(); $this->{StartTime} = $BASETIME; $this->{StartDate} = Utils::BuildDateString($this->{StartTime}); $this->{RemoteIPAddress} = $ENV{REMOTE_ADDR}; #Utils::InitHTML(); #print "IP: $this->{IPAddress}
\n"; return 1; } sub CreateWindow { my ($this, $MainWindow, $icon) = @_; $icon = 'widget' unless($icon); $this->SetMainWindow($MainWindow); $MainWindow->SetApplication($this); $MainWindow->SetIcon($icon); $MainWindow->CreateMenu(); $MainWindow->CreateWidgets(); $MainWindow->ModifyMenu(); return $MainWindow; } sub MainLoop { my ($this) = @_; Tk::MainLoop(); } #=============================================== # Application固有共通関数 #=============================================== sub StartTime { return shift->{'StartTime'}; } sub StartDate { return shift->{'StartDate'}; } sub RemoteIPAddress { my ($this) = @_; my $ip = $this->{RemoteIPAddress}; $ip = '127.0.0.1' if($ip eq '::1'); return $ip; } sub SetCGIForm { my ($this, $form) = @_; return $this->{CGIForm} if(!defined $form and $this->{CGIForm}); $form = new CGI if(!defined $form); return $this->{CGIForm} = $form; } sub AddArgument { my ($this, $arg, $explanation, $defval) = @_; #if(!defined $defval) { #print "def not defined: $arg, $explanation, $defval\n"; #} #else { #print "def defined: $arg, $explanation, $defval\n"; #} $this->{'Args'} = new GetArg($this) unless($this->{'Args'}); my $Args = $this->{'Args'}; $Args->AddArgument($arg, $explanation, $defval); } sub GetFileNameArray { my ($this) = @_; my $Args = $this->{'Args'}; my $files = $Args->FileNameArray(); return @$files; } sub GetArgFileName { my ($this, $idx) = @_; my $Args = $this->{'Args'}; my $files = $Args->FileNameArray(); return $files->[$idx]; } sub GetArgHash { my ($this, $UseDefault) = @_; my $Args = $this->{'Args'}; return $Args->GetArgHash($UseDefault); } sub ArgKeys { my ($this) = @_; my $Args = $this->{'Args'}; return $Args->ArgKeys(); } sub SetDefault { my ($this, $UseArgOnly, $EscapeURL) = @_; my $Args = $this->{'Args'}; return $Args->SetDefault(@_); } sub AddVars { my ($this, %hash) = @_; my $Args = $this->{'Args'}; foreach my $key (keys %hash) { $Args->AddVar($key, $hash{$key}); } } sub AddVar { my ($this, $key, $val) = @_; my $Args = $this->{'Args'}; return $Args->AddVar($key, $val); } sub var { my ($this, $key) = @_; my $Args = $this->{'Args'}; return $Args->var($key); } sub PrintArgs { my ($this, $format, $pargs) = @_; my $Args = $this->{'Args'}; return $Args->PrintArgs($format, $pargs); } sub GetGetArg { my ($this, $key, $defvalue, $StopFlag, $UseDefault) = @_; #print "MyApplication:GetGetArg: $key, $defvalue, $StopFlag\n"; $this->{'Args'} = new GetArg($this, $StopFlag) unless($this->{'Args'}); return undef unless(defined $key); # $keyが整数の場合、FileName引数を返す if($key =~ /^\d+$/) { my $str = $this->GetArgFileName($key); return $str if(defined $str); } # コマンドライン引数をチェック my $Args = $this->{'Args'}; my $str = $Args->GetGetArg($key, $UseDefault); #print "str=$str\n"; return $str if(defined $str); # $form引数をチェック my $CGIForm = $this->CGIForm(); #print "CGIForm=$CGIForm\n"; if($CGIForm) { $str = $this->CGIForm()->param($key); return $str if(defined $str); } return $defvalue; } sub ReadArgs { my ($this, $StopFlag, $WebCharCode, $CheckAllowedArgs) = @_; $CheckAllowedArgs = 1 if(!defined $CheckAllowedArgs); #Utils::InitHTML(); #print "

aaa

\n"; #print "t: $this\n"; $this->{Args} = new GetArg($this) unless($this->{Args}); my $Args = $this->{Args}; $Args->SetApplication($this); $Args->SetCheckAllowedArgs($CheckAllowedArgs); #print "A: $Args
\n"; my $ret = $Args->Read(\@ARGV, $StopFlag); #print "a\n"; #CGIであれば読み込む my $IsCGI = Utils::IsCGI(); #print "IsCGI=$IsCGI pIn=$this->{pIn}
\n"; if($IsCGI) { $this->Args()->SetCGIForm(new CGI) if(!$this->Args()->{CGIForm}); $this->Args()->parseInput($WebCharCode); } #print "IsCGI=$IsCGI pIn=$this->{pIn}
\n"; return $ret; } sub AddIniFileVariable { my ($this, $KeyTree, $VarName, $DefVal) = @_; return unless($VarName); my ($section, $key) = ($KeyTree =~ /^\\(.+?)\\(.*)$/); return unless($section); $DefVal = '' unless($DefVal); #print "Set: $KeyTree: $VarName: $DefVal\n"; my $pHash = $this->{'IniFileVariables'}; $this->{'IniFileVariables'} = $pHash = {} if(!defined $pHash); $pHash->{$KeyTree} = $VarName; my $pDefHash = $this->{'IniFileDefaultVariables'}; $this->{'IniFileDefaultVariables'} = $pDefHash = {} if(!defined $pDefHash); $pDefHash->{$KeyTree} = $DefVal; } sub ReadSetting { my ($this, $IsPrint) = @_; $IsPrint = 0 if(!defined $IsPrint); my $IniFile = $this->{IniFile}; unless($IniFile) { $this->print("Error: Can not get IniFile class.\n") if($IsPrint); return; } my $pHash = $this->{IniFileVariables}; unless($pHash) { $this->print("Error: Can not get IniFile::IniFileVariables.\n") if($IsPrint); return; } my $pDefHash = $this->{IniFileDefaultVariables}; unless($pDefHash) { $this->print("Error: Can not get IniFile::IniFileDefaultVariables.\n") if($IsPrint); return; } return unless($pHash); foreach my $KeyTree (keys %$pHash) { my $AppKey = $pHash->{$KeyTree}; my $DefVal = $pDefHash->{$KeyTree}; next unless($AppKey); my ($section, $key) = ($KeyTree =~ /^\\(.+?)\\(.*)$/); next unless($section); #print "kin: $AppKey: $section: $key: $DefVal
\n"; my $val = $IniFile->GetString($section, $key, $DefVal); ##print "$KeyTree: $AppKey: $DefVal: $val\n"; # $val = '' unless(defined $val); #print "Set $val to $AppKey
\n"; $this->{$AppKey} = $val; } return 1; } sub SaveSetting { my ($this) = @_; my $IniFile = $this->{'IniFile'}; return unless($IniFile); my $pHash = $this->{'IniFileVariables'}; return unless($pHash); foreach my $KeyTree (keys %$pHash) { my $AppKey = $pHash->{$KeyTree}; next unless($AppKey); my ($section, $key) = ($KeyTree =~ /^\\(.+?)\\(.*)$/); next unless($section); my $val = $this->{$AppKey}; next unless(defined $val); #print "kout: $AppKey: $section: $key: $val [ini=$IniFile]
\n"; $IniFile->WriteString($section, $key, $val); #print "Save $val to $section \\ $key
\n"; } return 1; } sub OpenIniFile { my ($this, $ProgramPath, $CreateIniFile) = @_; my $ret = $this->{'IniFile'} = new IniFile($ProgramPath, $CreateIniFile); return $ret; } sub ConnectDocument { my ($this, $doc) = @_; $this->{'Document'} = $doc; } sub SpeculateProgramPath { my ($this, $path, $BaseDir) = @_; my $ProgramPath = Deps::SpeculateProgramPath($path, $BaseDir); my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($ProgramPath); $this->SetProgramName($filename); return $this->SetProgramPath($ProgramPath); } sub SetWorkDir { my ($this, $path) = @_; return $this->{'WorkDir'} = $path if(-d $path); my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($path); return $this->{'WorkDir'} = Deps::MakePath($drive, $directory); } sub GetOutputMode { return shift->{OutputMode}; }; sub SetOutputMode { my ($this, $mode, $infile, $outfile) = @_; $mode = "console" if(!defined $mode or $mode eq '' or $mode =~ /con/i); if($this->{pINBuffer}) { delete $this->{pINBuffer}; } if($this->{pOUTBuffer}) { delete $this->{pOUTBuffer}; } if($this->{pINJFile}) { $this->{pINJFile}->Close(); delete $this->{pINJFile}; } if($this->{pOUTJFile}) { $this->{pOUTJFile}->Close(); delete $this->{pOUTJFile}; } if($mode =~ /auto/i) { if(Utils::IsCGI()) { $mode = 'HTML'; } else { $mode = 'console'; } } if($mode =~ /HTML/i) { binmode(STDOUT); binmode(STDERR); $this->{DeleteHTMLFlag} = 0; } else { $this->{DeleteHTMLFlag} = 0; # $this->{DeleteHTMLFlag} = 1; } if($mode =~ /WriteBuffer/) { my $s = ''; $this->{pOUTBuffer} = \$s; } if($mode =~ /ReadBuffer/) { my $s = ''; $this->{pINBuffer} = \$s; } if($mode =~ /WriteFile/) { $this->{pOUTJFile} = new JFile; my $wmode = ($mode =~ /HTML/i)? "wb" : "w"; if(!$this->{pOUTJFile}->Open($outfile, $wmode)) { $this->H3("Error in SetOutputMode: [$outfile] could not be opened for mode=[$mode]."); delete $this->{pOUTJFile}; $mode =~ s/WriteFile//; return undef; } } if($mode =~ /ReadFile/) { $this->{pINJFile} = new JFile; my $rmode = ($mode =~ /HTML/i)? "rb" : "r"; if(!$this->{pOUTJFile}->Open($outfile, $rmode)) { $this->H3("Error in SetOutputMode: [$infile] could not be opened for mode=[$mode]."); delete $this->{pINJFile}; $mode =~ s/ReadFile//; return undef; } } #print "p=$this->{pOUTJFile} [$mode, $outfile]\n"; #exit if($mode =~ /Write/); return $this->{OutputMode} = $mode; } sub OutputMode { return shift->{OutputMode}; } sub GetpBuffer { my ($this)=@_; return $this->{pOUTBuffer}; } sub GetBuffer { my ($this, $ClearBuffer) = @_; #print "b: $this->{pOUTBuffer}: ", ${$this->{pOUTBuffer}}, "
\n"; my $s = (defined $this->{pOUTBuffer})? ${$this->{pOUTBuffer}} : ''; $this->ClearBuffer() if($ClearBuffer); return $s; } sub SetBuffer { my ($this, $pbuffer) = @_; $this->{pOUTBuffer} = $pbuffer; } sub ClearBuffer { my ($this) = @_; if($this->{pOUTBuffer}) { ${$this->{pOUTBuffer}} = ''; } return $this->GetpBuffer(); } sub PrintBuffer { my ($this, $ClearBuffer) = @_; return if(!defined $this->{pOUTBuffer}); $ClearBuffer = 1 if(!defined $ClearBuffer); print ${$this->{pOUTBuffer}}; ${$this->{pOUTBuffer}} = '' if($ClearBuffer); } sub MergeStrings { my ($this, @s) = @_; my $s = ''; for(my $i = 0 ; $i < @s ; $i++) { $s .= $s[$i]; } return $s; } sub PrintError { my ($this, @args) = @_; if($this->OutputMode() =~ /HTML/i) { return $this->PrintRawHTML("", @args, ""); } else { #if($this->{OutputMode} eq 'console') { return $this->print2(0, @args); } } sub DeleteHTMLFlag { return shift->{DeleteHTMLFlag}; } sub SetDeleteHTMLFlag { my ($this,$f)=@_; return shift->{DeleteHTMLFlag} = $f;} sub SetHTMLVersion { my ($this, $ver) = @_; return $this->{HTMLVersion} = $ver; } sub SetDOCTYPE { my ($this, $key) = @_; return $this->{DOCTYPEKey} = $key; } sub InitHTML5 { my ($this, $s, $WebCharSet, $CSS, $PrintHTMLHeader, $LinkTarget, %args) = @_; #HTML5では frame仕様は削除された undef $this->{pFrameModeHash}; $args{pOUTBuffer} = $this->{pOUTBuffer} if(defined $this->{pOUTBuffer}); $args{pOUTJFile} = $this->{pOUTJFile} if(defined $this->{pOUTJFile}); $this->{WebCharCode} = 'utf8' if($this->{WebCharCode} =~ /utf-8/i); Jcode::convert(\$s, $this->{WebCharCode}); Utils::InitHTML5($s, $WebCharSet, $LinkTarget, $CSS, $PrintHTMLHeader, BGColor => $this->BGColor(), DOCTYPEKey => $this->{DOCTYPEKey}, %args); $this->{HTMLInitialized} = 1; } sub InitHTML { my ($this, $s, $WebCharSet, $CSS, $PrintHTMLHeader, %args) = @_; my $LinkTarget; if($WebCharSet =~ /^_/) { $LinkTarget = $WebCharSet; $WebCharSet = $this->WebCharSet(); } if(!defined $CSS or $CSS =~ /^_/) { ($this, $s, $WebCharSet, $LinkTarget, $CSS, $PrintHTMLHeader, %args) = @_; } return $this->InitHTML5($s, $WebCharSet, $CSS, $PrintHTMLHeader, $LinkTarget, %args) if($this->OutputMode() =~ /HTML/i and $this->{HTMLInitialized} != 1 and $this->{HTMLVersion} >= 5.0); #$this->print("BG: ", $this->BGColor(), "\n"); if($this->OutputMode() =~ /HTML/i and $this->{HTMLInitialized} != 1) { if($this->{pFrameModeHash}) { my $pHash = $this->{pFrameModeHash}; $this->InitHTMLFramePage($WebCharSet, $PrintHTMLHeader, $pHash, DOCTYPEKey => $this->{DOCTYPEKey}); return; } $args{pOUTBuffer} = $this->{pOUTBuffer} if(defined $this->{pOUTBuffer}); $args{pOUTJFile} = $this->{pOUTJFile} if(defined $this->{pOUTJFile}); $this->{WebCharCode} = 'utf8' if($this->{WebCharCode} =~ /utf-8/i); Jcode::convert(\$s, $this->{WebCharCode}); Utils::InitHTML($s, $WebCharSet, $LinkTarget, $CSS, $PrintHTMLHeader, BGColor => $this->BGColor(), DOCTYPEKey => $this->{DOCTYPEKey}, %args); $this->{HTMLInitialized} = 1; #foreach my $key (keys %args) { # print "$key: $args{$key}
\n"; #} } #print "CSS: $WebCharSet, $CSS, $PrintHTMLHeader, ", join('=>', %args), "
\n"; } sub EndHTML { my ($this, $s, $WebCharSet) = @_; if($this->OutputMode() =~ /HTML/i) { if($this->{pFrameModeHash}) { } else { Utils::EndHTML($this->{pOUTJFile}, $this->{pOUTBuffer}); } $this->{'HTMLInitialized'} = 0; } } sub BGColor { return shift->{BGColor}; } sub SetBGColor { my ($this, $bg) = @_; return $this->{BGColor} = $bg; } sub PrintWithHTMLTag { my ($this, $tag, @s) = @_; if($this->OutputMode =~ /HTML/i) { for(my $i = 0 ; $i < @s ; $i++) { my $s = $s[$i]; $s = Utils::ConvertToHTMLString($s); $this->PrintRawHTML("<$tag>$s\n"); } } else { $this->print(@s); } } #sub PrintWithHTMLTag #{ # my ($this, @args) = @_; # return $this->print2(0, @args); #} sub PrintRawHTML { my ($this, @args) = @_; if($this->OutputMode() =~ /HTML/i and $this->{HTMLInitialized} != 1) { $this->print(""); $this->{HTMLInitialized} = 1; } my $mode = $this->{OutputMode}; $this->{OutputMode} = ""; $this->print2(0, @args); $this->{OutputMode} = $mode; } sub italic { my ($this, @s) = @_; $this->PrintWithHTMLTag('i', $this->MergeStrings(@s)); } sub bold { my ($this, @s) = @_; $this->PrintWithHTMLTag('b', $this->MergeStrings(@s)); } sub ClearFloat { my ($this, @s) = @_; # $this->PrintRawHTML("
\n"); $this->PrintRawHTML("\n"); } sub H1 { my ($this, @s) = @_; $this->PrintWithHTMLTag('H1', $this->MergeStrings(@s)); } sub H2 { my ($this, @s) = @_; $this->PrintWithHTMLTag('H2', $this->MergeStrings(@s)); } sub H3 { my ($this, @s) = @_; $this->PrintWithHTMLTag('H3', $this->MergeStrings(@s)); } sub H4 { my ($this, @s) = @_; $this->PrintWithHTMLTag('H4', $this->MergeStrings(@s)); } sub H5 { my ($this, @s) = @_; $this->PrintWithHTMLTag('H5', $this->MergeStrings(@s)); } sub H6 { my ($this, @s) = @_; $this->PrintWithHTMLTag('H6', $this->MergeStrings(@s)); } sub P { my ($this, @s) = @_; $this->PrintWithHTMLTag('P', $this->MergeStrings(@s)); } sub BR { my ($this, @s) = @_; my $s = $this->MergeStrings(@s); $s = '' if(!defined $s); if($this->OutputMode =~ /HTML/i) { $s = Utils::ConvertToHTMLString($s); $this->PrintRawHTML($s); $this->PrintRawHTML("
\n"); } else { $this->print($s); } return ""; } sub HR { my ($this) = @_; if($this->OutputMode =~ /HTML/i) { $this->PrintRawHTML("
\n"); } return ""; } sub print { my ($this, @args) = @_; if($this->{OutputMode} eq 'console') { return $this->print2(0, @args); } else { if($this->OutputMode() =~ /HTML/i and $this->{HTMLInitialized} != 1) { $this->{PrintHeader} = 1 if(!defined $this->{PrintHeader}); $this->InitHTML($this->{Title}, $this->{WebCharSet}, $this->{LinkTarget}, $this->{CSS}, $this->{PrintHeader}, BGColor => $this->{BGColor}, pHeaderFiles => $this->{pHeaderFiles}); $this->{'HTMLInitialized'} = 1; } #print("pHeaderFiles= $this->{pHeaderFiles}
\n"); return $this->print2(1, @args); } } sub print2 { my ($this, $ConvertHTML, @args) = @_; my $RegLF = $this->{RegLF}; if($ConvertHTML and $RegLF and $RegLF ne '\n') { for(my $i = 0 ; $i < @args ; $i++) { $args[$i] =~ s/\n/$RegLF/g; } } if($ConvertHTML and $this->{OutputMode} =~ /HTML/i) { for(my $i = 0 ; $i < @args ; $i++) { $args[$i] = Utils::ConvertToHTMLString($args[$i]); } } if($this->{RegSpace} and $this->{RegSpace} ne ' ') { my $sp = $this->{RegSpace}; for(my $i = 0 ; $i < @args ; $i++) { $args[$i] =~ s/\t/$sp$sp$sp$sp/g; $args[$i] =~ s/ /$sp/g; } } if($this->{DeleteHTMLFlag}) { for(my $i = 0 ; $i < @args ; $i++) { $args[$i] =~ s/\<[^\<\>]+?\>//g; Utils::InvalidateHTMLTags($args[$i]); } } # if(defined $this->{'PrintCharCode'}) { # for(my $i = 0 ; $i < @args ; $i++) { # Jcode::convert(\($args[$i]), $this->{'PrintCharCode'}); # } # } if($this->{pOUTJFile}) { return $this->{pOUTJFile}->print(@args); } elsif($this->{pOUTBuffer}) { return ${$this->{pOUTBuffer}} .= join('', @args); } return $this->{stdio}->print(@args) if($this->{stdio}); return print(@args); } sub printf { my ($this, $format, @args) = @_; my $s = sprintf($format, @args); return $this->print($s); ($this, @args) = @_; my $RegLF = $this->{RegLF}; #$this->print("print: $RegLF\n"); if($RegLF and $RegLF ne '\n') { for(my $i = 0 ; $i < @args ; $i++) { $args[$i] =~ s/\n/$RegLF/g; } } if($this->{RegSpace} and $this->{RegSpace} ne ' ') { my $sp = $this->{'RegSpace'}; for(my $i = 0 ; $i < @args ; $i++) { $args[$i] =~ s/\t/$sp$sp$sp$sp/g; $args[$i] =~ s/ /$sp/g; } } if($this->{DeleteHTMLFlag}) { for(my $i = 0 ; $i < @args ; $i++) { $args[$i] =~ s/\<[^\<\>]+?\>//g; Utils::InvalidateHTMLTags($args[$i]); } } # if(defined $this->{'PrintCharCode'}) { # for(my $i = 0 ; $i < @args ; $i++) { # Jcode::convert(\($args[$i]), $this->{'PrintCharCode'}); # } # } return $this->{stdio}->printf(@args) if($this->{stdio}); return printf(@args); } sub DebugPrint { my ($this, @args) = @_; return if(!$PermitDebugPrint); return $this->print(@args) if($this->{'Debug'}); return ''; } #============================================================ # 初期化ファイルの設定 #============================================================ sub ConfigureIniFileVariables { my ($this) = @_; # my $Args = $this->Args(); # $App->AddIniFileVariable("\\Preferences\\EditorPath", "EditorPath", "notepad.exe"); # $App->ReadSetting(); return 1; } #======================================================== # 言語設定関係 #======================================================== sub SetLanguage { my ($App, $l) = @_; $App->{Language} = 'English' if(!defined $App->{Language}); return $App->{Language} if(!defined $l or $l eq ''); $App->{Language} = $l; $App->Args()->{Language} = $l if(defined $App->Args()); $App->SetWebCharSet(GetWebCharSet($l, $App->WebCharCode())); return $App->{Language} = $l; } sub Language { my ($App) = @_; $App->{Language} = 'English' if(!defined $App->{Language} or $App->{Language} eq ''); return $App->{Language}; } sub LanguageCode { my ($App) = @_; my %code = ( 'English', 'en', 'Japanese', 'jp', 'Korean', 'kr', 'Chinese', 'cn', 'Germany', 'de', 'French', 'fr', ); my $l = $App->Language(); my $c = $code{$l}; return 'Invalid Language' if(!defined $c or $c eq ''); return $c; } sub PrintWithReplaced { my ($App, $file, $target, @array) = @_; my $charcode = $App->PrintCharCode(); for(my $i = 0 ; $i < @array ; $i++) { Jcode::convert(\($array[$i]), $charcode); } return Utils::PrintWithReplaced($file, $target, @array); } sub PrintWithReplacedForHTML { my ($App, $file, $target, @array) = @_; my $charcode = $App->PrintCharCode(); for(my $i = 0 ; $i < @array ; $i++) { Jcode::convert(\($array[$i]), $charcode); } return Utils::PrintWithReplaced($file, $target, @array); } sub BuildDateString { my ($App, $d) = @_; return Utils::BuildDateString($d, $App->Language()); } sub CheckBlankString { my ($this, $s, @messages) = @_; return 1 if(defined $s and $s ne ''); if(@messages > 2) { my $lang = $this->{Language}; for(my $i = 0 ; $i < @messages ; $i += 2) { if($lang eq $messages[$i]) { $this->H2($messages[$i+1]); return 0; } } } else { $this->H2($messages[0]); } return 0; } #======================================================== # その他 #======================================================== sub GetFileContent { my ($App, $pParams, $infile) = @_; my $in = new JFile($infile, "r"); return '' if(!$in); my $content = ''; while(!$in->eof()) { $content .= $in->ReadLine(); } $in->Close(); return $content; } sub ConvertToTextFile { my ($App, $pParams, $SourcePath, $Overwrite, $pdftoext) = @_; return '' if($SourcePath !~ /\.pdf$/i); $Overwrite = 0 if(!defined $Overwrite); $pdftoext = $pParams->{pdftotext} if(!defined $pdftoext); my $TextPath = Deps::ReplaceExtension($SourcePath, ".txt"); if(-e $TextPath and !$Overwrite) { my $Content = $App->GetFileContent($pParams, $TextPath); return ($TextPath, $Content); } $App->print("Convert [$SourcePath] to [$TextPath]\n"); $SourcePath =~ s/\//\\/g if($^O eq 'MSWin32'); my $cmd = "$pdftoext \"$SourcePath\" \"$TextPath\""; #$App->print(" cmd: [$cmd]\n"); system($cmd); return ('', undef) if(!-e $TextPath); #print "a2 [$App]
"; my $Content = $App->GetFileContent($pParams, $TextPath); #$App->print("C: $Content\n"); $Content = $App->MakeHankakuFile($pParams, $TextPath, $Content); return ($TextPath, $Content) if(-e $TextPath); return ('', undef); } sub MakeHankakuFile { my ($App, $pParams, $outfile, $Content) = @_; use UTF8Code; my $ret = UTF8Code::MakeHankakuFile($App, $outfile, $Content); no UTF8Code; return $ret; } sub CollectDirs { my ($App, $pParams, $dir, $pfmasks) = @_; $pfmasks = ["*"] if(!defined $pfmasks); my @dirs; my %dirs; for(my $i = 0 ; $i < @$pfmasks ; $i++) { my $path = Utils::MakePath($dir, $pfmasks->[$i], '/', 0); my @f = sort glob($path); for(my $j = 0 ; $j < @f ; $j++) { if(!$dirs{$f[$j]}) { push(@dirs, $f[$j]) if(-d $f[$j]); $dirs{$f[$j]}++; } } } return @dirs; } sub ReadDirsToHash { my ($App, $pParams, $pDirs, $func) = @_; my @Infs; for(my $i = 0 ; $i < @$pDirs ; $i++) { my $pHash = &$func($pDirs->[$i]); $Infs[$i] = $pHash; } return @Infs; } sub IsExcludedFolder { my ($App, $pParams, $dir, $pExcludeDirs, $ScriptCharCode, $FileSystemCharCode) = @_; return 0 if(!defined $pExcludeDirs); my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($dir); for(my $i = 0 ; $i < @$pExcludeDirs ; $i++) { my $d = $pExcludeDirs->[$i]; Jcode::convert(\$d, $FileSystemCharCode, $ScriptCharCode) if($FileSystemCharCode ne '' and $ScriptCharCode ne ''); return 1 if($filename =~ /$d/i); } return 0; } sub GetFileList { my ($App, $pParams, $path, $SortByDir, $SearchHiddenFiles) = @_; $SortByDir = 1 if(!defined $SortByDir); $SearchHiddenFiles = 1 if(!defined $SearchHiddenFiles); $path =~ s/\\/\//g; my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($path); $directory = "$drive$directory"; $directory =~ s/\\/\//g; #$App->print("dir[$directory] f[$filename]\n"); my @f = Utils::Glob($directory, $filename); if($SearchHiddenFiles) { my @f2 = Utils::Glob($directory, '.*'); foreach my $f (@f2) { Utils::DelSpace($f); next if($f eq ''); push(@f, $f); #$App->print("fff[$f]\n"); } } return @f if(!$SortByDir); my @files; for(my $i = 0 ; $i < @f ; $i++) { next if(!-d $f[$i] or $f[$i] eq '.' or $f[$i] eq '..'); push(@files, $f[$i]); #print "f[$f[$i]]
\n"; #$App->print("fff[$f[$i]]\n"); } for(my $i = 0 ; $i < @f ; $i++) { next if(-d $f[$i] or $f[$i] eq '.' or $f[$i] eq '..'); push(@files, $f[$i]); #$App->print("ffd[$f[$i]]\n"); } return @files; } sub SearchDirectory { my ($App, $pParams, $keyword, $dir, $CallBack, $CurrentLevel, $MaxLevel, $pExculdedDirs, $ScriptCharCode, $FileSystemCharCode) = @_; &$CallBack($App, "EnterDir", 0, undef, $dir, undef) if($CallBack); $CurrentLevel++; #$App->H3("levels: $CurrentLevel, $MaxLevel (key: $keyword)\n"); if($MaxLevel > 0 and $CurrentLevel > $MaxLevel) { &$CallBack($App, "ExitDir", undef, undef, $dir, undef) if($CallBack); return; } my @files = Utils::Glob($dir, '*'); @files = $App->FileSortBy($pParams->{FileSortBy}, \@files); my $ukeyword = $keyword; Jcode::convert(\$ukeyword, 'utf8'); $ukeyword = Utils::RegExpQuote($ukeyword); my $count = 0; for(my $i = 0 ; $i < @files ; $i++) { my $f = $files[$i]; #$App->print("f: [$f][$keyword]\n"); my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($f); if(-d $f) { next if($App->IsExcludedFolder($pParams, $f, $pExculdedDirs, $ScriptCharCode, $FileSystemCharCode)); $App->SearchDirectory($pParams, $keyword, $f, $CallBack, $CurrentLevel, $MaxLevel, $pExculdedDirs); next; } my $ufilename = $filename; Jcode::convert(\$ufilename, 'utf8'); if($keyword eq '' or $ufilename =~ /$ukeyword/i) { if($count == 0) { # $App->PrintRawHTML("$dir
\n"); } &$CallBack($App, "HitFile", $count, $f, $dir, $filename) if($CallBack); $count++; } else { &$CallBack($App, "NotHitFile", $count, $f, $dir, $filename) if($CallBack); } } &$CallBack($App, "ExitDir", $count, undef, $dir, undef) if($CallBack); } sub FileSortBy { my ($App, $FileSortBy, $pFiles) = @_; if($FileSortBy eq 'FileName') { return sort @$pFiles; } elsif($FileSortBy eq 'FileName:dec') { return sort { $b <=> $a } @$pFiles; } elsif($FileSortBy eq 'FileSize') { return sort { my $at = Utils::GetFileSize($a); my $bt = Utils::GetFileSize($b); return $bt <=> $at; } @$pFiles; } elsif($FileSortBy eq 'FileSize:dec') { return sort { my $at = Utils::GetFileSize($a); my $bt = Utils::GetFileSize($b); return $at <=> $bt; } @$pFiles; } elsif($FileSortBy eq 'WriteDate') { return sort { my $at = Utils::GetWriteDate($a); my $bt = Utils::GetWriteDate($b); return $at <=> $bt; } @$pFiles; } # elsif($FileSortBy eq 'WriteDate:dec') { else { return sort { my $at = Utils::GetWriteDate($a); my $bt = Utils::GetWriteDate($b); return $bt <=> $at; } @$pFiles; } return @$pFiles; } sub BrowseDirectory { my ($App, $pParams, $path, $RootDir) = @_; if(ref $path eq 'HASH') { my $a; ($a, $App, $pParams) = @_; $path = ($pParams->{Path} =~ /%/)? Utils::URLDecode($pParams->{Path}) : $pParams->{Path}; $RootDir = ($pParams->{RootDir} =~ /%/)? Utils::URLDecode($pParams->{RootDir}) : $pParams->{RootDir}; } #$App->print("P[$path]\n"); if($RootDir eq '') { my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($path); $RootDir = "$drive$directory"; } my $code = Jcode::getcode($path); $RootDir = $path if(!defined $RootDir); my $RegExpRootDir = Utils::RegExpQuote($RootDir); if($path !~ /^$RegExpRootDir/) { $App->H3("Error in BrowseDirectory: Browsing [$path] is not allowed.\n"); return; } $App->H3("Browse [$path]\n"); # my @Files; $App->SearchDirectory($pParams, '', $path, sub { my ($App, $key, $HitCountInDir, $path, $dir, $filename) = @_; if($key =~ /^NotHit/) { } elsif($key =~ /^EnterDir/) { #$App->print("d: $dir\n"); $App->{"FilesArray::$dir"} = []; # @Files = (); my $LinkStr = $App->GetLinkString("LinkToDirectories", $pParams, undef, "_blank", undef, undef, $dir, undef, $RootDir); $App->PrintRawHTML("$LinkStr
\n"); $App->BeginItem(0); } elsif($key =~ /^ExitDir/) { #$App->print("sort by: [$pParams->{FileSortBy}]"); # @Files = $App->FileSortBy($pParams->{FileSortBy}, \@Files); my @Files = $App->FileSortBy($pParams->{FileSortBy}, $App->{"FilesArray::$dir"}); #\@Files); for(my $i = 0 ; $i < @Files ; $i++) { my $path = $Files[$i]; next if($path eq ''); my ($drive, $directory, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($path); my $wtime = Utils::BuildDateString(Utils::GetWriteDate($path)); my $size = int((Utils::GetFileSize($path)+1023) / 1024); my $LinkStr = $App->GetLinkString("DownloadSearchFile", $pParams, $filename, "_blank", undef, undef, $path); $App->PrintItem("$LinkStr ($size kB) $wtime
\n"); } $App->EndItem(); delete $App->{"FilesArray::$dir"}; # @Files = (); } else { # push(@Files, $path); push(@{$App->{"FilesArray::$dir"}}, $path); } }, 0, 1, undef, $pParams->{ScriptCharCode}, $pParams->{FileSystemCharCode}); } sub Execute { my ($this, $cmd, $IsPrint) = @_; $IsPrint = 1 if(!defined $IsPrint); $this->print(" Execute [$cmd]...\n") if($IsPrint); my $ret = system($cmd); if($ret and $IsPrint) { $this->print(" Error: execute [$cmd] failed with ret=$ret\n"); } return $ret; } sub Escape { my($this, $str, $data) = @_; my(@str) = split(//, $str); foreach (@str) { my $escaped = unpack("H2", $_); $data =~ s/$_/%$escaped/g; } return $data; } sub Revert { my($this, $data) = @_; $data =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("c", hex($1))/eg; return $data; } sub IsExistFile { my ($App, $path) = @_; return 1 if(-e $path); $App->print("Error: [$path] does not exist.\n"); return 0; } #======================================================== # 名前などを整形する #======================================================== sub MergeName { my ($App, $FirstName, $LastName) = @_; my $Name; if($LastName =~ /^[a-zA-Z\s\.\,\/\(\)]*$/ and $FirstName =~ /^[a-zA-Z\s\.\,\/\(\)]*$/) { $Name = "$FirstName $LastName"; } else { $Name = "$LastName $FirstName"; } Utils::DelSpace($Name); return $Name; #return Utils::MergeName($FirstName, $LastName); } sub SplitName { my ($App, $Name) = @_; return Utils::SplitName($Name); Utils::DelSpace($Name); return ('', $Name) if($Name eq ''); my ($FirstName, $LastName); #$App->print("n[$Name]\n"); if($Name =~ /^[a-zA-Z\s\.,\-+\~\/\(\)]+$/) { # my @a = Utils::Split("\\s+", $Name); if($Name =~ /,/) { $Name =~ /^([\w\-]+)[\s,]+(.*)$/; $FirstName = $2; $LastName = $1; } else { $Name =~ /^([\w\-]+)\s+(.*)$/; $FirstName = $1; $LastName = $2; } #$App->print("n[$FirstName][$LastName]\n"); } else { # my ($a, $b) = Utils::Split("\\s+", $Name); $Name =~ /^(.+?)[\s,]+(.+)$/; # $Name =~ /^(\w+)[\s,]+(.*)$/; $FirstName = $2; $LastName = $1; } if(!defined $FirstName) { $FirstName = ''; $LastName = $Name; } #print "LN: $LastName ($Name)
\n"; return ($FirstName, $LastName); } 1;