Profile of Params/Util.pm

Filename	/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/darwin-2level/Params/Util.pm
Statements	Executed 48 statements in 1.31ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
237723	16	6	545ms	629ms	Params::Util::::_INSTANCEParams::Util::_INSTANCE (xsub)
2087	1	1	6.60ms	6.60ms	Params::Util::::CORE:matchParams::Util::CORE:match (opcode)
4840	4	3	3.48ms	3.48ms	Params::Util::::_CODELIKEParams::Util::_CODELIKE (xsub)
288	2	2	346µs	346µs	Params::Util::::_STRINGParams::Util::_STRING (xsub)
1	1	1	28µs	28µs	Params::Util::::bootstrapParams::Util::bootstrap (xsub)
1	1	1	14µs	14µs	Params::Util::::BEGIN@58Params::Util::BEGIN@58
3	1	1	7µs	7µs	Params::Util::::_HASHLIKEParams::Util::_HASHLIKE (xsub)
1	1	1	6µs	16µs	Params::Util::::BEGIN@59Params::Util::BEGIN@59
1	1	1	6µs	53µs	Params::Util::::BEGIN@65Params::Util::BEGIN@65
3	1	1	2µs	2µs	Params::Util::::_ARRAYLIKEParams::Util::_ARRAYLIKE (xsub)
2	1	1	2µs	2µs	Params::Util::::_SCALAR0Params::Util::_SCALAR0 (xsub)

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Params::Util;
2
3					=pod
4
5					=head1 NAME
6
7					Params::Util - Simple, compact and correct param-checking functions
8
9					=head1 SYNOPSIS
10
11					# Import some functions
12					use Params::Util qw{_SCALAR _HASH _INSTANCE};
13
14					# If you are lazy, or need a lot of them...
15					use Params::Util ':ALL';
16
17					sub foo {
18					my $object = _INSTANCE(shift, 'Foo') or return undef;
19					my $image = _SCALAR(shift) or return undef;
20					my $options = _HASH(shift) or return undef;
21					# etc...
22					}
23
24					=head1 DESCRIPTION
25
26					C<Params::Util> provides a basic set of importable functions that makes
27					checking parameters a hell of a lot easier
28
29					While they can be (and are) used in other contexts, the main point
30					behind this module is that the functions B<both> Do What You Mean,
31					and Do The Right Thing, so they are most useful when you are getting
32					params passed into your code from someone and/or somewhere else
33					and you can't really trust the quality.
34
35					Thus, C<Params::Util> is of most use at the edges of your API, where
36					params and data are coming in from outside your code.
37
38					The functions provided by C<Params::Util> check in the most strictly
39					correct manner known, are documented as thoroughly as possible so their
40					exact behaviour is clear, and heavily tested so make sure they are not
41					fooled by weird data and Really Bad Things.
42
43					To use, simply load the module providing the functions you want to use
44					as arguments (as shown in the SYNOPSIS).
45
46					To aid in maintainability, C<Params::Util> will B<never> export by
47					default.
48
49					You must explicitly name the functions you want to export, or use the
50					C<:ALL> param to just have it export everything (although this is not
51					recommended if you have any _FOO functions yourself with which future
52					additions to C<Params::Util> may clash)
53
54					=head1 FUNCTIONS
55
56					=cut
57
58	2	38µs	1	14µs	# spent 14µs within Params::Util::BEGIN@58 which was called: # once (14µs+0s) by PPI::Token::BEGIN@24 at line 58 use 5.00503; # spent 14µs making 1 call to Params::Util::BEGIN@58
59	2	28µs	2	27µs	# spent 16µs (6+10) within Params::Util::BEGIN@59 which was called: # once (6µs+10µs) by PPI::Token::BEGIN@24 at line 59 use strict; # spent 16µs making 1 call to Params::Util::BEGIN@59 # spent 10µs making 1 call to strict::import
60	1	500ns			require overload;
61	1	100ns			require Exporter;
62	1	100ns			require Scalar::Util;
63	1	300ns			require DynaLoader;
64
65	2	522µs	2	101µs	# spent 53µs (6+48) within Params::Util::BEGIN@65 which was called: # once (6µs+48µs) by PPI::Token::BEGIN@24 at line 65 use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS}; # spent 53µs making 1 call to Params::Util::BEGIN@65 # spent 48µs making 1 call to vars::import
66
67	1	500ns			$VERSION = '1.07';
68	1	7µs			@ISA = qw{
69					Exporter
70					DynaLoader
71					};
72	1	4µs			@EXPORT_OK = qw{
73					_STRING _IDENTIFIER
74					_CLASS _CLASSISA _SUBCLASS _DRIVER _CLASSDOES
75					_NUMBER _POSINT _NONNEGINT
76					_SCALAR _SCALAR0
77					_ARRAY _ARRAY0 _ARRAYLIKE
78					_HASH _HASH0 _HASHLIKE
79					_CODE _CODELIKE
80					_INVOCANT _REGEX _INSTANCE _INSTANCEDOES
81					_SET _SET0
82					_HANDLE
83					};
84	1	1µs			%EXPORT_TAGS = ( ALL => \@EXPORT_OK );
85
86	1	700ns			eval {
87	1	100ns			local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
88	1	6µs	1	298µs	bootstrap Params::Util $VERSION; # spent 298µs making 1 call to DynaLoader::bootstrap
89	1	400ns			1;
90					} unless $ENV{PERL_PARAMS_UTIL_PP};
91
92					# Use a private pure-perl copy of looks_like_number if the version of
93					# Scalar::Util is old (for whatever reason).
94	1	14µs			my $SU = eval "$Scalar::Util::VERSION" \|\| 0; # spent 2µs executing statements in string eval
95	1	2µs	1	22µs	if ( $SU >= 1.18 ) { # spent 22µs making 1 call to Exporter::import
96					Scalar::Util->import('looks_like_number');
97					} else {
98					eval <<'END_PERL';
99					sub looks_like_number {
100					local $_ = shift;
101
102					# checks from perlfaq4
103					return 0 if !defined($_);
104					if (ref($_)) {
105					return overload::Overloaded($_) ? defined(0 + $_) : 0;
106					}
107					return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
108					return 1 if (/^([+-]?)(?=[0-9]\|\.[0-9])[0-9](\.[0-9])?([Ee]([+-]?[0-9]+))?$/); # a C float
109					return 1 if ($] >= 5.008 and /^(Inf(inity)?\|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
110
111					0;
112					}
113					END_PERL
114					}
115
- -
120					#####################################################################
121					# Param Checking Functions
122
123					=pod
124
125					=head2 _STRING $string
126
127					The C<_STRING> function is intended to be imported into your
128					package, and provides a convenient way to test to see if a value is
129					a normal non-false string of non-zero length.
130
131					Note that this will NOT do anything magic to deal with the special
132					C<'0'> false negative case, but will return it.
133
134					# '0' not considered valid data
135					my $name = _STRING(shift) or die "Bad name";
136
137					# '0' is considered valid data
138					my $string = _STRING($_[0]) ? shift : die "Bad string";
139
140					Please also note that this function expects a normal string. It does
141					not support overloading or other magic techniques to get a string.
142
143					Returns the string as a conveince if it is a valid string, or
144					C<undef> if not.
145
146					=cut
147
148	1	200ns			eval <<'END_PERL' unless defined &_STRING;
149					sub _STRING ($) {
150					(defined $_[0] and ! ref $_[0] and length($_[0])) ? $_[0] : undef;
151					}
152					END_PERL
153
154					=pod
155
156					=head2 _IDENTIFIER $string
157
158					The C<_IDENTIFIER> function is intended to be imported into your
159					package, and provides a convenient way to test to see if a value is
160					a string that is a valid Perl identifier.
161
162					Returns the string as a convenience if it is a valid identifier, or
163					C<undef> if not.
164
165					=cut
166
167	1	57µs			eval <<'END_PERL' unless defined &_IDENTIFIER;
168					sub _IDENTIFIER ($) {
169					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*\z/s) ? $_[0] : undef;
170					}
171					END_PERL
172
173					=pod
174
175					=head2 _CLASS $string
176
177					The C<_CLASS> function is intended to be imported into your
178					package, and provides a convenient way to test to see if a value is
179					a string that is a valid Perl class.
180
181					This function only checks that the format is valid, not that the
182					class is actually loaded. It also assumes "normalised" form, and does
183					not accept class names such as C<::Foo> or C<D'Oh>.
184
185					Returns the string as a convenience if it is a valid class name, or
186					C<undef> if not.
187
188					=cut
189
190	1	51µs			eval <<'END_PERL' unless defined &_CLASS; # spent 18.1ms executing statements in string eval # includes 7.48ms spent executing 2087 calls to 1 sub defined therein.
191					sub _CLASS ($) {
192					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s) ? $_[0] : undef;
193					}
194					END_PERL
195
196					=pod
197
198					=head2 _CLASSISA $string, $class
199
200					The C<_CLASSISA> function is intended to be imported into your
201					package, and provides a convenient way to test to see if a value is
202					a string that is a particularly class, or a subclass of it.
203
204					This function checks that the format is valid and calls the -E<gt>isa
205					method on the class name. It does not check that the class is actually
206					loaded.
207
208					It also assumes "normalised" form, and does
209					not accept class names such as C<::Foo> or C<D'Oh>.
210
211					Returns the string as a convenience if it is a valid class name, or
212					C<undef> if not.
213
214					=cut
215
216	1	51µs			eval <<'END_PERL' unless defined &_CLASSISA;
217					sub _CLASSISA ($$) {
218					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s and $_[0]->isa($_[1])) ? $_[0] : undef;
219					}
220					END_PERL
221
222					=head2 _CLASSDOES $string, $role
223
224					This routine behaves exactly like C<L</_CLASSISA>>, but checks with C<< ->DOES
225					>> rather than C<< ->isa >>. This is probably only a good idea to use on Perl
226					5.10 or later, when L<UNIVERSAL::DOES\|UNIVERSAL::DOES/DOES> has been
227					implemented.
228
229					=cut
230
231	1	52µs			eval <<'END_PERL' unless defined &_CLASSDOES;
232					sub _CLASSDOES ($$) {
233					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s and $_[0]->DOES($_[1])) ? $_[0] : undef;
234					}
235					END_PERL
236
237					=pod
238
239					=head2 _SUBCLASS $string, $class
240
241					The C<_SUBCLASS> function is intended to be imported into your
242					package, and provides a convenient way to test to see if a value is
243					a string that is a subclass of a specified class.
244
245					This function checks that the format is valid and calls the -E<gt>isa
246					method on the class name. It does not check that the class is actually
247					loaded.
248
249					It also assumes "normalised" form, and does
250					not accept class names such as C<::Foo> or C<D'Oh>.
251
252					Returns the string as a convenience if it is a valid class name, or
253					C<undef> if not.
254
255					=cut
256
257	1	55µs			eval <<'END_PERL' unless defined &_SUBCLASS;
258					sub _SUBCLASS ($$) {
259					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s and $_[0] ne $_[1] and $_[0]->isa($_[1])) ? $_[0] : undef;
260					}
261					END_PERL
262
263					=pod
264
265					=head2 _NUMBER $scalar
266
267					The C<_NUMBER> function is intended to be imported into your
268					package, and provides a convenient way to test to see if a value is
269					a number. That is, it is defined and perl thinks it's a number.
270
271					This function is basically a Params::Util-style wrapper around the
272					L<Scalar::Util> C<looks_like_number> function.
273
274					Returns the value as a convience, or C<undef> if the value is not a
275					number.
276
277					=cut
278
279	1	300ns			eval <<'END_PERL' unless defined &_NUMBER;
280					sub _NUMBER ($) {
281					( defined $_[0] and ! ref $_[0] and looks_like_number($_[0]) )
282					? $_[0]
283					: undef;
284					}
285					END_PERL
286
287					=pod
288
289					=head2 _POSINT $integer
290
291					The C<_POSINT> function is intended to be imported into your
292					package, and provides a convenient way to test to see if a value is
293					a positive integer (of any length).
294
295					Returns the value as a convience, or C<undef> if the value is not a
296					positive integer.
297
298					The name itself is derived from the XML schema constraint of the same
299					name.
300
301					=cut
302
303	1	44µs			eval <<'END_PERL' unless defined &_POSINT;
304					sub _POSINT ($) {
305					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[1-9]\d*$/) ? $_[0] : undef;
306					}
307					END_PERL
308
309					=pod
310
311					=head2 _NONNEGINT $integer
312
313					The C<_NONNEGINT> function is intended to be imported into your
314					package, and provides a convenient way to test to see if a value is
315					a non-negative integer (of any length). That is, a positive integer,
316					or zero.
317
318					Returns the value as a convience, or C<undef> if the value is not a
319					non-negative integer.
320
321					As with other tests that may return false values, care should be taken
322					to test via "defined" in boolean validy contexts.
323
324					unless ( defined _NONNEGINT($value) ) {
325					die "Invalid value";
326					}
327
328					The name itself is derived from the XML schema constraint of the same
329					name.
330
331					=cut
332
333	1	45µs			eval <<'END_PERL' unless defined &_NONNEGINT;
334					sub _NONNEGINT ($) {
335					(defined $_[0] and ! ref $_[0] and $_[0] =~ m/^(?:0\|[1-9]\d*)$/) ? $_[0] : undef;
336					}
337					END_PERL
338
339					=pod
340
341					=head2 _SCALAR \$scalar
342
343					The C<_SCALAR> function is intended to be imported into your package,
344					and provides a convenient way to test for a raw and unblessed
345					C<SCALAR> reference, with content of non-zero length.
346
347					For a version that allows zero length C<SCALAR> references, see
348					the C<_SCALAR0> function.
349
350					Returns the C<SCALAR> reference itself as a convenience, or C<undef>
351					if the value provided is not a C<SCALAR> reference.
352
353					=cut
354
355	1	300ns			eval <<'END_PERL' unless defined &_SCALAR;
356					sub _SCALAR ($) {
357					(ref $_[0] eq 'SCALAR' and defined ${$_[0]} and ${$_[0]} ne '') ? $_[0] : undef;
358					}
359					END_PERL
360
361					=pod
362
363					=head2 _SCALAR0 \$scalar
364
365					The C<_SCALAR0> function is intended to be imported into your package,
366					and provides a convenient way to test for a raw and unblessed
367					C<SCALAR0> reference, allowing content of zero-length.
368
369					For a simpler "give me some content" version that requires non-zero
370					length, C<_SCALAR> function.
371
372					Returns the C<SCALAR> reference itself as a convenience, or C<undef>
373					if the value provided is not a C<SCALAR> reference.
374
375					=cut
376
377	1	100ns			eval <<'END_PERL' unless defined &_SCALAR0;
378					sub _SCALAR0 ($) {
379					ref $_[0] eq 'SCALAR' ? $_[0] : undef;
380					}
381					END_PERL
382
383					=pod
384
385					=head2 _ARRAY $value
386
387					The C<_ARRAY> function is intended to be imported into your package,
388					and provides a convenient way to test for a raw and unblessed
389					C<ARRAY> reference containing B<at least> one element of any kind.
390
391					For a more basic form that allows zero length ARRAY references, see
392					the C<_ARRAY0> function.
393
394					Returns the C<ARRAY> reference itself as a convenience, or C<undef>
395					if the value provided is not an C<ARRAY> reference.
396
397					=cut
398
399	1	100ns			eval <<'END_PERL' unless defined &_ARRAY;
400					sub _ARRAY ($) {
401					(ref $_[0] eq 'ARRAY' and @{$_[0]}) ? $_[0] : undef;
402					}
403					END_PERL
404
405					=pod
406
407					=head2 _ARRAY0 $value
408
409					The C<_ARRAY0> function is intended to be imported into your package,
410					and provides a convenient way to test for a raw and unblessed
411					C<ARRAY> reference, allowing C<ARRAY> references that contain no
412					elements.
413
414					For a more basic "An array of something" form that also requires at
415					least one element, see the C<_ARRAY> function.
416
417					Returns the C<ARRAY> reference itself as a convenience, or C<undef>
418					if the value provided is not an C<ARRAY> reference.
419
420					=cut
421
422	1	100ns			eval <<'END_PERL' unless defined &_ARRAY0;
423					sub _ARRAY0 ($) {
424					ref $_[0] eq 'ARRAY' ? $_[0] : undef;
425					}
426					END_PERL
427
428					=pod
429
430					=head2 _ARRAYLIKE $value
431
432					The C<_ARRAYLIKE> function tests whether a given scalar value can respond to
433					array dereferencing. If it can, the value is returned. If it cannot,
434					C<_ARRAYLIKE> returns C<undef>.
435
436					=cut
437
438	1	0s			eval <<'END_PERL' unless defined &_ARRAYLIKE;
439					sub _ARRAYLIKE {
440					(defined $_[0] and ref $_[0] and (
441					(Scalar::Util::reftype($_[0]) eq 'ARRAY')
442					or
443					overload::Method($_[0], '@{}')
444					)) ? $_[0] : undef;
445					}
446					END_PERL
447
448					=pod
449
450					=head2 _HASH $value
451
452					The C<_HASH> function is intended to be imported into your package,
453					and provides a convenient way to test for a raw and unblessed
454					C<HASH> reference with at least one entry.
455
456					For a version of this function that allows the C<HASH> to be empty,
457					see the C<_HASH0> function.
458
459					Returns the C<HASH> reference itself as a convenience, or C<undef>
460					if the value provided is not an C<HASH> reference.
461
462					=cut
463
464	1	0s			eval <<'END_PERL' unless defined &_HASH;
465					sub _HASH ($) {
466					(ref $_[0] eq 'HASH' and scalar %{$_[0]}) ? $_[0] : undef;
467					}
468					END_PERL
469
470					=pod
471
472					=head2 _HASH0 $value
473
474					The C<_HASH0> function is intended to be imported into your package,
475					and provides a convenient way to test for a raw and unblessed
476					C<HASH> reference, regardless of the C<HASH> content.
477
478					For a simpler "A hash of something" version that requires at least one
479					element, see the C<_HASH> function.
480
481					Returns the C<HASH> reference itself as a convenience, or C<undef>
482					if the value provided is not an C<HASH> reference.
483
484					=cut
485
486	1	100ns			eval <<'END_PERL' unless defined &_HASH0;
487					sub _HASH0 ($) {
488					ref $_[0] eq 'HASH' ? $_[0] : undef;
489					}
490					END_PERL
491
492					=pod
493
494					=head2 _HASHLIKE $value
495
496					The C<_HASHLIKE> function tests whether a given scalar value can respond to
497					hash dereferencing. If it can, the value is returned. If it cannot,
498					C<_HASHLIKE> returns C<undef>.
499
500					=cut
501
502	1	100ns			eval <<'END_PERL' unless defined &_HASHLIKE;
503					sub _HASHLIKE {
504					(defined $_[0] and ref $_[0] and (
505					(Scalar::Util::reftype($_[0]) eq 'HASH')
506					or
507					overload::Method($_[0], '%{}')
508					)) ? $_[0] : undef;
509					}
510					END_PERL
511
512					=pod
513
514					=head2 _CODE $value
515
516					The C<_CODE> function is intended to be imported into your package,
517					and provides a convenient way to test for a raw and unblessed
518					C<CODE> reference.
519
520					Returns the C<CODE> reference itself as a convenience, or C<undef>
521					if the value provided is not an C<CODE> reference.
522
523					=cut
524
525	1	100ns			eval <<'END_PERL' unless defined &_CODE;
526					sub _CODE ($) {
527					ref $_[0] eq 'CODE' ? $_[0] : undef;
528					}
529					END_PERL
530
531					=pod
532
533					=head2 _CODELIKE $value
534
535					The C<_CODELIKE> is the more generic version of C<_CODE>. Unlike C<_CODE>,
536					which checks for an explicit C<CODE> reference, the C<_CODELIKE> function
537					also includes things that act like them, such as blessed objects that
538					overload C<'&{}'>.
539
540					Please note that in the case of objects overloaded with '&{}', you will
541					almost always end up also testing it in 'bool' context at some stage.
542
543					For example:
544
545					sub foo {
546					my $code1 = _CODELIKE(shift) or die "No code param provided";
547					my $code2 = _CODELIKE(shift);
548					if ( $code2 ) {
549					print "Got optional second code param";
550					}
551					}
552
553					As such, you will most likely always want to make sure your class has
554					at least the following to allow it to evaluate to true in boolean
555					context.
556
557					# Always evaluate to true in boolean context
558					use overload 'bool' => sub () { 1 };
559
560					Returns the callable value as a convenience, or C<undef> if the
561					value provided is not callable.
562
563					Note - This function was formerly known as _CALLABLE but has been renamed
564					for greater symmetry with the other _XXXXLIKE functions.
565
566					The use of _CALLABLE has been deprecated. It will continue to work, but
567					with a warning, until end-2006, then will be removed.
568
569					I apologise for any inconvenience caused.
570
571					=cut
572
573	1	100ns			eval <<'END_PERL' unless defined &_CODELIKE;
574					sub _CODELIKE($) {
575					(
576					(Scalar::Util::reftype($_[0])\|\|'') eq 'CODE'
577					or
578					Scalar::Util::blessed($_[0]) and overload::Method($_[0],'&{}')
579					)
580					? $_[0] : undef;
581					}
582					END_PERL
583
584					=pod
585
586					=head2 _INVOCANT $value
587
588					This routine tests whether the given value is a valid method invocant.
589					This can be either an instance of an object, or a class name.
590
591					If so, the value itself is returned. Otherwise, C<_INVOCANT>
592					returns C<undef>.
593
594					=cut
595
596	1	41µs			eval <<'END_PERL' unless defined &_INVOCANT;
597					sub _INVOCANT($) {
598					(defined $_[0] and
599					(defined Scalar::Util::blessed($_[0])
600					or
601					# We used to check for stash definedness, but any class-like name is a
602					# valid invocant for UNIVERSAL methods, so we stopped. -- rjbs, 2006-07-02
603					Params::Util::_CLASS($_[0]))
604					) ? $_[0] : undef;
605					}
606					END_PERL
607
608					=pod
609
610					=head2 _INSTANCE $object, $class
611
612					The C<_INSTANCE> function is intended to be imported into your package,
613					and provides a convenient way to test for an object of a particular class
614					in a strictly correct manner.
615
616					Returns the object itself as a convenience, or C<undef> if the value
617					provided is not an object of that type.
618
619					=cut
620
621	1	200ns			eval <<'END_PERL' unless defined &_INSTANCE;
622					sub _INSTANCE ($$) {
623					(Scalar::Util::blessed($_[0]) and $_[0]->isa($_[1])) ? $_[0] : undef;
624					}
625					END_PERL
626
627					=head2 _INSTANCEDOES $object, $role
628
629					This routine behaves exactly like C<L</_INSTANCE>>, but checks with C<< ->DOES
630					>> rather than C<< ->isa >>. This is probably only a good idea to use on Perl
631					5.10 or later, when L<UNIVERSAL::DOES\|UNIVERSAL::DOES/DOES> has been
632					implemented.
633
634					=cut
635
636	1	29µs			eval <<'END_PERL' unless defined &_INSTANCEDOES;
637					sub _INSTANCEDOES ($$) {
638					(Scalar::Util::blessed($_[0]) and $_[0]->DOES($_[1])) ? $_[0] : undef;
639					}
640					END_PERL
641
642					=pod
643
644					=head2 _REGEX $value
645
646					The C<_REGEX> function is intended to be imported into your package,
647					and provides a convenient way to test for a regular expression.
648
649					Returns the value itself as a convenience, or C<undef> if the value
650					provided is not a regular expression.
651
652					=cut
653
654	1	200ns			eval <<'END_PERL' unless defined &_REGEX;
655					sub _REGEX ($) {
656					(defined $_[0] and 'Regexp' eq ref($_[0])) ? $_[0] : undef;
657					}
658					END_PERL
659
660					=pod
661
662					=head2 _SET \@array, $class
663
664					The C<_SET> function is intended to be imported into your package,
665					and provides a convenient way to test for set of at least one object of
666					a particular class in a strictly correct manner.
667
668					The set is provided as a reference to an C<ARRAY> of objects of the
669					class provided.
670
671					For an alternative function that allows zero-length sets, see the
672					C<_SET0> function.
673
674					Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
675					the value provided is not a set of that class.
676
677					=cut
678
679	1	51µs			eval <<'END_PERL' unless defined &_SET;
680					sub _SET ($$) {
681					my $set = shift;
682					_ARRAY($set) or return undef;
683					foreach my $item ( @$set ) {
684					_INSTANCE($item,$_[0]) or return undef;
685					}
686					$set;
687					}
688					END_PERL
689
690					=pod
691
692					=head2 _SET0 \@array, $class
693
694					The C<_SET0> function is intended to be imported into your package,
695					and provides a convenient way to test for a set of objects of a
696					particular class in a strictly correct manner, allowing for zero objects.
697
698					The set is provided as a reference to an C<ARRAY> of objects of the
699					class provided.
700
701					For an alternative function that requires at least one object, see the
702					C<_SET> function.
703
704					Returns the C<ARRAY> reference itself as a convenience, or C<undef> if
705					the value provided is not a set of that class.
706
707					=cut
708
709	1	43µs			eval <<'END_PERL' unless defined &_SET0;
710					sub _SET0 ($$) {
711					my $set = shift;
712					_ARRAY0($set) or return undef;
713					foreach my $item ( @$set ) {
714					_INSTANCE($item,$_[0]) or return undef;
715					}
716					$set;
717					}
718					END_PERL
719
720					=pod
721
722					=head2 _HANDLE
723
724					The C<_HANDLE> function is intended to be imported into your package,
725					and provides a convenient way to test whether or not a single scalar
726					value is a file handle.
727
728					Unfortunately, in Perl the definition of a file handle can be a little
729					bit fuzzy, so this function is likely to be somewhat imperfect (at first
730					anyway).
731
732					That said, it is implement as well or better than the other file handle
733					detectors in existance (and we stole from the best of them).
734
735					=cut
736
737					# We're doing this longhand for now. Once everything is perfect,
738					# we'll compress this into something that compiles more efficiently.
739					# Further, testing file handles is not something that is generally
740					# done millions of times, so doing it slowly is not a big speed hit.
741	1	96µs			eval <<'END_PERL' unless defined &_HANDLE;
742					sub _HANDLE {
743					my $it = shift;
744
745					# It has to be defined, of course
746					unless ( defined $it ) {
747					return undef;
748					}
749
750					# Normal globs are considered to be file handles
751					if ( ref $it eq 'GLOB' ) {
752					return $it;
753					}
754
755					# Check for a normal tied filehandle
756					# Side Note: 5.5.4's tied() and can() doesn't like getting undef
757					if ( tied($it) and tied($it)->can('TIEHANDLE') ) {
758					return $it;
759					}
760
761					# There are no other non-object handles that we support
762					unless ( Scalar::Util::blessed($it) ) {
763					return undef;
764					}
765
766					# Check for a common base classes for conventional IO::Handle object
767					if ( $it->isa('IO::Handle') ) {
768					return $it;
769					}
770
771
772					# Check for tied file handles using Tie::Handle
773					if ( $it->isa('Tie::Handle') ) {
774					return $it;
775					}
776
777					# IO::Scalar is not a proper seekable, but it is valid is a
778					# regular file handle
779					if ( $it->isa('IO::Scalar') ) {
780					return $it;
781					}
782
783					# Yet another special case for IO::String, which refuses (for now
784					# anyway) to become a subclass of IO::Handle.
785					if ( $it->isa('IO::String') ) {
786					return $it;
787					}
788
789					# This is not any sort of object we know about
790					return undef;
791					}
792					END_PERL
793
794					=pod
795
796					=head2 _DRIVER $string
797
798					sub foo {
799					my $class = _DRIVER(shift, 'My::Driver::Base') or die "Bad driver";
800					...
801					}
802
803					The C<_DRIVER> function is intended to be imported into your
804					package, and provides a convenient way to load and validate
805					a driver class.
806
807					The most common pattern when taking a driver class as a parameter
808					is to check that the name is a class (i.e. check against _CLASS)
809					and then to load the class (if it exists) and then ensure that
810					the class returns true for the isa method on some base driver name.
811
812					Return the value as a convenience, or C<undef> if the value is not
813					a class name, the module does not exist, the module does not load,
814					or the class fails the isa test.
815
816					=cut
817
818	1	50µs			eval <<'END_PERL' unless defined &_DRIVER;
819					sub _DRIVER ($$) {
820					(defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
821					}
822					END_PERL
823
824	1	16µs			1;
825
826					=pod
827
828					=head1 TO DO
829
830					- Add _CAN to help resolve the UNIVERSAL::can debacle
831
832					- Would be even nicer if someone would demonstrate how the hell to
833					build a Module::Install dist of the ::Util dual Perl/XS type. :/
834
835					- Implement an assertion-like version of this module, that dies on
836					error.
837
838					- Implement a Test:: version of this module, for use in testing
839
840					=head1 SUPPORT
841
842					Bugs should be reported via the CPAN bug tracker at
843
844					L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Util>
845
846					For other issues, contact the author.
847
848					=head1 AUTHOR
849
850					Adam Kennedy E<lt>adamk@cpan.orgE<gt>
851
852					=head1 SEE ALSO
853
854					L<Params::Validate>
855
856					=head1 COPYRIGHT
857
858					Copyright 2005 - 2012 Adam Kennedy.
859
860					This program is free software; you can redistribute
861					it and/or modify it under the same terms as Perl itself.
862
863					The full text of the license can be found in the
864					LICENSE file included with this module.
865
866					=cut

					# spent 6.60ms within Params::Util::CORE:match which was called 2087 times, avg 3µs/call: # 2087 times (6.60ms+0s) by Params::Util::_CLASS at line 2 of (eval 14)[Params/Util.pm:190], avg 3µs/call sub Params::Util::CORE:match; # opcode
					# spent 2µs within Params::Util::_ARRAYLIKE which was called 3 times, avg 767ns/call: # 3 times (2µs+0s) by Data::OptList::__is_a at line 30 of Data/OptList.pm, avg 767ns/call sub Params::Util::_ARRAYLIKE; # xsub
					# spent 3.48ms within Params::Util::_CODELIKE which was called 4840 times, avg 720ns/call: # 4828 times (3.47ms+0s) by PPI::Node::_wanted at line 609 of PPI/Node.pm, avg 720ns/call # 6 times (5µs+0s) by Data::OptList::__is_a at line 30 of Data/OptList.pm, avg 817ns/call # 4 times (3µs+0s) by Sub::Exporter::default_generator at line 419 of Sub/Exporter.pm, avg 675ns/call # 2 times (2µs+0s) by Sub::Exporter::_do_import at line 352 of Sub/Exporter.pm, avg 800ns/call sub Params::Util::_CODELIKE; # xsub
					# spent 7µs within Params::Util::_HASHLIKE which was called 3 times, avg 2µs/call: # 3 times (7µs+0s) by Data::OptList::__is_a at line 30 of Data/OptList.pm, avg 2µs/call sub Params::Util::_HASHLIKE; # xsub
					# spent 629ms (545+83.6) within Params::Util::_INSTANCE which was called 237723 times, avg 3µs/call: # 105472 times (368ms+60.7ms) by PPI::Element::__eq at line 1089 of PPI/Element.pm, avg 4µs/call # 105472 times (57.7ms+47µs) by PPI::Element::__eq at line 1090 of PPI/Element.pm, avg 547ns/call # 10538 times (52.8ms+7.69ms) by PPI::Statement::new at line 203 of PPI/Statement.pm, avg 6µs/call # 5080 times (23.1ms+4.30ms) by List::Util::first at line 99 of PPI/Statement/Sub.pm, avg 5µs/call # 3157 times (12.6ms+2.40ms) by PPI::Lexer::_round at line 991 of PPI/Lexer.pm, avg 5µs/call # 2597 times (8.62ms+2.50ms) by PPI::Lexer::_round at line 1011 of PPI/Lexer.pm, avg 4µs/call # 1613 times (6.96ms+1.86ms) by PPI::Lexer::_statement at line 585 of PPI/Lexer.pm, avg 5µs/call # 1299 times (7.21ms+1.60ms) by PPI::Statement::Variable::type at line 70 of PPI/Statement/Variable.pm, avg 7µs/call # 1299 times (3.83ms+762µs) by PPI::Statement::Variable::type at line 73 of PPI/Statement/Variable.pm, avg 4µs/call # 286 times (898µs+279µs) by PPI::Element::statement at line 283 of PPI/Element.pm, avg 4µs/call # 286 times (839µs+166µs) by PPI::Element::statement at line 284 of PPI/Element.pm, avg 4µs/call # 144 times (1.34ms+334µs) by PPI::Lexer::lex_tokenizer at line 215 of PPI/Lexer.pm, avg 12µs/call # 144 times (771µs+148µs) by PPI::Document::File::new at line 67 of PPI/Document/File.pm, avg 6µs/call # 144 times (320µs+0s) by PPI::Lexer::lex_file at line 161 of PPI/Lexer.pm, avg 2µs/call # 131 times (687µs+399µs) by PPI::Lexer::_continues at line 876 of PPI/Lexer.pm, avg 8µs/call # 61 times (311µs+358µs) by PPI::Lexer::_curly at line 1248 of PPI/Lexer.pm, avg 11µs/call sub Params::Util::_INSTANCE; # xsub
					# spent 2µs within Params::Util::_SCALAR0 which was called 2 times, avg 950ns/call: # 2 times (2µs+0s) by Sub::Exporter::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Sub/Exporter.pm:159] at line 151 of Sub/Exporter.pm, avg 950ns/call sub Params::Util::_SCALAR0; # xsub
					# spent 346µs within Params::Util::_STRING which was called 288 times, avg 1µs/call: # 144 times (218µs+0s) by PPI::Document::File::new at line 54 of PPI/Document/File.pm, avg 2µs/call # 144 times (128µs+0s) by PPI::Lexer::lex_file at line 152 of PPI/Lexer.pm, avg 891ns/call sub Params::Util::_STRING; # xsub
					# spent 28µs within Params::Util::bootstrap which was called: # once (28µs+0s) by DynaLoader::bootstrap at line 217 of DynaLoader.pm sub Params::Util::bootstrap; # xsub