| 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; |