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