view release on metacpan or  search on metacpan

HTPL-modules/lib/HTML/HTPL/Munge.pm  view on Meta::CPAN

package HTML::HTPL::Munge;

use Filter::Util::Call;
use Tie::Parent;
require Exporter;
use strict;
use vars qw(%variables);
use Carp;

sub import {
    my $pkg = (caller)[0];
    my $class = shift;
    $variables{$pkg} = [ @_ ];   

    filter_add(bless {'pkg' => $pkg});
    Exporter::export('HTML::HTPL::Munge::Stub', $pkg, 'AUTOLOAD');
    Exporter::export('HTML::HTPL::Munge::Stub2', "${pkg}::__shadow__", 'AUTOLOAD');
    undef;
}

sub filter {
    my $self = shift;
    my $status = filter_read();
    if ($_ eq "SYNC\n") {
        my @vars = &getvars($self->{'pkg'});
        my @lines = map { s/^://; "my \$$_; tie \$$_, 'Tie::Parent', \$self, '$_';" }
              @vars;
        unshift(@lines, 'my $self = shift;', 'local ($__htpl_lastself) = $self;');
        $_ = join("\n", @lines, "");
    }
    $status;
}

sub getvars {
    my ($pkg, %way) = shift;
    my @vars = @{$variables{$pkg}};
    my @isa;
    eval '@{"$pkg\::ISA"};';

    return @vars unless (@vars && @isa);
    foreach (@isa) {
        push(@vars, &getvars($_, %way, $_, 1)) unless ($way{$_});
    }
    @vars;
}

package HTML::HTPL::Munge::Stub;
use strict;
use vars qw(%lastself $AUTOLOAD @EXPORT_OK);
@EXPORT_OK = qw(AUTOLOAD);

sub AUTOLOAD {
    &loader;
    goto &$AUTOLOAD;
}

sub loader {
    my $save = $@;
    $@ = undef;
    my $index = rindex($AUTOLOAD, "::");
    Carp::croak("Can't parse $AUTOLOAD") unless ($index > -1);
    my $class = substr($AUTOLOAD, 0, $index);
    my $method = substr($AUTOLOAD, $index + 2);
    if ($method eq 'DESTROY') {
        *$AUTOLOAD = {};
        return;
    }
    my $shadow_class = '__shadow__';
    my $shadow_method = '__shadow__';
    my $impclass = "${class}::$shadow_class";
    my $impmethod = "${shadow_method}$method";