3 |
use English; |
use English; |
4 |
use Carp; |
use Carp; |
5 |
use neb::Tree::Tag; |
use neb::Tree::Tag; |
6 |
|
use neb::Quoter; |
7 |
use neb; |
use neb; |
|
use Data::Dumper; |
|
8 |
our @ISA = ('neb::Tree::Tag'); |
our @ISA = ('neb::Tree::Tag'); |
9 |
|
|
10 |
sub init |
sub init |
18 |
. "{\n" |
. "{\n" |
19 |
. "my \$die = 0;\n" |
. "my \$die = 0;\n" |
20 |
. "my \%ARGS = (\n__ARGS__$parents);\n" |
. "my \%ARGS = (\n__ARGS__$parents);\n" |
21 |
|
. "my \$PARM = __PARM__$parents;\n" |
22 |
. "__VARS__$parents\n</neb:Block>"; |
. "__VARS__$parents\n</neb:Block>"; |
23 |
|
|
24 |
local $INPUT_RECORD_SEPARATOR = undef; |
local $INPUT_RECORD_SEPARATOR = undef; |
25 |
my $F = substr($self->name, 1+index($self->name, ':')) . '.neb'; |
my $F = $self->delete('neb:src'); |
26 |
|
|
27 |
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"; |
28 |
$text .= <F>; |
$text .= <F>; |
33 |
my $neb = neb->new; |
my $neb = neb->new; |
34 |
$neb->root($parents); |
$neb->root($parents); |
35 |
|
|
36 |
# 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 |
37 |
my $parsed = $neb->parse($text); |
my $parsed = $neb->parse($text); |
38 |
# reobtener el xml sin el root element |
# reobtener el xml sin el root element |
39 |
$parsed = $parsed->content->[0]; |
$parsed = $parsed->content->[0]; |
50 |
return join('', map($_->canonical, $self->content)); |
return join('', map($_->canonical, $self->content)); |
51 |
} |
} |
52 |
|
|
53 |
sub code_start{''}; |
sub code_start {''} |
54 |
sub code_end {''}; |
sub code_end {''} |
55 |
|
|
56 |
sub code |
sub code |
57 |
{ |
{ |
59 |
|
|
60 |
my $parents = $self->url; |
my $parents = $self->url; |
61 |
# esto probablemente sea romper algo (estoy metiendo mano |
# esto probablemente sea romper algo (estoy metiendo mano |
62 |
# adentro del árbol de parsado---otra vez) |
# adentro del árbol de parsado---otra vez) |
63 |
my @vars = grep (ref eq 'neb::Tree::Vars', |
my @vars = grep (ref eq 'neb::Tree::Vars', |
64 |
$self->content->[0]->content); |
$self->content->[0]->content); |
65 |
my $decls = ''; |
my $decls = ''; |
68 |
$decls .= $_->decls; |
$decls .= $_->decls; |
69 |
} |
} |
70 |
|
|
|
my $code = $self->code_middle; |
|
|
|
|
71 |
my %attrs = $self->attributes; |
my %attrs = $self->attributes; |
72 |
|
my $parm = ''; |
73 |
my $args = ''; |
my $args = ''; |
74 |
|
|
75 |
foreach (keys %attrs) |
foreach (keys %attrs) |
84 |
} |
} |
85 |
} |
} |
86 |
|
|
87 |
|
if (@{$self->content}) |
88 |
|
{ |
89 |
|
my @content = $self->content; |
90 |
|
my $sub = shift @content; |
91 |
|
|
92 |
|
$parm = quote(join '', map $_->canonical, @content); |
93 |
|
$self->content($sub) |
94 |
|
} |
95 |
|
|
96 |
|
|
97 |
|
my $code = $self->code_middle; |
98 |
|
|
99 |
$code =~ s/__VARS__$parents/$decls/; |
$code =~ s/__VARS__$parents/$decls/; |
100 |
$code =~ s/__ARGS__$parents/$args/; |
$code =~ s/__ARGS__$parents/$args/; |
101 |
|
$code =~ s/__PARM__$parents/$parm/; |
102 |
|
|
103 |
return $code; |
return $code; |
104 |
} |
} |
105 |
|
|
|
# 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('<neb>' . <F> . '</neb>'); |
|
|
# # reobtener el xml sin el root element |
|
|
# $parsed = $parsed->content->[0]; |
|
|
# $parsed->parent($self); |
|
|
|
|
|
# bless $self, 'neb::Tree::Tag'; |
|
|
# $self->add_content($parsed); |
|
|
|
|
|
# #print join "\n", map ref, $self->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->content->[0]->content); |
|
|
# my $decls = ''; |
|
|
# $decls .= $_ foreach (map $_->decls, @vars); |
|
|
|
|
|
# "{\nmy \%ARGS = ();\n" . $decls . |
|
|
# $neb->parse->content->[0]->code . "}"; |
|
|
# } |
|
|
|
|
|
|
|
106 |
1; |
1; |