server/ext/reseller.ext

#!perl # mandatory

sub ob2info {
   my ($item, $rval) = @_;

   sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]",
      $item->name, $item->kv_get ('ext_reseller_seller'),
      $item->kv_get ('ext_reseller_orig_value'), $item->value,
      (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid
}

sub audit_log {
   my ($who, $action, $info) = @_;
   cf::info
      sprintf "RESELLER_AUDIT(%s) %s %s: %s\n",
         $who->map->path, $who->name, $action, $info;
}

sub find_rec;

sub find_rec {
   my ($ob, $cb) = @_;

   my @found;

   for my $i ($ob->inv) {
      push @found, $i if $cb->($i);
      push @found, find_rec $i, $cb if $i->inv;
   }

   @found
}

sub find_unpaid {
   my ($ob) = @_;

   find_rec $ob, sub { $_[0]->flag (cf::FLAG_UNPAID) };
}

sub find_traded {
   my ($ob) = @_;

   find_rec $ob, sub { $_[0]->kv_get ('ext_reseller_seller') ne '' };
}

cf::register_script_function "reseller::list_sells" => sub {
   my ($who, $msg, $npc) = @_;
   my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
   my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
   my $hissells = $sells->{$who->name};

   unless (keys %{$hissells || {}}) {
      $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
      return 0;
   }

   my $reply = "T<You sold:>\n\n";

   for (keys %$hissells) {
      my $n = $_;
      $n =~ s/\s*\(unpaid\)//g;
      $reply .= "   B<$n> (for " . cf::cost_string_from_value ($hissells->{$_}) . ")\n";
   }

   $who->reply ($npc, $reply);

   0
};

cf::register_script_function "reseller::pay_player" => sub {
   my ($who, $msg, $npc) = @_;
   my $ext_re_sales = $npc->kv_get ('ext_reseller_sales');
   my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;
   my $hissells = $sells->{$who->name};

   unless (keys %{$hissells || {}}) {
      $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
      return 0;
   }

   my $sum = 0;
   $sum += $_ for values %$hissells;

   $who->pay_player ($sum);
   $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales.");

   audit_log ($who, 'collects', "$sum silver");

   $sells->{$who->name} = {};

   $npc->kv_set (ext_reseller_sales => cf::encode_json $sells)
      if $sells;

   0
};

cf::object::attachment "reseller_shopmat",
   on_move_trigger => sub {
      my ($self, $who_caused, $who) = @_;

      my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
                     $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});

      unless (@obs) {
         cf::error "Couldn't find shop keeper in " . $who->map->path . "\n";
         return cf::override;
      }

      my $ext_re_sales = $obs[0]->kv_get ('ext_reseller_sales');
      my $sells = $ext_re_sales && cf::decode_json $ext_re_sales;

      my $unpaid_items = {};

      for my $item (find_unpaid ($who)) {
         if ($item->kv_get ('ext_reseller_seller') eq $who->name) {
            audit_log ($who, 'removes', ob2info ($item));
            $item->flag (cf::FLAG_UNPAID, 0);
            $item->remove;
            give_back ($who, $item);
            next;
         }

         my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);

         cf::debug "Object ", $item->name, " bought by ", $who->name, " on map " ,
                   $who->map->path, " for $value silver has no seller set\n"
            if $item->kv_get ('ext_reseller_seller') eq '';

         $unpaid_items->{$item} = [$value, $item];
      }

      audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
         if %$unpaid_items;

      $self->apply_shop_mat ($who);

      my @seller_noted;

      for my $item (find_traded ($who)) {
         next if $item->flag (cf::FLAG_UNPAID);
         if (my $value = $unpaid_items->{$item}[0]) {
            push @seller_noted, ob2info ($item, $value)."P";
            $sells->{$item->kv_get ('ext_reseller_seller')}->{$item->name} += $value;
         } else {
            push @seller_noted, ob2info ($item)."T";
         }

         $item->value ($item->kv_get ('ext_reseller_orig_value'));
         $item->kv_del ("ext_reseller_seller");
      }

      audit_log ($who, 'removed', (join ",", @seller_noted))
         if @seller_noted;

      $obs[0]->kv_set (ext_reseller_sales => cf::encode_json $sells)
         if $sells;

      cf::override;
   },
