lib/common.pl

   1 ################################################################################
   2 #
   3 # FSWikiLite ¶¦ÄÌ´Ø¿ô¥Õ¥¡¥¤¥ë
   4 #
   5 ################################################################################
   6 require "./lib/cgi-lib.pl";
   7 require "./lib/jcode.pl";
   8 require "./lib/mimew.pl";
   9 require "./lib/setup.pl";
  10 #-------------------------------------------------------------------------------
  11 # ¥Ø¥Ã¥À¤òÉ½¼¨
  12 #-------------------------------------------------------------------------------
  13 sub print_header {
  14         my $title = shift;
  15         my $show  = shift;
  16
  17         print "Content-Type: text/html;charset=EUC-JP\n";
  18         print "Pragma: no-cache\n";
  19         print "Cache-Control: no-cache\n\n";
  20         print "<html>\n";
  21         print "<head>\n";
  22         print "<title>".&Util::escapeHTML($title)." - $SITE_TITLE</title>\n";
  23         print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$THEME_URL\">\n";
  24         print "</head>\n";
  25         print "<body>\n";
  26
  27         print "<div class=\"adminmenu\">\n";
  28         print "  <span class=\"adminmenu\">\n";
  29         print "    <a href=\"".&Wiki::create_url({p=>"FrontPage"})."\">FrontPage</a>\n";
  30         print "    <a href=\"".&Wiki::create_url({a=>"new"})."\">¿·µ¬</a>\n";
  31         if($show==1){
  32                 print "    <a href=\"".&Wiki::create_url({a=>"edit",p=>$in{"p"}})."\">ÊÔ½¸</a>\n";
  33         }
  34         print "    <a href=\"".&Wiki::create_url({a=>"search"})."\">¸¡º÷</a>\n";
  35         print "    <a href=\"".&Wiki::create_url({a=>"list"})."\">°ìÍ÷</a>\n";
  36         print "    <a href=\"".&Wiki::create_url({p=>"Help"})."\">¥Ø¥ë¥×</a>\n";
  37         print "  </span>\n";
  38         print "</div>\n";
  39
  40         print "<h1>".&Util::escapeHTML($title)."</h1>\n";
  41         if(&Wiki::page_exists("Menu")){
  42                 print "<div class=\"main\">\n";
  43         }
  44 }
  45
  46 #-------------------------------------------------------------------------------
  47 # ¥Õ¥Ã¥¿¤òÉ½¼¨
  48 #-------------------------------------------------------------------------------
  49 sub print_footer {
  50         if(&Wiki::page_exists("Menu")){
  51                 print "</div>\n";
  52                 print "<div class=\"sidebar\">\n";
  53                 print &Wiki::process_wiki(&Wiki::get_page("Menu"));
  54                 print "</div>\n";
  55         }
  56         print "<div class=\"footer\">Powered by <a href=\"".$main::SITE_URL."\">FreeStyleWikiLite ".$main::VERSION."</a></div>\n";
  57         print "</body></html>\n";
  58 }
  59
  60 #-------------------------------------------------------------------------------
  61 # µìVer(0.0.11)¸ß´¹À°Ý»ý
  62 # ¼¡´ü¥Ð¡¼¥¸¥ç¥ó¤Çºï½ü¤µ¤ì¤Þ¤¹¡£
  63 #-------------------------------------------------------------------------------
  64 sub redirect { return &Wiki::redirect(@_); }
  65 sub redirectURL { return &Wiki::redirectURL(@_); }
  66
  67 package Wiki;
  68 sub exists_page { return &page_exists(shift); }
  69 sub send_mail { return &Util::send_mail(@_); }
  70
  71 package HTMLParser;
  72
  73 package Util;
  74 sub parse_plugin { return &Wiki::parse_inline_plugin(@_); }
  75
  76 ###############################################################################
  77 #
  78 # Wiki´ØÏ¢¤Î´Ø¿ô¤òÄó¶¡¤¹¤ë¥Ñ¥Ã¥±¡¼¥¸
  79 #
  80 ###############################################################################
  81 package Wiki;
  82
  83 local @current_parser = [];
  84
  85 #==============================================================================
  86 # ¥×¥é¥°¥¤¥ó¤Î¾ðÊó¤ò¼èÆÀ¤·¤Þ¤¹
  87 #==============================================================================
  88 sub get_plugin_info {
  89         my $name = shift;
  90         return defined($main::P_PLUGIN->{$name}) ? {FUNCTION=>$main::P_PLUGIN->{$name}, TYPE=>'paragraph'} :
  91                defined($main::I_PLUGIN->{$name}) ? {FUNCTION=>$main::I_PLUGIN->{$name}, TYPE=>'inline'   } :
  92                defined($main::B_PLUGIN->{$name}) ? {FUNCTION=>$main::B_PLUGIN->{$name}, TYPE=>'block'    } :
  93                {};
  94 }
  95
  96 #==============================================================================
  97 # Wiki¥½¡¼¥¹¤òÅÏ¤·¤ÆHTML¤ò¼èÆÀ¤·¤Þ¤¹
  98 #==============================================================================
  99 sub process_wiki {
 100         my $source  = shift;
 101         my $mainflg = shift;
 102         my $parser  = HTMLParser->new($mainflg);
 103
 104         # Î¢µ»ÍÑ(¥×¥é¥°¥¤¥óÆâÉô¤«¤é¥Ñ¡¼¥µ¤ò»È¤¦¾ì¹ç)
 105         push(@current_parser, $parser);
 106
 107         $parser->parse($source);
 108
 109         # ¥Ñ¡¼¥µ¤Î»²¾È¤ò²òÊü
 110         pop(@current_parser);
 111
 112         return $parser->{html};
 113 }
 114
 115 #==============================================================================
 116 # ¥Ñ¡¼¥¹Ãæ¤Î¾ì¹ç¡¢¸½ºßÍ¸ú¤ÊHTMLParser¤Î¥¤¥ó¥¹¥¿¥ó¥¹¤òÊÖµÑ¤·¤Þ¤¹¡£
 117 # ¥Ñ¡¼¥¹Ãæ¤ÎÆâÍÆ¤ò¥×¥é¥°¥¤¥ó¤«¤éÊÑ¹¹¤·¤¿¤¤¾ì¹ç¤Ë»ÈÍÑ¤·¤Þ¤¹¡£
 118 #==============================================================================
 119 sub get_current_parser {
 120         return $current_parser[$#current_parser];
 121 }
 122
 123 #===============================================================================
 124 # ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ò¥Ñ¡¼¥¹¤·¤Æ¥³¥Þ¥ó¥É¤È°ú¿ô¤ËÊ¬³ä
 125 #===============================================================================
 126 sub parse_inline_plugin {
 127         my $text = shift;
 128         my ($cmd, @args_tmp) = split(/ /,$text);
 129         my $args_txt = &Util::trim(join(" ",@args_tmp));
 130         if($cmd =~ s/\}\}(.*?)$//){
 131                 return { command=>$cmd, args=>[], post=>"$1 $args_txt"};
 132         }
 133
 134         my @ret_args;
 135         my $tmp    = "";
 136         my $escape = 0;
 137         my $quote  = 0;
 138         my $i      = 0;
 139
 140         for($i = 0; $i<length($args_txt); $i++){
 141                 my $c = substr($args_txt,$i,1);
 142                 if($quote!=1 && $c eq ","){
 143                         if($quote==3){
 144                                 $tmp .= '}';
 145                         }
 146                         push(@ret_args,$tmp);
 147                         $tmp = "";
 148                         $quote = 0;
 149                 } elsif($quote==1 && $c eq "\\"){
 150                         if($escape==0){
 151                                 $escape = 1;
 152                         } else {
 153                                 $tmp .= $c;
 154                                 $escape = 0;
 155                         }
 156                 } elsif($quote==0 && $c eq '"'){
 157                         if($tmp eq ""){
 158                                 $quote = 1;
 159                         } else {
 160                                 $tmp .= $c;
 161                         }
 162                 } elsif($quote==1 && $c eq '"'){
 163                         if($escape==1){
 164                                 $tmp .= $c;
 165                                 $escape = 0;
 166                         } else {
 167                                 $quote = 2;
 168                         }
 169                 } elsif(($quote==0 || $quote==2) && $c eq '}'){
 170                         $quote = 3;
 171                 } elsif($quote==3){
 172                         if($c eq '}'){
 173                                 last;
 174                         } else {
 175                                 $tmp .= '}'.$c;
 176                                 $quote = 0;
 177                         }
 178                 } elsif($quote==2){
 179                         return {error=>"¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤Î¹½Ê¸¤¬ÉÔÀµ¤Ç¤¹¡£"};
 180                 } else {
 181                         $tmp .= $c;
 182                         $escape = 0;
 183                 }
 184         }
 185
 186         if($quote!=3){
 187                 my $info = &Wiki::get_plugin_info($cmd);
 188                 return undef if (defined($info->{TYPE}) && $info->{TYPE} ne 'block');
 189         }
 190
 191         if($tmp ne ""){
 192                 push(@ret_args,$tmp);
 193         }
 194
 195         return { command=>$cmd, args=>\@ret_args,
 196                 post=>substr($args_txt, $i + 1, length($args_txt) - $i)};
 197 }
 198
 199 #==============================================================================
 200 # ¥Ú¡¼¥¸É½¼¨¤ÎURL¤òÀ¸À®
 201 #==============================================================================
 202 sub create_page_url {
 203         my $page = shift;
 204         return create_url({p=>$page});
 205 }
 206
 207 #==============================================================================
 208 # Ç¤°Õ¤ÎURL¤òÀ¸À®
 209 #==============================================================================
 210 sub create_url {
 211         my $params = shift;
 212         my $script = shift;
 213         my $url    = '';
 214         my $query  = '';
 215         my $action = '';
 216         foreach my $key (keys(%$params)){
 217                 my $val = $params->{$key};
 218                 if ($key eq 'a') {
 219                         $action = $val;
 220                 }
 221                 if($query ne ''){
 222                         $query .= '&amp;';
 223                 }
 224                 $query .= Util::url_encode($key)."=".Util::url_encode($val);
 225         }
 226         if(!defined($script)){
 227                 if ($action =~ /^(edit|new|delconf)$/){
 228                         $script = $main::EDIT_SCRIPT;
 229                 }else{
 230                         $script = $main::MAIN_SCRIPT;
 231                 }
 232         }
 233         $url = $script;
 234         if($query ne ''){
 235                 $url .= '?'.$query;
 236         }
 237         return $url;
 238 }
 239
 240 #==============================================================================
 241 # ¥Ú¡¼¥¸¤Î°ìÍ÷¤ò¼èÆÀ
 242 #==============================================================================
 243 sub get_page_list {
 244         opendir(DIR, $main::DATA_DIR);
 245         my ($fileentry, @files);
 246         while($fileentry = readdir(DIR)){
 247                 my $type = substr($fileentry,rindex($fileentry,"."));
 248                 if($type eq ".wiki"){
 249                         push(@files, "$main::DATA_DIR/$fileentry");
 250                 }
 251         }
 252         closedir(DIR);
 253
 254         my @pages;
 255         foreach my $entry (@files){
 256                 my @stat = stat($entry);
 257                 my $time = $stat[9];
 258
 259                 $entry = substr($entry,length($main::DATA_DIR)+1);
 260                 $entry =~ /(.+?)\.wiki/;
 261                 my $page = &Util::url_decode($1);
 262                 push(@pages,{NAME=>$page,TIME=>$time});
 263         }
 264
 265         @pages = sort { $b->{TIME}<=>$a->{TIME} } @pages;
 266         return @pages;
 267 }
 268
 269 #==============================================================================
 270 # ¥Ú¡¼¥¸¤Î¹¹¿·Æü»þ¤ò¼èÆÀ
 271 #==============================================================================
 272 sub get_last_modified {
 273         my $page = shift;
 274         if(&page_exists($page)){
 275                 my $file = sprintf("%s/%s.wiki",$main::DATA_DIR,&Util::url_encode($page));
 276                 my @stat = stat($file);
 277                 return $stat[9];
 278         } else {
 279                 return undef;
 280         }
 281 }
 282
 283 #==============================================================================
 284 # ¥Ú¡¼¥¸¤ò¼èÆÀ
 285 #==============================================================================
 286 sub get_page {
 287         my $page = &Util::url_encode(shift);
 288
 289         open(DATA,"$main::DATA_DIR/$page.wiki") or &Util::error("$main::DATA_DIR/$page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
 290         my $content = "";
 291         while(<DATA>){
 292                 $content .= $_;
 293         }
 294         close(DATA);
 295
 296         return $content;
 297 }
 298 #==============================================================================
 299 # ¥Ú¡¼¥¸¤òÊÝÂ¸
 300 #==============================================================================
 301 sub save_page {
 302         my $page   = shift;
 303         my $source = shift;
 304
 305         $page = &Util::trim($page);
 306         $source =~ s/\r\n/\n/g;
 307         $source =~ s/\r/\n/g;
 308
 309         my $enc_page = &Util::url_encode($page);
 310         my $action   = 'MODIFY';
 311         unless(-e "$main::DATA_DIR/$enc_page.wiki"){
 312                 $action = 'CREATE';
 313         }
 314
 315         # ¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤òºîÀ®
 316         if(-e "$main::DATA_DIR/$enc_page.wiki"){
 317                 open(BACKUP,">$main::BACKUP_DIR/$enc_page.bak") or &Util::error("$main::BACKUP_DIR/$enc_page.bak¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
 318                 open(DATA  ,"$main::DATA_DIR/$enc_page.wiki")   or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
 319                 while(<DATA>){
 320                         print BACKUP $_;
 321                 }
 322                 close(DATA);
 323                 close(BACKUP);
 324         }
 325
 326         # ÆþÎÏÆâÍÆ¤òÊÝÂ¸
 327         open(DATA,">$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
 328         print DATA $source;
 329         close(DATA);
 330
 331         &Util::send_mail($action,$page);
 332 }
 333
 334 #==============================================================================
 335 # ¥Ú¡¼¥¸¤¬Â¸ºß¤¹¤ë¤«¤É¤¦¤«
 336 #==============================================================================
 337 sub page_exists {
 338         my $page = &Util::url_encode(shift);
 339         if(-e "$main::DATA_DIR/$page.wiki"){
 340                 return 1;
 341         } else {
 342                 return 0;
 343         }
 344 }
 345
 346 #==============================================================================
 347 # °ú¿ô¤ÇÅÏ¤·¤¿¥Ú¡¼¥¸¤ËÁ«°Ü
 348 #==============================================================================
 349 sub redirect {
 350         my $page = shift;
 351         my $url  = &Wiki::create_url({p=>$page});
 352         &redirectURL($url);
 353 }
 354
 355 #==============================================================================
 356 # °ú¿ô¤ÇÅÏ¤·¤¿URL¤ËÁ«°Ü
 357 #==============================================================================
 358 sub redirectURL {
 359         my $url  = shift;
 360
 361         print "Content-Type: text/html;charset=EUC-JP\n";
 362         print "Pragma: no-cache\n";
 363         print "Cache-Control: no-cache\n\n";
 364         print "<html>\n";
 365         print "  <head>\n";
 366         print "    <title>moving...</title>\n";
 367         print "    <meta http-equiv=\"Refresh\" content=\"0;URL=$url\">\n";
 368         print "  </head>\n";
 369         print "  <body>\n";
 370         print "    Wait or <a href=\"$url\">Click Here!!</a>\n";
 371         print "  </body>\n";
 372         print "</html>\n";
 373
 374         exit;
 375 }
 376
 377 #==============================================================================
 378 # ¥Ú¡¼¥¸¤òºï½ü
 379 #==============================================================================
 380 sub remove_page {
 381         my $page     = shift;
 382         my $enc_page = &Util::url_encode($page);
 383         unlink("$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Îºï½ü¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
 384
 385         &Util::send_mail('DELETE',$page);
 386 }
 387
 388 ###############################################################################
 389 #
 390 # HTML¥Ñ¡¼¥µ
 391 #
 392 ###############################################################################
 393 package HTMLParser;
 394 #==============================================================================
 395 # ¥³¥ó¥¹¥È¥é¥¯¥¿
 396 #==============================================================================
 397 sub new {
 398         my $class   = shift;
 399         my $mainflg = shift;
 400         my $self    = {};
 401
 402         if(!defined($mainflg) || $mainflg eq ""){ $mainflg = 0; }
 403
 404         $self->{dl_flag} = 0;
 405         $self->{dt} = "";
 406         $self->{dd} = "";
 407
 408         $self->{html}  = "";
 409         $self->{pre}   = "";
 410         $self->{quote} = "";
 411         $self->{table} = 0;
 412         $self->{level} = 0;
 413         $self->{list}  = 0;
 414         $self->{para}  = 0;
 415         $self->{p_cnt} = 0;
 416         $self->{main}  = $mainflg;
 417         return bless $self,$class;
 418 }
 419
 420 #===============================================================================
 421 # ¥Ñ¡¼¥¹
 422 #===============================================================================
 423 sub parse {
 424         my $self   = shift;
 425         my $source = shift;
 426
 427         $self->start_parse;
 428         $source =~ s/\r//g;
 429
 430         my @lines = split(/\n/,$source);
 431
 432         foreach my $line (@lines){
 433                 chomp $line;
 434
 435                 # Ê£¿ô¹Ô¤ÎÀâÌÀ
 436                 $self->multi_explanation($line);
 437
 438                 my $word1 = substr($line,0,1);
 439                 my $word2 = substr($line,0,2);
 440                 my $word3 = substr($line,0,3);
 441
 442                 # ¶õ¹Ô
 443                 if($line eq "" && !$self->{block}){
 444                         $self->l_paragraph();
 445                         next;
 446                 }
 447
 448                 # ¥Ö¥í¥Ã¥¯½ñ¼°¤Î¥¨¥¹¥±¡¼¥×
 449                 if(!$self->{block} && ($word2 eq "\\\\" || $word1 eq "\\")){
 450                         my @obj = $self->parse_line(substr($line, 1));
 451                         $self->l_text(\@obj);
 452                         next;
 453                 }
 454
 455                 # ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó
 456                 if($line =~ /^\{\{(.+\}\})$/){
 457                         if(!$self->{block}){
 458                                 my $plugin = &Wiki::parse_inline_plugin($1);
 459                                 my $info   = &Wiki::get_plugin_info($plugin->{command});
 460                                 if($info->{TYPE} eq "paragraph"){
 461                                         $self->l_plugin($plugin);
 462                                 } else {
 463                                         my @obj = $self->parse_line($line);
 464                                         $self->l_text(\@obj);
 465                                 }
 466                                 next;
 467                         }
 468                 } elsif($line =~ /^\{\{(.+)$/){
 469                         if ($self->{block}) {
 470                                 my $plugin = &Wiki::parse_inline_plugin($1);
 471                                 my $info   = &Wiki::get_plugin_info($plugin->{command});
 472                                 $self->{block}->{level}++ if($info->{TYPE} eq "block");
 473                                 $self->{block}->{args}->[0] .= $line."\n";
 474                                 next;
 475                         }
 476                         my $plugin = &Wiki::parse_inline_plugin($1);
 477                         my $info   = &Wiki::get_plugin_info($plugin->{command});
 478                         if($info->{TYPE} eq "block"){
 479                                 unshift(@{$plugin->{args}}, "");
 480                                 $self->{block} = $plugin;
 481                                 $self->{block}->{level} = 0;
 482                         } else {
 483                                 my @obj = $self->parse_line($line);
 484                                 $self->l_text(\@obj);
 485                         }
 486                         next;
 487                 }
 488                 if($self->{block}){
 489                         if($line eq "}}"){
 490                                 if ($self->{block}->{level} > 0) {
 491                                         $self->{block}->{level}--;
 492                                         $self->{block}->{args}->[0] .= $line."\n";
 493                                         next;
 494                                 }
 495                                 my $plugin = $self->{block};
 496                                 delete($self->{block});
 497                                 $self->l_plugin($plugin);
 498                         } else {
 499                                 $self->{block}->{args}->[0] .= $line."\n";
 500                         }
 501                         next;
 502                 }
 503
 504                 # PRE
 505                 if($word1 eq " " || $word1 eq "\t"){
 506                         $self->l_verbatim($line);
 507
 508                 # ¸«½Ð¤·
 509                 } elsif($word3 eq "!!!"){
 510                         my @obj = $self->parse_line(substr($line,3));
 511                         $self->l_headline(1,\@obj);
 512
 513                 } elsif($word2 eq "!!"){
 514                         my @obj = $self->parse_line(substr($line,2));
 515                         $self->l_headline(2,\@obj);
 516
 517                 } elsif($word1 eq "!"){
 518                         my @obj = $self->parse_line(substr($line,1));
 519                         $self->l_headline(3,\@obj);
 520
 521                 # ¹àÌÜ
 522                 } elsif($word3 eq "***"){
 523                         my @obj = $self->parse_line(substr($line,3));
 524                         $self->l_list(3,\@obj);
 525
 526                 } elsif($word2 eq "**"){
 527                         my @obj = $self->parse_line(substr($line,2));
 528                         $self->l_list(2,\@obj);
 529
 530                 } elsif($word1 eq "*"){
 531                         my @obj = $self->parse_line(substr($line,1));
 532                         $self->l_list(1,\@obj);
 533
 534                 # ÈÖ¹æÉÕ¤¹àÌÜ
 535                 } elsif($word3 eq "+++"){
 536                         my @obj = $self->parse_line(substr($line,3));
 537                         $self->l_numlist(3,\@obj);
 538
 539                 } elsif($word2 eq "++"){
 540                         my @obj = $self->parse_line(substr($line,2));
 541                         $self->l_numlist(2,\@obj);
 542
 543                 } elsif($word1 eq "+"){
 544                         my @obj = $self->parse_line(substr($line,1));
 545                         $self->l_numlist(1,\@obj);
 546
 547                 # ¿åÊ¿Àþ
 548                 } elsif($line eq "----"){
 549                         $self->l_line();
 550
 551                 # °úÍÑ
 552                 } elsif($word2 eq '""'){
 553                         my @obj = $self->parse_line(substr($line,2));
 554                         $self->l_quotation(\@obj);
 555
 556                 # ÀâÌÀ
 557                 } elsif(index($line,":")==0 && index($line,":",1)!=-1){
 558                         if(index($line,":::")==0){
 559                                 $self->{dd} .= substr($line,3);
 560                                 next;
 561                         }
 562                         if($self->{dt} ne "" || $self->{dd} ne ""){
 563                                 $self->multi_explanation;
 564                         }
 565                         if(index($line,"::")==0){
 566                                 $self->{dt} = substr($line,2);
 567                                 $self->{dl_flag} = 1;
 568                                 next;
 569                         }
 570                         my $dt = substr($line,1,index($line,":",1)-1);
 571                         my $dd = substr($line,index($line,":",1)+1);
 572                         my @obj1 = $self->parse_line($dt);
 573                         my @obj2 = $self->parse_line($dd);
 574                         $self->l_explanation(\@obj1,\@obj2);
 575
 576                 # ¥Æ¡¼¥Ö¥ë
 577                 } elsif($word1 eq ","){
 578                         if($line =~ /,$/){
 579                                 $line .= " ";
 580                         }
 581                         my @spl = map {/^"(.*)"$/ ? scalar($_ = $1, s/\"\"/\"/g, $_) : $_}
 582                                                   ($line =~ /,\s*(\"[^\"]*(?:\"\"[^\"]*)*\"|[^,]*)/g);
 583                         my @array;
 584                         foreach my $value (@spl){
 585                                 my @cell = $self->parse_line($value);
 586                                 push @array,\@cell;
 587                         }
 588                         $self->l_table(\@array);
 589
 590                 # ¥³¥á¥ó¥È
 591                 } elsif($word2 eq "//"){
 592
 593                 # ²¿¤â¤Ê¤¤¹Ô
 594                 } else {
 595                         my @obj = $self->parse_line($line);
 596                         $self->l_text(\@obj);
 597                 }
 598         }
 599
 600         # Ê£¿ô¹Ô¤ÎÀâÌÀ
 601         $self->multi_explanation;
 602
 603         # ¥Ñ¡¼¥¹Ãæ¤Î¥Ö¥í¥Ã¥¯¥×¥é¥°¥¤¥ó¤¬¤¢¤Ã¤¿¾ì¹ç¡¢¤È¤ê¤¢¤¨¤ºÉ¾²Á¤·¤Æ¤ª¤¯¡©
 604         if($self->{block}){
 605                 my $plugin = $self->{block};
 606                 delete($self->{block});
 607                 $self->l_plugin($plugin);
 608         }
 609
 610         $self->end_parse;
 611 }
 612
 613 #===============================================================================
 614 # Ê£¿ô¹Ô¤ÎÀâÌÀ
 615 #===============================================================================
 616 sub multi_explanation {
 617         my $self = shift;
 618         my $line = shift;
 619         if($self->{dl_flag}==1 && (index($line,":")!=0 || !defined($line))){
 620                 my @obj1 = $self->parse_line($self->{dt});
 621                 my @obj2 = $self->parse_line($self->{dd});
 622                 $self->l_explanation(\@obj1,\@obj2);
 623                 $self->{dl_flag} = 0;
 624                 $self->{dt} = "";
 625                 $self->{dd} = "";
 626         }
 627 }
 628
 629 #===============================================================================
 630 # £±¹ÔÊ¬¤ò¥Ñ¡¼¥¹
 631 #===============================================================================
 632 sub parse_line {
 633         my ($self, $source) = @_;
 634
 635         return () if (not defined $source);
 636
 637         my @array = ();
 638         my $pre   = q{};
 639         my @parsed = ();
 640
 641         # $source ¤¬¶õ¤Ë¤Ê¤ë¤Þ¤Ç·«¤êÊÖ¤¹¡£
 642         SOURCE:
 643         while ($source ne q{}) {
 644
 645                 # ¤É¤Î¥¤¥ó¥é¥¤¥ó Wiki ½ñ¼°¤ÎÀèÆ¬¤Ë¤â match ¤·¤Ê¤¤¾ì¹ç
 646                 if (!($source =~ /^(.*?)((?:\{\{|\[\[?|https?:|mailto:|f(?:tp:|ile:)|'''?|==|__|<<).*)$/)) {
 647                         # WikiName¸¡º÷¡¦ÃÖ´¹½èÍý¤Î¤ß¼Â»Ü¤·¤Æ½ªÎ»¤¹¤ë
 648                         push @array, $self->_parse_line_wikiname($pre . $source);
 649                         return @array;
 650                 }
 651
 652                 $pre   .= $1;   # match ¤·¤Ê¤«¤Ã¤¿ÀèÆ¬ÉôÊ¬¤ÏÎ¯¤á¤Æ¤ª¤¤¤Æ¸å¤Ç½èÍý¤¹¤ë
 653                 $source = $2;   # match ÉôÊ¬¤Ï¸åÂ³½èÍý¤Ë¤Æ¾ÜºÙ¥Á¥§¥Ã¥¯¤ò¹Ô¤¦
 654                 @parsed = ();
 655
 656                 # ¥×¥é¥°¥¤¥ó
 657                 if ($source =~ /^\{\{/) {
 658                         $source = $';
 659                         my $plugin = &Wiki::parse_inline_plugin($source);
 660                         unless($plugin){
 661                                 push @parsed, '{{';
 662                                 push @parsed, $self->parse_line($source);
 663                         } else {
 664                                 my $info = &Wiki::get_plugin_info($plugin->{command});
 665                                 if($info->{TYPE} eq "inline"){
 666                                         push @parsed, $self->plugin($plugin);
 667                                 } else {
 668                                         push @parsed, $self->parse_line("<<".$plugin->{command}."¥×¥é¥°¥¤¥ó¤ÏÂ¸ºß¤·¤Þ¤»¤ó¡£>>");
 669                                 }
 670                                 if ($source ne "") {
 671                                         $source = $plugin->{post};
 672                                 }
 673                         }
 674                 }
 675
 676                 # ¥Ú¡¼¥¸ÊÌÌ¾¥ê¥ó¥¯
 677                 elsif ($source =~ /^\[\[([^\[]+?)\|([^\|\[]+?)\]\]/) {
 678                         my $label = $1;
 679                         my $page  = $2;
 680                         $source = $';
 681                         push @parsed, $self->wiki_anchor($page, $label);
 682                 }
 683
 684                 # URLÊÌÌ¾¥ê¥ó¥¯
 685                 elsif ($source
 686                         =~ /^\[([^\[]+?)\|((?:http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!&=:;\*#\@'\$]*)\]/
 687                         || $source =~ /^\[([^\[]+?)\|(file:[^\[\]]*)\]/
 688                         || $source
 689                         =~ /^\[([^\[]+?)\|((?:\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!&=:;\*#\@'\$]*)\]/
 690                         )
 691                 {
 692                         my $label = $1;
 693                         my $url   = $2;
 694                         $source = $';
 695                         if (   index($url, q{"}) >= 0
 696                                 || index($url, '><') >= 0
 697                                 || index($url, 'javascript:') >= 0)
 698                         {
 699                                 push @parsed, $self->parse_line('<<ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£>>');
 700                         }
 701                         else {
 702                                 push @parsed, $self->url_anchor($url, $label);
 703                         }
 704                 }
 705
 706                 # URL¥ê¥ó¥¯
 707                 elsif ($source
 708                         =~ /^(?:https?|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!&=:;\*#\@'\$]*/
 709                         || $source =~ /^file:[^\[\]]*/)
 710                 {
 711                         my $url = $&;
 712                         $source = $';
 713                         if (   index($url, q{"}) >= 0
 714                                 || index($url, '><') >= 0
 715                                 || index($url, 'javascript:') >= 0)
 716                         {
 717                                 push @parsed, $self->parse_line('<<ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£>>');
 718                         }
 719                         else {
 720                                 push @parsed, $self->url_anchor($url);
 721                         }
 722                 }
 723
 724                 # ¥Ú¡¼¥¸¥ê¥ó¥¯
 725                 elsif ($source =~ /^\[\[([^\|]+?)\]\]/) {
 726                         my $page = $1;
 727                         $source = $';
 728                         push @parsed, $self->wiki_anchor($page);
 729                 }
 730
 731                 # Ç¤°Õ¤ÎURL¥ê¥ó¥¯
 732                 elsif ($source =~ /^\[([^\[]+?)\|(.+?)\]/) {
 733                         my $label = $1;
 734                         my $url   = $2;
 735                         $source = $';
 736                         if (   index($url, q{"}) >= 0
 737                                 || index($url, '><') >= 0
 738                                 || index($url, 'javascript:') >= 0)
 739                         {
 740                                 push @parsed, $self->parse_line('<<ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£>>');
 741                         }
 742                         else {
 743                                 # URI¤òºîÀ®
 744                                 my $uri  = &main::MyBaseUrl().$ENV{"PATH_INFO"};
 745                                 push @parsed, $self->url_anchor($uri . '/../' . $url, $label);
 746                         }
 747                 }
 748
 749                 # ¥Ü¡¼¥ë¥É¡¢¥¤¥¿¥ê¥Ã¥¯¡¢¼è¤ê¾Ã¤·Àþ¡¢²¼Àþ
 750                 elsif ($source =~ /^('''?|==|__)(.+?)\1/) {
 751                         my $type  = $1;
 752                         my $label = $2;
 753                         $source = $';
 754                         if ($type eq q{'''}) {
 755                                 push @parsed, $self->bold($label);
 756                         }
 757                         elsif ($type eq q{__}) {
 758                                 push @parsed, $self->underline($label);
 759                         }
 760                         elsif ($type eq q{''}) {
 761                                 push @parsed, $self->italic($label);
 762                         }
 763                         else {                                                     ## elsif ($type eq q{==}) {
 764                                 push @parsed, $self->denialline($label);
 765                         }
 766                 }
 767
 768                 # ¥¨¥é¡¼¥á¥Ã¥»¡¼¥¸
 769                 elsif ($source =~ /^<<(.+?)>>/) {
 770                         my $label = $1;
 771                         $source = $';
 772                         push @parsed, $self->error($label);
 773                 }
 774
 775                 # ¥¤¥ó¥é¥¤¥ó Wiki ½ñ¼°Á´ÂÎ¤Ë¤Ï macth ¤·¤Ê¤«¤Ã¤¿¤È¤
 776                 else {
 777                         # 1 Ê¸»ú¿Ê¤à¡£
 778                         if ($source =~ /^(.)/) {
 779                                 $pre .= $1;
 780                                 $source = $';
 781                         }
 782
 783                         # parse ·ë²Ì¤ò @array ¤ËÊÝÂ¸¤¹¤ë½èÍý¤òÈô¤Ð¤·¤Æ·«¤êÊÖ¤·¡£
 784                         next SOURCE;
 785                 }
 786
 787                 # ¥¤¥ó¥é¥¤¥ó Wiki ½ñ¼°Á´ÂÎ¤Ë macth ¤·¤¿¸å¤Î
 788                 # parse ·ë²Ì¤ò @array ¤ËÊÝÂ¸¤¹¤ë½èÍý¡£
 789
 790                 # ¤â¤· $pre ¤¬Î¯¤Þ¤Ã¤Æ¤¤¤ë¤Ê¤é¡¢WikiName¤Î½èÍý¤ò¼Â»Ü¡£
 791                 if ($pre ne q{}) {
 792                         push @array, $self->_parse_line_wikiname($pre);
 793                         $pre = q{};
 794                 }
 795
 796                 push @array, @parsed;
 797         }
 798
 799         # ¤â¤· $pre ¤¬Î¯¤Þ¤Ã¤Æ¤¤¤ë¤Ê¤é¡¢WikiName¤Î½èÍý¤ò¼Â»Ü¡£
 800         if ($pre ne q{}) {
 801                 push @array, $self->_parse_line_wikiname($pre);
 802         }
 803
 804         return @array;
 805 }
 806
 807 #========================================================================
 808 # parse_line() ¤«¤é¸Æ¤Ó½Ð¤µ¤ì¡¢WikiName¤Î¸¡º÷¡¦ÃÖ´¹½èÍý¤ò¹Ô¤¤¤Þ¤¹¡£
 809 #========================================================================
 810 sub _parse_line_wikiname {
 811         my $self   = shift;
 812         my $source = shift;
 813
 814         return () if (not defined $source);
 815
 816         my @array = ();
 817
 818         # $source ¤¬¶õ¤Ë¤Ê¤ë¤Þ¤Ç·«¤êÊÖ¤¹¡£
 819         while ($source ne q{}) {
 820
 821                 # WikiName
 822                 if ($main::WIKI_NAME == 1 && $source =~ /[A-Z]+?[a-z]+?(?:[A-Z]+?[a-z]+)+/) {
 823                         my $pre  = $`;
 824                         my $page = $&;
 825                         $source  = $';
 826                         if ($pre ne q{}) {
 827                                 push @array, $self->_parse_line_wikiname($pre);
 828                         }
 829                         push @array, $self->wiki_anchor($page);
 830                 }
 831
 832                 # WikiName ¤â¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¤È¤
 833                 else {
 834                         push @array, $self->text($source);
 835                         return @array;
 836                 }
 837         }
 838         return @array;
 839 }
 840
 841 #===============================================================================
 842 # <p>
 843 # ¥Ñ¡¼¥¹¤ò³«»ÏÁ°¤Ë¸Æ¤Ó½Ð¤µ¤ì¤Þ¤¹¡£
 844 # ¥µ¥Ö¥¯¥é¥¹¤ÇÉ¬Í×¤Ê½èÍý¤¬¤¢¤ë¾ì¹ç¤Ï¥ª¡¼¥Ð¡¼¥é¥¤¥É¤·¤Æ¤¯¤À¤µ¤¤¡£
 845 # </p>
 846 #===============================================================================
 847 sub start_parse {}
 848
 849 #==============================================================================
 850 # ¥ê¥¹¥È
 851 #==============================================================================
 852 sub l_list {
 853         my $self  = shift;
 854         my $level = shift;
 855         my $obj   = shift;
 856
 857         if($self->{para}==1){
 858                 $self->{html} .= "</p>\n";
 859                 $self->{para} = 0;
 860         }
 861
 862         if($self->{list} == 1 && $level <= $self->{level}){
 863                 $self->end_list;
 864         }
 865         $self->{list} = 0;
 866
 867         $self->end_verbatim;
 868         $self->end_table;
 869         $self->end_quote;
 870
 871         my $html = join("",@$obj);
 872
 873         if($level > $self->{level}){
 874                 while($level != $self->{level}){
 875                         $self->{html} .= "<ul>\n";
 876                         push(@{$self->{close_list}},"</ul>\n");
 877                         $self->{level}++;
 878                 }
 879         } elsif($level <= $self->{level}){
 880                 while($level-1 != $self->{level}){
 881                         if($self->{'list_close_'.$self->{level}} == 1){
 882                                 $self->{html} .= "</li>\n";
 883                                 $self->{'list_close_'.$self->{level}} = 0;
 884                         }
 885                         if($level == $self->{level}){
 886                                 last;
 887                         }
 888                         $self->{html} .= pop(@{$self->{close_list}});
 889                         $self->{level}--;
 890                 }
 891         }
 892
 893         $self->{html} .= "<li>".$html;
 894         $self->{'list_close_'.$level} = 1;
 895 }
 896
 897 #==============================================================================
 898 # ÈÖ¹æÉÕ¤¥ê¥¹¥È
 899 #==============================================================================
 900 sub l_numlist {
 901         my $self  = shift;
 902         my $level = shift;
 903         my $obj   = shift;
 904
 905         if($self->{para}==1){
 906                 $self->{html} .= "</p>\n";
 907                 $self->{para} = 0;
 908         }
 909
 910         if($self->{list} == 0 && $level >= $self->{level}){
 911                 $self->end_list;
 912         }
 913         $self->{list} = 1;
 914
 915         $self->end_verbatim;
 916         $self->end_table;
 917         $self->end_quote;
 918
 919         my $html = join("",@$obj);
 920
 921         if($level > $self->{level}){
 922                 while($level != $self->{level}){
 923                         $self->{html} .= "<ol>\n";
 924                         push(@{$self->{close_list}},"</ol>\n");
 925                         $self->{level}++;
 926                 }
 927         } elsif($level <= $self->{level}){
 928                 while($level-1 != $self->{level}){
 929                         if($self->{'list_close_'.$self->{level}} == 1){
 930                                 $self->{html} .= "</li>\n";
 931                                 $self->{'list_close_'.$self->{level}} = 0;
 932                         }
 933                         if($level == $self->{level}){
 934                                 last;
 935                         }
 936                         $self->{html} .= pop(@{$self->{close_list}});
 937                         $self->{level}--;
 938                 }
 939         }
 940
 941         $self->{html} .= "<li>".$html;
 942         $self->{'list_close_'.$level} = 1;
 943 }
 944
 945 #==============================================================================
 946 # ¥ê¥¹¥È¤Î½ªÎ»
 947 #==============================================================================
 948 sub end_list {
 949         my $self  = shift;
 950         while($self->{level} != 0){
 951                 if($self->{'list_close_'.($self->{level})} == 1){
 952                         $self->{html} .= "</li>\n";
 953                         $self->{'list_close_'.$self->{level}} = 0;
 954                 }
 955                 $self->{html} .= pop(@{$self->{close_list}});
 956                 $self->{level}--;
 957         }
 958 }
 959
 960 #==============================================================================
 961 # ¥Ø¥Ã¥É¥é¥¤¥ó
 962 #==============================================================================
 963 sub l_headline {
 964         my $self  = shift;
 965         my $level = shift;
 966         my $obj   = shift;
 967
 968         if($self->{para}==1){
 969                 $self->{html} .= "</p>\n";
 970                 $self->{para} = 0;
 971         }
 972
 973         $self->end_list;
 974         $self->end_verbatim;
 975         $self->end_table;
 976         $self->end_quote;
 977
 978         my $html  = join("",@$obj);
 979
 980         # ¥á¥¤¥ó¤ÎÉ½¼¨ÎÎ°è¤Ç¤Ê¤¤¤È¤
 981         if(!$self->{main}){
 982                 $self->{html} .= "<h".($level+1).">".$html."</h".($level+1).">\n";
 983
 984         # ¥á¥¤¥ó¤ÎÉ½¼¨ÎÎ°è¤Î¾ì¹ç¤Ï¥¢¥ó¥«¤ò½ÐÎÏ
 985         } else {
 986                 if($level==2){
 987                         $self->{html} .= "<h".($level+1)."><a name=\"p".$self->{p_cnt}."\"><span class=\"sanchor\">&nbsp;</span>".
 988                                          $html."</a></h".($level+1).">\n";
 989                 } else {
 990                         $self->{html} .= "<h".($level+1)."><a name=\"p".$self->{p_cnt}."\">".$html."</a></h".($level+1).">\n";
 991                 }
 992         }
 993         $self->{p_cnt}++;
 994 }
 995
 996 #==============================================================================
 997 # ¿åÊ¿Àþ
 998 #==============================================================================
 999 sub l_line {
1000         my $self = shift;
1001
1002         if($self->{para}==1){
1003                 $self->{html} .= "</p>\n";
1004                 $self->{para} = 0;
1005         }
1006
1007         $self->end_list;
1008         $self->end_verbatim;
1009         $self->end_table;
1010         $self->end_quote;
1011
1012         $self->{html} .= "<hr>\n";
1013 }
1014
1015 #==============================================================================
1016 # ÃÊÍî¶èÀÚ¤ê
1017 #==============================================================================
1018 sub l_paragraph {
1019         my $self = shift;
1020
1021         $self->end_list;
1022         $self->end_verbatim;
1023         $self->end_table;
1024         $self->end_quote;
1025
1026         if($self->{para}==1){
1027                 $self->{html} .= "</p>\n";
1028                 $self->{para} = 0;
1029         } elsif($main::BR_MODE==1){
1030                 $self->{html} .= "<br>\n";
1031         }
1032 }
1033
1034 #==============================================================================
1035 # À°·ÁºÑ¥Æ¥¥¹¥È
1036 #==============================================================================
1037 sub l_verbatim {
1038         my $self  = shift;
1039         my $text  = shift;
1040
1041         if($self->{para}==1){
1042                 $self->{html} .= "</p>\n";
1043                 $self->{para} = 0;
1044         }
1045
1046         $self->end_list;
1047         $self->end_table;
1048         $self->end_quote;
1049
1050         $text =~ s/^\s//;
1051         $self->{pre} .= Util::escapeHTML($text)."\n";
1052 }
1053
1054 sub end_verbatim {
1055         my $self  = shift;
1056         if($self->{pre} ne ""){
1057                 $self->{html} .= "<pre>".$self->{pre}."</pre>\n";
1058                 $self->{pre} = "";
1059         }
1060 }
1061
1062 #==============================================================================
1063 # ¥Æ¡¼¥Ö¥ë
1064 #==============================================================================
1065 sub l_table {
1066         my $self = shift;
1067         my $row  = shift;
1068         $self->end_list;
1069         $self->end_verbatim;
1070         $self->end_quote;
1071
1072         my $tag = "td";
1073
1074         if($self->{table}==0){
1075                 $self->{table}=1;
1076                 $self->{html} .= "<table>\n";
1077                 $tag = "th";
1078         } else {
1079                 $self->{table}=2;
1080         }
1081
1082         my @columns = ();
1083         foreach(@$row){
1084                 my $html = join("",@$_);
1085                 if($#columns != -1 && $html eq '&lt;&lt;'){
1086                         @columns[$#columns]->{colspan}++;
1087                 } else {
1088                         push(@columns, {colspan => 1, html => $html});
1089                 }
1090         }
1091         $self->{html} .= "<tr>\n";
1092         foreach(@columns){
1093                 $self->{html} .= "<$tag colspan=\"".$_->{colspan}."\">".$_->{html}."</$tag>\n";
1094         }
1095         $self->{html} .= "</tr>\n";
1096 }
1097
1098 sub end_table {
1099         my $self = shift;
1100         if($self->{table}!=0){
1101                 $self->{table} = 0;
1102                 $self->{html} .= "</table>\n";
1103         }
1104 }
1105
1106 #==============================================================================
1107 # ¥Ñ¡¼¥¹½ªÎ»»þ¤Î½èÍý
1108 #==============================================================================
1109 sub end_parse {
1110         my $self = shift;
1111         $self->end_list;
1112         $self->end_verbatim;
1113         $self->end_table;
1114         $self->end_quote;
1115
1116         if($self->{para}==1){
1117                 $self->{html} .= "</p>\n";
1118                 $self->{para} = 0;
1119         }
1120 }
1121
1122 #==============================================================================
1123 # ¹Ô½ñ¼°¤Ë³ºÅö¤·¤Ê¤¤¹Ô
1124 #==============================================================================
1125 sub l_text {
1126         my $self = shift;
1127         my $obj  = shift;
1128         $self->end_list;
1129         $self->end_verbatim;
1130         $self->end_table;
1131         $self->end_quote;
1132         my $html = join("",@$obj);
1133
1134         if($self->{para}==0){
1135                 $self->{html} .= "<p>";
1136                 $self->{para} = 1;
1137         }
1138         $self->{html} .= $html;
1139
1140         # br¥â¡¼¥É¤ËÀßÄê¤µ¤ì¤Æ¤¤¤ë¾ì¹ç¤Ï<br>¤òÂ¤¹
1141         if($main::BR_MODE==1){
1142                 $self->{html} .= "<br>\n";
1143         }
1144 }
1145
1146 #==============================================================================
1147 # °úÍÑ
1148 #==============================================================================
1149 sub l_quotation {
1150         my $self = shift;
1151         my $obj  = shift;
1152         $self->end_list;
1153         $self->end_verbatim;
1154         $self->end_table;
1155         my $html = join("",@$obj);
1156         $self->{quote} .= "<p>".$html."</p>\n";
1157 }
1158
1159 sub end_quote {
1160         my $self = shift;
1161         if($self->{quote} ne ""){
1162                 $self->{html} .= "<blockquote>".$self->{quote}."</blockquote>\n";
1163                 $self->{quote} = "";
1164         }
1165 }
1166
1167 #==============================================================================
1168 # ÀâÌÀ
1169 #==============================================================================
1170 sub l_explanation {
1171         my $self = shift;
1172         my $obj1 = shift;
1173         my $obj2 = shift;
1174
1175         $self->end_list;
1176         $self->end_verbatim;
1177         $self->end_table;
1178         $self->end_quote;
1179
1180         my $html1 = join("",@$obj1);
1181         my $html2 = join("",@$obj2);
1182
1183         $self->{html} .= "<dl>\n<dt>".$html1."</dt>\n<dd>".$html2."</dd>\n</dl>\n";
1184 }
1185
1186 #==============================================================================
1187 # ¥Ü¡¼¥ë¥É
1188 #==============================================================================
1189 sub bold {
1190         my $self = shift;
1191         my $text = shift;
1192         return "<strong>".join("",$self->parse_line($text))."</strong>";
1193 }
1194
1195 #==============================================================================
1196 # ¥¤¥¿¥ê¥Ã¥¯
1197 #==============================================================================
1198 sub italic {
1199         my $self = shift;
1200         my $text = shift;
1201         return "<em>".join("",$self->parse_line($text))."</em>";
1202 }
1203
1204 #==============================================================================
1205 # ²¼Àþ
1206 #==============================================================================
1207 sub underline {
1208         my $self = shift;
1209         my $text = shift;
1210         return "<ins>".join("",$self->parse_line($text))."</ins>";
1211 }
1212
1213 #==============================================================================
1214 # ÂÇ¤Á¾Ã¤·Àþ
1215 #==============================================================================
1216 sub denialline {
1217         my $self = shift;
1218         my $text = shift;
1219         return "<del>".join("",$self->parse_line($text))."</del>";
1220 }
1221
1222 #==============================================================================
1223 # URL¥¢¥ó¥«
1224 #==============================================================================
1225 sub url_anchor {
1226         my $self = shift;
1227         my $url  = shift;
1228         my $name = shift;
1229
1230         if($name eq ""){
1231                 $name = $url;
1232         }
1233
1234         if($url eq $name && $url=~/\.(gif|jpg|jpeg|bmp|png)$/i && $main::DISPLAY_IMAGE==1){
1235                 return "<img src=\"".$url."\">";
1236         } else {
1237                 return "<a href=\"$url\">".Util::escapeHTML($name)."</a>";
1238         }
1239 }
1240
1241 #==============================================================================
1242 # Wiki¥Ú¡¼¥¸¤Ø¤Î¥¢¥ó¥«
1243 #==============================================================================
1244 sub wiki_anchor {
1245         my $self = shift;
1246         my $page = shift;
1247         my $name = shift;
1248
1249         my $anchor = undef;
1250         my $ppage = $page;
1251
1252         if(!defined($name) || $name eq ""){
1253                 $name = $page;
1254         }
1255
1256         if(&Wiki::page_exists($page)){
1257                 #¥¢¥ó¥«¡¼¤ò´Þ¤à¥Ú¡¼¥¸¤¬Â¸ºß¤¹¤ë¾ì¹ç¤Ï¥ê¥ó¥¯¤òÍ¥Àè
1258                 return "<a href=\"".&Wiki::create_page_url($page)."\" class=\"wikipage\">".
1259                        &Util::escapeHTML($name)."</a>";
1260         } else {
1261                 #ºÇ¸å¤Î"#"°Ê¹ß¤ò¥¢¥ó¥«¡¼¤È¤¹¤ë
1262                 if($page =~ m/#([^#]+)$/) {
1263                         $page = $`;
1264                         $anchor = $1;
1265                 }
1266                 if(defined($anchor) && $page eq '') {
1267                         #Æ±°ì¥Ú¡¼¥¸¤Î¥¢¥ó¥«¡¼¥ê¥ó¥¯
1268                         return "<a href=\"#$anchor\" class=\"wikipage\">".
1269                                &Util::escapeHTML($name)."</a>";
1270                 } elsif(&Wiki::page_exists($page)) {
1271                         #»ØÄê¥Ú¡¼¥¸¤Î¥¢¥ó¥«¡¼¥ê¥ó¥¯
1272                         return "<a href=\"".&Wiki::create_page_url($page).(defined($anchor)?"#".$anchor:"")."\" class=\"wikipage\">".
1273                                &Util::escapeHTML($name)."</a>";
1274                 } else {
1275                         #¿·µ¬¥Ú¡¼¥¸ºîÀ®ÍÑ¥ê¥ó¥¯
1276                         return "<span class=\"nopage\">".&Util::escapeHTML($name)."</span>".
1277                                "<a href=\"".&Wiki::create_page_url($page)."\">?</a>";
1278                 }
1279         }
1280 }
1281
1282 #==============================================================================
1283 # ¤¿¤À¤Î¥Æ¥¥¹¥È
1284 #==============================================================================
1285 sub text {
1286         my $self = shift;
1287         my $text = shift;
1288         return &Util::escapeHTML($text);
1289 }
1290
1291 #==============================================================================
1292 # ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó
1293 #==============================================================================
1294 sub plugin {
1295         my $self   = shift;
1296         my $plugin = shift;
1297
1298         my $func_ref = &Wiki::get_plugin_info($plugin->{command})->{FUNCTION};
1299         my $result = &$func_ref(@{$plugin->{args}});
1300         if(defined($result) && $result ne ""){
1301                 return ($result);
1302         }
1303
1304         return undef;
1305 }
1306
1307 #==============================================================================
1308 # ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó
1309 #==============================================================================
1310 sub l_plugin {
1311         my $self   = shift;
1312         my $plugin = shift;
1313
1314         if($self->{para}==1){
1315                 $self->{html} .= "</p>\n";
1316                 $self->{para} = 0;
1317         }
1318
1319         $self->end_list;
1320         $self->end_verbatim;
1321         $self->end_table;
1322         $self->end_quote;
1323
1324         my $func_ref = &Wiki::get_plugin_info($plugin->{command})->{FUNCTION};
1325         my $result = &$func_ref(@{$plugin->{args}});
1326         if(defined($result) && $result ne ""){
1327                 $self->{html} .= $result;
1328         }
1329 }
1330
1331 #==============================================================================
1332 # ¥¤¥á¡¼¥¸
1333 #==============================================================================
1334 sub l_image {
1335         my $self   = shift;
1336         my $page   = shift;
1337         my $file   = shift;
1338         my $width  = shift;
1339         my $height = shift;
1340
1341         if($self->{para}==1){
1342                 $self->{html} .= "</p>\n";
1343                 $self->{para} = 0;
1344         }
1345
1346         $self->end_list;
1347         $self->end_verbatim;
1348         $self->end_table;
1349         $self->end_quote;
1350
1351         $self->{html} .= "<div class=\"image\">";
1352         $self->{html} .= "<img src=\"".&Wiki::create_url({'p'=>$page,'f'=>$file},$main::DOWNLOAD_SCRIPT)."\"";
1353         $self->{html} .= " width=\"$width\"" if ($width ne "");
1354         $self->{html} .= " height=\"$height\"" if ($height ne "");
1355         $self->{html} .= "/>";
1356         $self->{html} .= "</div>\n";
1357 }
1358
1359 #==============================================================================
1360 # ¥¨¥é¡¼¥á¥Ã¥»¡¼¥¸
1361 #==============================================================================
1362 sub error {
1363         my $self  = shift;
1364         my $label = shift;
1365
1366         return "<span class=\"error\">".Util::escapeHTML($label)."</span>";
1367 }
1368
1369 ################################################################################
1370 #
1371 # ¥æ¡¼¥Æ¥£¥ê¥Æ¥£´Ø¿ô¤òÄó¶¡¤¹¤ë¥Ñ¥Ã¥±¡¼¥¸
1372 #
1373 ################################################################################
1374 package Util;
1375 #===============================================================================
1376 #  °ú¿ô¤ÇÅÏ¤µ¤ì¤¿Ê¸»úÎó¤òURL¥¨¥ó¥³¡¼¥É¤·¤ÆÊÖ¤·¤Þ¤¹¡£
1377 #===============================================================================
1378 sub url_encode {
1379         my $retstr = shift;
1380         &jcode::convert(\$retstr,"euc");
1381
1382         $retstr =~ s/([^ 0-9A-Za-z])/sprintf("%%%.2X", ord($1))/eg;
1383         $retstr =~ tr/ /+/;
1384         return $retstr;
1385 }
1386
1387 #===============================================================================
1388 #  °ú¿ô¤ÇÅÏ¤µ¤ì¤¿Ê¸»úÎó¤òURL¥Ç¥³¡¼¥É¤·¤ÆÊÖ¤·¤Þ¤¹¡£
1389 #===============================================================================
1390 sub url_decode{
1391         my $retstr = shift;
1392
1393         $retstr =~ tr/+/ /;
1394         $retstr =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
1395         return $retstr;
1396 }
1397
1398 #===============================================================================
1399 #  °ú¿ô¤ÇÅÏ¤µ¤ì¤¿Ê¸»úÎó¤ÎHTML¥¿¥°¤ò¥¨¥¹¥±¡¼¥×¤·¤ÆÊÖ¤·¤Þ¤¹¡£
1400 #===============================================================================
1401 sub escapeHTML {
1402         my($retstr) = shift;
1403         &jcode::convert(\$retstr,"euc");
1404
1405         my %table = (
1406                 '&' => '&amp;',
1407                 '"' => '&quot;',
1408                 '<' => '&lt;',
1409                 '>' => '&gt;',
1410         );
1411         $retstr =~ s/([&\"<>])/$table{$1}/go;
1412         $retstr =~ s/&amp;#([0-9]{1,5});/&#$1;/go;
1413         $retstr =~ s/&#(0*(0|9|10|13|38|60|62));/&amp;#$1;/g;
1414 #       $retstr =~ s/&amp;([a-zA-Z0-9]{2,8});/&$1;/go;
1415         return $retstr;
1416 }
1417
1418
1419 #===============================================================================
1420 # ÆüÉÕ¤ò¥Õ¥©¡¼¥Þ¥Ã¥È¤·¤Þ¤¹¡£
1421 #===============================================================================
1422 sub format_date {
1423         my $t = shift;
1424         my ($sec, $min, $hour, $mday, $mon, $year) = localtime($t);
1425         return sprintf("%04dÇ¯%02d·î%02dÆü %02d»þ%02dÊ¬%02dÉÃ",
1426                        $year+1900,$mon+1,$mday,$hour,$min,$sec);
1427 }
1428
1429 #===============================================================================
1430 # Ê¸»úÎó¤ÎÎ¾Ã¼¤Î¶õÇò¤òÀÚ¤êÍî¤È¤·¤Þ¤¹¡£
1431 #===============================================================================
1432 sub trim {
1433         my $text = shift;
1434         if(!defined($text)){
1435                 return "";
1436         }
1437         $text =~ s/^(?:\s)+//o;
1438         $text =~ s/(?:\s)+$//o;
1439         return $text;
1440 }
1441
1442
1443 #===============================================================================
1444 # ¥¿¥°¤òºï½ü¤·¤ÆÊ¸»úÎó¤Î¤ß¤ò¼èÆÀ¤·¤Þ¤¹¡£
1445 #===============================================================================
1446 sub delete_tag {
1447         my $text = shift;
1448         $text =~ s/<(.|\s)+?>//g;
1449         return $text;
1450 }
1451
1452 #===============================================================================
1453 # ¥Ú¡¼¥¸Ì¾¤¬»ÈÍÑ²ÄÇ½¤«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£
1454 #===============================================================================
1455 sub check_pagename {
1456         my $pagename = shift;
1457
1458         #¥Ú¡¼¥¸Ì¾¤ò¥Á¥§¥Ã¥¯
1459         if( !defined($pagename)
1460                 || $pagename eq ""                     # ¶õ
1461                 || $pagename =~ /[\|\[\]]/             # |[]
1462                 || $pagename =~ /^:/                   # ¥³¥í¥ó¤Ç»Ï¤Þ¤ë
1463                 || $pagename =~ /[^:]:[^:]/            # ¥³¥í¥óÃ±ÂÎ¤Ç¤Î»ÈÍÑ
1464                 || $pagename =~ /^\s+$/                # ¶õÇò¤Î¤ß
1465         ){
1466                 return 0;
1467         }
1468         return 1;
1469 }
1470
1471 #===============================================================================
1472 # ¿ôÃÍ¤«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£
1473 #===============================================================================
1474 sub check_numeric {
1475         my $text = shift;
1476         if($text =~ /^[0-9]+$/){
1477                 return 1;
1478         } else {
1479                 return 0;
1480         }
1481 }
1482
1483 #==============================================================================
1484 # ¥á¡¼¥ëÁ÷¿®
1485 #==============================================================================
1486 sub send_mail {
1487         my $action   = shift;
1488         my $page     = shift;
1489         my $enc_page = &Util::url_encode($page);
1490
1491         if($main::ADMIN_MAIL eq "" || $main::SEND_MAIL eq ""){
1492                 return;
1493         }
1494
1495         my $subject = "";
1496         if($action eq 'CREATE'){
1497                 $subject = "[FSWikiLite]$page¤¬ºîÀ®¤µ¤ì¤Þ¤·¤¿";
1498
1499         } elsif($action eq 'MODIFY'){
1500                 $subject = "[FSWikiLite]$page¤¬¹¹¿·¤µ¤ì¤Þ¤·¤¿";
1501
1502         } elsif($action eq 'DELETE'){
1503                 $subject = "[FSWikiLite]$page¤¬ºï½ü¤µ¤ì¤Þ¤·¤¿";
1504         }
1505
1506         # MIME¥¨¥ó¥³¡¼¥É
1507         $subject = &main::mimeencode($subject);
1508
1509         my $head = "Subject: $subject\n".
1510                    "From: $main::ADMIN_MAIL\n".
1511                    "Content-Transfer-Encoding: 7bit\n".
1512                    "Content-Type: text/plain; charset=\"ISO-2022-JP\"\n".
1513                    "Reply-To: $main::ADMIN_MAIL\n".
1514                    "\n";
1515
1516         my $body = "IP:".$ENV{'REMOTE_ADDR'}."\n".
1517                    "UA:".$ENV{'HTTP_USER_AGENT'}."\n";
1518
1519         if($action eq 'MODIFY' || $action eq 'DELETE'){
1520                 if(-e "$main::BACKUP_DIR/$enc_page.bak"){
1521                         $body .= "°Ê²¼¤ÏÊÑ¹¹Á°¤Î¥½¡¼¥¹¤Ç¤¹¡£\n".
1522                                  "-----------------------------------------------------\n";
1523                         open(BACKUP,"$main::BACKUP_DIR/$enc_page.bak");
1524                         while(my $line = <BACKUP>){
1525                                 $body .= $line;
1526                         }
1527                         close(BACKUP);
1528                 }
1529         }
1530
1531         # Ê¸»ú¥³¡¼¥É¤ÎÊÑ´¹(jcode.pl¤ò»ÈÍÑ¤¹¤ë)
1532         &jcode::convert(\$body,'jis');
1533
1534         open(MAIL,"| $main::SEND_MAIL $main::ADMIN_MAIL");
1535         print MAIL $head;
1536         print MAIL $body;
1537         close(MAIL);
1538 }
1539
1540 #===============================================================================
1541 # ¥¨¥é¡¼¤òÄÌÃÎ
1542 #===============================================================================
1543 sub error {
1544         my $error = shift;
1545
1546         print "Content-Type: text/html;charset=EUC-JP\n\n";
1547         print "<html>\n";
1548         print "<head><title>¥¨¥é¡¼ - FSWikiLite</title></head>\n";
1549         print "<body>\n";
1550         print "<h1>¥¨¥é¡¼¤¬È¯À¸¤·¤Þ¤·¤¿</h1>\n";
1551         print "<pre>\n";
1552         print &Util::escapeHTML($error);
1553         print "</pre>\n";
1554         print "</body><html>\n";
1555
1556         exit;
1557 }
1558
1559 #===============================================================================
1560 # ·ÈÂÓÅÅÏÃ¤«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£
1561 #===============================================================================
1562 sub handyphone {
1563         my $ua = $ENV{'HTTP_USER_AGENT'};
1564         if(!defined($ua)){
1565                 return 0;
1566         }
1567         if($ua=~/^DoCoMo\// || $ua=~ /^J-PHONE\// || $ua=~ /UP\.Browser/ || $ua=~ /\(DDIPOCKET\;/ || $ua=~ /\(WILLCOM\;/ || $ua=~ /^Vodafone\// || $ua=~ /^SoftBank\//){
1568                 return 1;
1569         } else {
1570                 return 0;
1571         }
1572 }
1573
1574 #===============================================================================
1575 # ¥¹¥Þ¡¼¥È¥Õ¥©¥ó¤«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£
1576 #===============================================================================
1577 sub smartphone {
1578         my $ua = $ENV{'HTTP_USER_AGENT'};
1579         if(!defined($ua)){
1580                 return 0;
1581         }
1582         if($ua =~ /Android/ || $ua =~ /iPhone/){
1583                 return 1;
1584         } else {
1585                 return 0;
1586         }
1587 }
1588
1589 1;