overload methods

[scpubgit/HTML-String.git] / lib / HTML / String / Value.pm

diff --git a/lib/HTML/String/Value.pm b/lib/HTML/String/Value.pm
index 46181d4..cb73ad2 100644 (file)
--- a/lib/HTML/String/Value.pm
+++ b/lib/HTML/String/Value.pm
@@ -1,49 +1,24 @@
 package HTML::String::Value;
 
 use strictures 1;
+use UNIVERSAL::ref;
 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',
-    '='    => 'clone',
-
-    '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('<<'),
+    '""'   => '_hsv_escaped_string',
+    '.'    => '_hsv_dot',
+    'bool' => '_hsv_is_true',
 
     fallback => 1,
 ;
 
 sub new {
+    if (ref($_[0])) { my $c = shift; return $c->_hsv_unescaped_string->new(@_) }
     my ($class, @raw_parts) = @_;
 
+    my $opts = (ref($raw_parts[-1]) eq 'HASH') ? pop(@raw_parts) : {};
+
     my @parts = map {
         if (ref($_) eq 'ARRAY') {
             $_
@@ -54,14 +29,26 @@ sub new {
         }
     } @raw_parts;
 
-    my $self = bless { parts => \@parts }, $class;
+    my $self = bless { parts => \@parts, %$opts }, $class;
 
     return $self;
 }
 
-sub escaped_string {
+sub AUTOLOAD {
+    my $invocant = shift;
+    (my $meth = our $AUTOLOAD) =~ s/.*:://;
+    die "No such method ${meth} on ${invocant}"
+        unless ref($invocant);
+    return $invocant->_hsv_unescaped_string->$meth(@_);
+}
+
+sub _hsv_escaped_string {
     my $self = shift;
 
+    if ($self->{ignore}{scalar caller}) {
+        return $self->_hsv_unescaped_string;
+    }
+
     return join '', map +(
         $_->[1]
             ? byval { 
@@ -74,13 +61,13 @@ sub escaped_string {
     ), @{$self->{parts}};
 }
 
-sub unescaped_string {
+sub _hsv_unescaped_string {
     my $self = shift;
 
     return join '', map $_->[0], @{$self->{parts}};
 }
 
-sub dot {
+sub _hsv_dot {
     my ($self, $str, $prefix) = @_;
 
     return $self unless $str;
@@ -99,29 +86,14 @@ sub dot {
         push @parts, @new_parts;
     }
 
-    return ref($self)->new(@parts);
+    return ref($self)->new(@parts, { ignore => $self->{ignore} });
 }
 
-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;
+sub _hsv_is_true {
+    my ($self) = @_;
+    return 1 if grep length($_), map $_->[0], @{$self->{parts}};
 }
 
-sub clone {
-    my $self = shift;
-
-    return ref($self)->new(@{$self->{parts}});
-}
+sub ref { '' }
 
 1;