line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
3
|
|
|
|
|
|
|
# Send a block of data from one process to another on the local machine |
4
|
|
|
|
|
|
|
# Philip R Brenan at gmail dot com, Appa Apps Ltd Inc, 2016-2017 |
5
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Data::Send::Local; |
8
|
|
|
|
|
|
|
our $VERSION = 20170926; |
9
|
2
|
|
|
2
|
|
888
|
use v5.8.0; |
|
2
|
|
|
|
|
20
|
|
10
|
2
|
|
|
2
|
|
12
|
use warnings FATAL => qw(all); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
68
|
|
11
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
48
|
|
12
|
2
|
|
|
2
|
|
22
|
use Carp qw(confess); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
144
|
|
13
|
2
|
|
|
2
|
|
760
|
use Data::Dump qw(dump); |
|
2
|
|
|
|
|
15866
|
|
|
2
|
|
|
|
|
236
|
|
14
|
2
|
|
|
2
|
|
1534
|
use Data::Table::Text qw(:all); |
|
2
|
|
|
|
|
114874
|
|
|
2
|
|
|
|
|
1160
|
|
15
|
2
|
|
|
2
|
|
1140
|
use Socket; |
|
2
|
|
|
|
|
7680
|
|
|
2
|
|
|
|
|
2566
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
#1 Send and receive |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub sendLocal($$;$) #S Send a block of data locally. Returns B on success otherwise an error message |
20
|
1
|
|
|
1
|
1
|
15
|
{my ($socketName, $data, $timeOut) = @_; # Socket name (a socket file name that already exists), data, optional timeout for socket to be created - defaults to 10 seconds |
21
|
|
|
|
|
|
|
|
22
|
1
|
50
|
|
|
|
56
|
if (!-S $socketName) # Wait for a bit if necessary for the socket to be created |
23
|
0
|
0
|
0
|
|
|
0
|
{for(1..($timeOut//10)) {sleep 1; last if -S $socketName} |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
24
|
|
|
|
|
|
|
} |
25
|
1
|
50
|
|
|
|
21
|
-S $socketName or return "No such socket: $socketName"; # Socket not available |
26
|
|
|
|
|
|
|
|
27
|
1
|
50
|
|
|
|
119
|
socket(my $socket, AF_UNIX, SOCK_DGRAM, 0) or return $!; |
28
|
1
|
50
|
|
|
|
67
|
connect($socket, sockaddr_un($socketName)) or return $!; |
29
|
1
|
50
|
|
|
|
89
|
send($socket, dump($data), 0) or return $!; |
30
|
1
|
|
|
|
|
412
|
close($socket); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
undef # Return without errors |
33
|
1
|
|
|
|
|
22
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub recvLocal($;$) #S Receive a block of data sent locally. Returns the data received. |
36
|
1
|
|
|
1
|
1
|
21
|
{my ($socketName, $length) = @_; # Socket name (a socket file name that is created), optional maximum length to receive - defaults to one megabyte. |
37
|
|
|
|
|
|
|
|
38
|
1
|
|
|
|
|
29
|
unlink $socketName; # Remove existing socket to avoid 'already in use'; |
39
|
1
|
|
|
|
|
34
|
makePath($socketName); # Create socket directory |
40
|
1
|
50
|
|
|
|
119
|
socket(my $socket, AF_UNIX, SOCK_DGRAM, 0) or confess $!; |
41
|
1
|
50
|
|
|
|
32
|
bind($socket, sockaddr_un($socketName)) or confess $!; |
42
|
1
|
|
50
|
|
|
949
|
recv($socket, my $read, $length // 1e6, 0); |
43
|
1
|
|
|
|
|
15
|
close($socket); |
44
|
1
|
|
|
|
|
46
|
unlink $socketName; # Remove existing socket to force send to wait while the socket is created |
45
|
|
|
|
|
|
|
|
46
|
1
|
|
|
|
|
199
|
my $r = eval $read; # Reconstitute data |
47
|
1
|
50
|
|
|
|
9
|
$@ and confess $@; # Bad data block |
48
|
|
|
|
|
|
|
|
49
|
1
|
|
|
|
|
19
|
$r # Return data |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
53
|
|
|
|
|
|
|
# Tests |
54
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub test2() |
57
|
2
|
|
|
2
|
0
|
14
|
{my $socket = 'socket'; # Socket name |
58
|
2
|
|
|
|
|
4
|
my $data = 'hello'; # Data |
59
|
2
|
|
|
|
|
22
|
autoflush STDOUT 1; |
60
|
|
|
|
|
|
|
|
61
|
2
|
50
|
|
|
|
116
|
if ($^O !~ m/\AMSWin32\Z/) # Ignore windows |
62
|
2
|
|
|
|
|
16
|
{say STDOUT "1..2"; |
63
|
2
|
100
|
|
|
|
1976
|
if (fork()) |
64
|
1
|
50
|
|
|
|
30
|
{say STDOUT "ok" if Data::Send::Local::recvLocal($socket) eq $data; # Receive data |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
else |
67
|
1
|
|
|
|
|
90
|
{autoflush STDOUT 1; |
68
|
1
|
50
|
|
|
|
191
|
say STDOUT "ok" unless Data::Send::Local::sendLocal($socket, $data); # Send data without error |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
test2 unless caller; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# podDocumentation |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=pod |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=encoding utf-8 |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head1 Name |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Data::Send::Local - Send and receive a block of data between processes on the |
84
|
|
|
|
|
|
|
local machine. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 Synopsis |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Send B between two processes running on the same machine over the |
89
|
|
|
|
|
|
|
socket named B. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
use Test2::Bundle::More; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my $socket = 'socket'; # Socket name |
94
|
|
|
|
|
|
|
my $data = 'hello'; # Data |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
if (fork()) |
97
|
|
|
|
|
|
|
{ok Data::Send::Local::recvLocal($socket) eq $data; # Receive data |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
else |
100
|
|
|
|
|
|
|
{ok !Data::Send::Local::sendLocal($socket, $data); # Send data without error |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
done_testing; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 Description |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
The following sections describe the methods in each functional area of this |
108
|
|
|
|
|
|
|
module. For an alphabetic listing of all methods by name see L. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 Send and receive |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head2 sendLocal($$$) |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Send a block of data locally. Returns B on success otherwise an error message |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
1 $socketName Socket name (a socket file name that already exists) |
119
|
|
|
|
|
|
|
2 $data Data |
120
|
|
|
|
|
|
|
3 $timeOut Optional timeout for socket to be created - defaults to 10 seconds |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
This is a static method and so should be invoked as: |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Data::Send::Local::sendLocal |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head2 recvLocal($$) |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Receive a block of data sent locally. Returns the data received. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
1 $socketName Socket name (a socket file name that is created) |
132
|
|
|
|
|
|
|
2 $length Optional maximum length to receive - defaults to one megabyte. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
This is a static method and so should be invoked as: |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Data::Send::Local::recvLocal |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head1 Index |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
1 L |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
2 L |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 Installation |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
This module is written in 100% Pure Perl and, thus, it is easy to read, use, |
150
|
|
|
|
|
|
|
modify and install. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Standard L process for building and installing modules: |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
perl Build.PL |
155
|
|
|
|
|
|
|
./Build |
156
|
|
|
|
|
|
|
./Build test |
157
|
|
|
|
|
|
|
./Build install |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head1 Author |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
L |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
L |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head1 Copyright |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Copyright (c) 2016-2017 Philip R Brenan. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
This module is free software. It may be used, redistributed and/or modified |
170
|
|
|
|
|
|
|
under the same terms as Perl itself. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Tests and documentation |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub test |
179
|
0
|
|
|
0
|
0
|
|
{my $p = __PACKAGE__; |
180
|
0
|
|
|
|
|
|
binmode($_, ":utf8") for *STDOUT, *STDERR; |
181
|
0
|
0
|
|
|
|
|
return if eval "eof(${p}::DATA)"; |
182
|
0
|
|
|
|
|
|
my $s = eval "join('', <${p}::DATA>)"; |
183
|
0
|
0
|
|
|
|
|
$@ and die $@; |
184
|
0
|
|
|
|
|
|
eval $s; |
185
|
0
|
0
|
|
|
|
|
$@ and die $@; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
test unless caller; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
1; |
191
|
|
|
|
|
|
|
__DATA__ |