options to ignore specific callers, more TT tests
Matt S Trout [Sun, 12 Aug 2012 16:32:14 +0000 (09:32 -0700)]
lib/HTML/String/Overload.pm
lib/HTML/String/TT/Directive.pm
lib/HTML/String/Value.pm
t/simple.t

index 1191c4a..3c72850 100644 (file)
@@ -1,12 +1,15 @@
 package HTML::String::Overload;
 
 use strictures 1;
-use HTML::String;
+use HTML::String::Value;
 use B::Hooks::EndOfScope;
 use overload ();
 
 sub import {
-    overload::constant q => \&html;
+    my ($class, @opts) = @_;
+    overload::constant q => sub {
+        HTML::String::Value->new($_[1], @opts);
+    };
     on_scope_end { __PACKAGE__->unimport };
 }
 
index b77d501..5e6baad 100644 (file)
@@ -7,8 +7,22 @@ use base qw(Template::Directive);
 
 sub template {
     return byval {
-        s/sub {/sub { use HTML::String::Overload;/;
+        s/sub {/sub { package HTML::String::TT::_TMPL; use HTML::String::Overload { ignore => { q{Template::Provider} => 1, q{Template::Directive} => 1, q{Template::Document} => 1 } };/;
     } Template::Directive::pad(shift->SUPER::template(@_), 2);
 }
 
+sub textblock {
+    my ($self, $text) = @_;
+    return $Template::Directive::OUTPUT.' '.$self->text($text).';';
+}
+
+sub text {
+    my ($class, $text) = @_;
+    for ($text) {
+        s/(["\$\@\\])/\\$1/g;
+        s/\n/"."\\n"."/g;
+    }
+    return '"' . $text . '"';
+}
+
 1;
index 2ef0ba9..2e48349 100644 (file)
@@ -8,6 +8,7 @@ use Data::Munge;
 use overload
     '""'   => 'escaped_string',
     '.'    => 'dot',
+    'bool' => 'is_true',
 
     fallback => 1,
 ;
@@ -15,6 +16,8 @@ use overload
 sub new {
     my ($class, @raw_parts) = @_;
 
+    my $opts = (ref($raw_parts[-1]) eq 'HASH') ? pop(@raw_parts) : {};
+
     my @parts = map {
         if (ref($_) eq 'ARRAY') {
             $_
@@ -25,7 +28,7 @@ sub new {
         }
     } @raw_parts;
 
-    my $self = bless { parts => \@parts }, $class;
+    my $self = bless { parts => \@parts, %$opts }, $class;
 
     return $self;
 }
@@ -33,6 +36,10 @@ sub new {
 sub escaped_string {
     my $self = shift;
 
+    if ($self->{ignore}{scalar caller}) {
+        return $self->unescaped_string;
+    }
+
     return join '', map +(
         $_->[1]
             ? byval { 
@@ -70,7 +77,12 @@ sub dot {
         push @parts, @new_parts;
     }
 
-    return ref($self)->new(@parts);
+    return ref($self)->new(@parts, { ignore => $self->{ignore} });
+}
+
+sub is_true {
+    my ($self) = @_;
+    return 1 if grep length($_), map $_->[0], @{$self->{parts}};
 }
 
 sub ref { '' }
index b77accd..af9ff91 100644 (file)
@@ -16,4 +16,23 @@ my $two = do {
 
 is("$two", '<tag>Hi &lt;bob&gt;</tag>');
 
+my $three = html('<tag>');
+
+$three .= $hi;
+
+$three .= html('</tag>');
+
+is("$three", '<tag>Hi &lt;bob&gt;</tag>');
+
+my $four; {
+  use HTML::String::Overload { ignore => { lies => 1 } };
+
+  #$four = "<tag>".$hi."</tag>\n";
+  $four = "<tag>$hi</tag>"."\n";
+};
+
+chomp($four);
+
+is("$four", '<tag>Hi &lt;bob&gt;</tag>');
+
 done_testing;