#!/usr/bin/perl -w
#----------------------------------------------------------------
# #mt-sukeroku.pl - Movable Type Wiki風味TextFormatプラグイン
# Copyright(C)DonaDona(KITAO Masato) 2003
#----------------------------------------------------------------
#
# ##改変履歴
#
# :version 0.00:2003/10/26 作成開始
# :version 0.10:2003/10/27 エントリー実験開始
# :version 0.11:2003/10/28 pluginの文字列判定法の変更
# :version 0.12:2003/10/29 comment pluginの追加
# :version 0.20:2003/10/29 inline処理避け記法の追加
# :version 0.30:2003/10/30 プラグイン用の枠組みを用意し、従来のプラグインはインラインコマンド機能と変更。\nフォーマット対象外処理のバグ出し。\nモード切替命令の追加。\n改行が連続した場合に<p></p>が発生するのを防いだ。
# :version 0.31:2003/10/31 インラインコマンド機能のチェック漏れ(-_-;;)のバグつぶし
# :version 0.40:2003/11/09 ルビのショートハンド（#src#{"..."(...)}）の追加。インラインコマンドlink,image,thumbnailを追加。
# :version 0.50:2003/11/10 インラインコマンドnotebody,notemark,stickyを追加。\nインラインコマンドが行頭に来たときのことを考慮してなかったので、@でも代用できるようにした(-_-;;)\nリスト（用語定義、リスト）を見出しの直後に行を空けずに続けると発生していたエラーを多少回避するようにした
#
# ##インストール方法
#
# MTのインストール先のフォルダ直下にpluginsフォルダにこのファイルを入れてください。
# ない場合はフォルダを作って、放り込んでみてください。
#
# ###スタイルシートの追加とか。
#
# 引用や整形済みテキストなどを利用する場合、stylesheetテンプレートを追加した方がいいかも。
# 追加方法とかはそこらへんのサイトを見ていただくとして、簡単なサンプルを挙げておきます。
#
#	blockquote {
#		border: dotted 1px #0000cc;
#		background-color: #ccccff;
#		padding: 5px;
#	}
#	pre {
#		border: inset 2px #ffffff;
#		color: #00ff00;
#		background-color: #000000;
#		padding: 5px;
#	}
#
# 注釈系を使う場合はこちらも追加しておいてください。
#
#	span.sticky{
#		color: #ff0000;
#		vertical-align:super;
#		text-decoration: underline;
#	}
#	a.notemark{
#		font-size:small;
#		color: #ff0000;
#		vertical-align:super;
#		text-decoration: underline;
#	}
#	a.notebody{
#		color: #ff0000;
#		text-decoration: underline;
#	}
#
# ###使い方
#
# エントリー画面でテキストフォーマットを「**Sukeroku**」に選択してください。
#
#----------------------------------------------------------------
#
# ##フォーマット
#
# ###ブロックレベル（論理行頭に配置）
#
# - #,##,###
# -- 見出し1,2,3
# - ----
# -- 水平線
# - -,--,---
# -- リスト（個数でレベルが分かれます）
# - 0.
# -- ナンバーリスト（0でなくても数字ならなんでもOK）
# - :word:difinition
# -- 用語定義
# - >,>>,>>>
# -- 引用（個数でレベル）
# - 空行、もしくはスペースのみ 
# -- 改段落
# - 行頭スペースあり
# -- 整形済みテキスト
# - =====
# -- 整形モードのトグル（変換対象外<==>変換対象）
#
# ###インライン
#
# -``\n``で改行
# -等号(=)を二つ重ねて挟む(``==取り消し線==``)と==取り消し線==
# -アンダーライン(_)を二つ重ねて挟む(``__下線__``)と__下線__
# -アスタリスク(*)を二つ重ねて挟む(``**太字**``)と**太字**
# -単一引用符(')を二つ重ねて挟む(``''斜体''``)と''斜体''
# -[...]との間に
# --[title]+[url]で新規ウィンドウでリンク(``[[title]+[url]]``)
# --[title][url]で同一フレーム内でリンク(``[[title][url]]``)
# --[url]で新規ウィンドウでリンク(``[[url]]``)
# -二重引用符で挟んだ直後に括弧で囲むとルビ(``"テキスト"(ルビ)``)
# -#で命令名を挟み、{と}の間にパラメータを挟む（``#command#{param}``）と、インラインコマンド機能呼び出し。\n詳細は後述。
# -`を二つ重ねて挟むと、上記インライン処理を無視します（#src#{``...``}）。もしくは#src#{#src#{...}}。
#
# ###インラインコマンド機能
#
# $1,$2と書いているのは「|」で区切られたパラメータのことです。
# $1のみのものは明記していません。
# また、処理対象テキストを再帰的にインライン処理しないものもあります。
# :b,bold:太字
# :i,italic:斜体
# :u,underline:下線
# :s,strike:取り消し線
# :q,quote:引用
# :color:色指定（$1=色, $2=テキスト）
# :big:大きく
# :small:小さく
# :rb,ruby:ルビ（$1=漢字, $2=ルビ）
# :nm,notemark:注釈マーク($1=シンボル)
# :nb,notebody:注釈本体($1=シンボル)
# :st,sticky:付箋注釈($1=シンボル, $2=本文)
# :a,link:リンク（$1=タイトル, $2=url）画像は展開しません
# :img,image:画像インライン（$1=alt, $2=url）
# :tn,thumbnail:サムネイルリンク（$1=alt, $2=サムネイル,$3=実画像）
# :=,html:中のコードをそのまま表示する
# :style:CSS指定($1=style, $2=テキスト)
# :entity:実体参照
#
# ###プラグイン機能
#
# 実装予定ですが、どうなることやら。
#
#----------------------------------------------------------------
#
# ##ライセンス
#
# 参考にした[[YukiWiki]+[http://www.hyuki.com/yukiwiki/index.html]]のライセンス#nm#{01}に準じます。
# YukiWikiのback_push, escape, unescapeの各サブルーチンを流用#st#{*|一部修正してます}させて頂いています。
# またconvert_htmlサブルーチンを参考にしています。
# 
#----------------------------------------------------------------
#
# ##なんで「助六」なのか。
#
# 作り始めた2003年10月26日にNHK教育テレビで放映されていた團十郎の「"助六由縁江戸桜"(すけろくゆかりのえどざくら)」を見ながら作っていたためです。
# それ以上の理由は特にないです(^^;
# 
#----------------------------------------------------------------
#
# ##注釈
# -#nb#{01}）Perlと同じライセンス。具体的にはGNU GPL2 と ArtisticLicense の dual licenseってことらしい。
#
#----------------------------------------------------------------

