line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package AMF::Connection; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
28789
|
use AMF::Connection::Message; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
7
|
use AMF::Connection::MessageBody; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
5
|
1
|
|
|
1
|
|
6
|
use AMF::Connection::OutputStream; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
6
|
1
|
|
|
1
|
|
5
|
use AMF::Connection::InputStream; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
1478
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
79011
|
|
|
1
|
|
|
|
|
36
|
|
9
|
1
|
|
|
1
|
|
7380
|
use HTTP::Cookies; |
|
1
|
|
|
|
|
12365
|
|
|
1
|
|
|
|
|
38
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
#use Data::Dumper; #for debug |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
10
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
90
|
|
14
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2465
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.32'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $HASMD5 = 0; |
19
|
|
|
|
|
|
|
{ |
20
|
|
|
|
|
|
|
local $@; |
21
|
|
|
|
|
|
|
eval { require Digest::MD5; }; |
22
|
|
|
|
|
|
|
$HASMD5 = ($@) ? 0 : 1 ; |
23
|
|
|
|
|
|
|
}; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $HASUUID; |
26
|
|
|
|
|
|
|
{ |
27
|
|
|
|
|
|
|
local $@; |
28
|
|
|
|
|
|
|
eval { require Data::UUID; }; |
29
|
|
|
|
|
|
|
$HASUUID = ($@) ? 0 : 1 ; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $HAS_LWP_PROTOCOL_SOCKS; |
33
|
|
|
|
|
|
|
{ |
34
|
|
|
|
|
|
|
local $@; |
35
|
|
|
|
|
|
|
eval { require LWP::Protocol::socks }; |
36
|
|
|
|
|
|
|
$HAS_LWP_PROTOCOL_SOCKS = ($@) ? 0 : 1 ; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub new { |
40
|
0
|
|
|
0
|
1
|
|
my ($proto, $endpoint) = @_; |
41
|
0
|
|
0
|
|
|
|
my $class = ref($proto) || $proto; |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
my $self = { |
44
|
|
|
|
|
|
|
'endpoint' => $endpoint, |
45
|
|
|
|
|
|
|
'headers' => [], |
46
|
|
|
|
|
|
|
'http_headers' => {}, |
47
|
|
|
|
|
|
|
'http_cookie_jar' => new HTTP::Cookies(), |
48
|
|
|
|
|
|
|
'response_counter' => 0, |
49
|
|
|
|
|
|
|
'encoding' => 0, # default is AMF0 encoding |
50
|
|
|
|
|
|
|
'ua' => new LWP::UserAgent(), |
51
|
|
|
|
|
|
|
'append_to_endpoint' => '' |
52
|
|
|
|
|
|
|
}; |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
$self->{'ua'}->cookie_jar( $self->{'http_cookie_jar'} ); |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
return bless($self, $class); |
57
|
|
|
|
|
|
|
}; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# plus add paramters, referer, user agent, authentication/credentials ( see also SecureAMFChannel stuff ), |
60
|
|
|
|
|
|
|
# plus timezone on retunred dates to pass to de-serializer - see AMF3 spec saying "it is suggested that time zone be queried independnetly as needed" - unelss local DateTime default to right locale! |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# we pass the string, and let Storable::AMF to parse the options into a scalar - see Input/OutputStream and Storable::AMF0 documentation |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub setInputAMFOptions { |
65
|
0
|
|
|
0
|
1
|
|
my ($class, $options) = @_; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$class->{'input_amf_options'} = $options; |
68
|
|
|
|
|
|
|
}; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub setOutputAMFOptions { |
71
|
0
|
|
|
0
|
1
|
|
my ($class, $options) = @_; |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
$class->{'output_amf_options'} = $options; |
74
|
|
|
|
|
|
|
}; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# useful when input and output options are the same |
77
|
|
|
|
|
|
|
sub setAMFOptions { |
78
|
0
|
|
|
0
|
1
|
|
my ($class, $options) = @_; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
$class->setInputAMFOptions ($options); |
81
|
0
|
|
|
|
|
|
$class->setOutputAMFOptions ($options); |
82
|
|
|
|
|
|
|
}; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub getInputAMFOptions { |
85
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
return $class->{'input_amf_options'}; |
88
|
|
|
|
|
|
|
}; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub getOutputAMFOptions { |
91
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
return $class->{'output_amf_options'}; |
94
|
|
|
|
|
|
|
}; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub setEndpoint { |
97
|
0
|
|
|
0
|
1
|
|
my ($class, $endpoint) = @_; |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
$class->{'endpoint'} = $endpoint; |
100
|
|
|
|
|
|
|
}; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub getEndpoint { |
103
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
|
return $class->{'endpoint'}; |
106
|
|
|
|
|
|
|
}; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub setHTTPProxy { |
109
|
0
|
|
|
0
|
1
|
|
my ($class, $proxy) = @_; |
110
|
|
|
|
|
|
|
|
111
|
0
|
0
|
0
|
|
|
|
if( ($proxy =~ m!^socks://(.*?):(\d+)!) && |
112
|
|
|
|
|
|
|
(!$HAS_LWP_PROTOCOL_SOCKS) ) { |
113
|
0
|
|
|
|
|
|
croak "LWP::Protocol::socks is required for SOCKS support"; |
114
|
|
|
|
|
|
|
}; |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
$class->{'http_proxy'} = $proxy; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
$class->{'ua'}->proxy( [qw(http https)] => $class->{'http_proxy'} ); |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub getHTTPProxy { |
122
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
return $class->{'http_proxy'}; |
125
|
|
|
|
|
|
|
}; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub setEncoding { |
128
|
0
|
|
|
0
|
1
|
|
my ($class, $encoding) = @_; |
129
|
|
|
|
|
|
|
|
130
|
0
|
0
|
0
|
|
|
|
croak "Unsupported AMF encoding $encoding" |
131
|
|
|
|
|
|
|
unless( $encoding==0 or $encoding==3 ); |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
$class->{'encoding'} = $encoding; |
134
|
|
|
|
|
|
|
}; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub getEncoding { |
137
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
return $class->{'encoding'}; |
140
|
|
|
|
|
|
|
}; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub addHeader { |
143
|
0
|
|
|
0
|
1
|
|
my ($class, $header, $value, $required) = @_; |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
|
|
|
|
if( ref($header) ) { |
146
|
0
|
0
|
|
|
|
|
croak "Not a valid header $header" |
147
|
|
|
|
|
|
|
unless( $header->isa("AMF::Connection::MessageHeader") ); |
148
|
|
|
|
|
|
|
} else { |
149
|
0
|
0
|
|
|
|
|
$header = new AMF::Connection::MessageHeader( $header, $value, ($required==1) ? 1 : 0 ); |
150
|
|
|
|
|
|
|
}; |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
|
push @{ $class->{'headers'} }, $header; |
|
0
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
}; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub addHTTPHeader { |
156
|
0
|
|
|
0
|
1
|
|
my ($class, $name, $value) = @_; |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
$class->{'http_headers'}->{ $name } = $value ; |
159
|
|
|
|
|
|
|
}; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub setUserAgent { |
162
|
0
|
|
|
0
|
1
|
|
my ($class, $ua) = @_; |
163
|
|
|
|
|
|
|
|
164
|
0
|
0
|
0
|
|
|
|
croak "Not a valid User-Agent $ua" |
|
|
|
0
|
|
|
|
|
165
|
|
|
|
|
|
|
unless( ref($ua) and $ua->isa("LWP::UserAgent") and $ua->can("post") ); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# the passed UA might have a different agent and cookie jar settings |
168
|
0
|
|
|
|
|
|
$class->{'ua'} = $ua; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# make sure we set the proxy if was already set |
171
|
|
|
|
|
|
|
# NOTE - we do not re-check SOCKS support due we assume the setHTTPProxy() was called earlier |
172
|
0
|
0
|
0
|
|
|
|
$class->{'ua'}->proxy( [qw(http https)] => $class->{'http_proxy'} ) |
173
|
|
|
|
|
|
|
if( exists $class->{'http_proxy'} and defined $class->{'http_proxy'} ); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# copy/pass over cookies too |
176
|
0
|
|
|
|
|
|
$class->{'ua'}->cookie_jar( $class->{'http_cookie_jar'} ); |
177
|
|
|
|
|
|
|
}; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub setHTTPCookieJar { |
180
|
0
|
|
|
0
|
1
|
|
my ($class, $cookie_jar) = @_; |
181
|
|
|
|
|
|
|
|
182
|
0
|
0
|
0
|
|
|
|
croak "Not a valid cookies jar $cookie_jar" |
183
|
|
|
|
|
|
|
unless( ref($cookie_jar) and $cookie_jar->isa("HTTP::Cookies") ); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# TODO - copy/pass over the current cookies (in-memory by default) if any set |
186
|
0
|
|
|
0
|
|
|
$class->{'http_cookie_jar'}->scan( sub { $cookie_jar->set_cookie( @_ ); } ); |
|
0
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
|
$class->{'http_cookie_jar'} = $cookie_jar; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# tell user agent to use new cookie jar |
191
|
0
|
|
|
|
|
|
$class->{'ua'}->cookie_jar( $class->{'http_cookie_jar'} ); |
192
|
|
|
|
|
|
|
}; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub getHTTPCookieJar { |
195
|
0
|
|
|
0
|
1
|
|
my ($class) = @_; |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
return $class->{'http_cookie_jar'}; |
198
|
|
|
|
|
|
|
}; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# send "flex.messaging.messages.RemotingMessage" |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub call { |
203
|
0
|
|
|
0
|
1
|
|
my ($class, $operation, $arguments, $destination) = @_; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
my @call = $class->callBatch ({ "operation" => $operation, |
206
|
|
|
|
|
|
|
"arguments" => $arguments, |
207
|
|
|
|
|
|
|
"destination" => $destination }); |
208
|
|
|
|
|
|
|
|
209
|
0
|
0
|
|
|
|
|
return (wantarray) ? @call : $call[0]; |
210
|
|
|
|
|
|
|
}; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub callBatch { |
213
|
0
|
|
|
0
|
1
|
|
my ($class, @batch) = @_; |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
my $request = new AMF::Connection::Message; |
216
|
0
|
|
|
|
|
|
$request->setEncoding( $class->{'encoding'} ); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# add AMF any request headers |
219
|
0
|
|
|
|
|
|
map { $request->addHeader( $_ ); } @{ $class->{'headers'} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# TODO - prepare HTTP/S request headers based on AMF headers received/set if any - and credentials |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
foreach my $call (@batch) |
224
|
|
|
|
|
|
|
{ |
225
|
|
|
|
|
|
|
next |
226
|
0
|
0
|
0
|
|
|
|
unless (defined $call && ref ($call) =~ m/HASH/ |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
227
|
|
|
|
|
|
|
&& defined $call->{'operation'} && defined $call->{'arguments'}); |
228
|
|
|
|
|
|
|
|
229
|
0
|
|
|
|
|
|
my $operation = $call->{'operation'}; |
230
|
0
|
|
|
|
|
|
my $arguments = $call->{'arguments'}; |
231
|
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
|
my $body = new AMF::Connection::MessageBody; |
233
|
0
|
|
|
|
|
|
$class->{'response_counter'}++; |
234
|
0
|
|
|
|
|
|
$body->setResponse( "/".$class->{'response_counter'} ); |
235
|
|
|
|
|
|
|
|
236
|
0
|
0
|
|
|
|
|
if( $class->{'encoding'} == 3 ) { # AMF3 |
237
|
0
|
|
|
|
|
|
$body->setTarget( 'null' ); |
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
|
my (@operation) = split('\.',$operation); |
240
|
0
|
|
|
|
|
|
my $method = pop @operation; |
241
|
0
|
|
|
|
|
|
my $service = join('.',@operation); |
242
|
0
|
0
|
|
|
|
|
my $destination = (defined $call->{'destination'}) ? $call->{'destination'} : $service; |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
my $remoting_message = $class->_brew_flex_remoting_message( $service, $method, {}, $arguments, $destination); |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
|
$body->setData( [ $remoting_message ] ); # it seems we need array ref here - to be checked |
247
|
|
|
|
|
|
|
} else { |
248
|
0
|
|
|
|
|
|
$body->setTarget( $operation ); |
249
|
0
|
|
|
|
|
|
$body->setData( $arguments ); |
250
|
|
|
|
|
|
|
}; |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
$request->addBody( $body ); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
0
|
|
|
|
|
|
my $request_stream = new AMF::Connection::OutputStream($class->{'output_amf_options'}); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# serialize request |
258
|
0
|
|
|
|
|
|
$request->serialize($request_stream); |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
#use Data::Dumper; |
261
|
|
|
|
|
|
|
#print STDERR Dumper( $request ); |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# set any extra HTTP header |
264
|
0
|
|
|
|
|
|
map { $class->{'ua'}->default_header( $_ => $class->{'http_headers'}->{$_} ); } keys %{ $class->{'http_headers'} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
0
|
|
|
|
|
|
my $http_response = $class->{'ua'}->post( |
267
|
|
|
|
|
|
|
$class->{'endpoint'}.$class->{'append_to_endpoint'}, # TODO - check if append to URL this really work for HTTP POST |
268
|
|
|
|
|
|
|
Content_Type => "application/x-amf", |
269
|
|
|
|
|
|
|
Content => $request_stream->getStreamData() |
270
|
|
|
|
|
|
|
); |
271
|
|
|
|
|
|
|
|
272
|
0
|
0
|
|
|
|
|
croak "HTTP POST error: ".$http_response->status_line."\n" |
273
|
|
|
|
|
|
|
unless($http_response->is_success); |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
my $response_stream = new AMF::Connection::InputStream( $http_response->decoded_content, $class->{'input_amf_options'}); |
276
|
0
|
|
|
|
|
|
my $response = new AMF::Connection::Message; |
277
|
0
|
|
|
|
|
|
$response->deserialize( $response_stream ); |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
#print STDERR Dumper( $response )."\n"; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# process AMF response headers |
282
|
0
|
|
|
|
|
|
$class->_process_response_headers( $response ); |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
my @all = @{ $response->getBodies() }; |
|
0
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# we make sure the main response is always returned first |
287
|
0
|
0
|
|
|
|
|
return (wantarray) ? @all : $all[0]; |
288
|
|
|
|
|
|
|
}; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# TODO |
291
|
|
|
|
|
|
|
# |
292
|
|
|
|
|
|
|
# sub command { } - to send "flex.messaging.messages.CommandMessage" instead |
293
|
|
|
|
|
|
|
# |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub setCredentials { |
296
|
0
|
|
|
0
|
1
|
|
my ($class, $username, $password) = @_; |
297
|
|
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
$class->addHeader( 'Credentials', { 'userid' => $username,'password' => $password }, 0 ); |
299
|
|
|
|
|
|
|
}; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub _process_response_headers { |
303
|
0
|
|
|
0
|
|
|
my ($class,$message) = @_; |
304
|
|
|
|
|
|
|
|
305
|
0
|
|
|
|
|
|
foreach my $header (@{ $message->getHeaders()}) { |
|
0
|
|
|
|
|
|
|
306
|
0
|
0
|
|
|
|
|
if($header->getName eq 'ReplaceGatewayUrl') { # another way used by server to keep cookies-less sessions |
|
|
0
|
|
|
|
|
|
307
|
0
|
0
|
|
|
|
|
$class->setEndpoint( $header->getValue ) |
308
|
|
|
|
|
|
|
unless( ref($header->getValue) ); |
309
|
|
|
|
|
|
|
} elsif($header->getName eq 'AppendToGatewayUrl') { # generally used for cokies-less sessions E.g. ';jsessionid=99226346ED3FF5296D08146B02ECCA28' |
310
|
0
|
0
|
|
|
|
|
$class->{'append_to_endpoint'} = $header->getValue |
311
|
|
|
|
|
|
|
unless( ref($header->getValue) ); |
312
|
|
|
|
|
|
|
}; |
313
|
|
|
|
|
|
|
}; |
314
|
|
|
|
|
|
|
}; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# just an hack to avoid rewrite class mapping local-to-remote and viceversa and make Storable::AMF happy |
317
|
|
|
|
|
|
|
sub _brew_flex_remoting_message { |
318
|
0
|
|
|
0
|
|
|
my ($class,$source,$operation,$headers,$body,$destination) = @_; |
319
|
|
|
|
|
|
|
|
320
|
0
|
0
|
|
|
|
|
return bless( { |
321
|
|
|
|
|
|
|
'clientId' => _generateID(), |
322
|
|
|
|
|
|
|
'destination' => $destination, |
323
|
|
|
|
|
|
|
'messageId' => _generateID(), |
324
|
|
|
|
|
|
|
'timestamp' => time() . '00', |
325
|
|
|
|
|
|
|
'timeToLive' => 0, |
326
|
|
|
|
|
|
|
'headers' => ($headers) ? $headers : {}, |
327
|
|
|
|
|
|
|
'body' => $body, |
328
|
|
|
|
|
|
|
'correlationId' => undef, |
329
|
|
|
|
|
|
|
'operation' => $operation, |
330
|
|
|
|
|
|
|
'source' => $source # for backwards compatibility - google for it! |
331
|
|
|
|
|
|
|
}, 'flex.messaging.messages.RemotingMessage' ); |
332
|
|
|
|
|
|
|
}; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub _generateID { |
335
|
0
|
|
|
0
|
|
|
my $uniqueid; |
336
|
|
|
|
|
|
|
|
337
|
0
|
0
|
|
|
|
|
if($HASUUID) { |
|
|
0
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
eval { |
339
|
0
|
|
|
|
|
|
my $ug = new Data::UUID; |
340
|
0
|
|
|
|
|
|
$uniqueid = $ug->to_string( $ug->create() ); |
341
|
|
|
|
|
|
|
}; |
342
|
|
|
|
|
|
|
} elsif ($HASMD5) { |
343
|
0
|
|
|
|
|
|
eval { |
344
|
0
|
|
|
|
|
|
$uniqueid = substr(Digest::MD5::md5_hex(Digest::MD5::md5_hex(time(). {}. rand(). $$)), 0, 32); |
345
|
|
|
|
|
|
|
}; |
346
|
|
|
|
|
|
|
} else { |
347
|
0
|
|
|
|
|
|
$uniqueid =""; |
348
|
0
|
|
|
|
|
|
my $length=16; |
349
|
|
|
|
|
|
|
|
350
|
0
|
|
|
|
|
|
my $j; |
351
|
0
|
|
|
|
|
|
for(my $i=0 ; $i< $length ;) { |
352
|
0
|
|
|
|
|
|
$j = chr(int(rand(127))); |
353
|
|
|
|
|
|
|
|
354
|
0
|
0
|
|
|
|
|
if($j =~ /[a-zA-Z0-9]/) { |
355
|
0
|
|
|
|
|
|
$uniqueid .=$j; |
356
|
0
|
|
|
|
|
|
$i++; |
357
|
|
|
|
|
|
|
}; |
358
|
|
|
|
|
|
|
}; |
359
|
|
|
|
|
|
|
}; |
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
|
return $uniqueid; |
362
|
|
|
|
|
|
|
}; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
1; |
365
|
|
|
|
|
|
|
__END__ |