[Jifty-commit] r6184 - in Template-Declare/branches/markapl-syntax: lib/Template/Declare

[Jifty commits]

Author: gugod
Date: Thu Dec 25 01:59:24 2008
New Revision: 6184

Removed:
   Template-Declare/branches/markapl-syntax/lib/Template/Declare/TagCompiler.pm
Modified:
   Template-Declare/branches/markapl-syntax/   (props changed)
   Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm

Log:
 r9515 at yra:  gugod | 2008-12-25 14:53:41 +0800
 Move the whole TagCompiler.pm into Tags.pm for the need to share several global variables.
 
 r9516 at yra:  gugod | 2008-12-25 14:57:53 +0800
 remove debug print


Modified: Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm
==============================================================================
--- Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm	(original)
+++ Template-Declare/branches/markapl-syntax/lib/Template/Declare/Tags.pm	Thu Dec 25 01:59:24 2008
@@ -14,7 +14,9 @@
 use Carp qw(carp croak);
 use Symbol 'qualify_to_ref';
 use Devel::Declare ();
-use Template::Declare::TagCompiler;
+use B::Hooks::EndOfScope;
+
+# use Template::Declare::TagCompiler;
 
 our @EXPORT
     = qw( with template private show show_page attr outs
@@ -79,7 +81,7 @@
             
             $code_str .= qq{sub $tag (&);};
             $config->{$tag} = {
-                const => Template::Declare::TagCompiler::tag_parser_for($tag)
+                const => tag_parser_for($tag, $tagset)
             }
         }
         eval $code_str;
@@ -99,6 +101,154 @@
     *$slot = $coderef;
 }
 
+## 
+our ($Declarator, $Offset);
+
+sub skip_declarator {
+    $Offset += Devel::Declare::toke_move_past_token($Offset);
+}
+
+sub skipspace {
+    $Offset += Devel::Declare::toke_skipspace($Offset);
+}
+
+sub strip_name {
+    skipspace;
+    if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) {
+        my $linestr = Devel::Declare::get_linestr();
+        my $name = substr($linestr, $Offset, $len);
+        substr($linestr, $Offset, $len) = '';
+        Devel::Declare::set_linestr($linestr);
+        return $name;
+    }
+    return;
+}
+
+sub strip_proto {
+    skipspace;
+
+    my $linestr = Devel::Declare::get_linestr();
+    if (substr($linestr, $Offset, 1) eq '(') {
+        my $length = Devel::Declare::toke_scan_str($Offset);
+        my $proto = Devel::Declare::get_lex_stuff();
+        Devel::Declare::clear_lex_stuff();
+        $linestr = Devel::Declare::get_linestr();
+        substr($linestr, $Offset, $length) = '';
+        Devel::Declare::set_linestr($linestr);
+        return $proto;
+    }
+    return;
+}
+
+sub shadow {
+    my $pack = Devel::Declare::get_curstash_name;
+    Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]);
+}
+
+sub make_proto_unwrap {
+    my ($proto) = @_;
+    return (defined($proto) && length($proto)) ? "($proto);" : "";
+}
+
+sub inject_if_block {
+    my $inject = shift;
+    skipspace;
+    my $linestr = Devel::Declare::get_linestr;
+    if (substr($linestr, $Offset, 1) eq '{') {
+        substr($linestr, $Offset+1, 0) = $inject;
+        Devel::Declare::set_linestr($linestr);
+    }
+}
+
+sub inject_before_block {
+    my $inject = shift;
+    skipspace;
+    my $linestr = Devel::Declare::get_linestr;
+    if (substr($linestr, $Offset, 1) eq '{') {
+        substr($linestr, $Offset, 0) = $inject;
+        Devel::Declare::set_linestr($linestr);
+    }
+}
+
+sub inject_scope {
+    on_scope_end {
+        my $linestr = Devel::Declare::get_linestr;
+        my $offset = Devel::Declare::get_linestr_offset;
+        substr($linestr, $offset, 0) = ';';
+        Devel::Declare::set_linestr($linestr);
+    };
+}
+
+my %alt = (
+    'cell'      => 'td',
+    'row'       => 'tr',
+    'html_base' => 'base',
+    'html_link' => 'link',
+    'html_map'  => 'map',
+    'html_q'    => 'q',
+    'html_s'    => 's',
+    'html_sub'  => 'sub',
+    'html_tr'   => 'tr',
+);
+
+sub _tag_builder_for {
+    my ($tag, $tagset) = @_;
+
+    return sub {
+        my $block = pop;
+        my @attr = @_;
+        %ATTRIBUTES = ();
+
+        if (@attr == 1) {
+            my $css = $attr[0];
+            while ($css =~ /([\#\.])(\w+)/g) {
+                if ($1 eq '#') {
+                    $ATTRIBUTES{id} = $2;
+                } else {
+                    $ATTRIBUTES{class} = $2;
+                }
+            }
+        } else {
+            %ATTRIBUTES = (@attr);
+        }
+
+        _tag($tag, $tagset, $block);
+        return '';
+    }
+}
+
+sub tag_parser_for {
+    my ($tag, $tagset) = @_;
+    $tag = $alt{$tag} if defined($alt{$tag});
+
+    return sub {
+        local ($Declarator, $Offset) = @_;
+
+        my $offset_before = $Offset;
+        skip_declarator;
+
+        # This means that current declarator is in a hash key.
+        # Don't shadow sub in this case
+        return if $Offset == $offset_before;
+
+        my $name = strip_name;
+        my $proto = strip_proto;
+
+        inject_if_block("no strict; BEGIN { Template::Declare::TagCompiler::inject_scope }; use strict;");
+
+        if (defined($proto)) {
+            inject_before_block("$proto, sub");
+        }
+        else {
+            inject_before_block("sub");
+        }
+
+        shadow(_tag_builder_for($tag, $tagset));
+    }
+}
+
+##
+
 =head1 NAME
 
 Template::Declare::Tags - Build and install XML Tag subroutines for Template::Declare
@@ -386,7 +536,7 @@
 
 =cut
 
-sub attr (&;@) {
+sub attr($;@) {
     my $code = shift;
     my @rv   = $code->();
     while ( my ( $field, $val ) = splice( @rv, 0, 2 ) ) {
@@ -638,17 +788,14 @@
 }
 
 sub _tag {
+    my $name      = shift;
     my $tagset    = shift;
     my $code      = shift;
     my $more_code = shift;
-    my ($package,   $filename, $line,       $subroutine, $hasargs,
-        $wantarray, $evaltext, $is_require, $hints,      $bitmask
-        )
-        = caller(1);
 
     # This is the hash of attributes filled in by attr() calls in the code;
 
-    my $tag = $subroutine;
+    my $tag = $name;
     $tag =~ s/^.*\:\://;
     # "html:foo"
     $tag = $tagset->namespace . ":$tag"