diff --git a/lib/OokOok/Declare/Base/TagLibrary.pm b/lib/OokOok/Declare/Base/TagLibrary.pm index 35b05d9..8c215de 100644 --- 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 index 5641517..8c0277e 100644 --- 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 index e5d45f5..5d38e98 100644 --- 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 index 8a29f8d..0a58bd0 100644 --- 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 { + "" . $yield -> () + } + + under asset { + + element link (Str :$title?) returns HTML { + "" + } + + element image (Str :$title?) returns HTML { + "" + } + + } + + } + 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 index 5f32fbd..a400453 100644 --- 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 index 4ee96bb..2ca5c8f 100644 --- a/lib/OokOok/Template/Parser.pm +++ b/lib/OokOok/Template/Parser.pm @@ -43,17 +43,20 @@ by a L 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 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 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; + } } }