18720301874

Committed 22 Oct 2025 02:52PM UTC coverage: 99.099% (+1.7%) from 97.368%

Build # 18720301874

Build Type

push

github

Committed by

nigelhorne

Commit Message

Remove unreachable code

Run Details

110 of 111 relevant lines covered (99.1%)

151.17 hits per line

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

99.1

/lib/Data/Text.pm

package Data::Text;

use warnings;
use strict;

use Carp;
use Encode;
use Lingua::Conjunction;
use Object::Configure 0.16;
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.18

=cut

our $VERSION = '0.18';

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 = shift;
        my $self;
        my $params;

        if(scalar(@_) == 1) {
                # Just one parameter - the text to initialize with
                $params = Params::Get::get_params('text', \@_);
        } else {
                $params = Params::Get::get_params(undef, \@_) || {};
        }

        if(!defined($class)) {
                # Using Data::Text->new(), not Data::Text::new()
                # 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 keys %{$params});
        } else {
                # Create a new object
                $self = bless { }, $class;
        }

        $params = Object::Configure::configure($class, $params);

        # Set additional attributes if arguments are provided
        $self->set($params) if($params->{'text'});

        # 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*[\.,;]/)) {
                if(my $logger = $self->{'logger'}) {
                        $logger->warn(": attempt to add consecutive punctuation\n\tCurrent = '" . $self->{'text'} .
                        "' at $line of $file\n\tAppend = '", $text, "'");
                }
                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.

    $d->append('Hello World');
    $d->replace({ 'Hello' => 'Goodbye', 'World' => 'Universe' });
    print $d->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 nigelhorne.com> >>

=head1 BUGS

There is no Unicode or UTF-8 support.

=head1 SEE ALSO

=over 4

=item * Test coverage report: L<https://nigelhorne.github.io/Data-Text/coverage/>

=item * L<String::Util>, L<Lingua::String>

=back

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

nigelhorne / Data-Text / 18720301874

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