view release on metacpan or  search on metacpan

lib/Squatting/H.pm  view on Meta::CPAN

package Squatting::H;
use strict;
use warnings;
use Clone;

our $AUTOLOAD;

# Squatting::H->new(\%attributes) -- constructor
sub new {
  my ($class, $opts) = @_;
  $opts ||= {};
  CORE::bless { %$opts } => $class;
}

# Squatting::H->bless(\%attributes) -- like new() but directly bless $opts instead of making a shallow copy.
sub bless {
  my ($class, $opts) = @_;
  $opts ||= {};
  CORE::bless $opts => $class;
}

# $object->extend(\%attributes) -- extend keys and values of another hashref into $self
sub extend {
  my ($self, $extend) = @_;
  for (keys %$extend) {
    $self->{$_} = $extend->{$_};
  }
  $self;
}

# $object->clone(\%attributes) -- copy constructor
sub clone {
  my ($self, $extend) = @_;
  my $clone = Clone::clone($self);
  $clone->extend($extend) if ($extend);
  $clone;
}

# $object->slots -- keys of underlying hashref of $object
sub slots {
  keys %{$_[0]}
}

# $object->can($method) -- does the $object support this $method?
sub can {
  UNIVERSAL::can($_[0], $_[1]) || $_[0]->{$_[1]};
}

# $self->$method -- treat key values as methods
sub AUTOLOAD {
  my ($self, @args) = @_;
  my $attr = $AUTOLOAD;
  $attr =~ s/.*://;
  if (ref($self->{$attr}) eq 'CODE') {
    $self->{$attr}->($self, @args)
  } else {
    if (@args) {
      $self->{$attr} = $args[0];
    } else {
      $self->{$attr};
    }
  }
}

sub DESTROY { }

1;

__END__

=head1 NAME

Squatting::H - a slot-based object that's vaguely reminiscent of Camping::H

=head1 SYNOPSIS

Behold, a glorified hashref that you can treat like an object:

  my $cat = Squatting::H->new({