lib/AnyEvent/Strict.pm

=head1 NAME

AnyEvent::Strict - force strict mode on for the whole process

=head1 SYNOPSIS

   use AnyEvent::Strict;
   # strict mode now switched on

=head1 DESCRIPTION

This module implements AnyEvent's strict mode.

Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
expense of being slower (often the argument checking takes longer than the
actual function).

Normally, you don't load this module yourself but instead use it
indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
L<AnyEvent>). However, this module can be loaded at any time.

=cut

package AnyEvent::Strict;

use common::sense;

use Carp qw(croak);
use Fcntl ();

use AnyEvent ();

our @ISA;

AnyEvent::post_detect {
   # assume the first ISA member is the implementation
   # # and link us in before it in the chain.
   my $MODEL = shift @AnyEvent::ISA;
   unshift @ISA, $MODEL;
   unshift @AnyEvent::ISA, AnyEvent::Strict::
};

sub io {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   $arg{poll} =~ /^[rw]$/
      or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";

   if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s*\d+\s*$/) {
      defined fileno $arg{fh}
         or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
   } else {
      $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
   }

   -f $arg{fh}
      and croak "AnyEvent->io called with fh argument pointing to a file";

   delete $arg{poll};
   delete $arg{fh};
 
   croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::io (@_)
}

sub timer {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   exists $arg{after}
      or croak "AnyEvent->timer called without mandatory 'after' parameter";
   delete $arg{after};
 
   !$arg{interval} or $arg{interval} > 0
      or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
   delete $arg{interval};
 
   croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::timer (@_)
}

sub signal {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
      or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
   delete $arg{signal};
 
   croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::signal (@_)
}

sub child {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   $arg{pid} =~ /^-?\d+$/
      or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
   delete $arg{pid};
 
   croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::child (@_)
}

sub idle {
   my $class = shift;
   my %arg = @_;

   ref $arg{cb}
      or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::idle (@_)
}

sub condvar {
   my $class = shift;
   my %arg = @_;

   !exists $arg{cb} or ref $arg{cb}
      or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::condvar (@_)
}

sub time {
   my $class = shift;

   @_
      and croak "AnyEvent->time wrongly called with paramaters";

   $class->SUPER::time (@_)
}

sub now {
   my $class = shift;

   @_
      and croak "AnyEvent->now wrongly called with paramaters";

   $class->SUPER::now (@_)
}

1;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.14
Committed:	Thu Jul 9 18:58:19 2009 UTC (14 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.13:	+1 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.5	=head1 NAME
2
3			AnyEvent::Strict - force strict mode on for the whole process
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::Strict;
8	root	1.8	# strict mode now switched on
9	root	1.5
10			=head1 DESCRIPTION
11
12			This module implements AnyEvent's strict mode.
13
14			Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
15			expense of being slower (often the argument checking takes longer than the
16	root	1.7	actual function).
17	root	1.5
18			Normally, you don't load this module yourself but instead use it
19			indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
20			L<AnyEvent>). However, this module can be loaded at any time.
21
22			=cut
23
24	root	1.1	package AnyEvent::Strict;
25
26	root	1.14	use common::sense;
27	root	1.10
28	root	1.5	use Carp qw(croak);
29	root	1.13	use Fcntl ();
30	root	1.2
31	root	1.1	use AnyEvent ();
32
33	root	1.13	our @ISA;
34
35	root	1.1	AnyEvent::post_detect {
36	root	1.3	# assume the first ISA member is the implementation
37			# # and link us in before it in the chain.
38	root	1.1	my $MODEL = shift @AnyEvent::ISA;
39			unshift @ISA, $MODEL;
40			unshift @AnyEvent::ISA, AnyEvent::Strict::
41			};
42
43			sub io {
44			my $class = shift;
45			my %arg = @_;
46
47			ref $arg{cb}
48			or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
49			delete $arg{cb};
50
51	root	1.13	$arg{poll} =~ /^[rw]$/
52			or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
53
54			if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s\d+\s$/) {
55			defined fileno $arg{fh}
56			or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
57			} else {
58			$arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
59			}
60
61	root	1.9	-f $arg{fh}
62			and croak "AnyEvent->io called with fh argument pointing to a file";
63	root	1.13
64			delete $arg{poll};
65	root	1.1	delete $arg{fh};
66
67			croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
68			if keys %arg;
69
70			$class->SUPER::io (@_)
71			}
72
73			sub timer {
74			my $class = shift;
75			my %arg = @_;
76
77			ref $arg{cb}
78			or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
79			delete $arg{cb};
80
81			exists $arg{after}
82			or croak "AnyEvent->timer called without mandatory 'after' parameter";
83			delete $arg{after};
84
85			!$arg{interval} or $arg{interval} > 0
86			or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
87			delete $arg{interval};
88
89			croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
90			if keys %arg;
91
92			$class->SUPER::timer (@_)
93			}
94
95			sub signal {
96			my $class = shift;
97			my %arg = @_;
98
99			ref $arg{cb}
100			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
101			delete $arg{cb};
102
103	root	1.4	eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
104	root	1.1	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
105			delete $arg{signal};
106
107			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
108			if keys %arg;
109
110			$class->SUPER::signal (@_)
111			}
112
113			sub child {
114			my $class = shift;
115			my %arg = @_;
116
117			ref $arg{cb}
118	root	1.11	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
119	root	1.1	delete $arg{cb};
120
121			$arg{pid} =~ /^-?\d+$/
122	root	1.11	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
123	root	1.1	delete $arg{pid};
124
125	root	1.11	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
126	root	1.1	if keys %arg;
127
128			$class->SUPER::child (@_)
129			}
130
131	root	1.12	sub idle {
132			my $class = shift;
133			my %arg = @_;
134
135			ref $arg{cb}
136			or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
137			delete $arg{cb};
138
139			croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
140			if keys %arg;
141
142			$class->SUPER::idle (@_)
143			}
144
145	root	1.1	sub condvar {
146			my $class = shift;
147			my %arg = @_;
148
149			!exists $arg{cb} or ref $arg{cb}
150			or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
151			delete $arg{cb};
152
153			croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
154			if keys %arg;
155
156			$class->SUPER::condvar (@_)
157			}
158
159			sub time {
160			my $class = shift;
161
162			@_
163			and croak "AnyEvent->time wrongly called with paramaters";
164
165			$class->SUPER::time (@_)
166			}
167
168			sub now {
169			my $class = shift;
170
171			@_
172			and croak "AnyEvent->now wrongly called with paramaters";
173
174			$class->SUPER::now (@_)
175			}
176
177	root	1.5	1;
178
179			=head1 AUTHOR
180
181			Marc Lehmann <schmorp@schmorp.de>
182			http://home.schmorp.de/
183
184			=cut
185