view release on metacpan or  search on metacpan

lib/Class/Observable.pm  view on Meta::CPAN

}

sub count_observers { scalar $_[0]->get_observers }

sub get_direct_observers {
	my $invocant = shift;
	my $addr = refaddr $invocant;
	my $observers = $O{ $addr || "::$invocant" } or return wantarray ? () : 0;
	@$observers;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Class::Observable - Allow other classes and objects to respond to events in yours

=head1 SYNOPSIS

  # Define an observable class
 
  package My::Object;
 
  use parent 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 parent 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 parent 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

=head1 DESCRIPTION

If you have ever used Java, you may have run across the
C<java.util.Observable> class and the C<java.util.Observer>
interface. With them you can decouple an object from the one or more
objects that wish to be notified whenever particular events occur.

These events occur based on a contract with the observed item. They
may occur at the beginning, in the middle or end of a method. In
addition, the object B<knows> that it is being observed. It just does
not know how many or what types of objects are doing the observing. It
can therefore control when the messages get sent to the obsevers.

The behavior of the observers is up to you. However, be aware that we
do not do any error handling from calls to the observers. If an
observer throws a C<die>, it will bubble up to the observed item and
require handling there. So be careful.

=head1 USER GUIDE

Throughout this documentation we refer to an 'observed item' or
'observable item'. This ambiguity refers to the fact that both a class
and an object can be observed. The behavior when notifying observers
is identical. The only difference comes in which observers are
notified. (See L<Observable Classes and Objects> for more
information.)

=head2 Observable Classes and Objects

The observable item does not need to implement any extra methods or
variables. Whenever it wants to let observers know about a
state-change or occurrence in the object, it just needs to call
C<notify_observers()>.

As noted above, whether the observed item is a class or object does
not matter -- the behavior is the same. The difference comes in
determining which observers are to be notified:

=over 4

=item *

If the observed item is a class, all objects instantiated from that
class will use these observers. In addition, all subclasses and
objects instantiated from the subclasses will use these observers.

=item *

lib/Class/Observable.pm  view on Meta::CPAN

 my @observers = Baz->get_observers();
 my @observers = $baz_a->get_observers();

would return a two-item list. The first item would be the
C<observer_b> code reference, the second the C<observer_a> code
reference. Running:

 my @observers = $baz_b->get_observers();

would return a three-item list, including the observer for that
specific object (C<observer_c> coderef) as well as from its class
(Baz) and the parent (Foo) of its class.

=head2 Types of Observers

There are three types of observers: classes, objects, and
subroutines. All three respond to events when C<notify_observers()> is
called from an observable item. The differences among the three are
are:

=over 4

=item *

A class or object observer must implement a method C<update()> which
is called when a state-change occurs. The name of the subroutine
observer is irrelevant.

=item *

A class or object observer must take at least two arguments: itself
and the observed item. The subroutine observer is obligated to take
only one argument, the observed item.

Both types of observers may also take an action name and a hashref of
parameters as optional arguments. Whether these are used depends on
the observed item.

=item *

Object observers can maintain state between responding to
observations.

=back

Examples:

B<Subroutine observer>:

 sub respond {
     my ( $item, $action, $params ) = @_;
     return unless ( $action eq 'update' );
     # ...
 }
 $observable->add_observer( \&respond );

B<Class observer>:

 package My::ObserverC;
 
 sub update {
     my ( $class, $item, $action, $params ) = @_;
     return unless ( $action eq 'update' );
     # ...
 }

B<Object observer>:

 package My::ObserverO;
 
 sub new {
     my ( $class, $type ) = @_;
     return bless ( { type => $type }, $class );
 }
 
 sub update {
     my ( $self, $item, $action, $params ) = @_;
     return unless ( $action eq $self->{type} );
     # ...
 }

=head2 Observable Objects and DESTROY

This class has a C<DESTROY> method which B<must> run
when an instance of an observable class goes out of scope
in order to clean up the observers added to that instance.

If there is no other destructor in the inheritance tree,
this will end up happening naturally and everything will be fine.

If it does not get called, then the list of observers B<will leak>
(which also prevents the observers in it from being garbage-collected)
and B<may become associated with a different instance>
created later at the same memory address as a previous instance.

This may happen if a class needs its own C<DESTROY> method
when it also wants to inherit from Class::Observer (even indirectly!),
because perl only invokes the single nearest inherited C<DESTROY>.

The most straightforward (but maybe not best) way to ensure that
the destructor is called is to do something like this:

  # in My::Class
  sub DESTROY {
      # ...
      $self->Class::Observable::DESTROY;
      # ...
  }

A better way may be to to write all destructors in your class hierarchy
with the expectation that all of them will be called
(which would usually be preferred anyway)
and then enforcing that expectation by writing all of them as follows:

  use mro;
  sub DESTROY {
      # ...
      $self->maybe::next::method;
      # ...
  }

(Perl being Perl, of course, there are many other ways to go about this.)

=head1 METHODS

B<notify_observers( [ $action, @params ] )>

Called from the observed item, this method sends a message to all
observers that a state-change has occurred. The observed item can
optionally include additional information about the type of change
that has occurred and any additional parameters C<@params> which get
passed along to each observer. The observed item should indicate in
its API what information will be passed along to the observers in
C<$action> and C<@params>.

Returns: Nothing