package neb::Tree::Sub;
use strict;
use English;
use Carp;
use neb::Tree::Tag;
use neb;
use Data::Dumper;
our @ISA = ('neb::Tree::Tag');
sub fqdn
{
my $self = shift;
unless ($self->{FQDN})
{
my $parents = '';
my $p = $self;
while ($p)
{
my $name = eval '$p->name';
$parents = "${name}::$parents" if $name;
$p = $p->parent;
}
$parents =~ s/::$//g;
$self->{FQDN} = $parents;
}
return $self->{FQDN};
}
sub init
{
my $self = shift;
$self->SUPER::init(@_);
my $parents = $self->fqdn;
my $text = "### $parents\n"
. "{\n"
. "my \$die = 0;\n"
. "my \%ARGS = (\n__ARGS__$parents);\n"
. "__VARS__$parents\n";
local $INPUT_RECORD_SEPARATOR = undef;
my $F = substr($self->name, 1+index($self->name, ':')) . '.neb';
open (F, $F) or confess "No puedo abrir el archivo $F: $OS_ERROR";
# $text = "" . . "";
$text .= ;
close(F);
$text .= "die 'aborting due to errors' if \$die;\n}\n### end $parents\n";
my $neb = neb->new;
# rodear el componente con un elemento 'dummy', para que sea xml válido
my $parsed = $neb->parse($text);
# reobtener el xml sin el root element
$parsed = $parsed->content->[0]->container;
$parsed->parent($self);
$self->add_content($parsed);
return $self;
}
sub code_start{'die "you shouldn\'t see this!"'};
sub code_end {'die "you shouldn\'t see this!"'};
sub code
{
my $self = shift;
my $parents = $self->fqdn;
# esto probablemente sea romper algo (estoy metiendo mano
# adentro del árbol de parsado---otra vez)
my @vars = grep (ref eq 'neb::Tree::Vars',
$self->container->content->[0]->content);
my $decls = '';
foreach (@vars)
{
$decls .= $_->decls;
$_->free;
}
my $code = $self->container->code;
my %attrs = $self->attributes;
my $args = join ('',
map ("\t$_ => \"\Q$attrs{$_}\E\",\n",
keys %attrs));
$code =~ s/__VARS__$parents/$decls/;
$code =~ s/__ARGS__$parents/$args/;
return $code;
}
# sub code
# {
# my $self = shift;
# local $INPUT_RECORD_SEPARATOR = undef;
# my $F = substr($self->name, 1+index($self->name, ':')) . '.neb';
# open (F, $F) or confess "No puedo abrir el archivo $F: $OS_ERROR";
# my $neb = neb::Parse->new;
# # rodear el componente con un elemento 'dummy', para que sea xml válido
# my $parsed = $neb->parse('' . . '');
# # reobtener el xml sin el root element
# $parsed = $parsed->content->[0]->container;
# $parsed->parent($self);
# bless $self, 'neb::Tree::Tag';
# $self->container->add_content($parsed);
# #print join "\n", map ref, $self->container->content->[0]->content;exit;
# # esto probablemente sea romper algo (estoy metiendo mano
# # adentro del árbol de parsado---otra vez)
# my @vars = grep (ref eq 'neb::Tree::Vars',
# $self->container->content->[0]->content);
# my $decls = '';
# $decls .= $_ foreach (map $_->decls, @vars);
# "{\nmy \%ARGS = ();\n" . $decls .
# $neb->parse->content->[0]->container->code . "}";
# }
1;