package MT::Plugins::Sukeroku;

use vars qw($VERSION);
$VERSION = 0.50;

use strict;

use MT;
use MT::Template::Context;
use MT::Util qw(encode_html first_n_words);

##TextFilterの追加
MT->add_text_filter(sukeroku => {
  label => 'Sukeroku',
  docs => 'http://hsj.jp/',
  on_format => \& sukeroku_format,
});
##コンテナタグの追加
MT::Template::Context->add_container_tag(sukerokutext => sub { &sukeroku_tag; }); 

##利用していないです(^^;
sub sukeroku {
  my $text=shift;
  my $ctx=shift;
  return &sukeroku_format($text, $ctx);
}
##コンテナタグのコールバックサブルーチン
sub sukeroku_tag {
  my($ctx,$args) = @_;
  my $builder = $ctx->stash('builder');
  my $tokens = $ctx->stash('tokens');
  defined(my $out = $builder->build($ctx,$tokens)) or return '';
  return &sukeroku($out);
}

##テキストフォーマット用サブルーチン
sub sukeroku_format {
  # パラメータの取得（#1:text, #2:context）→テキストの各行を改行で分割
  my ($text, $ctx) = @_;
  my (@lines) = split(/\n/, $text);

  # フォーマット処理フラグ
  my $formatFlag = 1;
  # 改行有効フラグ
  my $crlfForceFlag = 1;
  
  # tagのスタックを初期化
  my (@saved, @result);
  unshift(@saved, "</p>");
  push(@result, "<p>");
  my ($lastLine);

  # 一行ずつフォーマット処理をする
  foreach (@lines) {

    # 末尾の\nを除去
    chomp;

    # 行頭に====がある場合はフォーマット処理フラグを切り替える
    if (/^====/) {
      if($formatFlag == 1){
        $formatFlag = 0;
        #$_ = '';
      }
      else{
        $formatFlag = 1;
        #$_ = '';
      }
    }
    elsif(/^\#mode\#([^\|]+)\|(.+)$/i){
      my($modeName, $modeParam) = ($1, $2);
      my($modeNewValue) = 0;
      if($modeParam =~ /on|true|in/i){
        $modeNewValue = 1;
      }
      if($modeName =~ /format/i){
        $formatFlag = $modeNewValue;
      }
      elsif($modeName =~ /crlf|line/i){
        $crlfForceFlag = $modeNewValue;
      }
    }
    # 通常処理
    else{
      #
      # フォーマット処理フラグが有効ならば。
      #
      if($formatFlag == 1){
        #
        # 見出し 
        #
        if (/^\#\#\#(.*)/) {
          push(@result, splice(@saved), '<h5>' . &inline($1, $ctx) . '</h5>');
        }
        elsif (/^\#\#(.*)/) {
          push(@result, splice(@saved), '<h4>' . &inline($1, $ctx) . '</h4>');
        }
        elsif (/^\#(.*)/) {
          push(@result, splice(@saved), '<h3>' . &inline($1, $ctx) . '</h3>');
        }
        #
        # 水平線
        #
        elsif (/^----/) {
          push(@result, splice(@saved), '<hr />');
        }
        #
        # リスト表示。
        #
        elsif (/^(-{1,3})(.*)/) {
          &back_push('ul', length($1), \@saved, \@result, '');
          push(@result, '<li>' . &inline($2, $ctx) . '</li>');
        }
        elsif (/^([0-9]+\.)(.*)/) {
          &back_push('ol', 1, \@saved, \@result, '');
          push(@result, '<li>' . &inline($2, $ctx) . '</li>');
        }
        #
        # 用語定義
        #
        elsif (/^:([^:]+):(.*)/) {
          &back_push('dl', 1, \@saved, \@result, '');
          push(@result, '<dt>' . &inline($1, $ctx) . '</dt>', '<dd>' . &inline($2, $ctx) . '</dd>');
        }
        #
        # 引用
        #
        elsif (/^(>{1,3})(.*)/) {
          &back_push('blockquote', length($1), \@saved, \@result, '');
          push(@result, &inline($2, $ctx));
        }
        #
        # (to   v.0.31) 改段落。空行もしくはスペースのみの場合…
        # (from v.0.40) 改段落。空行の場合…
        #
        #elsif (/^\s*$/) {
        elsif (/^$/) {
          if($lastLine =~ /^$/){
            ## do nothing
          }
          else{
            push(@result, splice(@saved));
            unshift(@saved, "</p>");
            push(@result, "<p>");
          }
        }
        #
        # 整形済みテキスト
        #
        elsif (/^(\s+.*)$/) {
          &back_push('pre', 1, \@saved, \@result, '');
          push(@result, &escape($1)); # Not &inline, but &escape
        }
        #
        # NORMAL LINES(with BR)
        #
        else {
          push(@result, &inline($_, $ctx));
          if($crlfForceFlag == 1){
            push(@result, '<br />');
          }
        }
        #最終処理行の保存
        $lastLine = $_;
      }
      #
      # フォーマット処理フラグが無効ならば、行の内容をそのまま吐き出す
      #
      else{
        push(@result, $_);
      }
    }
  }
  # 
  push(@result, splice(@saved));
  my $out = join("\n", @result);
  
  # restore line breaks within 'pre' blocks:
  #$out =~ s/&#28;/\n/gs;
  #$out =~ s/$;/\n/gs;
  return $out;
}

