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.8 by root, Sun Sep 30 16:24:30 2007 UTC vs.
Revision 1.19 by root, Sun Jan 29 02:47:04 2017 UTC

1#!perl # mandatory 1#!perl # mandatory
2
3my %unit = (
4 silver => 1,
5 gold => 10,
6 platina => 50,
7 royalty => 5000,
8);
9
10my %aliases = (
11 platinum => 'platina',
12 royalties => 'royalty',
13);
14 2
15sub ob2info { 3sub ob2info {
16 my ($item, $rval) = @_; 4 my ($item, $rval) = @_;
5
17 sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]", 6 sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]",
18 $item->name, $item->get_ob_key_value ('ext_reseller_seller'), 7 $item->name, $item->kv_get ('ext_reseller_seller'),
19 $item->get_ob_key_value ('ext_reseller_orig_value'), $item->value, 8 $item->kv_get ('ext_reseller_orig_value'), $item->value,
20 (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid; 9 (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid
21} 10}
22 11
23sub audit_log { 12sub audit_log {
24 my ($who, $action, $info) = @_; 13 my ($who, $action, $info) = @_;
25 warn 14 cf::info
26 sprintf "RESELLER_AUDIT(%s) %s %s: %s\n", 15 sprintf "RESELLER_AUDIT(%s) %s %s: %s\n",
27 $who->map->path, $who->name, $action, $info; 16 $who->map->path, $who->name, $action, $info;
28} 17}
29 18
30sub find_rec; 19sub find_rec;
31 20
32sub find_rec { 21sub find_rec {
33 my ($ob, $cb) = @_; 22 my ($ob, $cb) = @_;
34 23
35 my @found; 24 my @found;
25
36 for my $i ($ob->inv) { 26 for my $i ($ob->inv) {
37 push @found, $i if $cb->($i); 27 push @found, $i if $cb->($i);
38 push @found, find_rec $i, $cb if $i->inv; 28 push @found, find_rec $i, $cb if $i->inv;
39 } 29 }
40 30
41 return @found; 31 @found
42} 32}
43 33
44sub find_unpaid { 34sub find_unpaid {
45 my ($ob) = @_; 35 my ($ob) = @_;
36
46 find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) }; 37 find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) };
47} 38}
48 39
49sub find_traded { 40sub find_traded {
50 my ($ob) = @_; 41 my ($ob) = @_;
42
51 find_rec $ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' }; 43 find_rec $ob, sub { $_[0]->kv_get ('ext_reseller_seller') ne '' };
52} 44}
53 45
54cf::register_script_function "reseller::list_sells" => sub { 46cf::register_script_function "reseller::list_sells" => sub {
55 my ($who, $msg, $npc) = @_; 47 my ($who, $msg, $npc) = @_;
56 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales'); 48 my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
57 my $sells = $ext_re_sales && cf::from_json $ext_re_sales; 49 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
58 my $hissells = $sells->{$who->name}; 50 my $hissells = $sells->{$who->name};
59 51
60 unless (keys %{$hissells || {}}) { 52 unless (keys %{$hissells || {}}) {
61 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 53 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
62 return 0; 54 return 0;
63 } 55 }
64 56
65 $who->reply ($npc, "You sold:\n", cf::NDI_BROWN); 57 my $reply = "T<You sold:>\n\n";
58
66 for (keys %$hissells) { 59 for (keys %$hissells) {
67 my $n = $_; 60 my $n = $_;
68 $n =~ s/\s*\(unpaid\)//g; 61 $n =~ s/\s*\(unpaid\)//g;
69 $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN); 62 $reply .= " B<$n> (for " . cf::cost_string_from_value ($hissells->{$_}) . ")\n";
70 } 63 }
64
65 $who->reply ($npc, $reply);
71 66
72 0 67 0
73}; 68};
74 69
75cf::register_script_function "reseller::pay_player" => sub { 70cf::register_script_function "reseller::pay_player" => sub {
76 my ($who, $msg, $npc) = @_; 71 my ($who, $msg, $npc) = @_;
77 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales'); 72 my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
78 my $sells = $ext_re_sales && cf::from_json $ext_re_sales; 73 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
79 my $hissells = $sells->{$who->name}; 74 my $hissells = $sells->{$who->name};
80 75
81 unless (keys %{$hissells || {}}) { 76 unless (keys %{$hissells || {}}) {
82 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 77 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
83 return 0; 78 return 0;
… …
85 80
86 my $sum = 0; 81 my $sum = 0;
87 $sum += $_ for values %$hissells; 82 $sum += $_ for values %$hissells;
88 83
89 $who->pay_player ($sum); 84 $who->pay_player ($sum);
90 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales"); 85 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales.");
91 86
92 audit_log ($who, 'collects', "$sum silver"); 87 audit_log ($who, 'collects', "$sum silver");
93 88
94 $sells->{$who->name} = {}; 89 $sells->{$who->name} = {};
95 90
96 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells) 91 $npc->kv_set (ext_reseller_sales => cf::encode_json $sells)
97 if $sells; 92 if $sells;
98 93
99 0 94 0
100}; 95};
101 96
… …
105 100
106 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} } 101 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
107 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y}); 102 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});
108 103
109 unless (@obs) { 104 unless (@obs) {
110 warn "Couldn't find shop keeper in " . $who->map->path . "\n"; 105 cf::error "Couldn't find shop keeper in " . $who->map->path . "\n";
111 return cf::override; 106 return cf::override;
112 } 107 }
113 108
114 my $ext_re_sales = $obs[0]->get_ob_key_value ('ext_reseller_sales'); 109 my $ext_re_sales = $obs[0]->kv_get ('ext_reseller_sales');
115 my $sells = $ext_re_sales && cf::from_json $ext_re_sales; 110 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
116 111
117 my $unpaid_items = {}; 112 my $unpaid_items = {};
118 113
119 for my $item (find_unpaid ($who)) { 114 for my $item (find_unpaid ($who)) {
120 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { 115 if ($item->kv_get ('ext_reseller_seller') eq $who->name) {
121 audit_log ($who, 'removes', ob2info ($item)); 116 audit_log ($who, 'removes', ob2info ($item));
122 $item->flag (cf::FLAG_UNPAID, 0); 117 $item->flag (cf::FLAG_UNPAID, 0);
123 $item->remove; 118 $item->remove;
124 $who->insert ($item); 119 give_back ($who, $item);
125 next; 120 next;
126 } 121 }
127 122
128 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP); 123 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);
129 124
130 warn "Object " . $item->name . " bought by " . $who->name . " on map " 125 cf::debug "Object ", $item->name, " bought by ", $who->name, " on map " ,
131 . $who->map->path . " for $value silver has no seller set\n" 126 $who->map->path, " for $value silver has no seller set\n"
132 if $item->get_ob_key_value ('ext_reseller_seller') eq ''; 127 if $item->kv_get ('ext_reseller_seller') eq '';
133 128
134 $unpaid_items->{$item} = [$value, $item]; 129 $unpaid_items->{$item} = [$value, $item];
135 } 130 }
136 131
137 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items)) 132 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
… …
143 138
144 for my $item (find_traded ($who)) { 139 for my $item (find_traded ($who)) {
145 next if $item->flag (cf::FLAG_UNPAID); 140 next if $item->flag (cf::FLAG_UNPAID);
146 if (my $value = $unpaid_items->{$item}[0]) { 141 if (my $value = $unpaid_items->{$item}[0]) {
147 push @seller_noted, ob2info ($item, $value)."P"; 142 push @seller_noted, ob2info ($item, $value)."P";
148 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; 143 $sells->{$item->kv_get ('ext_reseller_seller')}->{$item->name} += $value;
149 } else { 144 } else {
150 push @seller_noted, ob2info ($item)."T"; 145 push @seller_noted, ob2info ($item)."T";
151 } 146 }
152 147
153 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value')); 148 $item->value ($item->kv_get ('ext_reseller_orig_value'));
154 $item->set_ob_key_value (ext_reseller_seller => ''); 149 $item->kv_del ("ext_reseller_seller");
155 } 150 }
156 151
157 audit_log ($who, 'removed', (join ",", @seller_noted)) 152 audit_log ($who, 'removed', (join ",", @seller_noted))
158 if @seller_noted; 153 if @seller_noted;
159 154
160 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells) 155 $obs[0]->kv_set (ext_reseller_sales => cf::encode_json $sells)
161 if $sells; 156 if $sells;
162 157
163 cf::override; 158 cf::override;
164 }, 159 },
165; 160;
161
162sub give_back {
163 my ($who, $what) = @_;
164 $who->insert ($what);
165}
166
167sub give_back_with_message {
168 my ($who, $what, $msg) = @_;
169 $who->message ($msg, cf::NDI_BROWN);
170 give_back ($who, $what);
171}
166 172
167cf::object::attachment "reseller_floor", 173cf::object::attachment "reseller_floor",
168 on_drop_on => sub { 174 on_drop_on => sub {
169 my ($on, $what, $who) = @_; 175 my ($on, $what, $who) = @_;
170 my $name = $what->custom_name; 176 my $name = $what->custom_name;
171 177
172 return if $what->flag (cf::FLAG_UNPAID); 178 return if $what->flag (cf::FLAG_UNPAID);
173 179
174 if ($what->type == cf::MONEY) { 180 if ($what->type == cf::MONEY) {
181 give_back_with_message ($who, $what,
175 $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN); 182 "The shopkeeper says: Sorry, you can't sell money here.");
176 $who->insert ($what);
177 return cf::override; 183 return cf::override;
178 } 184 }
179 185
180 if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) { 186 if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
187 give_back_with_message ($who, $what,
181 $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN); 188 "The shopkeeper says: Sorry, you can't sell unidentified stuff here.");
182 $who->insert ($what);
183 return cf::override; 189 return cf::override;
184 } 190 }
185 191
186 my $orig_value = $what->value; 192 my $orig_value = $what->value;
187 my $value = 0; 193 my $value = 0;
188 194
189 if ($name =~ m/\S/) { 195 if ($name =~ m/\S/) {
190 unless ($name =~ m/\d+\s*\S+/) { 196 unless ($name =~ m/\d+\s*\S+/) {
191 $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); 197 give_back_with_message ($who, $what,
192 $who->insert ($what); 198 "The shopkeeper says: Sorry, I don't recognize '$name' as currency. "
199 . "Please name your item like '17 platinum' or '10 gold 8 silver.'");
193 return cf::override; 200 return cf::override;
194 } 201 }
195 202
196 while ($name =~ s/^\s*(\d+)\s*(\S+)//) { 203 while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
197 if ($aliases{lc $2} or $unit{lc $2}) { 204 my ($v, $c) = ($1, $2);
198 $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}}); 205 if (my $coin = cf::coin_from_name $c) {
206 $value += $v * $coin->value;
199 } else { 207 } else {
200 $who->insert ($what); 208 give_back_with_message ($who, $what,
201 $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN); 209 "The shopkeeper says: I don't know the currency '$c', you can use one of these currencies: "
210 . (join ", ", cf::coin_names)
211 );
202 return cf::override; 212 return cf::override;
203 } 213 }
204 } 214 }
205 } else { 215 } else {
216 # commented out the following line because too many just use the
217 # reseller shop as dumpyard:
206 $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); 218 # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
219 give_back_with_message ($who, $what,
220 "Sorry, you can't just sell stuff without assigning a price to it! "
221 . "Please name your item like '17 platinum' or '10 gold 8 silver' "
222 . "and drop it again. (To rename the item use the B<rename> "
223 . "entry in the inventory item popup menu)."
224 );
225 return cf::override;
226 }
227
228 if ($value > 100 ** 4) { # also for overflow prevention
229 give_back_with_message ($who, $what,
230 "The shopkeeper says: You can't sell something for such a high "
231 . "value. Please keep it below 100 royalty.");
232 return cf::override;
207 } 233 }
208 234
209 if ($value < 0) { 235 if ($value < 0) {
210 $who->insert ($what); 236 give_back_with_message ($who, $what,
211 $who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN); 237 "The shopkeeper says: You can't sell something for a negative value: $value.");
212 return cf::override; 238 return cf::override;
213 } 239 }
214 240
215 my $fee = $value / 100; # 1% selling fee 241 my $fee = $value / 100; # 1% selling fee
216 242
217 unless ($who->pay_amount ($fee)) { 243 unless ($who->pay_amount ($fee)) {
218 $who->message ( 244 give_back_with_message ($who, $what,
219 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item", 245 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee)
220 cf::NDI_BROWN 246 . " to pay the 1% fee for this item.");
221 );
222 $who->insert ($what);
223 return cf::override; 247 return cf::override;
224 } else { 248 } else {
225 $who->message ( 249 $who->message (
226 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item", 250 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee)
251 . " for the item.",
227 cf::NDI_BROWN 252 cf::NDI_BROWN
228 ); 253 );
229 } 254 }
230 255
231 $what->value ($value); 256 $what->value ($value);
… …
241 266
242# my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof; 267# my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof;
243# warn "COSTS NOW: $cost\n"; 268# warn "COSTS NOW: $cost\n";
244 269
245 $who->message ( 270 $who->message (
246 "The shopkeeper says: Ok, I marked " 271 "The shopkeeper says: Ok, I marked "
247 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " 272 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least "
248 . cf::cost_string_from_value ($value) 273 . cf::cost_string_from_value ($value)
249 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN 274 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
250 ); 275 );
251 276
252 $what->set_ob_key_value (ext_reseller_seller => $who->name); 277 $what->kv_set (ext_reseller_seller => $who->name);
253 $what->set_ob_key_value (ext_reseller_orig_value => $orig_value); 278 $what->kv_set (ext_reseller_orig_value => $orig_value);
254# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; 279# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
255 $what->custom_name ($what->name . " (by " . $who->name . ")"); 280 $what->custom_name ($what->name . " (by " . $who->name . ")");
256 $what->flag (cf::FLAG_UNPAID, 1); 281 $what->flag (cf::FLAG_UNPAID, 1);
257 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 282 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
258 283
259 audit_log ($who, 'sells', ob2info ($what)); 284 audit_log ($who, 'sells', ob2info ($what));
260 285
261 cf::override; 286 cf::override;
262 }, 287 },
263; 288;
289

Diff Legend

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