perform loaddata.pl updates in a transaction per table, to speed it up
[bse.git] / site / cgi-bin / modules / BSE / ProductImportXLS.pm
1 package BSE::ProductImportXLS;
2 use strict;
3 use Spreadsheet::ParseExcel;
4 use BSE::API qw(bse_make_product bse_make_catalog bse_add_image);
5 use BSE::TB::Articles;
6 use BSE::TB::Products;
7 use Config;
8
9 our $VERSION = "1.003";
10
11 sub new {
12   my ($class, $cfg, $profile, %opts) = @_;
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);
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   }
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   }
46   my %set;
47   for my $set (grep /^set_\w+$/, keys %ids) {
48     (my $out = $set) =~ s/^set_//;
49     $set{$out} = $ids{$set};
50   }
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";
56     my $code = "sub { (local \$_, my \$product) = \@_; \n".$ids{$xform}."\n; return \$_ }";
57     my $sub = eval $code;
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,
79      set => \%set,
80      sheet => $sheet,
81      skiprows => $skiprows,
82      codes => $use_codes,
83      cats => \@cats,
84      parent => $parent,
85      price_dollar => $price_dollar,
86      reset_images => $reset_images,
87      cfg => $cfg,
88      file_path => \@file_path,
89      product_template => scalar($cfg->entry($section, 'product_template')),
90      catalog_template => scalar($cfg->entry($section, 'catalog_template')),
91     }, $class;
92 }
93
94 sub profiles {
95   my ($class, $cfg) = @_;
96
97   my %ids = $cfg->entries("xls product imports");
98   return \%ids;
99 }
100
101 sub 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 {
120       my %entry = %{$self->{set}};
121
122       $self->{product_template}
123         and $entry{template} = $self->{product_template};
124
125       # load from mapping
126       my $non_blank = 0;
127       for my $col (keys %{$self->{map}}) {
128         my $cell = $ws->get_cell($rownum, $self->{map}{$col}-1);
129         if (defined $cell) {
130           $entry{$col} = $cell->value;
131         }
132         else {
133           $entry{$col} = '';
134         }
135         $non_blank ||= $entry{$col} =~ /\S/;
136       }
137       $non_blank
138         or return;
139       for my $col (keys %{$self->{xform}}) {
140         $entry{$col} = $self->{xform}{$col}->($entry{$col}, \%entry);
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
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";
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);
171         my $value;
172         defined $cell and
173           $value = $cell->value;
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}) {
180         $product = BSE::TB::Products->getBy(product_code => $entry{product_code});
181       }
182       if ($product) {
183         @{$product}{keys %entry} = values %entry;
184         $product->save;
185         $callback
186           and $callback->("Updated $product->{id}: $entry{title}");
187         if ($self->{reset_images}) {
188           $product->remove_images($self->{cfg});
189           $callback
190             and $callback->(" $product->{id}: Reset images");
191         }
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       }
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       }
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
239 sub _find_cat {
240   my ($self, $cache, $callback, $parent, @cats) = @_;
241
242   @cats
243     or return $parent;
244   unless ($cache->{$parent}) {
245     my @kids = grep $_->{generator} eq 'BSE::Generate::Catalog', 
246       BSE::TB::Articles->children($parent);
247     $cache->{$parent} = \@kids;
248   }
249
250   my $title = shift @cats;
251   my ($cat) = grep lc $_->{title} eq lc $title, @{$cache->{$parent}};
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
276 sub errors {
277   $_[0]{errors}
278     and return @{$_[0]{errors}};
279
280   return;
281 }
282
283 sub products {
284   $_[0]{products}
285     and return @{$_[0]{products}};
286
287   return;
288 }
289
290 sub catalogs {
291   $_[0]{catalogs} or return;
292
293   return @{$_[0]{catalogs}};
294 }
295
296 sub _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
307 1;