Bug #115620 for String-Tagged: substr without affecting extents

For fixed-format strings, it'd be useful to have a shortcut for applying the same tags to many different instances. This patch provides an example implementation - since the behaviour is most useful on a direct copy of an existing instance, it may be better to provide ->clone('new string') instead? cheers, Tom

commit 084fdf5e389681cc1abf95fab0d245b134b5ffd8 Author: tom <TEAM@cpan.org> Date: Sun Jun 26 20:56:38 2016 +0100 overlay support diff --git a/lib/String/Tagged.pm b/lib/String/Tagged.pm index f2acc88..96bb160 100644 --- a/lib/String/Tagged.pm +++ b/lib/String/Tagged.pm @@ -1243,6 +1243,63 @@ sub set_substr return $self; } +=head2 $st->overlay_substr( $start, $len, $newstr ) + +Modifies the underlying plain string without affecting tags. Any existing +tags which overlap the region will continue to do so. + +Can be used on a L</clone>d copy of a template instance to support fixed +formats: + + my $iso8601_format = sub { + my $time = shift; + state $format = String::Tagged->new('0000-00-00T00:00:00.000Z') + ->apply_tag( 0, 4, years => 1) + ->apply_tag( 4, 1, separator => 1) + ->apply_tag( 5, 2, months => 1) + ->apply_tag( 7, 1, separator => 1) + ->apply_tag( 8, 2, days => 1) + ->apply_tag(11, 2, hours => 1) + ->apply_tag(13, 1, separator => 1) + ->apply_tag(14, 2, minutes => 1) + ->apply_tag(16, 1, separator => 1) + ->apply_tag(17, 2, seconds => 1) + ->apply_tag(19, 1, separator => 1) + ->apply_tag(20, 3, ms => 1); + $format->clone->overlay_str(sprintf '%s.%03dZ', strftime('%Y-%m-%dT%H:%M:%S', gmtime $time), 1000 * ($time - int($time))) + }; + +=cut + +sub overlay_substr +{ + my $self = shift; + my ( $start, $len, $new ) = @_; + + my $limit = $self->length; + + $start = $limit if $start > $limit; + $len = ( $limit - $start ) if $len > ( $limit - $start ); + + CORE::substr( $self->{str}, $start, $len ) = $new; + + return $self; +} + +=head2 $st->overlay_str( $newstr ) + +Modifies the underlying plain string without affecting tags. Any existing +tags which overlap the region will continue to do so. + +=cut + +sub overlay_str +{ + my $self = shift; + my ( $new ) = @_; + $self->overlay_substr(0, length($new), $new) +} + =head2 $st->insert( $start, $newstr ) Insert the given string at the given position. A shortcut around diff --git a/t/12overlay.t b/t/12overlay.t new file mode 100644 index 0000000..372e14e --- /dev/null +++ b/t/12overlay.t @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use String::Tagged; + +my $orig = String::Tagged->new + ->append ( "this string has " ) + ->append_tagged( "some", some => 1 ) + ->append ( " " ) + ->append_tagged( "tags", tags => 1 ) + ->append ( " applied to it" ); + +# full clone +{ + my $new = String::Tagged->clone( $orig ); + + is( $new->str, "this string has some tags applied to it", '->str of clone' ); + is_deeply( [ sort $new->tagnames ], [qw( some tags )], '->tagnames of clone' ); + my $expected = "once we had two cats that sat on it ..."; + is( $new->overlay_substr(0, length($expected), $expected)->str, $expected, '->str after overlay'); + is_deeply( [ sort $new->tagnames ], [qw( some tags )], '->tagnames of clone' ); + is( $new->get_tag_at( index($new, "cats"), "some"), 1, 'first tag matches'); + is( $new->get_tag_at( index($new, "that"), "tags"), 1, 'second tag matches'); +} +done_testing;