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.123 by root, Mon Oct 9 01:06:36 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
… …
69 or die "cannot establish bidiretcional pipe: $!\n"; 76 or die "cannot establish bidiretcional pipe: $!\n";
70 77
71 ($fh1, $fh2) 78 ($fh1, $fh2)
72} 79}
73 80
74sub background(&) { 81sub background(&;&) {
75 my ($cb) = @_; 82 my ($bg, $cb) = @_;
76 83
77 my ($fh_r, $fh_w) = CFPlus::socketpipe; 84 my ($fh_r, $fh_w) = CFPlus::socketpipe;
78 85
79 my $pid = fork; 86 my $pid = fork;
80 87
81 if (defined $pid && !$pid) { 88 if (defined $pid && !$pid) {
82 $SIG{__DIE__} = sub { 89 local $SIG{__DIE__};
83 my $msg = $_[0];
84 $msg =~ s/\n+/\n/;
85 warn "FATAL: $msg";
86 CFPlus::_exit 99;
87 };
88 90
89 open STDOUT, ">&", $fh_w; 91 open STDOUT, ">&", $fh_w;
90 open STDERR, ">&", $fh_w; 92 open STDERR, ">&", $fh_w;
91 close $fh_r; 93 close $fh_r;
92 close $fh_w; 94 close $fh_w;
93 95
94 $| = 1; 96 $| = 1;
95 97
96 $cb->(); 98 eval { $bg->() };
99
100 if ($@) {
101 my $msg = $@;
102 $msg =~ s/\n+/\n/;
103 warn "FATAL: $msg";
104 CFPlus::_exit 1;
105 }
97 106
98 # win32 is fucked up, of course. exit will clean stuff up, 107 # win32 is fucked up, of course. exit will clean stuff up,
99 # which destroys our database etc. _exit will exit ALL 108 # which destroys our database etc. _exit will exit ALL
100 # forked processes, because of the dreaded fork emulation. 109 # forked processes, because of the dreaded fork emulation.
101 CFPlus::_exit 0; 110 CFPlus::_exit 0;
102 } 111 }
103 112
104 close $fh_w; 113 close $fh_w;
105 114
106 my $buffer; 115 my $buffer;
107 116
108 Event->io (fd => $fh_r, poll => 'r', cb => sub { 117 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
109 unless (sysread $fh_r, $buffer, 4096, length $buffer) { 118 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
110 $_[0]->w->cancel; 119 undef $w;
111 $buffer .= "done\n"; 120 $cb->();
121 return;
112 } 122 }
113 123
114 while ($buffer =~ s/^(.*)\n//) { 124 while ($buffer =~ s/^(.*)\n//) {
115 my $line = $1; 125 my $line = $1;
126 $line =~ s/\s+$//;
116 utf8::decode $line; 127 utf8::decode $line;
128 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
129 $cb->(from_json $1);
130 } else {
117 ::message ({ 131 ::message ({
118 markup => "editor($pid): " . CFPlus::asxml $line, 132 markup => "background($pid): " . CFPlus::asxml $line,
133 });
119 }); 134 }
120 } 135 }
121 }); 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";
122} 146}
123 147
124package CFPlus::Database; 148package CFPlus::Database;
125 149
126our @ISA = BerkeleyDB::Btree::; 150our @ISA = BerkeleyDB::Btree::;
… …
157 $path = "$_/CFPlus/resources/$_[0]"; 181 $path = "$_/CFPlus/resources/$_[0]";
158 return $path if -r $path; 182 return $path if -r $path;
159 } 183 }
160 184
161 die "FATAL: can't find required file $_[0]\n"; 185 die "FATAL: can't find required file $_[0]\n";
162}
163
164BEGIN {
165 use Crossfire::Protocol::Base ();
166 *to_json = \&Crossfire::Protocol::Base::to_json;
167 *from_json = \&Crossfire::Protocol::Base::from_json;
168} 186}
169 187
170sub read_cfg { 188sub read_cfg {
171 my ($file) = @_; 189 my ($file) = @_;
172 190
… …
214 or return; 232 or return;
215 233
216 $ENV{http_proxy} = $proxy; 234 $ENV{http_proxy} = $proxy;
217} 235}
218 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
219our $DB_ENV; 259our $DB_ENV;
220our $DB_STATE; 260our $DB_STATE;
221 261
222sub db_table($) { 262sub db_table($) {
223 my ($table) = @_; 263 my ($table) = @_;
… …
235} 275}
236 276
237{ 277{
238 use strict; 278 use strict;
239 279
240 mkdir "$Crossfire::VARDIR/cfplus", 0777; 280 my $HOME = "$Crossfire::VARDIR/cfplus-$BerkeleyDB::db_version";
281
282 mkdir $HOME, 0777;
241 my $recover = $BerkeleyDB::db_version >= 4.4 283 my $recover = $BerkeleyDB::db_version >= 4.4
242 ? eval "DB_REGISTER | DB_RECOVER" 284 ? eval "DB_REGISTER | DB_RECOVER"
243 : 0; 285 : 0;
244 286
245 $DB_ENV = new BerkeleyDB::Env 287 $DB_ENV = new BerkeleyDB::Env
246 -Home => "$Crossfire::VARDIR/cfplus", 288 -Home => $HOME,
247 -Cachesize => 1_000_000, 289 -Cachesize => 1_000_000,
248 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt", 290 -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
249# -ErrPrefix => "DATABASE", 291# -ErrPrefix => "DATABASE",
250 -Verbose => 1, 292 -Verbose => 1,
251 -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,
252 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 294 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
253 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";
254 296
255 $DB_STATE = db_table "state"; 297 $DB_STATE = db_table "state";
256} 298}
257 299
258package CFPlus::Layout; 300package CFPlus::Layout;
… …
358 } elsif ($ev->{button} == 3) { 400 } elsif ($ev->{button} == 3) {
359 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop'; 401 my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
360 if ($self->{container} == $::CONN->{open_container}) { 402 if ($self->{container} == $::CONN->{open_container}) {
361 $move_prefix = "take"; 403 $move_prefix = "take";
362 } 404 }
405
406 my $shortname = CFPlus::shorten $self->{name}, 14;
363 407
364 my @menu_items = ( 408 my @menu_items = (
365 ["examine", sub { $::CONN->send ("examine $self->{tag}") }], 409 ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
366 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }], 410 ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
367 ["ignite/thaw", # first try of an easier use of flint&steel 411 ["ignite/thaw", # first try of an easier use of flint&steel
… …
403 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") }) 447 do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
404 } 448 }
405 ] 449 ]
406 ) 450 )
407 ), 451 ),
452 ["bind <i>apply $shortname</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["apply $self->{name}"]) }],
408 ); 453 );
409 454
410 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); 455 CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
411 } 456 }
412 457

Diff Legend

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