##インライン処理
sub inline {
  my ($text, $ctx) = @_;

  #inline処理をしない
  if($text =~ /\#(?:src|mama)\#{(({[^\}]+?}|[^\}])+)}/i){
    my ($left, $center, $right) = ($`, $1, $');
    my ($left_d) = &inline($left, $ctx);
    my ($right_d) = &inline($right, $ctx);
    $text = "$left_d$center$right_d";
  }
  elsif($text =~ /\`\`((?:[^(?:\`\`)]|.+))\`\`/i){
    my ($left, $center, $right) = ($`, $1, $');
    my ($left_d) = &inline($left, $ctx);
    my ($right_d) = &inline($right, $ctx);
    $text = "$left_d$center$right_d";
  }
  #inline処理をする
  else{
    #
    $text = &escape($text);
    
    # 明示的な改行
    $text =~ s|\\n|<br />|g;
    
    # テキストの装飾（省略記法）
    $text =~ s|==([^\=]+?)==|    '<s>' . &inline($1, $ctx) . '</s>'|gex;
    $text =~ s|__([^\_]+?)__|    '<u>' . &inline($1, $ctx) . '</u>'|gex;
    $text =~ s|''([^\']+?)''|    '<i>' . &inline($1, $ctx) . '</i>'|gex;
    $text =~ s|\*\*([^\*]+?)\*\*|'<b>' . &inline($1, $ctx) . '</b>'|gex;
    
    # リンク (url, title, attr)
    $text =~ s|\[\[([^\]]+?)\]\+\[([^\]]+?)\]\]|&inline_link($2, $1, 'new')|gex;
    $text =~ s|\[\[([^\]]+?)\]\[([^\]]+?)\]\]|&inline_link($2, $1, '')|gex;
    $text =~ s|\[\[([^\]]+?)\]\]|&inline_link($1, $1, 'new')|gex;

    # ルビ
    $text =~ s|&quot;([^(?&quot;)]+?)&quot;\(([^\)]+?)\)|'<ruby><rb>' .  $1 . '</rb><rp>(</rp><rt>' . $2 . '</rt><rp>)</rp></ruby>'|gex;
    
    # プラグイン
    $text =~ s/\@([^\@]+?)\@?{(({[^\}]+?}|[^\}])+)}/&inline_function($1, $2, $ctx)/gex;
    $text =~ s/\#([^\#]+?)\#?{(({[^\}]+?}|[^\}])+)}/&inline_function($1, $2, $ctx)/gex;
  } 
  return $text;
}

