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 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->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 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.11
Committed:	Tue Apr 14 04:27:32 2009 UTC (15 years, 1 month ago) by root
Branch:	MAIN
CVS Tags:	rel-4_352
Changes since 1.10:	+3 -3 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.10	no warnings; # sigh
27
28	root	1.5	use Carp qw(croak);
29	root	1.2
30	root	1.1	use AnyEvent ();
31
32			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			unshift @AnyEvent::ISA, AnyEvent::Strict::
38			};
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.6	defined fileno $arg{fh}
49	root	1.1	or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
50	root	1.9	-f $arg{fh}
51			and croak "AnyEvent->io called with fh argument pointing to a file";
52	root	1.1	delete $arg{fh};
53
54			$arg{poll} =~ /^[rw]$/
55			or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
56			delete $arg{poll};
57
58			croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
59			if keys %arg;
60
61			$class->SUPER::io (@_)
62			}
63
64			sub timer {
65			my $class = shift;
66			my %arg = @_;
67
68			ref $arg{cb}
69			or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
70			delete $arg{cb};
71
72			exists $arg{after}
73			or croak "AnyEvent->timer called without mandatory 'after' parameter";
74			delete $arg{after};
75
76			!$arg{interval} or $arg{interval} > 0
77			or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
78			delete $arg{interval};
79
80			croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
81			if keys %arg;
82
83			$class->SUPER::timer (@_)
84			}
85
86			sub signal {
87			my $class = shift;
88			my %arg = @_;
89
90			ref $arg{cb}
91			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
92			delete $arg{cb};
93
94	root	1.4	eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
95	root	1.1	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
96			delete $arg{signal};
97
98			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
99			if keys %arg;
100
101			$class->SUPER::signal (@_)
102			}
103
104			sub child {
105			my $class = shift;
106			my %arg = @_;
107
108			ref $arg{cb}
109	root	1.11	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
110	root	1.1	delete $arg{cb};
111
112			$arg{pid} =~ /^-?\d+$/
113	root	1.11	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
114	root	1.1	delete $arg{pid};
115
116	root	1.11	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
117	root	1.1	if keys %arg;
118
119			$class->SUPER::child (@_)
120			}
121
122			sub condvar {
123			my $class = shift;
124			my %arg = @_;
125
126			!exists $arg{cb} or ref $arg{cb}
127			or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
128			delete $arg{cb};
129
130			croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
131			if keys %arg;
132
133			$class->SUPER::condvar (@_)
134			}
135
136			sub time {
137			my $class = shift;
138
139			@_
140			and croak "AnyEvent->time wrongly called with paramaters";
141
142			$class->SUPER::time (@_)
143			}
144
145			sub now {
146			my $class = shift;
147
148			@_
149			and croak "AnyEvent->now wrongly called with paramaters";
150
151			$class->SUPER::now (@_)
152			}
153
154	root	1.5	1;
155
156			=head1 AUTHOR
157
158			Marc Lehmann <schmorp@schmorp.de>
159			http://home.schmorp.de/
160
161			=cut
162