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.124 by root, Wed Oct 11 23:34:24 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
… …
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
… …
217 or return; 222 or return;
218 223
219 $ENV{http_proxy} = $proxy; 224 $ENV{http_proxy} = $proxy;
220} 225}
221 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
222our $DB_ENV; 249our $DB_ENV;
223our $DB_STATE; 250our $DB_STATE;
224 251
225sub db_table($) { 252sub db_table($) {
226 my ($table) = @_; 253 my ($table) = @_;
… …
238} 265}
239 266
240{ 267{
241 use strict; 268 use strict;
242 269
243 mkdir "$Crossfire::VARDIR/cfplus", 0777; 270 my $HOME = "$Crossfire::VARDIR/cfplus-$BerkeleyDB::db_version";
271
272 mkdir $HOME, 0777;
244 my $recover = $BerkeleyDB::db_version >= 4.4 273 my $recover = $BerkeleyDB::db_version >= 4.4
245 ? eval "DB_REGISTER | DB_RECOVER" 274 ? eval "DB_REGISTER | DB_RECOVER"
246 : 0; 275 : 0;
247 276
248 $DB_ENV = new BerkeleyDB::Env 277 $DB_ENV = new BerkeleyDB::Env
249 -Home => "$Crossfire::VARDIR/cfplus", 278 -Home => $HOME,
250 -Cachesize => 1_000_000, 279 -Cachesize => 1_000_000,
251 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 280 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
252# -ErrPrefix => "DATABASE", 281# -ErrPrefix => "DATABASE",
253 -Verbose => 1, 282 -Verbose => 1,
254 -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,
255 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 284 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
256 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";
257 286
258 $DB_STATE = db_table "state"; 287 $DB_STATE = db_table "state";
259} 288}
260 289
261package CFPlus::Layout; 290package CFPlus::Layout;

Diff Legend

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