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.130 by root, Sun Dec 3 16:48:24 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.97';
19 21
20 use XSLoader; 22 use XSLoader;
21 XSLoader::load "CFPlus", $VERSION; 23 XSLoader::load "CFPlus", $VERSION;
22} 24}
23 25
24use utf8; 26use utf8;
25 27
26use Carp ();
27use AnyEvent (); 28use AnyEvent ();
28use BerkeleyDB; 29use BerkeleyDB;
29use Pod::POM (); 30use Pod::POM ();
30use Scalar::Util (); 31use Scalar::Util ();
31use Storable (); # finally 32use Storable (); # finally
32 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
33=item guard { BLOCK } 40=item guard { BLOCK }
34 41
35Returns 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.
36 43
37=cut 44=cut
… …
52 s/</&lt;/g; 59 s/</&lt;/g;
53 60
54 $_ 61 $_
55} 62}
56 63
64sub socketpipe() {
65 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
66 or die "cannot establish bidiretcional pipe: $!\n";
67
68 ($fh1, $fh2)
69}
70
71sub background(&;&) {
72 my ($bg, $cb) = @_;
73
74 my ($fh_r, $fh_w) = CFPlus::socketpipe;
75
76 my $pid = fork;
77
78 if (defined $pid && !$pid) {
79 local $SIG{__DIE__};
80
81 open STDOUT, ">&", $fh_w;
82 open STDERR, ">&", $fh_w;
83 close $fh_r;
84 close $fh_w;
85
86 $| = 1;
87
88 eval { $bg->() };
89
90 if ($@) {
91 my $msg = $@;
92 $msg =~ s/\n+/\n/;
93 warn "FATAL: $msg";
94 CFPlus::_exit 1;
95 }
96
97 # win32 is fucked up, of course. exit will clean stuff up,
98 # which destroys our database etc. _exit will exit ALL
99 # forked processes, because of the dreaded fork emulation.
100 CFPlus::_exit 0;
101 }
102
103 close $fh_w;
104
105 my $buffer;
106
107 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
108 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
109 undef $w;
110 $cb->();
111 return;
112 }
113
114 while ($buffer =~ s/^(.*)\n//) {
115 my $line = $1;
116 $line =~ s/\s+$//;
117 utf8::decode $line;
118 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
119 $cb->(from_json $1);
120 } else {
121 ::message ({
122 markup => "background($pid): " . CFPlus::asxml $line,
123 });
124 }
125 }
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";
136}
137
57package CFPlus::Database; 138package CFPlus::Database;
58 139
59our @ISA = BerkeleyDB::Btree::; 140our @ISA = BerkeleyDB::Btree::;
60 141
61sub get($$) { 142sub get($$) {
… …
69my %DB_SYNC; 150my %DB_SYNC;
70 151
71sub put($$$) { 152sub put($$$) {
72 my ($db, $key, $data) = @_; 153 my ($db, $key, $data) = @_;
73 154
155 my $hkey = $db + 0;
156 Scalar::Util::weaken $db;
74 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 157 $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 5, cb => sub {
158 delete $DB_SYNC{$hkey};
159 $db->db_sync if $db;
160 });
75 161
76 $db->db_put ($key => $data) 162 $db->db_put ($key => $data)
77} 163}
78 164
79package CFPlus; 165package CFPlus;
… …
85 $path = "$_/CFPlus/resources/$_[0]"; 171 $path = "$_/CFPlus/resources/$_[0]";
86 return $path if -r $path; 172 return $path if -r $path;
87 } 173 }
88 174
89 die "FATAL: can't find required file $_[0]\n"; 175 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} 176}
97 177
98sub read_cfg { 178sub read_cfg {
99 my ($file) = @_; 179 my ($file) = @_;
100 180
… …
123 open my $fh, ">:utf8", $file 203 open my $fh, ">:utf8", $file
124 or return; 204 or return;
125 print $fh to_json $::CFG; 205 print $fh to_json $::CFG;
126} 206}
127 207
208sub http_proxy {
209 my @proxy = win32_proxy_info;
210
211 if (@proxy) {
212 "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
213 } elsif (exists $ENV{http_proxy}) {
214 $ENV{http_proxy}
215 } else {
216 ()
217 }
218}
219
220sub set_proxy {
221 my $proxy = http_proxy
222 or return;
223
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
247}
248
128our $DB_ENV; 249our $DB_ENV;
250our $DB_STATE;
251
252sub db_table($) {
253 my ($table) = @_;
254
255 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
256
257 new CFPlus::Database
258 -Env => $DB_ENV,
259 -Filename => $table,
260# -Filename => "database",
261# -Subname => $table,
262 -Property => DB_CHKSUM,
263 -Flags => DB_CREATE | DB_UPGRADE,
264 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
265}
129 266
130{ 267{
131 use strict; 268 use strict;
132 269
133 mkdir "$Crossfire::VARDIR/cfplus", 0777; 270 mkdir "$Crossfire::VARDIR/cfplus", 0777;
… …
142# -ErrPrefix => "DATABASE", 279# -ErrPrefix => "DATABASE",
143 -Verbose => 1, 280 -Verbose => 1,
144 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 281 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
145 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 282 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
146 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 283 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
147}
148 284
149sub db_table($) { 285 $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} 286}
163 287
164package CFPlus::Layout; 288package CFPlus::Layout;
165 289
166$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { 290$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {

Diff Legend

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