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;

no warnings; # *sigh*
use strict qw(vars subs);

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.13
Committed:	Wed Jul 8 02:01:12 2009 UTC (14 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_81
Changes since 1.12:	+16 -6 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.10	no warnings; # sigh
27	root	1.13	use strict qw(vars subs);
28	root	1.10
29	root	1.5	use Carp qw(croak);
30	root	1.13	use Fcntl ();
31	root	1.2
32	root	1.1	use AnyEvent ();
33
34	root	1.13	our @ISA;
35
36	root	1.1	AnyEvent::post_detect {
37	root	1.3	# assume the first ISA member is the implementation
38			# # and link us in before it in the chain.
39	root	1.1	my $MODEL = shift @AnyEvent::ISA;
40			unshift @ISA, $MODEL;
41			unshift @AnyEvent::ISA, AnyEvent::Strict::
42			};
43
44			sub io {
45			my $class = shift;
46			my %arg = @_;
47
48			ref $arg{cb}
49			or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
50			delete $arg{cb};
51
52	root	1.13	$arg{poll} =~ /^[rw]$/
53			or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
54
55			if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s\d+\s$/) {
56			defined fileno $arg{fh}
57			or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
58			} else {
59			$arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
60			}
61
62	root	1.9	-f $arg{fh}
63			and croak "AnyEvent->io called with fh argument pointing to a file";
64	root	1.13
65			delete $arg{poll};
66	root	1.1	delete $arg{fh};
67
68			croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
69			if keys %arg;
70
71			$class->SUPER::io (@_)
72			}
73
74			sub timer {
75			my $class = shift;
76			my %arg = @_;
77
78			ref $arg{cb}
79			or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
80			delete $arg{cb};
81
82			exists $arg{after}
83			or croak "AnyEvent->timer called without mandatory 'after' parameter";
84			delete $arg{after};
85
86			!$arg{interval} or $arg{interval} > 0
87			or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
88			delete $arg{interval};
89
90			croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
91			if keys %arg;
92
93			$class->SUPER::timer (@_)
94			}
95
96			sub signal {
97			my $class = shift;
98			my %arg = @_;
99
100			ref $arg{cb}
101			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
102			delete $arg{cb};
103
104	root	1.4	eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
105	root	1.1	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
106			delete $arg{signal};
107
108			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
109			if keys %arg;
110
111			$class->SUPER::signal (@_)
112			}
113
114			sub child {
115			my $class = shift;
116			my %arg = @_;
117
118			ref $arg{cb}
119	root	1.11	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
120	root	1.1	delete $arg{cb};
121
122			$arg{pid} =~ /^-?\d+$/
123	root	1.11	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
124	root	1.1	delete $arg{pid};
125
126	root	1.11	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
127	root	1.1	if keys %arg;
128
129			$class->SUPER::child (@_)
130			}
131
132	root	1.12	sub idle {
133			my $class = shift;
134			my %arg = @_;
135
136			ref $arg{cb}
137			or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
138			delete $arg{cb};
139
140			croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
141			if keys %arg;
142
143			$class->SUPER::idle (@_)
144			}
145
146	root	1.1	sub condvar {
147			my $class = shift;
148			my %arg = @_;
149
150			!exists $arg{cb} or ref $arg{cb}
151			or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
152			delete $arg{cb};
153
154			croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
155			if keys %arg;
156
157			$class->SUPER::condvar (@_)
158			}
159
160			sub time {
161			my $class = shift;
162
163			@_
164			and croak "AnyEvent->time wrongly called with paramaters";
165
166			$class->SUPER::time (@_)
167			}
168
169			sub now {
170			my $class = shift;
171
172			@_
173			and croak "AnyEvent->now wrongly called with paramaters";
174
175			$class->SUPER::now (@_)
176			}
177
178	root	1.5	1;
179
180			=head1 AUTHOR
181
182			Marc Lehmann <schmorp@schmorp.de>
183			http://home.schmorp.de/
184
185			=cut
186