16737747939

Committed 05 Aug 2025 12:55AM UTC coverage: 95.0% (-1.9%) from 96.939%

Build # 16737747939

Build Type

push

github

Committed by

nigelhorne

Commit Message

Fix test with Params::Get 0.13

Run Details

3 of 3 new or added lines in 1 file covered. (100.0%)

2 existing lines in 1 file now uncovered.

95 of 100 relevant lines covered (95.0%)

14.43 hits per line

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

95.0

/lib/Data/Text.pm

package Data::Text;

use warnings;
use strict;

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

=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;
                        }
                        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, "'");
                return;
        }

        # Append text
        $self->{'text'} .= $text;

        return $self;
}

=head2 uppercase

Converts the text to uppercase.

    $d->uppercase();

=cut

sub uppercase {
        my $self = shift;

        $self->{'text'} = uc($self->{'text'}) if(defined($self->{'text'}));

        return $self;
}

=head2 lowercase

Converts the text to lowercase.

    $d->lowercase();

=cut

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

        $self->{'text'} = lc($self->{'text'}) if(defined($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.

=cut

sub length {
        my $self = shift;

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

        return length($self->{'text'});
}

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

nigelhorne / Data-Text / 16737747939

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