update the xls importer:
[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 Articles;
6 use Products;
7 use Config;
8
9 sub new {
10   my ($class, $cfg, $profile, %opts) = @_;
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);
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   }
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   }
44   my %set;
45   for my $set (grep /^set_\w+$/, keys %ids) {
46     (my $out = $set) =~ s/^set_//;
47     $set{$out} = $ids{$set};
48   }
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";
54     my $code = "sub { (local \$_, my \$product) = \@_; \n".$ids{$xform}."\n; return \$_ }";
55     my $sub = eval $code;
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,
77      set => \%set,
78      sheet => $sheet,
79      skiprows => $skiprows,
80      codes => $use_codes,
81      cats => \@cats,
82      parent => $parent,
83      price_dollar => $price_dollar,
84      reset_images => $reset_images,
85      cfg => $cfg,
86      file_path => \@file_path,
87      product_template => scalar($cfg->entry($section, 'product_template')),
88      catalog_template => scalar($cfg->entry($section, 'catalog_template')),
89     }, $class;
90 }
91
92 sub profiles {
93   my ($class, $cfg) = @_;
94
95   my %ids = $cfg->entries("xls product imports");
96   return \%ids;
97 }
98
99 sub 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 {
118       my %entry = %{$self->{set}};
119
120       $self->{product_template}
121         and $entry{template} = $self->{product_template};
122
123       # load from mapping
124       my $non_blank = 0;
125       for my $col (keys %{$self->{map}}) {
126         my $cell = $ws->get_cell($rownum, $self->{map}{$col}-1);
127         if (defined $cell) {
128           $entry{$col} = $cell->value;
129         }
130         else {
131           $entry{$col} = '';
132         }
133         $non_blank ||= $entry{$col} =~ /\S/;
134       }
135       $non_blank
136         or return;
137       for my $col (keys %{$self->{xform}}) {
138         $entry{$col} = $self->{xform}{$col}->($entry{$col}, \%entry);
139       }
140       $entry{title} =~ /\S/
141         or die "title blank\n";
142       if ($self->{codes}) {
143         $entry{product_code} =~ /\S/
144           or die "product_code blank with use_codes\n";
145       }
146       $entry{retailPrice} =~ s/\$//; # in case
147
148       if ($entry{retailPrice} =~ /\d/) {
149         $self->{price_dollar}
150           and $entry{retailPrice} *= 100;
151       }
152       else {
153         $callback
154           and $callback->("Row $rownum: Warning: no price");
155         $entry{retailPrice} = 0;
156       }
157       $entry{title} =~ /\n/
158         and die "Title may not contain newlines";
159       $entry{summary}
160         or $entry{summary} = $entry{title};
161       $entry{description}
162         or $entry{description} = $entry{title};
163       $entry{body}
164         or $entry{body} = $entry{title};
165
166       my @cats;
167       for my $cat (@{$self->{cats}}) {
168         my $cell = $ws->get_cell($rownum, $cat-1);
169         my $value;
170         defined $cell and
171           $value = $cell->value;
172         defined $value && $value =~ /\S/
173           and push @cats, $value;
174       }
175       $entry{parentid} = $self->_find_cat(\%cat_cache, $callback, $self->{parent}, @cats);
176       my $product;
177       if ($self->{codes}) {
178         $product = Products->getBy(product_code => $entry{product_code});
179       }
180       if ($product) {
181         @{$product}{keys %entry} = values %entry;
182         $product->save;
183         $callback
184           and $callback->("Updated $product->{id}: $entry{title}");
185         if ($self->{reset_images}) {
186           $product->remove_images($self->{cfg});
187           $callback
188             and $callback->(" $product->{id}: Reset images");
189         }
190       }
191       else
192       {
193         $product = bse_make_product
194           (
195            cfg => $self->{cfg},
196            %entry
197           );
198         $callback
199           and $callback->("Added $product->{id}: $entry{title}");
200       }
201       for my $image_index (1 .. 10) {
202         my $file = $entry{"image${image_index}_file"};
203         $file
204           or next;
205         my $full_file = $self->_find_file($file);
206         $full_file
207           or die "File '$file' not found for image$image_index\n";
208
209         my %opts = ( file => $full_file );
210         for my $key (qw/alt name url storage/) {
211           my $fkey = "image${image_index}_$key";
212           $entry{$fkey}
213             and $opts{$key} = $entry{$fkey};
214         }
215
216         my %errors;
217         my $im = bse_add_image($self->{cfg}, $product, %opts, 
218                                errors => \%errors);
219         $im 
220           or die join(", ",map "$_: $errors{$_}", keys %errors), "\n";
221         $callback
222           and $callback->(" $product->{id}: Add image '$file'");
223       }
224       push @{$self->{products}}, $product;
225     };
226     if ($@) {
227       my $error = "Row ".($rownum+1).": $@";
228       $error =~ s/\n\z//;
229       $error =~ tr/\n/ /s;
230       push @{$self->{errors}}, $error;
231       $callback
232         and $callback->("Error: $error");
233     }
234   }
235 }
236
237 sub _find_cat {
238   my ($self, $cache, $callback, $parent, @cats) = @_;
239
240   @cats
241     or return $parent;
242   unless ($cache->{$parent}) {
243     my @kids = grep $_->{generator} eq 'Generate::Catalog', 
244       Articles->children($parent);
245     $cache->{$parent} = \@kids;
246   }
247
248   my $title = shift @cats;
249   my ($cat) = grep lc $_->{title} eq lc $title, @{$cache->{$parent}};
250   unless ($cat) {
251     my %opts =
252       (
253        cfg => $self->{cfg},
254        parentid => $parent,
255        title => $title,
256        body => $title,
257       );
258     $self->{catalog_template}
259       and $opts{template} = $self->{catalog_template};
260     $cat = bse_make_catalog(%opts);
261     $callback
262       and $callback->("Add catalog $cat->{id}: $title");
263     push @{$cache->{$parent}}, $cat;
264   }
265
266   unless ($self->{catseen}{$cat->{id}}) {
267     $self->{catseen}{$cat->{id}} = 1;
268     push @{$self->{catalogs}}, $cat;
269   }
270
271   return $self->_find_cat($cache, $callback, $cat->{id}, @cats);
272 }
273
274 sub errors {
275   $_[0]{errors}
276     and return @{$_[0]{errors}};
277
278   return;
279 }
280
281 sub products {
282   $_[0]{products}
283     and return @{$_[0]{products}};
284
285   return;
286 }
287
288 sub catalogs {
289   $_[0]{catalogs} or return;
290
291   return @{$_[0]{catalogs}};
292 }
293
294 sub _find_file {
295   my ($self, $file) = @_;
296
297   for my $path (@{$self->{file_path}}) {
298     my $full = "$path/$file";
299     -f $full and return $full;
300   }
301
302   return;
303 }
304
305 1;