#!/usr/bin/perl
#-------------------------------------------------------------------------------
# tDiaryデータをadiary形式に変換	Version 1.0	2006/05/24 (C)nabe@abk
#-------------------------------------------------------------------------------
#[EUC-JP], [Lisence GPL2]
#
#   tDiary の標準形式のデータを adiary形式に変換します。adiaryを介してさらに、
# Movable Type形式などに変換することもできます。
#
#（使い方）
# 　tDiary本体（index.rb と update.rb のあるディレクトリ）にこのファイルを
# おいてください（ログディレクトリでも構いません）。あとはブラウザからこの
# cgi にアクセスし実行すればオーケーです（Ruby ではなく perl 5 が必要です）。
#
#（本文をはてな入力スタイルに変換）
# 　cgi にアクセスする際、?parse と引数をつけることで、本文をはてな準拠の
# 形式に変換できます。
#	（例）http://www.xxx.jp/~user/tdiary/tdiary2adiary.cgi?parse
# この書式で出されたデータはそのままはてなダイアリーでインポートできます。
# また、adiaryでもインポートできます（標準パーサー使用になります）。
#
#（高度な使い方）
#   このスクリプトはコマンドラインからも実行することができます。その場合は、
# カレントディレクトリを tDiary 本体またはログディレクトリと同じにするか、
# 引数に処理したいログディレクトリを指定してください。
#-------------------------------------------------------------------------------
require 5.004;
use strict;
use Fcntl;
use Symbol;	# for File Handle
#-------------------------------------------------------------------------------
# 設定部
#-------------------------------------------------------------------------------
my $log_dir     = './';			# tDiaryログdir
my $conf_file   = './tdiary.conf';	# tDiary configファイル
my $parser      = 'tdiary';		# adiaryパーサー選択
my $parse_flag  = 0;			# はてな/adiaryスタイル向けに書式変換する
my $adiary_flag = 1;			# はてなデータ/adiaryデータ判別フラグ
my $filename    = 'adiary.xml';		# 出力ファイル名

my $charset     = 'EUC-JP';		# tDiary標準文字コード
my $out_charset = 'UTF-8';		# 出力XML文字コード
my $http = ($ENV{SERVER_PROTOCOL} ne '');
#-------------------------------------------------------------------------------
# 引数解析
#-------------------------------------------------------------------------------
my $arg = $ARGV[0];
# はてな形式に本文変換？
if ($ENV{QUERY_STRING} =~ /parse/i) { $parse_flag=1; $arg=undef; }
if ($arg =~ /-parse/i) {
	$arg = $ARGV[1];
	$parse_flag = 1;
}
if ($parse_flag) {
	$parser = 'default_p1';
	$adiary_flag=0;
}

# ディレクトリ指定
if ($arg ne '') {
	$log_dir   = $arg;		# tDiaryログdir
	$conf_file = $arg . $conf_file;	# tDiary configファイル
}

#-------------------------------------------------------------------------------
# 文字コード変換のロード
#-------------------------------------------------------------------------------
my $jcode;
if ($charset ne $out_charset && $] > 5.008000) {
	eval 'use Encode; use Encode::Guess qw(euc-jp shiftjis iso-2022-jp)';
	if (! $@) { $jcode = 1; }
}
if (!$jcode) { $out_charset=$charset; }	# コード変換できないとき

#-------------------------------------------------------------------------------
# ヘッダ出力
#-------------------------------------------------------------------------------
if ($http) {	# HTTP ヘッダ出力
		print <<HEADER;
Content-Disposition: attachment; filename=$filename
Content-Type: text/xml; charset=$out_charset;

HEADER
}
#-------------------------------------------------------------------------------
# ログディレクトリの解析
#-------------------------------------------------------------------------------
{
	my $lines = &fread_lines( $conf_file );
	foreach(@$lines) {
		if ($_ =~ /\@data_path\s*=\s*'(.*?)'/) { $log_dir = $1; last; }
	}
}

