File Coverage

blib/lib/Params/Classify.pm
Criterion Covered Total %
statement 85 85 100.0
branch 80 82 97.5
condition 14 15 93.3
subroutine 27 27 100.0
pod 20 20 100.0
total 226 229 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              
20             $c = scalar_class($arg);
21              
22             if(is_undef($arg)) {
23             check_undef($arg);
24              
25             if(is_string($arg)) {
26             check_string($arg);
27             if(is_number($arg)) {
28             check_number($arg);
29              
30             if(is_glob($arg)) {
31             check_glob($arg);
32             if(is_regexp($arg)) {
33             check_regexp($arg);
34              
35             if(is_ref($arg)) {
36             check_ref($arg);
37             $t = ref_type($arg);
38             if(is_ref($arg, "HASH")) {
39             check_ref($arg, "HASH");
40              
41             if(is_blessed($arg)) {
42             check_blessed($arg);
43             if(is_blessed($arg, "IO::Handle")) {
44             check_blessed($arg, "IO::Handle");
45             $c = blessed_class($arg);
46             if(is_strictly_blessed($arg, "IO::Pipe::End")) {
47             check_strictly_blessed($arg, "IO::Pipe::End");
48             if(is_able($arg, ["print", "flush"])) {
49             check_able($arg, ["print", "flush"]);
50              
51             =head1 DESCRIPTION
52              
53             This module provides various type-testing functions. These are intended
54             for functions that, unlike most Perl code, care what type of data they
55             are operating on. For example, some functions wish to behave differently
56             depending on the type of their arguments (like overloaded functions
57             in C++).
58              
59             There are two flavours of function in this module. Functions of the first
60             flavour only provide type classification, to allow code to discriminate
61             between argument types. Functions of the second flavour package up the
62             most common type of type discrimination: checking that an argument is
63             of an expected type. The functions come in matched pairs, of the two
64             flavours, and so the type enforcement functions handle only the simplest
65             requirements for arguments of the types handled by the classification
66             functions. Enforcement of more complex types may, of course, be built
67             using the classification functions, or it may be more convenient to use
68             a module designed for the more complex job, such as L.
69              
70             This module is implemented in XS, with a pure Perl backup version for
71             systems that can't handle XS.
72              
73             =cut
74              
75             package Params::Classify;
76              
77 10     10   509614 { use 5.006001; }
  10         39  
  10         428  
78 10     10   68 use warnings;
  10         25  
  10         402  
79 10     10   65 use strict;
  10         34  
  10         526  
80              
81             our $VERSION = "0.013";
82              
83 10     10   35936 use parent "Exporter";
  10         4245  
  10         65  
84             our @EXPORT_OK = qw(
85             scalar_class
86             is_undef check_undef
87             is_string check_string
88             is_number check_number
89             is_glob check_glob
90             is_regexp check_regexp
91             is_ref check_ref ref_type
92             is_blessed check_blessed blessed_class
93             is_strictly_blessed check_strictly_blessed
94             is_able check_able
95             );
96              
97             eval { local $SIG{__DIE__};
98             require XSLoader;
99             XSLoader::load(__PACKAGE__, $VERSION);
100             };
101              
102             if($@ eq "") {
103             close(DATA);
104             } else {
105             (my $filename = __FILE__) =~ tr# -~##cd;
106             local $/ = undef;
107             my $pp_code = "#line 128 \"$filename\"\n".;
108             close(DATA);
109             {
110             local $SIG{__DIE__};
111             eval $pp_code;
112             }
113             die $@ if $@ ne "";
114             }
115              
116             sub is_string($);
117             sub is_number($) {
118 212 100   212 1 37489 return 0 unless &is_string;
119 72         103 my $warned;
120 72     36   450 local $SIG{__WARN__} = sub { $warned = 1; };
  36         111  
121 72         126 my $arg = $_[0];
122 10     10   3474 { no warnings "void"; 0 + $arg; }
  10         32  
  10         1239  
  72         88  
  72         428  
123 72         560 return !$warned;
124             }
125              
126             sub check_number($) {
127 84 100   84 1 827212 die "argument is not a number\n" unless &is_number;
128             }
129 27     27   7674  
  27         312  
  19         9173  
130             1;
131              
132             __DATA__