package TDS::Tdf::Command;
# $Id: Command.pm,v 1.63 2000/12/20 14:59:43 tom Exp $
################################################################

=head1 NAME

TDS::Tdf::Command - tdf Command

=head1 SYNOPSIS

use TDS::Tdf::Command;

 $c = new TDS::Tdf::Command::NEW;
 $c->attr(["NEW", "foo"]);
 $c->PushContent(["lines"]);
 print $c->AsHTML({});

=head2 DESCRIPTION

you are not expected to understand this code ???

=cut

################################################################

# in adding new commmand,
# you MUST add the class name to correspond %Entities

use strict qw(vars);

#BEGIN{ print STDERR "cmd start:", times(), "\n"; }

use JConv;
use Template;
#use ObjectTemplate;

use TDS::System;
use TDS::Mode;
#use TDS::Tdf::Command::LINK;
#use TDS::Tdf::Command::ANCHOR;

use vars qw(@EXPORT);
use vars qw(%Entities $SetupDone %IsCommand);
use vars qw($Template $EndTemplate $NumAttr $IsOneline @AllowCommands
	    $CountName $OmittableEnd $MustHaveContent
	    $DateHrefType $DynamicPrefix);

################################################################
# entity definition
# used in @AllowCommands

# Inline
@{$Entities{'Link'}} = ('LINK', 'LINKTITLE', 'SELFLINK',
			'ANCHOR', 'BANNER', 'URL', 'MAILTO');
@{$Entities{'Decoration'}} = ('STRIKE', 'BIG', 'SMALL', 'STRONG', 'EM',
			      'ASC',
			      'COLOR',
			      'ITALIC', 'BOLD',
			      'SUBSCRIPT', 'SUPERSCRIPT',
			      'UNDERLINE',
			      'BR');
@{$Entities{'Image'}} = ('IMG', 'DAILYIMAGE');
@{$Entities{'Comment'}} = ('FN', 'FN_Content', 'FN_Formatter',
			   'COMMENT','HIDE');
@{$Entities{'InlineContainer'}} = ('SPAN');
@{$Entities{'Inline'}} = ('Inline',                # uhmmm
			  'VERB', 'WARNING',
			  'ISBN',
#			  @{$Entities{'Link'}},
			  '%Link', '%Decoration',
			  '%Image', '%Comment', '%InlineContainer');
#			  @{$Entities{'Decoration'}},
#			  @{$Entities{'Image'}},
#			  @{$Entities{'Comment'}},
#			  @{$Entities{'InlineContainer'}});

#warn @{$Entities{'Inline'}};

# Block
@{$Entities{'Cite'}} = ('CITE', 'PRE', 'CODE');
@{$Entities{'List'}} = ('UL', 'OL', 'DL');
@{$Entities{'ListContent'}} = ('LI', 'DT', 'DD');
@{$Entities{'Table'}} = ('TABLE');
@{$Entities{'TableContent'}} = ('TR', 'TH', 'TD');
@{$Entities{'BlockContainer'}} = ('P', 'DIV');
@{$Entities{'Block'}} = ('HR',
			 'HD',
			 'SECRET',
			 'HIDE',
			 'VERBATIM',
			 'NOPARSE',
			 'INCLUDE',
			 '%BlockContainer', '%Table', '%Cite', '%List');
#			 @{$Entities{'BlockContainer'}},
#			 @{$Entities{'Table'}},
#			 @{$Entities{'Cite'}},
#			 @{$Entities{'List'}});


# 
#@{$Entities{'Flow'}} = (@{$Entities{'Inline'}}, @{$Entities{'Block'}});
@{$Entities{'Flow'}} = ('%Inline', '%Block');


# Diary specified
@{$Entities{'New'}} = ('NEW', 'SNEW');
@{$Entities{'Sub'}} = ('SUB', 'SSUB');
#@{$Entities{'DiaryContent'}} = (@{$Entities{'New'}}, @{$Entities{'Sub'}},
#				'TIMEDIV');
@{$Entities{'DiaryContent'}} = ('%New', '%Sub', 'TIMEDIV');

