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 Fcntl ();

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

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