server/ext/reseller.ext

#!perl # mandatory

my %unit = (
   silver   => 1,
   gold     => 10,
   platina  => 50,
   royalty  => 5000,
); 

my %aliases = (
   platinum  => 'platina',
   royalties => 'royalty',
);

sub ob2info {
   my ($item, $rval) = @_;
   sprintf "[%s from %s (%d:%d%s) nrof: %d uuid: %s]",
      $item->name, $item->get_ob_key_value ('ext_reseller_seller'),
      $item->get_ob_key_value ('ext_reseller_orig_value'), $item->value,
      (defined $rval ? ":$rval" : ""), $item->nrof, $item->uuid;
}

sub audit_log {
   my ($who, $action, $info) = @_;
   warn
      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;
   }

   return @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]->get_ob_key_value ('ext_reseller_seller') ne '' };
}

cf::register_script_function "reseller::list_sells" => sub {
   my ($who, $msg, $npc) = @_;
   my $ext_re_sales = $npc->get_ob_key_value ('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;
   }

   $who->reply ($npc, "You sold:\n", cf::NDI_BROWN);
   for (keys %$hissells) {
      my $n = $_;
      $n =~ s/\s*\(unpaid\)//g;
      $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN);
   }

   0
};

cf::register_script_function "reseller::pay_player" => sub {
   my ($who, $msg, $npc) = @_;
   my $ext_re_sales = $npc->get_ob_key_value ('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->set_ob_key_value (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) {
         warn "Couldn't find shop keeper in " . $who->map->path . "\n";
         return cf::override;
      }

      my $ext_re_sales = $obs[0]->get_ob_key_value ('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->get_ob_key_value ('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);

         warn "Object " . $item->name . " bought by " . $who->name . " on map " 
              . $who->map->path . " for $value silver has no seller set\n"
            if $item->get_ob_key_value ('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->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
         } else {
            push @seller_noted, ob2info ($item)."T";
         }

         $item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
         $item->set_ob_key_value (ext_reseller_seller => '');
      }

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

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

      cf::override;
   },
;

sub give_back {
   my ($who, $what) = @_;
   $who->insert ($what);
   $who->esrv_send_item ($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 '10 royalty' or '10 platinum 2 silver'");
            return cf::override;
         }

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