#============================================================= -*-Perl-*- # # Template::Plugin::String # # DESCRIPTION # Template Toolkit plugin to implement a basic String object. # # AUTHOR # Andy Wardley <abw@wardley.org> # # COPYRIGHT # Copyright (C) 2001-2022 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # #============================================================================ package Template::Plugin::String; use strict; use warnings; use base 'Template::Plugin'; use Template::Exception; use overload q|""| => "text", fallback => 1; our $VERSION = '3.100'; our $ERROR = ''; *centre = \*center; *append = \*push; *prepend = \*unshift; #------------------------------------------------------------------------ sub new { my ($class, @args) = @_; my $context = ref $class ? undef : shift(@args); my $config = @args && ref $args[-1] eq 'HASH' ? pop(@args) : { }; $class = ref($class) || $class; my $text = defined $config->{ text } ? $config->{ text } : (@args ? shift(@args) : ''); # print STDERR "text: [$text]\n"; # print STDERR "class: [$class]\n"; my $self = bless { text => $text, filters => [ ], _CONTEXT => $context, }, $class; my $filter = $config->{ filter } || $config->{ filters }; # install any output filters specified as 'filter' or 'filters' option $self->output_filter($filter) if $filter; return $self; } sub text { my $self = shift; return $self->{ text } unless @{ $self->{ filters } }; my $text = $self->{ text }; my $context = $self->{ _CONTEXT }; foreach my $dispatch (@{ $self->{ filters } }) { my ($name, $args) = @$dispatch; my $code = $context->filter($name, $args) || $self->throw($context->error()); $text = &$code($text); } return $text; } sub copy { my $self = shift; $self->new($self->{ text }); } sub throw { my $self = shift; die (Template::Exception->new('String', join('', @_))); } #------------------------------------------------------------------------ # output_filter($filter) # # Install automatic output filter(s) for the string. $filter can a list: # [ 'name1', 'name2' => [ ..args.. ], name4 => { ..args.. } ] or a hash # { name1 => '', name2 => [ args ], name3 => { args } } #------------------------------------------------------------------------ sub output_filter { my ($self, $filter) = @_; my ($name, $args, $dispatch); my $filters = $self->{ filters }; my $count = 0; if (ref $filter eq 'HASH') { $filter = [ %$filter ]; } elsif (ref $filter ne 'ARRAY') { $filter = [ split(/\s*\W+\s*/, $filter) ]; } while (@$filter) { $name = shift @$filter; # args may follow as a reference (or empty string, e.g. { foo => '' } if (@$filter && (ref($filter->[0]) || ! length $filter->[0])) { $args = shift @$filter; if ($args) { $args = [ $args ] unless ref $args eq 'ARRAY'; } else { $args = [ ]; } } else { $args = [ ]; } # $self->DEBUG("adding output filter $name(@$args)\n"); push(@$filters, [ $name, $args ]); $count++; } return ''; } #------------------------------------------------------------------------ sub push { my $self = shift; $self->{ text } .= join('', @_); return $self; } sub unshift { my $self = shift; $self->{ text } = join('', @_) . $self->{ text }; return $self; } sub pop { my $self = shift; my $strip = shift || return $self; $self->{ text } =~ s/$strip$//; return $self; } sub shift { my $self = shift; my $strip = shift || return $self; $self->{ text } =~ s/^$strip//; return $self; } #------------------------------------------------------------------------ sub center { my ($self, $width) = @_; my $text = $self->{ text }; my $len = length $text; $width ||= 0; if ($len < $width) { my $lpad = int(($width - $len) / 2); my $rpad = $width - $len - $lpad; $self->{ text } = (' ' x $lpad) . $self->{ text } . (' ' x $rpad); } return $self; } sub left { my ($self, $width) = @_; my $len = length $self->{ text }; $width ||= 0; $self->{ text } .= (' ' x ($width - $len)) if $width > $len; return $self; } sub right { my ($self, $width) = @_; my $len = length $self->{ text }; $width ||= 0; $self->{ text } = (' ' x ($width - $len)) . $self->{ text } if $width > $len; return $self; } sub format { my ($self, $format) = @_; $format = '%s' unless defined $format; $self->{ text } = sprintf($format, $self->{ text }); return $self; } sub filter { my ($self, $name, @args) = @_; my $context = $self->{ _CONTEXT }; my $code = $context->filter($name, \@args) || $self->throw($context->error()); return &$code($self->{ text }); } #------------------------------------------------------------------------ sub upper { my $self = CORE::shift; $self->{ text } = uc $self->{ text }; return $self; } sub lower { my $self = CORE::shift; $self->{ text } = lc $self->{ text }; return $self; } sub capital { my $self = CORE::shift; $self->{ text } =~ s/^(.)/\U$1/; return $self; } #------------------------------------------------------------------------ sub chop { my $self = CORE::shift; chop $self->{ text }; return $self; } sub chomp { my $self = CORE::shift; chomp $self->{ text }; return $self; } sub trim { my $self = CORE::shift; for ($self->{ text }) { s/^\s+//; s/\s+$//; } return $self; } sub collapse { my $self = CORE::shift; for ($self->{ text }) { s/^\s+//; s/\s+$//; s/\s+/ /g } return $self; } #------------------------------------------------------------------------ sub length { my $self = CORE::shift; return length $self->{ text }; } sub truncate { my ($self, $length, $suffix) = @_; return $self unless defined $length; $suffix ||= ''; return $self if CORE::length $self->{ text } <= $length; $self->{ text } = CORE::substr($self->{ text }, 0, $length - CORE::length($suffix)) . $suffix; return $self; } sub substr { my ($self, $offset, $length, $replacement) = @_; $offset ||= 0; if(defined $length) { if (defined $replacement) { my $removed = CORE::substr( $self->{text}, $offset, $length ); CORE::substr( $self->{text}, $offset, $length ) = $replacement; return $removed; } else { return CORE::substr( $self->{text}, $offset, $length ); } } else { return CORE::substr( $self->{text}, $offset ); } } sub repeat { my ($self, $n) = @_; return $self unless defined $n; $self->{ text } = $self->{ text } x $n; return $self; } sub replace { my ($self, $search, $replace) = @_; return $self unless defined $search; $replace = '' unless defined $replace; $self->{ text } =~ s/$search/$replace/g; return $self; } sub remove { my ($self, $search) = @_; $search = '' unless defined $search; $self->{ text } =~ s/$search//g; return $self; } sub split { my $self = CORE::shift; my $split = CORE::shift; my $limit = CORE::shift || 0; $split = '\s+' unless defined $split; return [ split($split, $self->{ text }, $limit) ]; } sub search { my ($self, $pattern) = @_; return $self->{ text } =~ /$pattern/; } sub equals { my ($self, $comparison) = @_; return $self->{ text } eq $comparison; } 1; __END__ =head1 NAME Template::Plugin::String - Object oriented interface for string manipulation =head1 SYNOPSIS # create String objects via USE directive [% USE String %] [% USE String 'initial text' %] [% USE String text => 'initial text' %] # or from an existing String via new() [% newstring = String.new %] [% newstring = String.new('newstring text') %] [% newstring = String.new( text => 'newstring text' ) %] # or from an existing String via copy() [% newstring = String.copy %] # append text to string [% String.append('text to append') %] # format left, right or center/centre padded [% String.left(20) %] [% String.right(20) %] [% String.center(20) %] # American spelling [% String.centre(20) %] # European spelling # and various other methods... =head1 DESCRIPTION This module implements a C<String> class for doing stringy things to text in an object-oriented way. You can create a C<String> object via the C<USE> directive, adding any initial text value as an argument or as the named parameter C<text>. [% USE String %] [% USE String 'initial text' %] [% USE String text='initial text' %] The object created will be referenced as C<String> by default, but you can provide a different variable name for the object to be assigned to: [% USE greeting = String 'Hello World' %] Once you've got a C<String> object, you can use it as a prototype to create other C<String> objects with the C<new()> method. [% USE String %] [% greeting = String.new('Hello World') %] The C<new()> method also accepts an initial text string as an argument or the named parameter C<text>. [% greeting = String.new( text => 'Hello World' ) %] You can also call C<copy()> to create a new C<String> as a copy of the original. [% greet2 = greeting.copy %] The C<String> object has a C<text()> method to return the content of the string. [% greeting.text %] However, it is sufficient to simply print the string and let the overloaded stringification operator call the C<text()> method automatically for you. [% greeting %] Thus, you can treat C<String> objects pretty much like any regular piece of text, interpolating it into other strings, for example: [% msg = "It printed '$greeting' and then dumped core\n" %] You also have the benefit of numerous other methods for manipulating the string. [% msg.append("PS Don't eat the yellow snow") %] Note that all methods operate on and mutate the contents of the string itself. If you want to operate on a copy of the string then simply take a copy first: [% msg.copy.append("PS Don't eat the yellow snow") %] These methods return a reference to the C<String> object itself. This allows you to chain multiple methods together. [% msg.copy.append('foo').right(72) %] It also means that in the above examples, the C<String> is returned which causes the C<text()> method to be called, which results in the new value of the string being printed. To suppress printing of the string, you can use the C<CALL> directive. [% foo = String.new('foo') %] [% foo.append('bar') %] # prints "foobar" [% CALL foo.append('bar') %] # nothing =head1 CONSTRUCTOR METHODS These methods are used to create new C<String> objects. =head2 new() Creates a new string using an initial value passed as a positional argument or the named parameter C<text>. [% USE String %] [% msg = String.new('Hello World') %] [% msg = String.new( text => 'Hello World' ) %] =head2 copy() Creates a new C<String> object which contains a copy of the original string. [% msg2 = msg.copy %] =head1 INSPECTOR METHODS These methods are used to examine the string. =head2 text() Returns the internal text value of the string. The stringification operator is overloaded to call this method. Thus the following are equivalent: [% msg.text %] [% msg %] =head2 length() Returns the length of the string. [% USE String("foo") %] [% String.length %] # => 3 =head2 search($pattern) Searches the string for the regular expression specified in C<$pattern> returning true if found or false otherwise. [% item = String.new('foo bar baz wiz waz woz') %] [% item.search('wiz') ? 'WIZZY! :-)' : 'not wizzy :-(' %] =head2 split($pattern, $limit) Splits the string based on the delimiter C<$pattern> and optional C<$limit>. Delegates to Perl's internal C<split()> so the parameters are exactly the same. [% FOREACH item.split %] ... [% END %] [% FOREACH item.split('baz|waz') %] ... [% END %] =head1 MUTATOR METHODS These methods modify the internal value of the string. For example: [% USE str=String('foobar') %] [% str.append('.html') %] # str => 'foobar.html' The value of C<str> is now 'C<foobar.html>'. If you don't want to modify the string then simply take a copy first. [% str.copy.append('.html') %] These methods all return a reference to the C<String> object itself. This has two important benefits. The first is that when used as above, the C<String> object 'C<str>' returned by the C<append()> method will be stringified with a call to its C<text()> method. This will return the newly modified string content. In other words, a directive like: [% str.append('.html') %] will update the string and also print the new value. If you just want to update the string but not print the new value then use C<CALL>. [% CALL str.append('.html') %] The other benefit of these methods returning a reference to the C<String> is that you can chain as many different method calls together as you like. For example: [% String.append('.html').trim.format(href) %] Here are the methods: =head2 push($suffix, ...) / append($suffix, ...) Appends all arguments to the end of the string. The C<append()> method is provided as an alias for C<push()>. [% msg.push('foo', 'bar') %] [% msg.append('foo', 'bar') %] =head2 pop($suffix) Removes the suffix passed as an argument from the end of the String. [% USE String 'foo bar' %] [% String.pop(' bar') %] # => 'foo' =head2 unshift($prefix, ...) / prepend($prefix, ...) Prepends all arguments to the beginning of the string. The C<prepend()> method is provided as an alias for C<unshift()>. [% msg.unshift('foo ', 'bar ') %] [% msg.prepend('foo ', 'bar ') %] =head2 shift($prefix) Removes the prefix passed as an argument from the start of the String. [% USE String 'foo bar' %] [% String.shift('foo ') %] # => 'bar' =head2 left($pad) If the length of the string is less than C<$pad> then the string is left formatted and padded with spaces to C<$pad> length. [% msg.left(20) %] =head2 right($pad) As per L<left()> but right padding the C<String> to a length of C<$pad>. [% msg.right(20) %] =head2 center($pad) / centre($pad) As per L<left()> and L<right()> but formatting the C<String> to be centered within a space padded string of length C<$pad>. The C<centre()> method is provided as an alias for C<center()>. [% msg.center(20) %] # American spelling [% msg.centre(20) %] # European spelling =head2 format($format) Apply a format in the style of C<sprintf()> to the string. [% USE String("world") %] [% String.format("Hello %s\n") %] # => "Hello World\n" =head2 upper() Converts the string to upper case. [% USE String("foo") %] [% String.upper %] # => 'FOO' =head2 lower() Converts the string to lower case [% USE String("FOO") %] [% String.lower %] # => 'foo' =head2 capital() Converts the first character of the string to upper case. [% USE String("foo") %] [% String.capital %] # => 'Foo' The remainder of the string is left untouched. To force the string to be all lower case with only the first letter capitalised, you can do something like this: [% USE String("FOO") %] [% String.lower.capital %] # => 'Foo' =head2 chop() Removes the last character from the string. [% USE String("foop") %] [% String.chop %] # => 'foo' =head2 chomp() Removes the trailing newline from the string. [% USE String("foo\n") %] [% String.chomp %] # => 'foo' =head2 trim() Removes all leading and trailing whitespace from the string [% USE String(" foo \n\n ") %] [% String.trim %] # => 'foo' =head2 collapse() Removes all leading and trailing whitespace and collapses any sequences of multiple whitespace to a single space. [% USE String(" \n\r \t foo \n \n bar \n") %] [% String.collapse %] # => "foo bar" =head2 truncate($length, $suffix) Truncates the string to C<$length> characters. [% USE String('long string') %] [% String.truncate(4) %] # => 'long' If C<$suffix> is specified then it will be appended to the truncated string. In this case, the string will be further shortened by the length of the suffix to ensure that the newly constructed string complete with suffix is exactly C<$length> characters long. [% USE msg = String('Hello World') %] [% msg.truncate(8, '...') %] # => 'Hello...' =head2 replace($search, $replace) Replaces all occurrences of C<$search> in the string with C<$replace>. [% USE String('foo bar foo baz') %] [% String.replace('foo', 'wiz') %] # => 'wiz bar wiz baz' =head2 remove($search) Remove all occurrences of C<$search> in the string. [% USE String('foo bar foo baz') %] [% String.remove('foo ') %] # => 'bar baz' =head2 repeat($count) Repeats the string C<$count> times. [% USE String('foo ') %] [% String.repeat(3) %] # => 'foo foo foo ' =head1 AUTHOR Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> =head1 COPYRIGHT Copyright (C) 1996-2022 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Template::Plugin> =cut # Local Variables: # mode: perl # perl-indent-level: 4 # indent-tabs-mode: nil # End: # # vim: expandtab shiftwidth=4: