view release on metacpan or  search on metacpan

lib/Class/Std/Slots.pm  view on Meta::CPAN

package Class::Std::Slots;

use warnings;
use strict;
use Carp;
use Scalar::Util qw(blessed refaddr weaken);

our $VERSION = '0.31';

my %signal_map  = ();   # maps id -> signame -> array of connected slots
my %signal_busy = ();   # maps id -> signame -> busy flag
my %patched     = ();   # classes whose DESTROY we've patched

# Subs we export to caller's namespace
my @exported_subs = qw(
 connect
 disconnect
 signals
 has_slots
 emit_signal
);

lib/Class/Std/Slots.pm  view on Meta::CPAN

sub _emit_signal {
  my $self     = shift;
  my $sig_name = shift;
  my $src_id   = refaddr( $self );

  unless ( blessed( $self ) ) {
    croak "Signal '$sig_name' must be invoked as a method\n";
  }

  if ( exists( $signal_busy{$src_id}->{$sig_name} ) ) {
    croak "Attempt to re-enter signal '$sig_name'";
  }

  # Flag this signal as busy
  $signal_busy{$src_id}->{$sig_name}++;

  # We still want to remove the busy lock on the signal
  # even if one of the slots dies - so wrap the whole
  # thing in an eval.
  eval {

    # Get the slots registered with this signal
    my $slots = $signal_map{$src_id}->{$sig_name};

    # Might have none... It's not an error.
    if ( defined $slots ) {
      for my $slot ( @{$slots} ) {

lib/Class/Std/Slots.pm  view on Meta::CPAN

            $dst_obj->$dst_method( @args );
          }
          else {
            $dst_obj->( @args );
          }
        }
      }
    }
  };

  # Remove busy flag
  delete $signal_busy{$src_id}->{$sig_name};

  # Rethrow any error
  die if $@;
}

sub _destroy {
  my $src_id = shift;
  delete $signal_map{$src_id};
  delete $signal_busy{$src_id};
}

sub has_slots {
  my $src_obj   = shift;
  my $sig_names = _massage_signal_names( shift );

  croak 'Usage: $obj->has_slots($sig_name)'
   unless blessed $src_obj;

  for my $sig_name ( @{$sig_names} ) {