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

nigelhorne / Data-Text / 14734311168

29 Apr 2025 02:50PM UTC coverage: 93.258% (-2.2%) from 95.506%
14734311168

push

github

nigelhorne
Added a decription

83 of 89 relevant lines covered (93.26%)

13.25 hits per line

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

93.26
/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::Tex>t 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
Handle text in an OO way.
44

45
    use Data::Text;
46

47
    my $d = Data::Text->new("Hello, World!\n");
48

49
    print $d->as_string();
50

51
=head1 SUBROUTINES/METHODS
52

53
=head2 new
54

55
Creates a Data::Text object.
56

57
The optional parameter contains a string, or object, to initialise the object with.
58

59
=cut
60

61
sub new {
62
        my ($class, @args) = @_;
43✔
63
        my $self;
43✔
64

65
        if(!defined($class)) {
43✔
66
                if((scalar @args) > 0) {
1✔
67
                        # Using Data::Text->new(), not Data::Text::new()
68
                        carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
×
69
                        return;
×
70
                }
71
                # FIXME: this only works when no arguments are given
72
                $self = bless { }, __PACKAGE__;
1✔
73
        } elsif(Scalar::Util::blessed($class)) {
74
                # If $class is an object, clone it with new arguments
75
                $self = bless { }, ref($class);
4✔
76
                return $self->set($class) if(!scalar(@args));
4✔
77
        } else {
78
                # Create a new object
79
                $self = bless { }, $class;
38✔
80
        }
81

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

85
        # Return the blessed object
86
        return $self;
40✔
87
}
88

89
=head2 set
90

91
Sets the object to contain the given text.
92

93
The argument can be a reference to an array of strings, or an object.
94
If called with an object, the message as_string() is sent to it for its contents.
95

96
    $d->set({ text => "Hello, World!\n" });
97
    $d->set(text => [ 'Hello, ', 'World!', "\n" ]);
98

99
=cut
100

101
sub set {
102
        my $self = shift;
33✔
103
        my $params = Params::Get::get_params('text', @_);
33✔
104

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

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

115
        if(ref($params->{'text'})) {
31✔
116
                # Allow the text to be a reference to a list of strings
117
                if(ref($params->{'text'}) eq 'ARRAY') {
6✔
118
                        if(scalar(@{$params->{'text'}}) == 0) {
2✔
119
                                Carp::carp(__PACKAGE__, ': no text given');
×
120
                                return;
×
121
                        }
122
                        delete $self->{'text'};
2✔
123
                        foreach my $text(@{$params->{'text'}}) {
2✔
124
                                $self = $self->append($text);
4✔
125
                        }
126
                        return $self;
2✔
127
                }
128
                $self->{'text'} = $params->{'text'}->as_string();
4✔
129
        } else {
130
                $self->{'text'} = $params->{'text'};
25✔
131
        }
132

133
        return $self;
29✔
134
}
135

136
=head2 append
137

138
Adds data given in "text" to the end of the object.
139
Contains a simple sanity test for consecutive punctuation.
140
I expect I'll improve that.
141

142
Successive calls to append() can be daisy chained.
143

144
    $d->set('Hello ')->append("World!\n");
145

146
The argument can be a reference to an array of strings, or an object.
147
If called with an object, the message as_string() is sent to it for its contents.
148

149
=cut
150

151
sub append
152
{
153
        my $self = shift;
33✔
154
        my $params = Params::Get::get_params('text', @_);
33✔
155
        my $text = $params->{'text'};
32✔
156

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

163
        # Capture caller information for debugging
164
        my $file = $self->{'file'};
30✔
165
        my $line = $self->{'line'};
30✔
166
        # my @call_details = caller(0);
167
        # $self->{'file'} = $call_details[1];
168
        # $self->{'line'} = $call_details[2];
169
        @{$self}{'file', 'line'} = (caller(0))[1, 2];
30✔
170

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

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

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

193
        return $self;
23✔
194
}
195

