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).

B<< Currently, only AnyEvent I<methods> are checked, the AE:: I<functions> are not
affected. >>

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 manually at any time.

=cut

package AnyEvent::Strict;

use Carp qw(croak);

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 ($arg{fh} =~ /^\s*\d+\s*$/) {
      $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
   } else {
      defined eval { 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{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} and $arg{signal} == 0
      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.24
Committed:	Sun Nov 14 02:26:52 2010 UTC (13 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-5_29, rel-5_3, rel-5_31
Changes since 1.23:	+1 -1 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	B<< Currently, only AnyEvent I<methods> are checked, the AE:: I<functions> are not
19	affected. >>
20
21	Normally, you don't load this module yourself but instead use it
22	indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
23	L<AnyEvent>). However, this module can be loaded manually at any time.
24
25	=cut
26
27	package AnyEvent::Strict;
28
29	use Carp qw(croak);
30
31	use AnyEvent (); BEGIN { AnyEvent::common_sense }
32
33	our @ISA;
34
35	AnyEvent::post_detect {
36	# assume the first ISA member is the implementation
37	# # and link us in before it in the chain.
38	my $MODEL = shift @AnyEvent::ISA;
39	unshift @ISA, $MODEL;
40	unshift @AnyEvent::ISA, AnyEvent::Strict::;
41	};
42
43	sub io {
44	my $class = shift;
45	my %arg = @_;
46
47	ref $arg{cb}
48	or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
49	delete $arg{cb};
50
51	$arg{poll} =~ /^[rw]$/
52	or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
53
54	if ($arg{fh} =~ /^\s\d+\s$/) {
55	$arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
56	} else {
57	defined eval { fileno $arg{fh} }
58	or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
59	}
60
61	-f $arg{fh}
62	and croak "AnyEvent->io called with fh argument pointing to a file";
63
64	delete $arg{poll};
65	delete $arg{fh};
66
67	croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
68	if keys %arg;
69
70	$class->SUPER::io (@_)
71	}
72
73	sub timer {
74	my $class = shift;
75	my %arg = @_;
76
77	ref $arg{cb}
78	or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
79	delete $arg{cb};
80
81	exists $arg{after}
82	or croak "AnyEvent->timer called without mandatory 'after' parameter";
83	delete $arg{after};
84
85	!$arg{interval} or $arg{interval} > 0
86	or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
87	delete $arg{interval};
88
89	croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
90	if keys %arg;
91
92	$class->SUPER::timer (@_)
93	}
94
95	sub signal {
96	my $class = shift;
97	my %arg = @_;
98
99	ref $arg{cb}
100	or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
101	delete $arg{cb};
102
103	defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
104	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
105	delete $arg{signal};
106
107	croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
108	if keys %arg;
109
110	$class->SUPER::signal (@_)
111	}
112
113	sub child {
114	my $class = shift;
115	my %arg = @_;
116
117	ref $arg{cb}
118	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
119	delete $arg{cb};
120
121	$arg{pid} =~ /^-?\d+$/
122	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
123	delete $arg{pid};
124
125	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
126	if keys %arg;
127
128	$class->SUPER::child (@_)
129	}
130
131	sub idle {
132	my $class = shift;
133	my %arg = @_;
134
135	ref $arg{cb}
136	or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
137	delete $arg{cb};
138
139	croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
140	if keys %arg;
141
142	$class->SUPER::idle (@_)
143	}
144
145	sub condvar {
146	my $class = shift;
147	my %arg = @_;
148
149	!exists $arg{cb} or ref $arg{cb}
150	or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
151	delete $arg{cb};
152
153	croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
154	if keys %arg;
155
156	$class->SUPER::condvar (@_)
157	}
158
159	sub time {
160	my $class = shift;
161
162	@_
163	and croak "AnyEvent->time wrongly called with paramaters";
164
165	$class->SUPER::time (@_)
166	}
167
168	sub now {
169	my $class = shift;
170
171	@_
172	and croak "AnyEvent->now wrongly called with paramaters";
173
174	$class->SUPER::now (@_)
175	}
176
177	1;
178
179	=head1 AUTHOR
180
181	Marc Lehmann <schmorp@schmorp.de>
182	http://home.schmorp.de/
183
184	=cut
185