File Coverage

blib/lib/Text/Xslate/Bridge/Star.pm
Criterion Covered Total %
statement 43 46 93.4
branch 29 36 80.5
condition 0 3 0.0
subroutine 13 13 100.0
pod 8 8 100.0
total 93 106 87.7


line stmt bran cond sub pod time code
1             package Text::Xslate::Bridge::Star;
2 1     1   5 use strict;
  1         2  
  1         28  
3 1     1   6 use warnings;
  1         1  
  1         28  
4 1     1   5 use parent qw(Text::Xslate::Bridge);
  1         2  
  1         7  
5              
6             BEGIN {
7 1 50   1   150 if(my $code = re->can('is_regexp')) {
8 1         515 *_is_rx = $code;
9             }
10             else {
11 0         0 require Scalar::Util;
12             *_is_rx = sub {
13 0   0     0 return Scalar::Util::blessed($_[0])
14             && $_[0]->isa('Regexp');
15 0         0 };
16             }
17             }
18              
19             sub lc {
20 3 100   3 1 24 return defined($_[0]) ? CORE::lc($_[0]) : undef;
21             }
22              
23             sub uc {
24 3 100   3 1 36 return defined($_[0]) ? CORE::uc($_[0]) : undef;
25             }
26              
27             sub substr {
28 4     4 1 7 my($str, $offset, $length) = @_;
29 4 100       15 return undef unless defined $str;
30 3 50       7 $offset = 0 unless defined $offset;
31 3 100       9 $length = length($str) unless defined $length;
32 3         62 return CORE::substr($str, $offset, $length);
33             }
34              
35              
36             sub sprintf {
37 2     2 1 4 my $fmt = shift;
38 2 50       7 return undef unless defined $fmt;
39 2 100       206 if(@_) { # sprintf($fmt, ...)
40 1         14 return sprintf $fmt, @_;
41             }
42             else { # $x | sprintf('%.02f')
43             return sub {
44 1     1   25 sprintf $fmt, @_;
45 1         7 };
46             }
47             }
48              
49             sub rx {
50 6 50   6 1 85 return defined($_[0]) ? qr/$_[0]/ : undef;
51             }
52              
53             sub match {
54 5     5 1 11 my($str, $pattern) = @_;
55 5 100       18 return undef unless defined $str;
56 4 50       8 return undef unless defined $pattern;
57              
58 4 100       16 $pattern = quotemeta($pattern) unless _is_rx($pattern);
59 4         67 return scalar($str =~ m/$pattern/);
60             }
61              
62             sub replace {
63 4     4 1 10 my($str, $pattern, $replacement) = @_;
64 4 50       12 return undef unless defined $str;
65 4 50       9 return undef unless defined $pattern;
66              
67 4 100       17 $pattern = quotemeta($pattern) unless _is_rx($pattern);
68 4         55 $str =~ s/$pattern/$replacement/g;
69 4         32 return $str;
70             }
71              
72             sub split {
73 6     6 1 15 my($str,$pattern,$limit) = @_;
74 6 100       17 if (!defined $pattern) {
75 1         3 $pattern = ' ';
76             }
77 6 100       23 $pattern = quotemeta($pattern) unless _is_rx($pattern);
78 6 100       13 if (defined $limit) {
79 1         21 return [CORE::split($pattern, $str, $limit)];
80             } else {
81 5         93 return [CORE::split($pattern, $str)];
82             }
83             }
84              
85             my %scalar_methods = (
86             lc => \&lc,
87             uc => \&uc,
88             substr => \&substr,
89             sprintf => \&sprintf,
90             rx => \&rx,
91             match => \&match,
92             replace => \&replace,
93             split => \&split,
94             );
95              
96             __PACKAGE__->bridge(
97             # nil => \%nil_methods,
98             scalar => \%scalar_methods,
99             # array => \%array_methods,
100             # hash => \%hash_methods,
101              
102             function => \%scalar_methods,
103             );
104              
105             1;
106             __END__