move Util.pm to BSE/Regen.pm
authorTony Cook <tony@develop-help.com>
Thu, 18 Aug 2011 03:40:18 +0000 (13:40 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 21 Sep 2011 06:19:04 +0000 (16:19 +1000)
MANIFEST
site/cgi-bin/admin/generate.pl
site/cgi-bin/admin/move.pl
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Regen.pm [new file with mode: 0644]
site/cgi-bin/modules/Generate/Article.pm
site/cgi-bin/modules/Generate/Catalog.pm
site/cgi-bin/modules/Util.pm [deleted file]
site/util/check_versions.pl
site/util/gen.pl

index 00f4a70..d24bd48 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -126,6 +126,7 @@ site/cgi-bin/modules/BSE/Passwords.pm
 site/cgi-bin/modules/BSE/PayPal.pm
 site/cgi-bin/modules/BSE/Permissions.pm
 site/cgi-bin/modules/BSE/ProductImportXLS.pm
+site/cgi-bin/modules/BSE/Regen.pm
 site/cgi-bin/modules/BSE/Report.pm
 site/cgi-bin/modules/BSE/Request.pm
 site/cgi-bin/modules/BSE/Request/Base.pm
@@ -322,7 +323,6 @@ site/cgi-bin/modules/Squirrel/PGP6.pm
 site/cgi-bin/modules/Squirrel/Row.pm
 site/cgi-bin/modules/Squirrel/Table.pm
 site/cgi-bin/modules/Squirrel/Template.pm
-site/cgi-bin/modules/Util.pm
 site/cgi-bin/nuser.fcgi
 site/cgi-bin/nuser.pl
 site/cgi-bin/page.fcgi
index 35707f5..f2d12f0 100755 (executable)
@@ -7,7 +7,7 @@ use lib "$FindBin::Bin/../modules";
 use Articles;
 use CGI qw(:standard);
 use Constants;
-use Util qw(generate_button regen_and_refresh);
+use BSE::Regen qw(generate_button regen_and_refresh generate_article);
 use BSE::WebUtil qw(refresh_to_admin);
 use Carp 'verbose';
 use BSE::Request;
@@ -46,7 +46,6 @@ if (generate_button()) {
     $callback = sub { print "<div>",escape_html($_[0]),"</div>" };
   }
   if (defined $id) {
-    use Util 'generate_article';
     my $article;
     my $can;
     if ($id eq 'extras') {
index 6b0907b..7273366 100755 (executable)
@@ -12,6 +12,7 @@ use CGI::Carp 'fatalsToBrowser';
 use BSE::Request;
 use Constants;
 use BSE::WebUtil qw/refresh_to refresh_to_admin/;
+use BSE::Regen 'generate_article';
 
 my $req = BSE::Request->new;
 
@@ -48,7 +49,6 @@ if (defined $cgi->param('stepchild')) {
       ($two->{childDisplayOrder}, $one->{childDisplayOrder});
     $one->save;
     $two->save;
-    use Util 'generate_article';
     generate_article('Articles', $article);
   }
 }
@@ -75,7 +75,6 @@ elsif (defined $cgi->param('stepparent')) {
     ($one->{$onename}, $two->{$twoname}) = ($two->{$twoname}, $one->{$onename});
     $one->save;
     $two->save;
-    use Util 'generate_article';
     generate_article('Articles', $article);
   }
 }
@@ -134,7 +133,6 @@ else {
     }
     
     $article->save();
-    use Util 'generate_article';
     generate_article('Articles', $article);
   }
 }
index 8c3147a..f59f685 100644 (file)
@@ -10,11 +10,12 @@ use BSE::CfgInfo qw(custom_class admin_base_url cfg_image_dir);
 use BSE::Util::Iterate;
 use BSE::Template;
 use BSE::Util::ContentType qw(content_type);
+use BSE::Regen 'generate_article';
 use DevHelp::Date qw(dh_parse_date dh_parse_sql_date);
 use List::Util qw(first);
 use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
 
-our $VERSION = "1.011";
+our $VERSION = "1.012";
 
 =head1 NAME
 
