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;