/[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.4 by jlenton, Wed Apr 9 19:59:22 2003 UTC revision 1.5 by jlenton, Wed Apr 9 23:52:49 2003 UTC
# Line 7  use neb; Line 7  use neb;
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"
# Line 44  sub init Line 24  sub init
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',
# Line 78  sub code Line 65  sub code
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    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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