@@ -1772,7 +1773,6 @@ sub save_new {
     $article->set_tags(\@tags, \$error);
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   if ($req->is_ajax) {
@@ -2054,7 +2054,6 @@ sub save {
     $article = $articles->getByPkey($article->{id});
   }
 
-  use Util 'generate_article';
   if ($Constants::AUTO_GENERATE) {
     generate_article($articles, $article);
     for my $regen_id (@extra_regen) {
@@ -2397,7 +2396,6 @@ sub add_stepkid {
     Articles->reorder_child($article->id, $child->id, $after_id);
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   if ($req->is_ajax) {
@@ -2478,7 +2476,6 @@ sub del_stepkid {
   if ($@) {
     return $self->_service_error($req, $article, $articles, $@, {}, "DELETE");
   }
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   if ($req->is_ajax) {
@@ -2528,7 +2525,6 @@ sub save_stepkids {
     };
     $@ and return $self->refresh($article, $cgi, '', $@);
   }
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
@@ -2682,7 +2678,6 @@ sub add_stepparent {
   };
   $@ and return $self->refresh($article, $cgi, 'step', $@);
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
@@ -2719,7 +2714,6 @@ sub del_stepparent {
   };
   $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
@@ -2765,7 +2759,6 @@ sub save_stepparents {
     $@ and return $self->refresh($article, $cgi, '', $@);
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   return $self->refresh($article, $cgi, 'stepparents', 
@@ -3007,7 +3000,6 @@ sub save_image_changes {
   }
   
   if ($changes_found) {
-    use Util 'generate_article';
     generate_article($articles, $article) if $Constants::AUTO_GENERATE;
   }
     
@@ -3290,7 +3282,6 @@ sub add_image {
   $errors{flash}
     and $req->flash($errors{flash});
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   if ($cgi->param('_service')) {
@@ -3358,7 +3349,6 @@ sub remove_img {
   unlink "$imagedir$image->{image}";
   $image->remove;
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   if ($req->want_json_response) {
@@ -3392,7 +3382,6 @@ sub move_img_up {
   $to->save;
   $from->save;
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   return $self->refresh($article, $req->cgi, undef, 'Image moved');
@@ -3419,7 +3408,6 @@ sub move_img_down {
   $to->save;
   $from->save;
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   return $self->refresh($article, $req->cgi, undef, 'Image moved');
@@ -3885,7 +3873,6 @@ sub fileadd {
   $@
     and $req->flash($@);
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   $self->_refresh_filelist($req, $article);
@@ -3919,7 +3906,6 @@ sub fileswap {
     }
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   $self->refresh($article, $req->cgi, undef, 'File moved');
@@ -3951,7 +3937,6 @@ sub filedel {
     }
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   $self->_refresh_filelist($req, $article, 'File deleted');
@@ -4128,7 +4113,6 @@ sub filesave {
     $file->save;
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   $self->_refresh_filelist($req, $article);
@@ -4567,7 +4551,6 @@ sub req_save_file {
     unlink "$download_path/$old_name";
   }
 
-  use Util 'generate_article';
   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
 
   $self->_refresh_filelist($req, $article);
@@ -4675,7 +4658,6 @@ sub unhide {
     $article->{listed} = 1;
     $article->save;
 
-    use Util 'generate_article';
     generate_article($articles, $article) if $Constants::AUTO_GENERATE;
   }
   return $self->refresh($article, $req->cgi, undef, 'Article unhidden');
@@ -4692,7 +4674,6 @@ sub hide {
     $article->{listed} = 0;
     $article->save;
 
-    use Util 'generate_article';
     generate_article($articles, $article) if $Constants::AUTO_GENERATE;
   }
   my $r = $req->cgi->param('r');
diff --git a/site/cgi-bin/modules/BSE/Regen.pm b/site/cgi-bin/modules/BSE/Regen.pm
new file mode 100644 (file)
index 0000000..abe432f
--- /dev/null
@@ -0,0 +1,369 @@
+package BSE::Regen;
+use strict;
+use vars qw(@ISA @EXPORT_OK);
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(generate_article generate_all generate_button 
+                regen_and_refresh);
+use Constants qw($GENERATE_BUTTON $SHOPID $AUTO_GENERATE);
+use Carp qw(confess);
+use BSE::WebUtil qw(refresh_to_admin);
+use BSE::Util::HTML;
+
+our $VERSION = "1.001";
+
+# returns non-zero if the Regenerate button should work
+sub generate_button {
+  if ($GENERATE_BUTTON) {
+    if (my $ref = ref $GENERATE_BUTTON) {
+      if ($ref eq 'CODE') {
+       return $GENERATE_BUTTON->();
+      }
+      else {
+       # assumed to be an object
+       return $GENERATE_BUTTON->want_button();
+      }
+    }
+    else {
+      return 1;
+    }
+  }
+  return 0;
+}
+
+# regenerate an individual article
+sub generate_low {
+  my ($articles, $article, $cfg) = @_;
+
+  $cfg ||= BSE::Cfg->single;
+
+  my $outname;
+  if ($article->is_dynamic) {
+    my $debug_jit = $cfg->entry('debug', 'jit_dynamic_regen');
+    $outname = $article->cached_filename($cfg);
+    if ($article->{flags} !~ /R/ && 
+       $cfg->entry('basic', 'jit_dynamic_pregen')) {
+      $debug_jit and print STDERR "JIT: $article->{id} - deleting $outname\n";
+      # just delete the file, page.pl will make it if needed
+      unlink $outname;
+      return;
+    }
+  }
+  else {
+    $outname = $article->link_to_filename($cfg)
+      or return; # no output for this article 
+  }
+
+  if ($article->flags =~ /P/ && $article->{parentid} != -1) {
+    # link to parent, remove the file
+    unlink $outname;
+    return;
+  }
+
+  my $genname = $article->{generator};
+  eval "use $genname";
+  $@ && die $@;
+  my $gen = $genname->new(articles=>$articles, cfg=>$cfg, top=>$article);
+
+  my $content = $gen->generate($article, $articles);
+  my $tempname = $outname . ".work";
+  unlink $tempname;
+  _write_text($tempname, $content, $cfg);
+  unlink $outname;
+  rename($tempname, $outname)
+    or die "Cannot rename $tempname to $outname: $!";
+}
+
+sub generate_article {
+  my ($articles, $article, $cfg) = @_;
+
+  while ($article) {
+    generate_low($articles, $article, $cfg) 
+      if $article->{link} && $article->{template};
+
+    if ($article->{parentid} != -1) {
+      $article = $articles->getByPkey($article->{parentid});
+    }
+    else {
+      undef $article;
+    }
+  }
+}
+
+# generates search.tmpl from search_base.tmpl
+sub generate_search {
+  my ($articles, $cfg) = @_;
+
+  $cfg ||= BSE::Cfg->single;
+
+  # build a dummy article
+  use Constants qw($SEARCH_TITLE $SEARCH_TITLE_IMAGE $CGI_URI);
+  my %article = map { $_, '' } Article->columns;
+  @article{qw(id parentid title titleImage displayOrder link level listed force_dynamic)} =
+    (-4, -1, $SEARCH_TITLE, $SEARCH_TITLE_IMAGE, 0, $CGI_URI."/search.pl", 0, 1, 1);
+
+  $article{link} = $cfg->entryErr('site', 'url') . $article{link};
+  require 'Generate/Article.pm';
+  my $gen = Generate::Article->new(cfg=>$cfg, top => \%article, 
+                                  force_dynamic => 1);
+
+  my %acts;
+  %acts = $gen->baseActs($articles, \%acts, \%article);
+  my $content = BSE::Template->get_page('search_base', $cfg, \%acts);
+  my $tmpldir = $cfg->entryVar('paths', 'templates');
+  my $outname = "$tmpldir/search.tmpl.work";
+  my $finalname = "$tmpldir/search.tmpl";
+  _write_text($outname, $content, $cfg);
+  rename $outname, $finalname
+    or die "Cannot rename $outname to $finalname: $!";
+}
+
+sub generate_shop {
+  my ($articles, $cfg) = @_;
+  my @pages =
+    (
+     'cart', 'checkoutnew', 'checkoutfinal', 'checkoutcard', 'checkoutconfirm',
+     'checkoutpay',
+    );
+  require 'Generate/Article.pm';
+  my $shop_base = $articles->getByPkey($SHOPID);
+  my $shop = { map { $_ => $shop_base->{$_} } $shop_base->columns };
+  $shop->{link} =~ /^\w+:/
+    or $shop->{link} = $cfg->entryErr('site', 'url') . $shop->{link};
+  $shop->{id} = -3; # some random negative number
+  my $gen = Generate::Article->new(cfg=>$cfg, top=>$shop, force_dynamic => 1);
+  for my $name (@pages) {
+    my %acts;
+    %acts = $gen->baseActs($articles, \%acts, $shop);
+    # different url behaviour - point the user at the http version
+    # of the site if the url contains no scheme
+    my $oldurl = $acts{url};
+    $acts{url} =
+      sub {
+        my $value = $oldurl->(@_);
+       $value =~ /^<:/ and return $value;
+        unless ($value =~ /^\w+:/) {
+          # put in the base site url
+          $value = $cfg->entryErr('site', 'url').$value;
+        }
+        return $value;
+      };
+    my $content = BSE::Template->get_page("${name}_base", $cfg, \%acts);
+    my $tmpldir = $cfg->entryVar('paths', 'templates');
+    my $outname = "$tmpldir/$name.tmpl.work";
+    my $finalname = "$tmpldir/$name.tmpl";
+    _write_text($outname, $content, $cfg);
+    unlink $finalname;
+    rename $outname, $finalname
+      or die "Cannot rename $outname to $finalname: $!";
+  }
+}
+
+sub generate_extras {
+  my ($articles, $cfg, $callback) = @_;
+
+  use BSE::Cfg;
+  $cfg ||= BSE::Cfg->new;
+  my $template_dir = $cfg->entryVar('paths', 'templates');
+
+  open EXTRAS, "$template_dir/extras.txt"
+    or return;
+  my @extras;
+  while (<EXTRAS>) {
+    chomp;
+    next if /^\s*#/;
+    if (/^(\S+)\s+(\S+)/) {
+      push(@extras, [ $1, $2 ]);
+    }
+  }
+  close EXTRAS;
+
+  my %entries = $cfg->entries('pregenerate');
+  for my $extra (@extras) {
+    my ($in, $out) = @$extra;
+    $entries{$out} = 'extras,' . $in;
+  }
+  if (keys %entries) {
+    require 'Generate/Article.pm';
+    for my $out (keys %entries) {
+      my ($presets, $input) = split ',', $entries{$out}, 2;
+      my $section = "$presets settings";
+      $callback->("$input to $out with $presets") if $callback;
+      my %article = map { $_, '' } Article->columns;
+      $article{displayOrder} = 1;
+      $article{id} = -5;
+      $article{parentid} = -1;
+      $article{link} = $cfg->entryErr('site', 'url');
+      for my $field (Article->columns) {
+       if ($cfg->entry($section, $field)) {
+         $article{$field} = $cfg->entryVar($section, $field);
+       }
+      }
+      # by default all of these are handled as dynamic, but it can be 
+      # overidden, eg. the error template
+      my $is_extras = $presets eq 'extras';
+      my $dynamic = $cfg->entry($section, 'dynamic', !$is_extras);
+      my $outpath = $cfg->entry($section, 'content', $is_extras) ? 
+       $cfg->content_base_path : $template_dir;
+      my %acts;
+      my $gen = Generate::Article->new(cfg=>$cfg, top=>\%article, 
+                                      force_dynamic => $dynamic);
+      %acts = $gen->baseActs($articles, \%acts, \%article);
+      my $oldurl = $acts{url};
+      $acts{url} =
+       sub {
+         my $value = $oldurl->(@_);
+         $value =~ /^<:/ and return $value;
+         unless ($value =~ /^\w+:/) {
+           # put in the base site url
+           $value = $cfg->entryErr('site', 'url').$value;
+         }
+         return $value;
+       };
+      my $content = BSE::Template->get_page($input, $cfg, \%acts);
+      my $finalname = $outpath . '/'. $out;
+      my $outname = $finalname . '.work';
+      _write_text($outname, $content, $cfg);
+      unlink $finalname;
+      rename $outname, $finalname
+       or die "Cannot rename $outname to $finalname: $!";
+    }
+  }
+}
+
+sub generate_all {
+  my ($articles, $cfg, $callback) = @_;
+
+  my @articleids = $articles->allids;
+  my $pc = 0;
+  $callback->("Generating articles (".scalar(@articleids)." to do)")
+    if $callback;
+  my $index;
+  my $total = 0;
+  Squirrel::Table->caching(1);
+  my $allstart = time;
+  for my $articleid (@articleids) {
+    my $article = $articles->getByPkey($articleid);
+    ++$index;
+    if ($article->{link} && $article->{template}) {
+      #$callback->("Article $articleid");
+      generate_low($articles, $article, $cfg);
+    }
+    my $newpc = $index / @articleids * 100;
+    my $now = time;
+    if ($callback && $newpc >= $pc + 1 || abs($newpc-100) < 0.01) {
+      $callback->(sprintf("%5d:  %.1f%% done - elapsed: %.1f", $articleid, $newpc, $now - $allstart)) if $callback;
+      $pc = int $newpc;
+    }
+  }
+
+  $callback->("Generating search base") if $callback;
+  generate_search($articles, $cfg);
+
+  $callback->("Generating shop base pages") if $callback;
+  generate_shop($articles, $cfg);
+
+  $callback->("Generating extra pages") if $callback;
+  generate_extras($articles, $cfg, $callback);
+
+  $callback->("Total of ".(time()-$allstart)." seconds") if $callback;
+}
+
+=item regen_and_refresh($articles, $article, $generate, $refreshto, $cfg, $progress)
+
+An error checking wrapper around the page regeneration code.
+
+In some cases IIS appears to lock the static pages, which was causing
+various problems.  Here we catch the error and let the user know what
+is going on.
+
+If $article is set to undef then everything is regenerated.
+
+$cfg should be an initialized BSE::Cfg object
+
+$progress should be either missing, undef or a code reference.
+
+$generate is typically 1 or $AUTO_GENERATE
+
+Returns 1 if the regeneration was performed successfully.
+
+=cut
+
+sub regen_and_refresh {
+  my ($articles, $article, $generate, $refreshto, $cfg, $progress) = @_;
+
+  if ($generate) {
+    eval {
+      if ($article) {
+       if ($article eq 'extras') {
+         $progress->("Generating search base") if $progress;
+         generate_search($articles, $cfg);
+         
+         $progress->("Generating shop base pages") if $progress  ;
+         generate_shop($articles, $cfg);
+         
+         $progress->("Generating extra pages") if $progress;
+         generate_extras($articles, $cfg, $progress);
+       }
+       else {
+         generate_article($articles, $article, $cfg);
+       }
+      }
+      else {
+       generate_all($articles, $cfg, $progress);
+      }
+    };
+    if ($@) {
+      if ($progress) {
+       $progress->($@);
+      }
+      else {
+       my $error = $@;
+       require 'BSE/Util/Tags.pm';
+       require 'BSE/Template.pm';
+       my %acts;
+       %acts =
+         (
+          BSE::Util::Tags->basic(\%acts, undef, $cfg),
+          ifArticle => sub { $article },
+          article => 
+          sub { 
+            if (ref $article) {
+              return escape_html($article->{$_[0]});
+            }
+            else {
+              return 'extras';
+            }
+          },
+          error => sub { escape_html($error) },
+         );
+       BSE::Template->show_page('admin/regenerror', $cfg, \%acts);
+       
+       return 0;
+      }
+    }
+  }
+
+  unless ($progress) {
+    refresh_to_admin($cfg, $refreshto);
+  }
+
+  return 1;
+}
+
+sub _write_text {
+  my ($filename, $data, $cfg) = @_;
+
+  open my $fh, ">", $filename
+    or die "Cannot create $filename: $!";
+  if ($cfg->utf8) {
+    my $charset = $cfg->charset;
+    binmode $fh,  ":encoding($charset)";
+  }
+  print $fh $data
+    or die "Cannot write $filename: $!";
+  close $fh
+    or die "Cannot close $filename: $!";
+}
+
+1;
index 6429eee..fcf4536 100644 (file)
@@ -6,7 +6,7 @@ use Constants qw(%LEVEL_DEFAULTS $CGI_URI $ADMIN_URI $IMAGES_URI
 use BSE::TB::Images;
 use vars qw(@ISA);
 use Generate;
-use Util qw(generate_button);
+use BSE::Regen qw(generate_button);
 use BSE::Util::Tags qw(tag_article);
 use BSE::TB::ArticleFiles;
 @ISA = qw/Generate/;
@@ -15,7 +15,7 @@ use BSE::Arrows;
 use Carp 'confess';
 use BSE::Util::Iterate;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 my $excerptSize = 300;
 
index abd24f0..7ad1e7a 100644 (file)
@@ -1,6 +1,6 @@
 package Generate::Catalog;
 
-our $VERSION = "1.000";
+our $VERSION = "1.001";
 
 use strict;
 use Generate;
@@ -8,7 +8,7 @@ use Products;
 use base 'Generate::Article';
 use BSE::Template;
 use Constants qw($CGI_URI $IMAGES_URI $ADMIN_URI);
-use Util qw(generate_button);
+use BSE::Regen qw(generate_button);
 use OtherParents;
 use DevHelp::HTML;
 use BSE::Arrows;
diff --git a/site/cgi-bin/modules/Util.pm b/site/cgi-bin/modules/Util.pm
deleted file mode 100644 (file)
index 1bc5c25..0000000
+++ /dev/null
@@ -1,369 +0,0 @@
-package Util;
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(generate_article generate_all generate_button 
-                regen_and_refresh);
-use Constants qw($GENERATE_BUTTON $SHOPID $AUTO_GENERATE);
-use Carp qw(confess);
-use BSE::WebUtil qw(refresh_to_admin);
-use BSE::Util::HTML;
-
-our $VERSION = "1.001";
-
-# returns non-zero if the Regenerate button should work
-sub generate_button {
-  if ($GENERATE_BUTTON) {
-    if (my $ref = ref $GENERATE_BUTTON) {
-      if ($ref eq 'CODE') {
-       return $GENERATE_BUTTON->();
-      }
-      else {
-       # assumed to be an object
-       return $GENERATE_BUTTON->want_button();
-      }
-    }
-    else {
-      return 1;
-    }
-  }
-  return 0;
-}
-
-# regenerate an individual article
-sub generate_low {
-  my ($articles, $article, $cfg) = @_;
-
-  $cfg ||= BSE::Cfg->single;
-
-  my $outname;
-  if ($article->is_dynamic) {
-    my $debug_jit = $cfg->entry('debug', 'jit_dynamic_regen');
-    $outname = $article->cached_filename($cfg);
-    if ($article->{flags} !~ /R/ && 
-       $cfg->entry('basic', 'jit_dynamic_pregen')) {
-      $debug_jit and print STDERR "JIT: $article->{id} - deleting $outname\n";
-      # just delete the file, page.pl will make it if needed
-      unlink $outname;
-      return;
-    }
-  }
-  else {
-    $outname = $article->link_to_filename($cfg)
-      or return; # no output for this article 
-  }
-
-  if ($article->flags =~ /P/ && $article->{parentid} != -1) {
-    # link to parent, remove the file
-    unlink $outname;
-    return;
-  }
-
-  my $genname = $article->{generator};
-  eval "use $genname";
-  $@ && die $@;
-  my $gen = $genname->new(articles=>$articles, cfg=>$cfg, top=>$article);
-
-  my $content = $gen->generate($article, $articles);
-  my $tempname = $outname . ".work";
-  unlink $tempname;
-  _write_text($tempname, $content, $cfg);
-  unlink $outname;
-  rename($tempname, $outname)
-    or die "Cannot rename $tempname to $outname: $!";
-}
-
-sub generate_article {
-  my ($articles, $article, $cfg) = @_;
-
-  while ($article) {
-    generate_low($articles, $article, $cfg) 
-      if $article->{link} && $article->{template};
-
-    if ($article->{parentid} != -1) {
-      $article = $articles->getByPkey($article->{parentid});
-    }
-    else {
-      undef $article;
-    }
-  }
-}
-
-# generates search.tmpl from search_base.tmpl
-sub generate_search {
-  my ($articles, $cfg) = @_;
-
-  $cfg ||= BSE::Cfg->single;
-
-  # build a dummy article
-  use Constants qw($SEARCH_TITLE $SEARCH_TITLE_IMAGE $CGI_URI);
-  my %article = map { $_, '' } Article->columns;
-  @article{qw(id parentid title titleImage displayOrder link level listed force_dynamic)} =
-    (-4, -1, $SEARCH_TITLE, $SEARCH_TITLE_IMAGE, 0, $CGI_URI."/search.pl", 0, 1, 1);
-
-  $article{link} = $cfg->entryErr('site', 'url') . $article{link};
-  require 'Generate/Article.pm';
-  my $gen = Generate::Article->new(cfg=>$cfg, top => \%article, 
-                                  force_dynamic => 1);
-
-  my %acts;
-  %acts = $gen->baseActs($articles, \%acts, \%article);
-  my $content = BSE::Template->get_page('search_base', $cfg, \%acts);
-  my $tmpldir = $cfg->entryVar('paths', 'templates');
-  my $outname = "$tmpldir/search.tmpl.work";
-  my $finalname = "$tmpldir/search.tmpl";
-  _write_text($outname, $content, $cfg);
-  rename $outname, $finalname
-    or die "Cannot rename $outname to $finalname: $!";
-}
-
-sub generate_shop {
-  my ($articles, $cfg) = @_;
-  my @pages =
-    (
-     'cart', 'checkoutnew', 'checkoutfinal', 'checkoutcard', 'checkoutconfirm',
-     'checkoutpay',
-    );
-  require 'Generate/Article.pm';
-  my $shop_base = $articles->getByPkey($SHOPID);
-  my $shop = { map { $_ => $shop_base->{$_} } $shop_base->columns };
-  $shop->{link} =~ /^\w+:/
-    or $shop->{link} = $cfg->entryErr('site', 'url') . $shop->{link};
-  $shop->{id} = -3; # some random negative number
-  my $gen = Generate::Article->new(cfg=>$cfg, top=>$shop, force_dynamic => 1);
-  for my $name (@pages) {
-    my %acts;
-    %acts = $gen->baseActs($articles, \%acts, $shop);
-    # different url behaviour - point the user at the http version
-    # of the site if the url contains no scheme
-    my $oldurl = $acts{url};
-    $acts{url} =
-      sub {
-        my $value = $oldurl->(@_);
-       $value =~ /^<:/ and return $value;
-        unless ($value =~ /^\w+:/) {
-          # put in the base site url
-          $value = $cfg->entryErr('site', 'url').$value;
-        }
-        return $value;
-      };
-    my $content = BSE::Template->get_page("${name}_base", $cfg, \%acts);
-    my $tmpldir = $cfg->entryVar('paths', 'templates');
-    my $outname = "$tmpldir/$name.tmpl.work";
-    my $finalname = "$tmpldir/$name.tmpl";
-    _write_text($outname, $content, $cfg);
-    unlink $finalname;
-    rename $outname, $finalname
-      or die "Cannot rename $outname to $finalname: $!";
-  }
-}
-
-sub generate_extras {
-  my ($articles, $cfg, $callback) = @_;
-
-  use BSE::Cfg;
-  $cfg ||= BSE::Cfg->new;
-  my $template_dir = $cfg->entryVar('paths', 'templates');
-
-  open EXTRAS, "$template_dir/extras.txt"
-    or return;
-  my @extras;
-  while (<EXTRAS>) {
-    chomp;
-    next if /^\s*#/;
-    if (/^(\S+)\s+(\S+)/) {
-      push(@extras, [ $1, $2 ]);
-    }
-  }
-  close EXTRAS;
-
-  my %entries = $cfg->entries('pregenerate');
-  for my $extra (@extras) {
-    my ($in, $out) = @$extra;
-    $entries{$out} = 'extras,' . $in;
-  }
-  if (keys %entries) {
-    require 'Generate/Article.pm';
-    for my $out (keys %entries) {
-      my ($presets, $input) = split ',', $entries{$out}, 2;
-      my $section = "$presets settings";
-      $callback->("$input to $out with $presets") if $callback;
-      my %article = map { $_, '' } Article->columns;
-      $article{displayOrder} = 1;
-      $article{id} = -5;
-      $article{parentid} = -1;
-      $article{link} = $cfg->entryErr('site', 'url');
-      for my $field (Article->columns) {
-       if ($cfg->entry($section, $field)) {
-         $article{$field} = $cfg->entryVar($section, $field);
-       }
-      }
-      # by default all of these are handled as dynamic, but it can be 
-      # overidden, eg. the error template
-      my $is_extras = $presets eq 'extras';
-      my $dynamic = $cfg->entry($section, 'dynamic', !$is_extras);
-      my $outpath = $cfg->entry($section, 'content', $is_extras) ? 
-       $cfg->content_base_path : $template_dir;
-      my %acts;
-      my $gen = Generate::Article->new(cfg=>$cfg, top=>\%article, 
-                                      force_dynamic => $dynamic);
-      %acts = $gen->baseActs($articles, \%acts, \%article);
-      my $oldurl = $acts{url};
-      $acts{url} =
-       sub {
-         my $value = $oldurl->(@_);
-         $value =~ /^<:/ and return $value;
-         unless ($value =~ /^\w+:/) {
-           # put in the base site url
-           $value = $cfg->entryErr('site', 'url').$value;
-         }
-         return $value;
-       };
-      my $content = BSE::Template->get_page($input, $cfg, \%acts);
-      my $finalname = $outpath . '/'. $out;
-      my $outname = $finalname . '.work';
-      _write_text($outname, $content, $cfg);
-      unlink $finalname;
-      rename $outname, $finalname
-       or die "Cannot rename $outname to $finalname: $!";
-    }
-  }
-}
-
-sub generate_all {
-  my ($articles, $cfg, $callback) = @_;
-
-  my @articleids = $articles->allids;
-  my $pc = 0;
-  $callback->("Generating articles (".scalar(@articleids)." to do)")
-    if $callback;
-  my $index;
-  my $total = 0;
-  Squirrel::Table->caching(1);
-  my $allstart = time;
-  for my $articleid (@articleids) {
-    my $article = $articles->getByPkey($articleid);
-    ++$index;
-    if ($article->{link} && $article->{template}) {
-      #$callback->("Article $articleid");
-      generate_low($articles, $article, $cfg);
-    }
-    my $newpc = $index / @articleids * 100;
-    my $now = time;
-    if ($callback && $newpc >= $pc + 1 || abs($newpc-100) < 0.01) {
-      $callback->(sprintf("%5d:  %.1f%% done - elapsed: %.1f", $articleid, $newpc, $now - $allstart)) if $callback;
-      $pc = int $newpc;
-    }
-  }
-
-  $callback->("Generating search base") if $callback;
-  generate_search($articles, $cfg);
-
-  $callback->("Generating shop base pages") if $callback;
-  generate_shop($articles, $cfg);
-
-  $callback->("Generating extra pages") if $callback;
-  generate_extras($articles, $cfg, $callback);
-
-  $callback->("Total of ".(time()-$allstart)." seconds") if $callback;
-}
-
-=item regen_and_refresh($articles, $article, $generate, $refreshto, $cfg, $progress)
-
-An error checking wrapper around the page regeneration code.
-
-In some cases IIS appears to lock the static pages, which was causing
-various problems.  Here we catch the error and let the user know what
-is going on.
-
-If $article is set to undef then everything is regenerated.
-
-$cfg should be an initialized BSE::Cfg object
-
-$progress should be either missing, undef or a code reference.
-
-$generate is typically 1 or $AUTO_GENERATE
-
-Returns 1 if the regeneration was performed successfully.
-
-=cut
-
-sub regen_and_refresh {
-  my ($articles, $article, $generate, $refreshto, $cfg, $progress) = @_;
-
-  if ($generate) {
-    eval {
-      if ($article) {
-       if ($article eq 'extras') {
-         $progress->("Generating search base") if $progress;
-         generate_search($articles, $cfg);
-         
-         $progress->("Generating shop base pages") if $progress  ;
-         generate_shop($articles, $cfg);
-         
-         $progress->("Generating extra pages") if $progress;
-         generate_extras($articles, $cfg, $progress);
-       }
-       else {
-         generate_article($articles, $article, $cfg);
-       }
-      }
-      else {
-       generate_all($articles, $cfg, $progress);
-      }
-    };
-    if ($@) {
-      if ($progress) {
-       $progress->($@);
-      }
-      else {
-       my $error = $@;
-       require 'BSE/Util/Tags.pm';
-       require 'BSE/Template.pm';
-       my %acts;
-       %acts =
-         (
-          BSE::Util::Tags->basic(\%acts, undef, $cfg),
-          ifArticle => sub { $article },
-          article => 
-          sub { 
-            if (ref $article) {
-              return escape_html($article->{$_[0]});
-            }
-            else {
-              return 'extras';
-            }
-          },
-          error => sub { escape_html($error) },
-         );
-       BSE::Template->show_page('admin/regenerror', $cfg, \%acts);
-       
-       return 0;
-      }
-    }
-  }
-
-  unless ($progress) {
-    refresh_to_admin($cfg, $refreshto);
-  }
-
-  return 1;
-}
-
-sub _write_text {
-  my ($filename, $data, $cfg) = @_;
-
-  open my $fh, ">", $filename
-    or die "Cannot create $filename: $!";
-  if ($cfg->utf8) {
-    my $charset = $cfg->charset;
-    binmode $fh,  ":encoding($charset)";
-  }
-  print $fh $data
-    or die "Cannot write $filename: $!";
-  close $fh
-    or die "Cannot close $filename: $!";
-}
-
-1;
index b7adabe..4f00598 100644 (file)
@@ -11,6 +11,7 @@ my @errors;
 for my $check (@check) {
   $check =~ /^D/ and next;
   $check =~ s/^(..)\s+//;
+  $check =~ s/.* -> //; # renames
   my $type = $1;
   -e $check or die "Cannot find file $check\n";
 
index f103312..49b493f 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use Getopt::Long;
 use FindBin;
 use lib "$FindBin::Bin/../cgi-bin/modules";
-use Util qw/generate_all generate_article/;
+use BSE::Regen qw/generate_all generate_article/;
 use BSE::API qw(bse_init bse_cfg);
 use Articles;