19345711288

Committed 13 Nov 2025 09:01PM UTC coverage: 98.198% (-0.9%) from 99.099%

Build # 19345711288

Build Type

push

github

Committed by

nigelhorne

Commit Message

Dynamically create fuzz

Run Details

109 of 111 relevant lines covered (98.2%)

145.51 hits per line

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

98.2

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

nigelhorne / Data-Text / 19345711288

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