import tool for xls sheets
authorTony Cook <tony@develop-help.com>
Tue, 21 Apr 2009 13:36:59 +0000 (13:36 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Tue, 21 Apr 2009 13:36:59 +0000 (13:36 +0000)
MANIFEST
site/cgi-bin/modules/BSE/API.pm
site/cgi-bin/modules/BSE/Edit/Base.pm
site/cgi-bin/modules/BSE/ProductImportXLS.pm [new file with mode: 0644]
site/cgi-bin/modules/Generate.pm
site/util/bsexlsprod.pl [new file with mode: 0644]

index fe3e5c7..e77e2af 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -133,6 +133,7 @@ site/cgi-bin/modules/BSE/TB/Order.pm
 site/cgi-bin/modules/BSE/TB/Orders.pm
 site/cgi-bin/modules/BSE/TB/OrderItem.pm
 site/cgi-bin/modules/BSE/TB/OrderItems.pm
+site/cgi-bin/modules/BSE/ProductImportXLS.pm
 site/cgi-bin/modules/BSE/TB/Seminar.pm
 site/cgi-bin/modules/BSE/TB/SeminarBooking.pm
 site/cgi-bin/modules/BSE/TB/SeminarBookings.pm
@@ -555,6 +556,7 @@ site/templates/xbase.tmpl
 site/util/bseaddimages.pl
 site/util/bse_s3.pl
 site/util/bse_storage.pl
+site/util/bsexlsprod.pl
 site/util/gen.pl
 site/util/getpcode.pl  Example code
 site/util/initial.pl
index 0a48d1d..00bfddf 100644 (file)
@@ -5,7 +5,7 @@ use BSE::Util::SQL qw(sql_datetime now_sqldatetime);
 use BSE::Cfg;
 require Exporter;
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(bse_cfg bse_make_product bse_encoding);
+@EXPORT_OK = qw(bse_cfg bse_make_product bse_make_catalog bse_encoding);
 use Carp qw(confess);
 
 my %acticle_defaults =
@@ -60,6 +60,13 @@ my %product_defaults =
    product_code => '',
   );
 
