File Coverage

blib/lib/Alien/Taco/Util.pm
Criterion Covered Total %
statement 21 22 95.4
branch 10 12 83.3
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 36 39 92.3


line stmt bran cond sub pod time code
1             # Taco Perl utility module.
2             # Copyright (C) 2013 Graham Bell
3             #
4             # This program is free software: you can redistribute it and/or modify
5             # it under the terms of the GNU General Public License as published by
6             # the Free Software Foundation, either version 3 of the License, or
7             # (at your option) any later version.
8             #
9             # This program is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
13             #
14             # You should have received a copy of the GNU General Public License
15             # along with this program. If not, see .
16              
17             =head1 NAME
18              
19             Alien::Taco::Util - Taco Perl utility module
20              
21             =head1 DESCRIPTION
22              
23             This module contains utility subroutines used to implement the
24             Perl Taco client and server.
25              
26             =cut
27              
28             package Alien::Taco::Util;
29              
30 4     4   25149 use strict;
  4         11  
  4         444  
31              
32             our $VERSION = '0.001';
33              
34 4     4   23 use Exporter;
  4         8  
  4         171  
35 4     4   19 use base 'Exporter';
  4         9  
  4         2041  
36             our @EXPORT_OK = qw/filter_struct/;
37              
38             =head1 SUBROUTINES
39              
40             =over 4
41              
42             =item filter_struct($ref, $predicate, $function)
43              
44             Walk through the given data structure and replace each entry
45             for which the predicate is true with the result of applying the
46             function to it.
47              
48             =cut
49              
50             sub filter_struct {
51 6     6 1 37 my $x = shift;
52 6         10 my $pred = shift;
53 6         11 my $func = shift;
54              
55 6         14 my $type = ref $x;
56              
57 6 100       23 if ($type eq 'HASH') {
    50          
58 5         17 foreach my $k (keys %$x) {
59 7 100       38 if ($pred->($x->{$k})) {
    100          
60 4         56 $x->{$k} = $func->($x->{$k});
61             }
62             elsif (ref $x->{$k}) {
63 2         127 filter_struct($x->{$k}, $pred, $func);
64             }
65             }
66             }
67             elsif ($type eq 'ARRAY') {
68 1         6 for (my $i = 0; $i < scalar @$x; $i ++) {
69 3 100       23 if ($pred->($x->[$i])) {
    50          
70 1         8 $x->[$i] = $func->($x->[$i]);
71             }
72             elsif (ref $x->[$i]) {
73 0           filter_struct($x->[$i], $pred, $func);
74             }
75             }
76             }
77             }
78              
79             1;
80              
81             __END__