##インライン処理（リンク）
sub inline_link {
  my ($url, $title, $attr) = @_;
  if ($url =~ /^(http|https|ftp):/) {
    if ($url =~ /\.(gif|png|jpeg|jpg)$/) {
      if($attr ne 'new'){
        return qq(<img src="$url" alt="$title" />);
      }
      else{
        return qq(<a href="$url" target="_blank"><img src="$url" alt="$title" border="0" /></a>);
      }
    }
    else{
      if($attr eq 'new'){
        return qq(<a href="$url" target="_blank">$title</a>);
      }
      else{
        return qq(<a href="$url">$title</a>);
      }
    }
  }
  elsif ($url =~ /^(mailto):(.*)/) {
    return qq(<a href="$url">$title</a>);
  }
  else{
    return '';
  }
}

##インラインコマンド処理
sub inline_function {
  my ($commandName, $attr, $ctx) = @_;
  my $answer = '';

  ## 太字
  if($commandName =~ /^(b|bold)$/i){
    $answer = '<b>' . &inline($attr, $ctx) . '</b>';
  }
  ## 斜体
  elsif($commandName =~ /^(i|italic)$/i){
    $answer = '<i>' . &inline($attr, $ctx) . '</i>';
  }
  ## 下線
  elsif($commandName =~ /^(u|underline)$/i){
    $answer = '<u>' . &inline($attr, $ctx) . '</u>';
  }
  ## 取消線
  elsif($commandName =~ /^(s|strike)$/i){
    $answer = '<s>' . &inline($attr, $ctx) . '</s>';
  }
  ## 句引用
  elsif($commandName =~ /^(q|quote)$/i){
    $answer = '<q>' . &inline($attr, $ctx) . '</q>';
  }
  ## 強調
  elsif($commandName =~ /^x256$/i){
    $answer = '<strong class="x256">' . &inline($attr, $ctx) . '</strong>';
  }
  ## 色
  elsif($commandName =~ /^color$/i){
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = "<font color=\"$1\">" . &inline($2, $ctx) . '</font>';
  }
  ## 大きい
  elsif($commandName =~ /^big$/i){
    $answer = '<big>' . &inline($attr, $ctx) . '</big>';
  }
  ## 小さい
  elsif($commandName =~ /^small$/i){
    $answer = '<small>' . &inline($attr, $ctx) . '</small>';
  }
  ## ルビ
  elsif($commandName =~ /^(rb|ruby)$/i){
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = qq(<ruby><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby>);
  }
  ## 付箋注釈：ポップアップ
  elsif($commandName =~ /^(st|sticky)$/i){
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = qq(<span class="sticky" title="$2">$1</span>);
  }
  ## 注釈：本文
  elsif($commandName =~ /^(nb|notebody)$/i){
    my $permaUrl = $ctx->stash('entry')->permalink;
    $answer = qq(<a href="${permaUrl}#nm_$attr" name="nb_$attr" class="notebody" title="back...">$attr</a>);
  }
  ## 注釈：マーク
  elsif($commandName =~ /^(nm|notemark)$/i){
    my $permaUrl = $ctx->stash('entry')->permalink;
    $answer = qq(<a href="${permaUrl}#nb_$attr" name="nm_$attr" class="notemark" title="note: $attr">$attr</a>);
  }
  ## リンク
  elsif($commandName =~ /^(a|link)$/i){
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = qq(<a href="$2">$1</a>);
  }
  ## 画像インライン
  elsif($commandName =~ /^(img|image)$/i){
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = qq(<img src="$2" alt="$1" />);
  }
  ## 画像サムネイル表示
  elsif($commandName =~ /^(tn|thumbnail)$/i){
    $attr   =~ /([^\|]+)\|([^\|]+)\|(.+)/;
    $answer = qq(<a href="$3"><img src="$2" alt="$1" border="0" /></a>);
  }
  ## エスケープ済みのHTMLを戻す
  elsif($commandName =~ /^(=|html)$/i){
    $answer = &unescape($attr);
  }
  ## エスケープ済みのHTMLを戻す
  elsif($commandName =~ /^unescape$/i){
    $answer = &unescape($attr);
  }
  ## さらにエスケープする
  elsif($commandName =~ /^escape$/i){
    $answer = &escape($attr);
  }
  ## styleを適用する
  elsif($commandName =~ /^style$/i){
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = qq(<span style="$1">$2</span>);
  }
  ## 実体参照を表示する
  elsif($commandName =~ /^entity$/i){
    $answer = '&' . $attr . ';';
  }
  ## コメントアウトする
  elsif($commandName =~ /^comment$/i){
    $answer = qq(<!-- $attr -->);
  }
  elsif($commandName =~ /^plugin$/i){
    # 未実装
    $attr   =~ /([^\|]+)\|(.+)/;
    $answer = &inline_call_plugin($1, $2);
  }
  return $answer;
}