#-------------------------------------------------------------------------------
# 処理するファイルリスト作成
#-------------------------------------------------------------------------------
my @diary_files;
{
	my $dirs = &search_files($log_dir, undef, 1);		# ディレクトリ検索
	foreach my $year (@$dirs) {
		if ($year !~ /^\d\d\d\d$/) { next; }		# year 式
		my $dir = "$log_dir$year/";
		my $files = &search_files($dir, '.td2');
		foreach(@$files) {
			if ($_ =~ /(\d\d\d\d\d\d)\.td2/) { push(@diary_files, "$dir$1"); }
		}
	}
}
#-------------------------------------------------------------------------------
# 変換処理の実行
#-------------------------------------------------------------------------------
print <<XML_HEADER;
<?xml version="1.0" encoding="$out_charset"?>
<diary>
XML_HEADER

foreach my $file (@diary_files) {
	my @diaries;
	my %comments;
	my %trackbacks;
	#--------------------------------------------------
	# .td2 の解析
	#--------------------------------------------------
	my $lines = &fread_lines( "$file.td2" );
	my $header = shift(@$lines);
	if ($header !~ /^TDIARY2/) { next; }	# tdiaryファイルでなければ無視
	my $date;
	while(@$lines) {
		my $diary = &parse_tdiary_data_file( $lines );
		if (! $diary->{date}) { next; }			# 日付のないデータは無視
		if ($parse_flag) { $diary->{body} = &tdiary2hatena( $diary->{body} ); }
		push(@diaries, $diary);
	}
	#--------------------------------------------------
	# .tdc の解析
	#--------------------------------------------------
	my $lines = &fread_lines( "$file.tdc" );
	my $header = shift(@$lines);
	if ($header !~ /^TDIARY2/) { $lines = []; }
	while(@$lines) {
		my $comment = &parse_tdiary_data_file( $lines );
		# データ記録
		my $date = $comment->{date};
		if (! $date) { next; }			# 日付のないデータは無視
		if ($comment->{name} ne 'TrackBack') {
			my $ary = $comments{$date}   ||= [];	# 配列 ref
			push(@$ary, $comment);
		} else {
			my $ary = $trackbacks{$date} ||= [];	# 配列 ref
			push(@$ary, $comment);
		}
		#    $ary = $trackbacks{$date} ||= [];
		# は次と等価
		#    if (! $trackbacks{$date}) { $trackbacks{$date}=[]; }
		#    $ary = $trackbacks{$date};
	}
	#--------------------------------------------------
	# 出力
	#--------------------------------------------------
	foreach my $day (@diaries) {
		my @out;
		#--------------------------------------------------
		# 日記本文
		#--------------------------------------------------
		my $date = $day->{date};
		$day->{date} = substr($date, 0, 4) . '-' . substr($date, 4, 2) . '-'  . substr($date, 6, 2);
		if ($day->{visible} =~ /true/i) { $day->{enable}=1; } else { $day->{enable}=0; }
		$day->{tm} = int($day->{"last-modified"});		# 書き込み時刻代わりに使う

		my $body = join('', @{ $day->{body} });
		&tag_escape($day->{title}, $body);
		push(@out, <<DIARY);
<day date="$day->{date}" title="$day->{title}">
<attributes enable="$day->{enable}" tm="$day->{tm}" parser="$parser" adiary="$adiary_flag"></attributes>
<body>$body</body>
DIARY
		#--------------------------------------------------
		# コメント
		#--------------------------------------------------
		my $comments = $comments{$date} || [];
		if (@$comments) { push(@out, "<comments>\n"); }
		foreach(@$comments) {
			$_->{tm} = int($_->{"last-modified"});		# 書き込み時刻
			if ($_->{visible} =~ /false/i) { $_->{hidden}=1; } else { $_->{hidden}=0; }

			my $body = join('', @{ $_->{body} });
			$body =~ s/\n/<br>/g;
			&tag_escape($_->{name}, $body);
			push(@out, <<COMMENT);
<comment>
<username>$_->{name}</username>
<hidden>$_->{hidden}</hidden>
<timestamp>$_->{tm}</timestamp>
<body>$body</body>
</comment>
COMMENT
		}
		if (@$comments) { push(@out, "</comments>\n"); }
		#--------------------------------------------------
		# トラックバック
		#--------------------------------------------------
		my $trackbacks = $trackbacks{$date} || [];
		if (@$trackbacks) { push(@out, "<trackbacks>\n"); }
		foreach(@$trackbacks) {
			$_->{tm} = int($_->{"last-modified"});		# 書き込み時刻
			if ($_->{visible} =~ /false/i) { $_->{hidden}=1; } else { $_->{hidden}=0; }

			my $body = $_->{body};
			$_->{url}       = shift( @$body );	# 1行目=URL
			$_->{blog_name} = shift( @$body );	# 2行目=blog名
			$_->{title}     = shift( @$body );	# 3行目=タイトル
			chomp($_->{url}, $_->{blog_name}, $_->{title});

			$body = join('', @$body );
			$body =~ s/\n//g;
			&tag_escape($_->{name}, $_->{url}, $_->{blog_name}, $_->{title}, $body);
			push(@out, <<TRACKBACK);
<trackback>
<timestamp>$_->{tm}</timestamp>
<url>$_->{url}</url>
<blog_name>$_->{blog_name}</blog_name>
<title>$_->{title}</title>
<body>$body</body>
</trackback>
TRACKBACK
		}
		if (@$trackbacks) { push(@out, "</trackbacks>\n"); }
		#--------------------------------------------------
		# 文字コード変換をして出力
		#--------------------------------------------------
		{
			push(@out, "</day>\n");
			my $out = join('', @out);
			if ($jcode) { Encode::from_to($out, $charset, $out_charset); }
			local($|) = 1;	# 出力後、バッファクリア
			print $out;
		}
	}
}
print "</diary>\n";
exit(0);

