File Coverage

blib/lib/X11/Protocol/GrabServer.pm

Criterion	Covered	Total	%
statement	14	38	36.8
branch	1	12	8.3
condition	1	7	14.2
subroutine	6	11	54.5
pod	4	4	100.0
total	26	72	36.1

# Copyright 2010, 2011, 2012, 2013, 2014, 2017 Kevin Ryde

# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other 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.
#
# X11-Protocol-Other 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 X11-Protocol-Other.  If not, see .


package X11::Protocol::GrabServer;
BEGIN { require 5 }
use strict;
use Carp;
BEGIN {
  # weaken() if available, which means new enough Perl to have weakening,
  # and Scalar::Util with its XS code
  eval "use Scalar::Util 'weaken'; 1"
    or eval "\n#line ".(__LINE__+1)." \"".__FILE__."\"\n" . <<'HERE' or die;
sub weaken {} # otherwise noop
HERE
}

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

use vars '$VERSION';
$VERSION = 31;

sub new {
  my ($class, $X) = @_;
  ### GrabServer-object new(): "$X"
  if (! defined $X) {
    croak "No X connection given";
  }
  my $self = bless { X => $X }, $class;
  weaken ($self->{'X'});
  $self->grab;
  return $self;
}
sub DESTROY {
  my ($self) = @_;
  ### GrabServer-object DESTROY()

  $self->ungrab;

  # ### initial error: $@
  # local $@;  # don't clobber if destroyed during a die() unwind
  # eval { $self->ungrab };  # ignore EPIPE write if server already closed
  # ### DESTROY error: $@
}

sub grab {
  my ($self) = @_;
  ### GrabServer-object grab()
  unless ($self->{'grabbed'}) {
    my $X = $self->{'X'} || return;
    $self->{'grabbed'} = 1;
    if (! $X->{__PACKAGE__.'.count'}++) {
      ### initial X->GrabServer
      $X->GrabServer;
    }
  }
  ### grab count now: $self->{'X'} && $self->{'X'}->{__PACKAGE__.'.count'}
}

sub ungrab {
  my ($self) = @_;
  ### GrabServer-object ungrab()
  if (delete $self->{'grabbed'}) {
    my $X = $self->{'X'} || return;
    if (--$X->{__PACKAGE__.'.count'} <= 0) {
      delete $X->{__PACKAGE__.'.count'}; # cleanup
      ### final X->UngrabServer
      $X->UngrabServer;
      $X->flush;
    }
  }
  ### grab count now: $self->{'X'} && $self->{'X'}->{__PACKAGE__.'.count'}
}

sub is_grabbed {
  my ($self) = @_;
  return $self->{'grabbed'};
}

# # not sure about this ...
# sub call_with_grab {
#   my $class = shift;
#   my $X = shift;
#   my $subr = shift;
#   my $grab = $class->new ($X);
#   &$subr (@_);
# }

1;
__END__