package neb::Tree::Vars; use strict; use English; use Carp; use neb::Tree::Perl; our @ISA = ('neb::Tree::Tag'); sub code {'print "***Si ves este mensaje en la salida de neb, es porque algo malo sucedió en el parseo.\n";'} sub decls { my $self = shift; my $parents = ''; my $p = $self->parent; while ($p) { my $name = eval '$p->name'; $parents = "${name}::$parents" if $name; $p = $p->parent; } $parents = substr($parents, 0, -2); # extrae y limpia líneas significativas (i.e. no vacías) my @lines = grep ($_, map ({s/^\s*(.*?)\s*$/$1/g; $_} map ($_->stuff, $self->container->content) ) ); my %optional = (); my @required = (); my $decl = ''; foreach (@lines) { if (/^(\S+)\s*=>\s*(\S.*)$/) { $optional{$1} = $2; } elsif (/^(\S+)$/) { push @required, $1; } else { confess "I don't reckognize \"$_\" as a variable declaration"; } } foreach (keys %optional) { my $argname = $_; $argname =~ s/^[\$\%\@\*]//; $decl .= "my $_ = exists \$ARGS{'\Q$argname\E'} ? \$ARGS{'\Q$argname\E'} : $optional{$_};\n"; } foreach (@required) { my $argname = $_; $argname =~ s/^[\$\%\@\*]//; $decl .= "my $_ = \$ARGS{'\Q$argname\E'};\n"; } $decl .= <