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 }

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