line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
# = HISTORY SECTION ===================================================================== |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# --------------------------------------------------------------------------------------- |
5
|
|
|
|
|
|
|
# version | date | author | changes |
6
|
|
|
|
|
|
|
# --------------------------------------------------------------------------------------- |
7
|
|
|
|
|
|
|
# 2.03 |29.02.00| JSTENZEL | corrected perl version demand; |
8
|
|
|
|
|
|
|
# | | JSTENZEL | slight POD and comment improvements; |
9
|
|
|
|
|
|
|
# 2.02 |06.01.00| JSTENZEL | started translation of POD; |
10
|
|
|
|
|
|
|
# | | JSTENZEL | replaced bug() by Carp::confess(); |
11
|
|
|
|
|
|
|
# | | JSTENZEL | integrated inhouse modules and funtions (like filters); |
12
|
|
|
|
|
|
|
# |15.01.00| JSTENZEL | improved source filters; |
13
|
|
|
|
|
|
|
# 2.01 | | JSTENZEL | ; |
14
|
|
|
|
|
|
|
# 2.00 |25.10.99| JSTENZEL | added the delayed sending feature; |
15
|
|
|
|
|
|
|
# |26.10.99| JSTENZEL | formatted POD to be better prepared for pod2text; |
16
|
|
|
|
|
|
|
# | | JSTENZEL | added traces; |
17
|
|
|
|
|
|
|
# --------------------------------------------------------------------------------------- |
18
|
|
|
|
|
|
|
# 1.05 |30.09.99| JSTENZEL | extended traces; |
19
|
|
|
|
|
|
|
# 1.04 |15.09.99| JSTENZEL | documented noAssert; |
20
|
|
|
|
|
|
|
# 1.03 |10.09.99| JSTENZEL | improvements to avoid warnings; |
21
|
|
|
|
|
|
|
# | | JSTENZEL | constructor now checks if the passed handle is open; |
22
|
|
|
|
|
|
|
# | | JSTENZEL | all methods now check if the the handle is still opened; |
23
|
|
|
|
|
|
|
# | | JSTENZEL | improved POD formatting; |
24
|
|
|
|
|
|
|
# | | JSTENZEL | message fix; |
25
|
|
|
|
|
|
|
# 1.02 |09.09.99| JSTENZEL | comment fixes; |
26
|
|
|
|
|
|
|
# | | JSTENZEL | better fcntl() calls (saving original flags really), |
27
|
|
|
|
|
|
|
# | | | inspired by code pieces in "Advanced Perl Programming"; |
28
|
|
|
|
|
|
|
# | | JSTENZEL | non blocking mode is now activated only during transfers; |
29
|
|
|
|
|
|
|
# | | JSTENZEL | modified some traces; |
30
|
|
|
|
|
|
|
# 1.01 |09.09.99| JSTENZEL | adding initial select() calls to avoid obstipation trouble; |
31
|
|
|
|
|
|
|
# | | JSTENZEL | using IO::Select now; |
32
|
|
|
|
|
|
|
# | | JSTENZEL | the waiting select() call to complete incomplete transfers |
33
|
|
|
|
|
|
|
# | | | now waits SPECIFICALLY on the socket AND with timeout - |
34
|
|
|
|
|
|
|
# | | | so if the socket is ready before the timeout period ends, |
35
|
|
|
|
|
|
|
# | | | the process is accelerated now (select() returns earlier); |
36
|
|
|
|
|
|
|
# | | JSTENZEL | SIGPIPE is now temporarily disabled in send() and receive() |
37
|
|
|
|
|
|
|
# | | | to avoid trouble with sockets closing during a transfer; |
38
|
|
|
|
|
|
|
# 1.00 |07.09.99| JSTENZEL | new, derived from Admin::IO::common; |
39
|
|
|
|
|
|
|
# --------------------------------------------------------------------------------------- |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# = POD SECTION ========================================================================= |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 NAME |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
B - implements a length based IPC protocol |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 SCRIPT DATA |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
This manual describes version B<2.03>. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 DESCRIPTION |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Interprocess communication often uses line (or record) oriented protocols. FTP, |
54
|
|
|
|
|
|
|
for example, usually is such a protocol: a client sends a command (e.g. "LS") which is |
55
|
|
|
|
|
|
|
completed by a carriage return. This carriage return is included in the command |
56
|
|
|
|
|
|
|
which is sent to the server process (FTP deamon) which could implement its reading |
57
|
|
|
|
|
|
|
in a way like this: |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
while ($cmd=) |
60
|
|
|
|
|
|
|
{ |
61
|
|
|
|
|
|
|
chomp($cmd); |
62
|
|
|
|
|
|
|
performCommand($cmd); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Well, such record oriented, blocked protocols are very useful and simply to implement, |
66
|
|
|
|
|
|
|
but sometimes there is a need to transfer more complex data which has no trailing carriage |
67
|
|
|
|
|
|
|
return, or data which may include more carriage returns inside the message which should |
68
|
|
|
|
|
|
|
not cause the reciepient to think the message is already complete while it is really not. |
69
|
|
|
|
|
|
|
Even if you choose to replace carriage returns by some obscure delimiters, the same could |
70
|
|
|
|
|
|
|
happen again until you switch to a protocol which does not flag the end of a message by |
71
|
|
|
|
|
|
|
special strings. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
On the other hand, if there is no final carriage return (or whatever flag string) within |
74
|
|
|
|
|
|
|
a message, the end of the message has to be marked another way to avoid blocking by endless |
75
|
|
|
|
|
|
|
waiting for more message parts. A simple way to provide this is to precede a message by a |
76
|
|
|
|
|
|
|
prefix which includes the length of the remaining (real) message. A reciepient reads this |
77
|
|
|
|
|
|
|
prefix, decodes the length information and continues reading until the announced number of |
78
|
|
|
|
|
|
|
bytes came in. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
B provides a class to build objects which transparently perform such "Iength |
81
|
|
|
|
|
|
|
Iriven Iransfer". A user sends and receives messages by simple method calls, while |
82
|
|
|
|
|
|
|
the LDT objects perform the complete translation into and from LDT messages (with prefix) |
83
|
|
|
|
|
|
|
and all the necessary low level IO handling to transfer stream messages on non blocked handles. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
B objects can be configured to transfer simle string messages as well as complex |
86
|
|
|
|
|
|
|
data structures. Additionally, they allow to delay the transfer of certain messages in a user |
87
|
|
|
|
|
|
|
defined way. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 SYNOPSIS |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Load the module as usual: |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
use IPC::LDT; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Make an LDT object for every handle that should be used in an LDT communication: |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my $asciiClient=new IPC::LDT(handle=>HANDLE); |
98
|
|
|
|
|
|
|
my $objectClient=new IPC::LDT(handle=>HANDLE, objectMode=>1); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Now you can send and receive data: |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
$data=$asciiClient->receive; |
103
|
|
|
|
|
|
|
@objects=$objectClient->receive; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
B<> |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$asciiClient=$client->send("This is", " a message."); |
108
|
|
|
|
|
|
|
$objectClient=$client->send("These are data:", [qw(a b c)]); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# check perl version |
113
|
|
|
|
|
|
|
require 5.00503; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# = PACKAGE SECTION (internal helper packages) ========================================== |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# declare package |
118
|
|
|
|
|
|
|
package IPC::LDT::Filter::MeTrace; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# declare package version |
121
|
|
|
|
|
|
|
$VERSION=$VERSION=1.00; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# set pragmas |
124
|
4
|
|
|
4
|
|
3582
|
use strict; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
157
|
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# load CPAN modules |
127
|
4
|
|
|
4
|
|
5460
|
use Filter::Util::Call; |
|
4
|
|
|
|
|
8196
|
|
|
4
|
|
|
|
|
988
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# The main function - see the Filter::Util::Call manual for details. |
130
|
|
|
|
|
|
|
# I'm using the closure variant here. It's shorter. |
131
|
|
|
|
|
|
|
sub import |
132
|
|
|
|
|
|
|
{ |
133
|
|
|
|
|
|
|
# get parameter |
134
|
4
|
|
|
4
|
|
8
|
my ($self)=@_; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# define and register the filter |
137
|
|
|
|
|
|
|
filter_add( |
138
|
|
|
|
|
|
|
sub |
139
|
|
|
|
|
|
|
{ |
140
|
|
|
|
|
|
|
# get parameter |
141
|
4488
|
|
|
4488
|
|
4899
|
my ($self)=@_; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# declare variable |
144
|
4488
|
|
|
|
|
4366
|
my ($status); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# remove trace code ... |
147
|
4488
|
100
|
|
|
|
37645
|
s/\$me->trace\(.+?\);//g if ($status=filter_read())>0; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# reply state |
150
|
4488
|
|
|
|
|
17914
|
$status; |
151
|
|
|
|
|
|
|
} |
152
|
4
|
|
|
|
|
29
|
); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# reply a true value to flag successfull init |
156
|
|
|
|
|
|
|
1; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# reset pragmas; |
159
|
4
|
|
|
4
|
|
31
|
no strict; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
215
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# declare package |
162
|
|
|
|
|
|
|
package IPC::LDT::Filter::Assert; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# declare package version |
165
|
|
|
|
|
|
|
$VERSION=$VERSION=1.00; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# set pragmas |
168
|
4
|
|
|
4
|
|
18
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
108
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# load CPAN modules |
171
|
4
|
|
|
4
|
|
19
|
use Filter::Util::Call; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
899
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# The main function - see the Filter::Util::Call manual for details. |
174
|
|
|
|
|
|
|
# I'm using the closure variant here. It's shorter. |
175
|
|
|
|
|
|
|
sub import |
176
|
|
|
|
|
|
|
{ |
177
|
|
|
|
|
|
|
# get parameter |
178
|
4
|
|
|
4
|
|
15
|
my ($self, $noAssert)=@_; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# define and register the filter |
181
|
|
|
|
|
|
|
filter_add( |
182
|
|
|
|
|
|
|
sub |
183
|
|
|
|
|
|
|
{ |
184
|
|
|
|
|
|
|
# get parameter |
185
|
4488
|
|
|
4488
|
|
20866
|
my ($self)=@_; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# declare variable |
188
|
4488
|
|
|
|
|
4413
|
my ($status); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# remove trace code ... |
191
|
4488
|
100
|
|
|
|
10398
|
if (($status=filter_read())>0) |
192
|
|
|
|
|
|
|
{ |
193
|
4484
|
50
|
|
|
|
8902
|
if ($noAssert) |
|
0
|
|
|
|
|
0
|
|
194
|
4484
|
|
|
|
|
7439
|
{s/bug\(.+?\)[^;]*?;//g;} |
195
|
|
|
|
|
|
|
else |
196
|
|
|
|
|
|
|
{s/bug\((['"])/confess\($1\[BUG\] /g;} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# reply state |
200
|
4488
|
|
|
|
|
111240
|
$status; |
201
|
|
|
|
|
|
|
} |
202
|
4
|
|
|
|
|
21
|
); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# reply a true value to flag successfull init |
206
|
|
|
|
|
|
|
1; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# reset pragmas |
209
|
4
|
|
|
4
|
|
21
|
no strict; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
296
|
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# = PACKAGE SECTION ====================================================================== |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# declare package |
214
|
|
|
|
|
|
|
package IPC::LDT; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# filters |
217
|
|
|
|
|
|
|
BEGIN |
218
|
|
|
|
|
|
|
{ |
219
|
|
|
|
|
|
|
# deactivate compiler checks |
220
|
4
|
|
|
4
|
|
23
|
no strict 'refs'; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
399
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# trace filter (first line to avoid useless warnings) |
223
|
4
|
50
|
|
4
|
|
12
|
defined ${join('::', __PACKAGE__, 'Trace')} ? 1 : 1; |
|
4
|
|
|
|
|
41
|
|
224
|
4
|
50
|
|
|
|
7
|
IPC::LDT::Filter::MeTrace::import() unless ${join('::', __PACKAGE__, 'Trace')}; |
|
4
|
|
|
|
|
35
|
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# assertion filter (first line to avoid useless warnings) |
227
|
4
|
50
|
|
|
|
99
|
defined ${join('::', __PACKAGE__, 'noAssert')} ? 1 : 1; |
|
4
|
|
|
|
|
27
|
|
228
|
4
|
|
|
|
|
15
|
IPC::LDT::Filter::Assert::import(${join('::', __PACKAGE__, 'noAssert')}); |
|
4
|
|
|
|
|
48
|
|
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
4
|
|
|
4
|
|
22
|
use Exporter (); |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
17
|
|
232
|
|
|
|
|
|
|
@ISA=qw(Exporter); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# declare package version |
235
|
|
|
|
|
|
|
$VERSION=2.03; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# declare fields |
238
|
4
|
|
|
|
|
28
|
use fields qw( |
239
|
|
|
|
|
|
|
delayFilter |
240
|
|
|
|
|
|
|
delayQueue |
241
|
|
|
|
|
|
|
fileno |
242
|
|
|
|
|
|
|
handle |
243
|
|
|
|
|
|
|
msg |
244
|
|
|
|
|
|
|
objectMode |
245
|
|
|
|
|
|
|
rc |
246
|
|
|
|
|
|
|
select |
247
|
|
|
|
|
|
|
startblockLength |
248
|
|
|
|
|
|
|
traceMode |
249
|
4
|
|
|
4
|
|
6003
|
); |
|
4
|
|
|
|
|
7400
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=pod |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head2 Exports |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
No symbol is exported by default. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
You can explicitly import LDT_CLOSED, LDT_READ_INCOMPLETE, LDT_WRITE_INCOMPLETE, |
258
|
|
|
|
|
|
|
LDT_OK and LDT_INFO_LENGTH which are described in section I. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=cut |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# declare exporter modules |
263
|
|
|
|
|
|
|
@EXPORT=qw(); |
264
|
|
|
|
|
|
|
@EXPORT_OK=qw( |
265
|
|
|
|
|
|
|
LDT_CLOSED |
266
|
|
|
|
|
|
|
LDT_INFO_LENGTH |
267
|
|
|
|
|
|
|
LDT_OK |
268
|
|
|
|
|
|
|
LDT_READ_INCOMPLETE |
269
|
|
|
|
|
|
|
LDT_WRITE_INCOMPLETE |
270
|
|
|
|
|
|
|
); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# = PRAGMA SECTION ======================================================================= |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# set pragmas |
275
|
4
|
|
|
4
|
|
30
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
79
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# = LIBRARY SECTION ====================================================================== |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# load modules |
280
|
4
|
|
|
4
|
|
23
|
use Carp; # message handling; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
245
|
|
281
|
4
|
|
|
4
|
|
4173
|
use POSIX; |
|
4
|
|
|
|
|
36996
|
|
|
4
|
|
|
|
|
30
|
|
282
|
4
|
|
|
4
|
|
5679
|
use Storable; # data serialization; |
|
4
|
|
|
|
|
16534
|
|
|
4
|
|
|
|
|
272
|
|
283
|
4
|
|
|
4
|
|
349526
|
use IO::Select; # a select() wrapper; |
|
4
|
|
|
|
|
7964
|
|
|
4
|
|
|
|
|
154
|
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# = CODE SECTION ========================================================================= |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# exportable constants |
288
|
4
|
|
|
4
|
|
30
|
use constant LDT_INFO_LENGTH=>8; # length of a handle message length string; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
274
|
|
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# internal constants |
291
|
4
|
|
|
4
|
|
25
|
use constant HANDLE_RETRY_COUNT=>100; # number of trials to complete a message from a handle; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
135
|
|
292
|
4
|
|
|
4
|
|
21
|
use constant HANDLE_RETRY_DELAY=>0.2; # number of seconds until a new attempt to complete a reading; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
114
|
|
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=pod |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=head1 Global Variables |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=head2 Settings |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=over 4 |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=item Traces |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
You may set the module variable B<$IPC::LDT::Trace> I the module |
305
|
|
|
|
|
|
|
is loaded (that means in a I block before the "use" statement) to |
306
|
|
|
|
|
|
|
activate the built in trace code. If not prepared this way, all runtime |
307
|
|
|
|
|
|
|
trace settings (e.g. via the constructor parameter I) will take |
308
|
|
|
|
|
|
|
I because the trace code will have been filtered out at compile |
309
|
|
|
|
|
|
|
time for reasons of performance. (This means that no trace message will |
310
|
|
|
|
|
|
|
appear.) |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
I B<$IPC::LDT::Trace> is set before the module is loaded, te builtin |
313
|
|
|
|
|
|
|
trace code is active and can be deactivated or reactivated at runtime |
314
|
|
|
|
|
|
|
globally (for all objects of this class) by unsetting or resetting of |
315
|
|
|
|
|
|
|
this module variable. Alternatively, you may choose to control traces |
316
|
|
|
|
|
|
|
for certain objects by using the constructor parameter I. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
So, if you want to trace every object, set B<$IPC::LDT::Trace> initially |
319
|
|
|
|
|
|
|
and load the module. If you want to trace only certain objects, additionally |
320
|
|
|
|
|
|
|
unset B<$IPC::LDT::Trace> after the module is loaded and construct these |
321
|
|
|
|
|
|
|
certain objects with constructor flag I. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=item Assertions |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
It is a good tradition to build self checks into a code. This makes |
326
|
|
|
|
|
|
|
code execution more secure and simplifies bug searching after a failure. |
327
|
|
|
|
|
|
|
On the other hand, self checks decrease code performance. That's why |
328
|
|
|
|
|
|
|
you can filter out the self checking code (which is built in and activated |
329
|
|
|
|
|
|
|
by default) by setting the module variable B<$IPC::LDT::noAssert> I |
330
|
|
|
|
|
|
|
the module is loaded. The checks will be removed from the code before |
331
|
|
|
|
|
|
|
they reach the compiler. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Setting or unsetting this variable after the module was loaded takes |
334
|
|
|
|
|
|
|
I. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=back |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=head1 CONSTANTS |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head2 Error codes |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=over 4 |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=item LDT_CLOSED |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
a handle related to an LDT object was closed when reading or writing |
347
|
|
|
|
|
|
|
should be performed on it; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=item LDT_READ_INCOMPLETE |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
a message could not be (completely) read within the set number of |
352
|
|
|
|
|
|
|
trials; |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=item LDT_WRITE_INCOMPLETE |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
a message could not be (completely) written within the set number of |
357
|
|
|
|
|
|
|
trials; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=back |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=cut |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# error constants - these are made public (but not exported by default) |
364
|
4
|
|
|
4
|
|
27
|
use constant LDT_OK =>100; # all right; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
205
|
|
365
|
4
|
|
|
4
|
|
21
|
use constant LDT_CLOSED =>-1; # the handle was closed while it should be read; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
112
|
|
366
|
4
|
|
|
4
|
|
21
|
use constant LDT_READ_INCOMPLETE =>-2; # a handle message could not be read completely; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
133
|
|
367
|
4
|
|
|
4
|
|
19
|
use constant LDT_WRITE_INCOMPLETE=>-3; # a handle message could not be read completely; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
102
|
|
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=pod |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head1 METHODS |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=cut |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
377
|
|
|
|
|
|
|
=pod |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=head2 new() |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
The constructor builds a new object for data transfers. All parameters |
382
|
|
|
|
|
|
|
except of the class name are passed named (this means, by a hash). |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
B |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=over 4 |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item Class name |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
the first parameter as usual - passed implicitly by Perl: |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
my $asciiClient=new IPC::LDT(...); |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
The method form of construtor calls is not supported. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=item handle |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
The handle to be used to perform the communication. It has to be opened |
399
|
|
|
|
|
|
|
already and will not be closed if the object will be destroyed. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
Example: |
402
|
|
|
|
|
|
|
handle => SERVER |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
A closed handle is I accepted. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
You can use whatever type of handle meets your needs. Usually it is a socket |
407
|
|
|
|
|
|
|
or anything derived from a socket. For example, if you want to perform secure |
408
|
|
|
|
|
|
|
IPC, the handle could be made by Net::SSL. There is only one precondition: |
409
|
|
|
|
|
|
|
the handle has to provide a B method. (You can enorce this even for |
410
|
|
|
|
|
|
|
Perls default handles by simply using B.) |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item objectMode |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Pass a true value if you want to transfer data structures. If this |
415
|
|
|
|
|
|
|
setting is missed or a "false" value is passed, the object will transfer |
416
|
|
|
|
|
|
|
strings. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
Data structures will be serialized via I for transfer. Because |
419
|
|
|
|
|
|
|
of this, such a communication is usually restricted to partners which could |
420
|
|
|
|
|
|
|
use I methods as well to reconstruct the data structures (which |
421
|
|
|
|
|
|
|
means that they are written in Perl). |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
String transfer objects, on the other hand, can be used to cimmunicate with |
424
|
|
|
|
|
|
|
any partner who speaks the LDT protocol. We use Java and C clients as well |
425
|
|
|
|
|
|
|
as Perl ones, for example. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
Example: |
428
|
|
|
|
|
|
|
objectMode => 1 |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
The transfer mode may be changed while the object is alive by using the |
431
|
|
|
|
|
|
|
methods I and I. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=item startblockLength |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sets the length of the initial info block which preceds every LDT |
436
|
|
|
|
|
|
|
message coding the length of the remaining message. This setting is |
437
|
|
|
|
|
|
|
done in bytes. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
If no value is provided, the builtin default value I |
440
|
|
|
|
|
|
|
is used. (This value can be imported in your own code, see section |
441
|
|
|
|
|
|
|
"I" for details.) I is designed to meet |
442
|
|
|
|
|
|
|
usual needs. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Example: |
445
|
|
|
|
|
|
|
startblockLength => 4 |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=item traceMode |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Set this flag to a true value if you want to trace to actions of the |
450
|
|
|
|
|
|
|
module. If set, messages will be displayed on STDERR reporting what |
451
|
|
|
|
|
|
|
is going on. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
Traces for objects of this class can be activated (regardless of |
454
|
|
|
|
|
|
|
this constructor parameter) via I<$IPC::LDT::Trace>. This is described |
455
|
|
|
|
|
|
|
more detailed in section "I". |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
Example: |
458
|
|
|
|
|
|
|
traceMode => 1 |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=back |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
B |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
A successfull constructor call replies the new object. A failed call |
465
|
|
|
|
|
|
|
replies an undefined value. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
B |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
my $asciiClient=new IPC::LDT(handle=>HANDLE); |
470
|
|
|
|
|
|
|
my $objectClient=new IPC::LDT(handle=>HANDLE, objectMode=>1); |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=cut |
473
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
474
|
|
|
|
|
|
|
sub new |
475
|
|
|
|
|
|
|
{ |
476
|
|
|
|
|
|
|
# get parameters |
477
|
4
|
50
|
|
4
|
1
|
1150
|
bug("Number of parameters should be even") unless @_ % 2; |
478
|
4
|
|
|
|
|
31
|
my ($class, %switches)=@_; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# and check them |
481
|
4
|
50
|
|
|
|
21
|
bug("Missing class name parameter") unless $class; |
482
|
4
|
50
|
|
|
|
17
|
bug("Constructor called as method, use copy() method instead") if ref($class); |
483
|
4
|
50
|
33
|
|
|
55
|
bug("Missing handle parameter") unless exists $switches{'handle'} and $switches{'handle'}; |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
# declare function variables |
486
|
4
|
|
|
|
|
9
|
my ($me); |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# make new object |
489
|
|
|
|
|
|
|
{ |
490
|
4
|
|
|
4
|
|
36
|
no strict 'refs'; |
|
4
|
|
|
|
|
19
|
|
|
4
|
|
|
|
|
96
|
|
|
4
|
|
|
|
|
8
|
|
491
|
4
|
|
|
|
|
10
|
$me=bless([\%{"$class\::FIELDS"}], $class); |
|
4
|
|
|
|
|
47
|
|
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
# check the handle for being valid and open |
495
|
4
|
50
|
|
|
|
64
|
if (defined $switches{'handle'}->fileno) |
496
|
|
|
|
|
|
|
{ |
497
|
|
|
|
|
|
|
# build and init the object |
498
|
4
|
|
|
|
|
1032
|
$me->{'handle'}=$switches{'handle'}; |
499
|
0
|
|
|
|
|
0
|
$me->{'fileno'}=$me->{'handle'}->fileno; |
500
|
0
|
|
|
|
|
0
|
$me->{'msg'}=$me->{'rc'}=''; |
501
|
0
|
0
|
0
|
|
|
0
|
$me->{'objectMode'}=(exists $switches{'objectMode'} and $switches{'objectMode'}) ? 1 : 0; |
502
|
0
|
0
|
0
|
|
|
0
|
$me->{'startblockLength'}=(exists $switches{'startblockLength'} and $switches{'startblockLength'}>0) ? $switches{'startblockLength'} : LDT_INFO_LENGTH; |
503
|
0
|
0
|
0
|
|
|
0
|
$me->{'traceMode'}=(exists $switches{'trace'} and $switches{'trace'}) ? 1: 0; |
504
|
0
|
|
|
|
|
0
|
$me->{'select'}=new IO::Select($me->{'handle'}); |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# trace, if necessary |
507
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: object is made."); |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# reply the new object |
510
|
0
|
|
|
|
|
0
|
return $me; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
else |
513
|
|
|
|
|
|
|
{ |
514
|
|
|
|
|
|
|
# invalid or closed handle passed |
515
|
0
|
|
|
|
|
0
|
return undef; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# internal method |
521
|
|
|
|
|
|
|
sub DESTROY |
522
|
|
|
|
|
|
|
{ |
523
|
|
|
|
|
|
|
# get and check parameters |
524
|
4
|
|
|
4
|
|
14
|
my ($me)=@_; |
525
|
4
|
50
|
|
|
|
22
|
bug("Missed object parameter") unless $me; |
526
|
4
|
50
|
|
|
|
38
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# get fileno (and handle status this way) |
529
|
4
|
|
|
|
|
|
my $fileno=$me->{'handle'}->fileno; |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# trace, if necessary |
532
|
|
|
|
|
|
|
$me->trace("LDT ${\($fileno?$fileno:qq(with closed handle, was $me->{'fileno'}))}: object dies. Queue is", (defined $me->{'delayQueue'} and @{$me->{'delayQueue'}}) ? 'filled.' : 'empty.'); |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
537
|
|
|
|
|
|
|
=pod |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=head2 setObjectMode() |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
Switches the LDT object to "object trasnfer mode" which means that |
542
|
|
|
|
|
|
|
is can send and receive Perl data structures now. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Runtime changes of the transfer mode have to be exactly synchronized |
545
|
|
|
|
|
|
|
with the partner the object is talking with. See the constructor (I) |
546
|
|
|
|
|
|
|
description for details. |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
B |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=over 4 |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=item object |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
An LDT object made by I. |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=back |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
B |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
$asciiClient->setObjectMode; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=cut |
563
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
564
|
|
|
|
|
|
|
sub setObjectMode |
565
|
|
|
|
|
|
|
{ |
566
|
|
|
|
|
|
|
# get and check parameters |
567
|
0
|
|
|
0
|
1
|
|
my ($me)=@_; |
568
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
569
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
# trace, if necessary |
572
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: object switches into object mode."); |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
# modify mode |
575
|
0
|
|
|
|
|
|
$me->{'objectMode'}=1; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
580
|
|
|
|
|
|
|
=pod |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=head2 setAsciiMode() |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
Switches the LDT object to "ASCII trasnfer mode" which means that |
585
|
|
|
|
|
|
|
is sends and receives strings now. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
Runtime changes of the transfer mode have to be exactly synchronized |
588
|
|
|
|
|
|
|
with the partner the object is talking with. See the constructor (I) |
589
|
|
|
|
|
|
|
description for details. |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
B |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=over 4 |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=item object |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
An LDT object made by I. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=back |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
B |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
$objectClient->setAsciiMode; |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=cut |
606
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
607
|
|
|
|
|
|
|
sub setAsciiMode |
608
|
|
|
|
|
|
|
{ |
609
|
|
|
|
|
|
|
# get and check parameters |
610
|
0
|
|
|
0
|
1
|
|
my ($me)=@_; |
611
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
612
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# trace, if necessary |
615
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: objekt switches into ASCII mode."); |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
# modify mode |
618
|
0
|
|
|
|
|
|
$me->{'objectMode'}=0; |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
623
|
|
|
|
|
|
|
=pod |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=head2 delay() |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
Sometimes you do not want to send messages immediatly but buffer |
628
|
|
|
|
|
|
|
them for later delivery, e.g. to set up a certain send order. You |
629
|
|
|
|
|
|
|
can use I to install a filter which enforces the LDT object |
630
|
|
|
|
|
|
|
to delay the delivery of all matching messages until the next call |
631
|
|
|
|
|
|
|
of I. |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
The filter is implemented as a callback of I. As long as it |
634
|
|
|
|
|
|
|
is set, I calls it to check a message for sending or buffering |
635
|
|
|
|
|
|
|
it. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
You can overwrite a set filter by a subsequent call of I. |
638
|
|
|
|
|
|
|
Messages already collected will remain collected. |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
To send delayed messages you have to call I. |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
If the object is detroyed while messages are still buffered, |
643
|
|
|
|
|
|
|
they will not be delivered but lost. |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
B |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=over 4 |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=item object |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
An LDT object made by I. |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
=item filter |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
A code reference. It should await a reference to an array which |
656
|
|
|
|
|
|
|
will contain the message (possibly in parts). It should reply |
657
|
|
|
|
|
|
|
a true or false value to flag if the passed message has to be delayed. |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
It is recommended to provide a I function because it will be |
660
|
|
|
|
|
|
|
called everytime I will be invoked. |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=back |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
B |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
$ldt->delay(\&filter); |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
with filter() defined as |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
sub filter |
671
|
|
|
|
|
|
|
{ |
672
|
|
|
|
|
|
|
# get and check parameters |
673
|
|
|
|
|
|
|
my ($msg)=@_; |
674
|
|
|
|
|
|
|
confess "Missed message parameter" unless $msg; |
675
|
|
|
|
|
|
|
confess "Message parameter is no array reference" |
676
|
|
|
|
|
|
|
unless ref($msg) and ref($msg) eq 'ARRAY'; |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
C<> |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
# check something |
681
|
|
|
|
|
|
|
$msg->[0] eq 'delay me'; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
See I for a complete example. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
688
|
|
|
|
|
|
|
sub delay |
689
|
|
|
|
|
|
|
{ |
690
|
|
|
|
|
|
|
# get and check parameters |
691
|
0
|
|
|
0
|
1
|
|
my ($me, $filter)=@_; |
692
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
693
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
694
|
0
|
0
|
|
|
|
|
bug("Missed filter parameter") unless $filter; |
695
|
0
|
0
|
0
|
|
|
|
bug("Filter parameter is no code reference ($filter)") unless ref($filter) and ref($filter) eq 'CODE'; |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
# trace, if necessary |
698
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: object is setting a new delay filter."); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
# store filter |
701
|
0
|
|
|
|
|
|
$me->{'delayFilter'}=$filter; |
702
|
0
|
0
|
0
|
|
|
|
$me->{'delayQueue'}=[] unless defined $me->{'delayQueue'} and @{$me->{'delayQueue'}}; # keep messages possibly delayed by another filter; |
|
0
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
707
|
|
|
|
|
|
|
=pod |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=head2 undelay() |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Sends all messages collected by a filter which was set by I. |
712
|
|
|
|
|
|
|
The filter is I, so that every message will be sent by I |
713
|
|
|
|
|
|
|
immediatly afterwards again. |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
In case of no buffered message and no set filter, a call of this message |
716
|
|
|
|
|
|
|
takes no effect. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
B |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=over 4 |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=item object |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
An LDT object made by I. |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=back |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
B |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
$ldt->undelay; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
Here comes a complete example to illustrate how delays can be used. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
filter definition: |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
sub filter |
737
|
|
|
|
|
|
|
{ |
738
|
|
|
|
|
|
|
# check something |
739
|
|
|
|
|
|
|
$msg->[0] eq 'delay me'; |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
usage: |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
# send messages |
745
|
|
|
|
|
|
|
$ldt->send('send me', 1); # sent; |
746
|
|
|
|
|
|
|
$ldt->send('delay me', 2); # sent; |
747
|
|
|
|
|
|
|
# activate filter |
748
|
|
|
|
|
|
|
$ldt->delay(\&filter); |
749
|
|
|
|
|
|
|
# send messages |
750
|
|
|
|
|
|
|
$ldt->send('send me', 3); # sent; |
751
|
|
|
|
|
|
|
$ldt->send('delay me', 4); # delayed; |
752
|
|
|
|
|
|
|
$ldt->send('send me', 5); # sent; |
753
|
|
|
|
|
|
|
$ldt->send('delay me', 6); # delayed; |
754
|
|
|
|
|
|
|
# send collected messages, uninstall filter |
755
|
|
|
|
|
|
|
$ldt->undelay; # sends messages 4 and 6; |
756
|
|
|
|
|
|
|
# send messages |
757
|
|
|
|
|
|
|
$ldt->send('send me', 7); # sent; |
758
|
|
|
|
|
|
|
$ldt->send('delay me', 8); # sent; |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=cut |
762
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
763
|
|
|
|
|
|
|
sub undelay |
764
|
|
|
|
|
|
|
{ |
765
|
|
|
|
|
|
|
# get and check parameters |
766
|
0
|
|
|
0
|
1
|
|
my ($me)=@_; |
767
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
768
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# check for a set filter |
771
|
0
|
0
|
|
|
|
|
if (defined $me->{'delayFilter'}) |
772
|
|
|
|
|
|
|
{ |
773
|
|
|
|
|
|
|
# trace, if necessary |
774
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: object stops delay and sends", scalar(@{$me->{'delayQueue'}}), "stored message(s)."); |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
# remove filter |
777
|
0
|
|
|
|
|
|
$me->{'delayFilter'}=undef; |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
# send all delayed messages |
780
|
0
|
|
|
|
|
|
$me->send(@$_) foreach @{$me->{'delayQueue'}}; |
|
0
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# empty queue |
783
|
0
|
|
|
|
|
|
$me->{'delayQueue'}=undef; |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
else |
786
|
|
|
|
|
|
|
{ |
787
|
|
|
|
|
|
|
# trace, if necessary |
788
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: object was enforced to stop delay, but there was no delay set before."); |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
793
|
|
|
|
|
|
|
=pod |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=head2 send() |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
Sends the passed message via the related handle (which was passed to |
798
|
|
|
|
|
|
|
I). The message, which could be passed as a list of parts, is |
799
|
|
|
|
|
|
|
sent as a (concatenated) string or as serialized Perl data depending |
800
|
|
|
|
|
|
|
on the settings made by the constructor flag I and calls |
801
|
|
|
|
|
|
|
of I or I, respectively. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
In case of an error, the method replies an undefined value and stores |
804
|
|
|
|
|
|
|
both an error code and an error message inside the object which could |
805
|
|
|
|
|
|
|
be accessed via the object variables "rc" and "msg". (See I |
806
|
|
|
|
|
|
|
for a list of error codes.) |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
An error will occur, for example, if the handle related to the LDT object |
809
|
|
|
|
|
|
|
was closed (possibly outside the module). |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
An error is detected as well if a I call of I or |
812
|
|
|
|
|
|
|
I already detected an error. This behaviour is implemented |
813
|
|
|
|
|
|
|
for reasons of security, however, if you want to try it again regardless |
814
|
|
|
|
|
|
|
of the objects history, you can reset the internal error state by I. |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
For reasons of efficiency, sent messages may be splitted up into parts by |
817
|
|
|
|
|
|
|
the underlaying (operating or network) system. The reciepient will get the |
818
|
|
|
|
|
|
|
message part by part. On the other hand, the sender might only be able to |
819
|
|
|
|
|
|
|
I them part by part as well. That is why this I method retries writing |
820
|
|
|
|
|
|
|
attempts to the associated handle until the complete message could be sent. |
821
|
|
|
|
|
|
|
Well, in fact it stops retries earlier if an inacceptable long period of time |
822
|
|
|
|
|
|
|
passed by without being successfull. If that happens, the method replies I |
823
|
|
|
|
|
|
|
and provides an error code in the object variable "rc". I |
824
|
|
|
|
|
|
|
I |
825
|
|
|
|
|
|
|
I |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
B |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=over 4 |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item object |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
An LDT object made by I. |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item message (a list) |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
All list elements will be combined to the resulting message as done by I |
838
|
|
|
|
|
|
|
or I (that means, I separating parts by additional whitespaces). |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=back |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
B |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
$asciiClient->send('Silence?', 'Maybe.') |
845
|
|
|
|
|
|
|
or die $asciiClient->{'msg'}; |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
B<> |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
$objectClient->send({oops=>1, beep=>[qw(7)]}, $scalar, \@array); |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
B If the connection is closed while the message is sent, the signal |
852
|
|
|
|
|
|
|
I might arrive and terminate the complete program. To |
853
|
|
|
|
|
|
|
avoid this, I is ignored while this method is running. |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
The handle associated with the LDT object is made I during |
856
|
|
|
|
|
|
|
data transmission. The original mode is restored before the method returns. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=cut |
859
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
860
|
|
|
|
|
|
|
sub send |
861
|
|
|
|
|
|
|
{ |
862
|
|
|
|
|
|
|
# get and check parameters |
863
|
0
|
|
|
0
|
1
|
|
my ($me, @msg)=@_; |
864
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
865
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
866
|
0
|
0
|
|
|
|
|
bug("Missed message parameter(s)") unless @msg; |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
# trace, if necessary |
869
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: starting send."); |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
# check state |
872
|
0
|
0
|
0
|
|
|
|
if ($me->{'rc'} and $me->{'rc'}!=LDT_OK) |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
873
|
|
|
|
|
|
|
{ |
874
|
|
|
|
|
|
|
# trace, if necessary |
875
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: message unsent: object is in state $me->{'rc'}."); |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
# flag error |
878
|
0
|
|
|
|
|
|
undef; |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
elsif (not defined $me->{'handle'}->fileno) |
881
|
0
|
|
|
|
|
|
{ |
882
|
|
|
|
|
|
|
# trace, if necessary |
883
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: message unsent: related handle was closed."); |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
# set internal flags |
886
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_CLOSED; |
887
|
0
|
|
|
|
|
|
$me->{'msg'}='Related handle was closed.'; |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
# flag error |
890
|
0
|
|
|
|
|
|
undef; |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
elsif (defined $me->{'delayFilter'} and &{$me->{'delayFilter'}}(\@msg)) |
893
|
|
|
|
|
|
|
{ |
894
|
|
|
|
|
|
|
# messages should be delayed, queue the new one |
895
|
0
|
|
|
|
|
|
push(@{$me->{'delayQueue'}}, \@msg); |
|
0
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
# trace, if necessary |
898
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: message unsent: handle was closed."); |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
else |
901
|
|
|
|
|
|
|
{ |
902
|
|
|
|
|
|
|
# temporarily disable SIGPIPE |
903
|
0
|
|
|
|
|
|
local($SIG{'PIPE'})='IGNORE'; |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
# build the message as necessary |
906
|
0
|
|
|
|
|
|
my $msg=join('', @msg); |
907
|
0
|
0
|
|
|
|
|
$msg=Storable::nfreeze([@msg]) if $me->{'objectMode'}; |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
# store original handle access flags |
910
|
0
|
|
|
|
|
|
my $handleFlags=fcntl($me->{'handle'}, F_GETFL, 0); |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# activate non blocking mode |
913
|
0
|
|
|
|
|
|
fcntl($me->{'handle'}, F_SETFL, $handleFlags | O_NONBLOCK); |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
# trace, if necessary |
916
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: new message on the way ..."); |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
# send |
919
|
0
|
|
|
|
|
|
my $rc=$me->writeHandle(\(join('', sprintf(join('', '%.', $me->{'startblockLength'}, 'd'), length($msg)), $msg))); |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
# trace, if necessary |
922
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: sent message: $msg."); |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
# reset file handle access flags |
925
|
0
|
|
|
|
|
|
fcntl($me->{'handle'}, F_SETFL, $handleFlags); |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
# reply result state |
928
|
0
|
|
|
|
|
|
$rc; |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
934
|
|
|
|
|
|
|
=pod |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=head2 reset |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
If an error occurs while data are transmitted, further usage of the |
939
|
|
|
|
|
|
|
associated handle is usually critical. That is why I and |
940
|
|
|
|
|
|
|
I stop operation after a transmission error, even if you |
941
|
|
|
|
|
|
|
repeat their calls. This should I your program and make it |
942
|
|
|
|
|
|
|
more stable (e.g. writing to a closed handle migth cause a fatal error |
943
|
|
|
|
|
|
|
and even terminate your program). |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
Nevertheless, if you really want to retry after an error, here is the |
946
|
|
|
|
|
|
|
I method which resets the internal error flags - unless the |
947
|
|
|
|
|
|
|
associated handle was not already closed. |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
B |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=over 4 |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item object |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
An LDT object made by I. |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=back |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
B |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
$ldtObject->reset; |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
=cut |
964
|
|
|
|
|
|
|
sub reset |
965
|
|
|
|
|
|
|
{ |
966
|
|
|
|
|
|
|
# get and check parameters |
967
|
0
|
|
|
0
|
1
|
|
my ($me)=@_; |
968
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
969
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
# trace, if necessary |
972
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: object resets error state."); |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
# reset state buffer |
975
|
0
|
0
|
|
|
|
|
$me->{'msg'}=$me->{'rc'}='' unless $me->{'rc'}==LDT_CLOSED; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
979
|
|
|
|
|
|
|
=pod |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=head2 receive() |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
reads a message from the associated handle and replies it. |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
In case of an error, the method replies an undefined value and |
986
|
|
|
|
|
|
|
provides both a return code (see I) and a complete |
987
|
|
|
|
|
|
|
message in the object variables "rc" and "msg", respectively, |
988
|
|
|
|
|
|
|
where you can read them. |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
An error will occur, for example, if the handle related to the LDT object |
991
|
|
|
|
|
|
|
was closed (possibly outside the module). |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
An error is detected as well if a I call of I or |
994
|
|
|
|
|
|
|
I already detected an error. This behaviour is implemented |
995
|
|
|
|
|
|
|
for reasons of security, however, if you want to try it again regardless |
996
|
|
|
|
|
|
|
of the objects history, you can reset the internal error state by I. |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
For reasons of efficiency, sent messages may be splitted up into parts by |
999
|
|
|
|
|
|
|
the underlaying (operating or network) system. The reciepient will get the |
1000
|
|
|
|
|
|
|
message part by part. That is why this I method retries reading |
1001
|
|
|
|
|
|
|
attempts to the associated handle until the complete message could be read. |
1002
|
|
|
|
|
|
|
Well, in fact it stops retries earlier if an inacceptable long period of time |
1003
|
|
|
|
|
|
|
passed by without being successfull. If that happens, the method replies I |
1004
|
|
|
|
|
|
|
and provides an error code in the object variable "rc". I |
1005
|
|
|
|
|
|
|
I |
1006
|
|
|
|
|
|
|
I |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
B |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=over 4 |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=item object |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
An LDT object made by I. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=back |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
The received message is replied as a string in ASCII mode, and as |
1019
|
|
|
|
|
|
|
a list in object mode. |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
B |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
$msg=$asciiClient->receive or die $asciiClient->{'msg'}; |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
B<> |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
@objects=$objectClient->receive or die $objectClient->{'msg'}; |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
B If the connection is closed while the message is read, the signal |
1030
|
|
|
|
|
|
|
I might arrive and terminate the complete program. To |
1031
|
|
|
|
|
|
|
avoid this, I is ignored while this method is running. |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
The handle associated with the LDT object is made I during |
1034
|
|
|
|
|
|
|
data transmission. The original mode is restored before the method returns. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=cut |
1037
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1038
|
|
|
|
|
|
|
sub receive |
1039
|
|
|
|
|
|
|
{ |
1040
|
|
|
|
|
|
|
# declare function variables |
1041
|
0
|
|
|
0
|
1
|
|
my ($buffer, $mlen)=('', ''); |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
# get and check parameters |
1044
|
0
|
|
|
|
|
|
my ($me)=@_; |
1045
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
1046
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
# trace, if necessary |
1049
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: startet receiving."); |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
# check state |
1052
|
0
|
0
|
0
|
|
|
|
if ($me->{'rc'} and $me->{'rc'}!=LDT_OK) |
|
|
0
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
{ |
1054
|
|
|
|
|
|
|
# trace, if necessary |
1055
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: stopped receiving: object is in state $me->{'rc'}."); |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
# flag error |
1058
|
0
|
|
|
|
|
|
undef; |
1059
|
|
|
|
|
|
|
} |
1060
|
|
|
|
|
|
|
elsif (not defined $me->{'handle'}->fileno) |
1061
|
|
|
|
|
|
|
{ |
1062
|
|
|
|
|
|
|
# trace, if necessary |
1063
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: stopped receiving: object is in state $me->{'rc'}."); |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
# set internal flags |
1066
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_CLOSED; |
1067
|
0
|
|
|
|
|
|
$me->{'msg'}='Related handle was closed.'; |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
# flag error |
1070
|
0
|
|
|
|
|
|
undef; |
1071
|
|
|
|
|
|
|
} |
1072
|
|
|
|
|
|
|
else |
1073
|
|
|
|
|
|
|
{ |
1074
|
|
|
|
|
|
|
# temporarily disable SIGPIPE |
1075
|
0
|
|
|
|
|
|
local($SIG{'PIPE'})='IGNORE'; |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
# store original handle access flags |
1078
|
0
|
|
|
|
|
|
my $handleFlags=fcntl($me->{'handle'}, F_GETFL, 0); |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
# activate non blocking mode |
1081
|
0
|
|
|
|
|
|
fcntl($me->{'handle'}, F_SETFL, $handleFlags | O_NONBLOCK); |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
# read message, start with length info |
1084
|
0
|
|
0
|
|
|
|
my $rc=($me->readHandle(\$mlen) and $me->readHandle(\$buffer, $mlen)); |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
# reset file handle access flags |
1087
|
0
|
|
|
|
|
|
fcntl($me->{'handle'}, F_SETFL, $handleFlags); |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
# check transfer success |
1090
|
0
|
0
|
|
|
|
|
unless ($rc) |
1091
|
|
|
|
|
|
|
{ |
1092
|
|
|
|
|
|
|
# failed: reply state |
1093
|
0
|
|
|
|
|
|
return undef; |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
else |
1096
|
|
|
|
|
|
|
{ |
1097
|
|
|
|
|
|
|
# thaw result list, if necessary |
1098
|
0
|
0
|
0
|
|
|
|
my @buffer=@{Storable::thaw($buffer)} if $buffer and $me->{'objectMode'}; |
|
0
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
# reply result in correct form |
1101
|
0
|
0
|
|
|
|
|
$me->{'objectMode'} ? @buffer : $buffer; |
1102
|
|
|
|
|
|
|
} |
1103
|
|
|
|
|
|
|
} |
1104
|
|
|
|
|
|
|
} |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1107
|
|
|
|
|
|
|
# |
1108
|
|
|
|
|
|
|
# Internal method: Reads a number of bytes from the object handle. |
1109
|
|
|
|
|
|
|
# |
1110
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1111
|
|
|
|
|
|
|
sub readHandle |
1112
|
|
|
|
|
|
|
{ |
1113
|
|
|
|
|
|
|
# declare function variables |
1114
|
0
|
|
|
0
|
0
|
|
my ($readBytes, $trials); |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
# get and check parameters |
1117
|
0
|
|
|
|
|
|
my ($me, $targetBufferRef, $targetLength)=@_; |
1118
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
1119
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
1120
|
0
|
0
|
|
|
|
|
bug("Missed target buffer parameter") unless $targetBufferRef; |
1121
|
0
|
0
|
|
|
|
|
bug("Target buffer parameter is no scalar reference") unless ref $targetBufferRef eq 'SCALAR'; |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
# set default length, if necessary |
1124
|
0
|
0
|
|
|
|
|
$targetLength=$me->{'startblockLength'} unless defined $targetLength; |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
# read! |
1127
|
0
|
|
|
|
|
|
my $length=$targetLength; |
1128
|
0
|
|
|
|
|
|
while ($length) |
1129
|
|
|
|
|
|
|
{ |
1130
|
|
|
|
|
|
|
# perform reading |
1131
|
0
|
|
|
|
|
|
$readBytes=sysread($me->{'handle'}, $$targetBufferRef, $length, $targetLength-$length); |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
# all right? |
1134
|
0
|
0
|
|
|
|
|
if (defined $readBytes) |
1135
|
|
|
|
|
|
|
{ |
1136
|
|
|
|
|
|
|
# connection closed? |
1137
|
0
|
0
|
|
|
|
|
unless ($readBytes) |
1138
|
|
|
|
|
|
|
{ |
1139
|
|
|
|
|
|
|
# the handle closed! |
1140
|
0
|
|
|
|
|
|
$me->{'msg'}="Related handle was closed (while reading was performed)."; |
1141
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_CLOSED; |
1142
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: $me->{'msg'}"); |
1143
|
0
|
|
|
|
|
|
return undef; |
1144
|
|
|
|
|
|
|
} |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
# If here, we read a little bit more - and this bit was already added |
1147
|
|
|
|
|
|
|
# to our buffer. All we still have to do is to update our length |
1148
|
|
|
|
|
|
|
# counter and to reset the trial one. |
1149
|
0
|
|
|
|
|
|
$length-=$readBytes; |
1150
|
0
|
|
|
|
|
|
$trials=0; |
1151
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: read $readBytes bytes gelesen, still waiting for $length."); |
1152
|
|
|
|
|
|
|
} |
1153
|
|
|
|
|
|
|
else |
1154
|
|
|
|
|
|
|
{ |
1155
|
0
|
0
|
0
|
|
|
|
if ($!==EAGAIN and ++$trials
|
1156
|
|
|
|
|
|
|
{ |
1157
|
|
|
|
|
|
|
# The system flagged that we should continue later to get more |
1158
|
|
|
|
|
|
|
# from our handle. Doing nothing here means we continue with |
1159
|
|
|
|
|
|
|
# the next loop - restarting select() - which will hopefully |
1160
|
|
|
|
|
|
|
# provide more bytes from the handle. |
1161
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: waitig for a new chance to read remaining $length bytes ($trials. trial)."); |
1162
|
0
|
|
|
|
|
|
$me->{'select'}->can_read(HANDLE_RETRY_DELAY); |
1163
|
|
|
|
|
|
|
} |
1164
|
|
|
|
|
|
|
else |
1165
|
|
|
|
|
|
|
{ |
1166
|
|
|
|
|
|
|
# anything is wrong here |
1167
|
0
|
|
|
|
|
|
$me->{'msg'}="Cannot read the message completely."; |
1168
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_READ_INCOMPLETE; |
1169
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: $me->{'msg'}"); |
1170
|
0
|
|
|
|
|
|
return undef; |
1171
|
|
|
|
|
|
|
} |
1172
|
|
|
|
|
|
|
} |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
# trace, if necessary |
1176
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: message received: \"$$targetBufferRef\"."); |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
# if we are here, we were successfull |
1179
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_OK; |
1180
|
0
|
|
|
|
|
|
1; |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1186
|
|
|
|
|
|
|
# |
1187
|
|
|
|
|
|
|
# Internal method: Writes a number of bytes to the object handle. |
1188
|
|
|
|
|
|
|
# |
1189
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1190
|
|
|
|
|
|
|
sub writeHandle |
1191
|
|
|
|
|
|
|
{ |
1192
|
|
|
|
|
|
|
# declare function variables |
1193
|
0
|
|
|
0
|
0
|
|
my ($writtenBytes, $trials, $length, $srcLength); |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
# get and check parameters |
1196
|
0
|
|
|
|
|
|
my ($me, $srcBufferRef)=@_; |
1197
|
0
|
0
|
|
|
|
|
bug("Missed object parameter") unless $me; |
1198
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
1199
|
0
|
0
|
|
|
|
|
bug("Missed source buffer parameter") unless $srcBufferRef; |
1200
|
0
|
0
|
|
|
|
|
bug("Source buffer parameter is no scalar reference") unless ref $srcBufferRef eq 'SCALAR'; |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
# write! |
1203
|
0
|
|
|
|
|
|
$length=$srcLength=length($$srcBufferRef); |
1204
|
0
|
|
|
|
|
|
while ($length) |
1205
|
|
|
|
|
|
|
{ |
1206
|
|
|
|
|
|
|
# perform writing |
1207
|
0
|
|
|
|
|
|
$writtenBytes=syswrite($me->{'handle'}, $$srcBufferRef, $length, $srcLength-$length); |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
# all right? |
1210
|
0
|
0
|
|
|
|
|
if (defined $writtenBytes) |
1211
|
|
|
|
|
|
|
{ |
1212
|
|
|
|
|
|
|
# connection closed? |
1213
|
0
|
0
|
|
|
|
|
unless ($writtenBytes) |
1214
|
|
|
|
|
|
|
{ |
1215
|
|
|
|
|
|
|
# the handle closed! |
1216
|
0
|
|
|
|
|
|
$me->{'msg'}="Related handle was closed (while writing to it)."; |
1217
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_CLOSED; |
1218
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: $me->{'msg'}"); |
1219
|
0
|
|
|
|
|
|
return undef; |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
# If here, we wrote a little bit more. All we still |
1223
|
|
|
|
|
|
|
# have to do is to update our length counter and to reset the trial one. |
1224
|
0
|
|
|
|
|
|
$length-=$writtenBytes; |
1225
|
0
|
|
|
|
|
|
$trials=0; |
1226
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: wrote $writtenBytes bytes, $length bytes still waiting."); |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
else |
1229
|
|
|
|
|
|
|
{ |
1230
|
0
|
0
|
0
|
|
|
|
if ($!==EAGAIN and ++$trials
|
1231
|
|
|
|
|
|
|
{ |
1232
|
|
|
|
|
|
|
# The sytem flagged that we should continue later to send more |
1233
|
|
|
|
|
|
|
# to our handle. Doing nothing here means we continue with |
1234
|
|
|
|
|
|
|
# the next loop - restarting select() - which will hopefully |
1235
|
|
|
|
|
|
|
# send more bytes to the handle. |
1236
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: waiting for a new chance to write remaining $length bytes ($trials. trial)."); |
1237
|
0
|
|
|
|
|
|
$me->{'select'}->can_write(HANDLE_RETRY_DELAY); |
1238
|
|
|
|
|
|
|
} |
1239
|
|
|
|
|
|
|
else |
1240
|
|
|
|
|
|
|
{ |
1241
|
|
|
|
|
|
|
# anything is wrong here |
1242
|
0
|
|
|
|
|
|
$me->{'msg'}="Cannot write the message completely."; |
1243
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_WRITE_INCOMPLETE; |
1244
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: $me->{'msg'}"); |
1245
|
0
|
|
|
|
|
|
return undef; |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
} |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
# trace, if necessary |
1251
|
|
|
|
|
|
|
$me->trace("LDT $me->{'fileno'}: message sent completely: \"$$srcBufferRef\"."); |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
# if we are here, we were successfull |
1254
|
0
|
|
|
|
|
|
$me->{'rc'}=LDT_OK; |
1255
|
0
|
|
|
|
|
|
1; |
1256
|
|
|
|
|
|
|
} |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1260
|
|
|
|
|
|
|
# Internal trace method. |
1261
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1262
|
|
|
|
|
|
|
sub trace |
1263
|
|
|
|
|
|
|
{ |
1264
|
|
|
|
|
|
|
# get and check parameters |
1265
|
0
|
|
|
0
|
0
|
|
my ($me, @msg)=@_; |
1266
|
0
|
0
|
|
|
|
|
bug("Missed object reference parameter") unless $me; |
1267
|
0
|
0
|
|
|
|
|
bug("Object parameter is no ${\(__PACKAGE__)} object") unless ref($me) eq __PACKAGE__; |
|
0
|
|
|
|
|
|
|
1268
|
0
|
0
|
|
|
|
|
bug("Missed message parameter(s)") unless @msg; |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
# deactivate compiler checks |
1271
|
4
|
|
|
4
|
|
54
|
no strict 'refs'; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
94
|
|
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
# display trace (use print() instead of warn() because the message may contain freezed data) |
1274
|
0
|
0
|
0
|
|
|
|
print STDERR "[Trace] ", time, ": @msg\n" if ${join('::', __PACKAGE__, 'Trace')} or $me->{'traceMode'}; |
|
0
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
} |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------------------------- |
1279
|
|
|
|
|
|
|
=pod |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=head2 version() |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
replies the modules version. It simply replies $IPC::LDT::VERSION and is |
1284
|
|
|
|
|
|
|
implemented only to provide compatibility to other object modules. |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
Example: |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
# get version |
1290
|
|
|
|
|
|
|
warn "[Info] IPC is performed by IPC::LDT ", IPC::LDT::version, ".\n"; |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
=cut |
1293
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------------------------- |
1294
|
|
|
|
|
|
|
sub version |
1295
|
|
|
|
|
|
|
{ |
1296
|
|
|
|
|
|
|
# reply module version |
1297
|
0
|
|
|
0
|
1
|
|
$IPC::LDT::VERSION; |
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
# = MODULE TRAILER SECTION =============================================================== |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
# mark a completely read module |
1304
|
|
|
|
|
|
|
1; |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
# = POD TRAILER SECTION ================================================================== |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
=pod |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
=head1 ENVIRONMENT |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
=head1 FILES |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
=head1 SEE ALSO |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
=head1 NOTES |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
=head1 EXAMPLE |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
To share data between processes, you could embed a socket into an LDT object. |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
my $ipc=new IO::Socket(...); |
1324
|
|
|
|
|
|
|
my $ldt=new IPC::LDT(handle=>$ipc, objectMode=>1); |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
Now you are able to send data: |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
my $dataRef=[{o=>1, lal=>2, a=>3}, [[qw(4 5 6)], [{oo=>'ps'}, 7, 8, 9]]]; |
1329
|
|
|
|
|
|
|
$ldt->send($dataRef) or die $ldt->{'msg'}; |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
or receive them: |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
@data=$ldt->receive or die $ldt->{'msg'}; |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
=head1 AUTHOR |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
Jochen Stenzel (perl@jochen-stenzel.de) |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
Copyright (c) 1998-2000 Jochen Stenzel. All rights reserved. |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
This program is free software, you can redistribute it and/or modify it |
1345
|
|
|
|
|
|
|
under the terms of the Artistic License distributed with Perl version |
1346
|
|
|
|
|
|
|
5.003 or (at your option) any later version. Please refer to the |
1347
|
|
|
|
|
|
|
Artistic License that came with your Perl distribution for more |
1348
|
|
|
|
|
|
|
details. |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
=cut |