--- deliantra/server/ext/reseller.ext 2006/12/15 19:29:18 1.1 +++ deliantra/server/ext/reseller.ext 2009/08/20 18:27:21 1.16 @@ -1,45 +1,48 @@ -#!perl +#!perl # mandatory -my %unit = ( - silver => 1, - gold => 10, - platina => 50, - royalty => 5000, -); - -my %aliases = ( - platinum => 'platina', - royalties => 'royalty', -); +sub ob2info { + my ($item, $rval) = @_; + sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]", + $item->name, $item->kv_get ('ext_reseller_seller'), + $item->kv_get ('ext_reseller_orig_value'), $item->value, + (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid; +} + +sub audit_log { + my ($who, $action, $info) = @_; + warn + sprintf "RESELLER_AUDIT(%s) %s %s: %s\n", + $who->map->path, $who->name, $action, $info; +} + +sub find_rec; sub find_rec { my ($ob, $cb) = @_; - my @unpaid; + my @found; for my $i ($ob->inv) { - push @unpaid, $i if $cb->($i); - - push @unpaid, find_unpaid ($i, $cb) - if $i->inv; + push @found, $i if $cb->($i); + push @found, find_rec $i, $cb if $i->inv; } - return @unpaid; + + return @found; } sub find_unpaid { my ($ob) = @_; - my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) }); - return @r; + find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) }; } sub find_traded { my ($ob) = @_; - my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' }); - return @r; + find_rec $ob, sub { $_[0]->kv_get ('ext_reseller_seller') ne '' }; } cf::register_script_function "reseller::list_sells" => sub { my ($who, $msg, $npc) = @_; - my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales'); + my $ext_re_sales = $npc->kv_get ('ext_reseller_sales'); + my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; my $hissells = $sells->{$who->name}; unless (keys %{$hissells || {}}) { @@ -47,19 +50,23 @@ return 0; } - $who->reply ($npc, "You sold:\n", cf::NDI_BROWN); + my $reply = "T\n\n"; + for (keys %$hissells) { my $n = $_; $n =~ s/\s*\(unpaid\)//g; - $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN); + $reply .= " B<$n> (for " . cf::cost_string_from_value ($hissells->{$_}) . ")\n"; } + $who->reply ($npc, $reply); + 0 }; cf::register_script_function "reseller::pay_player" => sub { my ($who, $msg, $npc) = @_; - my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales'); + my $ext_re_sales = $npc->kv_get ('ext_reseller_sales'); + my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; my $hissells = $sells->{$who->name}; unless (keys %{$hissells || {}}) { @@ -71,16 +78,19 @@ $sum += $_ for values %$hissells; $who->pay_player ($sum); - $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales"); + $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales."); + + audit_log ($who, 'collects', "$sum silver"); $sells->{$who->name} = {}; - $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); + $npc->kv_set (ext_reseller_sales => cf::encode_json $sells) + if $sells; 0 }; -cf::register_attachment "reseller_shopmat", +cf::object::attachment "reseller_shopmat", on_move_trigger => sub { my ($self, $who_caused, $who) = @_; @@ -88,19 +98,21 @@ $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y}); unless (@obs) { - warn "Couldn't find shop keeper in " . $who->map . "\n"; + warn "Couldn't find shop keeper in " . $who->map->path . "\n"; return cf::override; } - my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales'); + my $ext_re_sales = $obs[0]->kv_get ('ext_reseller_sales'); + my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; my $unpaid_items = {}; for my $item (find_unpaid ($who)) { - if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { + if ($item->kv_get ('ext_reseller_seller') eq $who->name) { + audit_log ($who, 'removes', ob2info ($item)); $item->flag (cf::FLAG_UNPAID, 0); $item->remove; - $item->insert_ob_in_ob ($who); + give_back ($who, $item); next; } @@ -108,30 +120,53 @@ warn "Object " . $item->name . " bought by " . $who->name . " on map " . $who->map->path . " for $value silver has no seller set\n" - if $item->get_ob_key_value ('ext_reseller_seller') eq ''; + if $item->kv_get ('ext_reseller_seller') eq ''; $unpaid_items->{$item} = [$value, $item]; } + audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items)) + if %$unpaid_items; + $self->apply_shop_mat ($who); + my @seller_noted; + for my $item (find_traded ($who)) { next if $item->flag (cf::FLAG_UNPAID); if (my $value = $unpaid_items->{$item}[0]) { - $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; + push @seller_noted, ob2info ($item, $value)."P"; + $sells->{$item->kv_get ('ext_reseller_seller')}->{$item->name} += $value; + } else { + push @seller_noted, ob2info ($item)."T"; } - $item->value ($item->get_ob_key_value ('ext_reseller_orig_value')); - $item->set_ob_key_value (ext_reseller_seller => ''); + $item->value ($item->kv_get ('ext_reseller_orig_value')); + $item->kv_del ("ext_reseller_seller"); } - $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); + audit_log ($who, 'removed', (join ",", @seller_noted)) + if @seller_noted; + + $obs[0]->kv_set (ext_reseller_sales => cf::encode_json $sells) + if $sells; cf::override; }, ; -cf::register_attachment "reseller_floor", +sub give_back { + my ($who, $what) = @_; + $who->insert ($what); +} + +sub give_back_with_message { + my ($who, $what, $msg) = @_; + $who->message ($msg, cf::NDI_BROWN); + give_back ($who, $what); +} + +cf::object::attachment "reseller_floor", on_drop_on => sub { my ($on, $what, $who) = @_; my $name = $what->custom_name; @@ -139,14 +174,14 @@ return if $what->flag (cf::FLAG_UNPAID); if ($what->type == cf::MONEY) { - $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN); - $what->insert_ob_in_ob ($who); + give_back_with_message ($who, $what, + "The shopkeeper says: Sorry, you can't sell money here."); return cf::override; } if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) { - $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN); - $what->insert_ob_in_ob ($who); + give_back_with_message ($who, $what, + "The shopkeeper says: Sorry, you can't sell unidentified stuff here."); return cf::override; } @@ -155,42 +190,61 @@ if ($name =~ m/\S/) { unless ($name =~ m/\d+\s*\S+/) { - $who->message ("The shopkeeper says: Sorry, I don't recognize '$name' as currency. Please name your item like '10 royalty' or '10 platinum 2 silver'", cf::NDI_BROWN); - $what->insert_ob_in_ob ($who); + give_back_with_message ($who, $what, + "The shopkeeper says: Sorry, I don't recognize '$name' as currency. " + . "Please name your item like '17 platinum' or '10 gold 8 silver.'"); return cf::override; } while ($name =~ s/^\s*(\d+)\s*(\S+)//) { - if ($aliases{lc $2} or $unit{lc $2}) { - $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}}); + my ($v, $c) = ($1, $2); + if (my $coin = cf::coin_from_name $c) { + $value += $v * $coin->value; } else { - $what->insert_ob_in_ob ($who); - $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN); + give_back_with_message ($who, $what, + "The shopkeeper says: I don't know the currency '$c', you can use one of these currencies: " + . (join ", ", cf::coin_names) + ); return cf::override; } } } else { - $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); + # commented out the following line because too many just use the + # reseller shop as dumpyard: + # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); + give_back_with_message ($who, $what, + "Sorry, you can't just sell stuff without assigning a price to it! " + . "Please name your item like '17 platinum' or '10 gold 8 silver' " + . "and drop it again. (To rename the item use the B " + . "entry in the inventory item popup menu)." + ); + return cf::override; + } + + if ($value > 100 ** 4) { # also for overflow prevention + give_back_with_message ($who, $what, + "The shopkeeper says: You can't sell something for such a high " + . "value. Please keep it below 100 royalty."); + return cf::override; } if ($value < 0) { - $what->insert_ob_in_ob ($who); - $who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN); + give_back_with_message ($who, $what, + "The shopkeeper says: You can't sell something for a negative value: $value."); return cf::override; } my $fee = $value / 100; # 1% selling fee unless ($who->pay_amount ($fee)) { - $who->message ( - "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item", - cf::NDI_BROWN - ); - $what->insert_ob_in_ob ($who); + give_back_with_message ($who, $what, + "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) + . " to pay the 1% fee for this item."); return cf::override; } else { $who->message ( - "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item", + "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) + . " for the item.", cf::NDI_BROWN ); } @@ -216,13 +270,15 @@ . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN ); - $what->set_ob_key_value (ext_reseller_seller => $who->name); - $what->set_ob_key_value (ext_reseller_orig_value => $orig_value); + $what->kv_set (ext_reseller_seller => $who->name); + $what->kv_set (ext_reseller_orig_value => $orig_value); # warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; $what->custom_name ($what->name . " (by " . $who->name . ")"); $what->flag (cf::FLAG_UNPAID, 1); $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); + audit_log ($who, 'sells', ob2info ($what)); + cf::override; }, ;