7 |
use Data::Dumper; |
use Data::Dumper; |
8 |
our @ISA = ('neb::Tree::Tag'); |
our @ISA = ('neb::Tree::Tag'); |
9 |
|
|
|
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}; |
|
|
} |
|
|
|
|
10 |
sub init |
sub init |
11 |
{ |
{ |
12 |
my $self = shift; |
my $self = shift; |
13 |
$self->SUPER::init(@_); |
$self->SUPER::init(@_); |
14 |
|
|
15 |
my $parents = $self->fqdn; |
my $parents = $self->url; |
16 |
|
|
17 |
my $text = "<neb><neb:Block>### $parents\n" |
my $text = "<neb><neb:Block>### $parents\n" |
18 |
. "{\n" |
. "{\n" |
24 |
my $F = substr($self->name, 1+index($self->name, ':')) . '.neb'; |
my $F = substr($self->name, 1+index($self->name, ':')) . '.neb'; |
25 |
|
|
26 |
open (F, $F) or confess "No puedo abrir el archivo $F: $OS_ERROR"; |
open (F, $F) or confess "No puedo abrir el archivo $F: $OS_ERROR"; |
|
# $text = "<neb>" . <F> . "</neb>"; |
|
27 |
$text .= <F>; |
$text .= <F>; |
28 |
close(F); |
close(F); |
29 |
|
|
30 |
$text .= "<neb:Block>die 'aborting due to errors' if \$die;\n}\n### end $parents\n</neb:Block></neb>"; |
$text .= "<neb:Block>die 'aborting due to errors' if \$die;\n}\n### end $parents\n</neb:Block></neb>"; |
31 |
|
|
32 |
my $neb = neb->new; |
my $neb = neb->new; |
33 |
|
$neb->root($parents); |
34 |
|
|
35 |
# rodear el componente con un elemento 'dummy', para que sea xml válido |
# rodear el componente con un elemento 'dummy', para que sea xml válido |
36 |
my $parsed = $neb->parse($text); |
my $parsed = $neb->parse($text); |
37 |
# reobtener el xml sin el root element |
# reobtener el xml sin el root element |
38 |
$parsed = $parsed->content->[0]; |
$parsed = $parsed->content->[0]; |
39 |
$parsed->parent($self); |
bless $parsed, 'neb::Tree::Container'; |
40 |
|
|
41 |
$self->add_content($parsed); |
$self->add_content($parsed); |
42 |
|
|
43 |
return $self; |
return $self; |
44 |
} |
} |
45 |
|
|
46 |
sub code_start{'die "you shouldn\'t see this!";'}; |
sub canonical |
47 |
sub code_end {'die "you shouldn\'t see this!";'}; |
{ |
48 |
|
my $self = shift; |
49 |
|
return join('', map($_->canonical, $self->content)); |
50 |
|
} |
51 |
|
|
52 |
|
sub code_start{''}; |
53 |
|
sub code_end {''}; |
54 |
|
|
55 |
sub code |
sub code |
56 |
{ |
{ |
57 |
my $self = shift; |
my $self = shift; |
58 |
|
|
59 |
my $parents = $self->fqdn; |
my $parents = $self->url; |
60 |
# esto probablemente sea romper algo (estoy metiendo mano |
# esto probablemente sea romper algo (estoy metiendo mano |
61 |
# adentro del árbol de parsado---otra vez) |
# adentro del árbol de parsado---otra vez) |
62 |
my @vars = grep (ref eq 'neb::Tree::Vars', |
my @vars = grep (ref eq 'neb::Tree::Vars', |
65 |
foreach (@vars) |
foreach (@vars) |
66 |
{ |
{ |
67 |
$decls .= $_->decls; |
$decls .= $_->decls; |
|
$_->free; |
|
68 |
} |
} |
69 |
|
|
70 |
my $code = $self->code; |
my $code = $self->code_middle; |
71 |
|
|
|
|
|
72 |
my %attrs = $self->attributes; |
my %attrs = $self->attributes; |
73 |
my $args = ''; |
my $args = ''; |
74 |
|
|