ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.7 by root, Tue Mar 7 13:44:43 2006 UTC vs.
Revision 1.9 by root, Fri Mar 17 03:22:00 2006 UTC

… …
22 print STDERR "cfperl: $msg"; 22 print STDERR "cfperl: $msg";
23 LOG llevError, "cfperl: $msg"; 23 LOG llevError, "cfperl: $msg";
24 }; 24 };
25} 25}
26 26
27my %ignore_set = (MAP_PROP_PATH => 1); # I hate the plug-in api. Deeply!
28
27# generate property mutators 29# generate property mutators
28sub prop_gen { 30sub prop_gen {
29 my ($prefix, $class) = @_; 31 my ($prefix, $class) = @_;
30 32
31 no strict 'refs'; 33 no strict 'refs';
… …
41 $_[0]->get_property ($type, $idx) 43 $_[0]->get_property ($type, $idx)
42 }; 44 };
43 45
44 *{"$class\::set_$sub"} = sub { 46 *{"$class\::set_$sub"} = sub {
45 $_[0]->set_property ($type, $idx, $_[1]); 47 $_[0]->set_property ($type, $idx, $_[1]);
46 }; 48 } unless $ignore_set{$prop};
47 } 49 }
48} 50}
49 51
50# auto-generate most of the API 52# auto-generate most of the API
51 53
… …
212 } else { 214 } else {
213 $who->message ("Intruder Alert!"); 215 $who->message ("Intruder Alert!");
214 } 216 }
215}; 217};
216 218
219#############################################################################
220# load/save/clean perl data associated with a map
221
217*on_mapclean = sub { 222*on_mapclean = sub {
218 my $map = shift->{map}; 223 my $map = shift->{map};
219 224
220 my $path = $map->tmpname; 225 my $path = $map->tmpname;
221 defined $path or return; 226 defined $path or return;
… …
251 256
252 if (defined $obs) { 257 if (defined $obs) {
253 open my $fh, ">:raw", "$path.cfperl" 258 open my $fh, ">:raw", "$path.cfperl"
254 or die "$path.cfperl: $!"; 259 or die "$path.cfperl: $!";
255 260
261 stat $path;
262
256 print $fh Storable::nfreeze { 263 print $fh Storable::nfreeze {
264 size => (stat _)[7],
265 time => (stat _)[9],
257 version => 1, 266 version => 1,
258 obs => $obs, 267 obs => $obs,
259 }; 268 };
260 269
261 chmod SAVE_MODE, "$path.cfperl"; # very racy, but cf-compatible *g* 270 chmod SAVE_MODE, "$path.cfperl"; # very racy, but cf-compatible *g*
262 } else { 271 } else {
263 unlink "$path.cfperl"; 272 unlink "$path.cfperl";
264 } 273 }
265}; 274};
266 275
276#############################################################################
277# load/save perl data associated with player->ob objects
278
279*on_player_load = sub {
280 my ($event) = @_;
281 my $path = $event->{message};
282 my $ob = $event->{who};
283
284 open my $fh, "<:raw", "$path.cfperl"
285 or return; # no perl data
286
287 my $data = Storable::thaw do { local $/; <$fh> };
288
289 $data->{version} <= 1
290 or return; # too new
291
292 %$ob = %{$data->{ob}};
293};
294
295*on_player_save = sub {
296 my ($event) = @_;
297 my $path = $event->{message};
298 my $ob = $event->{who};
299
300 if (keys %$ob) {
301 open my $fh, ">:raw", "$path.cfperl"
302 or die "$path.cfperl: $!";
303
304 stat $path;
305
306 print $fh Storable::nfreeze {
307 size => (stat _)[7],
308 time => (stat _)[9],
309 version => 1,
310 ob => $ob,
311 };
312
313 chmod SAVE_MODE, "$path.cfperl"; # very racy, but cf-compatible *g*
314 } else {
315 unlink "$path.cfperl";
316 }
317};
318
267register "<global>", __PACKAGE__; 319register "<global>", __PACKAGE__;
268 320
269load_extensions; 321load_extensions;
270 322
2711 3231

Diff Legend

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