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.131 by root, Tue Dec 5 00:52:56 2006 UTC

… …
15package CFPlus; 15package CFPlus;
16 16
17use Carp (); 17use Carp ();
18 18
19BEGIN { 19BEGIN {
20 $VERSION = '0.52'; 20 $VERSION = '0.97';
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
81 if (defined $pid && !$pid) { 78 if (defined $pid && !$pid) {
82 $SIG{__DIE__} = sub { 79 local $SIG{__DIE__};
83 my $msg = $_[0];
84 $msg =~ s/\n+/\n/;
85 warn "FATAL: $msg";
86 CFPlus::_exit 99;
87 };
88 80
89 open STDOUT, ">&", $fh_w; 81 open STDOUT, ">&", $fh_w;
90 open STDERR, ">&", $fh_w; 82 open STDERR, ">&", $fh_w;
91 close $fh_r; 83 close $fh_r;
92 close $fh_w; 84 close $fh_w;
93 85
94 $| = 1; 86 $| = 1;
95 87
96 $cb->(); 88 eval { $bg->() };
89
90 if ($@) {
91 my $msg = $@;
92 $msg =~ s/\n+/\n/;
93 warn "FATAL: $msg";
94 CFPlus::_exit 1;
95 }
97 96
98 # win32 is fucked up, of course. exit will clean stuff up, 97 # win32 is fucked up, of course. exit will clean stuff up,
99 # which destroys our database etc. _exit will exit ALL 98 # which destroys our database etc. _exit will exit ALL
100 # forked processes, because of the dreaded fork emulation. 99 # forked processes, because of the dreaded fork emulation.
101 CFPlus::_exit 0; 100 CFPlus::_exit 0;
102 } 101 }
103 102
104 close $fh_w; 103 close $fh_w;
105 104
106 my $buffer; 105 my $buffer;
107 106
108 Event->io (fd => $fh_r, poll => 'r', cb => sub { 107 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
109 unless (sysread $fh_r, $buffer, 4096, length $buffer) { 108 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
110 $_[0]->w->cancel; 109 undef $w;
111 $buffer .= "done\n"; 110 $cb->();
111 return;
112 } 112 }
113 113
114 while ($buffer =~ s/^(.*)\n//) { 114 while ($buffer =~ s/^(.*)\n//) {
115 my $line = $1; 115 my $line = $1;
116 $line =~ s/\s+$//;
116 utf8::decode $line; 117 utf8::decode $line;
118 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
119 $cb->(from_json $1);
120 } else {
117 ::message ({ 121 ::message ({
118 markup => "editor($pid): " . CFPlus::asxml $line, 122 markup => "background($pid): " . CFPlus::asxml $line,
123 });
119 }); 124 }
120 } 125 }
121 }); 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";
122} 136}
123 137
124package CFPlus::Database; 138package CFPlus::Database;
125 139
126our @ISA = BerkeleyDB::Btree::; 140our @ISA = BerkeleyDB::Btree::;
… …
157 $path = "$_/CFPlus/resources/$_[0]"; 171 $path = "$_/CFPlus/resources/$_[0]";
158 return $path if -r $path; 172 return $path if -r $path;
159 } 173 }
160 174
161 die "FATAL: can't find required file $_[0]\n"; 175 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} 176}
169 177
170sub read_cfg { 178sub read_cfg {
171 my ($file) = @_; 179 my ($file) = @_;
172 180
… …
214 or return; 222 or return;
215 223
216 $ENV{http_proxy} = $proxy; 224 $ENV{http_proxy} = $proxy;
217} 225}
218 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
247}
248
219our $DB_ENV; 249our $DB_ENV;
220our $DB_STATE; 250our $DB_STATE;
221 251
222sub db_table($) { 252sub db_table($) {
223 my ($table) = @_; 253 my ($table) = @_;
… …
235} 265}
236 266
237{ 267{
238 use strict; 268 use strict;
239 269
240 mkdir "$Crossfire::VARDIR/cfplus", 0777; 270 my $HOME = "$Crossfire::VARDIR/cfplus-$BerkeleyDB::db_version";
271
272 mkdir $HOME, 0777;
241 my $recover = $BerkeleyDB::db_version >= 4.4 273 my $recover = $BerkeleyDB::db_version >= 4.4
242 ? eval "DB_REGISTER | DB_RECOVER" 274 ? eval "DB_REGISTER | DB_RECOVER"
243 : 0; 275 : 0;
244 276
245 $DB_ENV = new BerkeleyDB::Env 277 $DB_ENV = new BerkeleyDB::Env
246 -Home => "$Crossfire::VARDIR/cfplus", 278 -Home => $HOME,
247 -Cachesize => 1_000_000, 279 -Cachesize => 1_000_000,
248 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 280 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
249# -ErrPrefix => "DATABASE", 281# -ErrPrefix => "DATABASE",
250 -Verbose => 1, 282 -Verbose => 1,
251 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 283 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
252 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 284 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
253 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 285 or die "unable to create/open database home $HOME: $BerkeleyDB::Error";
254 286
255 $DB_STATE = db_table "state"; 287 $DB_STATE = db_table "state";
256} 288}
257 289
258package CFPlus::Layout; 290package CFPlus::Layout;

Diff Legend

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