Commit | Line | Data |
---|---|---|
ca9aa2bf TC |
1 | package BSE::Edit::Product; |
2 | use strict; | |
3 | use base 'BSE::Edit::Article'; | |
4 | use Products; | |
5 | use HTML::Entities; | |
aefcabcb | 6 | use BSE::Template; |
ca9aa2bf TC |
7 | |
8 | my %money_fields = | |
9 | ( | |
10 | retailPrice => "Retail price", | |
11 | wholesalePrice => "Wholesale price", | |
12 | gst => "GST", | |
13 | ); | |
14 | ||
15 | sub generator { 'Generate::Product' } | |
16 | ||
17 | sub base_template_dirs { | |
18 | return ( "products" ); | |
19 | } | |
20 | ||
21 | sub extra_templates { | |
22 | my ($self, $article) = @_; | |
23 | ||
24 | my @extras = $self->SUPER::extra_templates($article); | |
aefcabcb TC |
25 | push @extras, 'shopitem.tmpl' |
26 | if grep -f "$_/shopitem.tmpl", | |
27 | BSE::Template->template_dirs($self->{cfg}); | |
ca9aa2bf | 28 | |
d64413ee TC |
29 | my $extras = $self->{cfg}->entry('products', 'extra_templates'); |
30 | push @extras, grep /\.(tmpl|html)$/i, split /,/, $extras | |
31 | if $extras; | |
32 | ||
ca9aa2bf TC |
33 | return @extras; |
34 | } | |
35 | ||
36 | sub hash_tag { | |
37 | my ($article, $arg) = @_; | |
38 | ||
39 | my $value = $article->{$arg}; | |
40 | defined $value or $value = ''; | |
7b81711b TC |
41 | if ($value =~ /\cJ/ && $value =~ /\cM/) { |
42 | $value =~ tr/\cM//d; | |
43 | } | |
ca9aa2bf TC |
44 | |
45 | return encode_entities($value); | |
46 | } | |
47 | ||
48 | sub low_edit_tags { | |
49 | my ($self, $acts, $req, $article, $articles, $msg, $errors) = @_; | |
50 | ||
51 | return | |
52 | ( | |
53 | product => [ \&hash_tag, $article ], | |
54 | $self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg, | |
55 | $errors), | |
56 | alloptions => join(",", sort keys %Constants::SHOP_PRODUCT_OPTS), | |
57 | ); | |
58 | } | |
59 | ||
60 | sub edit_template { | |
61 | my ($self, $article, $cgi) = @_; | |
62 | ||
63 | my $base = 'product'; | |
64 | my $t = $cgi->param('_t'); | |
65 | if ($t && $t =~ /^\w+$/) { | |
66 | $base = $t; | |
67 | } | |
68 | return $self->{cfg}->entry('admin templates', $base, | |
69 | "admin/edit_$base"); | |
70 | } | |
71 | ||
72 | sub add_template { | |
73 | my ($self, $article, $cgi) = @_; | |
74 | ||
75 | return $self->{cfg}->entry('admin templates', 'add_product', | |
918735d1 | 76 | 'admin/edit_product'); |
ca9aa2bf TC |
77 | } |
78 | ||
79 | sub validate_parent { | |
80 | my ($self, $data, $articles, $parent, $rmsg) = @_; | |
81 | ||
82 | my $shopid = $self->{cfg}->entryErr('articles', 'shop'); | |
83 | unless ($parent && | |
84 | $parent->{generator} eq 'Generate::Catalog') { | |
85 | $$rmsg = "Products must be in a catalog (not $parent->{generator})"; | |
86 | return; | |
87 | } | |
88 | ||
89 | return $self->SUPER::validate_parent($data, $articles, $parent, $rmsg); | |
90 | } | |
91 | ||
92 | sub _validate_common { | |
93 | my ($self, $data, $articles, $errors) = @_; | |
94 | ||
95 | for my $col (keys %money_fields) { | |
96 | my $value = $data->{$col}; | |
97 | unless ($value =~ /^\d+(\.\d{1,2})?\s*/) { | |
98 | $errors->{$col} = "$money_fields{$col} invalid"; | |
99 | } | |
100 | } | |
101 | ||
102 | my @bad_opts =grep !$Constants::SHOP_PRODUCT_OPTS{$_}, | |
103 | split /,/, $data->{options}; | |
104 | if (@bad_opts) { | |
105 | $errors->{options} = "Bad product options '". join(",", @bad_opts)."' entered"; | |
106 | } | |
107 | ||
108 | return !keys %$errors; | |
109 | } | |
110 | ||
111 | sub validate { | |
918735d1 | 112 | my ($self, $data, $articles, $errors) = @_; |
ca9aa2bf | 113 | |
918735d1 | 114 | my $ok = $self->SUPER::validate($data, $articles, $errors); |
ca9aa2bf TC |
115 | $self->_validate_common($data, $articles, $errors); |
116 | ||
117 | for my $field (qw(title summary body)) { | |
118 | unless ($data->{$field} =~ /\S/) { | |
119 | $errors->{$field} = "No $field entered"; | |
120 | } | |
121 | } | |
122 | ||
123 | return $ok && !keys %$errors; | |
124 | } | |
125 | ||
126 | sub validate_old { | |
918735d1 | 127 | my ($self, $article, $data, $articles, $errors) = @_; |
ca9aa2bf | 128 | |
918735d1 | 129 | $self->SUPER::validate($data, $articles, $errors) |
ca9aa2bf TC |
130 | or return; |
131 | ||
132 | return !keys %$errors; | |
133 | } | |
134 | ||
135 | sub possible_parents { | |
136 | my ($self, $article, $articles) = @_; | |
137 | ||
138 | my %labels; | |
139 | my @values; | |
140 | ||
141 | my $shopid = $self->{cfg}->entryErr('articles', 'shop'); | |
142 | # the parents of a catalog can be other catalogs or the shop | |
143 | my $shop = $articles->getByPkey($shopid); | |
144 | my @work = [ $shopid, $shop->{title} ]; | |
145 | while (@work) { | |
146 | my ($id, $title) = @{pop @work}; | |
147 | push(@values, $id); | |
148 | $labels{$id} = $title; | |
149 | push @work, map [ $_->{id}, $title.' / '.$_->{title} ], | |
150 | sort { $b->{displayOrder} <=> $a->{displayOrder} } | |
151 | grep $_->{generator} eq 'Generate::Catalog', | |
152 | $articles->getBy(parentid=>$id); | |
153 | } | |
154 | shift @values; | |
155 | delete $labels{$shopid}; | |
156 | return (\@values, \%labels); | |
157 | } | |
158 | ||
159 | sub table_object { | |
160 | my ($self, $articles) = @_; | |
161 | ||
162 | 'Products'; | |
163 | } | |
164 | ||
165 | sub get_article { | |
166 | my ($self, $articles, $article) = @_; | |
167 | ||
168 | return Products->getByPkey($article->{id}); | |
169 | } | |
170 | ||
95989433 TC |
171 | sub default_link_path { |
172 | my ($self, $article) = @_; | |
173 | ||
174 | $self->{cfg}->entry('uri', 'shop', '/shop'); | |
175 | } | |
176 | ||
ca9aa2bf TC |
177 | sub make_link { |
178 | my ($self, $article) = @_; | |
179 | ||
95989433 | 180 | my $shop_uri = $self->link_path($article); |
ca9aa2bf TC |
181 | my $urlbase = $self->{cfg}->entryVar('site', 'secureurl'); |
182 | return $urlbase.$shop_uri."/shop$article->{id}.html"; | |
183 | } | |
184 | ||
185 | sub _fill_product_data { | |
186 | my ($self, $req, $data, $src) = @_; | |
187 | ||
188 | for my $money_col (qw(retailPrice wholesalePrice gst)) { | |
189 | if (exists $src->{$money_col}) { | |
190 | if ($src->{$money_col} =~ /^\d+(\.\d\d)?\s*/) { | |
191 | $data->{$money_col} = 100 * $src->{$money_col}; | |
192 | } | |
193 | else { | |
194 | $data->{$money_col} = 0; | |
195 | } | |
196 | } | |
197 | } | |
198 | if (exists $src->{leadTime}) { | |
199 | $src->{leadTime} =~ /^\d+\s*$/ | |
200 | or $src->{leadTime} = 0; | |
201 | $data->{leadTime} = $src->{leadTime}; | |
202 | } | |
4010d92e TC |
203 | if (exists $src->{summary} && length $src->{summary}) { |
204 | if ($data->{id}) { | |
205 | if ($req->user_can('edit_field_edit_summary', $data)) { | |
206 | $data->{summary} = $src->{summary}; | |
207 | } | |
208 | } | |
209 | } | |
918735d1 TC |
210 | if (exists $src->{options}) { |
211 | $data->{options} = $src->{options}; | |
212 | } | |
ca9aa2bf TC |
213 | } |
214 | ||
215 | sub fill_new_data { | |
216 | my ($self, $req, $data, $articles) = @_; | |
217 | ||
218 | $self->_fill_product_data($req, $data, $data); | |
219 | ||
220 | return $self->SUPER::fill_new_data($req, $data, $articles); | |
221 | } | |
222 | ||
223 | sub fill_old_data { | |
224 | my ($self, $req, $article, $src) = @_; | |
225 | ||
226 | $self->_fill_product_data($req, $article, $src); | |
227 | ||
228 | return $self->SUPER::fill_old_data($req, $article, $src); | |
229 | } | |
230 | ||
caa7299c TC |
231 | sub default_template { |
232 | my ($self, $article, $cfg, $templates) = @_; | |
233 | ||
d64413ee | 234 | my $template = $cfg->entry('products', 'template'); |
caa7299c TC |
235 | return $template |
236 | if $template && grep $_ eq $template, @$templates; | |
237 | ||
238 | return $self->SUPER::default_template($article, $cfg, $templates); | |
239 | } | |
240 | ||
6473c56f TC |
241 | sub can_remove { |
242 | my ($self, $req, $article, $articles, $rmsg) = @_; | |
243 | ||
244 | require OrderItems; | |
245 | my @items = OrderItems->getBy(productId=>$article->{id}); | |
246 | if (@items) { | |
247 | $$rmsg = "There are orders for this product. It cannot be deleted."; | |
248 | return; | |
249 | } | |
250 | ||
251 | return $self->SUPER::can_remove($req, $article, $articles, $rmsg); | |
252 | } | |
253 | ||
918735d1 TC |
254 | sub flag_sections { |
255 | my ($self) = @_; | |
256 | ||
257 | return ( 'product flags', $self->SUPER::flag_sections ); | |
258 | } | |
259 | ||
ca9aa2bf | 260 | 1; |