import tool for xls sheets
[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);
5 use Articles;
6 use Products;
7
8 sub new {
9   my ($class, $cfg, $profile) = @_;
10
11   # field mapping
12   my $section = "xls import $profile";
13   my %ids = $cfg->entriesCS($section);
14   keys %ids
15     or die "No entries found for profile $profile\n";
16   
17   my $sheet = $cfg->entry($section, "sheet", 1);
18   my $skiprows = $cfg->entry($section, 'skiprows', 1);
19   my $use_codes = $cfg->entry($section, 'codes', 0);
20   my $parent = $cfg->entry($section, 'parent', 3);
21   my $price_dollar = $cfg->entry($section, 'price_dollar', 0);
22
23   my %map;
24   for my $map (grep /^map_\w+$/, keys %ids) {
25     (my $out = $map) =~ s/^map_//;
26     my $in = $ids{$map};
27     $in =~ /^\d+$/
28       or die "Mapping for $out not numeric\n";
29     $map{$out} = $in;
30   }
31   my %xform;
32   for my $xform (grep /^xform_\w+$/, keys %ids) {
33     (my $out = $xform) =~ s/^xform_//;
34     $map{$out}
35       or die "Xform for $out but no mapping\n";
36     my $code = 'sub { local ($_) = @_; '.$ids{$xform}.'; return $_ }';
37     my $sub;
38     eval {
39       $sub = eval $code;
40     };
41     $sub
42       or die "Compilation error for $xform code: $@\n";
43     $xform{$out} = $sub;
44   }
45   defined $map{title}
46     or die "No title mapping found\n";
47   defined $map{retailPrice}
48     or die "No retailPrice mapping found\n";
49   if ($use_codes && !defined $map{product_code}) {
50     die "No product_code mapping found with 'codes' enabled\n";
51   }
52   my @cats;
53   for my $cat (qw/cat1 cat2 cat3/) {
54     my $col = $ids{$cat};
55     $col and push @cats, $col;
56   }
57
58   return bless 
59     {
60      map => \%map,
61      xform => \%xform,
62      sheet => $sheet,
63      skiprows => $skiprows,
64      codes => $use_codes,
65      cats => \@cats,
66      parent => $parent,
67      price_dollar => $price_dollar,
68      cfg => $cfg,
69      product_template => scalar($cfg->entry($section, 'product_template')),
70      catalog_template => scalar($cfg->entry($section, 'catalog_template')),
71     }, $class;
72 }
73
74 sub profiles {
75   my ($class, $cfg) = @_;
76
77   my %ids = $cfg->entries("xls product imports");
78   return \%ids;
79 }
80
81 sub process {
82   my ($self, $filename, $callback) = @_;
83
84   $self->{catseen} = {};
85   $self->{catalogs} = [];
86   $self->{products} = [];
87   my $parser = Spreadsheet::ParseExcel->new;
88   my $wb = $parser->Parse($filename)
89     or die "Could not parse $filename";
90   $self->{sheet} <= $wb->{SheetCount}
91     or die "No enough worksheets in input\n";
92   my $ws = ($wb->worksheets)[$self->{sheet}-1]
93     or die "No worksheet found at $self->{sheet}\n";
94
95   my ($minrow, $maxrow) = $ws->RowRange;
96   my @errors;
97   my %cat_cache;
98   for my $rownum ($self->{skiprows} ... $maxrow) {
99     eval {
100       my %entry;
101
102       $self->{product_template}
103         and $entry{template} = $self->{product_template};
104
105       # load from mapping
106       for my $col (keys %{$self->{map}}) {
107         my $cell = $ws->get_cell($rownum, $self->{map}{$col}-1);
108         $entry{$col} = $cell->value;
109
110         if ($self->{xform}{$col}) {
111           $entry{$col} = $self->{xform}{$col}->($entry{$col});
112         }
113       }
114       $entry{title} =~ /\S/
115         or die "title blank\n";
116       if ($self->{codes}) {
117         $entry{product_code} =~ /\S/
118           or die "product_code blank with use_codes\n";
119       }
120       $entry{retailPrice} =~ s/\$//; # in case
121
122       $self->{price_dollar}
123         and $entry{retailPrice} *= 100;
124
125       $entry{summary}
126         or $entry{summary} = $entry{title};
127       $entry{description}
128         or $entry{description} = $entry{title};
129       $entry{body}
130         or $entry{body} = $entry{title};
131
132       my @cats;
133       for my $cat (@{$self->{cats}}) {
134         my $cell = $ws->get_cell($rownum, $cat-1);
135         my $value = $cell->value;
136         defined $value && $value =~ /\S/
137           and push @cats, $value;
138       }
139       $entry{parentid} = $self->_find_cat(\%cat_cache, $callback, $self->{parent}, @cats);
140       my $product;
141       if ($self->{codes}) {
142         $product = Products->getBy(product_code => $entry{product_code});
143       }
144       if ($product) {
145         @{$product}{keys %entry} = values %entry;
146         $product->save;
147         $callback
148           and $callback->("Updated $product->{id}: $entry{title}");
149       }
150       else
151       {
152         $product = bse_make_product
153           (
154            cfg => $self->{cfg},
155            %entry
156           );
157         $callback
158           and $callback->("Added $product->{id}: $entry{title}");
159       }
160       push @{$self->{products}}, $product;
161     };
162     if ($@) {
163       my $error = "Row ".($rownum+1).": $@";
164       $error =~ s/\n\z//;
165       $error =~ tr/\n/ /s;
166       push @{$self->{errors}}, $error;
167       $callback
168         and $callback->("Error: $error");
169     }
170   }
171 }
172
173 sub _find_cat {
174   my ($self, $cache, $callback, $parent, @cats) = @_;
175
176   @cats
177     or return $parent;
178   unless ($cache->{$parent}) {
179     my @kids = grep $_->{generator} eq 'Generate::Catalog', 
180       Articles->children($parent);
181     $cache->{$parent} = \@kids;
182   }
183
184   my $title = shift @cats;
185   my ($cat) = grep $_->{title} eq $title, @{$cache->{$parent}};
186   unless ($cat) {
187     my %opts =
188       (
189        cfg => $self->{cfg},
190        parentid => $parent,
191        title => $title,
192        body => $title,
193       );
194     $self->{catalog_template}
195       and $opts{template} = $self->{catalog_template};
196     $cat = bse_make_catalog(%opts);
197     $callback
198       and $callback->("Add catalog $cat->{id}: $title");
199     push @{$cache->{$parent}}, $cat;
200   }
201
202   unless ($self->{catseen}{$cat->{id}}) {
203     $self->{catseen}{$cat->{id}} = 1;
204     push @{$self->{catalogs}}, $cat;
205   }
206
207   return $self->_find_cat($cache, $callback, $cat->{id}, @cats);
208 }
209
210 sub errors {
211   $_[0]{errors}
212     and return @{$_[0]{errors}};
213
214   return;
215 }
216
217 sub products {
218   $_[0]{products}
219     and return @{$_[0]{products}};
220
221   return;
222 }
223
224 sub catalogs {
225   $_[0]{catalogs} or return;
226
227   return @{$_[0]{catalogs}};
228 }
229
230 1;