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.112 by root, Sun Aug 13 03:20:53 2006 UTC vs.
Revision 1.121 by root, Fri Sep 29 00:56:05 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
… …
69my %DB_SYNC; 79my %DB_SYNC;
70 80
71sub put($$$) { 81sub put($$$) {
72 my ($db, $key, $data) = @_; 82 my ($db, $key, $data) = @_;
73 83
84 my $hkey = $db + 0;
85 Scalar::Util::weaken $db;
74 $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); 86 $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 5, cb => sub {
87 delete $DB_SYNC{$hkey};
88 $db->db_sync if $db;
89 });
75 90
76 $db->db_put ($key => $data) 91 $db->db_put ($key => $data)
77} 92}
78 93
79package CFPlus; 94package CFPlus;
… …
124 or return; 139 or return;
125 print $fh to_json $::CFG; 140 print $fh to_json $::CFG;
126} 141}
127 142
128our $DB_ENV; 143our $DB_ENV;
144our $DB_STATE;
145
146sub db_table($) {
147 my ($table) = @_;
148
149 $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
150
151 new CFPlus::Database
152 -Env => $DB_ENV,
153 -Filename => $table,
154# -Filename => "database",
155# -Subname => $table,
156 -Property => DB_CHKSUM,
157 -Flags => DB_CREATE | DB_UPGRADE,
158 or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
159}
129 160
130{ 161{
131 use strict; 162 use strict;
132 163
133 mkdir "$Crossfire::VARDIR/cfplus", 0777; 164 mkdir "$Crossfire::VARDIR/cfplus", 0777;
… …
142# -ErrPrefix => "DATABASE", 173# -ErrPrefix => "DATABASE",
143 -Verbose => 1, 174 -Verbose => 1,
144 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover, 175 -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
145 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE, 176 -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
146 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error"; 177 or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
147}
148 178
149sub db_table($) { 179 $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} 180}
163 181
164package CFPlus::Layout; 182package CFPlus::Layout;
165 183
166$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { 184$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
… …
209} 227}
210 228
211sub do_n_dialog { 229sub do_n_dialog {
212 my ($cb) = @_; 230 my ($cb) = @_;
213 231
214 my $w = new CFPlus::UI::FancyFrame 232 my $w = new CFPlus::UI::Toplevel
215 on_delete => sub { $_[0]->destroy; 1 }, 233 on_delete => sub { $_[0]->destroy; 1 },
216 has_close_button => 1, 234 has_close_button => 1,
217 ; 235 ;
218 236
219 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center"); 237 $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
… …
281 &::open_string_query ("Text to inscribe", sub { 299 &::open_string_query ("Text to inscribe", sub {
282 my ($entry, $txt) = @_; 300 my ($entry, $txt) = @_;
283 $::CONN->send ("mark ". pack "N", $self->{tag}); 301 $::CONN->send ("mark ". pack "N", $self->{tag});
284 $::CONN->send ("command use_skill inscription $txt"); 302 $::CONN->send ("command use_skill inscription $txt");
285 }); 303 });
304 }
305 ],
306 ["rename", # first try of an easier use of flint&steel
307 sub {
308 &::open_string_query ("Rename item to:", sub {
309 my ($entry, $txt) = @_;
310 $::CONN->send ("mark ". pack "N", $self->{tag});
311 $::CONN->send ("command rename to <$txt>");
312 }, $self->{name},
313 "If you input no name or erase the current custom name, the custom name will be unset");
286 } 314 }
287 ], 315 ],
288 ["apply", sub { $::CONN->send ("apply $self->{tag}") }], 316 ["apply", sub { $::CONN->send ("apply $self->{tag}") }],
289 ( 317 (
290 $self->{flags} & F_LOCKED 318 $self->{flags} & F_LOCKED

Diff Legend

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