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.115 by elmex, Tue Aug 15 06:30:05 2006 UTC vs.
Revision 1.127 by root, Thu Nov 16 19:42:44 2006 UTC

… …
12 12
13=cut 13=cut
14 14
15package CFPlus; 15package CFPlus;
16 16
17use Carp ();
18
17BEGIN { 19BEGIN {
18 $VERSION = '0.2'; 20 $VERSION = '0.95';
19 21
20 use XSLoader; 22 use XSLoader;
21 XSLoader::load "CFPlus", $VERSION; 23 XSLoader::load "CFPlus", $VERSION;
22} 24}
23 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}
34
24use utf8; 35use utf8;
25 36
26use Carp ();
27use AnyEvent (); 37use AnyEvent ();
28use BerkeleyDB; 38use BerkeleyDB;
29use Pod::POM (); 39use Pod::POM ();
30use Scalar::Util (); 40use Scalar::Util ();
31use Storable (); # finally 41use Storable (); # finally
32 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
33=item guard { BLOCK } 49=item guard { BLOCK }
34 50
35Returns 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.
36 52
37=cut 53=cut
… …
52 s/</&lt;/g; 68 s/</&lt;/g;
53 69
54 $_ 70 $_
55} 71}
56 72
73sub socketpipe() {
74 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
75 or die "cannot establish bidiretcional pipe: $!\n";
76
77 ($fh1, $fh2)
78}
79
80sub background(&;&) {
81 my ($bg, $cb) = @_;
82
83 my ($fh_r, $fh_w) = CFPlus::socketpipe;
84
85 my $pid = fork;
86
87 if (defined $pid && !$pid) {
88 local $SIG{__DIE__};
89
90 open STDOUT, ">&", $fh_w;
91 open STDERR, ">&", $fh_w;
92 close $fh_r;
93 close $fh_w;
94
95 $| = 1;
96
97 eval { $bg->() };
98
99 if ($@) {
100 my $msg = $@;
101 $msg =~ s/\n+/\n/;
102 warn "FATAL: $msg";
103 CFPlus::_exit 1;
104 }
105
106 # win32 is fucked up, of course. exit will clean stuff up,
107 # which destroys our database etc. _exit will exit ALL
108 # forked processes, because of the dreaded fork emulation.
109 CFPlus::_exit 0;
110 }
111
112 close $fh_w;
113
114 my $buffer;
115
116 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
117 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
118 undef $w;
119 $cb->();
120 return;
121 }
122
123 while ($buffer =~ s/^(.*)\n//) {
124 my $line = $1;
125 $line =~ s/\s+$//;
126 utf8::decode $line;
127 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
128 $cb->(from_json $1);
129 } else {
130 ::message ({
131 markup => "background($pid): " . CFPlus::asxml $line,
132 });
133 }
134 }
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";
145}
146
57package CFPlus::Database; 147package CFPlus::Database;
58 148
59our @ISA = BerkeleyDB::Btree::; 149our @ISA = BerkeleyDB::Btree::;
60 150
61sub get($$) { 151sub get($$) {
… …
69my %DB_SYNC; 159my %DB_SYNC;
70 160
71sub put($$$) { 161sub put($$$) {
72 my ($db, $key, $data) = @_; 162 my ($db, $key, $data) = @_;
73 163
164 my $hkey = $db + 0;
165 Scalar::Util::weaken $db;
74 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 166 $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 5, cb => sub {
167 delete $DB_SYNC{$hkey};
168 $db->db_sync if $db;
169 });
75 170
76 $db->db_put ($key => $data) 171 $db->db_put ($key => $data)
77} 172}
78 173
79package CFPlus; 174package CFPlus;
… …
85 $path = "$_/CFPlus/resources/$_[0]"; 180 $path = "$_/CFPlus/resources/$_[0]";
86 return $path if -r $path; 181 return $path if -r $path;
87 } 182 }
88 183
89 die "FATAL: can't find required file $_[0]\n"; 184 die "FATAL: can't find required file $_[0]\n";
90}
91
92BEGIN {
93 use Crossfire::Protocol::Base ();
94 *to_json = \&Crossfire::Protocol::Base::to_json;
95 *from_json = \&Crossfire::Protocol::Base::from_json;
96} 185}
97 186
98sub read_cfg { 187sub read_cfg {
99 my ($file) = @_; 188 my ($file) = @_;
100 189
… …
123 open my $fh, ">:utf8", $file 212 open my $fh, ">:utf8", $file
124 or return; 213 or return;
125 print $fh to_json $::CFG; 214 print $fh to_json $::CFG;
126} 215}
127 216
217sub http_proxy {
218 my @proxy = win32_proxy_info;
219
220 if (@proxy) {
221 "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
222 } elsif (exists $ENV{http_proxy}) {
223 $ENV{http_proxy}
224 } else {
225 ()
226 }
227}
228
229sub set_proxy {
230 my $proxy = http_proxy
231 or return;
232
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
256}
257
128our $DB_ENV; 258our $DB_ENV;
259our $DB_STATE;
260
261sub db_table($) {
262 my ($table) = @_;
263
264 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
265
266 new CFPlus::Database
267 -Env => $DB_ENV,
268 -Filename => $table,
269# -Filename => "database",
270# -Subname => $table,
271 -Property => DB_CHKSUM,
272 -Flags => DB_CREATE | DB_UPGRADE,
273 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
274}
129 275
130{ 276{
131 use strict; 277 use strict;
132 278
133 mkdir "$Crossfire::VARDIR/cfplus", 0777; 279 mkdir "$Crossfire::VARDIR/cfplus", 0777;
… …
142# -ErrPrefix => "DATABASE", 288# -ErrPrefix => "DATABASE",
143 -Verbose => 1, 289 -Verbose => 1,
144 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 290 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
145 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 291 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
146 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 292 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
147}
148 293
149sub db_table($) { 294 $DB_STATE = db_table "state";
150 my ($table) = @_;
151
152 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
153
154 new CFPlus::Database
155 -Env => $DB_ENV,
156 -Filename => $table,
157# -Filename => "database",
158# -Subname => $table,
159 -Property => DB_CHKSUM,
160 -Flags => DB_CREATE | DB_UPGRADE,
161 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
162} 295}
163 296
164package CFPlus::Layout; 297package CFPlus::Layout;
165 298
166$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { 299$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {

Diff Legend

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