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 (); 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.21
Committed:	Tue Aug 31 23:32:40 2010 UTC (13 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-5_28
Changes since 1.20:	+4 -4 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	use Carp qw(croak);
27
28	use AnyEvent (); BEGIN { AnyEvent::common_sense }
29
30	our @ISA;
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	$arg{poll} =~ /^[rw]$/
49	or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
50
51	if ($arg{fh} =~ /^\s\d+\s$/) {
52	$arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
53	} else {
54	defined eval { fileno $arg{fh} }
55	or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
56	}
57
58	-f $arg{fh}
59	and croak "AnyEvent->io called with fh argument pointing to a file";
60
61	delete $arg{poll};
62	delete $arg{fh};
63
64	croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
65	if keys %arg;
66
67	$class->SUPER::io (@_)
68	}
69
70	sub timer {
71	my $class = shift;
72	my %arg = @_;
73
74	ref $arg{cb}
75	or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
76	delete $arg{cb};
77
78	exists $arg{after}
79	or croak "AnyEvent->timer called without mandatory 'after' parameter";
80	delete $arg{after};
81
82	!$arg{interval} or $arg{interval} > 0
83	or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
84	delete $arg{interval};
85
86	croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
87	if keys %arg;
88
89	$class->SUPER::timer (@_)
90	}
91
92	sub signal {
93	my $class = shift;
94	my %arg = @_;
95
96	ref $arg{cb}
97	or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
98	delete $arg{cb};
99
100	defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
101	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
102	delete $arg{signal};
103
104	croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
105	if keys %arg;
106
107	$class->SUPER::signal (@_)
108	}
109
110	sub child {
111	my $class = shift;
112	my %arg = @_;
113
114	ref $arg{cb}
115	or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
116	delete $arg{cb};
117
118	$arg{pid} =~ /^-?\d+$/
119	or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
120	delete $arg{pid};
121
122	croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
123	if keys %arg;
124
125	$class->SUPER::child (@_)
126	}
127
128	sub idle {
129	my $class = shift;
130	my %arg = @_;
131
132	ref $arg{cb}
133	or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
134	delete $arg{cb};
135
136	croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
137	if keys %arg;
138
139	$class->SUPER::idle (@_)
140	}
141
142	sub condvar {
143	my $class = shift;
144	my %arg = @_;
145
146	!exists $arg{cb} or ref $arg{cb}
147	or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
148	delete $arg{cb};
149
150	croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
151	if keys %arg;
152
153	$class->SUPER::condvar (@_)
154	}
155
156	sub time {
157	my $class = shift;
158
159	@_
160	and croak "AnyEvent->time wrongly called with paramaters";
161
162	$class->SUPER::time (@_)
163	}
164
165	sub now {
166	my $class = shift;
167
168	@_
169	and croak "AnyEvent->now wrongly called with paramaters";
170
171	$class->SUPER::now (@_)
172	}
173
174	1;
175
176	=head1 AUTHOR
177
178	Marc Lehmann <schmorp@schmorp.de>
179	http://home.schmorp.de/
180
181	=cut
182