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 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.12
Committed:	Thu Apr 23 22:44:30 2009 UTC (15 years, 2 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_4, rel-4_45, rel-4_41, rel-4_42, rel-4_412, rel-4_411, rel-4_8
Changes since 1.11:	+14 -0 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	AnyEvent::Strict - force strict mode on for the whole process
4
5	=head1 SYNOPSIS
6
7	use AnyEvent::Strict;
8	# strict mode now switched on
9
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	actual function).
17
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	package AnyEvent::Strict;
25
26	no warnings; # sigh
27
28	use Carp qw(croak);
29
30	use AnyEvent ();
31
32	AnyEvent::post_detect {
33	# assume the first ISA member is the implementation
34	# # and link us in before it in the chain.
35	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	defined fileno $arg{fh}
49	or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
50	-f $arg{fh}
51	and croak "AnyEvent->io called with fh argument pointing to a file";
52	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	eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
95	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	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
110	delete $arg{cb};
111
112	$arg{pid} =~ /^-?\d+$/
113	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
114	delete $arg{pid};
115
116	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
117	if keys %arg;
118
119	$class->SUPER::child (@_)
120	}
121
122	sub idle {
123	my $class = shift;
124	my %arg = @_;
125
126	ref $arg{cb}
127	or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
128	delete $arg{cb};
129
130	croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
131	if keys %arg;
132
133	$class->SUPER::idle (@_)
134	}
135
136	sub condvar {
137	my $class = shift;
138	my %arg = @_;
139
140	!exists $arg{cb} or ref $arg{cb}
141	or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
142	delete $arg{cb};
143
144	croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
145	if keys %arg;
146
147	$class->SUPER::condvar (@_)
148	}
149
150	sub time {
151	my $class = shift;
152
153	@_
154	and croak "AnyEvent->time wrongly called with paramaters";
155
156	$class->SUPER::time (@_)
157	}
158
159	sub now {
160	my $class = shift;
161
162	@_
163	and croak "AnyEvent->now wrongly called with paramaters";
164
165	$class->SUPER::now (@_)
166	}
167
168	1;
169
170	=head1 AUTHOR
171
172	Marc Lehmann <schmorp@schmorp.de>
173	http://home.schmorp.de/
174
175	=cut
176