@{$Entities{'Diary'}} = ('DIARY', 'CAT', '%DiaryContent');
#			 @{$Entities{'DiaryContent'}});

# special
@{$Entities{'Special'}} = ('TITLE');
@{$Entities{'Dictionary'}} = ('WORD', 'PRONOUNCE', 'ANCHORNAME');
@{$Entities{'All'}} = ('Tdf',
		       '%Special', '%Dictionary', '%Diary',
		       '%ListContent', '%TableContent',
		       '%New', '%Flow'
#		       @{$Entities{'Special'}},
#		       @{$Entities{'Dictionary'}},		       
#		       @{$Entities{'Diary'}},
#		       @{$Entities{'ListContent'}},
#		       @{$Entities{'TableContent'}},
#		       @{$Entities{'New'}},
#		       @{$Entities{'Flow'}}
		       );

# judgement for command or not

#%IsCommand = map {$_=>1} @{$Entities{'All'}};

my $DateHrefTemplateDaily = "%y%0m%0d";
my $DateHrefTemplatePartly = "%y%0m%part";
$DateHrefType = 'daily';
#$DateHrefType = 'partly';
$DynamicPrefix = "./";

################################################################

#@TDS::Tdf::Command::ISA = qw(ObjectTemplate);
#@TDS::Tdf::Command::EXPORT = qw(attributes);

#attributes qw(attr ext_attrs parent pos content opt cat
#	      num_attr is_oneline has_arg_content omittable_end);

################################################################
sub new($)
{
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self->initialize;
    $self;
}
################################################################
sub initialize($)
{
    my $self = shift;
    # every class has value of static variable that will be changed by opt
    # as attribute.
    my $class = ref $self;
    my $var = "${class}::NumAttr";
    $self->{num_attr} = $$var;
    
    $var = "${class}::IsOneline";
    $self->{is_oneline} = $$var;
    
    $var = "${class}::HasArgContent";
    $self->{has_arg_content} = $$var;
    
    $var = "${class}::OmittableEnd";
    $self->{omittable_end} = $$var;
}
sub Name($)
{
    my $self = shift;

    my $name = ref $self;
    $name =~ s/.*:://;
    return $name;
}

# you MUST call this function,
# before parsing object.

