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   4 use strict;
  1         2  
  1         26  
3 1     1   4 use warnings;
  1         2  
  1         27  
4 1     1   5 use parent qw(Text::Xslate::Bridge);
  1         1  
  1         30  
5              
6             BEGIN {
7 1 50   1   123 if(my $code = re->can('is_regexp')) {
8 1         660 *_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 25 return defined($_[0]) ? CORE::lc($_[0]) : undef;
21             }
22              
23             sub uc {
24 3 100   3 1 47 return defined($_[0]) ? CORE::uc($_[0]) : undef;
25             }
26              
27             sub substr {
28 4     4 1 9 my($str, $offset, $length) = @_;
29 4 100       15 return undef unless defined $str;
30 3 50       8 $offset = 0 unless defined $offset;
31 3 100       7 $length = length($str) unless defined $length;
32 3         86 return CORE::substr($str, $offset, $length);
33             }
34              
35              
36             sub sprintf {
37 2     2 1 5 my $fmt = shift;
38 2 50       7 return undef unless defined $fmt;
39 2 100       183 if(@_) { # sprintf($fmt, ...)
40 1         13 return sprintf $fmt, @_;
41             }
42             else { # $x | sprintf('%.02f')
43             return sub {
44 1     1   23 sprintf $fmt, @_;
45 1         28 };
46             }
47             }
48              
49             sub rx {
50 6 50   6 1 91 return defined($_[0]) ? qr/$_[0]/ : undef;
51             }
52              
53             sub match {
54 5     5 1 12 my($str, $pattern) = @_;
55 5 100       20 return undef unless defined $str;
56 4 50       8 return undef unless defined $pattern;
57              
58 4 100       18 $pattern = quotemeta($pattern) unless _is_rx($pattern);
59 4         63 return scalar($str =~ m/$pattern/);
60             }
61              
62             sub replace {
63 4     4 1 9 my($str, $pattern, $replacement) = @_;
64 4 50       11 return undef unless defined $str;
65 4 50       11 return undef unless defined $pattern;
66              
67 4 100       15 $pattern = quotemeta($pattern) unless _is_rx($pattern);
68 4         49 $str =~ s/$pattern/$replacement/g;
69 4         32 return $str;
70             }
71              
72             sub split {
73 6     6 1 13 my($str,$pattern,$limit) = @_;
74 6 100       16 if (!defined $pattern) {
75 1         2 $pattern = ' ';
76             }
77 6 100       21 $pattern = quotemeta($pattern) unless _is_rx($pattern);
78 6 100       14 if (defined $limit) {
79 1         22 return [CORE::split($pattern, $str, $limit)];
80             } else {
81 5         98 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__