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.122 by root, Sun Oct 1 14:48:50 2006 UTC vs.
Revision 1.133 by root, Wed Dec 6 00:15:12 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
… …
50 bless \(my $cb = $_[0]), "CFPlus::Guard" 47 bless \(my $cb = $_[0]), "CFPlus::Guard"
51} 48}
52 49
53sub CFPlus::Guard::DESTROY { 50sub CFPlus::Guard::DESTROY {
54 ${$_[0]}->() 51 ${$_[0]}->()
52}
53
54=item shorten $string[, $maxlength]
55
56=cut
57
58sub shorten($;$) {
59 my ($str, $len) = @_;
60 substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
61 $str
55} 62}
56 63
57sub asxml($) { 64sub asxml($) {
58 local $_ = $_[0]; 65 local $_ = $_[0];
59 66
60 s/&/&amp;/g; 67 s/&/&amp;/g;
61 s/>/&gt;/g; 68 s/>/&gt;/g;
62 s/</&lt;/g; 69 s/</&lt;/g;
63 70
64 $_ 71 $_
72}
73
74sub socketpipe() {
75 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
76 or die "cannot establish bidiretcional pipe: $!\n";
77
78 ($fh1, $fh2)
79}
80
81sub background(&;&) {
82 my ($bg, $cb) = @_;
83
84 my ($fh_r, $fh_w) = CFPlus::socketpipe;
85
86 my $pid = fork;
87
88 if (defined $pid && !$pid) {
89 local $SIG{__DIE__};
90
91 open STDOUT, ">&", $fh_w;
92 open STDERR, ">&", $fh_w;
93 close $fh_r;
94 close $fh_w;
95
96 $| = 1;
97
98 eval { $bg->() };
99
100 if ($@) {
101 my $msg = $@;
102 $msg =~ s/\n+/\n/;
103 warn "FATAL: $msg";
104 CFPlus::_exit 1;
105 }
106
107 # win32 is fucked up, of course. exit will clean stuff up,
108 # which destroys our database etc. _exit will exit ALL
109 # forked processes, because of the dreaded fork emulation.
110 CFPlus::_exit 0;
111 }
112
113 close $fh_w;
114
115 my $buffer;
116
117 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
118 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
119 undef $w;
120 $cb->();
121 return;
122 }
123
124 while ($buffer =~ s/^(.*)\n//) {
125 my $line = $1;
126 $line =~ s/\s+$//;
127 utf8::decode $line;
128 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
129 $cb->(from_json $1);
130 } else {
131 ::message ({
132 markup => "background($pid): " . CFPlus::asxml $line,
133 });
134 }
135 }
136 });
137}
138
139sub background_msg {
140 my ($msg) = @_;
141
142 $msg = "\x{e877}json_msg " . to_json $msg;
143 $msg =~ s/\n//g;
144 utf8::encode $msg;
145 print $msg, "\n";
65} 146}
66 147
67package CFPlus::Database; 148package CFPlus::Database;
68 149
69our @ISA = BerkeleyDB::Btree::; 150our @ISA = BerkeleyDB::Btree::;
… …
100 $path = "$_/CFPlus/resources/$_[0]"; 181 $path = "$_/CFPlus/resources/$_[0]";
101 return $path if -r $path; 182 return $path if -r $path;
102 } 183 }
103 184
104 die "FATAL: can't find required file $_[0]\n"; 185 die "FATAL: can't find required file $_[0]\n";
105}
106
107BEGIN {
108 use Crossfire::Protocol::Base ();
109 *to_json = \&Crossfire::Protocol::Base::to_json;
110 *from_json = \&Crossfire::Protocol::Base::from_json;
111} 186}
112 187
113sub read_cfg { 188sub read_cfg {
114 my ($file) = @_; 189 my ($file) = @_;
115 190
… …
157 or return; 232 or return;
158 233
159 $ENV{http_proxy} = $proxy; 234 $ENV{http_proxy} = $proxy;
160} 235}
161 236
237sub lwp_useragent {
238 require LWP::UserAgent;
239
240 CFPlus::set_proxy;
241
242 my $ua = LWP::UserAgent->new (
243 agent => "cfplus $VERSION",
244 keep_alive => 1,
245 env_proxy => 1,
246 timeout => 30,
247 );
248}
249
250sub lwp_check($) {
251 my ($res) = @_;
252
253 $res->is_error
254 and die $res->status_line;
255
256 $res
257}
258
162our $DB_ENV; 259our $DB_ENV;
163our $DB_STATE; 260our $DB_STATE;
164 261
165sub db_table($) { 262sub db_table($) {
166 my ($table) = @_; 263 my ($table) = @_;
… …
178} 275}
179 276
180{ 277{
181 use strict; 278 use strict;
182 279
183 mkdir "$Crossfire::VARDIR/cfplus", 0777; 280 my $HOME = "$Crossfire::VARDIR/cfplus-$BerkeleyDB::db_version";
281
282 mkdir $HOME, 0777;
184 my $recover = $BerkeleyDB::db_version >= 4.4 283 my $recover = $BerkeleyDB::db_version >= 4.4
185 ? eval "DB_REGISTER | DB_RECOVER" 284 ? eval "DB_REGISTER | DB_RECOVER"
186 : 0; 285 : 0;
187 286
188 $DB_ENV = new BerkeleyDB::Env 287 $DB_ENV = new BerkeleyDB::Env
189 -Home => "$Crossfire::VARDIR/cfplus", 288 -Home => $HOME,
190 -Cachesize => 1_000_000, 289 -Cachesize => 1_000_000,
191 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 290 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
192# -ErrPrefix => "DATABASE", 291# -ErrPrefix => "DATABASE",
193 -Verbose => 1, 292 -Verbose => 1,
194 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 293 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
195 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 294 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
196 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 295 or die "unable to create/open database home $HOME: $BerkeleyDB::Error";
197 296
198 $DB_STATE = db_table "state"; 297 $DB_STATE = db_table "state";
199} 298}
200 299
201package CFPlus::Layout; 300package CFPlus::Layout;
… …
301 } elsif ($ev->{button} == 3) { 400 } elsif ($ev->{button} == 3) {
302 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop'; 401 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
303 if ($self->{container} == $::CONN->{open_container}) { 402 if ($self->{container} == $::CONN->{open_container}) {
304 $move_prefix = "take"; 403 $move_prefix = "take";
305 } 404 }
405
406 my $shortname = CFPlus::shorten $self->{name}, 14;
306 407
307 my @menu_items = ( 408 my @menu_items = (
308 ["examine", sub { $::CONN->send ("examine $self->{tag}") }], 409 ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
309 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }], 410 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
310 ["ignite/thaw", # first try of an easier use of flint&steel 411 ["ignite/thaw", # first try of an easier use of flint&steel
… …
346 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") }) 447 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
347 } 448 }
348 ] 449 ]
349 ) 450 )
350 ), 451 ),
452 ["bind <i>apply $shortname</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["apply $self->{name}"]) }],
351 ); 453 );
352 454
353 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); 455 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
354 } 456 }
355 457

Diff Legend

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