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