fix error reporting for the transform code
[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 (\$_) = \@_; \n".$ids{$xform}."\n; return \$_ }";
37     my $sub = eval $code;
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
71 sub profiles {
72   my ($class, $cfg) = @_;
73
74   my %ids = $cfg->entries("xls product imports");
75   return \%ids;
76 }
77
78 sub 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
170 sub _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
207 sub errors {
208   $_[0]{errors}
209     and return @{$_[0]{errors}};
210
211   return;
212 }
213
214 sub products {
215   $_[0]{products}
216     and return @{$_[0]{products}};
217
218   return;
219 }
220
221 sub catalogs {
222   $_[0]{catalogs} or return;
223
224   return @{$_[0]{catalogs}};
225 }
226
227 1;