Import original source of String-Tagged 0.15

parents
use strict;
use warnings;
use Module::Build;
my $build = Module::Build->new(
module_name => 'String::Tagged',
requires => {
},
build_requires => {
'Test::Identity' => 0,
'Test::More' => '0.88', # done_testing
},
auto_configure_requires => 0, # Don't add M::B to configure_requires
license => 'perl',
create_makefile_pl => 'traditional',
create_license => 1,
create_readme => 1,
);
$build->create_build_script;
Revision history for String-Tagged
0.15 2017-10-02 16:09:35
[CHANGES]
* Added ->from_sprintf constructor and ->sprintf convenience wrapper
method
0.14 2017/04/24 15:46:45
[BUGFIXES]
* Ensure that ->get_tag_extent can see non-initial tags (RT120691)
0.13 2017/03/16 17:59:47
[CHANGES]
* Define a String::Tagged::Formatting spec name for monospace text
* Updated documentation style to =head2 barename
0.12 2014/11/17 16:14:04
[BUGFIXES]
* Fix for ->get_tag_at ignoring tags in some situations (RT100392)
* Fix for ->substr for length of copied tags that start elsewhere
than offset 0 in the copied chunk (RT100409)
0.11 2014/11/14 17:40:35
[CHANGES]
* Added ->split method
* Allow ->apply_tag/->unapply_tag/->delete_tag to take an Extent
object instead of two integers for position
* Added ->clone method with tag set restriction and conversion
* Document the String::Tagged::Formatting spec
[BUGFIXES]
* Set the overload 'fallback' key
0.10 2014/09/08 17:48:53
[CHANGES]
* Have ->apply_tagged return the object itself, for chaining
* Have ->substr return a String::Tagged; add ->plain_substr for plain
perl strings
* Added ->matches
[BUGFIXES]
* Ensure ->get_tags_at at nonzero index works (RT98700)
0.09 2014/07/31 20:28:59
[CHANGES]
* Have apply_tag, unapply_tag, delete_tag accessors return the object
itself, so they're nice for chaining constructors
0.08 CHANGES:
* Efficiency updates to improve the performance of common append
operations
0.07 CHANGES:
* Respect subclassing in ->concat and . operator
* Added ->new_tagged convenience constructor
* Added 'only' and 'except' filters to iteration methods
0.06 CHANGES:
* Use Test::Identity to work around recent behavioural change in
Test::More when comparing object references
0.05 CHANGES:
* Allow use of ->new() as a clone constructor
* Copy tags if ->set_substr/insert/append are passed a String::Tagged
* Define . and .= operator overloads
0.04 CHANGES:
* Added ->merge_tags() method
* Created terminal colours/attributes example
* Various small fixes to keep CPANTS happy
0.03 CHANGES:
* use warnings
BUGFIXES:
* Ensure that, of multiple tags that start at the same position, the
shortest one wins.
0.02 CHANGES:
* New 'extent' API - methods to return extent objects
* Added ->get_tag_extent() and ->get_tag_missing_extent()
0.01 First version, released on an unsuspecting world.
This diff is collapsed.
Build.PL
Changes
examples/demo-show.pl
lib/String/Tagged.pm
lib/String/Tagged/Formatting.pod
LICENSE
Makefile.PL
MANIFEST This list of files
META.json
META.yml
README
t/00use.t
t/01plain.t
t/02tags-conststr.t
t/03tags-iter-limit.t
t/04tags-appendstr.t
t/05tags-delete.t
t/06tags-substr.t
t/07tags-range.t
t/10debugprint.t
t/11clone.t
t/20merge-tags.t
t/21merge-tags-anchors.t
t/30appendinsert.t
t/31matches.t
t/32split.t
t/33sprintf.t
t/40operators.t
t/50subclass.t
t/99pod.t
{
"abstract" : "string buffers with value tags on extents",
"author" : [
"Paul Evans <leonerd@leonerd.org.uk>"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.422",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "String-Tagged",
"prereqs" : {
"build" : {
"requires" : {
"Test::Identity" : "0",
"Test::More" : "0.88"
}
}
},
"provides" : {
"String::Tagged" : {
"file" : "lib/String/Tagged.pm",
"version" : "0.15"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
]
},
"version" : "0.15",
"x_serialization_backend" : "JSON::PP version 2.94"
}
---
abstract: 'string buffers with value tags on extents'
author:
- 'Paul Evans <leonerd@leonerd.org.uk>'
build_requires:
Test::Identity: '0'
Test::More: '0.88'
dynamic_config: 1
generated_by: 'Module::Build version 0.422, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: String-Tagged
provides:
String::Tagged:
file: lib/String/Tagged.pm
version: '0.15'
resources:
license: http://dev.perl.org/licenses/
version: '0.15'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
# Note: this file was auto-generated by Module::Build::Compat version 0.4220
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'String::Tagged',
'VERSION_FROM' => 'lib/String/Tagged.pm',
'PREREQ_PM' => {
'Test::Identity' => 0,
'Test::More' => '0.88'
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [],
'PL_FILES' => {}
)
;
This diff is collapsed.
#!/usr/bin/perl -w
use strict;
use String::Tagged;
my $CSI = "\e[";
while( my $line = <STDIN> ) {
my $str = String::Tagged->new( $line );
# Every capital letter red
pos $line = 0;
while( $line =~ m/[A-Z]/g ) {
$str->apply_tag( $-[0], 1, fg => 1 );
}
# Punctuation green
pos $line = 0;
while( $line =~ m/[[:punct:]]/g ) {
$str->apply_tag( $-[0], 1, fg => 2 );
}
# Numbers blue
pos $line = 0;
while( $line =~ m/\d+/g ) {
$str->apply_tag( $-[0], $+[0]-$-[0], fg => 4 );
}
# Underline whole words
pos $line = 0;
while( $line =~ m/\S+/g ) {
$str->apply_tag( $-[0], $+[0]-$-[0], u => 1 );
}
print STDERR $str->debug_sprintf;
my %pen;
$str->iter_substr_nooverlap( sub {
my ( $substr, %tags ) = @_;
my @SGR;
if( defined( my $fg = $tags{fg} ) ) {
push @SGR, $fg+30;
$pen{fg} = $fg;
}
elsif( exists $pen{fg} ) {
push @SGR, 39;
delete $pen{fg};
}
if( $tags{u} and !$pen{u} ) {
push @SGR, 4;
$pen{u} = 1;
}
elsif( !$tags{u} and $pen{u} ) {
push @SGR, 24;
delete $pen{u};
}
print "${CSI}".join(";", @SGR)."m" if @SGR;
print $substr;
} );
print "${CSI}m\n";
}
This diff is collapsed.
=head1 NAME
C<String::Tagged::Formatting> - an API specification for simple formatted strings
=head1 DESCRIPTION
A primary use case of L<String::Tagged> is to allow storage of a text string
with associated formatting data. As there are a growing number of subclasses
on CPAN that attempt to do this, a common specification is emerging to allow
interoperability between them. This will allow interchange between formats
from different sources, display or rendering, and so on.
Primarily this specification consists of the names and meanings of a set of
tags that a conforming string should supply, though it also suggests a pair of
methods useful for converting between different types of object and the
standard formatting. Specific implementations may not be able to represent all
of the tags of course; this specification only gives the suggested way to
represent those formatting styles that the implementation actually
understands.
=head1 TAGS
=head2 bold, under, italic, strike, blink, monospace
Tags with boolean values indicating bold, underline, italic, strikethrough,
blinking and monospaced font.
=head2 reverse
Tag with boolean value indicating reverse video; i.e. the effect of swapping
foreground and background colours. This effect is common on terminal-based
string systems, but is unlikely to be found elsewhere.
=head2 fg, bg
Tags with L<Convert::Color> instances giving foreground and background
colours. The use of a C<Convert::Color> instance allows specific
implementations to be able to represent their own colour space, while still
supporting an easy conversion to the colour spaces used by others.
=head1 METHODS
The following methods should be provided on conforming implementations, to
indicate their support of this specification and to allow easy conversion from
and to it.
=head2 as_formatting
$fmt = $st->as_formatting
Called on an existing instance of the class, returns a C<String::Tagged>
instance (or some subclass thereof) containing only the tags and values
defined by this specification. This method may simply return the original
instance if the tags natively used by it already fit this specification, or it
may return a newly-constructed instance by converting its own tag formats.
Use of the C<clone> method with C<only_tags> and possibly a C<convert_tags>
map should be able to implement this in most cases.
=head2 new_from_formatting
$st = String::Tagged::Subclass->new_from_formatting( $fmt )
Called as a class method on the target class type, returns a new instance of
that class constructed to represent the formatting contained in the C<$fmt>
instance, which should contain only the tags given in this specification. If
the class natively uses tags as per this specification, this can be a trivial
clone, otherwise some conversion will need to be performed.
Use of the C<clone> method with C<only_tags> and possibly a C<convert_tags>
map should be able to implement this in most cases.
=head1 KNOWN IMPLEMENTATIONS
=over 4
=item * C<String::Tagged::IRC>
=item * C<Net::Async::Matrix::Utils>
Contains a pair of functions to convert a formatted I<Matrix> message body to
and from this format.
=back
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use_ok( "String::Tagged" );
done_testing;
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use String::Tagged;
my $str = String::Tagged->new( "Hello, world" );
is( $str->str, "Hello, world", 'Plain string accessor' );
is( $str->length, 12, 'Plain string length' );
is( length($str), 12, 'length() str also works' );
is( $str->plain_substr( 0, 5 ), "Hello", 'Plain substring accessor' );
isa_ok( $str->substr( 0, 5 ), "String::Tagged", 'Tagged substring accessor' );
$str->set_substr( 7, 5, "planet" );
is( $str->str, "Hello, planet", "After set_substr" );
is( $str->length, 13, 'String length after set_substr' );
$str->insert( 7, "lovely " );
is( $str->str, "Hello, lovely planet", 'After insert' );
$str->append( "!" );
is( $str->str, "Hello, lovely planet!", 'After append' );
done_testing;
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Identity;
use String::Tagged;
my $str = String::Tagged->new( "Hello, world" );
is_deeply( [ $str->tagnames ], [], 'No tags defined initially' );
identical( $str->apply_tag( 0, 12, message => 1 ), $str, '->apply_tag returns $str' );
is_deeply( [ $str->tagnames ], [qw( message )], 'message tag now defined' );
my @tags;
$str->iter_tags( sub { push @tags, [ @_ ] } );
is_deeply( \@tags,
[
[ 0, 12, message => 1 ],
],
'tags list after apply message' );
my @extents;
$str->iter_extents( sub { push @extents, $_[0] } );
is( scalar @extents, 1, 'one extent from iter_extents' );
my $e = $extents[0];
can_ok( $e, qw( string start length end substr ) );
identical( $e->string, $str, '$e->string' );
is( $e->start, 0, '$e->start' );
is( $e->length, 12, '$e->length' );
is( $e->end, 12, '$e->end' );
is( $e->plain_substr, "Hello, world", '$e->plain_substr' );
{
my $sub = $e->substr;
isa_ok( $sub, "String::Tagged", '$e->substr' );
my @tags;
$sub->iter_tags( sub { push @tags, [ @_ ] } );
is_deeply( \@tags,
[ [ 0, 12, message => 1 ] ],
'$e->substr->iter_tags' );
}
is_deeply( $str->get_tags_at( 0 ),
{ message => 1 },
'tags at pos 0' );
is( $str->get_tag_at( 0, "message" ), 1, 'message tag is 1 at pos 0' );
$str->apply_tag( 6, 1, space => 1 );
is_deeply( [ sort $str->tagnames ], [qw( message space )], 'space tag now also defined' );
undef @tags;
$str->iter_tags( sub { push @tags, [ @_ ] } );
is_deeply( \@tags,
[
[ 0, 12, message => 1 ],
[ 6, 1, space => 1 ],
],
'tags list after apply space' );
undef @extents;
$str->iter_extents( sub { push @extents, $_[0] } );
is( scalar @extents, 2, 'two extent from iter_extents' );
is( $extents[0]->plain_substr, "Hello, world", '$e[0]->substr' );
is( $extents[1]->plain_substr, " ", '$e[1]->substr' );
sub fetch_tags
{
my ( $start, $len, %tags ) = @_;
push @tags, [ $start, $len, map { $_ => $tags{$_} } sort keys %tags ]
}
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags );
is_deeply( \@tags,
[
[ 0, 6, message => 1 ],
[ 6, 1, message => 1, space => 1 ],
[ 7, 5, message => 1 ],
],
'tags list non-overlapping after apply space' );
my @substrs;
sub fetch_substrs
{
my ( $substr, %tags ) = @_;
push @substrs, [ $substr, map { $_ => $tags{$_} } sort keys %tags ]
}
$str->iter_substr_nooverlap( \&fetch_substrs );
is_deeply( \@substrs,
[
[ "Hello,", message => 1 ],
[ " ", message => 1, space => 1 ],
[ "world", message => 1 ],
],
'substrs non-overlapping after apply space' );
$str->apply_tag( 0, 1, capital => 1 );
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags );
is_deeply( \@tags,
[
[ 0, 1, capital => 1, message => 1 ],
[ 1, 5, message => 1 ],
[ 6, 1, message => 1, space => 1 ],
[ 7, 5, message => 1 ],
],
'tags list non-overlapping after apply space' );
undef @substrs;
$str->iter_substr_nooverlap( \&fetch_substrs );
is_deeply( \@substrs,
[
[ "H", capital => 1, message => 1 ],
[ "ello,", message => 1 ],
[ " ", message => 1, space => 1 ],
[ "world", message => 1 ],
],
'substrs non-overlapping after apply space' );
$str = String::Tagged->new( "my BIG message" );
$str->apply_tag( 0, 14, size => 1 );
$str->apply_tag( 3, 3, size => 2 );
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags );
is_deeply( \@tags,
[
[ 0, 3, size => 1 ],
[ 3, 3, size => 2 ],
[ 6, 8, size => 1 ],
],
'tags list with overridden tag' );
$str->apply_tag( 0, 1, size => 3 );
$str->apply_tag( 3, 1, size => 4 );
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags );
is_deeply( \@tags,
[
[ 0, 1, size => 3 ],
[ 1, 2, size => 1 ],
[ 3, 1, size => 4 ],
[ 4, 2, size => 2 ],
[ 6, 8, size => 1 ],
],
'tags list with overridden tag at BOS' );
$str = String::Tagged->new( "BEGIN middle END" );
$str->apply_tag( -1, -1, everywhere => 1 );
$str->apply_tag( -1, 5, begin => 1 );
$str->apply_tag( 13, -1, end => 1);
undef @extents;
$str->iter_extents( sub {
my ( $e ) = @_;
push @extents, [ $e->substr, $e->start, $e->end, $e->anchor_before?1:0, $e->anchor_after?1:0 ];
} );
is_deeply( \@extents,
[ [ "BEGIN", 0, 5, 1, 0 ],
[ "BEGIN middle END", 0, 16, 1, 1 ],
[ "END", 13, 16, 0, 1 ] ],
'extent objects contain start/end/anchor_before/anchor_after' );
is_deeply( $str->get_tags_at( 0 ),
{ everywhere => 1, begin => 1 },
'tags at pos 0 of edge-anchored' );
is( $str->get_tag_at( 0, "everywhere" ), 1, 'everywhere tag is 1 at pos 0 of edge-anchored' );
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags );
is_deeply( \@tags,
[
[ 0, 5, begin => 1, everywhere => 1 ],
[ 5, 8, everywhere => 1 ],
[ 13, 3, end => 1, everywhere => 1 ],
],
'tags list with edge-anchored tags' );
# RT98700
{
my $str = String::Tagged->new( "Hello" );
$str->apply_tag( 1, 1, one => 1 );
$str->apply_tag( 4, 1, four => 4 );
is_deeply( $str->get_tags_at( 1 ), { one => 1 }, '->get_tags_at( 1 )' );
is_deeply( $str->get_tags_at( 4 ), { four => 4 }, '->get_tags_at( 4 )' );
}
my $str2 = String::Tagged->new( $str );
is( $str2->str, "BEGIN middle END", 'constructor clones string' );
undef @extents;
$str2->iter_extents( sub {
my ( $e ) = @_;
push @extents, [ $e->substr, $e->start, $e->end, $e->anchor_before?1:0, $e->anchor_after?1:0 ];
} );
is_deeply( \@extents,
[ [ "BEGIN", 0, 5, 1, 0 ],
[ "BEGIN middle END", 0, 16, 1, 1 ],
[ "END", 13, 16, 0, 1 ] ],
'constructor clones tags' );
$str = String::Tagged->new_tagged( "sample", foo => 1 );
is( $str->str, "sample", '->str from ->new_tagged' );
is_deeply( $str->get_tags_at( 0 ),
{ foo => 1 },
'tags at pos 0 from ->new_tagged' );
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags );
is_deeply( \@tags,
[ [ 0, 6, foo => 1 ] ],
'tags list from ->new_tagged' );
# get_tag_at (RT100392)
{
my $str = String::Tagged->new( "abcd" );
$str->apply_tag( $_, 1, some => 13 ) for 0 .. $str->length - 1;
my $v = $str->get_tag_at( 2, "some" );
is( $v, 13, "get_tag_at retrieved value" );
}
done_testing;
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use String::Tagged;
my $str = String::Tagged->new( "A string with BOLD and ITAL tags" );
$str->apply_tag( -1, -1, message => 1 );
$str->apply_tag( 14, 4, bold => 1 );
$str->apply_tag( 23, 4, italic => 1 );
my @tags;
undef @tags;
$str->iter_tags( sub { push @tags, [ @_ ] }, start => 20 );
is_deeply( \@tags,
[
[ 0, 32, message => 1 ],
[ 23, 4, italic => 1 ],
],
'tags list with start offset' );
undef @tags;
$str->iter_tags( sub { push @tags, [ @_ ] }, end => 20 );
is_deeply( \@tags,
[
[ 0, 32, message => 1 ],
[ 14, 4, bold => 1 ],
],
'tags list with end limit' );
undef @tags;
$str->iter_tags( sub { push @tags, [ @_ ] }, only => [qw( message )] );
is_deeply( \@tags,
[
[ 0, 32, message => 1 ],
],
'tags list with only (message)' );
undef @tags;
$str->iter_tags( sub { push @tags, [ @_ ] }, except => [qw( message )] );
is_deeply( \@tags,
[
[ 14, 4, bold => 1 ],
[ 23, 4, italic => 1 ],
],
'tags list with except (message)' );
sub fetch_tags
{
my ( $start, $len, %tags ) = @_;
push @tags, [ $start, $len, map { $_ => $tags{$_} } sort keys %tags ]
}
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags, start => 20 );
is_deeply( \@tags,
[
[ 20, 3, message => 1 ],
[ 23, 4, italic => 1, message => 1 ],
[ 27, 5, message => 1 ],
],
'tags list non-overlapping with start offset' );
undef @tags;
$str->iter_tags_nooverlap( \&fetch_tags, end => 20 );
is_deeply( \@tags,
[
[ 0, 14, message => 1 ],
[ 14, 4, bold => 1, message => 1 ],
[ 18, 2, message => 1 ],
],
'tags list non-overlapp