File Coverage

lib/POSIX/1003/Events.pm
Criterion Covered Total %
statement 14 30 46.6
branch 0 6 0.0
condition 0 2 0.0
subroutine 5 15 33.3
pod 7 7 100.0
total 26 60 43.3


line stmt bran cond sub pod time code
1             # Copyrights 2011-2015 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 1     1   4 use warnings;
  1         2  
  1         23  
6 1     1   3 use strict;
  1         1  
  1         26  
7              
8             package POSIX::1003::Events;
9 1     1   3 use vars '$VERSION';
  1         1  
  1         34  
10             $VERSION = '0.99_06';
11              
12 1     1   3 use base 'POSIX::1003::Module';
  1         1  
  1         105  
13              
14             my @constants;
15             my @functions = qw/
16             FD_CLR FD_ISSET FD_SET FD_ZERO select
17             poll poll_names
18             /;
19              
20             my @poll = qw(poll poll_names);
21              
22             our %EXPORT_TAGS =
23             ( constants => \@constants
24             , functions => \@functions
25             );
26              
27             my $poll;
28              
29             BEGIN {
30 1     1   10 $poll = poll_table;
31 1         313 push @constants, keys %$poll;
32             }
33              
34              
35             sub select($$$;$)
36 0 0   0 1   { push @_, undef if @_==3;
37 0           goto &select;
38             }
39              
40              
41 0     0 1   sub FD_CLR($$) {vec($_[1],$_[0],1) = 0}
42 0     0 1   sub FD_ISSET($$) {vec($_[1],$_[0],1) ==1}
43 0     0 1   sub FD_SET($$) {vec($_[1],$_[0],1) = 1}
44 0     0 1   sub FD_ZERO($) {$_[0] = 0}
45              
46              
47             sub poll($;$)
48 0     0 1   { my ($data, $timeout) = @_;
49 0 0         defined $timeout or $timeout = -1;
50 0           _poll($data, $timeout);
51             }
52              
53             #----------------------
54              
55 0     0 1   sub poll_names() { keys %$poll }
56              
57             sub _create_constant($)
58 0     0     { my ($class, $name) = @_;
59 0 0         $name =~ m/^POLL/
60             or die "constants expected to start with POLL, not $name\n";
61 0   0 0     my $val = $poll->{$name} // return sub() {undef};
  0            
62 0     0     sub() {$val};
  0            
63              
64             }
65             #----------------------
66              
67             1;