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              
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   204949 { use 5.006001; }
  10         50  
78 10     10   72 use warnings;
  10         26  
  10         331  
79 10     10   64 use strict;
  10         34  
  10         475  
80              
81             our $VERSION = "0.014";
82              
83 10     10   5070 use parent "Exporter";
  10         3263  
  10         69  
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 Devel::CallChecker;
99             Devel::CallChecker->VERSION(0.003);
100             };
101             eval { local $SIG{__DIE__};
102             require XSLoader;
103             XSLoader::load(__PACKAGE__, $VERSION);
104             };
105              
106             if($@ eq "") {
107             close(DATA);
108             } else {
109             (my $filename = __FILE__) =~ tr# -~##cd;
110             local $/ = undef;
111             my $pp_code = "#line 137 \"$filename\"\n".;
112             close(DATA);
113             {
114             local $SIG{__DIE__};
115             eval $pp_code;
116             }
117             die $@ if $@ ne "";
118             }
119              
120             sub is_string($);
121             sub is_number($) {
122 212 100   212 1 41457 return 0 unless &is_string;
123 72         156 my $warned;
124 72     36   448 local $SIG{__WARN__} = sub { $warned = 1; };
  36         165  
125 72         206 my $arg = $_[0];
126 10     10   3150 { no warnings "void"; 0 + $arg; }
  10         28  
  10         1131  
  72         181  
  72         636  
127 72         546 return !$warned;
128             }
129              
130             sub check_number($) {
131 84 100   84 1 474355 die "argument is not a number\n" unless &is_number;
132             }
133              
134             1;
135              
136             __DATA__