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 {
   my ($ob, $cb) = @_;

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

      push @unpaid, find_unpaid ($i, $cb)
         if $i->inv;
   }
   return @unpaid;
}

sub find_unpaid {
   my ($ob) = @_;
   my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) });
   return @r;
}

sub find_traded {
   my ($ob) = @_;
   my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' });
   return @r;
}

cf::register_script_function "reseller::list_sells" => sub {
   my ($who, $msg, $npc) = @_;
   my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_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 $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_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::to_json $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 $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_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;
            $item->insert_ob_in_ob ($who);
            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::to_json $sells);

      cf::override;
   },
;

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) {
         $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
         $what->insert_ob_in_ob ($who);
         return cf::override;
      }

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

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

      if ($name =~ m/\S/) {
         unless ($name =~ m/\d+\s*\S+/) {
            $who->message ("The shopkeeper says: Sorry, I don't recognize '$name' as currency. Please name your item like '10 royalty' or '10 platinum 2 silver'", cf::NDI_BROWN);
            $what->insert_ob_in_ob ($who);
            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 {
               $what->insert_ob_in_ob ($who);
               $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
               return cf::override;
            }
         }
      } else {
         $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
      }

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

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

      unless ($who->pay_amount ($fee)) {
         $who->message (
            "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item",
            cf::NDI_BROWN
         );
         $what->insert_ob_in_ob ($who);
         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.4
Committed:	Sat Jan 13 23:06:13 2007 UTC (17 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.3:	+1 -1 lines
Log Message:	WARNING: this release is BROKEN - rewrote map handling. map types are now completely pluggable, maybe too pluggable, as everything is a plug-in now. - mark mandatory extensions as such. - handle overloaded attachable objects correctly. - many minor changes.
#	Content
1	#!perl # MANDATORY
2
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	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	sub find_rec {
31	my ($ob, $cb) = @_;
32
33	my @unpaid;
34	for my $i ($ob->inv) {
35	push @unpaid, $i if $cb->($i);
36
37	push @unpaid, find_unpaid ($i, $cb)
38	if $i->inv;
39	}
40	return @unpaid;
41	}
42
43	sub find_unpaid {
44	my ($ob) = @_;
45	my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) });
46	return @r;
47	}
48
49	sub find_traded {
50	my ($ob) = @_;
51	my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' });
52	return @r;
53	}
54
55	cf::register_script_function "reseller::list_sells" => sub {
56	my ($who, $msg, $npc) = @_;
57	my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
58	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	my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
78	my $hissells = $sells->{$who->name};
79
80	unless (keys %{$hissells \|\| {}}) {
81	$who->reply ($npc, "I'm sorry, but you sold nothing.\n");
82	return 0;
83	}
84
85	my $sum = 0;
86	$sum += $_ for values %$hissells;
87
88	$who->pay_player ($sum);
89	$who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales");
90
91	audit_log ($who, 'collects', "$sum silver");
92
93	$sells->{$who->name} = {};
94
95	$npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
96
97	0
98	};
99
100	cf::object::attachment "reseller_shopmat",
101	on_move_trigger => sub {
102	my ($self, $who_caused, $who) = @_;
103
104	my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
105	$who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});
106
107	unless (@obs) {
108	warn "Couldn't find shop keeper in " . $who->map->path . "\n";
109	return cf::override;
110	}
111
112	my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');
113
114	my $unpaid_items = {};
115
116	for my $item (find_unpaid ($who)) {
117	if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
118	audit_log ($who, 'removes', ob2info ($item));
119	$item->flag (cf::FLAG_UNPAID, 0);
120	$item->remove;
121	$item->insert_ob_in_ob ($who);
122	next;
123	}
124
125	my $value = $item->query_cost ($who, cf::F_BUY \| cf::F_SHOP);
126
127	warn "Object " . $item->name . " bought by " . $who->name . " on map "
128	. $who->map->path . " for $value silver has no seller set\n"
129	if $item->get_ob_key_value ('ext_reseller_seller') eq '';
130
131	$unpaid_items->{$item} = [$value, $item];
132	}
133
134	audit_log ($who, 'wants', (join ",", map { ob2info ($_->[1], $_->[0]) } values %$unpaid_items))
135	if %$unpaid_items;
136
137	$self->apply_shop_mat ($who);
138
139	my @seller_noted;
140
141	for my $item (find_traded ($who)) {
142	next if $item->flag (cf::FLAG_UNPAID);
143	if (my $value = $unpaid_items->{$item}[0]) {
144	push @seller_noted, ob2info ($item, $value)."P";
145	$sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
146	} else {
147	push @seller_noted, ob2info ($item)."T";
148	}
149
150	$item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
151	$item->set_ob_key_value (ext_reseller_seller => '');
152	}
153
154	audit_log ($who, 'removed', (join ",", @seller_noted))
155	if @seller_noted;
156
157	$obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
158
159	cf::override;
160	},
161	;
162
163	cf::object::attachment "reseller_floor",
164	on_drop_on => sub {
165	my ($on, $what, $who) = @_;
166	my $name = $what->custom_name;
167
168	return if $what->flag (cf::FLAG_UNPAID);
169
170	if ($what->type == cf::MONEY) {
171	$who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
172	$what->insert_ob_in_ob ($who);
173	return cf::override;
174	}
175
176	if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
177	$who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN);
178	$what->insert_ob_in_ob ($who);
179	return cf::override;
180	}
181
182	my $orig_value = $what->value;
183	my $value = 0;
184
185	if ($name =~ m/\S/) {
186	unless ($name =~ m/\d+\s*\S+/) {
187	$who->message ("The shopkeeper says: Sorry, I don't recognize '$name' as currency. Please name your item like '10 royalty' or '10 platinum 2 silver'", cf::NDI_BROWN);
188	$what->insert_ob_in_ob ($who);
189	return cf::override;
190	}
191
192	while ($name =~ s/^\s(\d+)\s(\S+)//) {
193	if ($aliases{lc $2} or $unit{lc $2}) {
194	$value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}});
195	} else {
196	$what->insert_ob_in_ob ($who);
197	$who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
198	return cf::override;
199	}
200	}
201	} else {
202	$value = $what->query_cost ($who, cf::F_SELL \| cf::F_SHOP) / ($what->nrof \|\| 1);
203	}
204
205	if ($value < 0) {
206	$what->insert_ob_in_ob ($who);
207	$who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN);
208	return cf::override;
209	}
210
211	my $fee = $value / 100; # 1% selling fee
212
213	unless ($who->pay_amount ($fee)) {
214	$who->message (
215	"The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item",
216	cf::NDI_BROWN
217	);
218	$what->insert_ob_in_ob ($who);
219	return cf::override;
220	} else {
221	$who->message (
222	"The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item",
223	cf::NDI_BROWN
224	);
225	}
226
227	$what->value ($value);
228	my $cost = $what->query_cost ($who, cf::F_BUY \| cf::F_SHOP) / ($what->nrof \|\| 1);
229
230	my $fact = 0;
231	if ($cost) {
232	$fact = $value / $cost;
233	$what->value (cf::ceil ($value * $fact));
234	}
235
236	# warn "END VALUE: $value * $fact => " . $what->value . "\n";
237
238	# my $cost = $what->query_cost ($who, cf::F_BUY \| cf::F_SHOP) / $what->nrof;
239	# warn "COSTS NOW: $cost\n";
240
241	$who->message (
242	"The shopkeeper says: Ok, I marked "
243	. ($what->nrof \|\| 1) . " " . $what->name . " to be sold for at least "
244	. cf::cost_string_from_value ($value)
245	. ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
246	);
247
248	$what->set_ob_key_value (ext_reseller_seller => $who->name);
249	$what->set_ob_key_value (ext_reseller_orig_value => $orig_value);
250	# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
251	$what->custom_name ($what->name . " (by " . $who->name . ")");
252	$what->flag (cf::FLAG_UNPAID, 1);
253	$what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
254
255	audit_log ($who, 'sells', ob2info ($what));
256
257	cf::override;
258	},
259	;