###############################################################################
# ■サブルーチン
###############################################################################
#------------------------------------------------------------------------------
# ●データファイルのパース
#------------------------------------------------------------------------------
sub parse_tdiary_data_file {
	my $lines = shift;
	my %hash;
	while(shift(@$lines) =~ /^([\w\-]+):\s*(.*)\n/) {	# ヘッダ解析
		my $key = $1;
		$key =~ tr/A-Z/a-z/;
		$hash{$key} = $2;
	}
	my @text;
	my $category_flag = 1;
	my $prev = "\n";
	while(@$lines && (my $line = shift(@$lines)) ne ".\n") {	# ヘッダ解析
		if (ord($line) == 0x2e) { $line=substr($line,1); }	# .. → . に変換
		if ($category_flag && $prev eq "\n" && $line =~ /^\[(.+?)\]/) {
			$hash{category} = $1;
			$category_flag  = 0;
		}
		push(@text, $line);
		$prev = $line;		# １つ前の行
	}
	if ($text[$#text] eq "\n") { pop(@text); }
	$hash{body} = \@text;
	return \%hash;
}

#------------------------------------------------------------------------------
# ●本文のパース
#------------------------------------------------------------------------------
sub tdiary2hatena {
	my ($lines) = @_;

	my @ary;
	my @section;
	my $in_section = 0;
	push(@$lines, "\n");	# 必ずsectionを閉じるために付加
	foreach(@$lines) {
		my $s1 = substr($_, 0, 1);
		my $s2 = substr($_, 0, 2);
		# amazonタグの対応
		$_ =~ s/<%=(isbn.*?)%>/&amazon($1)/eg;

		#----------------------------------------------------
		# セクション中である
		#----------------------------------------------------
		if ($in_section) {
			if ($_ eq "\n") {		# セクションの終わり
				if ($in_section < 0) {		# <p> 禁止セクション
					unshift(@section, "><div>\n");	# <p>
					push   (@section, "</div><\n");	# <p>
				}
				foreach(@section) { push(@ary, $_); }
				push(@ary, "\n");
				@section = ();
				$in_section=0;
				next;
			}
			# 行頭記法を escape
			$_ =~ s/^([\-\+\*|:=])/ $1/;
			push(@section, $_);
			# '<'で始まる行がある場合、<p>を挿入しない
			if (ord($s1) == 0x3c) { $in_section=-1; }
			next;
		}
		#----------------------------------------------------
		# セクション外
		#----------------------------------------------------
		if ($_ eq "\n") { next; }
		#----------------------------------------------------
		# セクションの始まり
		#----------------------------------------------------
		$in_section = 1;
		if ($s1 eq '<' && $s2 ne '<<') {	# tagなセクション(p禁止)
			$in_section = -1;
			push(@section, $_);	# セクションに積む
			next;
		}
		if ($s1 eq ' ') {		# 先頭が半角スペース？
			$_ = substr($_, 1);
			push(@section, $_);
			next;
		}
		if ($s2 eq '　') {		# 先頭が全角スペース？
			$_ = substr($_, 2);
			push(@section, $_);
			next;
		}
		# それ以外は、セクションタイトル
		if ($s2 eq '<<') {		# tagなサブタイトル
			$_ = substr($_, 1);
			push(@ary, "*$_\n");
			next;
		}
		push(@ary, "*$_\n");
	}
	return \@ary;
}

#------------------------------------------------------------------------------
# ○amazonタグの書き換え
#------------------------------------------------------------------------------
sub amazon {
	my $tag = shift;
	if ($tag =~ /^isbn_image.*?"(.*?)"/)   { return "[isbn:$1:image]";    }
	if ($tag =~ /^isbn.*"(.*?)".*"(.*?)"/) { return "[isbn:$1:title=$2]"; }
	if ($tag =~ /^isbn.*"(.*?)"/)          { return "[isbn:$1]";          }
	return '';
}

###############################################################################
# ■雑多なサブルーチン
###############################################################################
#------------------------------------------------------------------------------
# ●タグのエスケープ
#------------------------------------------------------------------------------
sub tag_escape {
	foreach(@_) {
		$_ =~ s/&/&amp;/g;
		$_ =~ s/</&lt;/g;
		$_ =~ s/>/&gt;/g;
		$_ =~ s/"/&quot;/g;
	}
	return $_[0];
}

#------------------------------------------------------------------------------
# ●ファイル：すべての行を読み込む
#------------------------------------------------------------------------------
sub fread_lines {
	my ($file) = @_;
	my $fh = Symbol::gensym();
	if ( !sysopen($fh, $file, O_RDONLY) ) { return []; }
	my @lines = <$fh>;
	close($fh);
	return \@lines;
}

#------------------------------------------------------------------------------
# ●ファイルを検索する
#------------------------------------------------------------------------------
# search_files("directory name", "file extension", $dir_flag);
#	拡張子は ".txt" のように指定する
#	拡張子を省略した場合、すべてのリストが返る
#	$dir_flag = 1 を指定すると、ディレクトリも含めすべてのリストが返る
sub search_files {
	my ($dir, $file_ex, $dir_flag) = @_;

	my $fh  = Symbol::gensym();
	my $len = length($file_ex);
	my @filelist;
	opendir($fh, $dir) || return [];
	foreach(readdir($fh)) {
		if ($_ eq '.' || $_ eq '..' )  { next; }	# ./ ../ は無視
		if (!$dir_flag && -d "$dir$_") { next; }	# ディレクトリは無視
		if ($len) {	# 拡張子指定あり
			if (substr($_, -$len) ne $file_ex) { next; }	# 末尾であるか確認
		}
		push(@filelist, $_);
	}
	closedir($fh);

	@filelist = sort @filelist;
	return \@filelist;
}