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.1 by root, Fri Dec 15 19:29:18 2006 UTC vs.
Revision 1.6 by elmex, Wed Jun 6 17:41:17 2007 UTC

1#!perl 1#!perl # MANDATORY
2 2
3my %unit = ( 3my %unit = (
4 silver => 1, 4 silver => 1,
5 gold => 10, 5 gold => 10,
6 platina => 50, 6 platina => 50,
… …
10my %aliases = ( 10my %aliases = (
11 platinum => 'platina', 11 platinum => 'platina',
12 royalties => 'royalty', 12 royalties => 'royalty',
13); 13);
14 14
15sub ob2info {
16 my ($item, $rval) = @_;
17 sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]",
18 $item->name, $item->get_ob_key_value ('ext_reseller_seller'),
19 $item->get_ob_key_value ('ext_reseller_orig_value'), $item->value,
20 (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid;
21}
22
23sub audit_log {
24 my ($who, $action, $info) = @_;
25 warn
26 sprintf "RESELLER_AUDIT(%s) %s %s: %s\n",
27 $who->map->path, $who->name, $action, $info;
28}
29
30sub find_rec;
31
15sub find_rec { 32sub find_rec {
16 my ($ob, $cb) = @_; 33 my ($ob, $cb) = @_;
17 34
18 my @unpaid; 35 my @found;
19 for my $i ($ob->inv) { 36 for my $i ($ob->inv) {
20 push @unpaid, $i if $cb->($i); 37 push @found, $i if $cb->($i);
21 38 push @found, find_rec $i, $cb if $i->inv;
22 push @unpaid, find_unpaid ($i, $cb)
23 if $i->inv;
24 } 39 }
40
25 return @unpaid; 41 return @found;
26} 42}
27 43
28sub find_unpaid { 44sub find_unpaid {
29 my ($ob) = @_; 45 my ($ob) = @_;
30 my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) }); 46 find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) };
31 return @r;
32} 47}
33 48
34sub find_traded { 49sub find_traded {
35 my ($ob) = @_; 50 my ($ob) = @_;
36 my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' }); 51 find_rec $ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' };
37 return @r;
38} 52}
39 53
40cf::register_script_function "reseller::list_sells" => sub { 54cf::register_script_function "reseller::list_sells" => sub {
41 my ($who, $msg, $npc) = @_; 55 my ($who, $msg, $npc) = @_;
42 my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales'); 56 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales');
57 my $sells = $ext_re_sales && cf::from_json $ext_re_sales;
43 my $hissells = $sells->{$who->name}; 58 my $hissells = $sells->{$who->name};
44 59
45 unless (keys %{$hissells || {}}) { 60 unless (keys %{$hissells || {}}) {
46 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 61 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
47 return 0; 62 return 0;
… …
57 0 72 0
58}; 73};
59 74
60cf::register_script_function "reseller::pay_player" => sub { 75cf::register_script_function "reseller::pay_player" => sub {
61 my ($who, $msg, $npc) = @_; 76 my ($who, $msg, $npc) = @_;
62 my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales'); 77 my $ext_re_sales = $npc->get_ob_key_value ('ext_reseller_sales');
78 my $sells = $ext_re_sales && cf::from_json $ext_re_sales;
63 my $hissells = $sells->{$who->name}; 79 my $hissells = $sells->{$who->name};
64 80
65 unless (keys %{$hissells || {}}) { 81 unless (keys %{$hissells || {}}) {
66 $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); 82 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
67 return 0; 83 return 0;
… …
71 $sum += $_ for values %$hissells; 87 $sum += $_ for values %$hissells;
72 88
73 $who->pay_player ($sum); 89 $who->pay_player ($sum);
74 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales"); 90 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales");
75 91
92 audit_log ($who, 'collects', "$sum silver");
93
76 $sells->{$who->name} = {}; 94 $sells->{$who->name} = {};
77 95
78 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 96 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells)
97 if $sells;
79 98
80 0 99 0
81}; 100};
82 101
83cf::register_attachment "reseller_shopmat", 102cf::object::attachment "reseller_shopmat",
84 on_move_trigger => sub { 103 on_move_trigger => sub {
85 my ($self, $who_caused, $who) = @_; 104 my ($self, $who_caused, $who) = @_;
86 105
87 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} } 106 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
88 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y}); 107 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});
89 108
90 unless (@obs) { 109 unless (@obs) {
91 warn "Couldn't find shop keeper in " . $who->map . "\n"; 110 warn "Couldn't find shop keeper in " . $who->map->path . "\n";
92 return cf::override; 111 return cf::override;
93 } 112 }
94 113
95 my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales'); 114 my $ext_re_sales = $obs[0]->get_ob_key_value ('ext_reseller_sales');
115 my $sells = $ext_re_sales && cf::from_json $ext_re_sales;
96 116
97 my $unpaid_items = {}; 117 my $unpaid_items = {};
98 118
99 for my $item (find_unpaid ($who)) { 119 for my $item (find_unpaid ($who)) {
100 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { 120 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
121 audit_log ($who, 'removes', ob2info ($item));
101 $item->flag (cf::FLAG_UNPAID, 0); 122 $item->flag (cf::FLAG_UNPAID, 0);
102 $item->remove; 123 $item->remove;
103 $item->insert_ob_in_ob ($who); 124 $item->insert_ob_in_ob ($who);
104 next; 125 next;
105 } 126 }
… …
111 if $item->get_ob_key_value ('ext_reseller_seller') eq ''; 132 if $item->get_ob_key_value ('ext_reseller_seller') eq '';
112 133
113 $unpaid_items->{$item} = [$value, $item]; 134 $unpaid_items->{$item} = [$value, $item];
114 } 135 }
115 136
137 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
138 if %$unpaid_items;
139
116 $self->apply_shop_mat ($who); 140 $self->apply_shop_mat ($who);
141
142 my @seller_noted;
117 143
118 for my $item (find_traded ($who)) { 144 for my $item (find_traded ($who)) {
119 next if $item->flag (cf::FLAG_UNPAID); 145 next if $item->flag (cf::FLAG_UNPAID);
120 if (my $value = $unpaid_items->{$item}[0]) { 146 if (my $value = $unpaid_items->{$item}[0]) {
147 push @seller_noted, ob2info ($item, $value)."P";
121 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; 148 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
149 } else {
150 push @seller_noted, ob2info ($item)."T";
122 } 151 }
123 152
124 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value')); 153 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
125 $item->set_ob_key_value (ext_reseller_seller => ''); 154 $item->set_ob_key_value (ext_reseller_seller => '');
126 } 155 }
127 156
157 audit_log ($who, 'removed', (join ",", @seller_noted))
158 if @seller_noted;
159
128 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 160 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells)
161 if $sells;
129 162
130 cf::override; 163 cf::override;
131 }, 164 },
132; 165;
133 166
134cf::register_attachment "reseller_floor", 167cf::object::attachment "reseller_floor",
135 on_drop_on => sub { 168 on_drop_on => sub {
136 my ($on, $what, $who) = @_; 169 my ($on, $what, $who) = @_;
137 my $name = $what->custom_name; 170 my $name = $what->custom_name;
138 171
139 return if $what->flag (cf::FLAG_UNPAID); 172 return if $what->flag (cf::FLAG_UNPAID);
… …
221# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; 254# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
222 $what->custom_name ($what->name . " (by " . $who->name . ")"); 255 $what->custom_name ($what->name . " (by " . $who->name . ")");
223 $what->flag (cf::FLAG_UNPAID, 1); 256 $what->flag (cf::FLAG_UNPAID, 1);
224 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 257 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
225 258
259 audit_log ($who, 'sells', ob2info ($what));
260
226 cf::override; 261 cf::override;
227 }, 262 },
228; 263;

Diff Legend

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