;

sub give_back {
   my ($who, $what) = @_;
   $who->insert ($what);
}

sub give_back_with_message {
   my ($who, $what, $msg) = @_;
   $who->message ($msg, cf::NDI_BROWN);
   give_back ($who, $what);
}

cf::object::attachment "reseller_floor",
   on_drop_on => sub {
      my ($on, $what, $who) = @_;
      my $name = $what->custom_name;

      return if $what->flag (cf::FLAG_UNPAID);

      if ($what->type == cf::MONEY) {
         give_back_with_message ($who, $what,
            "The shopkeeper says: Sorry, you can't sell money here.");
         return cf::override;
      }

      if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
         give_back_with_message ($who, $what,
            "The shopkeeper says: Sorry, you can't sell unidentified stuff here.");
         return cf::override;
      }

      my $orig_value = $what->value;
      my $value = 0;

      if ($name =~ m/\S/) {
         unless ($name =~ m/\d+\s*\S+/) {
            give_back_with_message ($who, $what,
               "The shopkeeper says: Sorry, I don't recognize '$name' as currency. "
               . "Please name your item like '17 platinum' or '10 gold 8 silver.'");
            return cf::override;
         }

         while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
            my ($v, $c) = ($1, $2);
            if (my $coin = cf::coin_from_name $c) {
               $value += $v * $coin->value;
            } else {
               give_back_with_message ($who, $what,
                  "The shopkeeper says: I don't know the currency '$c', you can use one of these currencies: "
                  . (join ", ", cf::coin_names)
               );
               return cf::override;
            }
         }
      } else {
         # commented out the following line because too many just use the 
         # reseller shop as dumpyard:
         # $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
         give_back_with_message ($who, $what,
            "Sorry, you can't just sell stuff without assigning a price to it! "
            . "Please name your item like '17 platinum' or '10 gold 8 silver' "
            . "and drop it again. (To rename the item use the B<rename> "
            . "entry in the inventory item popup menu)."
         );
         return cf::override;
      }

      if ($value > 100 ** 4) { # also for overflow prevention
         give_back_with_message ($who, $what,
            "The shopkeeper says: You can't sell something for such a high "
            . "value. Please keep it below 100 royalty.");
         return cf::override;
      }

      if ($value < 0) {
         give_back_with_message ($who, $what,
            "The shopkeeper says: You can't sell something for a negative value: $value.");
         return cf::override;
      }

      my $fee = $value / 100; # 1% selling fee

      unless ($who->pay_amount ($fee)) {
         give_back_with_message ($who, $what,
            "The shopkeeper says: You need " . cf::cost_string_from_value ($fee)
            . " to pay the 1% fee for this item.");
         return cf::override;
      } else {
         $who->message (
            "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee)
            . " for the item.",
            cf::NDI_BROWN
         );
      }

      $what->value ($value);
      my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / ($what->nrof || 1);

      my $fact = 0;
      if ($cost) {
         $fact = $value / $cost;
         $what->value (cf::ceil ($value * $fact));
      }

#  warn "END VALUE: $value * $fact => " . $what->value . "\n";

#   my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof;
#  warn "COSTS NOW: $cost\n";

      $who->message (
         "The shopkeeper says: Ok, I marked " 
         . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " 
         . cf::cost_string_from_value ($value)
         . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
      );

      $what->kv_set (ext_reseller_seller => $who->name);
      $what->kv_set (ext_reseller_orig_value => $orig_value);
#  warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
      $what->custom_name ($what->name . " (by " . $who->name . ")");
      $what->flag (cf::FLAG_UNPAID, 1);
      $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);

      audit_log ($who, 'sells', ob2info ($what));

      cf::override;
   },
;

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