##プラグイン呼び出し処理
sub inline_call_plugin {
  my ($pluginName, $attr) = @_;
  my $answer = '';
  return $answer;
}

###############################################################
##ここからはYukiWiki(http://www.hyuki.com/yukiwiki/)から     ##
##抜粋引用させていただいているコードです。                   ##
###############################################################

#--------------------------------------------------------------
# original code from YukiWiki(http://www.hyuki.com/yukiwiki/)
#--------------------------------------------------------------
sub back_push {
  my ($tag, $level, $savedref, $resultref, $attr) = @_;
  while (@$savedref > $level) {
    push(@$resultref, shift(@$savedref));
  }
  #
  if(scalar(@{$savedref}) > 0){
    if ($savedref->[0] ne "</${tag}>") {
      push(@{$resultref}, splice(@{$savedref}));
    }
  }
  #
  while (@$savedref < $level) {
    unshift(@$savedref, "</$tag>");
    push(@$resultref, "<$tag$attr>");
  }
}

#--------------------------------------------------------------
# original code from YukiWiki(http://www.hyuki.com/yukiwiki/)
#--------------------------------------------------------------
sub escape {
  my $s = shift;
  $s =~ s|\r\n|\n|g;
  $s =~ s|\&|&amp;|g;
  $s =~ s|<|&lt;|g;
  $s =~ s|>|&gt;|g;
  $s =~ s|\"|&quot;|g;
  return $s;
}

#--------------------------------------------------------------
# original code from YukiWiki(http://www.hyuki.com/yukiwiki/)
#--------------------------------------------------------------
sub unescape {
  my $s = shift;
  # $s =~ s|\n|\r\n|g;
  $s =~ s|\&amp;|\&|g;
  $s =~ s|\&lt;|\<|g;
  $s =~ s|\&gt;|\>|g;
  $s =~ s|\&quot;|\"|g;
  return $s;
}

1;