local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Template/Plugin/String.pm

   1 #============================================================= -*-Perl-*-
   2 #
   3 # Template::Plugin::String
   4 #
   5 # DESCRIPTION
   6 #   Template Toolkit plugin to implement a basic String object.
   7 #
   8 # AUTHOR
   9 #   Andy Wardley   <abw@wardley.org>
  10 #
  11 # COPYRIGHT
  12 #   Copyright (C) 2001-2007 Andy Wardley.  All Rights Reserved.
  13 #
  14 #   This module is free software; you can redistribute it and/or
  15 #   modify it under the same terms as Perl itself.
  16 #
  17 #============================================================================
  18
  19 package Template::Plugin::String;
  20
  21 use strict;
  22 use warnings;
  23 use base 'Template::Plugin';
  24 use Template::Exception;
  25
  26 use overload q|""| => "text",
  27              fallback => 1;
  28
  29 our $VERSION = 2.40;
  30 our $ERROR   = '';
  31
  32 *centre  = \*center;
  33 *append  = \*push;
  34 *prepend = \*unshift;
  35
  36 #------------------------------------------------------------------------
  37
  38 sub new {
  39     my ($class, @args) = @_;
  40     my $context = ref $class ? undef : shift(@args);
  41     my $config = @args && ref $args[-1] eq 'HASH' ? pop(@args) : { };
  42
  43     $class = ref($class) || $class;
  44
  45     my $text = defined $config->{ text }
  46         ? $config->{ text }
  47         : (@args ? shift(@args) : '');
  48
  49 #    print STDERR "text: [$text]\n";
  50 #    print STDERR "class: [$class]\n";
  51
  52     my $self = bless {
  53         text     => $text,
  54         filters  => [ ],
  55         _CONTEXT => $context,
  56     }, $class;
  57
  58     my $filter = $config->{ filter } || $config->{ filters };
  59
  60     # install any output filters specified as 'filter' or 'filters' option
  61     $self->output_filter($filter)
  62         if $filter;
  63
  64     return $self;
  65 }
  66
  67
  68 sub text {
  69     my $self = shift;
  70     return $self->{ text } unless @{ $self->{ filters } };
  71
  72     my $text = $self->{ text };
  73     my $context = $self->{ _CONTEXT };
  74
  75     foreach my $dispatch (@{ $self->{ filters } }) {
  76         my ($name, $args) = @$dispatch;
  77         my $code = $context->filter($name, $args)
  78             || $self->throw($context->error());
  79         $text = &$code($text);
  80     }
  81     return $text;
  82 }
  83
  84
  85 sub copy {
  86     my $self = shift;
  87     $self->new($self->{ text });
  88 }
  89
  90
  91 sub throw {
  92     my $self = shift;
  93
  94     die (Template::Exception->new('String', join('', @_)));
  95 }
  96
  97
  98 #------------------------------------------------------------------------
  99 # output_filter($filter)
 100 #
 101 # Install automatic output filter(s) for the string.  $filter can a list:
 102 # [ 'name1', 'name2' => [ ..args.. ], name4 => { ..args.. } ] or a hash
 103 # { name1 => '', name2 => [ args ], name3 => { args } }
 104 #------------------------------------------------------------------------
 105
 106 sub output_filter {
 107     my ($self, $filter) = @_;
 108     my ($name, $args, $dispatch);
 109     my $filters = $self->{ filters };
 110     my $count = 0;
 111
 112     if (ref $filter eq 'HASH') {
 113         $filter = [ %$filter ];
 114     }
 115     elsif (ref $filter ne 'ARRAY') {
 116         $filter = [ split(/\s*\W+\s*/, $filter) ];
 117     }
 118
 119     while (@$filter) {
 120         $name = shift @$filter;
 121
 122         # args may follow as a reference (or empty string, e.g. { foo => '' }
 123         if (@$filter && (ref($filter->[0]) || ! length $filter->[0])) {
 124             $args = shift @$filter;
 125             if ($args) {
 126                 $args = [ $args ] unless ref $args eq 'ARRAY';
 127             }
 128             else {
 129                 $args = [ ];
 130             }
 131         }
 132         else {
 133             $args = [ ];
 134         }
 135
 136 #       $self->DEBUG("adding output filter $name(@$args)\n");
 137
 138         push(@$filters, [ $name, $args ]);
 139         $count++;
 140     }
 141
 142     return '';
 143 }
 144
 145
 146 #------------------------------------------------------------------------
 147
 148 sub push {
 149     my $self = shift;
 150     $self->{ text } .= join('', @_);
 151     return $self;
 152 }
 153
 154
 155 sub unshift {
 156     my $self = shift;
 157     $self->{ text } = join('', @_) . $self->{ text };
 158     return $self;
 159 }
 160
 161
 162 sub pop {
 163     my $self = shift;
 164     my $strip = shift || return $self;
 165     $self->{ text } =~ s/$strip$//;
 166     return $self;
 167 }
 168
 169
 170 sub shift {
 171     my $self = shift;
 172     my $strip = shift || return $self;
 173     $self->{ text } =~ s/^$strip//;
 174     return $self;
 175 }
 176
 177 #------------------------------------------------------------------------
 178
 179 sub center {
 180     my ($self, $width) = @_;
 181     my $text = $self->{ text };
 182     my $len = length $text;
 183     $width ||= 0;
 184
 185     if ($len < $width) {
 186         my $lpad = int(($width - $len) / 2);
 187         my $rpad = $width - $len - $lpad;
 188         $self->{ text } = (' ' x $lpad) . $self->{ text } . (' ' x $rpad);
 189     }
 190
 191     return $self;
 192 }
 193
 194
 195 sub left {
 196     my ($self, $width) = @_;
 197     my $len = length $self->{ text };
 198     $width ||= 0;
 199
 200     $self->{ text } .= (' ' x ($width - $len))
 201         if $width > $len;
 202
 203     return $self;
 204 }
 205
 206
 207 sub right {
 208     my ($self, $width) = @_;
 209     my $len = length $self->{ text };
 210     $width ||= 0;
 211
 212     $self->{ text } = (' ' x ($width - $len)) . $self->{ text }
 213         if $width > $len;
 214
 215     return $self;
 216 }
 217
 218
 219 sub format {
 220     my ($self, $format) = @_;
 221     $format = '%s' unless defined $format;
 222     $self->{ text } = sprintf($format, $self->{ text });
 223     return $self;
 224 }
 225
 226
 227 sub filter {
 228     my ($self, $name, @args) = @_;
 229
 230     my $context = $self->{ _CONTEXT };
 231
 232     my $code = $context->filter($name, \@args)
 233         || $self->throw($context->error());
 234     return &$code($self->{ text });
 235 }
 236
 237
 238 #------------------------------------------------------------------------
 239
 240 sub upper {
 241     my $self = CORE::shift;
 242     $self->{ text } = uc $self->{ text };
 243     return $self;
 244 }
 245
 246
 247 sub lower {
 248     my $self = CORE::shift;
 249     $self->{ text } = lc $self->{ text };
 250     return $self;
 251 }
 252
 253
 254 sub capital {
 255     my $self = CORE::shift;
 256     $self->{ text } =~ s/^(.)/\U$1/;
 257     return $self;
 258 }
 259
 260 #------------------------------------------------------------------------
 261
 262 sub chop {
 263     my $self = CORE::shift;
 264     chop $self->{ text };
 265     return $self;
 266 }
 267
 268
 269 sub chomp {
 270     my $self = CORE::shift;
 271     chomp $self->{ text };
 272     return $self;
 273 }
 274
 275
 276 sub trim {
 277     my $self = CORE::shift;
 278     for ($self->{ text }) {
 279         s/^\s+//;
 280         s/\s+$//;
 281     }
 282     return $self;
 283 }
 284
 285
 286 sub collapse {
 287     my $self = CORE::shift;
 288     for ($self->{ text }) {
 289         s/^\s+//;
 290         s/\s+$//;
 291         s/\s+/ /g
 292     }
 293     return $self;
 294
 295 }
 296
 297 #------------------------------------------------------------------------
 298
 299 sub length {
 300     my $self = CORE::shift;
 301     return length $self->{ text };
 302 }
 303
 304
 305 sub truncate {
 306     my ($self, $length, $suffix) = @_;
 307     return $self unless defined $length;
 308     $suffix ||= '';
 309     return $self if CORE::length $self->{ text } <= $length;
 310     $self->{ text } = CORE::substr($self->{ text }, 0,
 311                              $length - CORE::length($suffix)) . $suffix;
 312     return $self;
 313 }
 314
 315
 316 sub substr {
 317     my ($self, $offset, $length, $replacement) = @_;
 318     $offset ||= 0;
 319
 320     if(defined $length) {
 321         if (defined $replacement) {
 322             my $removed = CORE::substr( $self->{text}, $offset, $length );
 323             CORE::substr( $self->{text}, $offset, $length ) = $replacement;
 324             return $removed;
 325         }
 326         else {
 327             return CORE::substr( $self->{text}, $offset, $length );
 328         }
 329     }
 330     else {
 331         return CORE::substr( $self->{text}, $offset );
 332     }
 333 }
 334
 335
 336 sub repeat {
 337     my ($self, $n) = @_;
 338     return $self unless defined $n;
 339     $self->{ text } = $self->{ text } x $n;
 340     return $self;
 341 }
 342
 343
 344 sub replace {
 345     my ($self, $search, $replace) = @_;
 346     return $self unless defined $search;
 347     $replace = '' unless defined $replace;
 348     $self->{ text } =~ s/$search/$replace/g;
 349     return $self;
 350 }
 351
 352
 353 sub remove {
 354     my ($self, $search) = @_;
 355     $search = '' unless defined $search;
 356     $self->{ text } =~ s/$search//g;
 357     return $self;
 358 }
 359
 360
 361 sub split {
 362     my $self  = CORE::shift;
 363     my $split = CORE::shift;
 364     my $limit = CORE::shift || 0;
 365     $split = '\s+' unless defined $split;
 366     return [ split($split, $self->{ text }, $limit) ];
 367 }
 368
 369
 370 sub search {
 371     my ($self, $pattern) = @_;
 372     return $self->{ text } =~ /$pattern/;
 373 }
 374
 375
 376 sub equals {
 377     my ($self, $comparison) = @_;
 378     return $self->{ text } eq $comparison;
 379 }
 380
 381
 382 1;
 383
 384 __END__
 385
 386 =head1 NAME
 387
 388 Template::Plugin::String - Object oriented interface for string manipulation
 389
 390 =head1 SYNOPSIS
 391
 392     # create String objects via USE directive
 393     [% USE String %]
 394     [% USE String 'initial text' %]
 395     [% USE String text => 'initial text' %]
 396
 397     # or from an existing String via new()
 398     [% newstring = String.new %]
 399     [% newstring = String.new('newstring text') %]
 400     [% newstring = String.new( text => 'newstring text' ) %]
 401
 402     # or from an existing String via copy()
 403     [% newstring = String.copy %]
 404
 405     # append text to string
 406     [% String.append('text to append') %]
 407
 408     # format left, right or center/centre padded
 409     [% String.left(20) %]
 410     [% String.right(20) %]
 411     [% String.center(20) %]   # American spelling
 412     [% String.centre(20) %]   # European spelling
 413
 414     # and various other methods...
 415
 416 =head1 DESCRIPTION
 417
 418 This module implements a C<String> class for doing stringy things to
 419 text in an object-oriented way.
 420
 421 You can create a C<String> object via the C<USE> directive, adding any
 422 initial text value as an argument or as the named parameter C<text>.
 423
 424     [% USE String %]
 425     [% USE String 'initial text' %]
 426     [% USE String text='initial text' %]
 427
 428 The object created will be referenced as C<String> by default, but you
 429 can provide a different variable name for the object to be assigned
 430 to:
 431
 432     [% USE greeting = String 'Hello World' %]
 433
 434 Once you've got a C<String> object, you can use it as a prototype to
 435 create other C<String> objects with the C<new()> method.
 436
 437     [% USE String %]
 438     [% greeting = String.new('Hello World') %]
 439
 440 The C<new()> method also accepts an initial text string as an argument
 441 or the named parameter C<text>.
 442
 443     [% greeting = String.new( text => 'Hello World' ) %]
 444
 445 You can also call C<copy()> to create a new C<String> as a copy of the
 446 original.
 447
 448     [% greet2 = greeting.copy %]
 449
 450 The C<String> object has a C<text()> method to return the content of the
 451 string.
 452
 453     [% greeting.text %]
 454
 455 However, it is sufficient to simply print the string and let the
 456 overloaded stringification operator call the C<text()> method
 457 automatically for you.
 458
 459     [% greeting %]
 460
 461 Thus, you can treat C<String> objects pretty much like any regular piece
 462 of text, interpolating it into other strings, for example:
 463
 464     [% msg = "It printed '$greeting' and then dumped core\n" %]
 465
 466 You also have the benefit of numerous other methods for manipulating
 467 the string.
 468
 469     [% msg.append("PS  Don't eat the yellow snow") %]
 470
 471 Note that all methods operate on and mutate the contents of the string
 472 itself.  If you want to operate on a copy of the string then simply
 473 take a copy first:
 474
 475     [% msg.copy.append("PS  Don't eat the yellow snow") %]
 476
 477 These methods return a reference to the C<String> object itself.  This
 478 allows you to chain multiple methods together.
 479
 480     [% msg.copy.append('foo').right(72) %]
 481
 482 It also means that in the above examples, the C<String> is returned which
 483 causes the C<text()> method to be called, which results in the new value of
 484 the string being printed.  To suppress printing of the string, you can
 485 use the C<CALL> directive.
 486
 487     [% foo = String.new('foo') %]
 488
 489     [% foo.append('bar') %]         # prints "foobar"
 490
 491     [% CALL foo.append('bar') %]    # nothing
 492
 493 =head1 CONSTRUCTOR METHODS
 494
 495 These methods are used to create new C<String> objects.
 496
 497 =head2 new()
 498
 499 Creates a new string using an initial value passed as a positional
 500 argument or the named parameter C<text>.
 501
 502     [% USE String %]
 503     [% msg = String.new('Hello World') %]
 504     [% msg = String.new( text => 'Hello World' ) %]
 505
 506 =head2 copy()
 507
 508 Creates a new C<String> object which contains a copy of the original string.
 509
 510     [% msg2 = msg.copy %]
 511
 512 =head1 INSPECTOR METHODS
 513
 514 These methods are used to examine the string.
 515
 516 =head2 text()
 517
 518 Returns the internal text value of the string.  The stringification
 519 operator is overloaded to call this method.  Thus the following are
 520 equivalent:
 521
 522     [% msg.text %]
 523     [% msg %]
 524
 525 =head2 length()
 526
 527 Returns the length of the string.
 528
 529     [% USE String("foo") %]
 530     [% String.length %]   # => 3
 531
 532 =head2 search($pattern)
 533
 534 Searches the string for the regular expression specified in C<$pattern>
 535 returning true if found or false otherwise.
 536
 537     [% item = String.new('foo bar baz wiz waz woz') %]
 538     [% item.search('wiz') ? 'WIZZY! :-)' : 'not wizzy :-(' %]
 539
 540 =head2 split($pattern, $limit)
 541
 542 Splits the string based on the delimiter C<$pattern> and optional C<$limit>.
 543 Delegates to Perl's internal C<split()> so the parameters are exactly the same.
 544
 545     [% FOREACH item.split %]
 546          ...
 547     [% END %]
 548
 549     [% FOREACH item.split('baz|waz') %]
 550          ...
 551     [% END %]
 552
 553 =head1 MUTATOR METHODS
 554
 555 These methods modify the internal value of the string.  For example:
 556
 557     [% USE str=String('foobar') %]
 558     [% str.append('.html') %]   # str => 'foobar.html'
 559
 560 The value of C<str> is now 'C<foobar.html>'.  If you don't want
 561 to modify the string then simply take a copy first.
 562
 563     [% str.copy.append('.html') %]
 564
 565 These methods all return a reference to the C<String> object itself.  This
 566 has two important benefits.  The first is that when used as above, the
 567 C<String> object 'C<str>' returned by the C<append()> method will be stringified
 568 with a call to its C<text()> method.  This will return the newly modified
 569 string content.  In other words, a directive like:
 570
 571     [% str.append('.html') %]
 572
 573 will update the string and also print the new value.  If you just want
 574 to update the string but not print the new value then use C<CALL>.
 575
 576     [% CALL str.append('.html') %]
 577
 578 The other benefit of these methods returning a reference to the C<String>
 579 is that you can chain as many different method calls together as you
 580 like.  For example:
 581
 582     [% String.append('.html').trim.format(href) %]
 583
 584 Here are the methods:
 585
 586 =head2 push($suffix, ...) / append($suffix, ...)
 587
 588 Appends all arguments to the end of the string.  The
 589 C<append()> method is provided as an alias for C<push()>.
 590
 591     [% msg.push('foo', 'bar') %]
 592     [% msg.append('foo', 'bar') %]
 593
 594 =head2 pop($suffix)
 595
 596 Removes the suffix passed as an argument from the end of the String.
 597
 598     [% USE String 'foo bar' %]
 599     [% String.pop(' bar')   %]   # => 'foo'
 600
 601 =head2 unshift($prefix, ...) / prepend($prefix, ...)
 602
 603 Prepends all arguments to the beginning of the string.  The
 604 C<prepend()> method is provided as an alias for C<unshift()>.
 605
 606     [% msg.unshift('foo ', 'bar ') %]
 607     [% msg.prepend('foo ', 'bar ') %]
 608
 609 =head2 shift($prefix)
 610
 611 Removes the prefix passed as an argument from the start of the String.
 612
 613     [% USE String 'foo bar' %]
 614     [% String.shift('foo ') %]   # => 'bar'
 615
 616 =head2 left($pad)
 617
 618 If the length of the string is less than C<$pad> then the string is left
 619 formatted and padded with spaces to C<$pad> length.
 620
 621     [% msg.left(20) %]
 622
 623 =head2 right($pad)
 624
 625 As per L<left()> but right padding the C<String> to a length of C<$pad>.
 626
 627     [% msg.right(20) %]
 628
 629 =head2 center($pad) / centre($pad)
 630
 631 As per L<left()> and L<right()> but formatting the C<String> to be centered within
 632 a space padded string of length C<$pad>.  The C<centre()> method is provided as
 633 an alias for C<center()>.
 634
 635     [% msg.center(20) %]    # American spelling
 636     [% msg.centre(20) %]    # European spelling
 637
 638 =head2 format($format)
 639
 640 Apply a format in the style of C<sprintf()> to the string.
 641
 642     [% USE String("world") %]
 643     [% String.format("Hello %s\n") %]  # => "Hello World\n"
 644
 645 =head2 upper()
 646
 647 Converts the string to upper case.
 648
 649     [% USE String("foo") %]
 650     [% String.upper %]  # => 'FOO'
 651
 652 =head2 lower()
 653
 654 Converts the string to lower case
 655
 656     [% USE String("FOO") %]
 657     [% String.lower %]  # => 'foo'
 658
 659 =head2 capital()
 660
 661 Converts the first character of the string to upper case.
 662
 663     [% USE String("foo") %]
 664     [% String.capital %]  # => 'Foo'
 665
 666 The remainder of the string is left untouched.  To force the string to
 667 be all lower case with only the first letter capitalised, you can do
 668 something like this:
 669
 670     [% USE String("FOO") %]
 671     [% String.lower.capital %]  # => 'Foo'
 672
 673 =head2 chop()
 674
 675 Removes the last character from the string.
 676
 677     [% USE String("foop") %]
 678     [% String.chop %]   # => 'foo'
 679
 680 =head2 chomp()
 681
 682 Removes the trailing newline from the string.
 683
 684     [% USE String("foo\n") %]
 685     [% String.chomp %]  # => 'foo'
 686
 687 =head2 trim()
 688
 689 Removes all leading and trailing whitespace from the string
 690
 691     [% USE String("   foo   \n\n ") %]
 692     [% String.trim %]   # => 'foo'
 693
 694 =head2 collapse()
 695
 696 Removes all leading and trailing whitespace and collapses any sequences
 697 of multiple whitespace to a single space.
 698
 699     [% USE String(" \n\r  \t  foo   \n \n bar  \n") %]
 700     [% String.collapse %]   # => "foo bar"
 701
 702 =head2 truncate($length, $suffix)
 703
 704 Truncates the string to C<$length> characters.
 705
 706     [% USE String('long string') %]
 707     [% String.truncate(4) %]  # => 'long'
 708
 709 If C<$suffix> is specified then it will be appended to the truncated
 710 string.  In this case, the string will be further shortened by the
 711 length of the suffix to ensure that the newly constructed string
 712 complete with suffix is exactly C<$length> characters long.
 713
 714     [% USE msg = String('Hello World') %]
 715     [% msg.truncate(8, '...') %]   # => 'Hello...'
 716
 717 =head2 replace($search, $replace)
 718
 719 Replaces all occurences of C<$search> in the string with C<$replace>.
 720
 721     [% USE String('foo bar foo baz') %]
 722     [% String.replace('foo', 'wiz')  %]  # => 'wiz bar wiz baz'
 723
 724 =head2 remove($search)
 725
 726 Remove all occurences of C<$search> in the string.
 727
 728     [% USE String('foo bar foo baz') %]
 729     [% String.remove('foo ')  %]  # => 'bar baz'
 730
 731 =head2 repeat($count)
 732
 733 Repeats the string C<$count> times.
 734
 735     [% USE String('foo ') %]
 736     [% String.repeat(3)  %]  # => 'foo foo foo '
 737
 738 =head1 AUTHOR
 739
 740 Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
 741
 742 =head1 COPYRIGHT
 743
 744 Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
 745
 746 This module is free software; you can redistribute it and/or
 747 modify it under the same terms as Perl itself.
 748
 749 =head1 SEE ALSO
 750
 751 L<Template::Plugin>
 752
 753 =cut
 754
 755 # Local Variables:
 756 # mode: perl
 757 # perl-indent-level: 4
 758 # indent-tabs-mode: nil
 759 # End:
 760 #
 761 # vim: expandtab shiftwidth=4: