ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.125 by root, Wed Oct 18 12:53:45 2006 UTC vs.
Revision 1.129 by root, Mon Nov 20 16:41:46 2006 UTC

… …
15package CFPlus; 15package CFPlus;
16 16
17use Carp (); 17use Carp ();
18 18
19BEGIN { 19BEGIN {
20 $VERSION = '0.53'; 20 $VERSION = '0.96';
21 21
22 use XSLoader; 22 use XSLoader;
23 XSLoader::load "CFPlus", $VERSION; 23 XSLoader::load "CFPlus", $VERSION;
24}
25
26BEGIN {
27 $SIG{__DIE__} = sub {
28 return if CFPlus::in_destruct;
29 #CFPlus::fatal $_[0];#d#
30 CFPlus::error Carp::longmess $_[0];#d#
31 die;#d#
32 };
33} 24}
34 25
35use utf8; 26use utf8;
36 27
37use AnyEvent (); 28use AnyEvent ();
38use BerkeleyDB; 29use BerkeleyDB;
39use Pod::POM (); 30use Pod::POM ();
40use Scalar::Util (); 31use Scalar::Util ();
41use Storable (); # finally 32use Storable (); # finally
42 33
34BEGIN {
35 use Crossfire::Protocol::Base ();
36 *to_json = \&Crossfire::Protocol::Base::to_json;
37 *from_json = \&Crossfire::Protocol::Base::from_json;
38}
39
43=item guard { BLOCK } 40=item guard { BLOCK }
44 41
45Returns an object that executes the given block as soon as it is destroyed. 42Returns an object that executes the given block as soon as it is destroyed.
46 43
47=cut 44=cut
… …
69 or die "cannot establish bidiretcional pipe: $!\n"; 66 or die "cannot establish bidiretcional pipe: $!\n";
70 67
71 ($fh1, $fh2) 68 ($fh1, $fh2)
72} 69}
73 70
74sub background(&) { 71sub background(&;&) {
75 my ($cb) = @_; 72 my ($bg, $cb) = @_;
76 73
77 my ($fh_r, $fh_w) = CFPlus::socketpipe; 74 my ($fh_r, $fh_w) = CFPlus::socketpipe;
78 75
79 my $pid = fork; 76 my $pid = fork;
80 77
… …
86 close $fh_r; 83 close $fh_r;
87 close $fh_w; 84 close $fh_w;
88 85
89 $| = 1; 86 $| = 1;
90 87
91 eval { $cb->() }; 88 eval { $bg->() };
92 89
93 if ($@) { 90 if ($@) {
94 my $msg = $@; 91 my $msg = $@;
95 $msg =~ s/\n+/\n/; 92 $msg =~ s/\n+/\n/;
96 warn "FATAL: $msg"; 93 warn "FATAL: $msg";
… …
105 102
106 close $fh_w; 103 close $fh_w;
107 104
108 my $buffer; 105 my $buffer;
109 106
110 Event->io (fd => $fh_r, poll => 'r', cb => sub { 107 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
111 unless (sysread $fh_r, $buffer, 4096, length $buffer) { 108 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
112 $_[0]->w->cancel; 109 undef $w;
113 $buffer .= "done\n"; 110 $cb->();
111 return;
114 } 112 }
115 113
116 while ($buffer =~ s/^(.*)\n//) { 114 while ($buffer =~ s/^(.*)\n//) {
117 my $line = $1; 115 my $line = $1;
118 $line =~ s/\s+$//; 116 $line =~ s/\s+$//;
119 utf8::decode $line; 117 utf8::decode $line;
118 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
119 $cb->(from_json $1);
120 } else {
120 ::message ({ 121 ::message ({
121 markup => "editor($pid): " . CFPlus::asxml $line, 122 markup => "background($pid): " . CFPlus::asxml $line,
123 });
122 }); 124 }
123 } 125 }
124 }); 126 });
127}
128
129sub background_msg {
130 my ($msg) = @_;
131
132 $msg = "\x{e877}json_msg " . to_json $msg;
133 $msg =~ s/\n//g;
134 utf8::encode $msg;
135 print $msg, "\n";
125} 136}
126 137
127package CFPlus::Database; 138package CFPlus::Database;
128 139
129our @ISA = BerkeleyDB::Btree::; 140our @ISA = BerkeleyDB::Btree::;
… …
160 $path = "$_/CFPlus/resources/$_[0]"; 171 $path = "$_/CFPlus/resources/$_[0]";
161 return $path if -r $path; 172 return $path if -r $path;
162 } 173 }
163 174
164 die "FATAL: can't find required file $_[0]\n"; 175 die "FATAL: can't find required file $_[0]\n";
165}
166
167BEGIN {
168 use Crossfire::Protocol::Base ();
169 *to_json = \&Crossfire::Protocol::Base::to_json;
170 *from_json = \&Crossfire::Protocol::Base::from_json;
171} 176}
172 177
173sub read_cfg { 178sub read_cfg {
174 my ($file) = @_; 179 my ($file) = @_;
175 180
… …
215sub set_proxy { 220sub set_proxy {
216 my $proxy = http_proxy 221 my $proxy = http_proxy
217 or return; 222 or return;
218 223
219 $ENV{http_proxy} = $proxy; 224 $ENV{http_proxy} = $proxy;
225}
226
227sub lwp_useragent {
228 require LWP::UserAgent;
229
230 CFPlus::set_proxy;
231
232 my $ua = LWP::UserAgent->new (
233 agent => "cfplus $VERSION",
234 keep_alive => 1,
235 env_proxy => 1,
236 timeout => 30,
237 );
238}
239
240sub lwp_check($) {
241 my ($res) = @_;
242
243 $res->is_error
244 and die $res->status_line;
245
246 $res
220} 247}
221 248
222our $DB_ENV; 249our $DB_ENV;
223our $DB_STATE; 250our $DB_STATE;
224 251

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines