16879523492

Committed 11 Aug 2025 12:06PM UTC coverage: 95.327% (+0.3%) from 95.0%

Build # 16879523492

Build Type

push

github

Committed by

nigelhorne

Commit Message

Ensure length(), uppercase() and lowercase() do what you expect with UTF-8 characters

Run Details

5 of 6 new or added lines in 1 file covered. (83.33%)

4 existing lines in 1 file now uncovered.

102 of 107 relevant lines covered (95.33%)

13.82 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

95.33

/lib/Data/Text.pm

package Data::Text;

use warnings;
use strict;

use Carp;
use Encode;
use Lingua::Conjunction;
use Params::Get 0.13;
use Scalar::Util;
use String::Util;
use utf8;

=head1 NAME

Data::Text - Class to handle text in an OO way

=head1 VERSION

Version 0.17

=cut

our $VERSION = '0.17';

use overload (
        '==' => \&equal,
        '!=' => \&not_equal,
        '""' => \&as_string,
        bool => sub { 1 },
        fallback => 1        # So that boolean tests don't cause as_string to be called
);

=head1 DESCRIPTION

C<Data::Text> provides an object-oriented interface for managing and manipulating text content in Perl.
It wraps string operations in a class-based structure,
enabling clean chaining of methods like appending, trimming, replacing words, and joining text with conjunctions.
It supports flexible input types,
including strings, arrays, and other C<Data::Text> objects,
and overloads common operators to allow intuitive comparisons and stringification.

=head1 SYNOPSIS

    use Data::Text;

    my $d = Data::Text->new("Hello, World!\n");

    print $d->as_string();

=head1 SUBROUTINES/METHODS

=head2 new

Creates a Data::Text object.

The optional parameter contains a string, or object, to initialise the object with.

=cut

sub new {
        my ($class, @args) = @_;
        my $self;

        if(!defined($class)) {
                if((scalar @args) > 0) {
                        # Using Data::Text->new(), not Data::Text::new()
                        carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
                        return;
                }
                # FIXME: this only works when no arguments are given
                $self = bless { }, __PACKAGE__;
        } elsif(Scalar::Util::blessed($class)) {
                # If $class is an object, clone it with new arguments
                $self = bless { }, ref($class);
                return $self->set($class) if(!scalar(@args));
        } else {
                # Create a new object
                $self = bless { }, $class;
        }

        # Set additional attributes if arguments are provided
        $self->set(@args) if(scalar(@args));

        # Return the blessed object
        return $self;
}

=head2 set

Sets the object to contain the given text.

The argument can be a reference to an array of strings, or an object.
If called with an object, the message as_string() is sent to it for its contents.

    $d->set({ text => "Hello, World!\n" });
    $d->set(text => [ 'Hello, ', 'World!', "\n" ]);

=cut

sub set {
        my $self = shift;
        my $params = Params::Get::get_params('text', @_);

        if(!defined($params->{'text'})) {
                Carp::carp(__PACKAGE__, ': no text given to set()');
                return;
        }

        # @{$self}{'file', 'line'} = (caller(0))[1, 2];
        my @call_details = caller(0);
        $self->{'file'} = $call_details[1];
        $self->{'line'} = $call_details[2];

        if(ref($params->{'text'})) {
                # Allow the text to be a reference to a list of strings
                if(ref($params->{'text'}) eq 'ARRAY') {
                        if(scalar(@{$params->{'text'}}) == 0) {
                                Carp::carp(__PACKAGE__, ': no text given');
                                return $self;
                        }
                        delete $self->{'text'};
                        foreach my $text(@{$params->{'text'}}) {
                                $self = $self->append($text);
                        }
                        return $self;
                }
                $self->{'text'} = $params->{'text'}->as_string();
        } else {
                $self->{'text'} = $params->{'text'};
        }

        return $self;
}

=head2 append

Adds data given in "text" to the end of the object.
Contains a simple sanity test for consecutive punctuation.
I expect I'll improve that.

Successive calls to append() can be daisy chained.

    $d->set('Hello ')->append("World!\n");

The argument can be a reference to an array of strings, or an object.
If called with an object, the message as_string() is sent to it for its contents.

=cut

sub append
{
        my $self = shift;
        my $params = Params::Get::get_params('text', @_);
        my $text = $params->{'text'};

        # Check if text is provided
        unless(defined $text) {
                Carp::carp(__PACKAGE__, ': no text given to append()');
                return;
        }

        # Capture caller information for debugging
        my $file = $self->{'file'};
        my $line = $self->{'line'};
        # my @call_details = caller(0);
        # $self->{'file'} = $call_details[1];
        # $self->{'line'} = $call_details[2];
        @{$self}{'file', 'line'} = (caller(0))[1, 2];

        # Process if text is a reference
        if(ref($text)) {
                if(ref($text) eq 'ARRAY') {
                        unless(@{$text}) {
                                Carp::carp(__PACKAGE__, ': no text given');
                                return
                        }
                        $self->append($_) for @{$text};
                        return $self;
                }
                $text = $text->as_string();
        }

        # Check for consecutive punctuation
        # FIXME: handle ending with an abbreviation
        if($self->{'text'} && ($self->{'text'} =~ /\s*[\.,;]\s*$/) && ($text =~ /^\s*[\.,;]/)) {
                Carp::carp(__PACKAGE__,
                        ": attempt to add consecutive punctuation\n\tCurrent = '", $self->{'text'},
                        "' at $line of $file\n\tAppend = '", $text, "'");
        } else {
                # Append text
                $self->{'text'} .= $text;
        }

        return $self;
}

=head2 uppercase

Converts the text to uppercase.

    $d->uppercase();

=cut

sub uppercase {
        my $self = shift;

        Encode::_utf8_on($self->{'text'});        # Ensure characters like é are converted to É
        $self->{'text'} = uc($self->{'text'}) if(defined($self->{'text'}));
        Encode::_utf8_off($self->{'text'});

        return $self;
}

=head2 lowercase

Converts the text to lowercase.

    $d->lowercase();

=cut

sub lowercase {
        my $self = $_[0];

        Encode::_utf8_on($self->{'text'});        # Ensure characters like é are converted to É
        $self->{'text'} = lc($self->{'text'}) if(defined($self->{'text'}));
        Encode::_utf8_off($self->{'text'});

        return $self;
}

=head2 clear

Clears the text and resets internal state.

    $d->clear();

=cut

sub clear {
        my $self = shift;

        delete @$self{qw(text file line)};

        return $self;
}

=head2        equal

Are two texts the same?

    my $t1 = Data::Text->new('word');
    my $t2 = Data::Text->new('word');
    print ($t1 == $t2), "\n";        # Prints 1

=cut

sub equal {
        my $self = shift;
        my $other = shift;

        return $self->as_string() eq $other->as_string();
}

=head2        not_equal

Are two texts different?

    my $t1 = Data::Text->new('xyzzy');
    my $t2 = Data::Text->new('plugh');
    print ($t1 != $t2), "\n";        # Prints 1

=cut

sub not_equal {
        my $self = shift;
        my $other = shift;

        return $self->as_string() ne $other->as_string();
}

=head2 as_string

Returns the text as a string.

=cut

sub as_string {
        my $self = shift;

        return $self->{'text'};
}

=head2        length

Returns the length of the text.

This is actually the number of characters, not the number of bytes.

=cut

sub length {
        my $self = shift;

        if(!defined($self->{'text'})) {
                return 0;
        }

        my $copy = $self->{'text'};

        Encode::_utf8_on($copy);

        return length($copy);
}

=head2        trim

Removes leading and trailing spaces from the text.

=cut

sub trim {
        my $self = shift;

        $self->{'text'} = String::Util::trim($self->{'text'});

        return $self;
}

=head2        rtrim

Removes trailing spaces from the text.

=cut

sub rtrim {
        my $self = shift;

        $self->{'text'} = String::Util::rtrim($self->{'text'});

        return $self;
}

=head2 replace

Replaces multiple words in the text.

    $dt->append('Hello World');
    $dt->replace({ 'Hello' => 'Goodbye', 'World' => 'Universe' });
    print $dt->as_string(), "\n";        # Outputs "Goodbye Universe"

=cut

sub replace {
        my ($self, $replacements) = @_;

        if($self->{'text'} && (ref($replacements) eq 'HASH')) {
                foreach my $search (keys %{$replacements}) {
                        my $replace = $replacements->{$search};
                        $self->{'text'} =~ s/\b\Q$search\E\b/$replace/g;
                }
        }

        return $self;
}

=head2        appendconjunction

Add a list as a conjunction.  See L<Lingua::Conjunction>
Because of the way Data::Text works with quoting,
this code works

    my $d1 = Data::Text->new();
    my $d2 = Data::Text->new('a');
    my $d3 = Data::Text->new('b');

    # Prints "a and b\n"
    print $d1->appendconjunction($d2, $d3)->append("\n");

