line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
######################################################################## |
2
|
|
|
|
|
|
|
# File: String.pm |
3
|
|
|
|
|
|
|
# Author: David Winters |
4
|
|
|
|
|
|
|
# RCS: $Id: String.pm,v 1.7 2000/02/08 02:36:40 winters Exp winters $ |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# A character string class. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# This file contains POD documentation that may be viewed with the |
9
|
|
|
|
|
|
|
# perldoc, pod2man, or pod2html utilities. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# Copyright (c) 1998-2000 David Winters. All rights reserved. |
12
|
|
|
|
|
|
|
# This program is free software; you can redistribute it |
13
|
|
|
|
|
|
|
# and/or modify it under the same terms as Perl itself. |
14
|
|
|
|
|
|
|
######################################################################## |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
package Persistent::DataType::String; |
17
|
|
|
|
|
|
|
require 5.004; |
18
|
|
|
|
|
|
|
|
19
|
5
|
|
|
5
|
|
25
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
253
|
|
20
|
5
|
|
|
5
|
|
27
|
use vars qw($VERSION $REVISION @ISA); |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
367
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
### we are a subclass of the all-powerful Persistent::DataType::Base class ### |
23
|
5
|
|
|
5
|
|
3252
|
use Persistent::DataType::Base; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
195
|
|
24
|
|
|
|
|
|
|
@ISA = qw(Persistent::DataType::Base); |
25
|
|
|
|
|
|
|
|
26
|
5
|
|
|
5
|
|
26
|
use Carp; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
3513
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
### copy version number from superclass ### |
29
|
|
|
|
|
|
|
$VERSION = $Persistent::DataType::Base::VERSION; |
30
|
|
|
|
|
|
|
$REVISION = (qw$Revision: 1.7 $)[1]; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 NAME |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Persistent::DataType::String - A Character String Class |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 SYNOPSIS |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
use Persistent::DataType::String; |
39
|
|
|
|
|
|
|
use English; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
eval { ### in case an exception is thrown ### |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
### allocate a string ### |
44
|
|
|
|
|
|
|
my $string = new Persistent::DataType::String($value, |
45
|
|
|
|
|
|
|
$max_length); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
### get/set value of string ### |
48
|
|
|
|
|
|
|
$value = $string->value($new_value); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
### get length of string ### |
51
|
|
|
|
|
|
|
my $length = $string->length(); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
### get/set maximum length of string ### |
54
|
|
|
|
|
|
|
my $max = $string->max_length($new_max); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
### returns 'eq' for strings ### |
57
|
|
|
|
|
|
|
my $cmp_op = $string->get_compare_op(); |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
if ($EVAL_ERROR) { ### catch those exceptions! ### |
61
|
|
|
|
|
|
|
print "An error occurred: $EVAL_ERROR\n"; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head1 ABSTRACT |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
This is a character string class used by the Persistent framework of |
67
|
|
|
|
|
|
|
classes to implement the attributes of objects. This class provides |
68
|
|
|
|
|
|
|
methods for accessing the value, length, maximum length, and |
69
|
|
|
|
|
|
|
comparison operator of a character string. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
This class is usually not invoked directly, at least not when used |
72
|
|
|
|
|
|
|
with the Persistent framework of classes. However, the constructor |
73
|
|
|
|
|
|
|
arguments of this class are usually of interest when defining the |
74
|
|
|
|
|
|
|
attributes of a Persistent object since the I method of |
75
|
|
|
|
|
|
|
the Persistent classes instantiates this class directly. Also, the |
76
|
|
|
|
|
|
|
arguments to the I method are of interest when dealing with the |
77
|
|
|
|
|
|
|
accessor methods of the Persistent classes since the accessor methods |
78
|
|
|
|
|
|
|
pass their arguments to the I method and return the string |
79
|
|
|
|
|
|
|
value from the I method. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
This class is part of the Persistent base package which is available |
82
|
|
|
|
|
|
|
from: |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
http://www.bigsnow.org/persistent |
85
|
|
|
|
|
|
|
ftp://ftp.bigsnow.org/pub/persistent |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 DESCRIPTION |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Before we get started describing the methods in detail, it should be |
90
|
|
|
|
|
|
|
noted that all error handling in this class is done with exceptions. |
91
|
|
|
|
|
|
|
So you should wrap an eval block around all of your code. Please see |
92
|
|
|
|
|
|
|
the L documentation for more information on exception |
93
|
|
|
|
|
|
|
handling in Perl. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head1 METHODS |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=cut |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
######################################################################## |
100
|
|
|
|
|
|
|
# |
101
|
|
|
|
|
|
|
# -------------------------------------------------------------------- |
102
|
|
|
|
|
|
|
# PUBLIC ABSTRACT METHODS OVERRIDDEN (REDEFINED) FROM THE PARENT CLASS |
103
|
|
|
|
|
|
|
# -------------------------------------------------------------------- |
104
|
|
|
|
|
|
|
# |
105
|
|
|
|
|
|
|
######################################################################## |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
######################################################################## |
108
|
|
|
|
|
|
|
# initialize |
109
|
|
|
|
|
|
|
######################################################################## |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 Constructor -- Creates the String Object |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
eval { |
114
|
|
|
|
|
|
|
my $string = new Persistent::DataType::String($value, |
115
|
|
|
|
|
|
|
$max_length); |
116
|
|
|
|
|
|
|
}; |
117
|
|
|
|
|
|
|
croak "Exception caught: $@" if $@; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Initializes a character string object. This method throws Perl |
120
|
|
|
|
|
|
|
execeptions so use it with an eval block. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Parameters: |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=over 4 |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item I<$value> |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Actual value of the string. This argument is optional and may be set |
129
|
|
|
|
|
|
|
to undef. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=item I<$max_length> |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Maximum length of the string value. This argument is optional and |
134
|
|
|
|
|
|
|
will be initialized to an unlimitied length (0) as a default. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=back |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=cut |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub initialize { |
141
|
0
|
|
|
0
|
0
|
0
|
my($this, $value, $max_length) = @_; |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
0
|
$this->_trace(); |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
|
|
|
0
|
$max_length = 0 if !defined($max_length); |
146
|
0
|
|
|
|
|
0
|
$this->max_length($max_length); |
147
|
0
|
|
|
|
|
0
|
$this->value($value); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
######################################################################## |
151
|
|
|
|
|
|
|
# value |
152
|
|
|
|
|
|
|
######################################################################## |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=head2 value -- Accesses the Value of the String |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
eval { |
157
|
|
|
|
|
|
|
### set the value ### |
158
|
|
|
|
|
|
|
$string->value($value); |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
### get the value ### |
161
|
|
|
|
|
|
|
$value = $string->value(); |
162
|
|
|
|
|
|
|
}; |
163
|
|
|
|
|
|
|
croak "Exception caught: $@" if $@; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Sets the value of the string and/or returns the value. This method |
166
|
|
|
|
|
|
|
throws Perl execeptions so use it with an eval block. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Parameters: |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=over 4 |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item I<$value> |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Actual value of the string. This argument is optional and may be set |
175
|
|
|
|
|
|
|
to undef. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=back |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=cut |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub value { |
182
|
267
|
50
|
66
|
267
|
1
|
1007
|
(@_ == 1 || @_ == 2) or croak 'Usage: $obj->value([$value])'; |
183
|
267
|
|
|
|
|
279
|
my $this = shift; |
184
|
267
|
50
|
|
|
|
504
|
ref($this) or croak "$this is not an object"; |
185
|
|
|
|
|
|
|
|
186
|
267
|
|
|
|
|
857
|
$this->_trace(); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
### set the value ### |
189
|
267
|
100
|
|
|
|
513
|
if (@_) { |
190
|
122
|
|
|
|
|
149
|
my $value = shift; |
191
|
122
|
50
|
66
|
|
|
427
|
$value = undef if defined $value && $value eq ''; |
192
|
122
|
|
|
|
|
317
|
my $max_length = $this->max_length(); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
### check the length ### |
195
|
122
|
50
|
66
|
|
|
692
|
if (defined $value && $max_length > 0 && length($value) > $max_length) { |
|
|
|
66
|
|
|
|
|
196
|
0
|
|
|
|
|
0
|
croak "'$value' is longer than $max_length character(s)"; |
197
|
|
|
|
|
|
|
} else { |
198
|
122
|
|
|
|
|
264
|
$this->{Data}->{Value} = $value; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
### return the value ### |
203
|
267
|
|
|
|
|
947
|
$this->{Data}->{Value}; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
######################################################################## |
207
|
|
|
|
|
|
|
# get_compare_op |
208
|
|
|
|
|
|
|
######################################################################## |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head2 get_compare_op -- Returns the Comparison Operator |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
$cmp_op = $string->get_compare_op(); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Returns the comparison operator for the String class which is 'cmp'. |
215
|
|
|
|
|
|
|
This method does not throw execeptions. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Parameters: |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=over 4 |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=item None |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=back |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=cut |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub get_compare_op { |
228
|
2
|
50
|
|
2
|
1
|
7
|
(@_ == 1) or croak 'Usage: $obj->get_compare_op()'; |
229
|
2
|
|
|
|
|
3
|
my $this = shift; |
230
|
2
|
50
|
|
|
|
21
|
ref($this) or croak "$this is not an object"; |
231
|
|
|
|
|
|
|
|
232
|
2
|
|
|
|
|
6
|
$this->_trace(); |
233
|
|
|
|
|
|
|
|
234
|
2
|
|
|
|
|
4
|
'cmp'; ### string comparison operator ### |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
######################################################################## |
238
|
|
|
|
|
|
|
# |
239
|
|
|
|
|
|
|
# -------------- |
240
|
|
|
|
|
|
|
# PUBLIC METHODS |
241
|
|
|
|
|
|
|
# -------------- |
242
|
|
|
|
|
|
|
# |
243
|
|
|
|
|
|
|
######################################################################## |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
######################################################################## |
246
|
|
|
|
|
|
|
# length |
247
|
|
|
|
|
|
|
######################################################################## |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=head2 length -- Returns the Length of the String |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
eval { |
252
|
|
|
|
|
|
|
$value = $string->length(); |
253
|
|
|
|
|
|
|
}; |
254
|
|
|
|
|
|
|
croak "Exception caught: $@" if $@; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Returns the length of the string. This method throws Perl execeptions |
257
|
|
|
|
|
|
|
so use it with an eval block. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Parameters: |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=over 4 |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=item None |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=back |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub length { |
270
|
0
|
0
|
|
0
|
1
|
0
|
(@_ > 0) or croak 'Usage: $obj->length()'; |
271
|
0
|
|
|
|
|
0
|
my $this = shift; |
272
|
0
|
0
|
|
|
|
0
|
ref($this) or croak "$this is not an object"; |
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
0
|
$this->_trace(); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
### no setting allowed ### |
277
|
0
|
0
|
|
|
|
0
|
croak "length is read-only" if @_; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
### return the length ### |
280
|
0
|
0
|
|
|
|
0
|
length(defined $this->value() ? $this->value() : ''); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
######################################################################## |
284
|
|
|
|
|
|
|
# max_length |
285
|
|
|
|
|
|
|
######################################################################## |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head2 max_length -- Accesses the Maximum Length of the String |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
eval { |
290
|
|
|
|
|
|
|
### set the maximum length ### |
291
|
|
|
|
|
|
|
$string->max_length($new_max); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
### get the maximum length ### |
294
|
|
|
|
|
|
|
$max_length = $string->max_length(); |
295
|
|
|
|
|
|
|
}; |
296
|
|
|
|
|
|
|
croak "Exception caught: $@" if $@; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
Sets the maximum length of the string and/or returns it. This method |
299
|
|
|
|
|
|
|
throws Perl execeptions so use it with an eval block. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
Parameters: |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=over 4 |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=item I<$max_length> |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
Maximum length of the string value. If the maximum length is set to |
308
|
|
|
|
|
|
|
undef, the empty string (''), or 0, then the string has an unlimited |
309
|
|
|
|
|
|
|
maximum length. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=back |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=cut |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub max_length { |
316
|
166
|
50
|
66
|
166
|
1
|
508
|
(@_ == 1 || @_ == 2) or croak 'Usage: $obj->max_length([$max_length])'; |
317
|
166
|
|
|
|
|
171
|
my $this = shift; |
318
|
166
|
50
|
|
|
|
308
|
ref($this) or croak "$this is not an object"; |
319
|
|
|
|
|
|
|
|
320
|
166
|
|
|
|
|
405
|
$this->_trace(); |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
### set the maximum length ### |
323
|
166
|
100
|
|
|
|
319
|
if (@_) { |
324
|
44
|
|
|
|
|
51
|
my $max_length = shift; |
325
|
44
|
50
|
33
|
|
|
190
|
$max_length = 0 if !defined($max_length) || $max_length eq ''; |
326
|
44
|
50
|
|
|
|
92
|
croak "max_length($max_length) must be >= 0" if $max_length < 0; |
327
|
44
|
|
|
|
|
128
|
$this->{Data}->{MaxLength} = $max_length; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
### shorten the value if too long ### |
330
|
44
|
50
|
|
|
|
94
|
if ($max_length > 0) { |
331
|
44
|
|
|
|
|
115
|
my $value = $this->value(); |
332
|
44
|
50
|
33
|
|
|
125
|
if (defined $value && CORE::length($value) > $max_length) { |
333
|
0
|
|
|
|
|
0
|
$value = substr($value, 0, $max_length); |
334
|
0
|
|
|
|
|
0
|
$this->value($value); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
### return the length ### |
340
|
166
|
|
|
|
|
484
|
$this->{Data}->{MaxLength}; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
### end of library ### |
344
|
|
|
|
|
|
|
1; |
345
|
|
|
|
|
|
|
__END__ |