#!/usr/bin/perl

package Mail::Summary::Tools::Output::HTML;
use Moose;

use HTML::Element;
use Text::Markdown ();
use HTML::Entities;

use utf8;

has body_only => (
	isa => "Bool",
	is  => "rw",
	default => 0,
);

has strip_divs => (
	isa => "Bool",
	is  => "rw",
	default => 0,
);

has lang => (
	isa => "Str",
	is  => "rw",
	default => "en",
);

has summary => (
	isa => "Mail::Summary::Tools::Summary",
	is  => "rw",
	required => 1,
);

has description => (
	isa => "Str",
	is  => "rw",
	default => "Mailing list summary",
);

has generator => (
	isa  => "Str",
	is   => "rw",
	lazy => 1,
	default => sub {
		my $self = shift;
		require Mail::Summary::Tools;
		return __PACKAGE__ . " version $Mail::Summary::Tools::VERSION";
	},
);

sub process {
	my $self = shift;

	my @tree = HTML::Element->new_from_lol( $self->body_only ? $self->body : $self->document_structure );

	@tree = $self->scrub(@tree);

	$self->emit(@tree);

}

sub document_structure {
	my $self = shift;

	return (
		[html => { xmlns => "http://www.w3.org/1999/xhtml", 'xml:lang' => $self->lang },
			[head =>
				[title => $self->summary->title ],
				[meta => { 'http-equiv' => "Content-Type", content => "text/html; charset=utf-8" }],
				[meta => { name => "description", content => $self->description }],
				[meta => { name => "generator",   content => $self->generator }],
				$self->css,
			],
			[body => 
				$self->toc,
				$self->body,
			],
		
		]
	);
}

sub scrub {
	my ( $self, @tree ) = @_;

	if ( $self->strip_divs ) {
		@tree = $self->scrub_strip_divs(@tree);
	}

	return @tree;
}

sub scrub_strip_divs {
	my ( $self, @tree ) = @_;

	foreach my $subtree ( @tree ) {
		foreach my $div ( $subtree->find_by_tag_name('div') ) {
			$div->replace_with_content if defined $div->parent;
		}
	}

	map { ($_->tag eq "div") ? $_->content_list : $_ } @tree;
}

sub emit {
	my ( $self, @tree ) = @_;
	return @tree;
}

sub template_snippet {
	my ( $self, $snippet, %vars ) = @_;
	
	my $out;	

	my $tt = $self->template_obj;

	$tt->process(
		\$snippet,
		{
			%vars,
			html => $self,
		},
		\$out,		
	) || warn $tt->error . " in $snippet";

	return $out;
}

sub markdown {
	my ( $self, $text ) = @_;

	$text =~ s/<((?:msgid|rt):\S+?)>/$self->expand_uri($1)/ge;
	$text =~ s/\[(.*?)\]\(((?:msgid|rt):\S+?)\)/$self->expand_uri($2, $1)/ge;

	my $html = Text::Markdown::markdown( $text );

	# non ascii stuff gets escaped (accents, etc), but not punctuation, which
	# markdown will handle for us
	['~literal' => { text => $self->escape_unicode($html) } ];
}

sub rt_uri {
	my ( $self, $rt, $id ) = @_;
	
	if ( $rt eq "perl" ) {
		return "http://rt.perl.org/rt3/Public/Bug/Display.html?id=$id";
	} else {
		die "unknown rt installation: $rt";
	}
}

sub link_to_message {
	my ( $self, $message_id, $text ) = @_;

	my $thread = $self->summary->get_thread_by_id( $message_id )
		|| die "The link to <$message_id> could not be resolved, because no thread with that message ID is in the summary data";

	my $uri;
	
	if ( $thread->hidden ) {
		$uri = $thread->archive_link->thread_uri;
	} else {
		$uri = URI->new;
		$uri->fragment($message_id);
	}

	$text ||= $thread->subject;

	"[$text]($uri)";
}

