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

Comparing deliantra/server/ext/reseller.ext (file contents):
Revision 1.11 by root, Thu Apr 10 15:35:16 2008 UTC vs.
Revision 1.15 by elmex, Mon Oct 6 18:26:35 2008 UTC

1#!perl # mandatory 1#!perl # mandatory
2 2
3sub ob2info { 3sub ob2info {
4 my ($item, $rval) = @_; 4 my ($item, $rval) = @_;
5 sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]", 5 sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]",
6 $item->name, $item->get_ob_key_value ('ext_reseller_seller'), 6 $item->name, $item->kv_get ('ext_reseller_seller'),
7 $item->get_ob_key_value ('ext_reseller_orig_value'), $item->value, 7 $item->kv_get ('ext_reseller_orig_value'), $item->value,
8 (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid; 8 (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid;
9} 9}
10 10
11sub audit_log { 11sub audit_log {
12 my ($who, $action, $info) = @_; 12 my ($who, $action, $info) = @_;
… …
34 find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) }; 34 find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) };
35} 35}
36 36
37sub find_traded { 37sub find_traded {
38 my ($ob) = @_; 38 my ($ob) = @_;
39 find_rec $ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' }; 39 find_rec $ob, sub { $_[0]->kv_get ('ext_reseller_seller') ne '' };
40} 40}
41 41
42cf::register_script_function "reseller::list_sells" => sub { 42cf::register_script_function "reseller::list_sells" => sub {
43 my ($who, $msg, $npc) = @_; 43 my ($who, $msg, $npc) = @_;
44 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales'); 44 my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
45 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; 45 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
46 my $hissells = $sells->{$who->name}; 46 my $hissells = $sells->{$who->name};
47 47
48 unless (keys %{$hissells || {}}) { 48 unless (keys %{$hissells || {}}) {
49 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 49 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
50 return 0; 50 return 0;
51 } 51 }
52 52
53 $who->reply ($npc, "You sold:\n", cf::NDI_BROWN); 53 my $reply = "T<You sold:>\n\n";
54
54 for (keys %$hissells) { 55 for (keys %$hissells) {
55 my $n = $_; 56 my $n = $_;
56 $n =~ s/\s*\(unpaid\)//g; 57 $n =~ s/\s*\(unpaid\)//g;
57 $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN); 58 $reply .= " B<$n> (for " . cf::cost_string_from_value ($hissells->{$_}) . ")\n";
58 } 59 }
60
61 $who->reply ($npc, $reply);
59 62
60 0 63 0
61}; 64};
62 65
63cf::register_script_function "reseller::pay_player" => sub { 66cf::register_script_function "reseller::pay_player" => sub {
64 my ($who, $msg, $npc) = @_; 67 my ($who, $msg, $npc) = @_;
65 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales'); 68 my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
66 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; 69 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
67 my $hissells = $sells->{$who->name}; 70 my $hissells = $sells->{$who->name};
68 71
69 unless (keys %{$hissells || {}}) { 72 unless (keys %{$hissells || {}}) {
70 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 73 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
… …
73 76
74 my $sum = 0; 77 my $sum = 0;
75 $sum += $_ for values %$hissells; 78 $sum += $_ for values %$hissells;
76 79
77 $who->pay_player ($sum); 80 $who->pay_player ($sum);
78 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales"); 81 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales.");
79 82
80 audit_log ($who, 'collects', "$sum silver"); 83 audit_log ($who, 'collects', "$sum silver");
81 84
82 $sells->{$who->name} = {}; 85 $sells->{$who->name} = {};
83 86
84 $npc->set_ob_key_value (ext_reseller_sales => cf::encode_json $sells) 87 $npc->kv_set (ext_reseller_sales => cf::encode_json $sells)
85 if $sells; 88 if $sells;
86 89
87 0 90 0
88}; 91};
89 92
… …
97 unless (@obs) { 100 unless (@obs) {
98 warn "Couldn't find shop keeper in " . $who->map->path . "\n"; 101 warn "Couldn't find shop keeper in " . $who->map->path . "\n";
99 return cf::override; 102 return cf::override;
100 } 103 }
101 104
102 my $ext_re_sales = $obs[0]->get_ob_key_value ('ext_reseller_sales'); 105 my $ext_re_sales = $obs[0]->kv_get ('ext_reseller_sales');
103 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; 106 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
104 107
105 my $unpaid_items = {}; 108 my $unpaid_items = {};
106 109
107 for my $item (find_unpaid ($who)) { 110 for my $item (find_unpaid ($who)) {
108 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { 111 if ($item->kv_get ('ext_reseller_seller') eq $who->name) {
109 audit_log ($who, 'removes', ob2info ($item)); 112 audit_log ($who, 'removes', ob2info ($item));
110 $item->flag (cf::FLAG_UNPAID, 0); 113 $item->flag (cf::FLAG_UNPAID, 0);
111 $item->remove; 114 $item->remove;
112 give_back ($who, $item); 115 give_back ($who, $item);
113 next; 116 next;
… …
115 118
116 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP); 119 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);
117 120
118 warn "Object " . $item->name . " bought by " . $who->name . " on map " 121 warn "Object " . $item->name . " bought by " . $who->name . " on map "
119 . $who->map->path . " for $value silver has no seller set\n" 122 . $who->map->path . " for $value silver has no seller set\n"
120 if $item->get_ob_key_value ('ext_reseller_seller') eq ''; 123 if $item->kv_get ('ext_reseller_seller') eq '';
121 124
122 $unpaid_items->{$item} = [$value, $item]; 125 $unpaid_items->{$item} = [$value, $item];
123 } 126 }
124 127
125 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items)) 128 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
… …
131 134
132 for my $item (find_traded ($who)) { 135 for my $item (find_traded ($who)) {
133 next if $item->flag (cf::FLAG_UNPAID); 136 next if $item->flag (cf::FLAG_UNPAID);
134 if (my $value = $unpaid_items->{$item}[0]) { 137 if (my $value = $unpaid_items->{$item}[0]) {
135 push @seller_noted, ob2info ($item, $value)."P"; 138 push @seller_noted, ob2info ($item, $value)."P";
136 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; 139 $sells->{$item->kv_get ('ext_reseller_seller')}->{$item->name} += $value;
137 } else { 140 } else {
138 push @seller_noted, ob2info ($item)."T"; 141 push @seller_noted, ob2info ($item)."T";
139 } 142 }
140 143
141 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value')); 144 $item->value ($item->kv_get ('ext_reseller_orig_value'));
142 $item->set_ob_key_value (ext_reseller_seller => ''); 145 $item->kv_del ("ext_reseller_seller");
143 } 146 }
144 147
145 audit_log ($who, 'removed', (join ",", @seller_noted)) 148 audit_log ($who, 'removed', (join ",", @seller_noted))
146 if @seller_noted; 149 if @seller_noted;
147 150
148 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::encode_json $sells) 151 $obs[0]->kv_set (ext_reseller_sales => cf::encode_json $sells)
149 if $sells; 152 if $sells;
150 153
151 cf::override; 154 cf::override;
152 }, 155 },
153; 156;
154 157
155sub give_back { 158sub give_back {
156 my ($who, $what) = @_; 159 my ($who, $what) = @_;
157 $who->insert ($what); 160 $who->insert ($what);
158 $who->esrv_send_item ($what);
159} 161}
160 162
161sub give_back_with_message { 163sub give_back_with_message {
162 my ($who, $what, $msg) = @_; 164 my ($who, $what, $msg) = @_;
163 $who->message ($msg, cf::NDI_BROWN); 165 $who->message ($msg, cf::NDI_BROWN);
… …
188 190
189 if ($name =~ m/\S/) { 191 if ($name =~ m/\S/) {
190 unless ($name =~ m/\d+\s*\S+/) { 192 unless ($name =~ m/\d+\s*\S+/) {
191 give_back_with_message ($who, $what, 193 give_back_with_message ($who, $what,
192 "The shopkeeper says: Sorry, I don't recognize '$name' as currency. " 194 "The shopkeeper says: Sorry, I don't recognize '$name' as currency. "
193 . "Please name your item like '17 platinum' or '10 gold 8 silver'"); 195 . "Please name your item like '17 platinum' or '10 gold 8 silver.'");
194 return cf::override; 196 return cf::override;
195 } 197 }
196 198
197 while ($name =~ s/^\s*(\d+)\s*(\S+)//) { 199 while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
198 my ($v, $c) = ($1, $2); 200 my ($v, $c) = ($1, $2);
… …
211 # reseller shop as dumpyard: 213 # reseller shop as dumpyard:
212 # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); 214 # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
213 give_back_with_message ($who, $what, 215 give_back_with_message ($who, $what,
214 "Sorry, you can't just sell stuff without assigning a price to it! " 216 "Sorry, you can't just sell stuff without assigning a price to it! "
215 . "Please name your item like '17 platinum' or '10 gold 8 silver' " 217 . "Please name your item like '17 platinum' or '10 gold 8 silver' "
216 . "and drop it again. (To rename the item use the 'rename' " 218 . "and drop it again. (To rename the item use the B<rename> "
217 . "context menu item in the inventory)." 219 . "entry in the inventory item popup menu)."
218 ); 220 );
219 return cf::override; 221 return cf::override;
220 } 222 }
221 223
222 if ($value < 0) { 224 if ($value < 0) {
223 give_back_with_message ($who, $what, 225 give_back_with_message ($who, $what,
224 "The shopkeeper says: You can't sell something for a negative value: $value"); 226 "The shopkeeper says: You can't sell something for a negative value: $value.");
225 return cf::override; 227 return cf::override;
226 } 228 }
227 229
228 my $fee = $value / 100; # 1% selling fee 230 my $fee = $value / 100; # 1% selling fee
229 231
230 unless ($who->pay_amount ($fee)) { 232 unless ($who->pay_amount ($fee)) {
231 give_back_with_message ($who, $what, 233 give_back_with_message ($who, $what,
232 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) 234 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee)
233 . " to pay the 1% fee for this item"); 235 . " to pay the 1% fee for this item.");
234 return cf::override; 236 return cf::override;
235 } else { 237 } else {
236 $who->message ( 238 $who->message (
237 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) 239 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee)
238 . " for the item", 240 . " for the item.",
239 cf::NDI_BROWN 241 cf::NDI_BROWN
240 ); 242 );
241 } 243 }
242 244
243 $what->value ($value); 245 $what->value ($value);
… …
259 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " 261 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least "
260 . cf::cost_string_from_value ($value) 262 . cf::cost_string_from_value ($value)
261 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN 263 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
262 ); 264 );
263 265
264 $what->set_ob_key_value (ext_reseller_seller => $who->name); 266 $what->kv_set (ext_reseller_seller => $who->name);
265 $what->set_ob_key_value (ext_reseller_orig_value => $orig_value); 267 $what->kv_set (ext_reseller_orig_value => $orig_value);
266# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; 268# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
267 $what->custom_name ($what->name . " (by " . $who->name . ")"); 269 $what->custom_name ($what->name . " (by " . $who->name . ")");
268 $what->flag (cf::FLAG_UNPAID, 1); 270 $what->flag (cf::FLAG_UNPAID, 1);
269 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 271 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
270 272

Diff Legend

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