stupid bug in dynsection tag
[bse.git] / site / cgi-bin / modules / BSE / ProductImportXLS.pm
CommitLineData
97469012
TC
1package BSE::ProductImportXLS;
2use strict;
3use Spreadsheet::ParseExcel;
bf87e97c 4use BSE::API qw(bse_make_product bse_make_catalog bse_add_image);
97469012
TC
5use Articles;
6use Products;
bf87e97c 7use Config;
97469012
TC
8
9sub new {
bf87e97c 10 my ($class, $cfg, $profile, %opts) = @_;
97469012
TC
11
12 # field mapping
13 my $section = "xls import $profile";
14 my %ids = $cfg->entriesCS($section);
15 keys %ids
16 or die "No entries found for profile $profile\n";
17
18 my $sheet = $cfg->entry($section, "sheet", 1);
19 my $skiprows = $cfg->entry($section, 'skiprows', 1);
20 my $use_codes = $cfg->entry($section, 'codes', 0);
21 my $parent = $cfg->entry($section, 'parent', 3);
22 my $price_dollar = $cfg->entry($section, 'price_dollar', 0);
bf87e97c
TC
23 my $reset_images = $cfg->entry($section, 'reset_images', 0);
24 my $file_path = $cfg->entry($section, 'file_path');
25 defined $file_path or $file_path = '';
26 my @file_path = split /$Config{path_sep}/, $file_path;
27 if ($opts{file_path}) {
28 unshift @file_path,
29 map
30 {
31 split /$Config{path_sep}/, $_
32 }
33 @{$opts{file_path}};
34 }
97469012
TC
35
36 my %map;
37 for my $map (grep /^map_\w+$/, keys %ids) {
38 (my $out = $map) =~ s/^map_//;
39 my $in = $ids{$map};
40 $in =~ /^\d+$/
41 or die "Mapping for $out not numeric\n";
42 $map{$out} = $in;
43 }
bf87e97c
TC
44 my %set;
45 for my $set (grep /^set_\w+$/, keys %ids) {
46 (my $out = $set) =~ s/^set_//;
47 $set{$out} = $ids{$set};
48 }
97469012
TC
49 my %xform;
50 for my $xform (grep /^xform_\w+$/, keys %ids) {
51 (my $out = $xform) =~ s/^xform_//;
52 $map{$out}
53 or die "Xform for $out but no mapping\n";
bf87e97c 54 my $code = "sub { (local \$_, my \$product) = \@_; \n".$ids{$xform}."\n; return \$_ }";
db84a28f 55 my $sub = eval $code;
97469012
TC
56 $sub
57 or die "Compilation error for $xform code: $@\n";
58 $xform{$out} = $sub;
59 }
60 defined $map{title}
61 or die "No title mapping found\n";
62 defined $map{retailPrice}
63 or die "No retailPrice mapping found\n";
64 if ($use_codes && !defined $map{product_code}) {
65 die "No product_code mapping found with 'codes' enabled\n";
66 }
67 my @cats;
68 for my $cat (qw/cat1 cat2 cat3/) {
69 my $col = $ids{$cat};
70 $col and push @cats, $col;
71 }
72
73 return bless
74 {
75 map => \%map,
76 xform => \%xform,
bf87e97c 77 set => \%set,
97469012
TC
78 sheet => $sheet,
79 skiprows => $skiprows,
80 codes => $use_codes,
81 cats => \@cats,
82 parent => $parent,
83 price_dollar => $price_dollar,
bf87e97c 84 reset_images => $reset_images,
97469012 85 cfg => $cfg,
bf87e97c 86 file_path => \@file_path,
97469012
TC
87 product_template => scalar($cfg->entry($section, 'product_template')),
88 catalog_template => scalar($cfg->entry($section, 'catalog_template')),
89 }, $class;
90}
91
92sub profiles {
93 my ($class, $cfg) = @_;
94
95 my %ids = $cfg->entries("xls product imports");
96 return \%ids;
97}
98
99sub process {
100 my ($self, $filename, $callback) = @_;
101
102 $self->{catseen} = {};
103 $self->{catalogs} = [];
104 $self->{products} = [];
105 my $parser = Spreadsheet::ParseExcel->new;
106 my $wb = $parser->Parse($filename)
107 or die "Could not parse $filename";
108 $self->{sheet} <= $wb->{SheetCount}
109 or die "No enough worksheets in input\n";
110 my $ws = ($wb->worksheets)[$self->{sheet}-1]
111 or die "No worksheet found at $self->{sheet}\n";
112
113 my ($minrow, $maxrow) = $ws->RowRange;
114 my @errors;
115 my %cat_cache;
116 for my $rownum ($self->{skiprows} ... $maxrow) {
117 eval {
bf87e97c 118 my %entry = %{$self->{set}};
97469012
TC
119
120 $self->{product_template}
121 and $entry{template} = $self->{product_template};
122
123 # load from mapping
124 for my $col (keys %{$self->{map}}) {
125 my $cell = $ws->get_cell($rownum, $self->{map}{$col}-1);
126 $entry{$col} = $cell->value;
bf87e97c
TC
127 }
128 for my $col (keys %{$self->{xform}}) {
129 $entry{$col} = $self->{xform}{$col}->($entry{$col}, \%entry);
97469012
TC
130 }
131 $entry{title} =~ /\S/
132 or die "title blank\n";
133 if ($self->{codes}) {
134 $entry{product_code} =~ /\S/
135 or die "product_code blank with use_codes\n";
136 }
137 $entry{retailPrice} =~ s/\$//; # in case
138
139 $self->{price_dollar}
140 and $entry{retailPrice} *= 100;
141
142 $entry{summary}
143 or $entry{summary} = $entry{title};
144 $entry{description}
145 or $entry{description} = $entry{title};
146 $entry{body}
147 or $entry{body} = $entry{title};
148
149 my @cats;
150 for my $cat (@{$self->{cats}}) {
151 my $cell = $ws->get_cell($rownum, $cat-1);
152 my $value = $cell->value;
153 defined $value && $value =~ /\S/
154 and push @cats, $value;
155 }
156 $entry{parentid} = $self->_find_cat(\%cat_cache, $callback, $self->{parent}, @cats);
157 my $product;
158 if ($self->{codes}) {
159 $product = Products->getBy(product_code => $entry{product_code});
160 }
161 if ($product) {
162 @{$product}{keys %entry} = values %entry;
163 $product->save;
164 $callback
165 and $callback->("Updated $product->{id}: $entry{title}");
bf87e97c
TC
166 if ($self->{reset_images}) {
167 $product->remove_images($self->{cfg});
168 $callback
169 and $callback->(" $product->{id}: Reset images");
170 }
97469012
TC
171 }
172 else
173 {
174 $product = bse_make_product
175 (
176 cfg => $self->{cfg},
177 %entry
178 );
179 $callback
180 and $callback->("Added $product->{id}: $entry{title}");
181 }
bf87e97c
TC
182 for my $image_index (1 .. 10) {
183 my $file = $entry{"image${image_index}_file"};
184 $file
185 or next;
186 my $full_file = $self->_find_file($file);
187 $full_file
188 or die "File '$file' not found for image$image_index\n";
189
190 my %opts = ( file => $full_file );
191 for my $key (qw/alt name url storage/) {
192 my $fkey = "image${image_index}_$key";
193 $entry{$fkey}
194 and $opts{$key} = $entry{$fkey};
195 }
196
197 my %errors;
198 my $im = bse_add_image($self->{cfg}, $product, %opts,
199 errors => \%errors);
200 $im
201 or die join(", ",map "$_: $errors{$_}", keys %errors), "\n";
202 $callback
203 and $callback->(" $product->{id}: Add image '$file'");
204 }
97469012
TC
205 push @{$self->{products}}, $product;
206 };
207 if ($@) {
208 my $error = "Row ".($rownum+1).": $@";
209 $error =~ s/\n\z//;
210 $error =~ tr/\n/ /s;
211 push @{$self->{errors}}, $error;
212 $callback
213 and $callback->("Error: $error");
214 }
215 }
216}
217
218sub _find_cat {
219 my ($self, $cache, $callback, $parent, @cats) = @_;
220
221 @cats
222 or return $parent;
223 unless ($cache->{$parent}) {
224 my @kids = grep $_->{generator} eq 'Generate::Catalog',
225 Articles->children($parent);
226 $cache->{$parent} = \@kids;
227 }
228
229 my $title = shift @cats;
230 my ($cat) = grep $_->{title} eq $title, @{$cache->{$parent}};
231 unless ($cat) {
232 my %opts =
233 (
234 cfg => $self->{cfg},
235 parentid => $parent,
236 title => $title,
237 body => $title,
238 );
239 $self->{catalog_template}
240 and $opts{template} = $self->{catalog_template};
241 $cat = bse_make_catalog(%opts);
242 $callback
243 and $callback->("Add catalog $cat->{id}: $title");
244 push @{$cache->{$parent}}, $cat;
245 }
246
247 unless ($self->{catseen}{$cat->{id}}) {
248 $self->{catseen}{$cat->{id}} = 1;
249 push @{$self->{catalogs}}, $cat;
250 }
251
252 return $self->_find_cat($cache, $callback, $cat->{id}, @cats);
253}
254
255sub errors {
256 $_[0]{errors}
257 and return @{$_[0]{errors}};
258
259 return;
260}
261
262sub products {
263 $_[0]{products}
264 and return @{$_[0]{products}};
265
266 return;
267}
268
269sub catalogs {
270 $_[0]{catalogs} or return;
271
272 return @{$_[0]{catalogs}};
273}
274
bf87e97c
TC
275sub _find_file {
276 my ($self, $file) = @_;
277
278 for my $path (@{$self->{file_path}}) {
279 my $full = "$path/$file";
280 -f $full and return $full;
281 }
282
283 return;
284}
285
97469012 2861;