sub Setup
{
    return if $SetupDone;

#    warn "setup", times();
    # expand entities
#    SetIsCommand(@{$Entities{'All'}});
    
#    print STDERR "setup: ", times(), "\n";
    
    # for all classes
    my @all_command = @{$TDS::Tdf::Command::Entities{'All'}};
    for (@all_command){
	my $cmd = $_;
#	print "\n$cmd: ";
	if ($cmd =~ /^%(.*)$/){
	    push(@all_command, @{$Entities{$1}});
	    next;
	}
	$IsCommand{$cmd} = 1;
#	print "$cmd:\n";
	my @classes = ("TDS::Tdf::Command::$cmd");
	my $class;
#	warn $cmd, @{$Entities{'Inline'}} if $cmd eq "P";
	for $class (@classes){
	    last unless $class =~ /^TDS/;
	    my $allow_commands = "${class}::AllowCommands";
	    if (@$allow_commands){
		my $allowed = "TDS::Tdf::Command::${cmd}::Allowed";
#		%$allowed = map {$_=>1} @$allow_commands;
		my @array = @$allow_commands;
		for (@array){
		    if (/^%(.*)$/){
#			warn $1, @{$Entities{$1}} if $cmd eq 'P';
			push(@array, @{$Entities{$1}});
			next;
		    }
#		    print STDERR "$_, " if $cmd eq 'P';
#		    die if $cmd eq 'P' && $_ eq 'ISBN';
		    $$allowed{$_} = 1;
		}
#		die "$cmd, $class", join(', ', keys %$allowed)
#		    if $cmd eq 'P';
	    } else {
		# if not found, call parent
		my $tmp = "${class}::ISA";
		push(@classes, @$tmp);
	    }
	}
	# NotAllowCommands
	my $not_allow = "TDS::Tdf::Command::${cmd}::NotAllowCommands";
#	print STDERR @$not_allow;
	for $class (@$not_allow){
#	    print STDERR "$cmd not allowed $class.\n";
	    my $allow = "TDS::Tdf::Command::${cmd}::Allowed";
	    my %tmp = %$allow;
#	    print %tmp;
#	    print STDERR $tmp{'STRIKE'};
	    $tmp{$class} = 0;
	}
	# scalar variables
	for (qw(Type CountName OmittableEnd IsOneline HasArgContent MustHaveContent)){
	    my $var_name = $_;
#	    print "$var_name = ";
	    @classes = ("TDS::Tdf::Command::$cmd");
	    # AllowCommands is array
	    for $class (@classes){
#		print "$class: ";
		last unless $class =~ /^TDS/;
		my $full_var_name = "${class}::$var_name";
		if (defined $$full_var_name){
#		    print "$$full_var_name, ";
		    my $tmp_var_name = "TDS::Tdf::Command::${cmd}::${var_name}";
		    $$tmp_var_name = $$full_var_name;
#		    print "$full_var_name=$$full_var_name<br>";
		    last;
		}
		# call parent recursely
		my $tmp = "${class}::ISA";
		push(@classes, @$tmp);
	    }
#	    print "\n";
	}
	if ($cmd eq 'ISBN'){
#	    warn $TDS::Tdf::Command::ISBN::Type;
	} elsif ($cmd eq 'P'){
#	    warn @{$Entities{'Inline'}};
#	    warn %TDS::Tdf::Command::P::Allowed;
	}
	
    }
#    print %TDS::Tdf::Command::NEW::Allowed;
#    exit;
#    print STDERR "setup: ", times(), "\n";
    $SetupDone = 1;
#    warn "setup done", times();
}
sub AddEntity($@)
{
    my ($type, @commands) = @_;

    push(@{$Entities{$type}}, @commands);
}
################################################################
# insert new command at legal position
# if $elem is not TDS::Tdf::Command object,
# it's regarded as a command name, and insert new object
sub InsertCommand($$$)
{
    my ($self, $elem, $opt) = @_;
    unless (ref $elem){
#	eval "\$elem = new TDS::Tdf::Command::$elem;";
#	die $@ if $@;
	$elem = "TDS::Tdf::Command::${elem}"->new();    # thanks to KKI
    }
    my $pos = $self->{'pos'} || $self;
#    $elem->{line} = $elem->Name . "\n"
#	unless $elem->{line};
    $elem->{opt} = $opt if ref $opt;
    $pos->PushContent($elem);
    $self->{'pos'} = $elem;
    return $elem;
}
# push new command or plain text as content
sub PushContent($@)
{
    my $self = shift;
    for (@_){
	if (ref $_){
	    $_->{parent} = $self;
	}
	push(@{$self->{content}}, $_);
    }
}
sub UnshiftContent($@)
{
    my $self = shift;
    for (@_){
	if (ref $_){
	    $_->parent($self);
	}
	unshift(@{$self->{content}}, $_);
    }
}
sub HasChild($$)
{
    my ($self, $cmd_name) = @_;

    for (@{$self->{content}}){
	if (ref $_ && $_->Name eq $cmd_name){
	    return $_;
	}
    }
    return undef;
}
sub FindParent($@){
    my ($self, @classes) = @_;

    my $classes_str;
    for (@classes){
	$classes_str .= "$_,";
    }
    # search parents
    my $p = $self->{parent};
    while ($p){
	my $p_name = $p->Name;
	if ($classes_str =~ /$p_name,/){
	    last;
	}
	$p = $p->{parent};
    }
    return $p;
}
################################################################
# access method to static variable of object class
sub get_static_variable ($$)    # private
{
    my ($self, $var_name) = @_;
    my $full_var_name = (ref $self) . "::$var_name";
    return $$full_var_name if defined $$full_var_name;

    # if undefined the class, get from parent class
    my $tmp = (ref $self) . "::ISA";
    my @isa = @$tmp;
    for my $class (@isa){
	$full_var_name = "${class}::$var_name";
	return $$full_var_name if defined $$full_var_name;
	my $tmp = "${class}::ISA";
	push(@isa, @$tmp);
    }
    return undef;
}
# check $cmd_name is permitted as content of $self
sub allowed($$)
{
    my ($self, $cmd_name) = @_;

#    print "<br>check allowed: $cmd_name: in " . ($self->{name}) . ": ";
    my @AllowCommands = $self->get_static_variable('AllowCommands');
    return 1 unless @AllowCommands;
    for (@AllowCommands){
	if ($cmd_name eq $_){      # command type
	    return 1;
	}
    }
    return 0;                  # not allowed $cmd_name in $self
}

