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
$(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)
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);
--- /dev/null
+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;
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 {
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;
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
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;
$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} = '';
sub => sub { $sub->{$_[0]} },
);
+ require BSE::Template;
return BSE::Template->get_page($template, $cfg, \%acts);
}
my %article;
$sub->_build_article(\%article, $opts);
+ require BSE::DummyArticle;
+ bless \%article, "BSE::DummyArticle";
return $sub->_text_format_low($cfg, $user, $opts, \%article);
}
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);
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);
}
$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;
use Carp qw(confess cluck);
use Config ();
-our $VERSION = "1.010";
+our $VERSION = "1.011";
my %formats =
(
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) = @_;
}
}
+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;
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 =
(
$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 =
(
return $req->dyn_response($template, \%acts);
}
+=item add
+
+Display a form for adding a new subscription.
+
+=cut
+
sub req_add {
my ($class, $req) = @_;
}
}
+=item edit
+
+Display a form to edit an existing subscription.
+
+=cut
+
sub req_edit {
my ($class, $req) = @_;
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,
};
}
$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,
};
}
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;
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;
}
\@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) = @_;
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;
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;
}
return _refresh_list($req, "Subscription deleted");
}
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook
+
+=cut
<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>
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;
projects / bse.git / commitdiff