#!/usr/bin/perl

package SDH::XDoc;
use strict;
use warnings;

our @ISA = ('SDH::Doc');

sub new {
	my $self = shift;
	my $class = ref($self) || $self;
	my $type = shift;
	$self = {
		mt => 'application/xhtml+xml', # mime-type
		dt => undef, # doctype
		ha => { }, # head attributes
		hc => '', # head content
		ba => { }, # body attributes
		bc => '', # body content
	};
	if ($type eq 'XHTML-1.1') {
		$self->{dt} = 'html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"';
	} elsif ('XHTML-1.0-Transitional') {
		$self->{dt} = 'html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"';
	} elsif ('XHTML-1.0-Strict') {
		$self->{dt} = 'html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"';
	} elsif ('XHTML-1.0-Frameset') {
		$self->{dt} = 'html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"';
	}
	return bless($self , $class);
}

sub content {
	my $self = shift;
	my $class = ref($self) || $self;
#	warn "$class cannot set content." if @_;
	my $result = << "EOT";
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE ${$self}{dt}>
EOT
	$result .= << "EOT";
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head@{[SDH::html_attr(%{$self->{ha}})]}>
${$self}{hc}</head>
<body@{[SDH::html_attr(%{$self->{ba}})]}>
${$self}{bc}</body>
</html>
EOT
	return $result;
}

sub doc_type {
	my $self = shift;
	$self->{dt} = shift if @_;
	return $self->{dt};
}

# append
sub head {
	my $self = shift;
	$self->{hc} .= shift while @_;
	return $self->{hc};
}

sub head_attr {
	my $self = shift;
	while (@_) {
		return $self->{ha}{shift} if @_ == 1;
		my ($k, $v) = (shift, shift);
		$self->{ha}{$k} = $v;
	}
	return $self->{ha};
}

# set
sub head_content {
	my $self = shift;
	$self->{hc} = shift if @_;
	return $self->{hc};
}

sub append {
	return &body;
}

# append
sub body {
	my $self = shift;
	$self->{bc} .= shift while @_;
	return $self->{bc};
}

sub body_attr {
	my $self = shift;
	while (@_) {
		return $self->{ba}{shift} if @_ == 1;
		$self->{ba}{shift} = shift;
	}
	return $self->{ba};
}

# set
sub body_content {
	my $self = shift;
	$self->{bc} = shift if @_;
	return $self->{bc};
}

1;