sub expand_uri {
	my ( $self, $uri_string, $text ) = @_;

	my $uri = URI->new($uri_string);

	if ( $uri->scheme eq 'rt' ) {
		my ( $rt, $id ) = ( $uri->authority, substr($uri->path, 1) );
	   	my $rt_uri = $self->rt_uri($rt, $id);
		$text ||= "[$rt #$id]";
		return "[$text]($rt_uri)";
	} elsif ( $uri->scheme eq 'msgid' ) {
		return $self->link_to_message( join("", grep { defined } $uri->authority, $uri->path), $text );
	} else {
		die "unknown uri scheme: $uri";
	}
}

sub escape_unicode {
	my ( $self, $text ) = @_;
	$self->escape_html($text, '^\p{IsASCII}');
}

sub escape_html {
	my ( $self, $text, @extra ) = @_;
	HTML::Entities::encode_entities($text, @extra);
}

sub div {
	my ( $self, $class_spec, @elems ) = @_;

	my $class_attr = (ref $class_spec
		? join(" ", @$class_spec)
		: $class_spec );

	[ div => { class => $class_attr }, @elems ];
}

has h1_tag => (
	isa => "ArrayRef",
	is  => "rw",
	auto_deref => 1,
	default => sub { ["h1"] },
);

sub wrap_tags {
	my ( $self, $tags, @elems ) = @_;

	if ( @$tags ) {
		my ( $outer, @inner ) = @$tags;
		return [ $outer => $self->wrap_tags( \@inner, @elems ) ];
	} else {
		return @elems;
	}
}

sub h1 {
	my ( $self, @inner ) = @_;
	my $tag = $self->h1_tag;
	$self->wrap_tags( $tag, @inner );
}

has h2_tag => (
	isa => "ArrayRef",
	is  => "rw",
	auto_deref => 1,
	default => sub { ["h2"] },
);

sub h2 {
	my ( $self, @inner ) = @_;
	my $tag = $self->h2_tag;
	$self->wrap_tags( $tag, @inner );
}

has h3_tag => (
	isa => "ArrayRef",
	is  => "rw",
	auto_deref => 1,
	default => sub { ["h3"] },
);

sub h3 {
	my ( $self, @inner ) = @_;
	my $tag = $self->h3_tag;
	$self->wrap_tags( $tag, @inner );
}

sub toc {
	my $self = shift;
	return ();
}

sub body {
	my $self = shift;

	return [ div => { id => "summary_container" },
		$self->header,
		$self->lists,
		$self->footer,
	];
}

sub header {
	my $self = shift;
	my @parts;
	
	return [ div => { id => "summary_header" },
		$self->h1( $self->summary->title || "Mailing list summary" ),
		$self->custom_header,
	];
}

sub custom_header {
	my $self = shift;

	if ( my $header = eval { $self->summary->extra->{header} } ) {
		return ( map { $self->custom_header_section( $_ ) } @$header );
	} else {
		return;
	}
}

sub custom_header_section {
	my ( $self, $section ) = @_;

	return $self->div( header_section => $self->generic_custom_section( $section ) );
}

sub footer {
	my $self = shift;
	
	return [ div => { id => "summary_footer" },
		$self->custom_footer,
		$self->see_also,
	];
}

sub custom_footer {
	my $self = shift;

	if ( my $footer = eval { $self->summary->extra->{footer} } ) {
		return ( map { $self->custom_footer_section( $_ ) } @$footer );
	} else {
		return;
	}
}

sub custom_footer_section {
	my ( $self, $section ) = @_;
	return $self->div( footer_section => 
		$self->generic_custom_section( $section ),
	);
}

sub generic_custom_section {
	my ( $self, $section ) = @_;

	my $title = $section->{title} || return;

	my $heading = $self->h2( $title );

	if ( my $body = $section->{body} ) {
		return (
			$heading,
			$self->markdown( $section->{body} ),
		);
	} else {
		return $heading;
	}
}

sub see_also {
	my $self = shift;

	if ( my $see_also = eval { $self->summary->extra->{see_also} } ) {
		return [ div => { id => "see_also", class => "footer_section" },
			$self->see_also_heading($see_also),
			$self->see_also_links($see_also),
		];
	} else {
		return;
	}
}

