14734792677

Committed 29 Apr 2025 03:11PM UTC coverage: 84.694% (-5.5%) from 90.217%

Build # 14734792677

Build Type

push

github

Committed by

nigelhorne

Commit Message

Added uppercase() and lowercase()

Coverage Stats

0 of 6 new or added lines in 1 file covered. (0.0%)

83 of 98 relevant lines covered (84.69%)

12.03 hits per line

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

84.69

/lib/Data/Text.pm

package Data::Text;

use warnings;
use strict;

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

=head1 NAME

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

=head1 VERSION

Version 0.15

=cut

our $VERSION = '0.15';

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');
                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');
                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') {
                        return Carp::carp(__PACKAGE__, ': no text given') unless @{$text};
                        $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 = shift;

        $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 clean)};

        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 words.

    use Data::Text;

    my $dt = Data::Text->new();
    $dt->append('Hello World');
    $dt->replace({ 'Hello' => 'Goodbye dear' });
    print $dt->as_string(), "\n";        # Outputs "Goodbye dear world"

=cut

sub replace {
        my $self = shift;

        # avoid assert failure in String::Clean
        if($self->{'text'}) {
                $self->{'clean'} ||= String::Clean->new();
                $self->{'text'} = $self->{'clean'}->replace(shift, $self->{'text'}, shift);
        }

        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

=head1 SEE ALSO

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

=head1 SUPPORT

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

nigelhorne / Data-Text / 14734792677

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