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.5 by elmex, Wed Jan 24 19:39:14 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 $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
… …
71 $sum += $_ for values %$hissells; 85 $sum += $_ for values %$hissells;
72 86
73 $who->pay_player ($sum); 87 $who->pay_player ($sum);
74 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales"); 88 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales");
75 89
90 audit_log ($who, 'collects', "$sum silver");
91
76 $sells->{$who->name} = {}; 92 $sells->{$who->name} = {};
77 93
78 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 94 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
79 95
80 0 96 0
81}; 97};
82 98
83cf::register_attachment "reseller_shopmat", 99cf::object::attachment "reseller_shopmat",
84 on_move_trigger => sub { 100 on_move_trigger => sub {
85 my ($self, $who_caused, $who) = @_; 101 my ($self, $who_caused, $who) = @_;
86 102
87 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} } 103 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
88 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y}); 104 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});
89 105
90 unless (@obs) { 106 unless (@obs) {
91 warn "Couldn't find shop keeper in " . $who->map . "\n"; 107 warn "Couldn't find shop keeper in " . $who->map->path . "\n";
92 return cf::override; 108 return cf::override;
93 } 109 }
94 110
95 my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales'); 111 my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');
96 112
97 my $unpaid_items = {}; 113 my $unpaid_items = {};
98 114
99 for my $item (find_unpaid ($who)) { 115 for my $item (find_unpaid ($who)) {
100 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { 116 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
117 audit_log ($who, 'removes', ob2info ($item));
101 $item->flag (cf::FLAG_UNPAID, 0); 118 $item->flag (cf::FLAG_UNPAID, 0);
102 $item->remove; 119 $item->remove;
103 $item->insert_ob_in_ob ($who); 120 $item->insert_ob_in_ob ($who);
104 next; 121 next;
105 } 122 }
… …
111 if $item->get_ob_key_value ('ext_reseller_seller') eq ''; 128 if $item->get_ob_key_value ('ext_reseller_seller') eq '';
112 129
113 $unpaid_items->{$item} = [$value, $item]; 130 $unpaid_items->{$item} = [$value, $item];
114 } 131 }
115 132
133 audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
134 if %$unpaid_items;
135
116 $self->apply_shop_mat ($who); 136 $self->apply_shop_mat ($who);
137
138 my @seller_noted;
117 139
118 for my $item (find_traded ($who)) { 140 for my $item (find_traded ($who)) {
119 next if $item->flag (cf::FLAG_UNPAID); 141 next if $item->flag (cf::FLAG_UNPAID);
120 if (my $value = $unpaid_items->{$item}[0]) { 142 if (my $value = $unpaid_items->{$item}[0]) {
143 push @seller_noted, ob2info ($item, $value)."P";
121 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; 144 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
145 } else {
146 push @seller_noted, ob2info ($item)."T";
122 } 147 }
123 148
124 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value')); 149 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
125 $item->set_ob_key_value (ext_reseller_seller => ''); 150 $item->set_ob_key_value (ext_reseller_seller => '');
126 } 151 }
152
153 audit_log ($who, 'removed', (join ",", @seller_noted))
154 if @seller_noted;
127 155
128 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 156 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
129 157
130 cf::override; 158 cf::override;
131 }, 159 },
132; 160;
133 161
134cf::register_attachment "reseller_floor", 162cf::object::attachment "reseller_floor",
135 on_drop_on => sub { 163 on_drop_on => sub {
136 my ($on, $what, $who) = @_; 164 my ($on, $what, $who) = @_;
137 my $name = $what->custom_name; 165 my $name = $what->custom_name;
138 166
139 return if $what->flag (cf::FLAG_UNPAID); 167 return if $what->flag (cf::FLAG_UNPAID);
… …
221# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; 249# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
222 $what->custom_name ($what->name . " (by " . $who->name . ")"); 250 $what->custom_name ($what->name . " (by " . $who->name . ")");
223 $what->flag (cf::FLAG_UNPAID, 1); 251 $what->flag (cf::FLAG_UNPAID, 1);
224 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 252 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
225 253
254 audit_log ($who, 'sells', ob2info ($what));
255
226 cf::override; 256 cf::override;
227 }, 257 },
228; 258;

Diff Legend

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