File Coverage

blib/lib/Templ/Util.pm
Criterion Covered Total %
statement 52 62 83.8
branch 8 10 80.0
condition n/a
subroutine 14 17 82.3
pod 0 9 0.0
total 74 98 75.5


line stmt bran cond sub pod time code
1             package Templ::Util;
2              
3             require Exporter;
4             our @ISA = qw(Exporter);
5             our @EXPORT_OK
6             = qw(attempt quote unquote default indent undent number_lines headerize expand_isa);
7              
8 1     1   5 use strict;
  1         1  
  1         23  
9 1     1   5 use warnings;
  1         1  
  1         26  
10              
11 1     1   4 use Carp qw(croak);
  1         2  
  1         266  
12              
13             # Run a block of code, return 0 if the code died, 1 if it didn't
14             sub attempt (&) {
15 2     2 0 3 my $sub = shift;
16 2         4 eval { $sub->(); };
  2         6  
17 2 100       16 return $@ ? 0 : 1;
18             }
19              
20             # Escapes a single-quoted string
21             sub quote ($) {
22 4     4 0 8 my $str = shift;
23 4         8 $str =~ s|\\|\\\\|gs;
24 4         12 $str =~ s|'|\\'|gs;
25 4         15 return $str;
26             }
27              
28             # Escapes a single-quoted string
29             sub unquote ($) {
30 18     18 0 34 my $str = shift;
31 18         28 $str =~ s|\\\\|\\|gs;
32 18         28 $str =~ s|\\'|'|gs;
33 18         46 return $str;
34             }
35              
36             # Returns the first defined value in a list, or a blank string if there are
37             # no defined values
38             sub default (@) {
39 51 100   51 0 92 foreach (@_) { defined($_) && return $_; }
  123         441  
40 0         0 return '';
41             }
42              
43             sub undent ($) {
44 1     1   4 no warnings 'uninitialized';
  1         2  
  1         177  
45 1 50   1 0 413 return $_[0] if ( $_[0] !~ m/^(?:\r?\n)*([ \t]+)/ );
46 1         3 my $i = $1;
47 1         11 return join '', map { s/^\Q$i\E//; $_ } grep { $_ ne '' }
  5         27  
  5         14  
  10         19  
48             split /(.*?\n)/, $_[0];
49             }
50              
51             sub indent ($$) {
52 1     1   4 no warnings 'uninitialized';
  1         2  
  1         103  
53 0     0 0 0 return join '', map {"$_[0]$_"} grep { $_ ne '' } split /(.*?\n)/, $_[1];
  0         0  
  0         0  
54             }
55              
56             sub headerize ($$) {
57 1     1   5 no warnings 'uninitialized';
  1         2  
  1         101  
58 0     0 0 0 return join '', map {"$_[0]$_\n"} split /\n/, $_[1];
  0         0  
59             }
60              
61             sub number_lines ($) {
62 1     1   5 no warnings 'uninitialized';
  1         2  
  1         129  
63 0     0 0 0 my @lines = split /\n/, $_[0];
64 0         0 my $format = '%' . length( scalar(@lines) . '' ) . "s: %s\n";
65 0         0 return join '', map { sprintf( $format, ( $_ + 1 ), $lines[$_] ) }
  0         0  
66             0 .. $#lines;
67             }
68              
69             # Inspired by Class::ISA::self_and_super_path
70             sub expand_isa {
71 1     1   5 no strict 'refs';
  1         1  
  1         154  
72 38 100   38 0 88 my $seen = ref($_[0]) eq 'HASH' ? shift @_ : {};
73             return
74 72         89 map { s/^::/main::/; $_ }
  72         162  
75 72 50       299 grep { defined($_) && $_ ne '' }
76 30         38 map { $_, expand_isa( $seen, @{ $_ . '::ISA' } ) }
  30         119  
77 38         73 grep { !$seen->{$_}++ }
  30         97  
78             @_;
79             }
80              
81             1;