196
=head2        equal
197

198
Are two texts the same?
199

200
    my $t1 = Data::Text->new('word');
201
    my $t2 = Data::Text->new('word');
202
    print ($t1 == $t2), "\n";        # Prints 1
203

204
=cut
205

206
sub equal {
207
        my $self = shift;
6✔
208
        my $other = shift;
6✔
209

210
        return $self->as_string() eq $other->as_string();
6✔
211
}
212

213
=head2        not_equal
214

215
Are two texts different?
216

217
    my $t1 = Data::Text->new('xyzzy');
218
    my $t2 = Data::Text->new('plugh');
219
    print ($t1 != $t2), "\n";        # Prints 1
220

221
=cut
222

223
sub not_equal {
224
        my $self = shift;
5✔
225
        my $other = shift;
5✔
226

227
        return $self->as_string() ne $other->as_string();
5✔
228
}
229

230
=head2 as_string
231

232
Returns the text as a string.
233

234
=cut
235

236
sub as_string {
237
        my $self = shift;
63✔
238

239
        return $self->{'text'};
63✔
240
}
241

242
=head2        length
243

244
Returns the length of the text.
245

246
=cut
247

248
sub length {
249
        my $self = shift;
4✔
250

251
        if(!defined($self->{'text'})) {
4✔
252
                return 0;
1✔
253
        }
254

255
        return length($self->{'text'});
3✔
256
}
257

258
=head2        trim
259

260
Removes leading and trailing spaces from the text.
261

262
=cut
263

264
sub trim {
265
        my $self = shift;
3✔
266

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

269
        return $self;
3✔
270
}
271

272
=head2        rtrim
273

274
Removes trailing spaces from the text.
275

276
=cut
277

278
sub rtrim {
279
        my $self = shift;
2✔
280

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

283
        return $self;
2✔
284
}
285

286
=head2        replace
287

288
Replaces words.
289

290
    use Data::Text;
291

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

297
=cut
298

299
sub replace {
300
        my $self = shift;
4✔
301

302
        # avoid assert failure in String::Clean
303
        if($self->{'text'}) {
4✔
304
                $self->{'clean'} ||= String::Clean->new();
3✔
305
                $self->{'text'} = $self->{'clean'}->replace(shift, $self->{'text'}, shift);
3✔
306
        }
307

308
        return $self;
4✔
309
}
310

311
=head2        appendconjunction
312

313
Add a list as a conjunction.  See L<Lingua::Conjunction>
314
Because of the way Data::Text works with quoting,
315
this code works
316

317
    my $d1 = Data::Text->new();
318
    my $d2 = Data::Text->new('a');
319
    my $d3 = Data::Text->new('b');
320

321
    # Prints "a and b\n"
322
    print $d1->appendconjunction($d2, $d3)->append("\n");
323

324
=cut
325

326
sub appendconjunction
327
{
328
        my $self = shift;
4✔
329

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

332
        return $self;
4✔
333
}
334

335
=head1 AUTHOR
336

337
Nigel Horne, C<< <njh at bandsman.co.uk> >>
338

339
=head1 BUGS
340

341
=head1 SEE ALSO
342

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

345
=head1 SUPPORT
346

347
You can find documentation for this module with the perldoc command.
348

349
    perldoc Data::Text
350

351
You can also look for information at:
352

353
=over 4
354

355
=item * MetaCPAN
356

357
L<https://metacpan.org/release/Data-Text>
358

359
=item * RT: CPAN's request tracker
360

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

363
=item * CPAN Testers' Matrix
364

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

367
=item * CPAN Testers Dependencies
368

369
L<http://deps.cpantesters.org/?module=Data::Text>
370

371
=back
372

373
=head1 LICENSE AND COPYRIGHT
374

375
Copyright 2021-2025 Nigel Horne.
376

377
This program is released under the following licence: GPL2
378

379
=cut
380

381
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