File Coverage

blib/lib/Gtk2/Ex/KeySnooper.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011, 2012 Kevin Ryde
2              
3             # This file is part of Gtk2-Ex-WidgetBits.
4             #
5             # Gtk2-Ex-WidgetBits is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Gtk2-Ex-WidgetBits is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Gtk2-Ex-WidgetBits. If not, see .
17              
18             package Gtk2::Ex::KeySnooper;
19 1     1   767 use 5.008;
  1         3  
  1         37  
20 1     1   4 use strict;
  1         2  
  1         26  
21 1     1   4 use warnings;
  1         1  
  1         31  
22 1     1   540 use Gtk2;
  0            
  0            
23              
24             our $VERSION = 48;
25              
26             sub new {
27             my ($class, $func, $userdata) = @_;
28             my $self = bless {}, $class;
29             $self->install ($func, $userdata);
30             return $self;
31             }
32              
33             # not yet documented ...
34             sub install {
35             my ($self, $func, $userdata) = @_;
36             $self->remove;
37             if ($func) {
38             $self->{'id'} = Gtk2->key_snooper_install ($func, $userdata);
39             }
40             }
41              
42             sub DESTROY {
43             my ($self) = @_;
44             $self->remove;
45             }
46              
47             sub remove {
48             my ($self) = @_;
49             if (my $id = delete $self->{'id'}) {
50             Gtk2->key_snooper_remove ($id);
51             }
52             }
53              
54             1;
55             __END__