ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/ipo.ext
(Generate patch)

Comparing deliantra/maps/perl/ipo.ext (file contents):
Revision 1.2 by elmex, Mon Jul 24 18:10:12 2006 UTC vs.
Revision 1.6 by root, Fri Aug 25 13:24:05 2006 UTC

… …
46 1 => ['scroll', 'mailscroll'], 46 1 => ['scroll', 'mailscroll'],
47 2 => ['note', 'newspaper'], 47 2 => ['note', 'newspaper'],
48 3 => ['diploma', 'mailwarning'], 48 3 => ['diploma', 'mailwarning'],
49); 49);
50 50
51sub notify_players {
52 my (%sent_targets) = @_;
53
54 # lets message player ingame: this is a NEW feature from the perl IPO :-)
55 for (keys %sent_targets) {
56 if (my $player = cf::player::find $_) {
57 my $cnt = $sent_targets{$_};
58
59 if ($cnt == 1) {
60 $player->ob->message ("You've got new mail.");
61 } else {
62 $player->ob->message ("You've got $cnt new mails.");
63 }
64 }
65 }
66}
67
51sub create_object { 68sub create_object {
52 my ($name, $map, $x, $y, $cb, @a) = @_; 69 my ($name, $map, $x, $y, $cb, @a) = @_;
53 my $o = cf::object::new $name; 70 my $o = cf::object::new $name;
54 my $r = $cb->($o, @a); 71 my $r = $cb->($o, @a);
55 $map->insert_object ($o, $x, $y); 72 $map->insert_object ($o, $x, $y);
56 $r 73 $r
57} 74}
58 75
59# this handler handles to notice the player that he has got mail 76# this handler handles to notice the player that he has got mail
60sub on_login { 77sub on_login {
61 my ($pl, $host) = @_; 78 my ($pl) = @_;
62 79
63 my $mails = CFMail::get_mail ($pl->ob->name); 80 my $mails = CFMail::get_mail ($pl->ob->name);
64 81
65 my $cnt = @{$mails || []}; 82 my $cnt = @{$mails || []};
66 83
… …
141 } 158 }
142 } 159 }
143 160
144 $_->remove for @mails; 161 $_->remove for @mails;
145 162
146 # lets message player ingame: this is a NEW feature from the perl IPO :-) 163 notify_players (%sent_targets);
147 for (keys %sent_targets) {
148 if (my $player = cf::player::find $_) {
149 my $cnt = $sent_targets{$_};
150
151 if ($cnt == 1) {
152 $player->ob->message ("You've got new mail.");
153 } else {
154 $player->ob->message ("You've got $cnt new mails.");
155 }
156 }
157 }
158 164
159 0; 165 0;
160} 166}
161 167
162# this is the main command interface for the IPO NPC 168# this is the main command interface for the IPO NPC
… …
224 } 230 }
225 } 231 }
226 232
227 if ($cnt) { 233 if ($cnt) {
228 $who->reply ($npc, $cnt == 1 ? "Package sent to $arguments." : "Sent $cnt packages to $arguments\n"); 234 $who->reply ($npc, $cnt == 1 ? "Package sent to $arguments." : "Sent $cnt packages to $arguments\n");
235 CFMail::send_mail (1, $arguments, $who->name, "You got $cnt packages from " . $who->name);
236 notify_players ($arguments => 1);
229 } else { 237 } else {
230 $who->reply ($npc, "Sorry, found no package to send to $arguments."); 238 $who->reply ($npc, "Sorry, found no package to send to $arguments.");
231 } 239 }
232 240
233 } else { 241 } else {
… …
238 ."- literacy (%s platinum)\n" 246 ."- literacy (%s platinum)\n"
239 ."- mailscroll <friend> (%s platinum)\n" 247 ."- mailscroll <friend> (%s platinum)\n"
240 ."- bag <friend> (%s platinum)\n" 248 ."- bag <friend> (%s platinum)\n"
241 ."- package <friend> (%s platinum)\n" 249 ."- package <friend> (%s platinum)\n"
242 ."- carton <friend> (%s platinum)\n" 250 ."- carton <friend> (%s platinum)\n"
251 ."- send <friend> (send bags/packages/cartons)\n"
252 ."- receive (to receive packages for you)\n"
243 .($who->flag (cf::FLAG_WIZ) ? "- mailwarning <player>" : ""), 253 .($who->flag (cf::FLAG_WIZ) ? "- mailwarning <player>" : ""),
244 40, 1000, 1, 1, 5, 10 254 40, 1000, 1, 1, 5, 10
245 ); 255 );
246 } 256 }
247 1 257 1
248}; 258};
249 259
250package CFMail; 260package CFMail;
251use YAML qw/LoadFile DumpFile Dump/;
252use POSIX qw/strftime/; 261use POSIX qw/strftime/;
262use CFDB;
253 263
254my $maildb_file = cf::localdir . "/crossfiremail.perl"; 264my $MAILDB = CFDB->new (db_file => cf::localdir . "/crossfiremail.perl");
255my $last_check = (-M $maildb_file) + 1;
256my $MAILDB;
257
258sub check_maildb {
259 if ($last_check > (-M $maildb_file)) {
260 $last_check = -M $maildb_file;
261
262 my $maildb = eval { my $m = LoadFile ($maildb_file); return $m };
263 if ($@) {
264 warn "ERROR when reading mail database $maildb_file: $@\n";
265 $maildb_file = cf::localdir . "/crossfiremail.perl.after_load_failure";
266 } else {
267 $MAILDB = $maildb;
268 }
269 }
270}
271
272# This is not thread or multiprocess safe!
273# XXX: A second process will (of course) terribly damage the maildatabase
274# but i assume there wont be any second process.
275sub sync_maildb {
276 eval {
277 DumpFile ("$maildb_file.tmp", $MAILDB);
278 };
279 if ($@) {
280 warn "ERROR when writing mail database $maildb_file.tmp: $@\n";
281 } else {
282 rename "$maildb_file.tmp", $maildb_file;
283 $last_check = -M $maildb_file;
284 }
285}
286 265
287sub get_mail { 266sub get_mail {
288 my ($toname) = @_; 267 my ($toname) = @_;
289 check_maildb;
290 $MAILDB->{$toname}; 268 $MAILDB->get ($toname);
291} 269}
292 270
293sub clear_mail { 271sub clear_mail {
294 my ($toname) = @_; 272 my ($toname) = @_;
295 check_maildb; 273 $MAILDB->clear ($toname);
296 $MAILDB->{$toname} = [];
297 sync_maildb;
298} 274}
299 275
300sub store_mail { 276sub store_mail {
301 my ($type, $toname, $fromname, $message) = @_; 277 my ($type, $toname, $fromname, $message) = @_;
302 check_maildb; 278 my $mails = $MAILDB->get ($toname);
303 push @{$MAILDB->{$toname}}, [$type, $fromname, $message]; 279 push @$mails, [$type, $fromname, $message];
304 sync_maildb; 280 $MAILDB->set ($toname, $mails);
305} 281}
306 282
307sub send_mail { 283sub send_mail {
308 my ($type, $toname, $fromname, $message) = @_; 284 my ($type, $toname, $fromname, $message) = @_;
309 my $time = strftime ("%a, %d %b %Y %H:%M:%S CEST", localtime (time)); 285 my $time = strftime ("%a, %d %b %Y %H:%M:%S CEST", localtime (time));
310 my $msg = "From: $fromname\nTo: $toname\nDate: $time\n\n$message\n"; 286 my $msg = "From: $fromname\nTo: $toname\nDate: $time\n\n$message\n";
311 check_maildb; 287 store_mail ($type, $toname, $fromname, $msg);
312 push @{$MAILDB->{$toname}}, [$type, $fromname, $msg];
313 sync_maildb;
314} 288}
315
316check_maildb ();
317 289
3181; 2901;

Diff Legend

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