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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines