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 our $VERSION = "1.000";
  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 = 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       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;