| … | |
… | |
| 96 | |
96 | |
| 97 | =cut |
97 | =cut |
| 98 | |
98 | |
| 99 | sub new { |
99 | sub new { |
| 100 | my $class = shift; |
100 | my $class = shift; |
|
|
101 | |
|
|
102 | my $rand = join "", map chr 0x21 + rand 94, 1..40; # ~ 262 bits entropy |
|
|
103 | |
| 101 | my $self = bless { |
104 | my $self = bless { |
| 102 | host => $ENV{FREDHOST} || "127.0.0.1", |
105 | host => $ENV{FREDHOST} || "127.0.0.1", |
| 103 | port => $ENV{FREDPORT} || 9481, |
106 | port => $ENV{FREDPORT} || 9481, |
| 104 | timeout => 3600 * 2, |
107 | timeout => 3600 * 2, |
| 105 | name => time.rand.rand.rand, # lame |
108 | name => time.rand.rand.rand, # lame |
| 106 | @_, |
109 | @_, |
| 107 | queue => [], |
110 | queue => [], |
| 108 | req => {}, |
111 | req => {}, |
|
|
112 | prefix => "..:aefcpid-$rand:", |
| 109 | id => "a0", |
113 | idseq => "a0", |
| 110 | }, $class; |
114 | }, $class; |
| 111 | |
115 | |
| 112 | { |
116 | { |
| 113 | Scalar::Util::weaken (my $self = $self); |
117 | Scalar::Util::weaken (my $self = $self); |
| 114 | |
118 | |
| … | |
… | |
| 131 | ); |
135 | ); |
| 132 | |
136 | |
| 133 | $self |
137 | $self |
| 134 | } |
138 | } |
| 135 | |
139 | |
|
|
140 | sub identifier { |
|
|
141 | $_[0]{prefix} . ++$_[0]{idseq} |
|
|
142 | } |
|
|
143 | |
| 136 | sub send_msg { |
144 | sub send_msg { |
| 137 | my ($self, $type, %kv) = @_; |
145 | my ($self, $type, %kv) = @_; |
| 138 | |
146 | |
| 139 | my $data = delete $kv{data}; |
147 | my $data = delete $kv{data}; |
| 140 | |
148 | |
| 141 | if (exists $kv{id_cb}) { |
149 | if (exists $kv{id_cb}) { |
| 142 | my $id = $kv{identifier} ||= ++$self->{id}; |
150 | my $id = $kv{identifier} ||= $self->identifier; |
| 143 | $self->{id}{$id} = delete $kv{id_cb}; |
151 | $self->{id}{$id} = delete $kv{id_cb}; |
| 144 | } |
152 | } |
| 145 | |
153 | |
| 146 | my $msg = (touc $type) . "\012" |
154 | my $msg = (touc $type) . "\012" |
| 147 | . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv; |
155 | . join "", map +(touc $_) . "=$kv{$_}\012", keys %kv; |
| … | |
… | |
| 371 | my ($name, $sub) = @_; |
379 | my ($name, $sub) = @_; |
| 372 | |
380 | |
| 373 | *{$name} = sub { |
381 | *{$name} = sub { |
| 374 | my $cv = AE::cv; |
382 | my $cv = AE::cv; |
| 375 | |
383 | |
| 376 | splice @_, 1, 0, $cv, sub { $cv->throw ($_[0]{extra_description}) }; |
384 | splice @_, 1, 0, $cv, sub { $cv->croak ($_[0]{extra_description}) }; |
| 377 | &$sub; |
385 | &$sub; |
| 378 | $cv->recv |
386 | $cv->recv |
| 379 | }; |
387 | }; |
| 380 | |
388 | |
| 381 | *{"$name\_"} = sub { |
389 | *{"$name\_"} = sub { |
| 382 | my ($ok, $err) = pop; |
390 | my ($ok, $err) = pop; |
| 383 | |
391 | |
| 384 | if (ARRAY:: eq ref $ok) { |
392 | if (ARRAY:: eq ref $ok) { |
| 385 | ($ok, $err) = @$ok; |
393 | ($ok, $err) = @$ok; |
| 386 | } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) { |
394 | } elsif (UNIVERSAL::isa $ok, AnyEvent::CondVar::) { |
| 387 | $err = sub { $ok->throw ($_[0]{extra_description}) }; |
395 | $err = sub { $ok->croak ($_[0]{extra_description}) }; |
| 388 | } else { |
396 | } else { |
| 389 | my $bt = Carp::longmess ""; |
397 | my $bt = Carp::longmess ""; |
| 390 | $err = sub { |
398 | $err = sub { |
| 391 | die "$_[0]{extra_description}$bt"; |
399 | die "$_[0]{extra_description}$bt"; |
| 392 | }; |
400 | }; |
