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;
        Sidef::Types::String::String->new(scalar JSON::to_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) = @_;