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

Diff Legend

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