package ehmod;
$IDENT = q$Id: ehmod.pm,v 1.1.1.1 2002/01/14 22:41:30 chouser Exp $;
# to use this module from the command line, do something like:
#   perl -Mehmod -e "ehmod::doleaf 'index.pl'"
# or use eh2html

use strict;
no strict 'refs';   # we're going to be doing a lot of namespace munging
use HTML::Template;
my $verbose = $ENV{'EHMOD_V'} || 0;
my %uselist;
my $ident = '';
my $leafident = 0;
my %export = (
    'fixdash' => 1,
    'mytmpldata' => 1,
);

sub fixdash {
    my ($obj) = @_;
    my $ref = ref $obj;
    if ($ref eq 'HASH') {
        foreach my $key (keys %$obj) {
            if (substr($key, 0, 1) eq '-') {
                my $newkey = substr($key, 1);
                $obj->{substr($key, 1)} = delete $obj->{$key};
                $key = $newkey;
            }
            fixdash($obj->{$key}) if ref $obj->{$key};
        }
    }
    elsif ($ref eq 'ARRAY') {
        foreach my $item (@$obj) {
            fixdash($item);
        }
    }
}

sub template {
    my ($params, $subname, @newargs) = @_;
    warn "template $subname\n" if $verbose;

    # log the identity of the leaf package
    unless ($leafident) {
        my $identref = *{"leaf::IDENT"};
        $ident = "$$identref\n$ident" if $$identref;
        $leafident = 1;
    }

    # process params for -key syntax
    my %hp = @$params;
    fixdash(\%hp);

    # filter to all for #TMPL_VAR x# syntax
    my $filter = sub {
        my $text_ref = shift;
        $$text_ref =~ s{#(/?TMPL_.*?)#} {<$1>}g;
    };

    # build and use HTML::Template
    my $tmpl = HTML::Template->new(
        die_on_bad_params => 0,
        filter => $filter,
        @newargs
    );
    $tmpl->param('ident' => $ident);
    $tmpl->param(%hp);
    my $out = $tmpl->output();

    # pop a level of dots from the <...TMPL_VARs>
    $out =~ s/([#<])\.(\.*TMPL_)/$1$2/g;
    return $out;
}

# apply params to Template in this package's DATA section
sub mydatatmpl {
    my ($pkgname) = caller;
    my $dataref = *{"${pkgname}::DATA"};
    return template (\@_, "${pkgname}::mydatatmpl", 'filehandle' => $dataref);
}

# examine pkg, building subs for package-global vars and DATA
sub buildsubs {
    my ($pkgname) = @_;

    # examine pkg, building subs for package-global vars
    my $pkg = *{"${pkgname}::"}{HASH};
    foreach my $entry (keys %$pkg) {
        # be verbose
        if ($verbose) {
            warn "   $entry\n";
            foreach my $type (qw(SCALAR ARRAY HASH CODE GLOB)) {
                my $x = *{"${pkgname}::${entry}"}{$type};
                if ($x) {
                    #$x = $$x if $type eq 'SCALAR';
                    warn "      $type: $x\n";
                }
            }
        }

        # build subs for package-global scalars
        my $valref = *{"${pkgname}::${entry}"};
        if ($$valref) {
            warn "  produce code for $entry\n" if $verbose;
            *{"${pkgname}::${entry}"} = sub {
                return template (\@_, $entry, 'scalarref' => $valref);
            };
        }
    }

    # examine pkg, build sub "pkg" using DATA if needed
    my $dataref = *{"${pkgname}::DATA"};
    if (*{"${pkgname}::DATA"}{IO} && !*{"${pkgname}::$pkgname"}{CODE}) {
        warn "  produce code for DATA: $pkgname\n" if $verbose;
        *{"${pkgname}::${pkgname}"} = sub {
            warn "in anon $pkgname, about to call template\n" if $verbose;
            return template (\@_, $pkgname, 'filehandle' => $dataref);
        };
    }
}

sub postimport {
    my ($pkgname, $myname, @names) = @_;

    # log the identity of each package
    my $identref = *{"${pkgname}::IDENT"};
    $ident .= "$$identref\n" if $$identref;
    undef $$identref;

    # recursively call postimport for all packages that this one uses
    foreach my $usepkg (@{$uselist{$pkgname}}) {
        &postimport(shift @$usepkg, $pkgname, @$usepkg);
    }

    # now do postimport for myself
    my $endgame = ($pkgname eq 'ehmod' || $pkgname eq 'leaf' || $pkgname eq '');
    warn "postimport for $pkgname into $myname\n" if $verbose;

    # create various subs for this package on the fly
    buildsubs ($pkgname) unless $endgame;

    # now import various subs, built or prebuilt, into myname
    # imports @names from $pkgname into $myname
    push @names, $pkgname unless $endgame;
    foreach my $name (@names) {
        my $frompkg = $pkgname;
        $export{$name} and $frompkg = 'ehmod';
        my $code = *{"${frompkg}::$name"}{CODE};
        warn "  import $name from $frompkg into $myname\n" if $verbose;
        local $^W = 0;
        *{"${myname}::$name"} = $code or 
            warn "No sub ${frompkg}::$name to import to $myname\n";
    }
}

sub import {
    my ($myname, @names) = @_;
    my ($pkgname) = caller;
    warn "ehmod import to $pkgname from $myname\n" if $verbose;
    return if $pkgname eq "main";

    # first, add my package name to the list of pkgs our target will need
    # to postimport later
    push @{$uselist{$pkgname}}, [$myname, @names];

    # import key items needed for a future postimport
    *{"${pkgname}::import"} = \&import;

    # import stub subs to aid in parsing -- these should be over-written later
    foreach my $name (@names) {
        *{"${pkgname}::$name"} = sub {
            die "sub ${pkgname}::$name not defined\n";
        };
    }

    # if the imports are all done and we're back at the top,
    # we are now ready to start postimport
    if ($pkgname eq 'leaf') {
        warn "now calling postimport\n" if $verbose;
        &postimport('leaf');
        # reset uselist
        %uselist = ();
    }
}

sub doleaf {
    my ($leaffile, $htmlfile) = @_;

    my $out;
    {
        package leaf;
        unless ($out = do $leaffile) {
            die "couldn't parse $leaffile: $@" if $@;
            die "couldn't do $leaffile: $!"    unless defined $out;
            die "couldn't run $leaffile"       unless $out;
        }
        print $out;
    }
};

# 'use' goes down the net from the leaf to ehmod at the bottom
# 'import' is then called going up the net from ehmod to the leaf
#   our import installs an 'import' for each dependant up the chain
#   

1;