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.10 by elmex, Mon Dec 24 16:41:55 2007 UTC vs.
Revision 1.12 by root, Sat May 3 11:14:50 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 $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales'); 44 my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
57 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; 45 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
58 my $hissells = $sells->{$who->name}; 46 my $hissells = $sells->{$who->name};
59 47
60 unless (keys %{$hissells || {}}) { 48 unless (keys %{$hissells || {}}) {
61 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 49 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
… …
72 0 60 0
73}; 61};
74 62
75cf::register_script_function "reseller::pay_player" => sub { 63cf::register_script_function "reseller::pay_player" => sub {
76 my ($who, $msg, $npc) = @_; 64 my ($who, $msg, $npc) = @_;
77 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales'); 65 my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
78 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; 66 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
79 my $hissells = $sells->{$who->name}; 67 my $hissells = $sells->{$who->name};
80 68
81 unless (keys %{$hissells || {}}) { 69 unless (keys %{$hissells || {}}) {
82 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 70 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
… …
91 79
92 audit_log ($who, 'collects', "$sum silver"); 80 audit_log ($who, 'collects', "$sum silver");
93 81
94 $sells->{$who->name} = {}; 82 $sells->{$who->name} = {};
95 83
96 $npc->set_ob_key_value (ext_reseller_sales => cf::encode_json $sells) 84 $npc->kv_set (ext_reseller_sales => cf::encode_json $sells)
97 if $sells; 85 if $sells;
98 86
99 0 87 0
100}; 88};
101 89
… …
109 unless (@obs) { 97 unless (@obs) {
110 warn "Couldn't find shop keeper in " . $who->map->path . "\n"; 98 warn "Couldn't find shop keeper in " . $who->map->path . "\n";
111 return cf::override; 99 return cf::override;
112 } 100 }
113 101
114 my $ext_re_sales = $obs[0]->get_ob_key_value ('ext_reseller_sales'); 102 my $ext_re_sales = $obs[0]->kv_get ('ext_reseller_sales');
115 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales; 103 my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
116 104
117 my $unpaid_items = {}; 105 my $unpaid_items = {};
118 106
119 for my $item (find_unpaid ($who)) { 107 for my $item (find_unpaid ($who)) {
120 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { 108 if ($item->kv_get ('ext_reseller_seller') eq $who->name) {
121 audit_log ($who, 'removes', ob2info ($item)); 109 audit_log ($who, 'removes', ob2info ($item));
122 $item->flag (cf::FLAG_UNPAID, 0); 110 $item->flag (cf::FLAG_UNPAID, 0);
123 $item->remove; 111 $item->remove;
124 give_back ($who, $item); 112 give_back ($who, $item);
125 next; 113 next;
… …
127 115
128 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP); 116 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);
129 117
130 warn "Object " . $item->name . " bought by " . $who->name . " on map " 118 warn "Object " . $item->name . " bought by " . $who->name . " on map "
131 . $who->map->path . " for $value silver has no seller set\n" 119 . $who->map->path . " for $value silver has no seller set\n"
132 if $item->get_ob_key_value ('ext_reseller_seller') eq ''; 120 if $item->kv_get ('ext_reseller_seller') eq '';
133 121
134 $unpaid_items->{$item} = [$value, $item]; 122 $unpaid_items->{$item} = [$value, $item];
135 } 123 }
136 124
137 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items)) 125 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
… …
143 131
144 for my $item (find_traded ($who)) { 132 for my $item (find_traded ($who)) {
145 next if $item->flag (cf::FLAG_UNPAID); 133 next if $item->flag (cf::FLAG_UNPAID);
146 if (my $value = $unpaid_items->{$item}[0]) { 134 if (my $value = $unpaid_items->{$item}[0]) {
147 push @seller_noted, ob2info ($item, $value)."P"; 135 push @seller_noted, ob2info ($item, $value)."P";
148 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; 136 $sells->{$item->kv_get ('ext_reseller_seller')}->{$item->name} += $value;
149 } else { 137 } else {
150 push @seller_noted, ob2info ($item)."T"; 138 push @seller_noted, ob2info ($item)."T";
151 } 139 }
152 140
153 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value')); 141 $item->value ($item->kv_get ('ext_reseller_orig_value'));
154 $item->set_ob_key_value (ext_reseller_seller => ''); 142 $item->kv_del ("ext_reseller_seller");
155 } 143 }
156 144
157 audit_log ($who, 'removed', (join ",", @seller_noted)) 145 audit_log ($who, 'removed', (join ",", @seller_noted))
158 if @seller_noted; 146 if @seller_noted;
159 147
160 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::encode_json $sells) 148 $obs[0]->kv_set (ext_reseller_sales => cf::encode_json $sells)
161 if $sells; 149 if $sells;
162 150
163 cf::override; 151 cf::override;
164 }, 152 },
165; 153;
… …
200 188
201 if ($name =~ m/\S/) { 189 if ($name =~ m/\S/) {
202 unless ($name =~ m/\d+\s*\S+/) { 190 unless ($name =~ m/\d+\s*\S+/) {
203 give_back_with_message ($who, $what, 191 give_back_with_message ($who, $what,
204 "The shopkeeper says: Sorry, I don't recognize '$name' as currency. " 192 "The shopkeeper says: Sorry, I don't recognize '$name' as currency. "
205 ."Please name your item like '10 royalty' or '10 platinum 2 silver'"); 193 . "Please name your item like '17 platinum' or '10 gold 8 silver'");
206 return cf::override; 194 return cf::override;
207 } 195 }
208 196
209 while ($name =~ s/^\s*(\d+)\s*(\S+)//) { 197 while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
210 if ($aliases{lc $2} or $unit{lc $2}) { 198 my ($v, $c) = ($1, $2);
211 $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}}); 199 if (my $coin = cf::coin_from_name $c) {
200 $value += $v * $coin->value;
212 } else { 201 } else {
213 give_back_with_message ($who, $what, 202 give_back_with_message ($who, $what,
214 "The shopkeeper says: I don't know the currency '$2', you can use one of these currencies: ".join (", ", keys %unit)." or also: ".join (", ", keys %aliases)); 203 "The shopkeeper says: I don't know the currency '$c', you can use one of these currencies: "
204 . (join ", ", cf::coin_names)
205 );
215 return cf::override; 206 return cf::override;
216 } 207 }
217 } 208 }
218 } else { 209 } else {
219 # commented out the following line because too many just use the 210 # commented out the following line because too many just use the
220 # reseller shop as dumpyard: 211 # reseller shop as dumpyard:
221 # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); 212 # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
222 give_back_with_message ($who, $what, 213 give_back_with_message ($who, $what,
223 "Sorry, you can't just sell stuff without assigning a price to it! " 214 "Sorry, you can't just sell stuff without assigning a price to it! "
224 ."Please name your item like '10 royalty' or '10 platinum 2 silver' " 215 . "Please name your item like '17 platinum' or '10 gold 8 silver' "
225 ."and drop it again. (To rename the item use the 'rename' " 216 . "and drop it again. (To rename the item use the 'rename' "
226 ."context menu item in the inventory)."); 217 . "context menu item in the inventory)."
218 );
227 return cf::override; 219 return cf::override;
228 } 220 }
229 221
230 if ($value < 0) { 222 if ($value < 0) {
231 give_back_with_message ($who, $what, 223 give_back_with_message ($who, $what,
… …
267 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " 259 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least "
268 . cf::cost_string_from_value ($value) 260 . cf::cost_string_from_value ($value)
269 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN 261 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
270 ); 262 );
271 263
272 $what->set_ob_key_value (ext_reseller_seller => $who->name); 264 $what->kv_set (ext_reseller_seller => $who->name);
273 $what->set_ob_key_value (ext_reseller_orig_value => $orig_value); 265 $what->kv_set (ext_reseller_orig_value => $orig_value);
274# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; 266# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
275 $what->custom_name ($what->name . " (by " . $who->name . ")"); 267 $what->custom_name ($what->name . " (by " . $who->name . ")");
276 $what->flag (cf::FLAG_UNPAID, 1); 268 $what->flag (cf::FLAG_UNPAID, 1);
277 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 269 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
278 270

Diff Legend

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