[Templates-cvs] cvs commit: TT3/lib/Template/VObject Text.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Mon, 29 Mar 2004 19:36:42 +0100
cvs 04/03/29 18:36:42
Modified: lib/Template/VObject Text.pm
Log:
* updated Text vmethods
Revision Changes Path
1.2 +519 -27 TT3/lib/Template/VObject/Text.pm
Index: Text.pm
===================================================================
RCS file: /template-toolkit/TT3/lib/Template/VObject/Text.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Text.pm 2004/03/29 16:31:31 1.1
+++ Text.pm 2004/03/29 18:36:41 1.2
@@ -17,7 +17,7 @@
# modify it under the same terms as Perl itself.
#
# REVISION
-# $Id: Text.pm,v 1.1 2004/03/29 16:31:31 abw Exp $
+# $Id: Text.pm,v 1.2 2004/03/29 18:36:41 abw Exp $
#
#========================================================================
@@ -29,7 +29,7 @@
use base qw( Template::VObject );
use vars qw( $VERSION $DEBUG $ERROR $THROW $METHODS );
-$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$THROW = 'Text';
@@ -45,57 +45,326 @@
text => \&text,
item => \&item,
- # accessors
+ # accessor methods
size => \&size,
length => \&length,
- equals => \&equals,
- # mutators (all non-destructive)
- pop => \&pop,
- push => \&push,
- shift => \&shift,
- unshift => \&unshift,
- append => \&push,
- prepend => \&unshift,
-
- centre => \¢re,
- center => \¢re, # for our American friends
+ # formatting methods
+ centre => \¢re, # keep the Europeans happy
+ center => \¢re, # keep the Americans happy
left => \&left,
right => \&right,
format => \&format,
- upper => \&upper,
- lower => \&lower,
+ # text munging methods
capital => \&capital,
capitals => \&capitals,
-
- chop => \&chop,
chomp => \&chomp,
- trim => \&trim,
+ chop => \&chop,
collapse => \&collapse,
+ trim => \&trim,
truncate => \&truncate,
+ upper => \&upper,
+ lower => \&lower,
+ # transmogrification methods
chunk => \&chunk,
repeat => \&repeat,
remove => \&remove,
replace => \&replace,
- match => \&match,
- search => \&match,
split => \&split,
+
+ # comparison methods
+ equals => \&equals,
+ match => \&match,
+ search => \&search, # alias for match()
+
+ # mutators (all non-destructive)
+ prefix => \&prefix,
+ suffix => \&suffix,
+ pop => \&pop,
+ push => \&push,
+ shift => \&shift,
+ unshift => \&unshift,
};
+*text = \©
+*item = \©
+*center = \¢re;
+*search = \&match;
+*push = \&suffix;
+*unshift = \&prefix;
+
+
+
+
+#------------------------------------------------------------------------
+# type() [% text.type %]
+#------------------------------------------------------------------------
+
+sub type {
+ return 'Text';
+}
+
+#------------------------------------------------------------------------
+# new() [% Text.new('Hello World') %]
+#------------------------------------------------------------------------
+
sub new {
my ($class, $text) = @_;
my $self = ref $text ? $text : \$text;
+
+ # TODO: new from existing Text object (should already work?)
+
$class = ref $class || $class;
bless $self, $class;
}
+#------------------------------------------------------------------------
+# copy() [% text.copy %]
+#
+# Returns a copy of the text.
+#------------------------------------------------------------------------
+
+sub copy {
+ my $self = shift;
+ return ref $self ? $$self : $self;
+}
+
+
+#------------------------------------------------------------------------
+# list() [% text.list %]
+#
+# Returns unmodified text as a single item list.
+#------------------------------------------------------------------------
+
+sub list {
+ my $self = shift;
+ return [ ref $self ? $$self : $self ];
+}
+
+
+#------------------------------------------------------------------------
+# hash() [% text.hash %]
+#
+# Returns unmodified text as the 'text' entry in a hash array.
+#------------------------------------------------------------------------
+sub hash {
+ my $self = shift;
+ return { text => ref $self ? $$self : $self };
+}
+
+
#------------------------------------------------------------------------
+# size() [% text.size %]
+#
+# Returns 1 to indicate it's a solitary item.
+#------------------------------------------------------------------------
+
+sub size {
+ return 1;
+}
+
+
+#------------------------------------------------------------------------
+# length() [% text.length %]
+#
+# Returns the number of characters in the text.
+#------------------------------------------------------------------------
+
+sub length {
+ my $self = shift;
+ return CORE::length(ref $self ? $$self : $self);
+}
+
+
+#------------------------------------------------------------------------
+# centre($width) [% text.center(72) %]
+#
+# Returns the text centered within a space padded block $width characters
+# wide.
+#------------------------------------------------------------------------
+
+sub centre {
+ my ($self, $width) = @_;
+ my $text = ref $self ? $$self : $self;
+ my $len = CORE::length $text;
+ $width ||= 0;
+
+ if ($len < $width) {
+ my $lpad = int(($width - $len) / 2);
+ my $rpad = $width - $len - $lpad;
+ return (' ' x $lpad) . $text . (' ' x $rpad);
+ }
+
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# left($width) [% text.left(72) %]
+#
+# Returns the text left padded within a block of $width characters.
+#------------------------------------------------------------------------
+
+sub left {
+ my ($self, $width) = @_;
+ my $text = ref $self ? $$self : $self;
+ my $len = CORE::length $text;
+ $width ||= 0;
+
+ if ($width > $len) {
+ return $text . (' ' x ($width - $len));
+ }
+ else {
+ return $text;
+ }
+}
+
+
+#------------------------------------------------------------------------
+# right($width) [% text.right(72) %]
+#
+# Returns the text right padded within a block of $width characters.
+#------------------------------------------------------------------------
+
+sub right {
+ my ($self, $width) = @_;
+ my $text = ref $self ? $$self : $self;
+ my $len = CORE::length $text;
+ $width ||= 0;
+
+ if ($width > $len) {
+ return (' ' x ($width - $len)) . $text;
+ }
+ else {
+ return $text;
+ }
+}
+
+
+#------------------------------------------------------------------------
+# format($format, $arg1, $arg2, ...) [% text.format('%s/%d', n) %]
+#
+# Format the text using sprintf() according to the format passed as the
+# first argument. The first argument passed to sprintf() is the text
+# value itself, followed by any additional arguments passed.
+#------------------------------------------------------------------------
+
+sub format {
+ my ($self, $format, @args) = @_;
+ $format = '%s' unless defined $format;
+ sprintf($format, ref $self ? $$self : $self, @args);
+}
+
+
+#------------------------------------------------------------------------
+# capital() [% text.capital %]
+# capitals() [% text.capitals %]
+#
+# Return text with first word or all words capitalised, respectively.
+#------------------------------------------------------------------------
+
+sub capital {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ $text =~ s/(\w)/\U$1/;
+ return $text;
+}
+
+sub capitals {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ $text =~ s/(\w)(\w*)/\U$1\E$2/g;
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# chop() [% text.chop %]
+# chomp() [% text.chomp %]
+#
+# Same as Perl's chop() and chomp(), removing last character, or last
+# character only if newline, respectively.
+#------------------------------------------------------------------------
+
+sub chop {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ CORE::chop $text;
+ return $text;
+}
+
+sub chomp {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ CORE::chomp $text;
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# collapse() [% text.collapse %]
+#
+# Returns text with all leading and trailing whitespace removed and all
+# sequences of multiple whitespace characters collapsed to a single
+# space.
+#------------------------------------------------------------------------
+
+sub collapse {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ for ($text) {
+ s/^\s+//;
+ s/\s+$//;
+ s/\s+/ /g
+ }
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# trim() [% text.trim %]
+#
+# Returns text with all leading and trailing whitespace removed.
+#------------------------------------------------------------------------
+
+sub trim {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ for ($text) {
+ s/^\s+//;
+ s/\s+$//;
+ }
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# truncate($length, $suffix) [% text.truncate(32, '...') %]
+#
+# Truncates the text to at most $length characters. An optional suffix
+# can be provided which is appended to the text if it is truncated. In
+# this case, the resultant string with the suffix added will be $length
+# characters.
+#------------------------------------------------------------------------
+
+sub truncate {
+ my ($self, $length, $suffix) = @_;
+ my $text = ref $self ? $$self : $self;
+ return $text unless defined $length;
+ $suffix ||= '';
+ return $text if CORE::length $text <= $length;
+ $text = substr($text, 0, $length - CORE::length($suffix)) . $suffix;
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
# upper() [% text.upper %]
# lower() [% text.lower %]
#
@@ -104,22 +373,245 @@
sub upper {
my $self = shift;
- my $text = ref $self ? $self : \$self;
- return uc $$text;
+ my $text = ref $self ? $$self : $self;
+ return uc $text;
}
+
sub lower {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ return lc $text;
+}
+
+
+#------------------------------------------------------------------------
+# chunk($size) [% text.chunk(3) %]
+#
+# Returns a list of the text string split into chunks of $size chars.
+#------------------------------------------------------------------------
+
+sub chunk {
+ my ($self, $size) = @_;
+ my $text = ref $self ? $$self : $self;
+ my @list;
+ $size ||= 1;
+
+ if ($size < 0) {
+ # sexeger!
+ $text = reverse $text;
+ $size = -$size;
+ unshift(@list, scalar reverse $1)
+ while ($text =~ /((.{$size})|(.+))/g);
+ }
+ else {
+ push(@list, $1) while ($text =~ /((.{$size})|(.+))/g);
+ }
+ return \@list;
+}
+
+
+#------------------------------------------------------------------------
+# repeat($count) [% text.repeat(3) %]
+#
+# Returns the text repeated $count times.
+#------------------------------------------------------------------------
+
+sub repeat {
+ my ($self, $n) = @_;
+ my $text = ref $self ? $$self : $self;
+ return $text unless defined $n;
+ return $text x $n;
+}
+
+
+#------------------------------------------------------------------------
+# remove($pattern) [% text.remove('\.(gif|jpg)$') %]
+#
+# Returns the text with any matches of $pattern removed.
+#------------------------------------------------------------------------
+
+sub remove {
+ my ($self, $search) = @_;
+ my $text = ref $self ? $$self : $self;
+ $search = '' unless defined $search;
+ $text =~ s/$search//g;
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# replace($pattern, $value) [% text.replace('\W+', '_') %]
+#
+# Returns the text with any matches of $pattern replaced by $value.
+#------------------------------------------------------------------------
+
+sub replace {
+ my ($self, $search, $replace) = @_;
+ my $text = ref $self ? $$self : $self;
+ return $text unless defined $search;
+ $replace = '' unless defined $replace;
+ $text =~ s/$search/$replace/g;
+ return $text;
+}
+
+
+#------------------------------------------------------------------------
+# split($pattern, $limit) [% text.split('::') %]
+#
+# Returns a list of the text split into chunks using $pattern as a
+# delimiter. $limit can be set to limit the number of chunks.
+#------------------------------------------------------------------------
+
+sub split {
+ my ($self, $split, @args) = @_;
+ my $text = ref $self ? $$self : $self;
+ $text = '' unless defined $text;
+ return [ defined $split
+ ? split($split, $text, @args)
+ : split(' ', $text, @args) ];
+}
+
+
+#------------------------------------------------------------------------
+# match($pattern) [% text.match('\W+') %]
+#
+# Returns a list of all the matches of $pattern within the text.
+#------------------------------------------------------------------------
+
+sub match {
+ my ($self, $search) = @_;
+ my $text = ref $self ? $$self : $self;
+ return $text unless defined $text and defined $search;
+ my @matches = ($text =~ /$search/g);
+ return @matches ? \@matches : '';
+}
+
+
+#------------------------------------------------------------------------
+# equals($text) [% text.equals('Hello World') %]
+#
+# Returns true if the text matches the first argument.
+#------------------------------------------------------------------------
+
+sub equals {
+ my ($self, $text) = @_;
+ my $s = ref $self ? $self : \$self;
+ my $t = ref $text ? $text : \$text;
+ return $$s eq $$t;
+}
+
+
+#------------------------------------------------------------------------
+# prefix($text, $more_text, ...)
+#
+# Prepends all arguments to the start of the text string.
+#------------------------------------------------------------------------
+
+sub prefix {
my $self = shift;
- my $text = ref $self ? $self : \$self;
- return lc $$self;
+ return join('', @_, ref $self ? $$self : $self);
}
-sub text {
+
+#------------------------------------------------------------------------
+# suffix($text, $more_text, ...)
+#
+# Appends all arguments to the end of the text string.
+#------------------------------------------------------------------------
+
+sub suffix {
my $self = shift;
- return ref $self ? $$self : $self;
+ return join('', ref $self ? $$self : $self, @_);
+}
+
+
+
+
+#------------------------------------------------------------------------
+# pop($text, $more_text, ...) [% text.pop('The End.') %]
+#
+# Concatenates arguments and removes the resultant string from the end
+# of the target text.
+#------------------------------------------------------------------------
+
+sub pop {
+ my $self = shift;
+ my $text = ref $self ? $$self : $self;
+ my $strip = join('', @_);
+ $text =~ s/$strip$//;
+ return $text;
}
+#------------------------------------------------------------------------
+# shift($text, $more_text, ...) [% text.shift('Once upon a time') %]
+#
+# Concatenates arguments and removes the resultant string from the start
+# of the target text.
+#------------------------------------------------------------------------
+
+sub shift {
+ my $text = shift;
+ my $strip = join('', @_);
+ $text =~ s/^$strip//;
+ return $text;
+}
+
+
+
+
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Template::VMethods::Text - text virtual methods
+
+=head1 SYNOPSIS
+
+ use Template::VMethods::Text;
+
+ my $vtable = Template::VMethods::Text->vtable();
+ my $handler = $vtable->{ length };
+ my $text = 'The cat sat on the mat';
+ my $result = &$handler($text);
+
+=head1 DESCRIPTION
+
+This module implements the text virtual methods
+
+=head1 AUTHOR
+
+Andy Wardley E<lt>abw@kfs.orgE<gt>
+
+L<http://www.andywardley.com/|http://www.andywardley.com/>
+
+=head1 VERSION
+
+$revision$
+
+=head1 COPYRIGHT
+
+ Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved.
+ Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
+
+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|Template>
+
+=cut
+
+
+
+#========================================================================
+
1;
__END__
@@ -142,7 +634,7 @@
=head1 VERSION
-$Revision: 1.1 $
+$Revision: 1.2 $
=head1 COPYRIGHT