view release on metacpan or  search on metacpan

lib/Sidef/Object/Object.pm  view on Meta::CPAN

        @parents;
    };

    Sidef::Types::Array::Array->new([$extract_parents->(CORE::ref($obj) || $obj)]);
}

sub interpolate {
    my $self = shift(@_);
    $self->new(CORE::join('', @_));
}

sub dump {
    my %addr;    # keep track of dumped objects

    my $sub = sub {
        my ($obj) = @_;

        my $refaddr = Scalar::Util::refaddr($obj);

        exists($addr{$refaddr})
          and return $addr{$refaddr};

        my $type = Sidef::normalize_type(CORE::ref($obj) || $obj);
        Scalar::Util::reftype($obj) eq 'HASH' or return $type;
        my @keys = CORE::sort(CORE::keys(%{$obj}));

        my $str = Sidef::Types::String::String->new($type . "(#`($refaddr)...)");

        $addr{$refaddr} = $str;

        my $s;
        $$str = (
            "$type(" . CORE::join(
                ', ',
                map {
                    my $str = (
                               defined($obj->{$_})
                               ? (
                                  (CORE::ref($obj->{$_}) && ($s = UNIVERSAL::can($obj->{$_}, 'dump')))
                                  ? $s->($obj->{$_})
                                  : "$obj->{$_}"
                                 )
                               : 'nil'
                              );
                    "$_: $str";
                  } @keys
              )
              . ')'
        );

        $str;
    };

    no warnings 'redefine';
    local *Sidef::Object::Object::dump = $sub;
    $sub->($_[0]);
}

sub to_json {
    my ($self) = @_;
    state $x = require JSON::PP;
    state $y = require Encode;
    Sidef::Types::String::String->new(Encode::decode_utf8(scalar JSON::PP::encode_json($self->get_value)));
}

{
    no strict 'refs';

    sub def_method {
        my ($self, $name, $block) = @_;
        *{(CORE::ref($self) || $self) . '::' . $name} = sub {
            $block->call(@_);
        };
        $self;
    }

    sub undef_method {
        my ($self, $name) = @_;
        delete ${(CORE::ref($self) || $self) . '::'}{$name};
        $self;
    }

    sub alias_method {
        my ($self, $old, $new) = @_;

        my $ref = (CORE::ref($self) || $self);
        my $to  = \&{$ref . '::' . $old};

        if (not defined &$to) {
            die "[ERROR] Can't alias the nonexistent method `$old` as `$new`!";
        }

        *{$ref . '::' . $new} = $to;
    }

    sub methods {
        my ($self, @args) = @_;

        my %alias;
        my %methods;

        my $ref = CORE::ref($self) || $self;

        foreach my $method (grep { $_ !~ /^[(_]/ and defined(&{$ref . '::' . $_}) } keys %{$ref . '::'}) {
            $methods{$method} = (
                                 $alias{\&{$ref . '::' . $method}} //=
                                   Sidef::Object::LazyMethod->new(
                                                                  {
                                                                   obj    => $self,
                                                                   method => $method,
                                                                   args   => \@args,
                                                                  }
                                                                 )
                                );
        }

        Sidef::Types::Hash::Hash->new(\%methods);
    }

    # Smart match operator
    sub smartmatch {
        my ($first, $second) = @_;