• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

nigelhorne / Data-Text / 14734501640

29 Apr 2025 02:59PM UTC coverage: 90.217% (-3.0%) from 93.258%
14734501640

push

github

nigelhorne
Added clear()

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

83 of 92 relevant lines covered (90.22%)

12.82 hits per line

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

90.22
/lib/Data/Text.pm
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—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) = @_;
43✔
61
        my $self;
43✔
62

63
        if(!defined($class)) {
43✔
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;
38✔
78
        }
79

80
        # Set additional attributes if arguments are provided
81
        $self->set(@args) if(scalar(@args));
40✔
82

83
        # Return the blessed object
84
        return $self;
40✔
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;
33✔
101
        my $params = Params::Get::get_params('text', @_);
33✔
102

103
        if(!defined($params->{'text'})) {
33✔
104
                Carp::carp(__PACKAGE__, ': no text given');
2✔
105
                return;
×
106
        }
107

108
        # @{$self}{'file', 'line'} = (caller(0))[1, 2];
109
        my @call_details = caller(0);
31✔
110
        $self->{'file'} = $call_details[1];
31✔
111
        $self->{'line'} = $call_details[2];
31✔
112

113
        if(ref($params->{'text'})) {
31✔
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✔
117
                                Carp::carp(__PACKAGE__, ': no text given');
×
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'};
25✔
129
        }
130

131
        return $self;
29✔
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;
33✔
152
        my $params = Params::Get::get_params('text', @_);
33✔
153
        my $text = $params->{'text'};
32✔
154

155
        # Check if text is provided
156
        unless(defined $text) {
32✔
157
                Carp::carp(__PACKAGE__, ': no text given');
2✔
158
                return;
1✔
159
        }
160

161
        # Capture caller information for debugging
162
        my $file = $self->{'file'};
30✔
163
        my $line = $self->{'line'};
30✔
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];
30✔
168

169
        # Process if text is a reference
170
        if(ref($text)) {
30✔
171
                if(ref($text) eq 'ARRAY') {
3✔
172
                        return Carp::carp(__PACKAGE__, ': no text given') unless @{$text};
2✔
173
                        $self->append($_) for @{$text};
1✔
174
                        return $self;
1✔
175
                }
176
                $text = $text->as_string();
1✔
177
        }
178

179
        # Check for consecutive punctuation
180
        # FIXME: handle ending with an abbreviation
181
        if($self->{'text'} && ($self->{'text'} =~ /\s*[\.,;]\s*$/) && ($text =~ /^\s*[\.,;]/)) {
28✔
182
                Carp::carp(__PACKAGE__,
183
                        ": attempt to add consecutive punctuation\n\tCurrent = '", $self->{'text'},
5✔
184
                        "' at $line of $file\n\tAppend = '", $text, "'");
185
                return;
5✔
186
        }
187

188
        # Append text
189
        $self->{'text'} .= $text;
23✔
190

191
        return $self;
23✔
192
}
193

194
=head2 clear
195

196
Clears the text and resets internal state.
197

198
    $d->clear();
199

200
=cut
201

202
sub clear {
NEW
203
        my $self = shift;
×
204

NEW
205
        delete @$self{qw(text file line clean)};
×
206

NEW
207
        return $self;
×
208
}
209

210
=head2        equal
211

212
Are two texts the same?
213

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

218
=cut
219

220
sub equal {
221
        my $self = shift;
6✔
222
        my $other = shift;
6✔
223

224
        return $self->as_string() eq $other->as_string();
6✔
225
}
226

227
=head2        not_equal
228

229
Are two texts different?
230

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

235
=cut
236

237
sub not_equal {
238
        my $self = shift;
5✔
239
        my $other = shift;
5✔
240

241
        return $self->as_string() ne $other->as_string();
5✔
242
}
243

244
=head2 as_string
245

246
Returns the text as a string.
247

248
=cut
249

250
sub as_string {
251
        my $self = shift;
63✔
252

253
        return $self->{'text'};
63✔
254
}
255

256
=head2        length
257

258
Returns the length of the text.
259

260
=cut
261

262
sub length {
263
        my $self = shift;
4✔
264

265
        if(!defined($self->{'text'})) {
4✔
266
                return 0;
1✔
267
        }
268

269
        return length($self->{'text'});
3✔
270
}
271

272
=head2        trim
273

274
Removes leading and trailing spaces from the text.
275

276
=cut
277

278
sub trim {
279
        my $self = shift;
3✔
280

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

283
        return $self;
3✔
284
}
285

286
=head2        rtrim
287

288
Removes trailing spaces from the text.
289

290
=cut
291

292
sub rtrim {
293
        my $self = shift;
2✔
294

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

297
        return $self;
2✔
298
}
299

300
=head2        replace
301

302
Replaces words.
303

304
    use Data::Text;
305

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

311
=cut
312

313
sub replace {
314
        my $self = shift;
4✔
315

316
        # avoid assert failure in String::Clean
317
        if($self->{'text'}) {
4✔
318
                $self->{'clean'} ||= String::Clean->new();
3✔
319
                $self->{'text'} = $self->{'clean'}->replace(shift, $self->{'text'}, shift);
3✔
320
        }
321

322
        return $self;
4✔
323
}
324

325
=head2        appendconjunction
326

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

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

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

338
=cut
339

340
sub appendconjunction
341
{
342
        my $self = shift;
4✔
343

344
        $self->append(Lingua::Conjunction::conjunction(@_));
4✔
345

346
        return $self;
4✔
347
}
348

349
=head1 AUTHOR
350

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

353
=head1 BUGS
354

355
=head1 SEE ALSO
356

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

359
=head1 SUPPORT
360

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

363
    perldoc Data::Text
364

365
You can also look for information at:
366

367
=over 4
368

369
=item * MetaCPAN
370

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

373
=item * RT: CPAN's request tracker
374

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

377
=item * CPAN Testers' Matrix
378

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

381
=item * CPAN Testers Dependencies
382

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

385
=back
386

387
=head1 LICENSE AND COPYRIGHT
388

389
Copyright 2021-2025 Nigel Horne.
390

391
This program is released under the following licence: GPL2
392

393
=cut
394

395
1;
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc