#============================================================ # TkWiki #============================================================ package CGI::TkWiki; use Common; @ISA = qw(Common); #公開したいサブルーチン #@EXPORT = qw(erfc tan); @EXPORT_OK = qw(); use strict; use Cwd; use JFile; use Template; use MyMail; use JSParams; #========================================== # 大域変数 #========================================== sub WikiDir { return shift->{WikiDir}; } sub SetWikiDir { my ($this,$d)=@_; return $this->{WikiDir} = $d; } sub SetModuleName { my ($this,$n)=@_; return $this->{ModuleName} = $n; } sub SetTemplatePaths { my ($this, $HTML, $Wiki, $Text) = @_; #Utils::InitHTML(); #print "T[$HTML][$Wiki]
\n"; $this->{HTMLTemplatePath} = $HTML; $this->{WikiTemplatePath} = $Wiki; $this->{TextTemplatePath} = $Text; #print "SetTemplatePaths T[$this->{ModuleName}][$this->{HTMLTemplatePath}][$this->{WikiTemplatePath}]
\n"; } sub GetWikiPath { my ($this, $App, $pParams, $FileName) = @_; Jcode::convert(\$FileName, $pParams->{FileSystemCharCode}); my $path; $path =~ s/\\/\//g; if(defined $pParams->{CurDir}) { Jcode::convert(\$pParams->{CurDir}, $pParams->{FileSystemCharCode}); if($pParams->{CurDir} eq '/.') { $path = Utils::MakePath($this->{WikiDir}, [$FileName], '/', 0); } else { $path = Utils::MakePath($this->{WikiDir}, [$pParams->{CurDir}, $FileName], '/', 0); } } else { Jcode::convert(\$pParams->{WikiDir}, $pParams->{FileSystemCharCode}); $path = Utils::MakePath($this->{WikiDir}, $FileName, '/', 0); } # $path =~ s/\/\.\//\//g; #$App->print("F: $path [$FileName]\n"); #Jcode::convert(\$path, "utf-8", "sjis"); #$pParams->{FileSystemCharSet}); #$App->print("F: $path\n"); return $path; } #============================================================ #　コンストラクタ、デストラクタ #============================================================ sub new { my ($module) = @_; my $this = {}; bless $this; # $this->SUPER::new(@_); return $this; } sub DESTROY { my $this = shift; $this->SUPER::DESTROY(@_); } #============================================================ #　メンバー関数 #============================================================ sub DecodeFSWikiName { my ($this, $filename) = @_; my $filebody = $filename; $filebody =~ s/\.wiki$//i; my $s2 = $filebody; $s2 = Utils::URLDecode($filebody); #print "s2: $s2\n"; my $guess = Encode::Guess::guess_encoding($s2); my $s3; unless(ref $guess){ # 判別失敗 #print("Cannot guess: $guess\n"); # $s3 = from_to($s2, "euc-jp", "shift-jis"); $s3 = $s2; } else { # 判別成功 $s3 = $guess->decode($s2); $s3 = Encode::encode("shift-jis", $s3); } #print "$s2: $s3\n"; return $s3; } sub DecodePukiWikiName { my ($this, $filename) = @_; my $filebody = $filename; $filebody =~ s/\.txt$//i; my $s2 = $filebody; if($filebody =~ /^[0-9a-fA-F]+$/) { $s2 = Utils::HexDecode($filebody); } #print "s2: $s2\n"; my $guess = Encode::Guess::guess_encoding($s2); my $s3; unless(ref $guess){ # 判別失敗 #print("Cannot guess: $guess\n"); # $s3 = from_to($s2, "euc-jp", "shift-jis"); $s3 = $s2; } else { # 判別成功 $s3 = $guess->decode($s2); $s3 = Encode::encode("shift-jis", $s3); } #print "$s2: $s3\n"; return $s3; } sub ConvertURLLinksAll { my ($this, $App, $pParams, $text) = @_; $text =~ s/(https?:\/\/[\w:\/\@\.\-#&?\%\~]*)/$1<\/a>/sig; $text =~ s/(ftps?:\/\/[\w:\/\@\.\-]*)/$1<\/a>/sig; $text =~ s/([\w%\._\-]+\@[\w\._\-]+)/$1<\/a>/sig; return $text; } sub ConvertURLLinks { my ($this, $App, $pParams, $text) = @_; my $conv = ''; while(1) { my ($head, $mid, $tail) = ($text =~ /^(.*?)\<(.*?)\>(.*)$/s); #$App->print("head: $head / $mid / $tail\n"); if(!defined $tail) { $text = $this->ConvertURLLinksAll($App, $pParams, $text); # $text =~ s/(https?:\/\/[\w:\/\@\.\-#&?]*)/$1<\/a>/sig; # $text =~ s/(ftps?:\/\/[\w:\/\@\.\-]*)/$1<\/a>/sig; $conv .= $text; last; } $head = $this->ConvertURLLinksAll($App, $pParams, $head); # $head =~ s/(https?:\/\/[\w:\/\@\.\-#&?]*)/$1<\/a>/sig; # $head =~ s/(ftps?:\/\/[\w:\/\@\.\-]*)/$1<\/a>/sig; $conv .= "$head<$mid>"; $text = $tail; } # $text =~ s/(https?[\w:\/\@\.\-#&?]*)/$1<\/a>/sig; # $text =~ s/(ftps?[\w:\/\@\.\-]*)/$1<\/a>/sig; return $conv; } sub ConvertWikiPage { my ($this, $App, $pParams, $text, $charcode) = @_; $text .= "\n"; my $OriginalCode = Jcode::getcode($text); #print "Code: $OriginalCode
\n"; Jcode::convert(\$text, "euc-jp", $OriginalCode); $text =~ s/\-\>\{/&vbra;/sg; $text =~ s/\{\{/&dbra;/sg; $text =~ s/\}\}/&dket;/sg; $text = Template->new()->ReplaceByHash($text, $pParams, '{', '}', 0, $pParams->{WebCharSet}, 1); $text =~ s/&dbra;/{{/sg; $text =~ s/&dket;/}}/sg; $text =~ s/&vbra;/->{/sg; #no strict; # $text =~ s/\{\{(.*?::.*?)\((.*?)\)\}\}/eval("$1(" . '$this,$App,$pParams,' . "$2);");/emg; # $text =~ s/\{\{(.*?\-\>.*?)\((.*?)\)\}\}/eval("$1(" . '$App,$pParams,' . "$2);");/emg; # $text =~ s/\{\{(.*?::.*?)\}\}/eval("$1(" . '$this,$App,$pParams);');/emg; # $text =~ s/\{\{(.*?\-\>.*?)\}\}/eval("$1(" . '$App,$pParams);');/emg; #use strict; # $text = Template->new()->ReplaceByHash($text, $pParams, '{', '}', 0, $pParams->{WebCharSet}, 1); $text =~ s/\\&/&/mg; $text =~ s/\\\/>/mg; $text =~ s/\\\^/⊃/mg; $text =~ s/\\\_/⊂/mg; $text =~ s/\\\[/&kakubra;/mg; $text =~ s/\\\]/&kakuket;/mg; $text =~ s/\\\{/{/mg; $text =~ s/\\\}/}/mg; $text =~ s/\r\n/
/mg; $text =~ s/\n\r/
/mg; $text =~ s/\n/
/mg; $text =~ s/\r/
/mg; $text =~ s/\/
\n/mg; $text =~ s/'''(.*?)'''/\$1\<\/b\>/sig; $text =~ s/''(.*?)''/\$1\<\/i\>/sig; $text =~ s/==(.*?)==/\$1\<\/strike\>/sig; $text =~ s/__(.*?)__/\$1\<\/u\>/sig; $text =~ s/\^\^([^\n]+?)\^\^/$1<\/sup>/mg; $text =~ s/__([^\n]+?)__/$1<\/sub>/mg; $text =~ s/^!!!(.*?)\/

$1<\/h2>/mig; $text =~ s/^!!(.*?)\/

$1<\/h3>/mig; $text =~ s/^!(.*?)\/

$1<\/h4>/mig; $text =~ s/^""(.*?)\/
$1<\/blockquote>/mig; $text =~ s/^----\s*?\/
/mig; $text =~ s/^\/\/.*?\//mig; $text =~ s/^\s(.*\S.*?)\/
\n$1\n<\/pre>/mig;
	$text =~ s/\n<\/pre\>\n\//mig;

	$text =~ s/^\*\*\*(.*?)\/