initial import of HTML::String

diff --git a/lib/HTML/String.pm b/lib/HTML/String.pm
new file mode 100644 (file)
index 0000000..033be4e
--- /dev/null
+++ b/lib/HTML/String.pm
@@ -0,0 +1,13 @@
+package HTML::String;
+
+use strictures 1;
+use HTML::String::Value;
+use Exporter 'import';
+
+our @EXPORT = qw(html);
+
+sub html {
+  HTML::String::Value->new($_[0]);
+}
+
+1;

diff --git a/lib/HTML/String/Overload.pm b/lib/HTML/String/Overload.pm
new file mode 100644 (file)
index 0000000..e5f7c72
--- /dev/null
+++ b/lib/HTML/String/Overload.pm
@@ -0,0 +1,15 @@
+package HTML::String::Overload;
+
+use strictures 1;
+use HTML::String;
+use B::Hooks::EndOfScope;
+use overload '';
+
+sub import {
+  overload::constant q => \&html;
+  on_scope_end {
+    overload::remove_constant('q');
+  }
+}
+
+1;

diff --git a/lib/HTML/String/Value.pm b/lib/HTML/String/Value.pm
new file mode 100644 (file)
index 0000000..d03b287
--- /dev/null
+++ b/lib/HTML/String/Value.pm
@@ -0,0 +1,112 @@
+package HTML::String::Value;
+
+use strictures 1;
+use Safe::Isa;
+use Data::Munge;
+
+sub op_factory {
+    my ($op) = @_;
+
+    return eval q|sub {
+        my ($self, $str) = @_;
+
+        if ( $str->$_isa(__PACKAGE__) ) {
+            return $self->unescaped_string | . $op . q| $str->unescaped_string;
+        }
+        else {
+            return $self->unescaped_string | . $op . q| $str;
+        }
+    }|;
+}
+
+use overload
+    '""'   => 'escaped_string',
+    '.'    => 'dot',
+    '.='   => 'dot_equals',
+
+    'cmp' => op_factory('cmp'),
+    'eq'  => op_factory('eq'),
+    '<=>' => op_factory('<=>'),
+    '=='  => op_factory('=='),
+    '%'   => op_factory('%'),
+    '+'   => op_factory('+'),
+    '-'   => op_factory('-'),
+    '*'   => op_factory('*'),
+    '/'   => op_factory('/'),
+    '**'  => op_factory('**'),
+    '>>'  => op_factory('>>'),
+    '<<'  => op_factory('<<'),
+
+    fallback => 1,
+;
+
+sub new {
+    my ($class, @raw_parts) = @_;
+
+    my @parts = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @raw_parts;
+
+    my $self = bless { parts => \@parts }, $class;
+
+    return $self;
+}
+
+sub escaped_string {
+    my $self = shift;
+
+    return join '', map +(
+        $_->[1]
+            ? byval { 
+                s/&/&amp;/g;
+                s/</&lt;/g;
+                s/>/&gt;/g;
+                s/"/&quot;/g;
+              } $_->[0]
+            : $_->[0]
+    ), @{$self->{parts}};
+}
+
+sub unescaped_string {
+    my $self = shift;
+
+    return join '', map $_->[0], @{$self->{parts}};
+}
+
+sub dot {
+    my ($self, $str, $prefix) = @_;
+
+    return $self unless $str;
+
+    my @parts = @{$self->{parts}};
+
+    my @new_parts = (
+        $str->$_isa(__PACKAGE__)
+            ? @{$str->{parts}}
+            : [ $str, 1 ]
+    );
+
+    if ( $prefix ) {
+        unshift @parts, @new_parts;
+    } else {
+        push @parts, @new_parts;
+    }
+
+    return ref($self)->new(@parts);
+}
+
+sub dot_equals {
+    my ($self, $str, $prefix) = @_;
+
+    return $self unless $str;
+
+    my @new_parts = (
+        $str->$_isa(__PACKAGE__)
+            ? @{$str->{parts}}
+            : [ $str, 1 ]
+    );
+
+    push @{$self->{parts}}, @new_parts;
+
+    return $self;
+}
+
+1;

diff --git a/t/simple.t b/t/simple.t
new file mode 100644 (file)
index 0000000..da35254
--- /dev/null
+++ b/t/simple.t
@@ -0,0 +1,19 @@
+use strictures 1;
+use Test::More;
+use HTML::String;
+
+my $hi = 'Hi <bob>';
+
+my $one = html('<tag>').$hi.html('</tag>');
+
+is("$one", '<tag>Hi &lt;bob&gt;</tag>');
+
+my $two = do {
+  use HTML::String::Overload;
+
+  "<tag>${hi}</tag>"
+};
+
+is("$two", '<tag>Hi &lt;bob&gt;</tag>');
+
+done_testing;