# -*- cperl -*-
# -----------------------------------------------------------------------------
package Celaenito::Httpd::Show;
use strict;
use warnings;
use HTTP::Status;
use Celaenito::Permission;
use Celaenito::FileStorage;
use Celaenito::Template;
use Celaenito::DB;
use Celaenito::Curi;
use Celaenito::StaticFile;
use Celaenito::Config;
use Celaenito::Httpd;
use Date::Parse;
use SQLTime;
use Smart::Comments;

sub handler {
    my ($req, $resp) = @_;

    not CAN_SEE($req) and
      return need_auth_handler(@_);

    my $uri;
    my %opts;

    if ($req->uri->path_query =~ m|^/latest/(.+?)/(.+)$|) {
	# /latest/...
	$uri = URI->new(sprintf "$1://$2");
	$opts{time} = 'latest';
    }
    else {
	# FIXME: 増しなエラー画面を
	die "unknown url format: ".$req->uri->as_string;
    }
    # /latest/http/www.foobar.com:80/ となる筈が
    # /latest/http/www.foobar.com%3a80/ となつてゐる場合がある
    if ($uri->host =~ m/^(.+?)%3a(\d+)$/i) {
	$uri->host_port("$1:$2");
    }
    $uri = $uri->canonical;

    # target_urlから探す。フラグメントは消されてゐる事に注意。
    my $urlinfo = DB->selectrow_hashref(q{
        SELECT *
          FROM target_url
         WHERE url = ?
    }, undef, do { $_ = $uri->clone;
		   $_->fragment(undef);
		   $_->as_string });
    if (!$urlinfo) {
	if ($uri->path !~ m|/$|) {
	    # /で終はつてゐないなら、これを付けて再檢索してみる。
	    $urlinfo = DB->selectrow_hashref(q{
		SELECT *
		  FROM target_url
		 WHERE url = ?
		}, undef, do { $_ = $uri->clone;
			       $_->fragment(undef);
			       $_->path($_->path . '/');
			       $_->as_string });
	    if ($urlinfo) {
		# 見付かった！リダイレクトする。
		$resp->header(Location => do {
		    $_ = $req->uri->clone;
		    $_->path($_->path . '/');
		    $_->as_string;
		});
		return RC_MOVED_PERMANENTLY;
	    }
	}
    }

    my $version_to_show = do {
	if ($opts{time} eq 'latest') {
	    if ($urlinfo) {
		FS->get_latest_version($urlinfo->{urlid});
	    }
	    else {
		undef;
	    }
	}
	else {
	    die "Internal Error: unknown time option `$opts{time}'";
	}
    };

    unless (defined $version_to_show) {
	my $t = {
	    title => config('ui.title'),
	    url   => $uri->as_string,
	};
	
	my $out = '';
	TMPL->process('not_found.tt', $t, \$out)
	  or die Template->error;
	
	$resp->content($out);
	return RC_NOT_FOUND;
    }

    my $info = FS->get_info(
	$urlinfo->{urlid}, $version_to_show);

    # If-Modified-Sinceが付いてゐれば、timestampと比較して
    # それよりも遅ければ304 Not Modifiedを返す。
    if (my $ims = $req->headers->if_modified_since) {
	my $last_modified = sqlparsetime($info->{timestamp});
	
	if ($ims >= $last_modified) {
	    $resp->headers->last_modified(
		sqlparsetime $info->{timestamp});
	    return RC_NOT_MODIFIED;
	}
    }

    my $sth;
    my $get_urlid = sub {
	my $uri = shift;
	
	unless ($sth) {
	    $sth = DB->prepare(q{
                SELECT urlid
                  FROM target_url
                 WHERE url = ?
            });
	}
	$sth->execute("$uri");
	($_) = $sth->fetchrow_array;
	$_;
    };

    my ($content, $links) = FS->get_content(
	$urlinfo->{urlid}, $version_to_show);

    # リンクの書換へ:
    # 相對リンクも全て絶對リンクに書換へてしまふ爲、
    # <base>タグが殘つてゐても問題にはならない。
    my $delta = 0; # 位置のずれ
    foreach my $link (@$links) {
	my $absuri = URI->new_abs(
	    $link->[2], $link->[3] || $urlinfo->{url});

	# この位置に實際にURLが存在する事を確認する
	my $check_substr = substr(
	    $content,
	    $link->[0] + $delta,
	    length($link->[2]));
	if ($check_substr ne $link->[2]) {
	    die sprintf 'Internal Error: offset %d of the content starts with [%s] instead of [%s]',
	      $link->[0] + $delta, $check_substr, $link->[2];
	}

	# この URL が保存濟でなければ Celaenito URL にはしない。
	my $canon = do {
	    $_ = $absuri->clone;
	    $_->fragment(undef);
	    $_->canonical;
	};

	# 新しいリンクを作る
	my $new_uri = do {
	    if ($get_urlid->($canon)) {
		celaenito_uri(
		    host_uri => $req->uri,
		    orig_uri => $absuri,
		    time     => $opts{time},
		   );
	    }
	    else {
		$absuri;
	    }
	};

	# 書換への前後で長さが變はれば、以降のオフセットも
	# 補正しなければならない。
	substr($content, $link->[0] + $delta, length $link->[2])
	  = $new_uri->as_string;
	$delta += length($new_uri->as_string) - length($link->[2]);
    }

    if ($_ = $info->{content_type}) {
	$resp->header('Content-Type' => $info->{content_type});
    }
    else {
	$resp->header('Content-Type' => 'application/octet-stream');
    }

    $resp->headers->last_modified(
	sqlparsetime $info->{timestamp});

    # FIXME: ETag

    $resp->content($content);
    return RC_OK;
}

1;
