#============================================================
# 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$tag>\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;