view release on metacpan or  search on metacpan

lib/App/Chart/Glib/Ex/SignalBlock.pm  view on Meta::CPAN

# or add() take one object and multiple ids
# or new() accept signalids object too



# Copyright 2008, 2009, 2010, 2011 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart::Glib::Ex::SignalBlock;
use 5.008;
use strict;
use warnings;
use Carp;

# uncomment this to run the ### lines
#use Smart::Comments;

sub new {
  my $class = shift;
  my $self = bless [], $class;
  $self->add (@_);
  return $self;
}

sub new_from_signalids {
  my ($class, $ids) = @_;
  return $class->new ($ids->object, $ids->ids);
}

sub add {
  my $self = shift;
  ### SignalBlock on: "@pairs"
  if ((@_ & 1) != 0) {
    croak "SignalBlock expects even number of arguments for object,id pairs";
  }
  require Scalar::Util;
  while (@_) {
    my $object = shift @_;
    my $id = shift @_;
    $object->handler_block ($id);
    push @$self, $object,$id;
    Scalar::Util::weaken ($self->[-2]);
  }
}

sub add_signalids {
  my $self = shift;
  while (@_) {
    my $signalids = shift;
    my $object = $signalids->object;
    foreach my $id ($signalids->ids) {
      $self->add ($object, $id);
    }
  }
}

sub DESTROY {
  my ($self) = @_;
  while (@$self) {
    my $object = shift @$self;
    my $id = shift @$self;
    next if (! defined $object);  # possible weakening

    # could have been disconnected altogether by the application
    if ($object->signal_handler_is_connected ($id)) {
      ### SignalBlock unblock: "$object" . "id=$id"
      $object->handler_unblock ($id);
    }
  }
}

1;
__END__

=head1 NAME

App::Chart::Glib::Ex::SignalBlock -- block signal handlers with scope guard style

=for test_synopsis my ($obj, $id)

=head1 SYNOPSIS

 use App::Chart::Glib::Ex::SignalBlock;
 {
   my $blocker = App::Chart::Glib::Ex::SignalBlock->new ($obj, $id);
   # handler $id for activate is not called
   $obj->activate;
 }
 # until $blocker goes out of scope ...

=head1 DESCRIPTION

B<Not sure about the arguments yet ...>

B<Blocking may be more work than disconnecting and re-connecting ...>

C<App::Chart::Glib::Ex::SignalBlock> temporarily blocks a particular signal handler
connection using C<signal_handler_block>.  When the blocker object is
destroyed it unblocks with C<signal_handler_unblock>.

The idea is that it can be easier to manage the lifespan of an object than
to ensure every exit point from a particular bit of code includes an
unblock.  For example a temporary blocking in a Perl scope, knowing no
matter how it exits (error, goto, return, etc) the signal block will be
undone.

    {
      my $blocker = App::Chart::Glib::Ex::SignalBlock->new ($obj,$id);
      ...
    }

Or objects can help to manage longer lived blocking, so as not to lose track
of things held for a period of time or main loop conditions etc.

It works to nest blockers, done either with SignalBlock or explicit calls.
Glib simply keeps a count of current blocks on each connected ID, which
means there's no need for proper nesting, blockers can overlap in any
fashion.

=head2 Alternatives

You can also simply arrange for your signal handler to do nothing when it