File Coverage

blib/lib/Carp/Assert/More.pm
Criterion Covered Total %
statement 164 164 100.0
branch 44 44 100.0
condition 14 16 87.5
subroutine 33 33 100.0
pod 23 23 100.0
total 278 280 99.3


line stmt bran cond sub pod time code
1             package Carp::Assert::More;
2              
3 26     26   596 use warnings;
  26         563  
  26         566  
4 26     26   3932 use strict;
  26         2383  
  26         577  
5 26     26   930 use Exporter;
  26         274  
  26         658  
6 26     26   1385 use Carp::Assert;
  26         336  
  26         598  
7              
8 26     26   494 use vars qw( $VERSION @ISA @EXPORT );
  26         243  
  26         413  
9              
10             *_fail_msg = *Carp::Assert::_fail_msg;
11              
12              
13             =head1 NAME
14            
15             Carp::Assert::More - convenience wrappers around Carp::Assert
16            
17             =head1 VERSION
18            
19             Version 1.12
20            
21             =cut
22              
23             BEGIN {
24 26     26   352     $VERSION = '1.12';
25 26         403     @ISA = qw(Exporter);
26 26         1322     @EXPORT = qw(
27             assert_defined
28             assert_exists
29             assert_fail
30             assert_hashref
31             assert_in
32             assert_integer
33             assert_is
34             assert_isa
35             assert_isnt
36             assert_lacks
37             assert_like
38             assert_listref
39             assert_negative
40             assert_negative_integer
41             assert_nonblank
42             assert_nonempty
43             assert_nonnegative
44             assert_nonnegative_integer
45             assert_nonref
46             assert_nonzero
47             assert_nonzero_integer
48             assert_positive
49             assert_positive_integer
50             );
51             }
52              
53             =head1 SYNOPSIS
54            
55             use Carp::Assert::More;
56            
57             my $obj = My::Object;
58             assert_isa( $obj, 'My::Object', 'Got back a correct object' );
59            
60             =head1 DESCRIPTION
61            
62             Carp::Assert::More is a set of wrappers around the L<Carp::Assert> functions
63             to make the habit of writing assertions even easier.
64            
65             Everything in here is effectively syntactic sugar. There's no technical
66             reason to use
67            
68             assert_isa( $foo, 'HTML::Lint' );
69            
70             instead of
71            
72             assert( defined $foo );
73             assert( ref($foo) eq 'HTML::Lint' );
74            
75             other than readability and simplicity of the code.
76            
77             My intent here is to make common assertions easy so that we as programmers
78             have no excuse to not use them.
79            
80             =head1 CAVEATS
81            
82             I haven't specifically done anything to make Carp::Assert::More be
83             backwards compatible with anything besides Perl 5.6.1, much less back
84             to 5.004. Perhaps someone with better testing resources in that area
85             can help me out here.
86            
87             =head1 SIMPLE ASSERTIONS
88            
89             =head2 assert_is( $string, $match [,$name] )
90            
91             Asserts that I<$string> matches I<$match>.
92            
93             =cut
94              
95             sub assert_is($$;$) {
96 8     8 1 710     my $string = shift;
97 8         82     my $match = shift;
98 8         70     my $name = shift;
99              
100             # undef only matches undef
101 8 100 100     108     return if !defined($string) && !defined($match);
102 7         70     assert_defined( $string, $name );
103 6         55     assert_defined( $match, $name );
104              
105 5 100       68     return if $string eq $match;
106              
107 1         15     require Carp;
108 1         13     &Carp::confess( _fail_msg($name) );
109             }
110              
111             =head2 assert_isnt( $string, $unmatch [,$name] )
112            
113             Asserts that I<$string> does NOT match I<$unmatch>.
114            
115             =cut
116              
117             sub assert_isnt($$;$) {
118 8     8 1 613     my $string = shift;
119 8         71     my $unmatch = shift;
120 8         106     my $name = shift;
121              
122             # undef only matches undef
123 8 100 100     136     return if defined($string) xor defined($unmatch);
124              
125 6 100 66     107     return if defined($string) && defined($unmatch) && ($string ne $unmatch);
      100        
126              
127 5         72     require Carp;
128 5         58     &Carp::confess( _fail_msg($name) );
129             }
130              
131             =head2 assert_like( $string, qr/regex/ [,$name] )
132            
133             Asserts that I<$string> matches I<qr/regex/>.
134            
135             =cut
136              
137             sub assert_like($$;$) {
138 7     7 1 69     my $string = shift;
139 7         62     my $regex = shift;
140 7         61     my $name = shift;
141              
142 7         74     assert_nonref( $string, $name );
143 6         63     assert_isa( $regex, 'Regexp', $name );
144 4 100       67     return if $string =~ $regex;
145              
146 1         14     require Carp;
147 1         14     &Carp::confess( _fail_msg($name) );
148             }
149              
150             =head2 assert_defined( $this [, $name] )
151            
152             Asserts that I<$this> is defined.
153            
154             =cut
155              
156             sub assert_defined($;$) {
157 123 100   123 1 2400     return if defined( $_[0] );
158              
159 9         141     require Carp;
160 9         130     &Carp::confess( _fail_msg($_[1]) );
161             }
162              
163             =head2 assert_nonblank( $this [, $name] )
164            
165             Asserts that I<$this> is not blank and not a reference.
166            
167             =cut
168              
169             sub assert_nonblank($;$) {
170 5     5 1 130     my $this = shift;
171 5         44     my $name = shift;
172              
173 5         54     assert_nonref( $this, $name );
174 3 100       38     return if $this ne "";
175              
176 1         14     require Carp;
177 1         15     &Carp::confess( _fail_msg($_[1]) );
178             }
179              
180             =head1 NUMERIC ASSERTIONS
181            
182             =head2 assert_integer( $this [, $name ] )
183            
184             Asserts that I<$this> is an integer, which may be zero or negative.
185            
186             assert_integer( 0 ); # pass
187             assert_integer( -14 ); # pass
188             assert_integer( '14.' ); # FAIL
189            
190             =cut
191              
192             sub assert_integer($;$) {
193 21     21 1 191     my $this = shift;
194 21         178     my $name = shift;
195              
196 21         216     assert_nonref( $this, $name );
197 21 100       315     return if $this =~ /^-?\d+$/;
198              
199 11         162     require Carp;
200 11         253     &Carp::confess( _fail_msg($name) );
201             }
202              
203             =head2 assert_nonzero( $this [, $name ] )
204            
205             Asserts that the numeric value of I<$this> is not zero.
206            
207             assert_nonzero( 0 ); # FAIL
208             assert_nonzero( -14 ); # pass
209             assert_nonzero( '14.' ); # pass
210            
211             Asserts that the numeric value of I<$this> is not zero.
212            
213             =cut
214              
215             sub assert_nonzero($;$) {
216 12     12 1 109     my $this = shift;
217 12         102     my $name = shift;
218              
219 26     26   708     no warnings;
  26         1465  
  26         556  
220 12 100       259     return if $this+0 != 0;
221              
222 4         53     require Carp;
223 4         51     &Carp::confess( _fail_msg($name) );
224             }
225              
226             =head2 assert_positive( $this [, $name ] )
227            
228             Asserts that the numeric value of I<$this> is greater than zero.
229            
230             assert_positive( 0 ); # FAIL
231             assert_positive( -14 ); # FAIL
232             assert_positive( '14.' ); # pass
233            
234             =cut
235              
236             sub assert_positive($;$) {
237 17     17 1 157     my $this = shift;
238 17         146     my $name = shift;
239              
240 26     26   954     no warnings;
  26         241  
  26         370  
241 17 100       219     return if $this+0 > 0;
242              
243 8         111     require Carp;
244 8         105     &Carp::confess( _fail_msg($name) );
245             }
246              
247             =head2 assert_nonnegative( $this [, $name ] )
248            
249             Asserts that the numeric value of I<$this> is greater than or equal
250             to zero. Since non-numeric strings evaluate to zero, this means that
251             any non-numeric string will pass.
252            
253             assert_nonnegative( 0 ); # pass
254             assert_nonnegative( -14 ); # FAIL
255             assert_nonnegative( '14.' ); # pass
256             assert_nonnegative( 'dog' ); # pass
257            
258             =cut
259              
260             sub assert_nonnegative($;$) {
261 12     12 1 110     my $this = shift;
262 12         105     my $name = shift;
263              
264 26     26   468     no warnings;
  26         248  
  26         397  
265 12 100       221     return if $this+0 >= 0;
266              
267 2         32     require Carp;
268 2         32     &Carp::confess( _fail_msg($name) );
269             }
270              
271             =head2 assert_negative( $this [, $name ] )
272            
273             Asserts that the numeric value of I<$this> is less than zero.
274            
275             assert_negative( 0 ); # FAIL
276             assert_negative( -14 ); # pass
277             assert_negative( '14.' ); # FAIL
278            
279             =cut
280              
281             sub assert_negative($;$) {
282 13     13 1 243     my $this = shift;
283 13         120     my $name = shift;
284              
285 26     26   418     no warnings;
  26         235  
  26         436  
286 13 100       159     return if $this+0 < 0;
287              
288 10         156     require Carp;
289 10         124     &Carp::confess( _fail_msg($name) );
290             }
291              
292             =head2 assert_nonzero_integer( $this [, $name ] )
293            
294             Asserts that the numeric value of I<$this> is not zero, and that I<$this>
295             is an integer.
296            
297             assert_nonzero_integer( 0 ); # FAIL
298             assert_nonzero_integer( -14 ); # pass
299             assert_nonzero_integer( '14.' ); # FAIL
300            
301             =cut
302              
303             sub assert_nonzero_integer($;$) {
304 6     6 1 53     my $this = shift;
305 6         83     my $name = shift;
306              
307 6         63     assert_nonzero( $this, $name );
308 4         39     assert_integer( $this, $name );
309             }
310              
311             =head2 assert_positive_integer( $this [, $name ] )
312            
313             Asserts that the numeric value of I<$this> is greater than zero, and
314             that I<$this> is an integer.
315            
316             assert_positive_integer( 0 ); # FAIL
317             assert_positive_integer( -14 ); # FAIL
318             assert_positive_integer( '14.' ); # FAIL
319             assert_positive_integer( '14' ); # pass
320            
321             =cut
322              
323             sub assert_positive_integer($;$) {
324 7     7 1 62     my $this = shift;
325 7         58     my $name = shift;
326              
327 7         127     assert_positive( $this, $name );
328 4         41     assert_integer( $this, $name );
329             }
330              
331             =head2 assert_nonnegative_integer( $this [, $name ] )
332            
333             Asserts that the numeric value of I<$this> is not less than zero, and
334             that I<$this> is an integer.
335            
336             assert_nonnegative_integer( 0 ); # pass
337             assert_nonnegative_integer( -14 ); # pass
338             assert_nonnegative_integer( '14.' ); # FAIL
339            
340             =cut
341              
342             sub assert_nonnegative_integer($;$) {
343 6     6 1 56     my $this = shift;
344 6         52     my $name = shift;
345              
346 6         59     assert_nonnegative( $this, $name );
347 5         52     assert_integer( $this, $name );
348             }
349              
350             =head2 assert_negative_integer( $this [, $name ] )
351            
352             Asserts that the numeric value of I<$this> is less than zero, and that
353             I<$this> is an integer.
354            
355             assert_negative_integer( 0 ); # FAIL
356             assert_negative_integer( -14 ); # pass
357             assert_negative_integer( '14.' ); # FAIL
358            
359             =cut
360              
361             sub assert_negative_integer($;$) {
362 7     7 1 136     my $this = shift;
363 7         59     my $name = shift;
364              
365 7         77     assert_negative( $this, $name );
366 2         23     assert_integer( $this, $name );
367             }
368              
369             =head1 REFERENCE ASSERTIONS
370            
371             =head2 assert_isa( $this, $type [, $name ] )
372            
373             Asserts that I<$this> is an object of type I<$type>.
374            
375             =cut
376              
377             sub assert_isa($$;$) {
378 45     45 1 456     my $this = shift;
379 45         446     my $type = shift;
380 45         448     my $name = shift;
381              
382 45         441     assert_defined( $this, $name );
383              
384             # The assertion is true if
385             # 1) For objects, $this is of class $type or of a subclass of $type
386             # 2) For non-objects, $this is a reference to a HASH, SCALAR, ARRAY, etc.
387              
388 43         698     require Scalar::Util;
389              
390 43 100 66     723     return if Scalar::Util::blessed( $this ) && $this->isa( $type );
391 35 100       425     return if ref($this) eq $type;
392              
393 11         139     require Carp;
394 11         148     &Carp::confess( _fail_msg($name) );
395             }
396              
397              
398             =head2 assert_nonempty( $this [, $name ] )
399            
400             I<$this> must be a ref to either a hash or an array. Asserts that that
401             collection contains at least 1 element. Will assert (with its own message,
402             not I<$name>) unless given a hash or array ref. It is OK if I<$this> has
403             been blessed into objecthood, but the semantics of checking an object to see
404             if it has keys (for a hashref) or returns >0 in scalar context (for an array
405             ref) may not be what you want.
406            
407             assert_nonempty( 0 ); # FAIL
408             assert_nonempty( 'foo' ); # FAIL
409             assert_nonempty( undef ); # FAIL
410             assert_nonempty( {} ); # FAIL
411             assert_nonempty( [] ); # FAIL
412             assert_nonempty( {foo=>1} );# pass
413             assert_nonempty( [1,2,3] ); # pass
414            
415             =cut
416              
417             sub assert_nonempty($;$) {
418 7     7 1 64     my $ref = shift;
419 7         113     my $name = shift;
420              
421 7         64     my $type = ref $ref;
422 7 100       83     if ( $type eq "HASH" ) {
    100          
423 2         26         assert_positive( scalar keys %$ref, $name );
424                 }
425                 elsif ( $type eq "ARRAY" ) {
426 2         24         assert_positive( scalar @$ref, $name );
427                 }
428                 else {
429 3         33         assert_fail( "Not an array or hash reference" );
430                 }
431             }
432              
433             =head2 assert_nonref( $this [, $name ] )
434            
435             Asserts that I<$this> is not undef and not a reference.
436            
437             =cut
438              
439             sub assert_nonref($;$) {
440 61     61 1 581     my $this = shift;
441 61         751     my $name = shift;
442              
443 61         973     assert_defined( $this, $name );
444 57 100       632     return unless ref( $this );
445              
446 2         32     require Carp;
447 2         29     &Carp::confess( _fail_msg($name) );
448             }
449              
450             =head2 assert_hashref( $ref [,$name] )
451            
452             Asserts that I<$ref> is defined, and is a reference to a (possibly empty) hash.
453            
454             B<NB:> This method returns I<false> for objects, even those whose underlying
455             data is a hashref. This is as it should be, under the assumptions that:
456            
457             =over 4
458            
459             =item (a)
460            
461             you shouldn't rely on the underlying data structure of a particular class, and
462            
463             =item (b)
464            
465             you should use C<assert_isa> instead.
466            
467             =back
468            
469             =cut
470              
471             sub assert_hashref($;$) {
472 6     6 1 204     my $ref = shift;
473 6         52     my $name = shift;
474              
475 6         62     return assert_isa( $ref, 'HASH', $name );
476             }
477              
478             =head2 assert_listref( $ref [,$name] )
479            
480             Asserts that I<$ref> is defined, and is a reference to a (possibly empty) list.
481            
482             B<NB:> The same caveat about objects whose underlying structure is a
483             hash (see C<assert_hashref>) applies here; this method returns false
484             even for objects whose underlying structure is an array.
485            
486             =cut
487              
488             sub assert_listref($;$) {
489 7     7 1 203     my $ref = shift;
490 7         63     my $name = shift;
491              
492 7         77     return assert_isa( $ref, 'ARRAY', $name );
493             }
494              
495             =head1 SET AND HASH MEMBERSHIP
496            
497             =head2 assert_in( $string, \@inlist [,$name] );
498            
499             Asserts that I<$string> is defined and matches one of the elements
500             of I<\@inlist>.
501            
502             I<\@inlist> must be an array reference of defined strings.
503            
504             =cut
505              
506             sub assert_in($$;$) {
507 9     9 1 2390     my $string = shift;
508 9         140     my $arrayref = shift;
509 9         80     my $name = shift;
510              
511 9         94     assert_nonref( $string, $name );
512 8         79     assert_isa( $arrayref, 'ARRAY', $name );
513 6         50     foreach my $element (@{$arrayref}) {
  6         64  
514 14         121         assert_nonref( $element, $name );
515 14 100       156         return if $string eq $element;
516                 }
517 2         26     require Carp;
518 2         26     &Carp::confess( _fail_msg($name) );
519             }
520              
521             =head2 assert_exists( \%hash, $key [,$name] )
522            
523             =head2 assert_exists( \%hash, \@keylist [,$name] )
524            
525             Asserts that I<%hash> is indeed a hash, and that I<$key> exists in
526             I<%hash>, or that all of the keys in I<@keylist> exist in I<%hash>.
527            
528             assert_exists( \%custinfo, 'name', 'Customer has a name field' );
529            
530             assert_exists( \%custinfo, [qw( name addr phone )],
531             'Customer has name, address and phone' );
532            
533             =cut
534              
535             sub assert_exists($$;$) {
536 7     7 1 65     my $hash = shift;
537 7         63     my $key = shift;
538 7         60     my $name = shift;
539              
540 7         77     assert_isa( $hash, 'HASH', $name );
541 7 100       86     my @list = ref($key) ? @$key : ($key);
542              
543 7         126     for ( @list ) {
544 10 100       126         if ( !exists( $hash->{$_} ) ) {
545 3         36             require Carp;
546 3         39             &Carp::confess( _fail_msg($name) );
547                     }
548                 }
549             }
550              
551             =head2 assert_lacks( \%hash, $key [,$name] )
552            
553             =head2 assert_lacks( \%hash, \@keylist [,$name] )
554            
555             Asserts that I<%hash> is indeed a hash, and that I<$key> does NOT exist
556             in I<%hash>, or that none of the keys in I<@keylist> exist in I<%hash>.
557            
558             assert_lacks( \%users, 'root', 'Root is not in the user table' );
559            
560             assert_lacks( \%users, [qw( root admin nobody )], 'No bad usernames found' );
561            
562             =cut
563              
564             sub assert_lacks($$;$) {
565 6     6 1 58     my $hash = shift;
566 6         57     my $key = shift;
567 6         51     my $name = shift;
568              
569 6         62     assert_isa( $hash, 'HASH', $name );
570 6 100       68     my @list = ref($key) ? @$key : ($key);
571              
572 6         63     for ( @list ) {
573 8 100       97         if ( exists( $hash->{$_} ) ) {
574 2         90             require Carp;
575 2         27             &Carp::confess( _fail_msg($name) );
576                     }
577                 }
578             }
579              
580             =head1 UTILITY ASSERTIONS
581            
582             =head2 assert_fail( [$name] )
583            
584             Assertion that always fails. C<assert_fail($msg)> is exactly the same
585             as calling C<assert(0,$msg)>, but it eliminates that case where you
586             accidentally use C<assert($msg)>, which of course never fires.
587            
588             =cut
589              
590             sub assert_fail(;$) {
591 4     4 1 64     require Carp;
592 4         56     &Carp::confess( _fail_msg($_[0]) );
593             }
594              
595              
596             =head1 COPYRIGHT
597            
598             Copyright (c) 2005 Andy Lester. All rights reserved. This program is
599             free software; you can redistribute it and/or modify it under the same
600             terms as Perl itself.
601            
602             =head1 ACKNOWLEDGEMENTS
603            
604             Thanks to
605             Bob Diss,
606             Pete Krawczyk,
607             David Storrs,
608             Dan Friedman,
609             and Allard Hoeve
610             for code and fixes.
611            
612             =cut
613              
614             "I stood on the porch in a tie."
615