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 Carp qw(croak);

use AnyEvent (); BEGIN { AnyEvent::common_sense }

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