sub AS_ARRAY {
    my $self=shift;
    # do something useful here
}

##</code><code>##

$obj->[42];  # would be the same as
$obj->AS_ARRAY(42);  # and so on...

##</code><code>##

# -*- Perl -*-

use strict;
use warnings;

package Matrix;

use Scalar::Util qw/refaddr/;
use Data::Dumper;

use base 'Exporter';
our @EXPORT='matrix';

use overload
  '*'  => sub { $_[0]->mult($_[1]) },
  '*=' => sub { $_[0]->multby($_[1]) },
  '**'  => sub { $_[0]->pow($_[1]) };


sub matrix { Matrix->new(@_) }

sub mkaoa { [[ @_[0,1] ], [ @_[2,3] ]] }

{
    my %entry;
    
    sub entry : lvalue {
        my $id=refaddr shift;
        @_==0 ? $entry{$id} :
        @_==1 ? $entry{$id}[ $_[0] ] :
                $entry{$id}[ $_[0] ][ $_[1] ];
    }
    
    sub DESTROY { delete $entry{refaddr shift} }
}

sub new {
    my $class = shift;
    my $self;
    $self = sub : lvalue { $self->entry(@_) };
    bless($self => $class)->init(@_);
}

sub init {
    my $obj=shift;
    $obj->() = mkaoa @_;
    $obj;
}

sub _mult {
    my ($s,$o)=@_;
    $s->(0,0)*$o->(0,0) + $s->(0,1)*$o->(1,0),
    $s->(0,0)*$o->(0,1) + $s->(0,1)*$o->(1,1),
    $s->(1,0)*$o->(0,0) + $s->(1,1)*$o->(1,0),
    $s->(1,0)*$o->(0,1) + $s->(1,1)*$o->(1,1);
}

sub mult { 
    my ($s,$o)=@_;
    matrix $s->_mult($o)
}

sub multby { 
    my ($s,$o)=@_;
    $s->() = mkaoa $s->_mult($o);
    $s;
}

sub pow {
    my ($self, $pow)=@_;
    my $out=matrix 1,0,0,1;
    $out->multby($self) for 1..$pow;
    $out;
}

1;

__END__

##</code><code>##

#!/usr/bin/perl -l

use strict;
use warnings;
use Matrix;

# A somewhat esoteric way to print the
# twelfth Fibonacci number.
print +(matrix(1,1,1,0)**12)->(1,0);

__END__

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;


package Foo;

use Scalar::Util qw/refaddr/;

{
    my %bar;
    
    sub bar { 
        my $id=refaddr shift;
        @_ ? $bar{$id}=shift : $bar{$id};
    }
    
    sub DESTROY { 
        my $obj=shift;
        warn "Deleting $obj\n";
        delete $bar{refaddr $obj};
    }
}

sub new {
    my ($class, $type, $data)=@_;
    my $obj;
    $obj=bless $type eq 'code' ?
      sub { $obj } :
      {} => $class;
    warn "Creating $obj\n";
    $obj->bar($data);
}


package main;

sub test {
    my $type=shift;
    warn "--- Testing <$type> ---\n";
    my $x=Foo->new($type => 'x');
    warn "Leaving context\n";
}

test $_ for qw/code other/;

END { warn "Leaving program\n" }

__END__

##</code><code>##

--- Testing <code> ---
Creating Foo=CODE(0x224eb4)
Leaving context
--- Testing <other> ---
Creating Foo=HASH(0x225bec)
Deleting Foo=HASH(0x225bec)
Leaving context
Leaving program
Deleting Foo=CODE(0x224eb4)