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.114 by elmex, Mon Aug 14 04:34:40 2006 UTC vs.
Revision 1.123 by root, Mon Oct 9 01:06:36 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.52';
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
… …
52 s/</&lt;/g; 62 s/</&lt;/g;
53 63
54 $_ 64 $_
55} 65}
56 66
67sub socketpipe() {
68 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
69 or die "cannot establish bidiretcional pipe: $!\n";
70
71 ($fh1, $fh2)
72}
73
74sub background(&) {
75 my ($cb) = @_;
76
77 my ($fh_r, $fh_w) = CFPlus::socketpipe;
78
79 my $pid = fork;
80
81 if (defined $pid && !$pid) {
82 $SIG{__DIE__} = sub {
83 my $msg = $_[0];
84 $msg =~ s/\n+/\n/;
85 warn "FATAL: $msg";
86 CFPlus::_exit 99;
87 };
88
89 open STDOUT, ">&", $fh_w;
90 open STDERR, ">&", $fh_w;
91 close $fh_r;
92 close $fh_w;
93
94 $| = 1;
95
96 $cb->();
97
98 # win32 is fucked up, of course. exit will clean stuff up,
99 # which destroys our database etc. _exit will exit ALL
100 # forked processes, because of the dreaded fork emulation.
101 CFPlus::_exit 0;
102 }
103
104 close $fh_w;
105
106 my $buffer;
107
108 Event->io (fd => $fh_r, poll => 'r', cb => sub {
109 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
110 $_[0]->w->cancel;
111 $buffer .= "done\n";
112 }
113
114 while ($buffer =~ s/^(.*)\n//) {
115 my $line = $1;
116 utf8::decode $line;
117 ::message ({
118 markup => "editor($pid): " . CFPlus::asxml $line,
119 });
120 }
121 });
122}
123
57package CFPlus::Database; 124package CFPlus::Database;
58 125
59our @ISA = BerkeleyDB::Btree::; 126our @ISA = BerkeleyDB::Btree::;
60 127
61sub get($$) { 128sub get($$) {
… …
69my %DB_SYNC; 136my %DB_SYNC;
70 137
71sub put($$$) { 138sub put($$$) {
72 my ($db, $key, $data) = @_; 139 my ($db, $key, $data) = @_;
73 140
141 my $hkey = $db + 0;
142 Scalar::Util::weaken $db;
74 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 143 $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 5, cb => sub {
144 delete $DB_SYNC{$hkey};
145 $db->db_sync if $db;
146 });
75 147
76 $db->db_put ($key => $data) 148 $db->db_put ($key => $data)
77} 149}
78 150
79package CFPlus; 151package CFPlus;
… …
123 open my $fh, ">:utf8", $file 195 open my $fh, ">:utf8", $file
124 or return; 196 or return;
125 print $fh to_json $::CFG; 197 print $fh to_json $::CFG;
126} 198}
127 199
200sub http_proxy {
201 my @proxy = win32_proxy_info;
202
203 if (@proxy) {
204 "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
205 } elsif (exists $ENV{http_proxy}) {
206 $ENV{http_proxy}
207 } else {
208 ()
209 }
210}
211
212sub set_proxy {
213 my $proxy = http_proxy
214 or return;
215
216 $ENV{http_proxy} = $proxy;
217}
218
128our $DB_ENV; 219our $DB_ENV;
220our $DB_STATE;
221
222sub db_table($) {
223 my ($table) = @_;
224
225 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
226
227 new CFPlus::Database
228 -Env => $DB_ENV,
229 -Filename => $table,
230# -Filename => "database",
231# -Subname => $table,
232 -Property => DB_CHKSUM,
233 -Flags => DB_CREATE | DB_UPGRADE,
234 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
235}
129 236
130{ 237{
131 use strict; 238 use strict;
132 239
133 mkdir "$Crossfire::VARDIR/cfplus", 0777; 240 mkdir "$Crossfire::VARDIR/cfplus", 0777;
… …
142# -ErrPrefix => "DATABASE", 249# -ErrPrefix => "DATABASE",
143 -Verbose => 1, 250 -Verbose => 1,
144 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 251 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
145 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 252 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
146 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 253 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
147}
148 254
149sub db_table($) { 255 $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} 256}
163 257
164package CFPlus::Layout; 258package CFPlus::Layout;
165 259
166$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { 260$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
… …
289 sub { 383 sub {
290 &::open_string_query ("Rename item to:", sub { 384 &::open_string_query ("Rename item to:", sub {
291 my ($entry, $txt) = @_; 385 my ($entry, $txt) = @_;
292 $::CONN->send ("mark ". pack "N", $self->{tag}); 386 $::CONN->send ("mark ". pack "N", $self->{tag});
293 $::CONN->send ("command rename to <$txt>"); 387 $::CONN->send ("command rename to <$txt>");
294 }); 388 }, $self->{name},
389 "If you input no name or erase the current custom name, the custom name will be unset");
295 } 390 }
296 ], 391 ],
297 ["apply", sub { $::CONN->send ("apply $self->{tag}") }], 392 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
298 ( 393 (
299 $self->{flags} & F_LOCKED 394 $self->{flags} & F_LOCKED

Diff Legend

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