]> git.imager.perl.org - bse.git/blame_incremental - site/cgi-bin/modules/BSE/Edit/Product.pm
0.14_23 commit
[bse.git] / site / cgi-bin / modules / BSE / Edit / Product.pm
... / ...
CommitLineData
1package BSE::Edit::Product;
2use strict;
3use base 'BSE::Edit::Article';
4use Products;
5use HTML::Entities;
6use BSE::Template;
7
8my %money_fields =
9 (
10 retailPrice => "Retail price",
11 wholesalePrice => "Wholesale price",
12 gst => "GST",
13 );
14
15sub generator { 'Generate::Product' }
16
17sub base_template_dirs {
18 return ( "products" );
19}
20
21sub extra_templates {
22 my ($self, $article) = @_;
23
24 my @extras = $self->SUPER::extra_templates($article);
25 push @extras, 'shopitem.tmpl'
26 if grep -f "$_/shopitem.tmpl",
27 BSE::Template->template_dirs($self->{cfg});
28
29 my $extras = $self->{cfg}->entry('products', 'extra_templates');
30 push @extras, grep /\.(tmpl|html)$/i, split /,/, $extras
31 if $extras;
32
33 return @extras;
34}
35
36sub hash_tag {
37 my ($article, $arg) = @_;
38
39 my $value = $article->{$arg};
40 defined $value or $value = '';
41 if ($value =~ /\cJ/ && $value =~ /\cM/) {
42 $value =~ tr/\cM//d;
43 }
44
45 return encode_entities($value);
46}
47
48sub 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
60sub 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
72sub add_template {
73 my ($self, $article, $cgi) = @_;
74
75 return $self->{cfg}->entry('admin templates', 'add_product',
76 'admin/edit_product');
77}
78
79sub 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
92sub _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
111sub validate {
112 my ($self, $data, $articles, $errors) = @_;
113
114 my $ok = $self->SUPER::validate($data, $articles, $errors);
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
126sub validate_old {
127 my ($self, $article, $data, $articles, $errors) = @_;
128
129 $self->SUPER::validate($data, $articles, $errors)
130 or return;
131
132 return !keys %$errors;
133}
134
135sub 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
159sub table_object {
160 my ($self, $articles) = @_;
161
162 'Products';
163}
164
165sub get_article {
166 my ($self, $articles, $article) = @_;
167
168 return Products->getByPkey($article->{id});
169}
170
171sub default_link_path {
172 my ($self, $article) = @_;
173
174 $self->{cfg}->entry('uri', 'shop', '/shop');
175}
176
177sub make_link {
178 my ($self, $article) = @_;
179
180 my $shop_uri = $self->link_path($article);
181 my $urlbase = $self->{cfg}->entryVar('site', 'secureurl');
182 return $urlbase.$shop_uri."/shop$article->{id}.html";
183}
184
185sub _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 }
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 }
210 if (exists $src->{options}) {
211 $data->{options} = $src->{options};
212 }
213}
214
215sub 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
223sub 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
231sub default_template {
232 my ($self, $article, $cfg, $templates) = @_;
233
234 my $template = $cfg->entry('products', 'template');
235 return $template
236 if $template && grep $_ eq $template, @$templates;
237
238 return $self->SUPER::default_template($article, $cfg, $templates);
239}
240
241sub 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
254sub flag_sections {
255 my ($self) = @_;
256
257 return ( 'product flags', $self->SUPER::flag_sections );
258}
259
2601;