=cut

sub appendconjunction
{
        my $self = shift;

        $self->append(Lingua::Conjunction::conjunction(@_));

        return $self;
}

=head1 AUTHOR

Nigel Horne, C<< <njh at bandsman.co.uk> >>

=head1 BUGS

There is no Unicode or UTF-8 support.

=head1 SEE ALSO

L<String::Util>, L<Lingua::String>

=head1 SUPPORT

This module is provided as-is without any warranty.

You can find documentation for this module with the perldoc command.

    perldoc Data::Text

You can also look for information at:

=over 4

=item * MetaCPAN

L<https://metacpan.org/release/Data-Text>

=item * RT: CPAN's request tracker

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Text>

=item * CPAN Testers' Matrix

L<http://matrix.cpantesters.org/?dist=Data-Text>

=item * CPAN Testers Dependencies

L<http://deps.cpantesters.org/?module=Data::Text>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2021-2025 Nigel Horne.

This program is released under the following licence: GPL2

=cut

1;

1	package Data::Text;
2
3	use warnings;	9✔
4	use strict;	9✔
5
6	use Carp;	9✔
7	use Encode;	9✔
8	use Lingua::Conjunction;	9✔
9	use Params::Get 0.13;	9✔
10	use Scalar::Util;	9✔
11	use String::Util;	9✔
12	use utf8;	9✔
13
14	=head1 NAME
15
16	Data::Text - Class to handle text in an OO way
17
18	=head1 VERSION
19
20	Version 0.17
21
22	=cut
23
24	our $VERSION = '0.17';
25
26	use overload (
27	'==' => \&equal,
28	'!=' => \&not_equal,
29	'""' => \&as_string,
30	bool => sub { 1 },	2✔
31	fallback => 1 # So that boolean tests don't cause as_string to be called	9✔
32	);	9✔
33
34	=head1 DESCRIPTION
35
36	C<Data::Text> provides an object-oriented interface for managing and manipulating text content in Perl.
37	It wraps string operations in a class-based structure,
38	enabling clean chaining of methods like appending, trimming, replacing words, and joining text with conjunctions.
39	It supports flexible input types,
40	including strings, arrays, and other C<Data::Text> objects,
41	and overloads common operators to allow intuitive comparisons and stringification.
42
43	=head1 SYNOPSIS
44
45	use Data::Text;
46
47	my $d = Data::Text->new("Hello, World!\n");
48
49	print $d->as_string();
50
51	=head1 SUBROUTINES/METHODS
52
53	=head2 new
54
55	Creates a Data::Text object.
56
57	The optional parameter contains a string, or object, to initialise the object with.
58
59	=cut
60
61	sub new {
62	my ($class, @args) = @_;	50✔
63	my $self;	50✔
64
65	if(!defined($class)) {	50✔
66	if((scalar @args) > 0) {	1✔
67	# Using Data::Text->new(), not Data::Text::new()
UNCOV 68	carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');	×
UNCOV 69	return;	×
70	}
71	# FIXME: this only works when no arguments are given
72	$self = bless { }, __PACKAGE__;	1✔
73	} elsif(Scalar::Util::blessed($class)) {
74	# If $class is an object, clone it with new arguments
75	$self = bless { }, ref($class);	4✔
76	return $self->set($class) if(!scalar(@args));	4✔
77	} else {
78	# Create a new object
79	$self = bless { }, $class;	45✔
80	}
81
82	# Set additional attributes if arguments are provided
83	$self->set(@args) if(scalar(@args));	47✔
84
85	# Return the blessed object
86	return $self;	47✔
87	}
88
89	=head2 set
90
91	Sets the object to contain the given text.
92
93	The argument can be a reference to an array of strings, or an object.
94	If called with an object, the message as_string() is sent to it for its contents.
95
96	$d->set({ text => "Hello, World!\n" });
97	$d->set(text => [ 'Hello, ', 'World!', "\n" ]);
98
99	=cut
100
101	sub set {
102	my $self = shift;	43✔
103	my $params = Params::Get::get_params('text', @_);	43✔
104
105	if(!defined($params->{'text'})) {	43✔
106	Carp::carp(__PACKAGE__, ': no text given to set()');	2✔
UNCOV 107	return;	×
108	}
109
110	# @{$self}{'file', 'line'} = (caller(0))[1, 2];
111	my @call_details = caller(0);	41✔
112	$self->{'file'} = $call_details[1];	41✔
113	$self->{'line'} = $call_details[2];	41✔
114
115	if(ref($params->{'text'})) {	41✔
116	# Allow the text to be a reference to a list of strings
117	if(ref($params->{'text'}) eq 'ARRAY') {	6✔
118	if(scalar(@{$params->{'text'}}) == 0) {	2✔
UNCOV 119	Carp::carp(__PACKAGE__, ': no text given');	×
NEW 120	return $self;	×
121	}
122	delete $self->{'text'};	2✔
123	foreach my $text(@{$params->{'text'}}) {	2✔
124	$self = $self->append($text);	4✔
125	}
126	return $self;	2✔
127	}
128	$self->{'text'} = $params->{'text'}->as_string();	4✔
129	} else {
130	$self->{'text'} = $params->{'text'};	35✔
131	}
132
133	return $self;	39✔
134	}
135
136	=head2 append
137
138	Adds data given in "text" to the end of the object.
139	Contains a simple sanity test for consecutive punctuation.
140	I expect I'll improve that.
141
142	Successive calls to append() can be daisy chained.
143
144	$d->set('Hello ')->append("World!\n");
145
146	The argument can be a reference to an array of strings, or an object.
147	If called with an object, the message as_string() is sent to it for its contents.
148
149	=cut
150
151	sub append
152	{
153	my $self = shift;	34✔
154	my $params = Params::Get::get_params('text', @_);	34✔
155	my $text = $params->{'text'};	33✔
156
157	# Check if text is provided
158	unless(defined $text) {	33✔
159	Carp::carp(__PACKAGE__, ': no text given to append()');	2✔
160	return;	1✔
161	}
162
163	# Capture caller information for debugging
164	my $file = $self->{'file'};	31✔
165	my $line = $self->{'line'};	31✔
166	# my @call_details = caller(0);
167	# $self->{'file'} = $call_details[1];
168	# $self->{'line'} = $call_details[2];
169	@{$self}{'file', 'line'} = (caller(0))[1, 2];	31✔
170
171	# Process if text is a reference
172	if(ref($text)) {	31✔
173	if(ref($text) eq 'ARRAY') {	3✔
174	unless(@{$text}) {	2✔
175	Carp::carp(__PACKAGE__, ': no text given');	1✔
176	return
177	}	1✔
178	$self->append($_) for @{$text};	1✔
179	return $self;	1✔
180	}
181	$text = $text->as_string();	1✔
182	}
183
184	# Check for consecutive punctuation
185	# FIXME: handle ending with an abbreviation
186	if($self->{'text'} && ($self->{'text'} =~ /\s[\.,;]\s$/) && ($text =~ /^\s*[\.,;]/)) {	29✔
187	Carp::carp(__PACKAGE__,
188	": attempt to add consecutive punctuation\n\tCurrent = '", $self->{'text'},	5✔
189	"' at $line of $file\n\tAppend = '", $text, "'");
190	} else {
191	# Append text
192	$self->{'text'} .= $text;	24✔
193	}
194
195	return $self;	29✔
196	}
197
198	=head2 uppercase
199
200	Converts the text to uppercase.
201
202	$d->uppercase();
203
204	=cut
205
206	sub uppercase {
207	my $self = shift;	3✔
208
209	Encode::_utf8_on($self->{'text'}); # Ensure characters like é are converted to É	3✔
210	$self->{'text'} = uc($self->{'text'}) if(defined($self->{'text'}));	3✔
211	Encode::_utf8_off($self->{'text'});	3✔
212
213	return $self;	3✔
214	}
215
216	=head2 lowercase
217
218	Converts the text to lowercase.
219
220	$d->lowercase();
221
222	=cut
223
224	sub lowercase {
225	my $self = $_[0];	3✔
226
227	Encode::_utf8_on($self->{'text'}); # Ensure characters like é are converted to É	3✔
228	$self->{'text'} = lc($self->{'text'}) if(defined($self->{'text'}));	3✔
229	Encode::_utf8_off($self->{'text'});	3✔
230
231	return $self;	3✔
232	}
233
234	=head2 clear
235
236	Clears the text and resets internal state.
237
238	$d->clear();
239
240	=cut
241
242	sub clear {
243	my $self = shift;	1✔
244
245	delete @$self{qw(text file line)};	1✔
246
247	return $self;	1✔
248	}
249
250	=head2 equal
251
252	Are two texts the same?
253
254	my $t1 = Data::Text->new('word');
255	my $t2 = Data::Text->new('word');
256	print ($t1 == $t2), "\n"; # Prints 1
257
258	=cut
259
260	sub equal {
261	my $self = shift;	6✔
262	my $other = shift;	6✔
263
264	return $self->as_string() eq $other->as_string();	6✔
265	}
266
267	=head2 not_equal
268
269	Are two texts different?
270
271	my $t1 = Data::Text->new('xyzzy');
272	my $t2 = Data::Text->new('plugh');
273	print ($t1 != $t2), "\n"; # Prints 1
274
275	=cut
276
277	sub not_equal {
278	my $self = shift;	5✔
279	my $other = shift;	5✔
280
281	return $self->as_string() ne $other->as_string();	5✔
282	}
283
284	=head2 as_string
285
286	Returns the text as a string.
287
288	=cut
289
290	sub as_string {
291	my $self = shift;	77✔
292
293	return $self->{'text'};	77✔
294	}
295
296	=head2 length
297
298	Returns the length of the text.
299
300	This is actually the number of characters, not the number of bytes.
301
302	=cut
303
304	sub length {
305	my $self = shift;	5✔
306
307	if(!defined($self->{'text'})) {	5✔
308	return 0;	2✔
309	}
310
311	my $copy = $self->{'text'};	3✔
312
313	Encode::_utf8_on($copy);	3✔
314
315	return length($copy);	3✔
316	}
317
318	=head2 trim
319
320	Removes leading and trailing spaces from the text.
321
322	=cut
323
324	sub trim {
325	my $self = shift;	3✔
326
327	$self->{'text'} = String::Util::trim($self->{'text'});	3✔
328
329	return $self;	3✔
330	}
331
332	=head2 rtrim
333
334	Removes trailing spaces from the text.
335
336	=cut
337
338	sub rtrim {
339	my $self = shift;	2✔
340
341	$self->{'text'} = String::Util::rtrim($self->{'text'});	2✔
342
343	return $self;	2✔
344	}
345
346	=head2 replace
347
348	Replaces multiple words in the text.
349
350	$dt->append('Hello World');
351	$dt->replace({ 'Hello' => 'Goodbye', 'World' => 'Universe' });
352	print $dt->as_string(), "\n"; # Outputs "Goodbye Universe"
353
354	=cut
355
356	sub replace {
357	my ($self, $replacements) = @_;	11✔
358
359	if($self->{'text'} && (ref($replacements) eq 'HASH')) {	11✔
360	foreach my $search (keys %{$replacements}) {	9✔
361	my $replace = $replacements->{$search};	10✔
362	$self->{'text'} =~ s/\b\Q$search\E\b/$replace/g;	10✔
363	}
364	}
365
366	return $self;	11✔
367	}
368
369	=head2 appendconjunction
370
371	Add a list as a conjunction. See L<Lingua::Conjunction>
372	Because of the way Data::Text works with quoting,
373	this code works
374
375	my $d1 = Data::Text->new();
376	my $d2 = Data::Text->new('a');
377	my $d3 = Data::Text->new('b');
378
379	# Prints "a and b\n"
380	print $d1->appendconjunction($d2, $d3)->append("\n");
381
382	=cut
383
384	sub appendconjunction
385	{
386	my $self = shift;	4✔
387
388	$self->append(Lingua::Conjunction::conjunction(@_));	4✔
389
390	return $self;	4✔
391	}
392
393	=head1 AUTHOR
394
395	Nigel Horne, C<< <njh at bandsman.co.uk> >>
396
397	=head1 BUGS
398
399	There is no Unicode or UTF-8 support.
400
401	=head1 SEE ALSO
402
403	L<String::Util>, L<Lingua::String>
404
405	=head1 SUPPORT
406
407	This module is provided as-is without any warranty.
408
409	You can find documentation for this module with the perldoc command.
410
411	perldoc Data::Text
412
413	You can also look for information at:
414
415	=over 4
416
417	=item * MetaCPAN
418
419	L<https://metacpan.org/release/Data-Text>
420
421	=item * RT: CPAN's request tracker
422
423	L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Text>
424
425	=item * CPAN Testers' Matrix
426
427	L<http://matrix.cpantesters.org/?dist=Data-Text>
428
429	=item * CPAN Testers Dependencies
430
431	L<http://deps.cpantesters.org/?module=Data::Text>
432
433	=back
434
435	=head1 LICENSE AND COPYRIGHT
436
437	Copyright 2021-2025 Nigel Horne.
438
439	This program is released under the following licence: GPL2
440
441	=cut
442
443	1;

nigelhorne / Data-Text / 16879523492

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous