subscriptions fixes
authorTony Cook <tony@develop-help.com>
Mon, 3 Mar 2014 04:59:56 +0000 (15:59 +1100)
committerTony Cook <tony@develop-help.com>
Mon, 3 Mar 2014 04:59:56 +0000 (15:59 +1100)
- utf-8 fixes
- allow for variables for new style markup
- make the dummy article an object so it works with all the new code
  that expects an object
- fix handling of a negative or invalid archive article id
- use the BSE::UI wrapper in subs.pl

MANIFEST
Makefile
site/cgi-bin/admin/subs.pl
site/cgi-bin/modules/BSE/DummyArticle.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Regen.pm
site/cgi-bin/modules/BSE/SubscriptionType.pm
site/cgi-bin/modules/BSE/Template.pm
site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
site/templates/admin/subs/sending.tmpl
t/t000load.t

index af8cfcd..82ae79e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -82,6 +82,7 @@ site/cgi-bin/modules/BSE/Custom.pm
 site/cgi-bin/modules/BSE/CustomBase.pm
 site/cgi-bin/modules/BSE/DB.pm
 site/cgi-bin/modules/BSE/DB/Mysql.pm
+site/cgi-bin/modules/BSE/DummyArticle.pm
 site/cgi-bin/modules/BSE/Dynamic/Article.pm
 site/cgi-bin/modules/BSE/Dynamic/Catalog.pm
 site/cgi-bin/modules/BSE/Dynamic/Product.pm
index 712686d..559bced 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -71,7 +71,7 @@ distdir: docs dbinfo version
        $(PERL) site/util/make_versions.pl $(DISTBUILD)/$(BSEMODULES)
        mkdir $(DISTBUILD)/site/htdocs/shop
        find $(DISTBUILD) -type f | xargs chmod u+w
-       for i in `cat MANIFEST` ; do if [ -x $$i ] ; then chmod a+x $(DISTBUILD)/$$i ; fi ; done
+       for i in `cat MANIFEST | sed -e 's/\s.*//'` ; do if [ -x $$i ] ; then chmod a+x $(DISTBUILD)/$$i ; fi ; done
 
 clean:
        $(NOOP)
index 2a9ccf9..c0b334b 100755 (executable)
@@ -4,15 +4,7 @@ BEGIN { $ENV{DISPLAY} = '192.168.32.50:0.0' }
 use strict;
 use FindBin;
 use lib "$FindBin::Bin/../modules";
-use BSE::DB;
-use BSE::Request;
-use BSE::Template;
 use Carp 'confess';
-use BSE::UI::AdminNewsletter;
+use BSE::UI;
 
-$SIG{__DIE__} = sub { confess $@ };
-
-my $req = BSE::Request->new;
-
-my $result = BSE::UI::AdminNewsletter->dispatch($req);
-$req->output_result($result);
+BSE::UI->run("BSE::UI::AdminNewsletter", silent_exit => 1);
diff --git a/site/cgi-bin/modules/BSE/DummyArticle.pm b/site/cgi-bin/modules/BSE/DummyArticle.pm
new file mode 100644 (file)
index 0000000..928a337
--- /dev/null
@@ -0,0 +1,49 @@
+package BSE::DummyArticle;
+use base 'BSE::TB::SiteCommon';
+use Articles;
+
+our $VERSION = "1.000";
+
+sub images {
+  return;
+}
+
+sub files {
+  return;
+}
+
+{
+  for my $name (Article->columns) {
+    eval "sub $name { \$_[0]{$name} }";
+  }
+}
+
+sub restricted_method {
+  return 0;
+}
+
+sub section {
+  $_[0];
+}
+
+sub is_descendant_of {
+  0;
+}
+
+sub parent {
+  return;
+}
+
+sub is_dynamic {
+  1;
+}
+
+sub is_step_ancestor {
+  0;
+}
+
+sub menu_ancestors {
+  return;
+}
+
+1;
index 5be1ad5..2b365b2 100644 (file)
@@ -9,8 +9,9 @@ use Constants qw($GENERATE_BUTTON $SHOPID $AUTO_GENERATE);
 use Carp qw(confess);
 use BSE::WebUtil qw(refresh_to_admin);
 use BSE::Util::HTML;
+use BSE::DummyArticle;
 
-our $VERSION = "1.012";
+our $VERSION = "1.013";
 
 # returns non-zero if the Regenerate button should work
 sub generate_button {
@@ -468,49 +469,7 @@ sub _write_text {
 sub _dummy_article {
   my ($data) = @_;
 
-  return bless $data, "BSE::Regen::DummyArticle";
-}
-
-package BSE::Regen::DummyArticle;
-use base 'BSE::TB::SiteCommon';
-
-sub images {
-  return;
-}
-
-sub files {
-  return;
-}
-
-{
-  use Articles;
-  for my $name (Article->columns) {
-    eval "sub $name { \$_[0]{$name} }";
-  }
-}
-
-sub restricted_method {
-  return 0;
-}
-
-sub section {
-  $_[0];
-}
-
-sub is_descendant_of {
-  0;
-}
-
-sub parent {
-  return;
-}
-
-sub is_dynamic {
-  1;
-}
-
-sub is_step_ancestor {
-  0;
+  return bless $data, "BSE::DummyArticle";
 }
 
 1;
index 1aa0fad..d406bb2 100644 (file)
@@ -5,7 +5,7 @@ use Squirrel::Row;
 use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row/;
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
 
 sub columns {
   return qw/id name title description frequency keyword archive 
@@ -19,15 +19,18 @@ sub _build_article {
   my @cols = Article->columns;
   shift @cols;
   @$article{@cols} = ('') x @cols;
-  my $parentId = $opts->{parentId} || $sub->{parentId} || -1;
+  my $parent_id = $opts->{parentId} || $sub->{parentId} || -1;
   my $parent;
-  if ($parentId > 0) {
-    $parent = Articles->getByPkey($parentId);
+  if ($parent_id > 0) {
+    $parent = Articles->getByPkey($parent_id);
+    unless ($parent) {
+      $parent_id = -1;
+    }
   }
   use BSE::Util::SQL qw(now_datetime now_sqldate);
   $article->{body} = $opts->{body} || '';
   $article->{title} = defined($opts->{title}) ? $opts->{title} : $sub->{title};
-  $article->{parentid} = $opts->{parentId} || $sub->{parentId};
+  $article->{parentid} = $parent_id;
   $article->{displayOrder} = time;
   $article->{imagePos} = 'tr';
   $article->{release} = now_sqldate;
@@ -35,7 +38,7 @@ sub _build_article {
   $article->{keyword} = 
     exists($opts->{keyword}) ? $opts->{keyword} : $sub->{keyword};
   $article->{generator} = 'Generate::Article';
-  $article->{level} = $parent ? $parent->{level} + 1 : -1;
+  $article->{level} = $parent ? $parent->{level} + 1 : 1;
   $article->{listed} = 1;
   $article->{lastModified} = now_datetime;
   $article->{link} = '';
@@ -267,6 +270,7 @@ sub _text_format_low {
      sub => sub { $sub->{$_[0]} },
     );
   
+  require BSE::Template;
   return BSE::Template->get_page($template, $cfg, \%acts);
 }
 
@@ -275,6 +279,8 @@ sub text_format {
 
   my %article;
   $sub->_build_article(\%article, $opts);
+  require BSE::DummyArticle;
+  bless \%article, "BSE::DummyArticle";
   return $sub->_text_format_low($cfg, $user, $opts, \%article);
 }
 
@@ -283,7 +289,9 @@ sub html_format {
 
   my %article;
   $sub->_build_article(\%article, $opts);
-  require 'Generate/Subscription.pm';
+  require Generate::Subscription;
+  require BSE::DummyArticle;
+  bless \%article, "BSE::DummyArticle";
   my $gen = Generate::Subscription->new(cfg=>$cfg, top => \%article);
   $gen->set_user($user);
   $gen->set_sub($sub);
@@ -312,10 +320,12 @@ sub _send {
   require 'BSE/Mail.pm';
   my $mailer = BSE::Mail->new(cfg=>$cfg);
   $sub->_build_article($article, $opts);
+  require BSE::DummyArticle;
+  bless $article, "BSE::DummyArticle";
   my $gen;
   if ($article->{template}) {
     #print STDERR "Making generator\n";
-    require 'Generate/Subscription.pm';
+    require Generate::Subscription;
     $gen = Generate::Subscription->new(cfg=>$cfg, top=>$article);
     $gen->set_sub($sub);
   }
@@ -327,16 +337,27 @@ sub _send {
     $callback->('error', undef, "Configuration error: No from address configured, please set from in the subscriptions section of the config file, or \$SHOP_FROM in Constants.pm");
     return;
   }
-  my $charset = $cfg->entry('basic', 'charset') || 'iso-8859-1';
+  my $charset = $cfg->charset;
   my $index = 0;
   for my $user (@$recipients) {
     $callback->('user', $user) if $callback;
     my $text = $sub->_text_format_low($cfg, $user, $opts, $article);
+      if ($cfg->utf8) {
+       require Encode;
+       $text = Encode::encode($cfg->charset, $text);
+      }
     my $html;
     if ($gen && !$user->{textOnlyMail}) {
       #print STDERR "Making HTML\n";
       $gen->set_user($user);
-      $html = $gen->generate($article, 'Articles');
+      my %acts;
+      %acts = $gen->baseActs("Articles", \%acts, $article);
+      $html = BSE::Template->get_page($article->template, $cfg, \%acts,
+                                     undef, undef, $gen->variables);
+      if ($cfg->utf8) {
+       require Encode;
+       $html = Encode::encode($cfg->charset, $html);
+      }
     }
     my @headers;
     my $content;
index 67467ed..83b124b 100644 (file)
@@ -4,7 +4,7 @@ use Squirrel::Template;
 use Carp qw(confess cluck);
 use Config ();
 
-our $VERSION = "1.010";
+our $VERSION = "1.011";
 
 my %formats =
   (
@@ -151,6 +151,24 @@ sub get_response {
   return $class->make_response($content, $class->get_type($cfg, $template));
 }
 
+sub encode_content {
+  my ($self, $content, $cfg, $charset) = @_;
+
+  $cfg ||= BSE::Cfg->single;
+  if ($cfg->utf8) {
+    $charset ||= $cfg->charset;
+
+    require Encode;
+    my $cfg = BSE::Cfg->single;
+    my $check = $cfg->entry("utf8", "check", Encode::FB_DEFAULT());
+    $check = oct($check) if $check =~ /^0/;
+
+    $content = Encode::encode($charset, $content, $check);
+  }
+
+  return $content;
+}
+
 sub make_response {
   my ($class, $content, $type) = @_;
 
@@ -351,4 +369,22 @@ sub output_resultc {
   }
 }
 
+sub print_first_part {
+  my ($class, $content, $cfg) = @_;
+
+  $cfg ||= BSE::Cfg->single;
+
+  my $type = $class->html_type($cfg);
+
+  print "Content-Type: $type\n\n";
+  $class->print_next_part($content, $cfg);
+}
+
+sub print_next_part {
+  my ($class, $content, $cfg) = @_;
+
+  $content = $class->encode_content($content, $cfg);
+  print $content;
+}
+
 1;
index 09af01b..26bbe96 100644 (file)
@@ -8,7 +8,17 @@ use BSE::Util::HTML qw(:default popup_menu);
 use BSE::Util::Iterate;
 use base 'BSE::UI::AdminDispatch';
 
-our $VERSION = "1.002";
+our $VERSION = "1.003";
+
+=head1 NAME
+
+BSE::UI::AdminNewsletter - subscription/newsletter management
+
+=head1 TARGETS
+
+=over
+
+=cut
 
 my %actions =
   (
@@ -53,14 +63,52 @@ sub tag_list_recipient_count {
   $subs->[$$subindex]->recipient_count;
 }
 
+=item list
+X<targets, subscriptions, list>
+
+Display the list of subscriptions/newsletter lists.
+
+Tags, standard admin tags and:
+
+=over
+
+=item *
+
+C<iterator subscriptions ...>/C<< subscription I<key> >> - iterate
+over existing subscriptions.
+
+=item *
+
+C<message> - display any errors
+
+=back
+
+Standard admin variables and:
+
+=over
+
+=item *
+
+subscriptions - an array of existing subscriptions.
+
+=back
+
+
+Template: F<admin/subs/list>
+
+Access required: none
+
+=cut
+
 sub req_list {
   my ($class, $req, $message) = @_;
 
   my $q = $req->cgi;
   my $cfg = $req->cfg;
-  $message ||= $q->param('m') || '';
+  $message = $req->message($message);
   my @subs = sort { lc $a->{name} cmp $b->{name} } BSE::SubscriptionTypes->all;
   my $subindex;
+  $req->set_variable(subscriptions => \@subs);
   my %acts;
   %acts =
     (
@@ -222,6 +270,12 @@ sub sub_form {
   return $req->dyn_response($template, \%acts);
 }
 
+=item add
+
+Display a form for adding a new subscription.
+
+=cut
+
 sub req_add {
   my ($class, $req) = @_;
 
@@ -306,6 +360,12 @@ sub req_addsave {
   }
 }
 
+=item edit
+
+Display a form to edit an existing subscription.
+
+=cut
+
 sub req_edit {
   my ($class, $req) = @_;
 
@@ -427,9 +487,14 @@ sub req_html_preview {
   if ($template) {
     # build a fake article
     my $text = $sub->html_format($cfg, _dummy_user(), \%opts);
+    my $charset = $cfg->charset;
+    if ($cfg->utf8) {
+      require Encode;
+      $text = Encode::encode($charset, $text);
+    }
     return
       {
-       type => 'text/html',
+       type => BSE::Template->html_type($cfg),
        content => $text,
       };
   }
@@ -476,18 +541,23 @@ sub req_text_preview {
     $opts{$key} = ($q->param($key))[0];
   }
   my $text = $sub->text_format($cfg, _dummy_user(), \%opts);
+  my $charset = $cfg->charset;
+  if ($cfg->utf8) {
+    require Encode;
+    $text = Encode::encode($charset, $text);
+  }
   
   if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
     return
       {
-       type => 'text/html',
+       type => BSE::Template->html_type($cfg),
        content => "<html><body><pre>".escape_html($text)."</pre></body></html>"
       };
   }
   else {
     return
       {
-       type => 'text/plain',
+       type => "text/plain; charset=$charset",
        content => $text,
       };
   }
@@ -677,10 +747,8 @@ sub req_send_test {
   keys %errors
     and return _send_errors($req, $sub, \%errors);
 
-  my $template = BSE::Template->get_source('admin/subs/sending', $cfg);
+  require BSE::Template;
 
-  my ($prefix, $permessage, $suffix) = 
-    split /<:\s*iterator\s+(?:begin|end)\s+messages\s*:>/, $template;
   my $acts_message;
   my $acts_user;
   my $is_error;
@@ -695,17 +763,24 @@ sub req_send_test {
      ifError => sub { $is_error },
      testing => 1,
     );
-  BSE::Template->show_replaced($prefix, $cfg, \%acts);
+  my ($permessage, $suffix) = $class->_split_page
+    ($req, 'admin/subs/sending', \%acts);
+
   $sub->send_test($cfg, \%opts,
                  sub {
                    my ($type, $user, $msg) = @_;
                    $acts_message = defined($msg) ? $msg : '';
                    $acts_user = $user;
                    $is_error = $type eq 'error';
-                   print BSE::Template->replace($permessage, $cfg, \%acts);
+                   $req->set_variable(sub_user => $user || undef);
+                   $req->set_variable(sub_message => defined $msg ? $msg : '');
+                   $req->set_variable(is_error => $is_error);
+                   $req->set_variable(message_type => $type);
+                   BSE::Template->print_next_part(BSE::Template->replace($permessage, $cfg, \%acts, $req->{vars}));
                  },
                 \%recipient);
-  print BSE::Template->replace($suffix, $cfg, \%acts);
+  BSE::Template->print_next_part(BSE::Template->replace($suffix, $cfg, \%acts, $req->{vars}));
+
   return;
 }
 
@@ -737,6 +812,22 @@ sub _get_filtered_ids {
   \@ids;
 }
 
+sub _split_page {
+  my ($self, $req, $template, $acts) = @_;
+
+  require BSE::Template;
+  $req->set_variable(template => $template);
+  $req->_set_vars;
+  my $content = BSE::Template->get_page
+    ($template, $req->cfg, $acts, undef, undef, $req->{vars});
+  my ($prefix, $per_message, $suffix) =
+    split /<:\s*iterator\s+(?:begin|end)\s+messages\s*:>/, $content;
+
+  BSE::Template->print_first_part($prefix);
+
+  return ($per_message, $suffix);
+}
+
 sub req_send {
   my ($class, $req) = @_;
 
@@ -751,10 +842,6 @@ sub req_send {
 
   my $filtered_ids = _get_filtered_ids($req);
 
-  my $template = BSE::Template->get_source('admin/subs/sending', $cfg);
-
-  my ($prefix, $permessage, $suffix) = 
-    split /<:\s*iterator\s+(?:begin|end)\s+messages\s*:>/, $template;
   my $acts_message;
   my $acts_user;
   my $is_error;
@@ -769,16 +856,23 @@ sub req_send {
      ifError => sub { $is_error },
      testing => 0,
     );
-  BSE::Template->show_replaced($prefix, $cfg, \%acts);
+
+  my ($permessage, $suffix) = $class->_split_page
+    ($req, 'admin/subs/sending', \%acts);
+
   $sub->send($cfg, \%opts,
             sub {
               my ($type, $user, $msg) = @_;
               $acts_message = defined($msg) ? $msg : '';
               $acts_user = $user;
               $is_error = $type eq 'error';
-              print BSE::Template->replace($permessage, $cfg, \%acts);
+              $req->set_variable(sub_user => $user || undef);
+              $req->set_variable(sub_message => defined $msg ? $msg : '');
+              $req->set_variable(is_error => $is_error);
+              $req->set_variable(message_type => $type);
+              BSE::Template->print_next_part(BSE::Template->replace($permessage, $cfg, \%acts, $req->{vars}));
             }, $filtered_ids);
-  print BSE::Template->replace($suffix, $cfg, \%acts);
+  BSE::Template->print_next_part(BSE::Template->replace($suffix, $cfg, \%acts, $req->{vars}));
 
   return;
 }
@@ -814,3 +908,11 @@ sub req_delete {
 
   return _refresh_list($req, "Subscription deleted");
 }
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook
+
+=cut
index 037dd01..76c6f6b 100644 (file)
@@ -26,19 +26,19 @@ result in incomplete, or duplicate transmissions.</p>
 
 <ul>
 <:iterator begin messages:>
-<:if Error:>
-<:if User:>
-<li><b><:message:> sending to <:user email:></b></li>
-<:or User:>
-<li><b><:message:></b></li>
-<:eif User:>
-<:or Error:>
-<:if User:>
-<li>Sending to: <:user email:></li>
-<:or User:>
-<li><:message:></li>
-<:eif User:>
-<:eif Error:>
+<:.if is_error:>
+  <:.if sub_user:>
+<li><b><:= sub_message:> sending to <:= sub_user.email:></b></li>
+  <:.else :>
+<li><b><:= sub_message:></b></li>
+  <:.end if:>
+<:.else:>
+  <:.if sub_user:>
+<li>Sending to: <:= sub_user.email:></li>
+  <:.else:>
+<li><:= sub_message:></li>
+  <:.end if:>
+<:.end if:>
 <:iterator end messages:>
 </ul>
 
index 8992296..8827c99 100644 (file)
@@ -34,3 +34,6 @@ use_ok("BSE::Index::BSE");
 use_ok("BSE::ImageClean");
 use_ok("BSE::UI::AdminImageClean");
 use_ok("BSE::UI::Thumb");
+
+my $builder = Test::Builder->new;
+$builder->is_passing or $builder->BAIL_OUT;