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

Comparing deliantra/server/ext/ipo.ext (file contents):
Revision 1.16 by sf-marcmagus, Sun Oct 11 21:39:08 2009 UTC vs.
Revision 1.17 by root, Sat Jan 30 23:30:26 2010 UTC

… …
75# this handler notifies the player of new mail 75# this handler notifies the player of new mail
76cf::player->attach ( 76cf::player->attach (
77 on_login => sub { 77 on_login => sub {
78 my ($pl) = @_; 78 my ($pl) = @_;
79 79
80 my $mails = CFMail::get_mail ($pl->ob->name);
81
82 my $cnt = @{$mails || []}; 80 my $cnt = @{ $pl->{ip_mails} };
83 81
84 if ($cnt == 1) { 82 if ($cnt == 1) {
85 $pl->ob->message ("You got one mail."); 83 $pl->ob->message ("You got one mail.");
86 } elsif ($cnt > 1) { 84 } elsif ($cnt > 1) {
87 $pl->ob->message ("You got $cnt mails."); 85 $pl->ob->message ("You got $cnt mails.");
… …
92); 90);
93 91
94# this event handler handles receiving of mails 92# this event handler handles receiving of mails
95cf::object::attachment ipo_mailbox => 93cf::object::attachment ipo_mailbox =>
96 on_apply => sub { 94 on_apply => sub {
97 my ($box, $pl) = @_; 95 my ($box, $ob) = @_;
98 96
99 my $cnt; 97 my $cnt;
100 my $mails = CFMail::get_mail ($pl->name) || []; 98 my $mails = $ob->contr->{ipo_mails} || [];
101 99
102 # count the mails that are in the container 100 # count the mails that are in the container
103 # FIXME: the problem with on_apply is that it is called even when 101 # FIXME: the problem with on_apply is that it is called even when
104 # the player closes the container. so we get a 'You have X mails.' message 102 # the player closes the container. so we get a 'You have X mails.' message
105 # twice. - This bug existed also with the old python plugin 103 # twice. - This bug existed also with the old python plugin
106 104
107 my $plname = $pl->name; 105 my $plname = $ob->name;
106
108 for ($box->inv) { 107 for ($box->inv) {
109 $_->name =~ /\S+ F: \S+ T: \Q$plname\E/ 108 ++$cnt if $_->name =~ /^mail(?:scroll|warning) F: \S+ T: \Q$plname\E/;
110 and $cnt++;
111 } 109 }
112 110
113 for (@$mails) { 111 for (@$mails) {
114 my ($type, $from, $msg) = @$_; 112 my ($type, $from, $msg) = @$_;
115 $type = $mailtypes{$type || 1} || ['scroll', 'mailscroll']; 113 $type = $mailtypes{$type || 1} || ['scroll', 'mailscroll'];
116 my $mail = cf::object::new $type->[0]; 114 my $mail = cf::object::new $type->[0];
117 $mail->name ("$type->[1] F: $from T: " .$pl->name); 115 $mail->name ("$type->[1] F: $from T: $plname");
118 $mail->name_pl ("$type->[1]s F: $from T: " .$pl->name); 116 $mail->name_pl ("$type->[1]s F: $from T: $plname");
119 $mail->msg ($msg); 117 $mail->msg ($msg);
120 $mail->value (0); 118 $mail->value (0);
121 $box->insert ($mail); 119 $box->insert ($mail);
122 } 120 }
123 121
124 $cnt += @$mails; 122 $cnt += @$mails;
125 123
126 if ($cnt == 1) { 124 if ($cnt == 1) {
127 $pl->message ("You got one mail."); 125 $ob->message ("You got one mail.");
128 } elsif ($cnt > 1) { 126 } elsif ($cnt > 1) {
129 $pl->message ("You got $cnt mails."); 127 $ob->message ("You got $cnt mails.");
130 } else { 128 } else {
131 $pl->message ("You haven't got any mail."); 129 $ob->message ("You haven't got any mail.");
132 } 130 }
133 131
134 CFMail::clear_mail ($pl->name); 132 delete $ob->contr->{ipo_mails};
135 }, 133 },
136 # this event handler handles the sending of mails 134 # this event handler handles the sending of mails
137 on_close => sub { 135 on_close => sub {
138 my ($box, $pl) = @_; 136 my ($box, $ob) = @_;
139 137
140 my @mails; 138 my @mails = grep $_->name =~ /^mail(?:scroll|warning) [TF]: /, $box->inv;
141
142 my %sent_targets;
143
144 for ($box->inv) {
145 if ($_->name =~ m/^mail(scroll|warning) T: (\S+) F: (\S+)/) {
146 CFMail::send_mail ($1 eq 'scroll' ? 1 : 3, $2, $3, $_->msg);
147 $pl->message ("Sent mail$1 to $2 (from $3).");
148 $sent_targets{$2}++;
149 push @mails, $_;
150
151 } elsif ($_->name =~ m/^mail(scroll|warning) F: (\S+) T: (\S+)/) {
152 # this is for mails that remain in the queue for the player
153 CFMail::store_mail ($1 eq 'scroll' ? 1 : 3, $3, $2, $_->msg);
154 push @mails, $_;
155 }
156 }
157
158 $_->remove for @mails; 139 $_->remove for @mails;
159 140
141 # we can lose mails here, when the player is unloadable and the server crashes. shit happens.
142 cf::async {
143 my %sent_targets;
144
145 for (@mails) {
146 if ($_->name =~ m/^mail(scroll|warning) T: (\S+) F: (\S+)/) {
147 CFMail::send_mail ($1 eq 'scroll' ? 1 : 3, $2, $3, $_->msg);
148 $ob->message ("Sent mail$1 to $2 (from $3).");
149 ++$sent_targets{$2};
150
151 } elsif ($_->name =~ m/^mail(scroll|warning) F: (\S+) T: (\S+)/) {
152 # this is for mails that remain in the queue for the player
153 CFMail::store_mail ($1 eq 'scroll' ? 1 : 3, $3, $2, $_->msg);
154 }
155
156 $_->destroy;
157 }
158
160 notify_players (%sent_targets); 159 notify_players (%sent_targets);
160 };
161 }, 161 },
162; 162;
163 163
164# this is the main command interface for the IPO NPC 164# this is the main command interface for the IPO NPC
165cf::register_script_function "ipo::command" => sub { 165cf::register_script_function "ipo::command" => sub {
… …
274}; 274};
275 275
276package CFMail; 276package CFMail;
277 277
278use POSIX qw/strftime/; 278use POSIX qw/strftime/;
279use CFDB;
280 279
281my $MAILDB = CFDB->new (db_file => "$LOCALDIR/crossfiremail"); 280rename "$cf::LOCALDIR/crossfiremail", "$cf::LOCALDIR/crossfiremail.is-now-on-player";
282
283sub get_mail {
284 my ($toname) = @_;
285 $MAILDB->get ($toname);
286}
287
288sub clear_mail {
289 my ($toname) = @_;
290 $MAILDB->clear ($toname);
291}
292 281
293sub store_mail { 282sub store_mail {
294 my ($type, $toname, $fromname, $message) = @_; 283 my ($type, $toname, $fromname, $message) = @_;
295 my $mails = $MAILDB->get ($toname); 284
285 my $pl = cf::player::find $toname
286 or return;
287
296 push @$mails, [$type, $fromname, $message]; 288 push @{ $pl->{ipo_mails} }, [$type, $fromname, $message];
297 $MAILDB->set ($toname, $mails);
298} 289}
299 290
300sub send_mail { 291sub send_mail {
301 my ($type, $toname, $fromname, $message) = @_; 292 my ($type, $toname, $fromname, $message) = @_;
293
302 my $time = strftime ("%a, %d %b %Y %H:%M:%S CEST", localtime (time)); 294 my $time = strftime ("%a, %d %b %Y %H:%M:%S UTC", gmtime EV::now);
303 my $msg = "From: $fromname\rTo: $toname\rDate: $time\n\n$message\n"; 295 my $msg = "From: $fromname\rTo: $toname\rDate: $time\n\n$message\n";
296
304 store_mail ($type, $toname, $fromname, $msg); 297 store_mail $type, $toname, $fromname, $msg;
305} 298}
306 299
3071; 3001
308 301

Diff Legend

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