File Coverage

blib/lib/Scalar/IfDefined.pm
Criterion Covered Total %
statement 17 17 100.0
branch 2 2 100.0
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 26 26 100.0


line stmt bran cond sub pod time code
1             package Scalar::IfDefined;
2              
3 4     4   70909 use 5.006;
  4         15  
4 4     4   19 use strict;
  4         7  
  4         91  
5 4     4   26 use warnings;
  4         10  
  4         141  
6              
7 4     4   21 use Scalar::Util qw/blessed reftype/;
  4         7  
  4         481  
8              
9 4     4   21 use Exporter 'import';
  4         8  
  4         1196  
10             our @EXPORT_OK = qw/ifdef $ifdef/;
11              
12             =head1 NAME
13              
14             Scalar::IfDefined - Apply block to scalar depending on if it's defined.
15              
16             =cut
17              
18             our $VERSION = '0.06';
19              
20             =head1 SYNOPSIS
21              
22             use Scalar::IfDefined qw/ifdef/;
23              
24             my $hash = {
25             a => 1,
26             b => 2,
27             c => 3,
28             d => {
29             E => 1,
30             F => 2,
31             },
32             };
33              
34             ifdef { $_ + 1 } $hash->{a}; # ---> 2
35             ifdef { $_ + 1 } $hash->{missing}; # ---> undef
36             ifdef { $_ + 1 } ifdef { $_->{F} } $hash->{d}; # ---> 3
37             ifdef { $_ + 1 } ifdef { $_->{MISSING} } $hash->{d}; # ---> undef
38              
39              
40             # Or perhaps with Perl6::Flows
41              
42             use Perl6::Flows;
43             my $result = (
44             $hash->{a}
45             ==> ifdef { $_->{F} }
46             ==> ifdef { $_ + 1 }
47             ); # ---> 3
48              
49             =head1 EXPORT
50              
51             =over 4
52              
53             =item ifdef
54              
55             =item $ifdef
56              
57             =back
58              
59             =head1 SUBROUTINES/METHODS
60              
61             =head2 ifdef
62              
63             Takes a block and a scalar value.
64              
65             If the scalar value is undef, the block is ignored and undef is returned
66             straight away.
67              
68             If the scalar value is defined, then the block is evaluated with $_ as
69             the value passed in, and the result of the block is returned.
70              
71             =cut
72              
73             sub ifdef(&$) {
74 2     2 1 843 my ($block, $scalar) = @_;
75              
76 2 100       11 return $scalar if not defined $scalar;
77 1         6 return $block->($scalar) for $scalar;
78             }
79              
80             =head2 $ifdef
81              
82             Used to dereference a possibly-undef scalar.
83              
84             If the scalar is undef, returns undef.
85              
86             If the scalar is an object, the first argument is the method to call, and the
87             rest of the arguments are the method arguments.
88              
89             If the scalar is an array ref, the first argument is used to index into the
90             array.
91              
92             If the scalar is a hash ref, the first argument is used to access the hash.
93              
94             If the scalar is a code ref, the code ref is run with all the arguments.
95              
96             As a special case, if the first argument is a code ref, it will be run with the
97             scalar as the first argument and the other arguments as the rest. This form
98             allows you to use C<$ifdef> on a simple scalar - but you might be better off
99             with C itself for that.
100              
101             The following uses will all return undef if the C<$scalar> is undef, or The
102             Right Thing if not.
103              
104             # Run "method_name" on $obj, if $obj is defined.
105             $obj->$ifdef("method_name", "argument", "argument");
106              
107             # Run $coderef with two arguments if $coderef is defined.
108             $coderef->$ifdef("argument", "argument");
109              
110             # Lowercase the zeroth element of the arrayref, or undef if either of those
111             # things is undef.
112             $arrayref->$ifdef(0)->$ifdef(sub { lc });
113              
114             # Call "method_name" on $hashref->{object}, or return undef if either of
115             # those is undef
116             $hashref->$ifdef('object')->$ifdef('method_name');
117              
118             =cut
119              
120             our $ifdef = sub {
121             my $obj = shift;
122             my ($method, @args) = @_;
123              
124             return undef if not defined $obj;
125              
126             return $obj->$method(@args) if blessed $obj or reftype $method eq 'CODE';
127             return $obj->[$method] if reftype $obj eq 'ARRAY';
128             return $obj->{$method} if reftype $obj eq 'HASH';
129             return $obj->($method, @args) if reftype $obj eq 'CODE';
130              
131             die "Can't getdef on " . reftype $obj;
132             };
133              
134              
135             =head1 AUTHOR
136              
137             Nick Booker, C<< >>
138              
139             =head1 BUGS
140              
141             L
142              
143              
144             =head1 ACKNOWLEDGEMENTS
145              
146             =head2 Alastair McGowan-Douglas (ALTREUS)
147              
148             For developing the C<$ifdef> (coderef) form.
149              
150             =head1 LICENSE AND COPYRIGHT
151              
152             Copyright (C) 2015 Nick Booker
153              
154             This program is free software; you can redistribute it and/or modify it
155             under the terms of either: the GNU General Public License as published
156             by the Free Software Foundation; or the Artistic License.
157              
158             See http://dev.perl.org/licenses/ for more information.
159              
160              
161             =cut
162              
163             1; # End of Scalar::IfDefined