package Skelton;
# $Id: Skelton.pm,v 1.30 2001/02/06 05:02:05 tom Exp $
################################################################

=head1 NAME

Skelton - 

=head1 SYNOPSIS

   use Skelton;
   my $sk = new Skelton(filename=>"skelton.html");
   $sk->Read;
   $sk->SetMacro("CONTENT", sub {
       my ($self, $cmd, $var) = @_;
       ...
       return $value;
   });
   print $sk->AsHTML;

=head1 DESCRIPTION

Skelton : 雛形を元に
<!--#macro cmd=".." var=".." --> 
なマクロを設定、展開する

=head1 MEMBER VARIABLES

filename    雛形ファイル名

=head1 BUGS

・callback 関数には、
(自オブジェクト、コマンド名、付加変数）が与えられる
・入力はすべて一旦 $InternalJcode(euc) に変換。
出力する際に $OutputJcode に変換。
それも 'euc' ならそのまま出力


=cut

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

use strict;
use vars qw(@ISA @EXPORT $OutputJcode $InputJcode);
use Exporter;
@ISA = qw(ObjectTemplate);
@EXPORT = qw(attributes);

use JConv;
use ObjectTemplate;

# グローバル変数
my $InternalJcode = 'euc';     # なるべく変えない
$OutputJcode = 'euc' unless defined $OutputJcode;
       # 変えるとコード変換する分時間がかかる
$InputJcode = 'auto' unless defined $InputJcode;

attributes qw(filename
	      macros skelton config hash);

sub initialize($)
{
    my $self = shift;
    $self->hash({});
    $self->macros([]);
    $self->config({});
    $self->SUPER::initialize;
}
################################################################

=head2 $sk->Read;

雛形ファイルを読む。
設定項目が指定してあればそれをセット。

=cut

sub Read($)
{
    my $self = shift;

    my $s = (times())[0];
#    *jconv_tmp = mkjconv('auto', $InternalJcode);
    *jconv_tmp = mkjconv($InputJcode, $InternalJcode);
    open(F, $self->filename) || die $self->filename;
    my $line;
    if (0){
	while (<F>){
	    jconv_tmp(\$_);
	    $line .= $_;
	}
    } else {
	$line = join('', <F>);
	jconv_tmp(\$line);
    }
    close(F);
    $line =~ s/<!--#config (.*?) *-->/$self->set_config($1)/ge;
    $self->skelton($line);
    my $e = (times())[0];
##    warn "skelton read elasp: ", $e - $s;
}
################################################################

=head2 $sk->SetMacro($name, $callback);

マクロを設定。

$name というマクロを展開する $callback 関数を指定する。


=cut

sub SetMacro($$$)
{
    my ($self, $keyword, $callback) = @_;

#    print "add:$keyword<br>";
    unshift(@{$self->macros}, {keyword=>$keyword, callback=>$callback});
    $self->hash->{$keyword} = 1;

}
################################################################

=head2 $sk->AsHTML;

HTML に変換

=cut


sub AsHTML ($)
{
    my $self = shift;

    $self->SetMacros;
    $self->SetMacroHook;
    my $expanded_html = $self->expand;
    
    if ($OutputJcode ne 'euc'){
	sub jconv_html;
	*jconv_html = mkjconv($InternalJcode, $OutputJcode);
	jconv_html(\$expanded_html);
    }
    return $expanded_html;
}

sub SetMacroHook {}
sub SetMacros {}

################################################################
# 下請け
sub expand($)
{
##    warn "expand start";

#    my ($self, $line) = @_;
    my $self = shift;
    my $line = $self->skelton;

    $line =~ s/<!--#macro ([^>]*) *-->/$self->expand_macros($1)/ge;
    $line =~ s/<!--#include ([^>]*) *-->/$self->include($1)/ge;
##    warn "expand done";
    
    return $line;
}
sub expand_macros($$)
{
    my ($self, $line) = @_;

    my ($keyword) = $line =~ /^cmd *= *\"?([^ \"]*)\"?(.*)$/; #"
    my ($var) = $2 =~ /^ *var *= *\"?([^\"]*)\"?/; #"

    my @macros = @{$self->macros};

    for (@macros){
	next if ref $_ ne 'HASH';

#	print $_->{'keyword'}, ",";
	if ($keyword =~ /^$_->{'keyword'}/){
	    # automated judgement if table is usable
	    if (ref $_->{'callback'}){    # 関数
		return &{$_->{'callback'}}($self, $keyword, $var);
	    } else {
		return $_->{'callback'};  # 文字列
	    }
	}
    }

    # no such macros
    return "no such macro: $keyword";
}
sub include($$)
{
    my ($self, $line) = @_;
    # <!--#include file="file" -->
    # <!--#include virtual="path" -->
    
#    my ($keyword) = $line =~ /^cmd *= *\"?([^ \"]*)\"?(.*)$/; #"
    my ($type, $path) = $line =~ /^(file|virtual) *= *\"?([^ \"]*)\"?(.*)$/; #"
    open(F, $path) || return "no such file: $path";
    my @lines = <F>;
    close(F);
    return join("", @lines);
}
sub set_config($$)
{
    my ($self, $line) = @_;

#    my ($config, $value) = $line =~ /^([A-Za-z_]+) *= *\"?([^\"]*)\"?/; #"
    my ($config, $value) = $line =~ /^([A-Za-z_]+) *= *\"?(.*?)\"?$/; #"    
    $value =~ s/\\"/"/g;
    $self->config->{$config} = $value;
    return '';
}
################################################################
sub GetOutputCharset()
{
    return JConv::GetCharset($OutputJcode);
}
sub GetOutputJcode()
{
    return $OutputJcode;
}
sub SetInternalJcode($)
{
    $InternalJcode = shift;
}
1;
