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

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};
 
   defined 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{fh};
 
   $arg{poll} =~ /^[rw]$/
      or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
   delete $arg{poll};
 
   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->signal called with illegal cb argument '$arg{cb}'";
   delete $arg{cb};
 
   $arg{pid} =~ /^-?\d+$/
      or croak "AnyEvent->signal called with illegal pid value '$arg{pid}'";
   delete $arg{pid};
 
   croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
      if keys %arg;

   $class->SUPER::child (@_)
}

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.9
Committed:	Fri Mar 27 10:49:50 2009 UTC (15 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_35
Changes since 1.8:	+2 -0 lines
Log Message:	4.35
#	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.1	use AnyEvent ();
29
30			AnyEvent::post_detect {
31	root	1.3	# assume the first ISA member is the implementation
32			# # and link us in before it in the chain.
33	root	1.1	my $MODEL = shift @AnyEvent::ISA;
34			unshift @ISA, $MODEL;
35			unshift @AnyEvent::ISA, AnyEvent::Strict::
36			};
37
38			sub io {
39			my $class = shift;
40			my %arg = @_;
41
42			ref $arg{cb}
43			or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
44			delete $arg{cb};
45
46	root	1.6	defined fileno $arg{fh}
47	root	1.1	or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
48	root	1.9	-f $arg{fh}
49			and croak "AnyEvent->io called with fh argument pointing to a file";
50	root	1.1	delete $arg{fh};
51
52			$arg{poll} =~ /^[rw]$/
53			or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
54			delete $arg{poll};
55
56			croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
57			if keys %arg;
58
59			$class->SUPER::io (@_)
60			}
61
62			sub timer {
63			my $class = shift;
64			my %arg = @_;
65
66			ref $arg{cb}
67			or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
68			delete $arg{cb};
69
70			exists $arg{after}
71			or croak "AnyEvent->timer called without mandatory 'after' parameter";
72			delete $arg{after};
73
74			!$arg{interval} or $arg{interval} > 0
75			or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
76			delete $arg{interval};
77
78			croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
79			if keys %arg;
80
81			$class->SUPER::timer (@_)
82			}
83
84			sub signal {
85			my $class = shift;
86			my %arg = @_;
87
88			ref $arg{cb}
89			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
90			delete $arg{cb};
91
92	root	1.4	eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
93	root	1.1	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
94			delete $arg{signal};
95
96			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
97			if keys %arg;
98
99			$class->SUPER::signal (@_)
100			}
101
102			sub child {
103			my $class = shift;
104			my %arg = @_;
105
106			ref $arg{cb}
107			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
108			delete $arg{cb};
109
110			$arg{pid} =~ /^-?\d+$/
111			or croak "AnyEvent->signal called with illegal pid value '$arg{pid}'";
112			delete $arg{pid};
113
114			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
115			if keys %arg;
116
117			$class->SUPER::child (@_)
118			}
119
120			sub condvar {
121			my $class = shift;
122			my %arg = @_;
123
124			!exists $arg{cb} or ref $arg{cb}
125			or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
126			delete $arg{cb};
127
128			croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
129			if keys %arg;
130
131			$class->SUPER::condvar (@_)
132			}
133
134			sub time {
135			my $class = shift;
136
137			@_
138			and croak "AnyEvent->time wrongly called with paramaters";
139
140			$class->SUPER::time (@_)
141			}
142
143			sub now {
144			my $class = shift;
145
146			@_
147			and croak "AnyEvent->now wrongly called with paramaters";
148
149			$class->SUPER::now (@_)
150			}
151
152	root	1.5	1;
153
154			=head1 AUTHOR
155
156			Marc Lehmann <schmorp@schmorp.de>
157			http://home.schmorp.de/
158
159			=cut
160