File Coverage

blib/lib/String/Replace.pm
Criterion Covered Total %
statement 81 86 94.1
branch 20 28 71.4
condition 17 33 51.5
subroutine 17 17 100.0
pod 4 4 100.0
total 139 168 82.7


line stmt bran cond sub pod time code
1             package String::Replace;
2             our $VERSION = '0.02';
3 1     1   843 use strict;
  1         3  
  1         36  
4 1     1   5 use warnings;
  1         3  
  1         27  
5 1     1   5 use Exporter 'import';
  1         1  
  1         86  
6 1     1   6 use Scalar::Util 'reftype', 'blessed';
  1         2  
  1         156  
7 1     1   1035 use List::MoreUtils 'natatime';
  1         1586  
  1         97  
8 1     1   9 use Carp;
  1         2  
  1         1506  
9              
10             our @EXPORT_OK = ('replace', 'unreplace');
11             our %EXPORT_TAGS = ('all' => [ @EXPORT_OK ] );
12              
13             sub __prepare_replace {
14 9     9   12 my @l;
15 9 100 66     79 if (@_ == 1 && ref($_[0]) && reftype($_[0]) eq 'HASH') {
    50 66        
      33        
      33        
16 3         6 @l = ( %{$_[0]} );
  3         13  
17             } elsif (@_ == 1 && ref($_[0]) && reftype($_[0]) eq 'ARRAY') {
18 0         0 @l = @{$_[0]};
  0         0  
19             } else {
20 6         17 @l = @_;
21             }
22              
23 9 50       25 croak 'The replace list must have an even number of element' if @l & 1;
24              
25 9         87 my $it = natatime 2, @l;
26              
27 9         13 my @repl;
28 9         54 while (my ($k, $v) = $it->()) {
29 18         373 push @repl, [qr{\Q$k\E}, $v];
30             }
31              
32 9         60 return \@repl;
33             }
34              
35             sub __prepare_unreplace {
36 4     4   5 my @l;
37 4 100 66     52 if (@_ == 1 && ref($_[0]) && reftype($_[0]) eq 'HASH') {
    50 66        
      33        
      33        
38 2         3 @l = ( %{$_[0]} );
  2         8  
39             } elsif (@_ == 1 && ref($_[0]) && reftype($_[0]) eq 'ARRAY') {
40 0         0 @l = @{$_[0]};
  0         0  
41             } else {
42 2         6 @l = @_;
43             }
44              
45 4 50       12 croak 'The replace list must have an even number of element' if @l & 1;
46              
47 4         20 my $it = natatime 2, @l;
48              
49 4         5 my @repl;
50 4         21 while (my ($k, $val) = $it->()) {
51 8 50 33     30 my @lv = (ref $val && reftype $val eq 'ARRAY') ? @{$val} : $val;
  0         0  
52 8         12 for my $v (@lv) {
53 8         171 push @repl, [qr{\Q$v\E}, $k];
54             }
55             }
56              
57 4         23 return \@repl;
58             }
59              
60             # This function is the same for replace and unreplace.
61             sub __execute_replace {
62 23     23   52 my ($str, $repl) = @_;
63              
64 22         48 for my $e (@{$repl}) {
  22         68  
65 44         43 my ($re, $v) = @{$e};
  44         78  
66 44         252 $str =~ s/$re/$v/g;
67             }
68              
69 22         154 return $str;
70             }
71              
72             sub __execute_replace_in {
73 2     2   5 my (undef, $repl) = @_;
74              
75 2         3 for my $e (@{$repl}) {
  2         4  
76 4         5 my ($re, $v) = @{$e};
  4         8  
77 4         21 $_[0] =~ s/$re/$v/g;
78             }
79              
80 2         6 return;
81             }
82              
83              
84             sub new {
85 2     2 1 328 my ($class, @param) = @_;
86            
87 2         8 my $self = __prepare_replace(@param);
88              
89 2         11 return bless $self, $class;
90             }
91              
92             sub new_unreplace {
93 2     2 1 13 my ($class, @param) = @_;
94            
95 2         8 my $self = __prepare_unreplace(@param);
96              
97 2         9 return bless $self, $class;
98             }
99              
100              
101             sub __replace_method {
102 12     12   17 my $repl = shift;
103            
104 12 100       27 if (wantarray) {
    100          
105 5         9 return map { __execute_replace($_, $repl) } @_;
  8         16  
106             } elsif (defined wantarray) {
107 6 50       17 return @_ ? __execute_replace($_[0], $repl) : undef;
108             } else {
109 1         5 __execute_replace_in($_, $repl) for @_;
110 1         3 return;
111             }
112             }
113              
114             sub __replace_fun {
115 7     7   23 my ($str, @list) = @_;
116              
117 7         19 return __execute_replace($str, __prepare_replace(@list))
118             }
119              
120             sub __unreplace_fun {
121 2     2   5 my ($str, @list) = @_;
122              
123 2         5 return __execute_replace($str, __prepare_unreplace(@list))
124             }
125              
126             sub replace {
127 17 50   17 1 4763 croak 'Missing argument to '.__PACKAGE__.'::replace' unless @_;
128              
129 17 100 66     123 if (blessed($_[0]) && $_[0]->isa(__PACKAGE__)) {
130 10         18 return &__replace_method;
131             } else {
132 7         14 return &__replace_fun;
133             }
134             }
135              
136             sub unreplace {
137 4 50   4 1 11 croak 'Missing argument to '.__PACKAGE__.'::unreplace' unless @_;
138              
139 4 100 66     29 if (blessed($_[0]) && $_[0]->isa(__PACKAGE__)) {
140 2         6 return &__replace_method;
141             } else {
142 2         5 return &__unreplace_fun;
143             }
144             }
145              
146             1;
147              
148             =encoding utf-8
149              
150             =head1 NAME
151              
152             String::Replace - Performs arbitrary replacement in strings
153              
154             =head1 SYNOPSIS
155              
156             use String::Replace ':all';
157            
158             print replace('hello name', 'name' => 'world');
159             print unreplace('hello world', {'name' => 'world'});
160            
161             my $r = String::Replace->new('name' => 'world');
162             print $r->replace('hello world');
163              
164             =head1 DESCRIPTION
165              
166             C is a small module allowing to performs arbitrary replacement
167             in strings. Arbitrary means that there is no specific syntax to do so, you can
168             just replace any arbitrary substring.
169              
170             The real functionnality of C is its OO interface which allows
171             you to prepare and encapsulate replacement to be performed in string. While other
172             templating systems (all of them ?) allow you to load a template and then to
173             perform successive series of replacement in it, C allows you to
174             load a serie of replacement and then apply them successively to many template.
175             If this is what you need to do, your code will be simpler to read with C
176             and maybe slighly faster due to the preprocessing which can be done.
177              
178             Standard templating systems are typically used to generate the same web page many
179             times for different users. C is rather used to generate a lot
180             of different content for a single user, or to provide a simple parametrisation
181             system for code (as is done with SQL in my C module).
182              
183             =head1 FUNCTIONS
184              
185             This is a list of the public function of this library. Functions not listed here
186             are for internal use only by this module and should not be used in any external
187             code.
188              
189             Each function of this library (that is C and C) may be
190             exported on request. There is also a C<':all'> tag to get everything at once.
191             Just do :
192              
193             use String::Replace ':all';
194              
195             to have all the functions of the library imported into your current package.
196              
197             =head2 replace
198              
199             my $s = replace(EXPR, LIST);
200             my $s = replace(EXPR, HASH);
201              
202             The C function take a string and a list of replacement to perform in the
203             string and return a string where all replacement have been done. the replacement
204             can be given either as list or as a hash reference.
205              
206             replace('this is a string', 'this' => 'that', 'string' => 'chair');
207             replace('this is a string', { 'this' => 'that', 'string' => 'chair' });
208              
209             will both return the string C<'that is a chair'>.
210              
211             You should not that the replacement will be executed in the order in which they
212             appear if you give a list but in no particular order if you give a hash reference.
213             So if a replacement creates a substring that may be replaced by an other replacement
214             then you should use a list of replacement to be sure of what will be happening.
215              
216             =head2 unreplace
217              
218             my $s = replace(I, I);
219             my $s = replace(I, I);
220              
221             Performs the opposite of the C function.
222              
223             replace('that is a chair', 'this' => 'that', 'string' => 'chair');
224             replace('that is a chair', { 'this' => 'that', 'string' => 'chair' });
225              
226             will both return the string C<'this is a string'>. The same caveat than for the
227             C function will apply.
228              
229             =head1 Object-Oriented interface
230              
231             If you wish so, you may also use an object oriented interface to C.
232             The object oriented interface will be (slightly) faster than the functionnal one
233             if you have many strings on which you will perform the same replacement (as some
234             regexp can be pre-compiled).
235              
236             =head2 new
237              
238             my $r = String::Replace->new(I);
239             my $r = String::Replace->new(I);
240              
241             This constructor may be called with either a list of replacement to performs or
242             a reference to a hash describing these replacements. The argument is treated in
243             the same way as the second argument to the C function. When created,
244             the C method may then be called on the object.
245              
246             The code:
247              
248             my $r = String::Replace->new('this' => 'that', 'string' => 'chair');
249             $r->replace('this is a string');
250              
251             will return the same thing than the example above but the C<$r> object might be
252             reused.
253              
254             The same caveat as for the order of the argument to the C function apply
255             for this constructor.
256              
257             =head2 new_unreplace
258              
259             my $u = String::Replace->new_unreplace(I);
260             my $u = String::Replace->new_unreplace(I);
261              
262             This constructor may be called with either a list of replacement a reference to
263             a hash describing replacements. The argument is treated in the same way as the
264             second argument to the C function. When created, the C method
265             may then be called on the object the execute this I.
266              
267             The code:
268              
269             my $u = String::Replace->new_unreplace('this' => 'that', 'string' => 'chair');
270             $u->replace('that is a chair');
271              
272             will return the same thing than the example above but the C<$u> object might be
273             reused.
274              
275             The same caveat as for the order of the argument to the C function apply
276             for this constructor.
277              
278             =head2 replace
279              
280             my $s = $r->replace(I);
281             my @l = $r->replace(I);
282             $r->replace(I);
283              
284             This function performs a prepared replacement or I as described
285             in the documentation of the C and C constructors.
286              
287             This function is context sensitive: if it is called in list context, it will
288             apply its replacement in turn to each of its argument and returns a list with
289             each string where the replacement has been done. If it is called in sink (void)
290             context, then the replacement are executed in place. If called in scalar context
291             only the first argument of the C function is taken and replaced and the
292             result of this replacement is returned.
293              
294             The same apply if the object was prepared with C instead of C.
295              
296             =head2 unreplace
297              
298             $r->unreplace(LIST);
299              
300             This method is exactly the same as the C one and will not distinguish
301             between object created with the C or the C functions. It is
302             provided only for convenience.
303              
304             =head1 CAVEATS
305              
306             As stated above, the order in which the arguments are provided to the functions
307             of this library may matter. To avoid problem, you should use a non-ambiguous
308             parametrisation scheme (like prefixing all your variable to be replaced with a
309             given character).
310              
311             If this a problem for you, there is a safe version of this library: C>.
312             This version will performs all its replacement atomically so the order of the
313             argument does not matter. However the speed of this version will be approximately
314             half that of the C version (according to my test, this does not
315             depend much on the size of the string, the number of replacement that you want
316             to perform or the number of replacement actually performed).
317              
318             In an unambiguous case, the two version of this library should give back exactly
319             the same results.
320              
321             =head1 BUGS
322              
323             Please report any bugs or feature requests to C, or
324             through the web interface at L.
325              
326             =head1 SEE ALSO
327              
328             There is a safer (and slower) version of this library: C>.
329              
330             There is also a lot of templating system on CPAN and a lot of them could let you
331             achieve the same thing than C (with the caveat that they are
332             all centered around the template and not around the replace operation). Some
333             simple and efficient modules are the followings: C>
334             and C>.
335              
336             =head1 AUTHOR
337              
338             Mathias Kende (mathias@cpan.org)
339              
340             =head1 VERSION
341              
342             Version 0.02 (January 2013)
343              
344             =head1 COPYRIGHT & LICENSE
345              
346             Copyright 2013 © Mathias Kende. All rights reserved.
347              
348             This program is free software; you can redistribute it and/or
349             modify it under the same terms as Perl itself.
350              
351             =cut
352              
353              
354              
355