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.123 by root, Mon Oct 9 01:06:36 2006 UTC vs.
Revision 1.128 by root, Thu Nov 16 19:43:04 2006 UTC

… …
15package CFPlus; 15package CFPlus;
16 16
17use Carp (); 17use Carp ();
18 18
19BEGIN { 19BEGIN {
20 $VERSION = '0.52'; 20 $VERSION = '0.96';
21 21
22 use XSLoader; 22 use XSLoader;
23 XSLoader::load "CFPlus", $VERSION; 23 XSLoader::load "CFPlus", $VERSION;
24} 24}
25 25
… …
38use BerkeleyDB; 38use BerkeleyDB;
39use Pod::POM (); 39use Pod::POM ();
40use Scalar::Util (); 40use Scalar::Util ();
41use Storable (); # finally 41use Storable (); # finally
42 42
43BEGIN {
44 use Crossfire::Protocol::Base ();
45 *to_json = \&Crossfire::Protocol::Base::to_json;
46 *from_json = \&Crossfire::Protocol::Base::from_json;
47}
48
43=item guard { BLOCK } 49=item guard { BLOCK }
44 50
45Returns an object that executes the given block as soon as it is destroyed. 51Returns an object that executes the given block as soon as it is destroyed.
46 52
47=cut 53=cut
… …
69 or die "cannot establish bidiretcional pipe: $!\n"; 75 or die "cannot establish bidiretcional pipe: $!\n";
70 76
71 ($fh1, $fh2) 77 ($fh1, $fh2)
72} 78}
73 79
74sub background(&) { 80sub background(&;&) {
75 my ($cb) = @_; 81 my ($bg, $cb) = @_;
76 82
77 my ($fh_r, $fh_w) = CFPlus::socketpipe; 83 my ($fh_r, $fh_w) = CFPlus::socketpipe;
78 84
79 my $pid = fork; 85 my $pid = fork;
80 86
81 if (defined $pid && !$pid) { 87 if (defined $pid && !$pid) {
82 $SIG{__DIE__} = sub { 88 local $SIG{__DIE__};
83 my $msg = $_[0];
84 $msg =~ s/\n+/\n/;
85 warn "FATAL: $msg";
86 CFPlus::_exit 99;
87 };
88 89
89 open STDOUT, ">&", $fh_w; 90 open STDOUT, ">&", $fh_w;
90 open STDERR, ">&", $fh_w; 91 open STDERR, ">&", $fh_w;
91 close $fh_r; 92 close $fh_r;
92 close $fh_w; 93 close $fh_w;
93 94
94 $| = 1; 95 $| = 1;
95 96
96 $cb->(); 97 eval { $bg->() };
98
99 if ($@) {
100 my $msg = $@;
101 $msg =~ s/\n+/\n/;
102 warn "FATAL: $msg";
103 CFPlus::_exit 1;
104 }
97 105
98 # win32 is fucked up, of course. exit will clean stuff up, 106 # win32 is fucked up, of course. exit will clean stuff up,
99 # which destroys our database etc. _exit will exit ALL 107 # which destroys our database etc. _exit will exit ALL
100 # forked processes, because of the dreaded fork emulation. 108 # forked processes, because of the dreaded fork emulation.
101 CFPlus::_exit 0; 109 CFPlus::_exit 0;
102 } 110 }
103 111
104 close $fh_w; 112 close $fh_w;
105 113
106 my $buffer; 114 my $buffer;
107 115
108 Event->io (fd => $fh_r, poll => 'r', cb => sub { 116 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
109 unless (sysread $fh_r, $buffer, 4096, length $buffer) { 117 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
110 $_[0]->w->cancel; 118 undef $w;
111 $buffer .= "done\n"; 119 $cb->();
120 return;
112 } 121 }
113 122
114 while ($buffer =~ s/^(.*)\n//) { 123 while ($buffer =~ s/^(.*)\n//) {
115 my $line = $1; 124 my $line = $1;
125 $line =~ s/\s+$//;
116 utf8::decode $line; 126 utf8::decode $line;
127 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
128 $cb->(from_json $1);
129 } else {
117 ::message ({ 130 ::message ({
118 markup => "editor($pid): " . CFPlus::asxml $line, 131 markup => "background($pid): " . CFPlus::asxml $line,
132 });
119 }); 133 }
120 } 134 }
121 }); 135 });
136}
137
138sub background_msg {
139 my ($msg) = @_;
140
141 $msg = "\x{e877}json_msg " . to_json $msg;
142 $msg =~ s/\n//g;
143 utf8::encode $msg;
144 print $msg, "\n";
122} 145}
123 146
124package CFPlus::Database; 147package CFPlus::Database;
125 148
126our @ISA = BerkeleyDB::Btree::; 149our @ISA = BerkeleyDB::Btree::;
… …
157 $path = "$_/CFPlus/resources/$_[0]"; 180 $path = "$_/CFPlus/resources/$_[0]";
158 return $path if -r $path; 181 return $path if -r $path;
159 } 182 }
160 183
161 die "FATAL: can't find required file $_[0]\n"; 184 die "FATAL: can't find required file $_[0]\n";
162}
163
164BEGIN {
165 use Crossfire::Protocol::Base ();
166 *to_json = \&Crossfire::Protocol::Base::to_json;
167 *from_json = \&Crossfire::Protocol::Base::from_json;
168} 185}
169 186
170sub read_cfg { 187sub read_cfg {
171 my ($file) = @_; 188 my ($file) = @_;
172 189
… …
212sub set_proxy { 229sub set_proxy {
213 my $proxy = http_proxy 230 my $proxy = http_proxy
214 or return; 231 or return;
215 232
216 $ENV{http_proxy} = $proxy; 233 $ENV{http_proxy} = $proxy;
234}
235
236sub lwp_useragent {
237 require LWP::UserAgent;
238
239 CFPlus::set_proxy;
240
241 my $ua = LWP::UserAgent->new (
242 agent => "cfplus $VERSION",
243 keep_alive => 1,
244 env_proxy => 1,
245 timeout => 30,
246 );
247}
248
249sub lwp_check($) {
250 my ($res) = @_;
251
252 $res->is_error
253 and die $res->status_line;
254
255 $res
217} 256}
218 257
219our $DB_ENV; 258our $DB_ENV;
220our $DB_STATE; 259our $DB_STATE;
221 260

Diff Legend

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