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