Class::Observable 1.04

Class::Observable is a Perl module that allows other classes and objects to respond to events in yours.

SYNOPSIS

# Define an observable class

package My::Object;

use base qw( Class::Observable );

# Tell all classes/objects observing this object that a state-change
# has occurred

sub create {
my ( $self ) = @_;
eval { $self->_perform_create() };
if ( $@ ) {
My::Exception->throw( "Error saving: $@" );
}
$self->notify_observers();
}

# Same thing, except make the type of change explicit and pass
# arguments.

sub edit {
my ( $self ) = @_;
my %old_values = $self->extract_values;
eval { $self->_perform_edit() };
if ( $@ ) {
My::Exception->throw( "Error saving: $@" );
}
$self->notify_observers( edit, old_values => %old_values );
}

# Define an observer

package My::Observer;

sub update {
my ( $class, $object, $action ) = @_;
unless ( $action ) {
warn "Cannot operation on [", $object->id, "] without action";
return;
}
$class->_on_save( $object ) if ( $action eq save );
$class->_on_update( $object ) if ( $action eq update );
}

# Register the observer class with all instances of the observable
# class

My::Object->add_observer( My::Observer );

# Register the observer class with a single instance of the
# observable class

my $object = My::Object->new( foo );
$object->add_observer( My::Observer );

# Register an observer object the same way

my $observer = My::Observer->new( bar );
My::Object->add_observer( $observer );
my $object = My::Object->new( foo );
$object->add_observer( $observer );

# Register an observer using a subroutine

sub catch_observation { ... }

My::Object->add_observer( &catch_observation );
my $object = My::Object->new( foo );
$object->add_observer( &catch_observation );

# Define the observable class as a parent and allow the observers to
# be used by the child

package My::Parent;

use strict;
use base qw( Class::Observable );

sub prepare_for_bed {
my ( $self ) = @_;
$self->notify_observers( prepare_for_bed );
}

sub brush_teeth {
my ( $self ) = @_;
$self->_brush_teeth( time => 45 );
$self->_floss_teeth( time => 30 );
$self->_gargle( time => 30 );
}

sub wash_face { ... }


package My::Child;

use strict;
use base qw( My::Parent );

sub brush_teeth {
my ( $self ) = @_;
$self->_wet_toothbrush();
}

sub wash_face { return }

# Create a class-based observer

package My::ParentRules;

sub update {
my ( $item, $action ) = @_;
if ( $action eq prepare_for_bed ) {
$item->brush_teeth;
$item->wash_face;
}
}

My::Parent->add_observer( __PACKAGE__ );

$parent->prepare_for_bed # brush, floss, gargle, and wash face
$child->prepare_for_bed # pretend to brush, pretend to wash face