#!perl
use lib '.';
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use Jcode;
my $title = 'TinyTiny';
my $data_dir = './data';
my $top_page = 'トップページ';
my $new_page = '（新規ページ）';

&main;

sub main {
	my $query = CGI->new;
	my $mode = &initialize($query);
	my $html = &$mode($query);
	&output($query, $mode, $html) if (defined($html));
}

sub initialize {
	my $query = shift;
	my $mode = $query->param('mode');
	my $page = $query->param('page');
	if ($mode eq 'top') { ($mode, $page) = ('show', $top_page); }
	elsif ($mode eq 'add') { ($mode, $page) = ('edit', $new_page); }
	elsif ($mode eq 'list') { $page = ''; }
	$mode = 'show' unless (grep { $_ eq $mode } qw(show list edit save));
	$page = $top_page unless (defined($page));
	$page = jcode($page)->euc;
	$query->param(-name => 'mode', -value => $mode);                            # (2)
	$query->param(-name => 'page', -value => $page);                            # (2')
	return $mode;
}

sub output {
	my ($query, $mode, $html) = @_;
	my $url = $query->url;
	my $page = $query->param('page');
	my $page_url = &encodeURL($page);
	my $style = 'padding: 3px; text-align: right; background-color: #dddddd;';
	my $title = length($page) ? "$title - " . CGI::escapeHTML($page) : $title;
	print $query->header('-charset' => 'EUC-JP'), $query->start_html(-title => $title), "\n";
	print "<h1>$title</h1>\n";
	my @modes = map { "[<a href=\"$url?mode=$_\">$_</a>]" } ('top', 'list', 'add');
	if ($mode eq 'show') {
		push(@modes, "[<a href=\"$url?mode=edit&page=$page_url\">edit</a>]");   # (3)
	} elsif ($mode eq 'edit' or $mode eq 'save') {
		push(@modes, "[<a href=\"$url?mode=show&page=$page_url\">show</a>]");   # (3')
	}
	print qq(<p style="$style">) . join(' ', @modes) . "</p>\n";
	print $html;
	print $query->end_html;
}

sub show {
	my $query = shift;
	my $text = CGI::escapeHTML(&page_read($query));
	$text = jcode('（ページが未作成です）')->euc if (not defined($text));
	$text =~ s/\r?\n/<br \/>\n/g;
	$text =~ s/\t/    /g;
	$text =~ s/(  +)/sprintf('<span style="width:%.1fem;">%s<\/span>', length($1) * 0.5, $1)/ge;
	my $re_wiki = '\[\[.*?\]\]';                                                # (4)
	my $re_bracket = '([A-Z][a-z]+){2,}';
	my $re_url = 's?https?:\\/\\/[-_.!~*\'()a-zA-Z0-9;\\/?:\\@&=+\\$,%#]+';
	$text =~ s/($re_wiki|$re_bracket|$re_url)/&conv_to_link($query, $1)/goe;    # (4')
	return $text;
}

sub conv_to_link {
	my $query = shift;
	my $link = shift;
	if ($link =~ /^s?https?:/) {
		$link = CGI::escapeHTML($link);
		return "<a href=\"$link\">$link</a>";
	} else {
		$link =~ s/^\[\[(.*)\]\]$/$1/;
		return sprintf('<a href="%s?mode=show&page=%s">%s</a>', $query->url, &encodeURL($link), CGI::escapeHTML($link));
	}
}

sub edit {
	my $query = shift;
	my $text = &page_read($query);
	my $html = $query->start_form();
	$html .= $query->textarea(-name=>'text', -default=>$text, -rows=>15, -columns=>60) . $query->br;
	$html .= $query->textfield(-name=>'page');                                  # (5)
	$html .= $query->submit(-name=>'mode', -value=>'save');
	$html .= $query->end_form();
	return $html;
}

sub save {
	my $query = shift;
	my $result = &page_write($query);
	return CGI::escapeHTML($result);
}

sub list {
	my $query = shift;
	my $html = "<table>\n";
	my $url = $query->url;
	foreach my $page (&get_page_list()) {                                       # (6)
		my ($page_html, $page_url) = (CGI::escapeHTML($page), &encodeURL($page));
		$html .= qq(<tr><td>$page_html</td><td>[<a href="$url?mode=show&page=$page_url">show</a>]</td><td>[<a href="$url?mode=edit&page=$page_url">edit</a>]</td></tr>\n);
	}
	return "<table>\n$html</table>\n";
}

sub page_read {
	my $query = shift;
	my $file = &get_file_name($query->param('page')) or return undef;           # (7)
	my $text = undef;
	if (-f $file and open(IN, $file)) {
		local $/ = undef;
		$text = <IN>;
		close(IN);
	}
	return $text;
}

sub page_write {
	my $query = shift;
	my $text = $query->param('text');
	my $file = &get_file_name($query->param('page')) or return undef;           # (7')
	my $result = "ページを更新できませんでした。";
	if (defined($text) and length($text)) {
		if (open(OUT, ">$file")) {
			$text =~ s/(:?\x0D\x0A|\x0D|\x0A)/\n/g;
			print OUT jcode($text)->euc;
			close(OUT);
			$result = "ページが更新されました。";
		}
	} elsif (unlink($file)) {
		$result = "ページが削除されました。";
	}
	return jcode($result)->euc;
}

sub encodeURL {
	my $str = shift;
	$str =~ s/(\W)/'%' . unpack('H2', $1)/eg;
	return $str;
}

sub get_file_name {
	my $page = shift;
	$page = (defined($page) and length($page)) ? jcode($page)->euc : undef;
	return undef if ($page eq undef or $page eq $new_page);
	$page = &encodeURL($page);
	return "$data_dir/$page";
}

sub get_page_name {
	my $file = shift;
	return undef unless (defined($file) and $file =~ s/^\Q$data_dir\/\E//);
	$file =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
	return $file;
}

sub get_page_list {
	my @pages = grep {-f $_} glob("$data_dir/*");
	@pages = grep { defined($_) } map { $_ = &get_page_name($_) } @pages;
	@pages = sort { lc($a) cmp lc($b) or $a cmp $b } @pages;
	return @pages;
}