File Coverage

blib/lib/Params/Classify.pm
Criterion Covered Total %
statement 84 84 100.0
branch 80 82 97.5
condition 14 15 93.3
subroutine 27 27 100.0
pod 20 20 100.0
total 225 228 98.6


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Params::Classify - argument type classification
4              
5             =head1 SYNOPSIS
6              
7             use Params::Classify qw(
8             scalar_class
9             is_undef check_undef
10             is_string check_string
11             is_number check_number
12             is_glob check_glob
13             is_regexp check_regexp
14             is_ref check_ref ref_type
15             is_blessed check_blessed blessed_class
16             is_strictly_blessed check_strictly_blessed
17             is_able check_able);
18              
19             $c = scalar_class($arg);
20              
21             if(is_undef($arg)) {
22             check_undef($arg);
23              
24             if(is_string($arg)) {
25             check_string($arg);
26             if(is_number($arg)) {
27             check_number($arg);
28              
29             if(is_glob($arg)) {
30             check_glob($arg);
31             if(is_regexp($arg)) {
32             check_regexp($arg);
33              
34             if(is_ref($arg)) {
35             check_ref($arg);
36             $t = ref_type($arg);
37             if(is_ref($arg, "HASH")) {
38             check_ref($arg, "HASH");
39              
40             if(is_blessed($arg)) {
41             check_blessed($arg);
42             if(is_blessed($arg, "IO::Handle")) {
43             check_blessed($arg, "IO::Handle");
44             $c = blessed_class($arg);
45             if(is_strictly_blessed($arg, "IO::Pipe::End")) {
46             check_strictly_blessed($arg, "IO::Pipe::End");
47             if(is_able($arg, ["print", "flush"])) {
48             check_able($arg, ["print", "flush"]);
49              
50             =head1 DESCRIPTION
51              
52             This module provides various type-testing functions. These are intended
53             for functions that, unlike most Perl code, care what type of data they
54             are operating on. For example, some functions wish to behave differently
55             depending on the type of their arguments (like overloaded functions
56             in C++).
57              
58             There are two flavours of function in this module. Functions of the first
59             flavour only provide type classification, to allow code to discriminate
60             between argument types. Functions of the second flavour package up the
61             most common type of type discrimination: checking that an argument is
62             of an expected type. The functions come in matched pairs, of the two
63             flavours, and so the type enforcement functions handle only the simplest
64             requirements for arguments of the types handled by the classification
65             functions. Enforcement of more complex types may, of course, be built
66             using the classification functions, or it may be more convenient to use
67             a module designed for the more complex job, such as L<Params::Validate>.
68              
69             This module is implemented in XS, with a pure Perl backup version for
70             systems that can't handle XS.
71              
72             =cut
73              
74             package Params::Classify;
75              
76 12     12   656381 { use 5.006001; }
  12         46  
77 12     12   71 use warnings;
  12         28  
  12         369  
78 12     12   62 use strict;
  12         29  
  12         544  
79              
80             our $VERSION = "0.015";
81              
82 12     12   3797 use parent "Exporter";
  12         3395  
  12         92  
83             our @EXPORT_OK = qw(
84             scalar_class
85             is_undef check_undef
86             is_string check_string
87             is_number check_number
88             is_glob check_glob
89             is_regexp check_regexp
90             is_ref check_ref ref_type
91             is_blessed check_blessed blessed_class
92             is_strictly_blessed check_strictly_blessed
93             is_able check_able
94             );
95              
96             eval { local $SIG{__DIE__};
97             require Devel::CallChecker;
98             Devel::CallChecker->VERSION(0.003);
99             };
100             eval { local $SIG{__DIE__};
101             require XSLoader;
102             XSLoader::load(__PACKAGE__, $VERSION);
103             };
104              
105             if($@ eq "") {
106             close(DATA);
107             } else {
108             (my $filename = __FILE__) =~ tr# -~##cd;
109             local $/ = undef;
110             my $pp_code = "#line 137 \"$filename\"\n".<DATA>;
111             close(DATA);
112             {
113             local $SIG{__DIE__};
114             eval $pp_code;
115             }
116             die $@ if $@ ne "";
117             }
118              
119             sub is_string($);
120             sub is_number($) {
121 212 100   212 1 32757 return 0 unless &is_string;
122 72         131 my $warned;
123 72     36   434 local $SIG{__WARN__} = sub { $warned = 1; };
  36         133  
124 72         141 my $arg = $_[0];
125 12     12   3317 { no warnings "void"; 0 + $arg; }
  12         33  
  12         1275  
  72         93  
  72         470  
126 72         411 return !$warned;
127             }
128              
129             sub check_number($) {
130 84 100   84 1 555712 die "argument is not a number\n" unless &is_number;
131             }
132              
133             1;
134              
135             __DATA__
136              
137             use Scalar::Util 1.01 qw(blessed reftype);
138 28     28   5917  
  28         209  
  20         8301  
139             =head1 TYPE CLASSIFICATION
140              
141             This module divides up scalar values into the following classes:
142              
143             =over
144              
145             =item *
146              
147             undef
148              
149             =item *
150              
151             string (defined ordinary scalar)
152              
153             =item *
154              
155             typeglob (yes, typeglobs fit into scalar variables)
156              
157             =item *
158              
159             regexp (first-class regular expression objects in Perl 5.11 onwards)
160              
161             =item *
162              
163             reference to unblessed object (further classified by physical data type
164             of the referenced object)
165              
166             =item *
167              
168             reference to blessed object (further classified by class blessed into)
169              
170             =back
171              
172             These classes are mutually exclusive and should be exhaustive. This
173             classification has been chosen as the most useful when one wishes to
174             discriminate between types of scalar. Other classifications are possible.
175             (For example, the two reference classes are distinguished by a feature of
176             the referenced object; Perl does not internally treat this as a feature
177             of the reference.)
178              
179             =head1 FUNCTIONS
180              
181             Each of these functions takes one scalar argument (I<ARG>) to be tested,
182             possibly with other arguments specifying details of the test. Any scalar
183             value is acceptable for the argument to be tested. Each C<is_> function
184             returns a simple truth value result, which is true iff I<ARG> is of the
185             type being checked for. Each C<check_> function will return normally
186             if the argument is of the type being checked for, or will C<die> if it
187             is not.
188              
189             =head2 Classification
190              
191             =over
192              
193             =item scalar_class(ARG)
194              
195             Determines which of the five classes described above I<ARG> falls into.
196             Returns "B<UNDEF>", "B<STRING>", "B<GLOB>", "B<REGEXP>", "B<REF>", or
197             "B<BLESSED>" accordingly.
198              
199             =cut
200              
201             sub scalar_class($) {
202             my $type = reftype(\$_[0]);
203 4     106 1 23 if($type eq "SCALAR") {
204 22 100       79 $type = defined($_[0]) ? "STRING" : "UNDEF";
    100          
205 106 100       561 } elsif($type eq "REF") {
206             $type = "BLESSED" if defined(blessed($_[0]));
207 42 100       22334 }
208             $type;
209 3264         18340 }
210              
211             =back
212              
213             =head2 The Undefined Value
214              
215             =over
216              
217             =item is_undef(ARG)
218              
219             =item check_undef(ARG)
220              
221             Check whether I<ARG> is C<undef>. C<is_undef(ARG)> is precisely
222             equivalent to C<!defined(ARG)>, and is included for completeness.
223              
224             =cut
225              
226             sub is_undef($) { !defined($_[0]) }
227 42     42 1 20281  
228             sub check_undef($) {
229             die "argument is not undefined\n" unless &is_undef;
230 106 100   3264 1 697 }
231              
232             =back
233              
234             =head2 Strings
235              
236             =over
237              
238             =item is_string(ARG)
239              
240             =item check_string(ARG)
241              
242             Check whether I<ARG> is defined and is an ordinary scalar value (not a
243             reference, typeglob, or regexp). This is what one usually thinks of as a
244             string in Perl. In fact, any scalar (including C<undef> and references)
245             can be coerced to a string, but if you're trying to classify a scalar
246             then you don't want to do that.
247              
248             =cut
249              
250             sub is_string($) { defined($_[0]) && reftype(\$_[0]) eq "SCALAR" }
251 42 100   42 1 20306  
252             sub check_string($) {
253             die "argument is not a string\n" unless &is_string;
254 106 100   106 1 673 }
255              
256             =item is_number(ARG)
257              
258             =item check_number(ARG)
259              
260             Check whether I<ARG> is defined and an ordinary scalar (i.e.,
261             satisfies L</is_string> above) and is an acceptable number to Perl.
262             This is what one usually thinks of as a number.
263              
264             Note that simple (L</is_string>-satisfying) scalars may have independent
265             numeric and string values, despite the usual pretence that they have
266             only one value. Such a scalar is deemed to be a number if I<either> it
267             already has a numeric value (e.g., was generated by a numeric literal
268             or an arithmetic computation) I<or> its string value has acceptable
269             syntax for a number (so it can be converted). Where a scalar has
270             separate numeric and string values (see L<Scalar::Util/dualvar>), it is
271             possible for it to have an acceptable numeric value while its string
272             value does I<not> have acceptable numeric syntax. Be careful to use
273             such a value only in a numeric context, if you are using it as a number.
274             L<Scalar::Number/scalar_num_part> extracts the numeric part of a
275             scalar as an ordinary number. (C<0+ARG> suffices for that unless you
276             need to preserve floating point signed zeroes.)
277              
278             A number may be either a native integer or a native floating point
279             value, and there are several subtypes of floating point value.
280             For classification, and other handling of numbers in scalars, see
281             L<Scalar::Number>. For details of the two numeric data types, see
282             L<Data::Integer> and L<Data::Float>.
283              
284             This function differs from C<looks_like_number> (see
285             L<Scalar::Util/looks_like_number>; also L<perlapi/looks_like_number>
286             for a lower-level description) in excluding C<undef>, typeglobs,
287             and references. Why C<looks_like_number> returns true for C<undef>
288             or typeglobs is anybody's guess. References, if treated as numbers,
289             evaluate to the address in memory that they reference; this is useful
290             for comparing references for equality, but it is not otherwise useful
291             to treat references as numbers. Blessed references may have overloaded
292             numeric operators, but if so then they don't necessarily behave like
293             ordinary numbers. C<looks_like_number> is also confused by dualvars:
294             it looks at the string portion of the scalar.
295              
296             =back
297              
298             =head2 Typeglobs
299              
300             =over
301              
302             =item is_glob(ARG)
303              
304             =item check_glob(ARG)
305              
306             Check whether I<ARG> is a typeglob.
307              
308             =cut
309              
310             sub is_glob($) { reftype(\$_[0]) eq "GLOB" }
311 42     42 1 18758  
312             sub check_glob($) {
313             die "argument is not a typeglob\n" unless &is_glob;
314 24 100   106 1 6938 }
315              
316             =back
317              
318             =head2 Regexps
319              
320             =over
321              
322             =item is_regexp(ARG)
323              
324             =item check_regexp(ARG)
325              
326             Check whether I<ARG> is a regexp object.
327              
328             =cut
329              
330             sub is_regexp($) { reftype(\$_[0]) eq "REGEXP" }
331 24     42 1 136  
332             sub check_regexp($) {
333             die "argument is not a regexp\n" unless &is_regexp;
334 14 100   24 1 32 }
335              
336             =back
337              
338             =head2 References to Unblessed Objects
339              
340             =over
341              
342             =item is_ref(ARG)
343              
344             =item check_ref(ARG)
345              
346             Check whether I<ARG> is a reference to an unblessed object. If it
347             is, then the referenced data type can be determined using C<ref_type>
348             (see below), which will return a string such as "HASH" or "SCALAR".
349              
350             =item ref_type(ARG)
351              
352             Returns C<undef> if I<ARG> is not a reference to an unblessed object.
353             Otherwise, determines what type of object is referenced. Returns
354             "B<SCALAR>", "B<ARRAY>", "B<HASH>", "B<CODE>", "B<FORMAT>", or "B<IO>"
355             accordingly.
356              
357             Note that, unlike C<ref>, this does not distinguish between different
358             types of referenced scalar. A reference to a string and a reference to
359             a reference will both return "B<SCALAR>". Consequently, what C<ref_type>
360             returns for a particular reference will not change due to changes in
361             the value of the referent, except for the referent being blessed.
362              
363             =item is_ref(ARG, TYPE)
364              
365             =item check_ref(ARG, TYPE)
366              
367             Check whether I<ARG> is a reference to an unblessed object of type
368             I<TYPE>, as determined by L</ref_type>. I<TYPE> must be a string.
369             Possible I<TYPE>s are "B<SCALAR>", "B<ARRAY>", "B<HASH>", "B<CODE>",
370             "B<FORMAT>", and "B<IO>".
371              
372             =cut
373              
374             {
375             my %xlate_reftype = (
376             REF => "SCALAR",
377             SCALAR => "SCALAR",
378             LVALUE => "SCALAR",
379             GLOB => "SCALAR",
380             REGEXP => "SCALAR",
381             ARRAY => "ARRAY",
382             HASH => "HASH",
383             CODE => "CODE",
384             FORMAT => "FORMAT",
385             IO => "IO",
386             );
387              
388             my %reftype_ok = map { ($_ => undef) } qw(
389             SCALAR ARRAY HASH CODE FORMAT IO
390             );
391              
392             sub ref_type($) {
393             my $reftype = &reftype;
394 14     1858 1 34 return undef unless
395             defined($reftype) && !defined(blessed($_[0]));
396 14 100 100     51 my $xlated_reftype = $xlate_reftype{$reftype};
397 1858         65500 die "unknown reftype `$reftype', please update Params::Classify"
398 1728 50       3303 unless defined $xlated_reftype;
399             $xlated_reftype;
400 1656         4423 }
401              
402             sub is_ref($;$) {
403             if(@_ == 2) {
404 1738 100   606 1 3590 die "reference type argument is not a string\n"
405 1738 100       6525 unless is_string($_[1]);
406             die "invalid reference type\n"
407             unless exists $reftype_ok{$_[1]};
408 812 100       1798 }
409             my $reftype = reftype($_[0]);
410 768         1313 return undef unless
411             defined($reftype) && !defined(blessed($_[0]));
412 768 100 100     1362 return 1 if @_ != 2;
413 768 100       2163 my $xlated_reftype = $xlate_reftype{$reftype};
414 606         297693 die "unknown reftype `$reftype', please update Params::Classify"
415 504 50       3100 unless defined $xlated_reftype;
416             return $xlated_reftype eq $_[1];
417 626         48229 }
418             }
419              
420             sub check_ref($;$) {
421             unless(&is_ref) {
422 554 100   626 1 2755 die "argument is not a reference to plain ".
423 246 100       80624 (@_ == 2 ? lc($_[1]) : "object")."\n";
424             }
425             }
426              
427             =back
428              
429             =head2 References to Blessed Objects
430              
431             =over
432              
433             =item is_blessed(ARG)
434              
435             =item check_blessed(ARG)
436              
437             Check whether I<ARG> is a reference to a blessed object. If it is,
438             then the class into which the object was blessed can be determined using
439             L</blessed_class>.
440              
441             =item is_blessed(ARG, CLASS)
442              
443             =item check_blessed(ARG, CLASS)
444              
445             Check whether I<ARG> is a reference to a blessed object that claims to
446             be an instance of I<CLASS> (via its C<isa> method; see L<perlobj/isa>).
447             I<CLASS> must be a string, naming a Perl class.
448              
449             =cut
450              
451             sub is_blessed($;$) {
452             die "class argument is not a string\n"
453 174 100 100 246 1 1081 if @_ == 2 && !is_string($_[1]);
454             return defined(blessed($_[0])) && (@_ != 2 || $_[0]->isa($_[1]));
455 320   66     17574 }
456              
457             sub check_blessed($;$) {
458             unless(&is_blessed) {
459 304 100   320 1 597 die "argument is not a reference to blessed ".
460 232 100       627 (@_ == 2 ? $_[1] : "object")."\n";
461             }
462             }
463              
464             =item blessed_class(ARG)
465              
466             Returns C<undef> if I<ARG> is not a reference to a blessed object.
467             Otherwise, returns the class into which the object is blessed.
468              
469             C<ref> (see L<perlfunc/ref>) gives the same result on references
470             to blessed objects, but different results on other types of value.
471             C<blessed_class> is actually identical to L<Scalar::Util/blessed>.
472              
473             =cut
474              
475             *blessed_class = \&blessed;
476              
477             =item is_strictly_blessed(ARG)
478              
479             =item check_strictly_blessed(ARG)
480              
481             Check whether I<ARG> is a reference to a blessed object, identically
482             to L</is_blessed>. This exists only for symmetry; the useful form of
483             C<is_strictly_blessed> appears below.
484              
485             =item is_strictly_blessed(ARG, CLASS)
486              
487             =item check_strictly_blessed(ARG, CLASS)
488              
489             Check whether I<ARG> is a reference to an object blessed into I<CLASS>
490             exactly. I<CLASS> must be a string, naming a Perl class. Because this
491             excludes subclasses, this is rarely what one wants, but there are some
492             specialised occasions where it is useful.
493              
494             =cut
495              
496             sub is_strictly_blessed($;$) {
497             return &is_blessed unless @_ == 2;
498 232 100   162 1 853 die "class argument is not a string\n" unless is_string($_[1]);
499 162 100       78311 my $blessed = blessed($_[0]);
500 120         279 return defined($blessed) && $blessed eq $_[1];
501 80   100     437 }
502              
503             sub check_strictly_blessed($;$) {
504             return &check_blessed unless @_ == 2;
505 476 100   476 1 786 unless(&is_strictly_blessed) {
506 312 100       812 die "argument is not a reference to strictly blessed $_[1]\n";
507 240         403 }
508             }
509              
510             =item is_able(ARG)
511              
512             =item check_able(ARG)
513              
514             Check whether I<ARG> is a reference to a blessed object, identically
515             to L</is_blessed>. This exists only for symmetry; the useful form of
516             C<is_able> appears below.
517              
518             =item is_able(ARG, METHODS)
519              
520             =item check_able(ARG, METHODS)
521              
522             Check whether I<ARG> is a reference to a blessed object that claims to
523             implement the methods specified by I<METHODS> (via its C<can> method;
524             see L<perlobj/can>). I<METHODS> must be either a single method name or
525             a reference to an array of method names. Each method name is a string.
526             This interface check is often more appropriate than a direct ancestry
527             check (such as L</is_blessed> performs).
528              
529             =cut
530              
531             sub _check_methods_arg($) {
532             return if &is_string;
533 240 100   336   540 die "methods argument is not a string or array\n"
534 240 100       407 unless is_ref($_[0], "ARRAY");
535             foreach(@{$_[0]}) {
536 336         59364 die "method name is not a string\n" unless is_string($_);
  278         703  
537 206 100       770 }
538             }
539              
540             sub is_able($;$) {
541             return &is_blessed unless @_ == 2;
542 60 100   240 1 177 _check_methods_arg($_[1]);
543 20         45 return 0 unless defined blessed $_[0];
544 54 100       287 foreach my $method (ref($_[1]) eq "" ? $_[1] : @{$_[1]}) {
545 34 100       92 return 0 unless $_[0]->can($method);
  240         112119  
546 198 100       584 }
547             return 1;
548 126         425 }
549              
550             sub check_able($;$) {
551             return &check_blessed unless @_ == 2;
552 96 100     1 276 _check_methods_arg($_[1]);
553 64         202 unless(defined blessed $_[0]) {
554 96 100       525 my $desc = ref($_[1]) eq "" ?
555             "method \"$_[1]\""
556             : @{$_[1]} == 0 ?
557 30 100       91 "at all"
  20 100       58  
558             :
559             "method \"".$_[1]->[0]."\"";
560             die "argument is not able to perform $desc\n";
561 24         189 }
562             foreach my $method (ref($_[1]) eq "" ? $_[1] : @{$_[1]}) {
563   100         die "argument is not able to perform method \"$method\"\n"
564   100         unless $_[0]->can($method);
565             }
566             }
567              
568             =back
569              
570             =head1 BUGS
571              
572             Probably ought to handle something like L<Params::Validate>'s scalar
573             type specification system, which makes much the same distinctions.
574              
575             =head1 SEE ALSO
576              
577             L<Data::Float>,
578             L<Data::Integer>,
579             L<Params::Validate>,
580             L<Scalar::Number>,
581             L<Scalar::Util>
582              
583             =head1 AUTHOR
584              
585             Andrew Main (Zefram) <zefram@fysh.org>
586              
587             =head1 COPYRIGHT
588              
589             Copyright (C) 2004, 2006, 2007, 2009, 2010, 2017
590             Andrew Main (Zefram) <zefram@fysh.org>
591              
592             Copyright (C) 2009, 2010 PhotoBox Ltd
593              
594             =head1 LICENSE
595              
596             This module is free software; you can redistribute it and/or modify it
597             under the same terms as Perl itself.
598              
599             =cut
600              
601             1;