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.118 by root, Tue Sep 12 20:48:17 2006 UTC vs.
Revision 1.128 by root, Thu Nov 16 19:43:04 2006 UTC

… …
12 12
13=cut 13=cut
14 14
15package CFPlus; 15package CFPlus;
16 16
17use Carp ();
18
17BEGIN { 19BEGIN {
18 $VERSION = '0.5'; 20 $VERSION = '0.96';
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
… …
50 s/&/&/g; 66 s/&/&/g;
51 s/>/>/g; 67 s/>/>/g;
52 s/</&lt;/g; 68 s/</&lt;/g;
53 69
54 $_ 70 $_
71}
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";
55} 145}
56 146
57package CFPlus::Database; 147package CFPlus::Database;
58 148
59our @ISA = BerkeleyDB::Btree::; 149our @ISA = BerkeleyDB::Btree::;
… …
90 $path = "$_/CFPlus/resources/$_[0]"; 180 $path = "$_/CFPlus/resources/$_[0]";
91 return $path if -r $path; 181 return $path if -r $path;
92 } 182 }
93 183
94 die "FATAL: can't find required file $_[0]\n"; 184 die "FATAL: can't find required file $_[0]\n";
95}
96
97BEGIN {
98 use Crossfire::Protocol::Base ();
99 *to_json = \&Crossfire::Protocol::Base::to_json;
100 *from_json = \&Crossfire::Protocol::Base::from_json;
101} 185}
102 186
103sub read_cfg { 187sub read_cfg {
104 my ($file) = @_; 188 my ($file) = @_;
105 189
… …
128 open my $fh, ">:utf8", $file 212 open my $fh, ">:utf8", $file
129 or return; 213 or return;
130 print $fh to_json $::CFG; 214 print $fh to_json $::CFG;
131} 215}
132 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
133our $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}
134 275
135{ 276{
136 use strict; 277 use strict;
137 278
138 mkdir "$Crossfire::VARDIR/cfplus", 0777; 279 mkdir "$Crossfire::VARDIR/cfplus", 0777;
… …
147# -ErrPrefix => "DATABASE", 288# -ErrPrefix => "DATABASE",
148 -Verbose => 1, 289 -Verbose => 1,
149 -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,
150 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 291 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
151 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";
152}
153 293
154sub db_table($) { 294 $DB_STATE = db_table "state";
155 my ($table) = @_;
156
157 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
158
159 new CFPlus::Database
160 -Env => $DB_ENV,
161 -Filename => $table,
162# -Filename => "database",
163# -Subname => $table,
164 -Property => DB_CHKSUM,
165 -Flags => DB_CREATE | DB_UPGRADE,
166 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
167} 295}
168 296
169package CFPlus::Layout; 297package CFPlus::Layout;
170 298
171$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