add ability to nest tags using "under" keyword

jgsmith · Oct 8, 2012 · 7f2fb28 · 7f2fb28
1 parent b0efd15
commit 7f2fb28
Show file tree

Hide file tree

Showing 6 changed files with 173 additions and 18 deletions.
diff --git a/lib/OokOok/Declare/Base/TagLibrary.pm b/lib/OokOok/Declare/Base/TagLibrary.pm
@@ -17,10 +17,30 @@ class OokOok::Declare::Base::TagLibrary {
   method process_node ($ctx, $node) {
     # we want to pull out attributes and such based on needs of tag
     my $name = $node -> {local};
-    my $einfo = $self -> meta -> element( $name );
-    return if !$einfo; # TODO: perhaps throw an error if not a defined element
+    my @context = $ctx -> get_namespace_context($node -> {prefix});
+    push @context, $name;
+    my $einfo;
+    while(!$einfo && @context) {
+      $einfo = $self -> meta -> element( join(":", @context) );
+      shift @context;
+    }
+
+    # if we don't find anything, then we'll push the tag name onto the
+    # stack and dive in
+    if(!$einfo || !$einfo -> {impl}) {
+      if(@{$node->{children}||[]}) {
+        $ctx = $ctx -> localize;
+        $ctx -> add_namespace_context($node -> {prefix}, $name);
+        return $ctx -> process_node( $node -> {children} );
+      }
+      else {
+        # TODO: perhaps throw an error if not a defined element
+        return '';
+      }
+    }
+
 
-    return if !$einfo -> {impl}; # Nothing to do, so don't do anything
+    return '' if !$einfo -> {impl}; # Nothing to do, so don't do anything
 
     my $context = $ctx -> localize;
     my $xmlns;
@@ -55,6 +75,8 @@ class OokOok::Declare::Base::TagLibrary {
     if($einfo -> {yields} && @{$node -> {children}||[]}) {
       $yield = sub { 
         my $ctx = @_ ? $_[0] : $context;
+        $ctx = $ctx -> localize;
+        $ctx -> add_namespace_context($node -> {prefix}, $name);
         $ctx -> process_node( $node -> {children} || [''] );
       };
     }

diff --git a/lib/OokOok/Declare/Keyword/Element.pm b/lib/OokOok/Declare/Keyword/Element.pm
@@ -4,6 +4,9 @@ use MooseX::Declare;
 
 # ABSTRACT: Handle tag library element declarations
 
+$OokOok::Declare::SCOPE::UNDER = '';
+@OokOok::Declare::SCOPE::UNDER_STACK = ( );
+
 class OokOok::Declare::Keyword::Element 
   with MooseX::Declare::Syntax::KeywordHandling {
 
@@ -12,16 +15,13 @@ class OokOok::Declare::Keyword::Element
   use Carp qw( croak );
 
   use constant STOP_PARSING => '__MXDECLARE_STOP_PARSING__';
+  use constant UNDER_STACK  => '@OokOok::Declare::SCOPE::UNDER_STACK';
 
   use aliased 'CatalystX::Declare::Context::StringParsing';
   use aliased 'MooseX::Method::Signatures::Meta::Method';
   use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
   use aliased 'MooseX::MethodAttributes::Role::Meta::Role',   'AttributeMetaRole';
 
-  method register_method_declaration($meta, $name, $method) {
-    $meta -> add_method( $name, $method -> body );
-  }
-
   method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
     my %attributes = ( Returns => 'Str' );
     my @populators;
@@ -73,8 +73,6 @@ class OokOok::Declare::Keyword::Element
     if($attributes{Flags}{yielding}) {
       push @signature, 'CodeRef $yield';
     }
-    #push @signature, $attributes{Signature} || ();
-    #my $signature = join(", ", @signature);
 
     # register the element with the metaclass
     my %el_info = (
@@ -120,9 +118,8 @@ class OokOok::Declare::Keyword::Element
     $ctx -> inject_code_parts_here($code);
     $ctx -> inc_offset(length $code);
 
-    if($ctx -> peek_next_char eq '{') {
+    if($ctx -> peek_next_char eq '{') { # '}'
       $ctx -> inject_if_block( $ctx -> scope_injector_call . $method -> injectable_code );
-      #$ctx -> inject_if_block( $method -> injectable_code );
     }
     else {
       $ctx -> inject_code_parts_here(
@@ -147,6 +144,14 @@ class OokOok::Declare::Keyword::Element
       my $name = substr($attributes{Subname}, 1, -1);
       $body = $attrs and $attrs = {} if ref $attrs eq 'CODE';
 
+      my $under = join("_", "element", grep { defined } (@OokOok::Declare::SCOPE::UNDER_STACK, $attrs->{Chained}));
+
+      my $el_name = join(":", grep { defined } (@OokOok::Declare::SCOPE::UNDER_STACK, $attrs->{Chained}, $el_info{name}));
+
+      $name = $under . substr($name, 7);
+
+      $method -> name($name);
+
       my $real_method = $method -> reify(
         actual_body => $body,
         attributes => $compiled_attrs,
@@ -155,7 +160,7 @@ class OokOok::Declare::Keyword::Element
 
       my $prepare_meta = sub {
         my($meta) = @_;
-        $meta -> add_element( $el_info{name}, %el_info );
+        $meta -> add_element( $el_name, %el_info, impl => $name );
         $meta -> add_method( $name, $real_method );
         #$meta -> register_method_attributes($meta -> name -> can( $real_method -> name ), $compiled_attrs );
       };
@@ -194,6 +199,7 @@ class OokOok::Declare::Keyword::Element
     my $proto = $ctx -> strip_proto || '';
 
     $attrs -> {ElementName} ||= $name;
+
     $name = "'element_" . substr($name, 1);
     $attrs -> {Subname} = $name;
     $attrs -> {Signature} = $proto;
@@ -235,6 +241,27 @@ class OokOok::Declare::Keyword::Element
     return;
   }
 
+  method _handle_under_option (Object $ctx, HashRef $attrs) {
+    my $target = $self -> _strip_actionpath($ctx, interpolate => 1);
+    $ctx -> skipspace;
+
+    if($ctx->peek_next_char eq '{' and $self -> identifier eq 'under') {
+      $ctx -> inject_if_block(
+        $ctx -> scope_injector_call(sprintf 'pop %s;',UNDER_STACK) .
+        sprintf ';push %s, %s;',
+          UNDER_STACK,
+          $target,
+      );
+      return STOP_PARSING;
+    }
+
+    $attrs->{Chained} = $target;
+
+    return sub {
+      my $method = shift;
+    };
+  }
+
   method _strip_string (Object $ctx, :$interpolate?) {
     $ctx -> skipspace;
 
@@ -261,6 +288,39 @@ class OokOok::Declare::Keyword::Element
       croak "Invalid syntax for element name: $rest";
     }
   }
+
+  method _strip_actionpath (Object $ctx, :$interpolate?) {
+
+    $ctx->skipspace;
+    my $linestr = $ctx->get_linestr;
+    my $rest    = substr($linestr, $ctx->offset);
+    my $interp  = sub { $interpolate ? "'$_[0]'" : $_[0] };
+
+    # find simple barewords
+    if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
+      substr($linestr, $ctx->offset, length($1)) = '';
+      $ctx->set_linestr($linestr);
+      return $interp->($1);
+    }
+
+    # allow single quoted more complex barewords
+    elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
+      substr($linestr, $ctx->offset, length($1) + 2) = '';
+      $ctx->set_linestr($linestr);
+      return $interp->($1);
+    }
+
+    # double quoted strings and variables
+    elsif ($interpolate and my $str = $ctx->get_string) {
+      return $str;
+    }
+
+    # not suitable as action path
+    else {
+      croak "Invalid syntax for action path: $rest";
+    }
+  }
+
  
   with 'MooseX::Declare::Syntax::KeywordHandling';
 

diff --git a/lib/OokOok/Declare/Keyword/TagLibrary.pm b/lib/OokOok/Declare/Keyword/TagLibrary.pm
@@ -35,6 +35,7 @@ class OokOok::Declare::Keyword::TagLibrary
     [
       @{$self -> $orig},
       ElementKeyword -> new(  identifier => 'element' ),
+      ElementKeyword -> new(  identifier => 'under'   ),
       #AttributeKeyword -> new( identifier => 'attribute' ),
     ];
   }

diff --git a/lib/OokOok/TagLibrary/Core.pm b/lib/OokOok/TagLibrary/Core.pm
@@ -6,6 +6,26 @@ use OokOok::Declare;
 
 taglib OokOok::TagLibrary::Core {
 
+  under theme {
+
+    element asset (Str :$name) is yielding returns HTML {
+      "<!-- theme:asset -->" . $yield -> ()
+    }
+
+    under asset {
+
+      element link (Str :$title?) returns HTML {
+        "<!-- theme:asset:link -->"
+      }
+
+      element image (Str :$title?) returns HTML {
+        "<!-- theme:asset:image -->"
+      }
+
+    }
+
+  }
+
   documentation <<'EOD';
 Used within a snippet as a placeholder for substitution of child content, when
 the snippet is called as a double tag.

diff --git a/lib/OokOok/Template/Context.pm b/lib/OokOok/Template/Context.pm
@@ -59,6 +59,13 @@ The constructor takes the following options:
     lazy => 1,
   );
 
+  has _namespace_context => (
+    isa => 'HashRef',
+    is => 'rw',
+    default => sub { +{ } },
+    lazy => 1,
+  );
+
   has _yield => (
     isa => 'Maybe[CodeRef]',
     is => 'rw',
@@ -241,7 +248,21 @@ Associates the given value with the key in the current context.
     else { # if(is_ArrayRef($node)) {
       return join '', map {
         $self -> process_node($_)
-      } @{$node};
+      } grep { defined } @{$node};
+    }
+  }
+
+  method add_namespace_context ( Str $ns, Str $local ) {
+    $self -> _namespace_context -> {$ns} ||= [];
+    push @{$self -> _namespace_context -> {$ns}}, split(/:/, $local);
+  }
+
+  method get_namespace_context( Str $ns ) {
+    if($self -> has_parent) {
+      return $self -> parent -> get_namespace_context($ns), @{$self -> _namespace_context -> {$ns} || []};
+    }
+    else {
+      return @{$self -> _namespace_context -> {$ns} || []};
     }
   }
 }
diff --git a/lib/OokOok/Template/Parser.pm b/lib/OokOok/Template/Parser.pm
@@ -43,17 +43,20 @@ by a L<OokOok::Template::Document> instance.
         $self -> characters($c);
         $text = substr($text, length($c));
       }
-      if($text =~ m{\A<(/?)$prefix_regex(\S+)}s) {
+      if($text =~ m{\A<(/?)$prefix_regex([-A-Za-z0-9:_]+)}s) {
         my($ending, $prefix, $local) = ($1, $2, $3);
         $text = substr($text, length($prefix) + length($local) 
                                               + ($ending ? 3 : 2));
         if($ending) {
+          if(!($text =~ s{\A\s*>}{}s)) {
+            # error parsing
+          }
           $self -> end_element( $prefix, $local );
         }
         else {
           $self -> start_element( $prefix, $local );
           # now parse attributes
-          while($text && $text =~ m{\A(\s*$prefix_regex(\S+)\s*=\s*)}s) {
+          while($text && $text =~ m{\A(\s*$prefix_regex([-A-Za-z0-9_]+)\s*=\s*)}s) {
             my($ent, $aprefix, $attr) = ($1, $2, $3);
             $text = substr($text, length($ent));
             # now parse out balanced quotation
@@ -87,8 +90,10 @@ by a L<OokOok::Template::Document> instance.
 =cut
 
   method start_element (Str $prefix, Str $el) {
-    push @{$self -> _el_stack -> [0] -> {children}}, $self -> _buffer;
-    $self -> _buffer('');
+    if($self -> _buffer ne '') {
+      push @{$self -> _el_stack -> [0] -> {children}}, $self -> _buffer;
+      $self -> _buffer('');
+    }
     unshift @{$self -> _el_stack}, { prefix => $prefix, local => $el, attrs => {}, children => [] };
   }
 
@@ -111,6 +116,32 @@ by a L<OokOok::Template::Document> instance.
     push @{$self -> _el_stack -> [0] -> {children}}, $self -> _buffer;
     $self -> _buffer('');
     my $info = shift @{$self -> _el_stack};
-    push @{$self -> _el_stack -> [0] -> {children}}, $info;
+    # if $info->{local} has ':', then we need to expand into children
+    if($info->{local} =~ /:/) {
+      my @bits = split(/:/, $info->{local});
+      my $root = {
+        prefix => $info->{prefix},
+        local => shift(@bits),
+        attrs => $info->{attrs},
+        children => [],
+      };
+      push @{$self -> _el_stack -> [0] -> {children}}, $root;
+      my $cinfo = $root;
+
+      while(@bits) {
+        $cinfo  = {
+          prefix => $info->{prefix},
+          local => shift(@bits),
+          attrs => $info->{attrs},
+          children => [],
+        };
+        push @{$root -> {children}}, $cinfo;
+        $root = $cinfo;
+      }
+      $cinfo -> {children} = $info->{children};
+    }
+    else {
+      push @{$self -> _el_stack -> [0] -> {children}}, $info;
+    }
   }
 }