# template

sub GetTemplate ($)
{
#    my $cmd_name = shift;
    my $self = shift;
#    my $class = "TDS::Tdf::Command::$cmd_name";
    my $class = ref $self;

    # get template
    my $begin_template = sprintf("%s::Template", $class);
    my $end_template = sprintf("%s::EndTemplate", $class);

    # get anchor
    my $anchor_template = sprintf("%s::Anchor", $class);

    # get href
    my $href_template = sprintf("%s::HrefTemplate%s",
				$class,
				(TDS::Mode::IsStatic)? 'Static':'Dynamic');
    # apply date href to href
    if (1){
	$$href_template =~ s/%{?prefix}?/$DynamicPrefix/g;

	my $date_href_template = ($DateHrefType =~ /partly/) ? $DateHrefTemplatePartly : $DateHrefTemplateDaily;
	$$href_template =~ s/%{?date_href}?/$date_href_template/g;
    }
    
    # apply anchor to href
    $$href_template =~ s/%{?anchor}?/$$anchor_template/g;

    # apply href, anchor and suffix to template
    $$begin_template =~ s/%{?href}?/$$href_template/g;
    $$end_template =~ s/%{?href}?/$$href_template/g;
    $$begin_template =~ s/%{?anchor}?/$$anchor_template/g;
    $$end_template =~ s/%{?anchor}?/$$anchor_template/g;
    $$begin_template =~ s/%{?suffix}?/$TDS::Static::HtmlSuffix/g;
    $$end_template =~ s/%{?suffix}?/$TDS::Static::HtmlSuffix/g;
    
    return ($$begin_template, $$end_template);
}

################################################################
sub AsTdf
{
    my $self = shift;

    my $tdf = $self->{line};
    for (@{$self->{content}}){
	if (ref $_){
	    $tdf .= $_->AsTdf;
	} else {
	    $tdf .= $_;
	}
    }
    $tdf .= "/" . $self->Name . "\n";
    return $tdf;
}
    
