--- deliantra/server/ext/ipo.ext 2008/09/22 01:33:09 1.15 +++ deliantra/server/ext/ipo.ext 2010/05/04 21:45:42 1.19 @@ -1,7 +1,5 @@ #! perl -my $price_fact = 50; - sub set_package { my ($pkg, $from, $to, $bagname, $weight) = @_; @@ -10,18 +8,18 @@ $pkg->stats->Str (0); } -# prices in plat. +# prices [in silver] my %prices = ( pen => [ - 40, 'stylus', + 10000, 'stylus', sub { $_[0]->name ('IPO Writing Pen'); $_[0]->value (0); } ], literacy => [ - 1000, 'scroll_literacy', + 10000, 'scroll_literacy', sub { $_[0]->value (0) } ], mailscroll => [ - 1, 'mailscroll_empty', + 50, 'mailscroll_empty', sub { $_[0]->name ("mailscroll T: $_[2] F: $_[1]"); $_[0]->name_pl ("mailscrolls T: $_[2] F: $_[1]"); @@ -29,9 +27,9 @@ }, 'plarg' ], - bag => [ 1, 'r_sack', sub { set_package (@_, bag => 5000) }, 'plarg' ], - package => [ 5, 'r_sack', sub { set_package (@_, package => 50000) }, 'plarg' ], - carton => [10, 'r_sack', sub { set_package (@_, carton => 100000) }, 'plarg' ], + bag => [ 100, 'r_sack', sub { set_package (@_, bag => 5000) }, 'plarg' ], + package => [ 1000, 'r_sack', sub { set_package (@_, package => 50000) }, 'plarg' ], + carton => [ 2000, 'r_sack', sub { set_package (@_, carton => 100000) }, 'plarg' ], mailwarning => [ 0, 'diploma', sub { @@ -79,9 +77,7 @@ on_login => sub { my ($pl) = @_; - my $mails = CFMail::get_mail ($pl->ob->name); - - my $cnt = @{$mails || []}; + my $cnt = @{ $pl->{ip_mails} }; if ($cnt == 1) { $pl->ob->message ("You got one mail."); @@ -96,28 +92,28 @@ # this event handler handles receiving of mails cf::object::attachment ipo_mailbox => on_apply => sub { - my ($box, $pl) = @_; + my ($box, $ob) = @_; my $cnt; - my $mails = CFMail::get_mail ($pl->name) || []; + my $mails = $ob->contr->{ipo_mails} || []; # count the mails that are in the container # FIXME: the problem with on_apply is that it is called even when # the player closes the container. so we get a 'You have X mails.' message # twice. - This bug existed also with the old python plugin - my $plname = $pl->name; + my $plname = $ob->name; + for ($box->inv) { - $_->name =~ /\S+ F: \S+ T: \Q$plname\E/ - and $cnt++; + ++$cnt if $_->name =~ /^mail(?:scroll|warning) F: \S+ T: \Q$plname\E/; } for (@$mails) { my ($type, $from, $msg) = @$_; $type = $mailtypes{$type || 1} || ['scroll', 'mailscroll']; my $mail = cf::object::new $type->[0]; - $mail->name ("$type->[1] F: $from T: " .$pl->name); - $mail->name_pl ("$type->[1]s F: $from T: " .$pl->name); + $mail->name ("$type->[1] F: $from T: $plname"); + $mail->name_pl ("$type->[1]s F: $from T: $plname"); $mail->msg ($msg); $mail->value (0); $box->insert ($mail); @@ -126,40 +122,42 @@ $cnt += @$mails; if ($cnt == 1) { - $pl->message ("You got one mail."); + $ob->message ("You got one mail."); } elsif ($cnt > 1) { - $pl->message ("You got $cnt mails."); + $ob->message ("You got $cnt mails."); } else { - $pl->message ("You haven't got any mail."); + $ob->message ("You haven't got any mail."); } - CFMail::clear_mail ($pl->name); + delete $ob->contr->{ipo_mails}; }, # this event handler handles the sending of mails on_close => sub { - my ($box, $pl) = @_; + my ($box, $ob) = @_; - my @mails; + my @mails = grep $_->name =~ /^mail(?:scroll|warning) [TF]: /, $box->inv; + $_->remove for @mails; - my %sent_targets; + # we can lose mails here, when the player is unloadable and the server crashes. shit happens. + cf::async { + my %sent_targets; - for ($box->inv) { - if ($_->name =~ m/^mail(scroll|warning) T: (\S+) F: (\S+)/) { - CFMail::send_mail ($1 eq 'scroll' ? 1 : 3, $2, $3, $_->msg); - $pl->message ("Sent mail$1 to $2 (from $3)."); - $sent_targets{$2}++; - push @mails, $_; - - } elsif ($_->name =~ m/^mail(scroll|warning) F: (\S+) T: (\S+)/) { - # this is for mails that remain in the queue for the player - CFMail::store_mail ($1 eq 'scroll' ? 1 : 3, $3, $2, $_->msg); - push @mails, $_; - } - } + for (@mails) { + if ($_->name =~ m/^mail(scroll|warning) T: (\S+) F: (\S+)/) { + CFMail::send_mail ($1 eq 'scroll' ? 1 : 3, $2, $3, $_->msg); + $ob->message ("Sent mail$1 to $2 (from $3)."); + ++$sent_targets{$2}; + + } elsif ($_->name =~ m/^mail(scroll|warning) F: (\S+) T: (\S+)/) { + # this is for mails that remain in the queue for the player + CFMail::store_mail ($1 eq 'scroll' ? 1 : 3, $3, $2, $_->msg); + } - $_->remove for @mails; + $_->destroy; + } - notify_players (%sent_targets); + notify_players (%sent_targets); + }; }, ; @@ -177,7 +175,7 @@ return 1; } - if ($who->pay_amount ($pr->[0] * $price_fact)) { + if ($who->pay_amount ($pr->[0])) { cf::async { if ($pr->[3] && not cf::player::exists $arguments) { $who->reply ($npc, "Sorry, there is no '$arguments'"); @@ -255,16 +253,21 @@ $who->reply ($npc, sprintf "How can I help you?\n" . "Here is a quick list of commands I understand:\n\n" - . " - pen (%s platinum)\n" - . " - literacy (%s platinum)\n" - . " - mailscroll (%s platinum)\n" - . " - bag (%s platinum)\n" - . " - package (%s platinum)\n" - . " - carton (%s platinum)\n" + . " - pen (%s)\n" + . " - literacy (%s)\n" + . " - mailscroll (%s)\n" + . " - bag (%s)\n" + . " - package (%s)\n" + . " - carton (%s)\n" . " - send (send bags/packages/cartons)\n" . " - receive (to receive packages for you)\n" . ($who->flag (cf::FLAG_WIZ) ? " - mailwarning \n" : ""), - 40, 1000, 1, 1, 5, 10 + cf::cost_string_from_value($prices{'pen'}[0]), + cf::cost_string_from_value($prices{'literacy'}[0]), + cf::cost_string_from_value($prices{'mailscroll'}[0]), + cf::cost_string_from_value($prices{'bag'}[0]), + cf::cost_string_from_value($prices{'package'}[0]), + cf::cost_string_from_value($prices{'carton'}[0]) ); } 1 @@ -273,33 +276,24 @@ package CFMail; use POSIX qw/strftime/; -use CFDB; - -my $MAILDB = CFDB->new (db_file => "$LOCALDIR/crossfiremail"); -sub get_mail { - my ($toname) = @_; - $MAILDB->get ($toname); -} - -sub clear_mail { - my ($toname) = @_; - $MAILDB->clear ($toname); -} +rename "$cf::LOCALDIR/crossfiremail", "$cf::LOCALDIR/crossfiremail.is-now-on-player"; sub store_mail { my ($type, $toname, $fromname, $message) = @_; - my $mails = $MAILDB->get ($toname); - push @$mails, [$type, $fromname, $message]; - $MAILDB->set ($toname, $mails); + + my $pl = cf::player::find $toname + or return; + + push @{ $pl->{ipo_mails} }, [$type, $fromname, $message]; } sub send_mail { my ($type, $toname, $fromname, $message) = @_; - my $time = strftime ("%a, %d %b %Y %H:%M:%S CEST", localtime (time)); + + my $time = strftime ("%a, %d %b %Y %H:%M:%S UTC", gmtime AE::now); my $msg = "From: $fromname\rTo: $toname\rDate: $time\n\n$message\n"; - store_mail ($type, $toname, $fromname, $msg); -} -1; + store_mail $type, $toname, $fromname, $msg; +}