+my %catalog_defaults =
+  (
+   template => 'catalog.tmpl',
+   parentid => 3,
+   generator => 'Generate::Catalog',
+  );
+
 sub _set_dynamic {
   my ($cfg, $article) = @_;
 
@@ -149,6 +156,55 @@ sub bse_make_product {
   return $product;
 }
 
+sub bse_make_catalog {
+  my (%opts) = @_;
+
+  my $cfg = delete $opts{cfg}
+    or die "cfg option missing";
+
+  require Articles;
+
+  defined $opts{title} && length $opts{title}
+    or confess "Missing title option\n";
+  defined $opts{body} && length $opts{body}
+    or confess "Missing body option\n";
+
+  $opts{summary} ||= $opts{title};
+  unless ($opts{displayOrder}) {
+    if ($order) {
+      my $now = time;
+      if ($now == $order) {
+       $order++;
+      }
+      else {
+       $order = $now;
+      }
+    }
+    else {
+      $order = time;
+    }
+    $opts{displayOrder} = $order;
+  }
+
+  %opts =
+    (
+     %acticle_defaults,
+     %catalog_defaults,
+     %opts
+    );
+
+  _set_dynamic($cfg, \%opts);
+
+  my @cols = Article->columns;
+  shift @cols;
+  my $catalog = Articles->add(@opts{@cols});
+
+  require BSE::Edit::Catalog;
+  _finalize_article($cfg, $catalog, 'BSE::Edit::Catalog');
+
+  return $catalog;
+}
+
 sub bse_encoding {
   my ($cfg) = @_;
 
index fa845e4..141fff5 100644 (file)
@@ -34,7 +34,14 @@ sub article_class {
   $editclass =~ s/^(?:BSE::)?Generate::/BSE::Edit::/;
   my $obj = _get_class($editclass, $cfg);
   if ($obj) {
-    $article = $obj->get_article($articles, $article);
+    my $work = $obj->get_article($articles, $article);
+    if ($work) {
+      $article = $work;
+    }
+    else {
+      # broken object
+      $obj = _get_class("BSE::Edit::Article", $cfg);
+    }
   }
   return ($obj, $article);
 }
diff --git a/site/cgi-bin/modules/BSE/ProductImportXLS.pm b/site/cgi-bin/modules/BSE/ProductImportXLS.pm
new file mode 100644 (file)
index 0000000..ddfe2c1
--- /dev/null
@@ -0,0 +1,230 @@
+package BSE::ProductImportXLS;
+use strict;
+use Spreadsheet::ParseExcel;
+use BSE::API qw(bse_make_product bse_make_catalog);
+use Articles;
+use Products;
+
+sub new {
+  my ($class, $cfg, $profile) = @_;
+
+  # field mapping
+  my $section = "xls import $profile";
+  my %ids = $cfg->entriesCS($section);
+  keys %ids
+    or die "No entries found for profile $profile\n";
+  
+  my $sheet = $cfg->entry($section, "sheet", 1);
+  my $skiprows = $cfg->entry($section, 'skiprows', 1);
+  my $use_codes = $cfg->entry($section, 'codes', 0);
+  my $parent = $cfg->entry($section, 'parent', 3);
+  my $price_dollar = $cfg->entry($section, 'price_dollar', 0);
+
+  my %map;
+  for my $map (grep /^map_\w+$/, keys %ids) {
+    (my $out = $map) =~ s/^map_//;
+    my $in = $ids{$map};
+    $in =~ /^\d+$/
+      or die "Mapping for $out not numeric\n";
+    $map{$out} = $in;
+  }
+  my %xform;
+  for my $xform (grep /^xform_\w+$/, keys %ids) {
+    (my $out = $xform) =~ s/^xform_//;
+    $map{$out}
+      or die "Xform for $out but no mapping\n";
+    my $code = 'sub { local ($_) = @_; '.$ids{$xform}.'; return $_ }';
+    my $sub;
+    eval {
+      $sub = eval $code;
+    };
+    $sub
+      or die "Compilation error for $xform code: $@\n";
+    $xform{$out} = $sub;
+  }
+  defined $map{title}
+    or die "No title mapping found\n";
+  defined $map{retailPrice}
+    or die "No retailPrice mapping found\n";
+  if ($use_codes && !defined $map{product_code}) {
+    die "No product_code mapping found with 'codes' enabled\n";
+  }
+  my @cats;
+  for my $cat (qw/cat1 cat2 cat3/) {
+    my $col = $ids{$cat};
+    $col and push @cats, $col;
+  }
+
+  return bless 
+    {
+     map => \%map,
+     xform => \%xform,
+     sheet => $sheet,
+     skiprows => $skiprows,
+     codes => $use_codes,
+     cats => \@cats,
+     parent => $parent,
+     price_dollar => $price_dollar,
+     cfg => $cfg,
+     product_template => scalar($cfg->entry($section, 'product_template')),
+     catalog_template => scalar($cfg->entry($section, 'catalog_template')),
+    }, $class;
+}
+
+sub profiles {
+  my ($class, $cfg) = @_;
+
+  my %ids = $cfg->entries("xls product imports");
+  return \%ids;
+}
+
+sub process {
+  my ($self, $filename, $callback) = @_;
+
+  $self->{catseen} = {};
+  $self->{catalogs} = [];
+  $self->{products} = [];
+  my $parser = Spreadsheet::ParseExcel->new;
+  my $wb = $parser->Parse($filename)
+    or die "Could not parse $filename";
+  $self->{sheet} <= $wb->{SheetCount}
+    or die "No enough worksheets in input\n";
+  my $ws = ($wb->worksheets)[$self->{sheet}-1]
+    or die "No worksheet found at $self->{sheet}\n";
+
+  my ($minrow, $maxrow) = $ws->RowRange;
+  my @errors;
+  my %cat_cache;
+  for my $rownum ($self->{skiprows} ... $maxrow) {
+    eval {
+      my %entry;
+
+      $self->{product_template}
+       and $entry{template} = $self->{product_template};
+
+      # load from mapping
+      for my $col (keys %{$self->{map}}) {
+       my $cell = $ws->get_cell($rownum, $self->{map}{$col}-1);
+       $entry{$col} = $cell->value;
+
+       if ($self->{xform}{$col}) {
+         $entry{$col} = $self->{xform}{$col}->($entry{$col});
+       }
+      }
+      $entry{title} =~ /\S/
+       or die "title blank\n";
+      if ($self->{codes}) {
+       $entry{product_code} =~ /\S/
+         or die "product_code blank with use_codes\n";
+      }
+      $entry{retailPrice} =~ s/\$//; # in case
+
+      $self->{price_dollar}
+       and $entry{retailPrice} *= 100;
+
+      $entry{summary}
+       or $entry{summary} = $entry{title};
+      $entry{description}
+       or $entry{description} = $entry{title};
+      $entry{body}
+       or $entry{body} = $entry{title};
+
+      my @cats;
+      for my $cat (@{$self->{cats}}) {
+       my $cell = $ws->get_cell($rownum, $cat-1);
+       my $value = $cell->value;
+       defined $value && $value =~ /\S/
+         and push @cats, $value;
+      }
+      $entry{parentid} = $self->_find_cat(\%cat_cache, $callback, $self->{parent}, @cats);
+      my $product;
+      if ($self->{codes}) {
+       $product = Products->getBy(product_code => $entry{product_code});
+      }
+      if ($product) {
+       @{$product}{keys %entry} = values %entry;
+       $product->save;
+       $callback
+         and $callback->("Updated $product->{id}: $entry{title}");
+      }
+      else
+      {
+       $product = bse_make_product
+         (
+          cfg => $self->{cfg},
+          %entry
+         );
+       $callback
+         and $callback->("Added $product->{id}: $entry{title}");
+      }
+      push @{$self->{products}}, $product;
+    };
+    if ($@) {
+      my $error = "Row ".($rownum+1).": $@";
+      $error =~ s/\n\z//;
+      $error =~ tr/\n/ /s;
+      push @{$self->{errors}}, $error;
+      $callback
+       and $callback->("Error: $error");
+    }
+  }
+}
+
+sub _find_cat {
+  my ($self, $cache, $callback, $parent, @cats) = @_;
+
+  @cats
+    or return $parent;
+  unless ($cache->{$parent}) {
+    my @kids = grep $_->{generator} eq 'Generate::Catalog', 
+      Articles->children($parent);
+    $cache->{$parent} = \@kids;
+  }
+
+  my $title = shift @cats;
+  my ($cat) = grep $_->{title} eq $title, @{$cache->{$parent}};
+  unless ($cat) {
+    my %opts =
+      (
+       cfg => $self->{cfg},
+       parentid => $parent,
+       title => $title,
+       body => $title,
+      );
+    $self->{catalog_template}
+      and $opts{template} = $self->{catalog_template};
+    $cat = bse_make_catalog(%opts);
+    $callback
+      and $callback->("Add catalog $cat->{id}: $title");
+    push @{$cache->{$parent}}, $cat;
+  }
+
+  unless ($self->{catseen}{$cat->{id}}) {
+    $self->{catseen}{$cat->{id}} = 1;
+    push @{$self->{catalogs}}, $cat;
+  }
+
+  return $self->_find_cat($cache, $callback, $cat->{id}, @cats);
+}
+
+sub errors {
+  $_[0]{errors}
+    and return @{$_[0]{errors}};
+
+  return;
+}
+
+sub products {
+  $_[0]{products}
+    and return @{$_[0]{products}};
+
+  return;
+}
+
+sub catalogs {
+  $_[0]{catalogs} or return;
+
+  return @{$_[0]{catalogs}};
+}
+
+1;
index c3dae5d..c564457 100644 (file)
@@ -923,7 +923,7 @@ sub baseActs {
      $art_it->make_iterator( \&iter_inlines, 'inline', 'inlines' ),
      gimage => 
      sub {
-       my ($args, $acts, $name, $templater) = @_;
+       my ($args, $acts, $func, $templater) = @_;
        my ($name, $align, @rest) = 
         DevHelp::Tags->get_parms($args, $acts, $templater);
        my $rest = "@rest";
diff --git a/site/util/bsexlsprod.pl b/site/util/bsexlsprod.pl
new file mode 100644 (file)
index 0000000..1917181
--- /dev/null
@@ -0,0 +1,62 @@
+#!perl -w
+use strict;
+use Getopt::Long;
+use FindBin;
+use lib "$FindBin::Bin/../cgi-bin/modules";
+use BSE::Cfg;
+use BSE::API qw(bse_cfg bse_make_product bse_encoding);
+use BSE::ProductImportXLS;
+use Carp qw(confess);
+
+chdir "$FindBin::Bin/../cgi-bin"
+  or warn "Could not change to cgi-bin directory: $!\n";
+
+my $verbose;
+my $delete;
+GetOptions("v", \$verbose,
+          "d", \$delete);
+$verbose = defined $verbose;
+
+my $cfg = bse_cfg();
+
+my $profile = shift;
+my $filename = shift
+  or die "Usage: $0 profile filename\n";
+
+my $importer = BSE::ProductImportXLS->new($cfg, $profile);
+
+my $callback;
+$verbose
+  and $callback = sub { print "@_\n" };
+
+$importer->process($filename, $callback);
+
+if ($delete) {
+  my @products = $importer->products;
+  my @catalogs = $importer->catalogs;
+  for my $product (@products) {
+    print "Removing product $product->{id}: $product->{title}\n";
+    $product->remove($cfg);
+  }
+  require BSE::Permissions;
+  my $perms = BSE::Permissions->new($cfg);
+  for my $catalog (reverse @catalogs) {
+    my $msg;
+    if ($perms->check_edit_delete_article({}, $catalog, '', \$msg)) {
+      print "Removing catalog $catalog->{id}: $catalog->{title}\n";
+      $catalog->remove($cfg);
+    }
+    else {
+      print "Cannot remove $catalog->{id}: $msg\n";
+    }
+  }
+}
+
+my @errors = $importer->errors;
+unless ($verbose) { # unless we already reported them
+  print STDERR $_, "\n" for @errors;
+}
+@errors
+  and exit 1;
+
+exit;