# translate to HTML
sub AsHTML ($$)
{
    my ($self, $params) = @_;

    my $class = ref $self;
    my $cmd_name = $self->Name;

    # option : CMD* href ...
    if ($self->{opt}->{'link'}){
	my $link = new TDS::Tdf::Command::LINK;
	$link->{attr}->[1] = $self->{opt}->{href};
	if ($self->{has_arg_content}){
#	    print join(",", @{$self->{content}});
	    # その行の ext_attrs のみリンク化
	    $link->{content} = [shift @{$self->{content}}];
	    $self->{content} = [$link->AsHTML({'1'=>$self->{opt}->{href}}),
				@{$self->{content}}];
#	    $link->{content} = $self->{content};
#	    $self->{content} = [$link->AsHTML({'1'=>$self->{opt}->{href}})];
	} else {
	    $link->{content} = [$self->{ext_attrs}];
	    $self->{ext_attrs} = $link->AsHTML({'1'=>$self->{opt}->{href}});
	}
    } elsif ($self->{opt}->{'anchor'}){
	my $link = new TDS::Tdf::Command::ANCHOR;
	$link->{attr}->[1] = $self->{opt}->{anchor};
	if ($self->{has_arg_content}){
	    $link->{content} = $self->{content};
	    $self->{content} = [$link->AsHTML({'1'=>$self->{opt}->{anchor}})];
	} else {
	    $link->{content} = [$self->{ext_attrs}];
	    $self->{ext_attrs} = $link->AsHTML({'1'=>$self->{opt}->{anchor}});
	}
    }
	
    # secret mode (deprecated)
#    if ($self->opt->{secret} && !$params->{is_author}){
#	return undef;
#    }
#    $params->{content} = check_match($self->arg_content, $params);
#    $params->{content} = $self->arg_content;

    # counter increment
    $self->IncrementCounter($params);
    $self->ResetChildCounter($params);
    
    # recurse the contents
    my @content_html = $self->RecurseContent($params);
    return undef unless $self->ShouldBeShown($params);    
    # template
    my ($begin_template, $end_template) = $self->GetTemplate;

    $self->SetParams($params);
#    prnt %$params;
#    print $params->{encoded_term}, ", ";
#    print Template::Expand($begin_template, $params);
#    print "$cmd_name, ", $params->{ext_attrs}, "<br>";
    for (1..$#{$self->{attr}}){    # argument MUST NOT be changed.
	$params->{$_} = $self->{attr}->[$_];
    }
    $params->{ext_attrs} = $self->{ext_attrs};

    my @c_html = (Template::Expand($begin_template, $params));
    my $var_name = "TDS::Tdf::Command::${cmd_name}::Type";
    my $cmd_type = $$var_name;

    my $must_have_content = (ref $self) . "::MustHaveContent";
    # 中身がなきゃいけないのに、ないときは undef を返す
    # if content is required but not exists, return undef
    if ($$must_have_content && !@content_html){
#	print "nothing", $self->Name;
	return undef;
#	return "[undef]";
    } else {
	my $reverse_content = (ref $self) . "::CanReverseContent";
#	push(@c_html, ($params->{mode} eq 'RECENT' && $$reverse_content) ? reverse @content_html : @content_html);
	if ($TDS::Collection::ReverseInRecent &&
	    $params->{mode} =~ /RECENT/ &&
	    $$reverse_content){
	    push(@c_html, reverse @content_html);	    
	} else {
	    push(@c_html, @content_html);
	}
	# @
	push(@c_html, Template::Expand($end_template, $params));
	return join("", @c_html);
    }
}

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

    my $name = $self->Name;
    my $var = "TDS::Tdf::Command::${name}::TitleTemplate";
    return Expand($$var, $params);
}
sub EscapeEntity($\$)
{
    my ($self, $line) = @_;

    $$line =~ s/&/&amp;/g;
    $$line =~ s/>/&gt;/g;
    $$line =~ s/</&lt;/g;
    return $$line;
}

sub RecurseContent ($$)
{
    my ($self, $params) = @_;
    my @c_html;

    for (@{$self->{content}}){
	if (ref $_){
#	    print $_->Name, ",";
	    my $html = $_->AsHTML($params);
	    if ($html){
		push(@c_html, $html);
	    }
	} else {
	    push(@c_html, $_);
	}
    }
    return @c_html;
}
sub SetParams($$)
{
    my ($self, $params) = @_;
    # set attributes
    for (1..$#{$self->{attr}}){
	$params->{$_} = $self->{attr}->[$_];
    }
    $params->{ext_attrs} = $self->{ext_attrs};
}

sub IncrementCounter($$)
{}
sub ResetChildCounter($$)
{}
sub ShouldBeShown($$)
{1;}

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

    my $fn_fmt = new TDS::Tdf::Command::FN_Formatter;
    for (@{$self->{footnotes}}){
	$fn_fmt->PushContent($_);
    }
    my $tmp_params;
    for (keys %$params){
	$tmp_params->{$_} = $params->{$_};
    }
    $tmp_params->{fn} = $params->{fn} - @{$self->{footnotes}};
    $params->{footnote} = $fn_fmt->AsHTML($tmp_params);
}


1;
################################################################
# derived class from TDS::Tdf::Command
# top command (implicit);
#BEGIN{ print STDERR "cmd each command:", times(), "\n"; }
