[Templates-cvs] cvs commit: Template2/lib/Template Stash.pm

cvs@template-toolkit.org cvs@template-toolkit.org


cvs         06/02/01 14:53:20

  Modified:    lib/Template Stash.pm
  Log:
  * changed scalar.substr virtual method to return complete string if
    replacement argument is specified, rather than the part replaced
  
  * added new scalar.replace virtual method which handles backreferences
  
  Revision  Changes    Path
  2.96      +46 -6     Template2/lib/Template/Stash.pm
  
  Index: Stash.pm
  ===================================================================
  RCS file: /template-toolkit/Template2/lib/Template/Stash.pm,v
  retrieving revision 2.95
  retrieving revision 2.96
  diff -u -r2.95 -r2.96
  --- Stash.pm	2006/02/01 08:39:31	2.95
  +++ Stash.pm	2006/02/01 14:53:20	2.96
  @@ -18,7 +18,7 @@
   #
   #----------------------------------------------------------------------------
   #
  -# $Id: Stash.pm,v 2.95 2006/02/01 08:39:31 abw Exp $
  +# $Id: Stash.pm,v 2.96 2006/02/01 14:53:20 abw Exp $
   #
   #============================================================================
   
  @@ -29,7 +29,7 @@
   use strict;
   use vars qw( $VERSION $DEBUG $ROOT_OPS $SCALAR_OPS $HASH_OPS $LIST_OPS );
   
  -$VERSION = sprintf("%d.%02d", q$Revision: 2.95 $ =~ /(\d+)\.(\d+)/);
  +$VERSION = sprintf("%d.%02d", q$Revision: 2.96 $ =~ /(\d+)\.(\d+)/);
   
   
   #========================================================================
  @@ -69,7 +69,7 @@
           return $str unless defined $str and defined $pattern;
           return $str =~ /$pattern/;
       },
  -    'replace'  => sub { 
  +    'old_replace'  => sub { 
           my ($str, $search, $replace) = @_;
           $replace = '' unless defined $replace;
           return $str unless defined $str and defined $search;
  @@ -78,6 +78,47 @@
   #       eval "\$str =~ s$search$replaceg";
           return $str;
       },
  +    'replace' => sub {
  +        my ($text, $pattern, $replace, $global) = @_;
  +        my ($matched, $after, $backref, @start, @end);
  +        my $result = '';
  +
  +        $global = 1 unless defined $global;
  +        
  +        while ($text =~ m/$pattern/) {
  +            if($#- == 0) {  
  +                # no captured groups so do a simple search and replace
  +                if($global) { $text =~ s/$pattern/$replace/g }
  +                else        { $text =~ s/$pattern/$replace/  }
  +                last;
  +            }
  +
  +            # extract the bit before the match, the match itself, the 
  +            # bit after and the positions of all subgroups
  +            $result .= substr($text, 0, $-[0]) if $-[0];
  +            $matched = substr($text, $-[0], $+[0] - $-[0]);
  +            $after   = substr($text, $+[0]);
  +            @start   = @-;
  +            @end     = @+;
  +
  +            # do the s/// leaving the placeholders (literally '$1' etc) in place
  +            $matched =~ s/$pattern/$replace/;
  +
  +            # then replace the $1, $2, etc., placeholders in reverse order 
  +            # to ensure we do $10 before $1
  +            for (my $i = $#start; $i; $i--) {
  +                $backref = substr( $text, $start[$i], $end[$i] - $start[$i] );
  +                $matched =~ s/\$$i/$backref/g;
  +            }
  +
  +            # add the modified $matched output to the result and loop if global
  +            $result .= $matched;
  +            $text    = $after;
  +            last unless $global && length $text;
  +        }
  +        return $result . $text;
  +    },
  +
       'remove'  => sub { 
           my ($str, $search) = @_;
           return $str unless defined $str and defined $search;
  @@ -134,9 +175,8 @@
   
           if(defined $length) {
               if (defined $replacement) {
  -                my $removed = substr( $text, $offset, $length );
  -                substr( $text, $offset, $length ) = $replacement;
  -                return $removed;
  +                substr( $text, $offset, $length, $replacement );
  +                return $text;
               }
               else {
                   return substr( $text, $offset, $length );