/[papo]/papo/neb/neb/Tree/Sub.pm
ViewVC logotype

Diff of /papo/neb/neb/Tree/Sub.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by jlenton, Thu Apr 10 05:07:58 2003 UTC revision 1.7 by jlenton, Thu Apr 10 23:01:39 2003 UTC
# Line 3  use strict; Line 3  use strict;
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
# Line 18  sub init Line 18  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>;
# Line 32  sub init Line 33  sub init
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];
# Line 49  sub canonical Line 50  sub canonical
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  {  {
# Line 58  sub code Line 59  sub code
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 = '';
# Line 67  sub code Line 68  sub code
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)
# Line 84  sub code Line 84  sub code
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;

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26