view release on metacpan or  search on metacpan

t/lib/CLR.pm  view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
use warnings;
package CLR_X; # class-less root
# Our test example will be a very, very simple classless/prototype calling
# system. -- rjbs, 2008-05-16
 
sub new {
  my ($class, %attrs) = @_;
  my $root = {
    new => sub {
      my ($parent, %attrs) = @_;
      bless { %attrs, parent => $parent } => $class;
    },
    get => sub {
      my ($self, $attr) = @_;
      my $curr = $self;
      while ($curr) {
        return $curr->{$attr} if exists $curr->{$attr};
        $curr = $curr->{parent};
      }
      return undef;
    },
    set => sub {
      my ($self, $attr, $value) = @_;
      return $self->{$attr} = $value;
    },
    %attrs,
    parent => undef,
  };
 
  bless $root => $class;
}
 
my %STATIC = (new => \&new);
 
use MRO::Magic
  passthru   => [ qw(import export DESTROY AUTOLOAD) ],
  metamethod => sub {
  my ($invocant, $method, $args) = @_;
 
  unless (ref $invocant) {

t/lib/Instance.pm  view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use warnings;
package InstanceX;
 
use Scalar::Util qw(blessed);
 
our $VERSION = '1.000';
 
my %STATIC = (
  new => sub {
    my ($class, $arg) = @_;
    bless $arg => $class;
  }
);
 
my %UNIVERSAL = (
  class => sub { $_[0]->{__class__} }, # shout out to my homies in python
  isa   => sub { return $_[0]->class->derives_from($_[1]); },
);
 
sub invoke_method {
  my ($invocant, $method_name, $args) = @_;