sub see_also_heading {
	my ( $self, $see_also ) = @_;
	$self->h2("See Also");
}	

sub see_also_links {
	my ( $self, $see_also ) = @_;	
	[ ul => map { [ li => $self->see_also_link($_) ] } @$see_also ];
}

sub see_also_link {
	my ( $self, $item ) = @_;
	[a => { href => $item->{uri} }, $item->{name} ];
}

sub lists {
	my $self = shift;

	return $self->div( summary_container_body => 
		map { $self->list($_) } $self->summary->lists
	);
}

sub list {
	my ( $self, $list ) = @_;

	( my $id = $list->name ) =~ s/[^\w]+/_/g;
	
	my @body = $self->list_body($list);

	if ( @body ) {
		return [ div => { id => "summay_list_$id", class => 'summary_list' },
			$self->list_header($list),
			@body,
			$self->list_footer($list),
		];
	} else {
		return;
	}
}

sub list_header {
	my ( $self, $list ) = @_;

	return (
		$self->list_heading($list),
		$self->list_description($list),
	);
}

sub list_heading {
	my ( $self, $list ) = @_;

	my $title = $self->list_title($list) || return;

	$self->h2( $title, $self->list_heading_extra($list) );
}

sub list_heading_extra {
	my ( $self, $list ) = @_;
	# e.g. " (perl6-compiler)"... maybe $list->extra->{remark} || $list->name
	return;
}

sub list_title {
	my ( $self, $list ) = @_;

	my $title = $list->title || $list->name || return;

	if ( my $uri = eval { $list->extra->{uri} } ) {
		return [a => { href => $uri }, $title ],
	} else {
		return $title,
	}
}

sub list_description {
	my ( $self, $list ) = @_;

	if ( my $description = eval { $list->extra->{description} } ) {
		$self->markdown( $description );
	} else {
		return;
	}
}

sub list_body {
	my ( $self, $list ) = @_;

	( my $id = $list->name ) =~ s/[^\w]+/_/g;

	if ( my @threads = map { $self->thread($_) } $list->threads ) {
		return [ div => { id => "summary_list_body_$id", class => 'summary_list_body'  },
			@threads,
		];
	} else {
		return;
	}
}

sub list_footer {
	my ( $self, $list ) = @_;
	return ();
}

sub thread {
	my ( $self, $thread ) = @_;

	return if $thread->hidden;

	return $self->div( thread_summary =>
		$self->thread_header($thread),
		$self->thread_body($thread),
		$self->thread_footer($thread),
	);
}

sub thread_header {
	my ( $self, $thread ) = @_;
	$self->h3( $self->thread_link($thread) );
}

sub thread_link {
	my ( $self, $thread ) = @_;

	my $uri = $thread->archive_link->thread_uri;

	[a => { href => $uri, name=> $thread->message_id }, $thread->subject ],
}

sub thread_body {
	my ( $self, $thread ) = @_;

	if ( my $summary = $thread->summary ) {
		return $self->div( thread_summary_body => $self->markdown($summary) );
	} else {
		return $self->div(
			[qw/thread_summary_body empty_thread_summary_body/],
			$self->thread_body_no_summary($thread),
		);
	}
}

sub thread_body_no_summary {
	my ( $self, $thread ) = @_;

	my $posters = eval { $thread->extra->{posters} };

	return (
		[p => 'No summary provided.' ],
		($posters ? $self->thread_posters($posters) : ()),
	);
}

sub thread_posters {
	my ( $self, $posters ) = @_;

	return (
		[p => "The following people participated in this thread:" ],
		[ul => map { [li => ['~literal' => { text => $self->escape_unicode($_->{name} || $_->{email}) } ] ] } @$posters ],
	);
}

sub thread_footer {
	my ( $self, $thread ) = @_;
	return ();
}

sub css {
	my $self = shift;
	return ();
}


__PACKAGE__;

__END__

=pod

=head1 NAME

Mail::Summary::Tools::Output::HTML - 

=head1 SYNOPSIS

	use Mail::Summary::Tools::Output::HTML;

=head1 DESCRIPTION

=cut