Class::Builtin::Scalar - Scalar as an object

  use Class::Builtin::Scalar;                    # use Class::Builtin::Builtin;
  my $foo = Class::Builtin::Scalar->new('perl'); # OO('perl');
  print $foo->length; # 4

  print Class::Builtin::Scalar->new(0)->methods->join("\n")

package Class::Builtin::Scalar;
use 5.008001;
use warnings;
use strict;
our $VERSION = sprintf "%d.%02d", q$Revision: 0.3 $ =~ /(\d+)/g;

use Carp;
use Encode ();

use overload (
    bool     => sub { !! ${ $_[0] } },
    '""'     => sub { ${ $_[0] } . '' },
    '0+'     => sub { ${ $_[0] } + 0  },
    '@{}'    => sub { $_[0]->split(qr//) },
    # unary ops
    (map { $_ => eval qq{sub {
              __PACKAGE__->new($_ \${\$_[0]});
            }
        } } qw{ ~ }),
    # binary numeric ops
    (map { $_ => eval qq{sub {
              my \$l = ref \$_[0] ? \${\$_[0]} : \$_[0];
              my \$r = ref \$_[1] ? \${\$_[1]} : \$_[1];
              # warn "\$l $_ \$r";
              __PACKAGE__->new(\$l $_ \$r);
            }
        } } qw{+ - * / % ** << >> & | ^ . x }),
    # comparison ops -- bools are not objects
    (map { $_ => eval qq{sub {
                  my \$l = ref \$_[0] ? \${\$_[0]} : \$_[0];
                  my \$r = ref \$_[1] ? \${\$_[1]} : \$_[1];
                  \$l $_ \$r;
            }
        } } qw{ <=> cmp }),
    fallback => 1,
);

sub new {
    my ( $class, $scalar ) = @_;
    return $scalar if ref $scalar;
    bless \$scalar, $class;
}

sub clone{
    __PACKAGE__->new( ${$_[0]} );
}

sub unbless{ ${$_[0]} }

sub dump {
    local ($Data::Dumper::Terse)  = 1;
    local ($Data::Dumper::Indent) = 0;
    local ($Data::Dumper::Useqq)  = 1;
    sprintf 'OO(%s)', Data::Dumper::Dumper(${$_[0]});
}

my @unary = qw(
  length defined ref
  chomp chop chr lc lcfirst ord reverse uc ucfirst
  cos sin exp log sqrt int
  hex oct
);

for my $meth (@unary) {
    eval qq{
            sub Class::Builtin::Scalar::$meth
            {
		my \$self = shift;
		my \$ret  = CORE::$meth(\$\$self);
		__PACKAGE__->new(\$ret);
            }
        };
    croak $@ if $@;
}

sub atan2{
    my $self   = shift;
    my $second = shift || 1;
    __PACKAGE__->new( CORE::atan2($$self, $second) );
}

# prototype: $$ => $
for my $meth (qw/crypt/) {
    eval qq{
            sub Class::Builtin::Scalar::$meth
            {
		my \$self = shift;
                my \$arg0 = shift;
		my \$ret  = CORE::$meth(\$\$self, \$arg0);
		__PACKAGE__->new(\$ret);
            }
        };
    croak $@ if $@;
}
# prototype: $$ => @
sub unpack{
    my $self = shift;
    my $form = shift;
    my @ret  = CORE::unpack $$self, $form;
    __PACKAGE__->new([\@ret]);
}

# prototype: $$;$
for my $meth (qw/index rindex/) {
    eval qq{
            sub Class::Builtin::Scalar::$meth
            {
		my \$self = shift;
                my \$arg0 = shift;
		my \$ret  = \@_ ? CORE::$meth(\$\$self, \$arg0, shift)
                                                : CORE::$meth(\$\$self, \$arg0);
		__PACKAGE__->new(\$ret);
            }
        };
    croak $@ if $@;
}

# prototype:$@
for my $meth (qw/pack sprintf/) {
    eval qq{
            sub Class::Builtin::Scalar::$meth
            {
		my \$self = shift;
		my \$ret  = CORE::$meth(\$\$self, \@_);
		__PACKAGE__->new(\$ret);
            }
        };
    croak $@ if $@;
}

sub substr {
    my $self = shift;
    croak unless @_ > 0;
    my $ret =
        @_ == 1 ? CORE::substr $$self, $_[0]
      : @_ == 2 ? CORE::substr $$self, $_[0], $_[1]
      : CORE::substr @$self, $_[0], $_[1], $_[2];
    return @_ > 2 ? $self : __PACKAGE__->new($ret);
}

sub split {
    my $self = shift;
    my $pat  = shift || qr//;
    my @ret  = CORE::split $pat, $$self;
    Class::Builtin::Array->new( [@ret] );
}

sub print {
    my $self = shift;
    @_ ? CORE::print {$_[0]} $$self : CORE::print $$self;
}

sub say {
    my $self = shift;
    local $\ = "\n";
    @_ ? CORE::print {$_[0]} $$self : CORE::print $$self;
}

sub methods {
    Class::Builtin::Array->new(
        [ sort grep { defined &{$_} } keys %Class::Builtin::Scalar:: ] );
}

# Encode-related
for my $meth (qw/decode encode decode_utf8/){
    eval qq{
        sub Class::Builtin::Scalar::$meth
        {
		my \$self = shift;
		my \$ret  = Encode::$meth(\$\$self,\@_);
		__PACKAGE__->new(\$ret);
        }
        };
    croak $@ if $@;
}
for my $meth (qw/encode_utf8/){
    eval qq{
        sub Class::Builtin::Scalar::$meth
        {
		my \$self = shift;
		my \$ret  = Encode::$meth(\$\$self);
		__PACKAGE__->new(\$ret);
        }
        };
    croak $@ if $@;
}

*bytes = \&encode_utf8;
*utf8  = \&decode_utf8;

# Scalar::Util
# dualvar() and  set_prototype() not included

our @scalar_util = qw(
  blessed isweak readonly refaddr reftype tainted
  weaken isvstring looks_like_number
);

for my $meth (qw/blessed isweak refaddr reftype weaken/){
    eval qq{
            sub Class::Builtin::Scalar::$meth
            {
		my \$self = shift;
		my \$ret  = Scalar::Util::$meth(\$self);
		__PACKAGE__->new(\$ret);
            }
        };
    croak $@ if $@;
}

for my $meth (qw/readonly tainted isvstring looks_like_number/){
    eval qq{
            sub Class::Builtin::Scalar::$meth
            {
		my \$self = shift;
		my \$ret  = Scalar::Util::$meth(\$\$self);
		__PACKAGE__->new(\$ret);
            }
        };
    croak $@ if $@;
}

1; # End of Class::Builtin::Scalar