From: Matt S Trout Date: Sun, 12 Aug 2012 16:32:14 +0000 (-0700) Subject: options to ignore specific callers, more TT tests X-Git-Tag: v1.000000~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f27b509e7eec9bebb50f89023923dc05f78b54a6;p=scpubgit%2FHTML-String.git options to ignore specific callers, more TT tests --- diff --git a/lib/HTML/String/Overload.pm b/lib/HTML/String/Overload.pm index 1191c4a..3c72850 100644 --- a/lib/HTML/String/Overload.pm +++ b/lib/HTML/String/Overload.pm @@ -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 }; } diff --git a/lib/HTML/String/TT/Directive.pm b/lib/HTML/String/TT/Directive.pm index b77d501..5e6baad 100644 --- a/lib/HTML/String/TT/Directive.pm +++ b/lib/HTML/String/TT/Directive.pm @@ -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; diff --git a/lib/HTML/String/Value.pm b/lib/HTML/String/Value.pm index 2ef0ba9..2e48349 100644 --- a/lib/HTML/String/Value.pm +++ b/lib/HTML/String/Value.pm @@ -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 { '' } diff --git a/t/simple.t b/t/simple.t index b77accd..af9ff91 100644 --- a/t/simple.t +++ b/t/simple.t @@ -16,4 +16,23 @@ my $two = do { is("$two", 'Hi <bob>'); +my $three = html(''); + +$three .= $hi; + +$three .= html(''); + +is("$three", 'Hi <bob>'); + +my $four; { + use HTML::String::Overload { ignore => { lies => 1 } }; + + #$four = "".$hi."\n"; + $four = "$hi"."\n"; +}; + +chomp($four); + +is("$four", 'Hi <bob>'); + done_testing;