lib/AnyEvent/Strict.pm

=head1 NAME

AnyEvent::Strict - force strict mode on for the whole process

=head1 SYNOPSIS

   use AnyEvent::Strict;
   # struct 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 fucntion).

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}'";
   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.6
Committed:	Fri Nov 21 01:35:59 2008 UTC (15 years, 7 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_33, rel-4_331
Changes since 1.5:	+1 -1 lines
Log Message:	4.33
#	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			# struct 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 fucntion).
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	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			delete $arg{fh};
49
50			$arg{poll} =~ /^[rw]$/
51			or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
52			delete $arg{poll};
53
54			croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
55			if keys %arg;
56
57			$class->SUPER::io (@_)
58			}
59
60			sub timer {
61			my $class = shift;
62			my %arg = @_;
63
64			ref $arg{cb}
65			or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
66			delete $arg{cb};
67
68			exists $arg{after}
69			or croak "AnyEvent->timer called without mandatory 'after' parameter";
70			delete $arg{after};
71
72			!$arg{interval} or $arg{interval} > 0
73			or croak "AnyEvent->timer called with illegal interval argument '$arg{interval}'";
74			delete $arg{interval};
75
76			croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
77			if keys %arg;
78
79			$class->SUPER::timer (@_)
80			}
81
82			sub signal {
83			my $class = shift;
84			my %arg = @_;
85
86			ref $arg{cb}
87			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
88			delete $arg{cb};
89
90	root	1.4	eval "require POSIX; 0 < &POSIX::SIG$arg{signal}"
91	root	1.1	or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
92			delete $arg{signal};
93
94			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
95			if keys %arg;
96
97			$class->SUPER::signal (@_)
98			}
99
100			sub child {
101			my $class = shift;
102			my %arg = @_;
103
104			ref $arg{cb}
105			or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
106			delete $arg{cb};
107
108			$arg{pid} =~ /^-?\d+$/
109			or croak "AnyEvent->signal called with illegal pid value '$arg{pid}'";
110			delete $arg{pid};
111
112			croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
113			if keys %arg;
114
115			$class->SUPER::child (@_)
116			}
117
118			sub condvar {
119			my $class = shift;
120			my %arg = @_;
121
122			!exists $arg{cb} or ref $arg{cb}
123			or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
124			delete $arg{cb};
125
126			croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
127			if keys %arg;
128
129			$class->SUPER::condvar (@_)
130			}
131
132			sub time {
133			my $class = shift;
134
135			@_
136			and croak "AnyEvent->time wrongly called with paramaters";
137
138			$class->SUPER::time (@_)
139			}
140
141			sub now {
142			my $class = shift;
143
144			@_
145			and croak "AnyEvent->now wrongly called with paramaters";
146
147			$class->SUPER::now (@_)
148			}
149
150	root	1.5	1;
151
152			=head1 AUTHOR
153
154			Marc Lehmann <schmorp@schmorp.de>
155			http://home.schmorp.de/
156
157			=cut
158