view release on metacpan or  search on metacpan

lib/Ambrosia/core/Object.pm  view on Meta::CPAN

{
    my $self = shift;
    my $other = shift;
    my $deep = shift;
    my $identical = shift;

    return ($identical && int($self) == int($other))
            || (ref($self) eq ref($other) && $self->__equal($other, $deep));
}

################################################################################
sub __AMBROSIA_ATTR_ACTION__ { return {}; }

sub MODIFY_CODE_ATTRIBUTES
{
    my ($package, $subref, @attrs) = @_;

    no strict 'refs';
    no warnings 'redefine';
    my $h = $package->__AMBROSIA_ATTR_ACTION__();
    *{"${package}::__AMBROSIA_ATTR_ACTION__"} = sub { return { %$h, $subref => [$package, $subref, \@attrs] } };
    return;
}

sub FETCH_CODE_ATTRIBUTES
{
    #my ($package, $subref) = @_;
    #my $attrs = $attrs{ refaddr $subref };
    #return @$attrs;
}

1;

__END__

=head1 NAME

Ambrosia::core::Object - an abstract base class for classes that are created by Ambrosia::Meta.

=head1 VERSION

version 0.010

=head1 SYNOPSIS

    # file Foo.pm
    package Foo;
    use strict;
    
    use Ambrosia::Meta;
    class
    {
        public    => [qw/foo_pub1 foo_pub2/],
        protected => [qw/foo_pro1 foo_pro2/],
        private   => [qw/foo_pri1 foo_pri2/],
    };
    
    sub _init
    {
        my $self = shift;
        $self->SUPER::_init(@_);

        $self->foo_pub1 ||= 'foo_pub1';
        $self->foo_pub2 ||= 'foo_pub2';
        $self->foo_pri1 ||= 'foo_pri1';
        $self->foo_pri2 ||= 'foo_pri2';
        $self->foo_pro1 ||= 2;
        $self->foo_pro2 ||= 'foo_pro2';
    }
    
    sub count
    {
        shift->foo_pro1
    }
    
    1;
    
    # file Bar.pm
    package Bar;
    use strict;
    
    use Ambrosia::Meta;
    class sealed
    {
        extends   => [qw/Foo/],
        public    => [qw/bar_pub1 bar_pub2/],
        protected => [qw/bar_pro1 bar_pro2/],
        private   => [qw/bar_pri1 bar_pri2 list/],
    };
    
    sub _init
    {
        my $self = shift;

        #Ignore all input data
        $self->SUPER::_init(foo_pri1=>4);
        $self->bar_pub1 = 'bar_pub1';
        $self->bar_pub2 = 'bar_pub2';
        $self->bar_pri1 = 'bar_pri1';
        $self->bar_pri2 = 'bar_pri2';
        $self->bar_pro1 = 'bar_pro1';
        $self->bar_pro2 = 'bar_pro2';

        $self->list = [] unless defined $self->list;

        push @{$self->list}, (new Foo(foo_pub1 => 'list1.1', foo_pub2 => 'list1.2'),
                              new Foo(foo_pub1 => 'list2.1', foo_pub2 => 'list2.2')
                              );
    }

    1;

    # file test.pl

    #!/usr/bin/perl -w
    use strict;
    use Data::Dumper;
    use Bar;

    my $obj1 = new Bar;

    $obj1->foo_pub1 = 1;
    print $obj1->foo_pub1, "\n";

    use Time::HiRes qw ( time );

    my $s = 0;

    my $t1=time;

    foreach ( 1..10000 )
    {
        $s += $obj1->count;
    }
    print "time:",(time-$t1), "\n";

    print "sum=$s\n";

    $t1=time;

    foreach ( 1..10000 )
    {
        my $obj1 = Bar->new;
    }
    print "time:",(time-$t1), "\n";

    print Dumper($obj1);

    my $r;
    read STDIN, $r, 1;

    print $r;

    ############################################################################

=head1 DESCRIPTION