site/cgi-bin/modules/BSE/Template.pm
site/cgi-bin/modules/BSE/Thumb/Imager.pm
site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
+site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
+site/cgi-bin/modules/BSE/UI/AdminReport.pm
site/cgi-bin/modules/BSE/UI/AdminSeminar.pm
+site/cgi-bin/modules/BSE/UI/AdminShop.pm
site/cgi-bin/modules/BSE/UI/Affiliate.pm
site/cgi-bin/modules/BSE/UI/Dispatch.pm
site/cgi-bin/modules/BSE/UI/Formmail.pm
-VERSION=0.15_49
+VERSION=0.15_50
DISTNAME=bse-$(VERSION)
DISTBUILD=$(DISTNAME)
DISTTAR=../$(DISTNAME).tar
name varchar(80) not null,
description varchar(255) not null,
perm_map varchar(255) not null,
+ template_set varchar(80) not null default '',
primary key (base_id),
unique (name)
);
use Article;
use BSE::DB;
use BSE::Request;
-use BSE::Template;
use BSE::Edit::Base;
use Carp qw'verbose';
use Carp 'confess';
$result = $obj->noarticle_dispatch($req, $articles);
}
-$| = 1;
-push @{$result->{headers}}, "Content-Type: $result->{type}";
-push @{$result->{headers}}, $req->extra_headers;
-if (exists $ENV{GATEWAY_INTERFACE}
- && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
- require Apache;
- my $r = Apache->request or die;
- $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
-}
-else {
- print "$_\n" for @{$result->{headers}};
- print "\n";
-}
-print $result->{content};
+$req->output_result($result);
sub get_class {
my ($class, $cfg) = @_;
my $req = BSE::Request->new;
my $result = BSE::UI::AdminSeminar->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
use lib "$FindBin::Bin/../modules";
use BSE::DB;
use BSE::Request;
-use BSE::Template;
use Carp 'confess';
use BSE::AdminUsers;
my $req = BSE::Request->new;
my $result = BSE::AdminUsers->dispatch($req);
-$| = 1;
-push @{$result->{headers}}, "Content-Type: $result->{type}";
-push @{$result->{headers}}, $req->extra_headers;
-if (exists $ENV{GATEWAY_INTERFACE}
- && $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl\//) {
- require Apache;
- my $r = Apache->request or die;
- $r->send_cgi_header(join("\n", @{$result->{headers}})."\n");
-}
-else {
- print "$_\n" for @{$result->{headers}};
- print "\n";
-}
-print $result->{content};
+$req->output_result($result);
$result = BSE::Template->get_refresh($req->url('logon'), $req->cfg);
}
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
my $req = BSE::Request->new;
my $result = BSE::AdminLogon->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
my $req = BSE::Request->new;
my $result = BSE::AdminMenu->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
use strict;
use FindBin;
use lib "$FindBin::Bin/../modules";
-use BSE::DB;
use BSE::Request;
use BSE::Template;
-use BSE::Permissions;
-use BSE::Util::Tags;
-use BSE::Report;
-use DevHelp::HTML;
-use BSE::WebUtil 'refresh_to';
+use Carp 'confess';
+use BSE::UI::AdminReport;
-my $req = BSE::Request->new;
-my $cgi = $req->cgi;
-
-BSE::Permissions->check_logon($req)
- or do { refresh_to($req->url('logon'), $req->cfg); exit };
-
-my $reports = BSE::Report->new($req);
-
-if ($cgi->param('s_prompt') || $cgi->param('s_prompt.x')) {
- prompt($req, $reports);
-}
-elsif ($cgi->param('s_show') || $cgi->param('s_show.x')) {
- show($req, $reports);
-}
-else {
- list_reports($req, $reports);
-}
-
-sub list_reports {
- my ($req, $reports, $msg) = @_;
-
- $msg = '' unless defined $msg;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
- BSE::Util::Tags->admin(\%acts, $req->cfg),
- BSE::Util::Tags->secure($req),
- $reports->list_tags(),
- message => escape_html($msg),
- );
-
- return BSE::Template->show_page('admin/reports/list', $req->cfg, \%acts);
-}
-
-sub prompt {
- my ($req, $reports, $msg, $errors) = @_;
-
- my $repname = $req->cgi->param('r');
-
- defined $repname
- or return list_reports($req, $reports, 'No report id supplied');
-
- $reports->valid_report($repname)
- or return list_reports($req, $reports, 'Invalid report id supplied');
+$SIG{__DIE__} = sub { confess $@ };
- $reports->report_accessible($repname)
- or return list_reports($req, $reports, 'Report not accessible');
-
- defined $msg or $msg = '';
- if (keys %$errors && $msg eq '') {
- $msg = join "<br>", map "<b>".escape_html($_)."</b>", values %$errors;
- }
- else {
- $msg = escape_html($msg);
- }
-
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
- BSE::Util::Tags->admin(\%acts, $req->cfg),
- BSE::Util::Tags->secure($req),
- $reports->prompt_tags($repname, $req->cgi, BSE::DB->single),
- message => $msg,
- );
-
- my $template = $reports->prompt_template($repname) || 'admin/reports/prompt';
-
- return BSE::Template->show_page($template, $req->cfg, \%acts);
-}
-
-sub show {
- my ($req, $reports) = @_;
-
- my $repname = $req->cgi->param('r');
-
- defined $repname
- or return list_reports($req, $reports, 'No report id supplied');
-
- $reports->valid_report($repname)
- or return list_reports($req, $reports, 'Invalid report id supplied');
-
- $reports->report_accessible($repname)
- or return list_reports($req, $reports, 'Report not accessible');
-
- my %errors;
- my @params = $reports->validate_params($repname, $req->cgi,
- BSE::DB->single, \%errors);
- keys %errors
- and return prompt($req, $reports, '', \%errors);
-
- my $msg;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
- BSE::Util::Tags->admin(\%acts, $req->cfg),
- BSE::Util::Tags->secure($req),
- $reports->show_tags($repname, BSE::DB->single, \$msg, @params),
- );
-
- $msg
- and return prompt($req, $reports, $msg);
-
- my $levels = $reports->levels($repname, BSE::DB->single);
- my $template = $reports->show_template($repname) || 'admin/reports/show' . $levels;
+my $req = BSE::Request->new;
- return BSE::Template->show_page($template, $req->cfg, \%acts);
-}
+my $result = BSE::UI::AdminReport->dispatch($req);
+$req->output_result($result);
use strict;
use FindBin;
use lib "$FindBin::Bin/../modules";
-
-#use Carp; # 'verbose';
-use Products;
-use Product;
-use BSE::TB::Orders;
-use BSE::TB::OrderItems;
-use BSE::Template;
-#use Squirrel::ImageEditor;
-use Constants qw(:shop $SHOPID $PRODUCTPARENT
- $SHOP_URI $CGI_URI $IMAGES_URI $AUTO_GENERATE);
-use Images;
-use Articles;
-use BSE::Sort;
-use BSE::Util::Tags qw(tag_hash);
-use BSE::Util::Iterate;
+use BSE::DB;
use BSE::Request;
-use BSE::WebUtil 'refresh_to_admin';
-use DevHelp::HTML;
-use BSE::Arrows;
-use BSE::CfgInfo 'product_options';
-
-my $req = BSE::Request->new;
-my $cfg = $req->cfg;
-my $securlbase = $cfg->entryVar('site', 'secureurl');
-my $baseurl = $cfg->entryVar('site', 'url');
-unless ($req->check_admin_logon()) {
- refresh_to_admin($cfg, "/cgi-bin/admin/logon.pl");
- exit;
-}
-#my %session;
-#BSE::Session->tie_it(\%session, $cfg);
-
-#param();
-
-my %what_to_do =
- (
- order_list=>\&order_list,
- order_list_filled=>\&order_list_filled,
- order_list_unfilled=>\&order_list_unfilled,
- order_list_unpaid => \&order_list_unpaid,
- order_list_incomplete => \&order_list_incomplete,
- order_detail=>\&order_detail,
- order_filled=>\&order_filled,
- product_detail=>\&product_detail,
- );
-
-my @modifiable = qw(body retailPrice wholesalePrice gst release expire
- parentid leadTime options template threshold
- summaryLength);
-my %modifiable = map { $_=>1 } @modifiable;
-
-
-{
- my $cgi = $req->cgi;
- while (my ($key, $func) = each %what_to_do) {
- if ($cgi->param($key)) {
- $func->($req);
- exit;
- }
- }
-}
-
-product_list($req);
-
-#####################
-# product management
-
-sub embedded_catalog {
- my ($req, $catalog, $template) = @_;
-
- my $session = $req->session;
- use POSIX 'strftime';
- my $products = Products->new;
- my @list;
- if ($session->{showstepkids}) {
- my @allkids = $catalog->allkids;
- my %allgen = map { $_->{generator} => 1 } @allkids;
- for my $gen (keys %allgen) {
- (my $file = $gen . ".pm") =~ s!::!/!g;
- require $file;
- }
- @list = grep UNIVERSAL::isa($_->{generator}, 'Generate::Product'), $catalog->allkids;
- @list = map { $products->getByPkey($_->{id}) } @list;
- }
- else {
- @list = sort { $b->{displayOrder} <=> $a->{displayOrder} }
- $products->getBy(parentid=>$catalog->{id});
- }
- my $list_index = -1;
- my $subcat_index = -1;
- my @subcats = sort { $b->{displayOrder} <=> $a->{displayOrder} }
- grep $_->{generator} eq 'Generate::Catalog',
- Articles->children($catalog->{id});
-
- my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
-
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $CGI::Q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- BSE::Util::Tags->secure($req),
- catalog => sub { CGI::escapeHTML($catalog->{$_[0]}) },
- date => sub { display_date($list[$list_index]{$_[0]}) },
- money => sub { sprintf("%.2f", $list[$list_index]{$_[0]}/100.0) },
- iterate_products_reset => sub { $list_index = -1; },
- iterate_products =>
- sub {
- return ++$list_index < @list;
- },
- product => sub { CGI::escapeHTML($list[$list_index]{$_[0]}) },
- ifProducts => sub { @list },
- iterate_subcats_reset =>
- sub {
- $subcat_index = -1;
- },
- iterate_subcats => sub { ++$subcat_index < @subcats },
- subcat => sub { CGI::escapeHTML($subcats[$subcat_index]{$_[0]}) },
- ifSubcats => sub { @subcats },
- hiddenNote =>
- sub { $list[$list_index]{listed} == 0 ? "Hidden" : " " },
- move =>
- sub {
- my ($arg, $acts, $funcname, $templater) = @_;
-
- $req->user_can(edit_reorder_children => $catalog)
- or return '';
- my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
- defined $img_prefix or $img_prefix = '';
- defined $urladd or $urladd = '';
- @list > 1 or return '';
- # links to move products up/down
- my $refreshto = $ENV{SCRIPT_NAME}."$urladd#cat".$catalog->{id};
- my $down_url = '';
- if ($list_index < $#list) {
- if ($session->{showstepkids}) {
- $down_url = "$CGI_URI/admin/move.pl?stepparent=$catalog->{id}&d=swap&id=$list[$list_index]{id}&other=$list[$list_index+1]{id}";
- }
- else {
- $down_url = "$CGI_URI/admin/move.pl?id=$list[$list_index]{id}&d=swap&other=$list[$list_index+1]{id}";
- }
- }
- my $up_url = '';
- if ($list_index > 0) {
- if ($session->{showstepkids}) {
- $up_url = "$CGI_URI/admin/move.pl?stepparent=$catalog->{id}&d=swap&id=$list[$list_index]{id}&other=$list[$list_index-1]{id}";
- }
- else {
- $up_url = "$CGI_URI/admin/move.pl?id=$list[$list_index]{id}&d=swap&other=$list[$list_index-1]{id}";
- }
- }
- return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
- },
- script=>sub { $ENV{SCRIPT_NAME} },
- embed =>
- sub {
- my ($which, $template) = split ' ', $_[0];
- $which eq 'subcat' or return "Unknown object $which embedded";
- return embedded_catalog($req, $subcats[$subcat_index], $template);
- },
- movecat =>
- sub {
- my ($arg, $acts, $funcname, $templater) = @_;
-
- $req->user_can(edit_reorder_children => $catalog)
- or return '';
- @subcats > 1 or return '';
- # links to move catalogs up/down
- my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
- defined $img_prefix or $img_prefix = '';
- defined $urladd or $urladd = '';
- my $refreshto = $ENV{SCRIPT_NAME}.$urladd;
- my $down_url = "";
- if ($subcat_index < $#subcats) {
- $down_url = "$CGI_URI/admin/move.pl?id=$subcats[$subcat_index]{id}&d=swap&other=$subcats[$subcat_index+1]{id}&all=1";
- }
- my $up_url = "";
- if ($subcat_index > 0) {
- $up_url = "$CGI_URI/admin/move.pl?id=$subcats[$subcat_index]{id}&d=swap&other=$subcats[$subcat_index-1]{id}&all=1";
- }
- return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
- },
- );
-
- return BSE::Template->get_page('admin/'.$template, $cfg, \%acts);
-}
-
-sub product_list {
- my ($req, $message) = @_;
-
- my $cgi = $req->cgi;
- my $session = $req->session;
- my $shopid = $req->cfg->entryErr('articles', 'shop');
- my $shop = Articles->getByPkey($shopid);
- my @catalogs = sort { $b->{displayOrder} <=> $a->{displayOrder} }
- grep $_->{generator} eq 'Generate::Catalog', Articles->children($shopid);
- my $catalog_index = -1;
- $message ||= $cgi->param('m') || $cgi->param('message') || '';
- if (defined $cgi->param('showstepkids')) {
- $session->{showstepkids} = $cgi->param('showstepkids');
- }
- exists $session->{showstepkids} or $session->{showstepkids} = 1;
- my $products = Products->new;
- my @products = sort { $b->{displayOrder} <=> $a->{displayOrder} }
- $products->getBy(parentid => $shopid);
- my $product_index;
-
- my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
-
- my $it = BSE::Util::Iterate->new;
-
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $cgi, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- BSE::Util::Tags->secure($req),
- catalog=> sub { CGI::escapeHTML($catalogs[$catalog_index]{$_[0]}) },
- iterate_catalogs => sub { ++$catalog_index < @catalogs },
- shopid=>sub { $shopid },
- shop => [ \&tag_hash, $shop ],
- script=>sub { $ENV{SCRIPT_NAME} },
- message => sub { $message },
- embed =>
- sub {
- my ($which, $template) = split ' ', $_[0];
- $which eq 'catalog' or return "Unknown object $which embedded";
- return embedded_catalog($req, $catalogs[$catalog_index], $template);
- },
- movecat =>
- sub {
- my ($arg, $acts, $funcname, $templater) = @_;
-
- $req->user_can(edit_reorder_children => $shopid)
- or return '';
- @catalogs > 1 or return '';
- # links to move catalogs up/down
- my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
- defined $img_prefix or $img_prefix = '';
- defined $urladd or $urladd = '';
- my $refreshto = $ENV{SCRIPT_NAME} . $urladd;
- my $down_url = '';
- if ($catalog_index < $#catalogs) {
- $down_url = "$CGI_URI/admin/move.pl?id=$catalogs[$catalog_index]{id}&d=swap&other=$catalogs[$catalog_index+1]{id}";
- }
- my $up_url = '';
- if ($catalog_index > 0) {
- $up_url = "$CGI_URI/admin/move.pl?id=$catalogs[$catalog_index]{id}&d=swap&other=$catalogs[$catalog_index-1]{id}";
- }
- return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
- },
- ifShowStepKids => sub { $session->{showstepkids} },
- $it->make_iterator(undef, 'product', 'products', \@products, \$product_index),
- move =>
- sub {
- my ($arg, $acts, $funcname, $templater) = @_;
-
- $req->user_can(edit_reorder_children => $shop)
- or return '';
- my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
- defined $img_prefix or $img_prefix = '';
- defined $urladd or $urladd = '';
- @products > 1 or return '';
- # links to move products up/down
- my $refreshto = $ENV{SCRIPT_NAME}."$urladd#cat".$shop->{id};
- my $down_url = '';
- if ($product_index < $#products) {
- if ($session->{showstepkids}) {
- $down_url = "$CGI_URI/admin/move.pl?stepparent=$shop->{id}&d=swap&id=$products[$product_index]{id}&other=$products[$product_index+1]{id}";
- }
- else {
- $down_url = "$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&d=swap&other=$products[$product_index+1]{id}";
- }
- }
- my $up_url = '';
- if ($product_index > 0) {
- if ($session->{showstepkids}) {
- $up_url = "$CGI_URI/admin/move.pl?stepparent=$shop->{id}&d=swap&id=$products[$product_index]{id}&other=$products[$product_index-1]{id}";
- }
- else {
- $up_url = "$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&d=swap&other=$products[$product_index-1]{id}";
- }
- }
- return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
- },
- );
-
- page('product_list', \%acts);
-}
-
-sub product_detail {
- my ($req) = @_;
-
- my $cgi = $req->cgi;
- my $id = $cgi->param('id');
- if ($id and
- my $product = Products->getByPkey($id)) {
- product_form($req, $product, '', '', 'product_detail');
- }
- else {
- product_list($req);
- }
-}
-
-sub product_form {
- my ($req, $product, $action, $message, $template) = @_;
-
- my $cgi = $req->cgi;
- $message ||= $cgi->param('m') || $cgi->param('message') || '';
- $template ||= 'add_product';
- my @catalogs;
- my $shopid = $req->cfg->entryErr('articles', 'shop');
- my @work = [ $shopid, '' ];
- while (@work) {
- my ($parent, $title) = @{shift @work};
-
- push(@catalogs, { id=>$parent, display=>$title }) if $title;
- my @kids = sort { $b->{displayOrder} <=> $a->{displayOrder} }
- grep $_->{generator} eq 'Generate::Catalog',
- Articles->children($parent);
- $title .= ' / ' if $title;
- unshift(@work, map [ $_->{id}, $title.$_->{title} ], @kids);
- }
- my @files;
- if ($product->{id}) {
- require 'ArticleFiles.pm';
- @files = ArticleFiles->getBy(articleId=>$product->{id});
- }
- my $file_index;
-
- my @templates;
- push(@templates, "shopitem.tmpl")
- if grep -e "$_/shopitem.tmpl", BSE::Template->template_dirs($cfg);
- for my $dir (BSE::Template->template_dirs($cfg)) {
- if (opendir PROD_TEMPL, "$dir/products") {
- push @templates, map "products/$_",
- grep -f "$dir/products/$_" && /\.tmpl$/i, readdir PROD_TEMPL;
- closedir PROD_TEMPL;
- }
- }
- my %seen_templates;
- @templates = sort { lc($a) cmp lc($b) }
- grep !$seen_templates{$_}++, @templates;
-
- my $stepcat_index;
- use OtherParents;
- # ugh
- my $realproduct;
- $realproduct = UNIVERSAL::isa($product, 'Product') ? $product : Products->getByPkey($product->{id});
- my @stepcats;
- @stepcats = OtherParents->getBy(childId=>$product->{id})
- if $product->{id};
- my @stepcat_targets = $realproduct->step_parents if $realproduct;
- my %stepcat_targets = map { $_->{id}, $_ } @stepcat_targets;
- my @stepcat_possibles = grep !$stepcat_targets{$_->{id}}, @catalogs;
- my @images;
- @images = $product->images
- if $product->{id};
-# @images = $imageEditor->images()
-# if $product->{id};
- my $image_index;
- my $avail_options = product_options($cfg);
-
- my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
-
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $cgi, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- BSE::Util::Tags->secure($req),
- catalogs =>
- sub {
- return popup_menu(-name=>'parentid',
- -values=>[ map $_->{id}, @catalogs ],
- -labels=>{ map { @$_{qw/id display/} } @catalogs },
- -default=>($product->{parentid} || $PRODUCTPARENT),
- -override=>1);
- },
- product => sub { CGI::escapeHTML($product->{$_[0]}) },
- action => sub { $action },
- message => sub { $message },
- script=>sub { $ENV{SCRIPT_NAME} },
- ifImage => sub { $product->{imageName} },
- hiddenNote => sub { $product->{listed} ? " " : "Hidden" },
- alloptions =>
- sub { CGI::escapeHTML(join(',', sort keys %$avail_options)) },
- templates =>
- sub {
- return CGI::popup_menu(-name=>'template', -values=>\@templates,
- -default=>$product->{id} ? $product->{template} :
- $templates[0]);
- },
- ifStepcats => sub { @stepcats },
- iterate_stepcats_reset => sub { $stepcat_index = -1; },
- iterate_stepcats => sub { ++$stepcat_index < @stepcats },
- stepcat => sub { CGI::escapeHTML($stepcats[$stepcat_index]{$_[0]}) },
- stepcat_targ =>
- sub {
- CGI::escapeHTML($stepcat_targets[$stepcat_index]{$_[0]});
- },
- movestepcat =>
- sub {
- my ($arg, $acts, $funcname, $templater) = @_;
- return ''
- unless $req->user_can(edit_reorder_stepparents => $product),
- @stepcats > 1 or return '';
- my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
- $img_prefix = '' unless defined $img_prefix;
- $urladd = '' unless defined $urladd;
- my $refreshto = CGI::escape($ENV{SCRIPT_NAME}
- ."?id=$product->{id}&$template=1$urladd#step");
- my $down_url = "";
- if ($stepcat_index < $#stepcats) {
- $down_url = "$CGI_URI/admin/move.pl?stepchild=$product->{id}&id=$stepcats[$stepcat_index]{parentId}&d=swap&other=$stepcats[$stepcat_index+1]{parentId}&all=1";
- }
- my $up_url = "";
- if ($stepcat_index > 0) {
- $up_url = "$CGI_URI/admin/move.pl?stepchild=$product->{id}&id=$stepcats[$stepcat_index]{parentId}&d=swap&other=$stepcats[$stepcat_index-1]{parentId}&all=1";
- }
- return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
- },
- ifStepcatPossibles => sub { @stepcat_possibles },
- stepcat_possibles => sub {
- popup_menu(-name=>'stepcat',
- -values=>[ map $_->{id}, @stepcat_possibles ],
- -labels=>{ map { $_->{id}, $_->{display}} @catalogs });
- },
- BSE::Util::Tags->
- make_iterator(\@files, 'file', 'files', \$file_index),
- BSE::Util::Tags->
- make_iterator(\@images, 'image', 'images', \$image_index),
- );
-
- page($template, \%acts);
-}
-
-# sub img_return {
-# if (exists $session{imageid}) {
-# if ($session{imageid}) {
-# param('id', $session{imageid});
-# edit_product();
-# }
-# else {
-# add_product();
-# }
-# }
-# else {
-# product_list(); # something wierd
-# }
-# }
-
-#####################
-# order management
-
-sub order_list_low {
- my ($req, $template, $title, @orders) = @_;
-
- my $cgi = $req->cgi;
-
- my $from = $cgi->param('from');
- my $to = $cgi->param('to');
- use BSE::Util::SQL qw/now_sqldate sql_to_date date_to_sql/;
- use BSE::Util::Valid qw/valid_date/;
- my $today = now_sqldate();
- for my $what ($from, $to) {
- if (defined $what) {
- if ($what eq 'today') {
- $what = $today;
- }
- elsif (valid_date($what)) {
- $what = date_to_sql($what);
- }
- else {
- undef $what;
- }
- }
- }
- my $message = $cgi->param('m');
- defined $message or $message = '';
- $message = escape_html($message);
- if (defined $from || defined $to) {
- $from ||= '1900-01-01';
- $to ||= '2999-12-31';
- $cgi->param('from', sql_to_date($from));
- $cgi->param('to', sql_to_date($to));
- $to = $to."Z";
- @orders = grep $from le $_->{orderDate} && $_->{orderDate} le $to,
- @orders;
- }
- my @orders_work;
- my $order_index = -1;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $CGI::Q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- BSE::Util::Tags->secure($req),
- #order=> sub { CGI::escapeHTML($orders_work[$order_index]{$_[0]}) },
- DevHelp::Tags->make_iterator2
- ( [ \&iter_orders, \@orders ],
- 'order', 'orders', \@orders_work, \$order_index, 'NoCache'),
- script => sub { $ENV{SCRIPT_NAME} },
- title => sub { $title },
- ifHaveParam => sub { defined $cgi->param($_[0]) },
- ifParam => sub { $cgi->param($_[0]) },
- cgi =>
- sub {
- my $value = $cgi->param($_[0]);
- defined $value or $value = '';
- CGI::escapeHTML($value);
- },
- message => $message,
- );
- page($template, \%acts);
-}
-
-sub iter_orders {
- my ($orders, $args) = @_;
-
- return bse_sort({ id => 'n', total => 'n', filled=>'n' }, $args, @$orders);
-}
-
-sub order_list {
- my ($req) = @_;
-
- $req->user_can('shop_order_list')
- or return product_list($req, "You don't have access to the order list");
-
- my $orders = BSE::TB::Orders->new;
- my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
- grep $_->{complete}, $orders->all;
- my $template = $req->cgi->param('template');
- unless (defined $template && $template =~ /^\w+$/) {
- $template = 'order_list';
- }
-
- order_list_low($req, $template, 'Order list', @orders);
-}
-
-sub order_list_filled {
- my ($req) = @_;
-
- $req->user_can('shop_order_list')
- or return product_list($req, "You don't have access to the order list");
-
- my $orders = BSE::TB::Orders->new;
- my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
- grep $_->{complete} && $_->{filled} && $_->{paidFor}, $orders->all;
-
- order_list_low($req, 'order_list_filled', 'Order list - Filled orders', @orders);
-}
-
-sub order_list_unfilled {
- my ($req) = @_;
-
- $req->user_can('shop_order_list')
- or return product_list($req, "You don't have access to the order list");
-
- my $orders = BSE::TB::Orders->new;
- my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
- grep $_->{complete} && !$_->{filled} && $_->{paidFor}, $orders->all;
-
- order_list_low($req, 'order_list_unfilled', 'Order list - Unfilled orders',
- @orders);
-}
-
-sub order_list_unpaid {
- my ($req) = @_;
-
- $req->user_can('shop_order_list')
- or return product_list($req, "You don't have access to the order list");
-
- my $orders = BSE::TB::Orders->new;
- my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
- grep $_->{complete} && !$_->{paidFor}, $orders->all;
-
- order_list_low($req, 'order_list_unpaid', 'Order list - Incomplete orders',
- @orders);
-}
-
-sub order_list_incomplete {
- my ($req) = @_;
-
- $req->user_can('shop_order_list')
- or return product_list($req, "You don't have access to the order list");
-
- my $orders = BSE::TB::Orders->new;
- my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
- grep !$_->{complete}, $orders->all;
-
- order_list_low($req, 'order_list_incomplete', 'Order list - Incomplete orders',
- @orders);
-}
-
-sub cart_item_opts {
- my ($cart_item, $product) = @_;
-
- my $avail_options = product_options($cfg);
-
- my @options = ();
- my @values = split /,/, $cart_item->{options};
- my @ids = split /,/, $product->{options};
- for my $opt_index (0 .. $#ids) {
- my $entry = $avail_options->{$ids[$opt_index]};
- my $option = {
- id=>$ids[$opt_index],
- value=>$values[$opt_index],
- desc => $entry->{desc} || $ids[$opt_index],
- };
- if ($entry->{labels}) {
- $option->{label} = $entry->{labels}{$values[$opt_index]};
- }
- else {
- $option->{label} = $option->{value};
- }
- push(@options, $option);
- }
-
- return @options;
-}
-
-sub nice_options {
- my (@options) = @_;
-
- if (@options) {
- return '('.join(", ", map("$_->{desc} $_->{label}", @options)).')';
- }
- else {
- return '';
- }
-}
-
-sub tag_siteuser {
- my ($order, $rsiteuser, $arg) = @_;
-
- unless ($$rsiteuser) {
- $$rsiteuser = $order->siteuser || {};
- }
-
- my $siteuser = $$rsiteuser;
- return '' unless $siteuser->{id};
-
- my $value = $siteuser->{$arg};
- defined $value or $value = '';
-
- return escape_html($value);
-}
-
-sub order_detail {
- my ($req, $message) = @_;
-
- $req->user_can('shop_order_detail')
- or return product_list($req, "You don't have access to order details");
-
- my $cgi = $req->cgi;
- my $id = $cgi->param('id');
- if ($id and
- my $order = BSE::TB::Orders->getByPkey($id)) {
- $message ||= $cgi->param('m') || '';
- my @lines = $order->items;
- my @products = map { Products->getByPkey($_->{productId}) } @lines;
- my $line_index = -1;
- my $product;
- my @options;
- my $option_index = -1;
- my $siteuser;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $CGI::Q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- BSE::Util::Tags->secure($req),
- item => sub { CGI::escapeHTML($lines[$line_index]{$_[0]}) },
- iterate_items_reset => sub { $line_index = -1 },
- iterate_items =>
- sub {
- if (++$line_index < @lines ) {
- $option_index = -1;
- @options = cart_item_opts($lines[$line_index],
- $products[$line_index]);
- return 1;
- }
- return 0;
- },
- order => sub { CGI::escapeHTML($order->{$_[0]}) },
- money =>
- sub {
- my ($func, $args) = split ' ', $_[0], 2;
- return sprintf("%.2f", $acts{$func}->($args)/100.0)
- },
- date =>
- sub {
- my ($func, $args) = split ' ', $_[0], 2;
- return display_date($acts{$func}->($args));
- },
- extension =>
- sub {
- sprintf("%.2f", $lines[$line_index]{units} * $lines[$line_index]{$_[0]}/100.0)
- },
- product => sub { CGI::escapeHTML($products[$line_index]{$_[0]}) },
- script => sub { $ENV{SCRIPT_NAME} },
- iterate_options_reset => sub { $option_index = -1 },
- iterate_options => sub { ++$option_index < @options },
- option => sub { CGI::escapeHTML($options[$option_index]{$_[0]}) },
- ifOptions => sub { @options },
- options => sub { nice_options(@options) },
- message => sub { $message },
- siteuser => [ \&tag_siteuser, $order, \$siteuser, ],
- );
- page('order_detail', \%acts);
- }
- else {
- order_list();
- }
-}
-
-sub order_filled {
- my ($req) = @_;
-
- $req->user_can('shop_order_filled')
- or return product_list($req, "You don't have access to order details");
-
- my $id = $req->cgi->param('id');
- if ($id and
- my $order = BSE::TB::Orders->getByPkey($id)) {
- my $filled = $req->cgi->param('filled');
- $order->{filled} = $filled;
- if ($order->{filled}) {
- $order->{whenFilled} = epoch_to_sql_datetime(time);
- my $user = $req->user;
- if ($user) {
- $order->{whoFilled} = $user->{logon};
- }
- else {
- $order->{whoFilled} = defined($ENV{REMOTE_USER})
- ? $ENV{REMOTE_USER} : "-unknown-";
- }
- }
- $order->save();
- if ($req->cgi->param('detail')) {
- order_detail($req);
- }
- else {
- order_list($req);
- }
- }
- else {
- order_list($req);
- }
-}
-
-#####################
-# utilities
-# perhaps some of these belong in a class...
-
-sub product_edit_refresh {
- my ($productid, $message, $name) = @_;
-
- my $url = '?edit_product=1&id='.$productid;
- $url .= '&message='.CGI::escape($message) if $message;
- $url .= "#$name" if $name;
-
- shop_redirect($url);
-}
-
-sub page {
- my ($which, $acts, $iter) = @_;
-
- BSE::Template->show_page('admin/'.$which, $cfg, $acts);
-}
-
-sub shop_url {
- my $url = shift;
- "$ENV{SCRIPT_NAME}$url"
-}
-
-sub shop_redirect {
- my $url = shift;
- print "Content-Type: text/html\n";
- print qq!Refresh: 0; url=\"!,shop_url($url),qq!"\n\n<html></html>\n!;
- exit;
-}
-
-# format an ANSI SQL date for display
-sub display_date {
- my ($date) = @_;
-
- if ( my ($year, $month, $day) =
- ($date =~ /^(\d+)-(\d+)-(\d+)/)) {
- return sprintf("%02d/%02d/%04d", $day, $month, $year);
- }
- return $date;
-}
-
-# convert a user entered date from dd/mm/yyyy to ANSI sql format
-# we try to parse flexibly here
-sub sql_date {
- my $str = shift;
- my ($year, $month, $day);
-
- # look for a date
- if (($day, $month, $year) = ($$str =~ m!(\d+)/(\d+)/(\d+)!)) {
- $year += 2000 if $year < 100;
-
- return $$str = sprintf("%04d-%02d-%02d", $year, $month, $day);
- }
- return undef;
-}
-
-sub money_to_cents {
- my $money = shift;
-
- $$money =~ /^\s*(\d+(\.\d*)|\.\d+)/
- or return undef;
- return $$money = sprintf("%.0f ", $$money * 100);
-}
-
-# convert an epoch time to sql format
-sub epoch_to_sql {
- use POSIX 'strftime';
- my ($time) = @_;
-
- return strftime('%Y-%m-%d', localtime $time);
-}
-
-# convert an epoch time to sql format
-sub epoch_to_sql_datetime {
- use POSIX 'strftime';
- my ($time) = @_;
-
- return strftime('%Y-%m-%d %H:%M', localtime $time);
-}
-
+use BSE::UI::AdminShop;
+use Carp 'confess';
-__END__
+$SIG{__DIE__} = sub { confess $@ };
-=head1 NAME
-
-shopadmin.pl - administration for the online-store tables
-
-=head1 SYNOPSYS
-
-(This is a CGI script.)
-
-=head1 DESCRIPTION
-
-shopadmin.pl gives a UI to edit the product table, and view the orders and
-order_item tables.
-
-=head1 TEMPLATES
-
-shopadmin.pl uses a few templates from the templates/admin directory.
-
-=head2 product_list.tmpl
-
-=over 4
-
-=item product I<name>
-
-Access to product fields.
-
-=item date I<name>
-
-Formats the I<name> field of the product as a date.
-
-=item money I<name>
-
-Formats the I<name> integer field as a 2 decimal place money value.
-
-=item iterator ... products
-
-Iterates over the products database in reverse expire order.
-
-=item script
-
-The name of the current script for use in URLs.
-
-=item message
-
-An error message that may have been passed in the 'message' parameter.
-
-=item hiddenNote
-
-'Deleted' if the expire date of the current product has passed.
-
-=back
-
-=head2 add_product.tmpl
-=head2 edit_product.tmpl
-=head2 product_detail.tmpl
-
-These use the same tags.
-
-=over 4
-
-=item product I<name>
-
-The specified field of the product.
-
-=item date I<name>
-
-Formats the given field of the product as a date.
-
-=item money I<name>
-
-Formats the given integer field of the product as money.
-
-=item action
-
-Either 'Add New' or 'Edit'.
-
-=item message
-
-The message parameter passed into the script.
-
-=item script
-
-The name of the script, for use in urls.
-
-=item ifImage
-
-Conditional, true if the product has an image.
-
-=item hiddenNote
-
-"Hidden" if the product is hidden.
-
-=back
-
-=head2 order_list.tmpl
-
-Used to display the list of orders. You can also specify a template
-parameter to the order_list target, and perform filtering and sorting
-within the template.
-
-=over 4
-
-=item order I<name>
-
-The given field of the order.
-
-=item iterator ... orders [filter-sort-spec]
-
-Iterates over the orders in reverse orderDate order.
-
-The [filter-sort-spec] can contain none, either or both of the following:
-
-=over
-
-=item filter= field op value, ...
-
-filter the data by checking the given expression.
-
-eg. filter= filled == 0
-
-=item sort= [+|-] keyword, ...
-
-Sorts the result by the specified fields, in reverse if preceded by '-'.
-
-=back
-
-=item money I<name>
-
-The given field of the current order formatted as money.
-
-=item date I<name>
-
-The given field of the current order formatted as a date.
-
-=item script
-
-The name of the script, for use in urls.
-
-=back
-
-=head2 order_detail.tmpl
-
-Used to display the details for an order.
-
-=over 4
-
-=item item I<name>
-
-Displays the given field of a line item
-
-=item iterator ... items
-
-Iterates over the line items in the order.
-
-=item order I<name>
-
-The given field of the order.
-
-=item money I<func> I<args>
-
-Formats the given functions return value as money.
-
-=item date I<func> I<args>
-
-Formats the given function return value as a date.
-
-=item extension I<name>
-
-Takes the given field for the current item multiplied by the units column.
-
-=item product I<name>
-
-The given product field of the product for the current item.
-
-=item script
-
-The name of the current script (for use in urls).
-
-=item iterator ... options
-
-Iterates over the options set for the current order item.
-
-=item option I<field>
-
-Access to a field of the option, any of id, value, desc or label.
-
-=item ifOptions
-
-Conditional tag, true if the current product has any options.
-
-=item options
-
-A laid-out list of the options set for the current order item.
-
-=back
+my $req = BSE::Request->new;
-=cut
+my $result = BSE::UI::AdminShop->dispatch($req);
+$req->output_result($result);
use lib "$FindBin::Bin/../modules";
use BSE::DB;
use BSE::Request;
-use BSE::Template;
use Carp 'confess';
use BSE::AdminSiteUsers;
my $req = BSE::Request->new;
my $result = BSE::AdminSiteUsers->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
#!/usr/bin/perl -w
# -d:ptkdb
-BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0' }
-
+BEGIN { $ENV{DISPLAY} = '192.168.32.50:0.0' }
use strict;
use FindBin;
use lib "$FindBin::Bin/../modules";
-use BSE::SubscriptionTypes;
use BSE::DB;
-use BSE::Util::Tags;
-use BSE::Template;
-use Articles;
-use BSE::WebUtil qw/refresh_to refresh_to_admin/;
-use BSE::Message;
-use BSE::Permissions;
use BSE::Request;
-use DevHelp::HTML;
-use BSE::Util::Iterate;
-
-my $req = BSE::Request->new;
-if (BSE::Permissions->check_logon($req)) {
- my $cfg = $req->cfg;
-
- my %steps =
- (
- list => \&list,
- add => \&add,
- addsave => \&addsave,
- edit => \&edit,
- editsave => \&editsave,
- start_send => \&start_send,
- send_form => \&send_form,
- html_preview => \&html_preview,
- text_preview => \&text_preview,
- filter_preview => \&filter_preview,
- send => \&send_message,
- send_test => \&send_test,
- delconfirm => \&req_delconfirm,
- delete => \&req_delete,
- );
-
- my $q = $req->cgi;
- my $action = 'list';
- for my $name (keys %steps) {
- if ($q->param($name)) {
- $action = $name;
- last;
- }
- }
-
- $steps{$action}->($q, $req, $cfg);
-}
-else {
- refresh_to($req->url('logon'));
-}
-
-sub tag_list_recipient_count {
- my ($subs, $subindex) = @_;
-
- $$subindex >= 0 && $$subindex < @$subs
- or return '** subscriber_count only valid inside subscriptions iterator **';
-
- $subs->[$$subindex]->recipient_count;
-}
-
-sub list {
- my ($q, $req, $cfg, $message) = @_;
-
- $message ||= $q->param('m') || '';
- my @subs = sort { lc $a->{name} cmp $b->{name} } BSE::SubscriptionTypes->all;
- my $subindex;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->make_iterator(\@subs, 'subscription', 'subscriptions',
- \$subindex),
- BSE::Util::Tags->secure($req),
- BSE::Util::Tags->admin(\%acts, $cfg),
- message => sub { CGI::escapeHTML($message) },
- recipient_count => [ \&tag_list_recipient_count, \@subs, \$subindex ],
- );
- BSE::Template->show_page('admin/subs/list', $cfg, \%acts);
-}
-
-sub _template_popup {
- my ($cfg, $q, $sub, $old, $args) = @_;
-
- my ($name, $type, $optional) = split ' ', $args;
-
- my @templates;
- my $base = 'common';
- if ($type) {
- $base = $cfg->entry('subscriptions', "${type}_templates")
- || $type;
- }
- for my $dir (BSE::Template->template_dirs($cfg)) {
- if (opendir TEMPL, "$dir/$base") {
- push(@templates, sort map "$base/$_",
- grep -f "$dir/$base/$_" && /\.tmpl$/i, readdir TEMPL);
- closedir TEMPL;
- }
- }
- my %seen_templates;
- @templates = sort grep !$seen_templates{$_}++, @templates;
- @templates or push(@templates, "Could not find templates in $base");
- my $def = $old ? $q->param($name) :
- $sub ? $sub->{$name} : $templates[0];
- my %labels;
- @labels{@templates} = @templates;
- if ($optional) {
- unshift(@templates, '');
- $labels{''} = "(no HTML part)";
- }
- return CGI::popup_menu(-name=>$name, -values=>\@templates,
- -labels=>\%labels,
- -default=>$def, -override=>1);
-}
-
-sub _valid_archive_types {
- my ($req) = @_;
-
- my %valid;
- my %types = $req->cfg->entriesCS('valid child types');
- for my $type (keys %types) {
- for my $child (split /,/, $types{$type}) {
- if ($child eq 'Article') {
- $valid{$type} = 1;
- last;
- }
- }
- }
-
- return keys %valid;
-}
-
-sub _parent_popup {
- my ($req, $sub, $old) = @_;
-
- my %valid_types = map { $_ => 1 } _valid_archive_types($req);
- my $shopid = $req->cfg->entryErr('articles', 'shop');
- my @all = grep($req->user_can('edit_add_child', $_)
- || $sub->{parentId} == $_->{id},
- Articles->all());
- @all =
- grep
- {
- my $type = ($_->{generator} =~ /(\w+)$/)[0] || 'Article';
-
- $valid_types{$type} && $_->{id} != $shopid
- } @all;
- my %labels = map { $_->{id}, "$_->{title} ($_->{id})" } @all;
- @all = sort { lc $labels{$a->{id}} cmp lc $labels{$b->{id}} } @all;
- my @extras;
- unless ($old) {
- if ($sub) {
- @extras = ( -default=>$sub->{parentId} );
- }
- else {
- # use the highest id, presuming the most recent article created
- # was created to store subscriptions
- my $max = -1;
- $max < $_->{id} and $max = $_->{id} for @all;
- @extras = ( -default=>$max );
- }
- }
- return CGI::popup_menu(-name=>'parentId',
- -values=> [ map $_->{id}, @all ],
- -labels => \%labels,
- @extras);
-}
-
-sub sub_form {
- my ($q, $req, $cfg, $template, $sub, $old, $errors) = @_;
-
- my %defs = ( archive => 1, visible => 1 );
-
- my $message = '';
- $errors ||= [];
- $message = join("<br>\n", map CGI::escapeHTML($_->[1]), @$errors)
- if @$errors;
- my %errors;
- for my $error (@$errors) {
- push(@{$errors{$error->[0]}}, $error->[1]);
- }
- unless ($message) {
- $message = $q->param('m');
- defined $message or $message = '';
- $message = escape_html($message);
- }
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- old =>
- sub {
- CGI::escapeHTML($old ? $q->param($_[0]) :
- $sub ? $sub->{$_[0]} :
- $defs{$_[0]} || '');
- },
- message => sub { $message },
- template => sub { return _template_popup($cfg, $q, $sub, $old, $_[0]) },
- parent=> sub { _parent_popup($req, $sub, $old) },
- error =>
- sub {
- my ($name, $sep) = split ' ', $_[0], 2;
- if (my $msgs = $errors{$_[0]}) {
- $sep ||= ',';
- return join($sep, map CGI::escapeHTML($_), @$msgs);
- }
- else {
- return '';
- }
- },
- ifNew => !defined($sub),
- );
- if ($sub) {
- $acts{subscription} =
- sub {
- CGI::escapeHTML($sub->{$_[0]});
- };
- }
-
- BSE::Template->show_page($template, $cfg, \%acts);
-}
-
-sub add {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_add')
- or return list($q, $req, $cfg, "You dont have access to add subscriptions");
-
- sub_form($q, $req, $cfg, 'admin/subs/edit', undef, 0);
-}
-
-sub validate {
- my ($req, $q, $cfg, $errors, $sub) = @_;
-
- my @needed = qw(name title description frequency text_template);
- push(@needed, qw/article_template parentId/) if $q->param('archive');
- for my $field (@needed) {
- my $value = $q->param($field);
- defined $value and length $value
- or push(@$errors, [ $field, "\u$field must be entered" ]);
- }
- for my $field (qw(html_template text_template article_template)) {
- my $value = $q->param($field);
- if ($value) {
- if ($value =~ /\.\./) {
- push(@$errors, [ $field, "Template $value is invalid, contains .." ]);
- }
- elsif (!BSE::Template->find_source($value, $cfg)) {
- push(@$errors, [ $field, "Template $value does not exist" ]);
- }
- }
- }
- if ($q->param('archive')) {
- my $id = $q->param('parentId');
- if ($id) {
- my $article = Articles->getByPkey($id);
- if ($article) {
- unless ($req->user_can('edit_add_child', $article)
- || ($sub && $sub->{parentId} == $id)) {
- push @$errors, [ parentId => "You don't have permission to add children to that article" ];
- }
- }
- else {
- push(@$errors, [ 'parentId', "Select a parent for the archive" ]);
- }
- }
- }
-
- return !@$errors;
-}
-
-sub _refresh_list {
- my ($q, $cfg, $msg) = @_;
-
- my $url = $q->param('r');
- unless ($url) {
- $url = "/cgi-bin/admin/subs.pl";
- if ($msg) {
- $url .= "?m=" . CGI::escape($msg);
- }
- }
-
- refresh_to_admin($cfg, $url);
-}
-
-sub addsave {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_add')
- or return list($q, $req, $cfg, "You dont have access to add subscriptions");
-
- my @errors;
- if (validate($req, $q, $cfg, \@errors)) {
- my %subs;
- my @fields = grep $_ ne 'id', BSE::SubscriptionType->columns;
- for my $field (@fields) {
- $subs{$field} = $q->param($field) if defined $q->param($field);
- }
- $subs{archive} = () = $q->param('archive');
- $subs{visible} = 0 + defined $q->param('visible');
- $subs{lastSent} = '0000-00-00 00:00';
- my $sub = BSE::SubscriptionTypes->add(@subs{@fields});
-
- _refresh_list($q, $cfg, "Subscription created");
- }
- else {
- sub_form($q, $req, $cfg, 'admin/subs/edit', undef, 1, \@errors);
- }
-}
-
-sub edit {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_edit')
- or return list($q, $req, $cfg, "You dont have access to edit subscriptions");
-
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, "No id supplied to be edited");
-
-
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, "Cannot find record $id");
-
- sub_form($q, $req, $cfg, 'admin/subs/edit', $sub, 0);
-}
-
-sub editsave {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_edit')
- or return list($q, $req, $cfg, "You dont have access to edit subscriptions");
-
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, "No id supplied to be edited");
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, "Cannot find record $id");
-
- my @errors;
- if (validate($req, $q, $cfg, \@errors, $sub)) {
- my @fields = grep $_ ne 'id', BSE::SubscriptionType->columns;
- for my $field (@fields) {
- $sub->{$field} = $q->param($field) if defined $q->param($field);
- }
- $sub->{archive} = () = $q->param('archive');
- $sub->{visible} = 0 + defined $q->param('visible');
- $sub->save();
- _refresh_list($q, $cfg, "Subscription saved");
- }
- else {
- sub_form($q, $req, $cfg, 'admin/subs/edit', $sub, 1, \@errors);
- }
-}
-
-sub start_send {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
-
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be edited"));
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- sub => sub { CGI::escapeHTML($sub->{$_[0]}) },
- );
- BSE::Template->show_page('admin/subs/start_send', $cfg, \%acts);
-}
-
-sub tag_recipient_count {
- my ($sub, $rcount_cache) = @_;
-
- defined $$rcount_cache or $$rcount_cache = $sub->recipient_count;
-
- $$rcount_cache;
-}
-
-sub send_form {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
-
- my @filters = BSE::SubscriptionTypes->filters($cfg);
-
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be edited"));
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
- my $count_cache;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- subscription => sub { CGI::escapeHTML($sub->{$_[0]}) },
- message => sub { '' },
- ifError => sub { 0 },
- old => sub { CGI::escapeHTML(defined $sub->{$_[0]} ? $sub->{$_[0]} : '') },
- template => sub { return _template_popup($cfg, $q, $sub, 0, $_[0]) },
- parent=> sub { _parent_popup($req, $sub) },
- recipient_count => [ \&tag_recipient_count, $sub, \$count_cache ],
- map($_->tags, @filters),
- ifFilters => scalar(@filters),
- );
-
- BSE::Template->show_page('admin/subs/send_form', $cfg, \%acts);
-}
-
-sub html_preview {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
-
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be edited"));
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
- my %opts;
- for my $key ($q->param()) {
- # I'm not worried about multiple items
- $opts{$key} = ($q->param($key))[0];
- }
- my $template = $q->param('html_template');
- $template = $sub->{html_template} unless defined $template;
- if ($template) {
- # build a fake article
- my $text = $sub->html_format($cfg, _dummy_user(), \%opts);
- print "Content-Type: text/html\n\n";
- print $text;
- }
- else {
- print <<EOS;
-Content-Type: text/html
-
-You have no HTML template selected.
-EOS
- }
-}
-
-sub _dummy_user {
- my %user;
- $user{id} = 0;
- $user{userId} = "username";
- $user{password} = "p455w0rd";
- $user{email} = 'dummy@example.com';
- $user{name1} = "Firstname";
- $user{name2} = "Lastname";
- $user{confirmSecret} = "X" x 32;
-
- \%user;
-}
-
-sub text_preview {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
-
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be edited"));
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
-
- my %opts;
- for my $key ($q->param()) {
- # I'm not worried about multiple items
- $opts{$key} = ($q->param($key))[0];
- }
- my $text = $sub->text_format($cfg, _dummy_user(), \%opts);
- if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
- # IE is so broken
- print "Content-Type: text/html\n\n";
- print "<html><body><pre>",CGI::escapeHTML($text),"</pre></body></html>";
- }
- else {
- print "Content-Type: text/plain\n\n";
- print $text;
- }
-}
-
-sub filter_preview {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be edited"));
-
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
-
- my @filters = BSE::SubscriptionTypes->filters($cfg);
- my @all_subscribers = $sub->recipients;
- my @filter_res;
- my @subscribers = @all_subscribers;
-
- my $index = 1;
- for my $filter (@filters) {
- if ($q->param("criteria$index")) {
- my @members = $filter->members($q);
- my %members = map { $_ => 1 } @members;
- @subscribers = grep $members{$_->{id}}, @subscribers;
- # not much to say at this point
- push @filter_res,
- {
- enabled => 1,
- filter_count => scalar(@members),
- subscriber_count => scalar(@subscribers),
- };
- }
- else {
- push @filter_res,
- {
- enabled => 0,
- filter_count => 0,
- subcriber_count => scalar(@subscribers),
- };
- }
- ++$index;
- }
-
- my $it = BSE::Util::Iterate->new;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- subscription => sub { CGI::escapeHTML($sub->{$_[0]}) },
- (map {;
- "filter$_" => [ \&tag_hash, $filter_res[$_-1] ],
- } 1..@filters),
- $it->make_iterator(undef, 'filter', 'filters', \@filter_res),
- total_count => scalar(@all_subscribers),
- filter_count => scalar(@subscribers),
- );
-
- BSE::Template->show_page('admin/subs/filter_preview', $cfg, \%acts);
-}
-
-sub _first {
- for (@_) {
- return $_ if defined;
- }
- undef;
-}
-
-sub _send_errors {
- my ($q, $cfg, $sub, $errors) = @_;
-
- my @errors = map +{ field=> $_, message => $errors->{$_} }, keys %$errors;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- subscription => sub { escape_html($sub->{$_[0]}) },
- BSE::Util::Tags->make_iterator(\@errors, 'error', 'errors'),
- );
-
- BSE::Template->show_page('admin/subs/send_error', $cfg, \%acts);
-}
-
-sub _send_setup {
- my ($q, $req, $cfg, $opts, $rsub) = @_;
-
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, $msgs->(startnoid=>"No id supplied to be sent"));
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, $msgs->(startnosub=>"Cannot find record $id"));
-
- my %errors;
- for my $key ($q->param()) {
- # I'm not worried about multiple items
- $opts->{$key} = ($q->param($key))[0];
- }
- if ($q->param('have_archive_check')) {
- $opts->{archive} = defined $q->param('archive')
- }
- # work our way through, so we have a consistent set of data to validate
- for my $key (grep $_ ne 'id', BSE::SubscriptionType->columns) {
- unless (exists $opts->{$key}) {
- $opts->{$key} = $sub->{$key};
- }
- }
- if ($opts->{archive} &&
- ($opts->{parentId} && $opts->{parentId} != $sub->{parentId})) {
- $req->user_can('edit_add_child', $opts->{parentId})
- or $errors{parentId} = "You cannot add children to the archive parent";
- }
- $opts->{title} eq ''
- and $errors{title} = "Please enter a title";
- $opts->{body} eq ''
- and $errors{body} = "Please enter a body";
-
- if (keys %errors) {
- _send_errors($q, $cfg, $sub, \%errors);
- return;
- }
-
- $$rsub = $sub;
-
- return 1;
-}
-
-sub send_test {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
-
- my %opts;
- my $sub;
- _send_setup($q, $req, $cfg, \%opts, \$sub)
- or return;
-
- $cfg->entry('subscriptions', 'testing', 1)
- or return _send_errors($q, $cfg, $sub,
- { error => "Test subscription messages disabled" });
-
- # make sure the user is being authenticated in some way
- # this prevents spammers from using this to send their messages
- $ENV{REMOTE_USER} || $req->getuser
- or return _send_errors($q, $cfg, $sub,
- { error => "You must be authenticated to use this function. Either enable access control or setup .htpasswd." });
-
- my $testemail = $q->param('testemail');
- my $testname = $q->param('testname');
- my $testtextonly = $q->param('testtextonly');
-
- require SiteUsers;
- my %recipient =
- (
- (map { $_ => '' } SiteUser->columns),
- id => 999,
- userId => 'xxxx',
- email => $testemail,
- name1 => $testname,
- confirmSecret => 'TESTTESTTESTTESTTESTTESTTESTTEST',
- textOnlyMail => (defined $testtextonly ? 1 : 0 ),
- );
-
- my %errors;
- unless ($testemail && $testemail =~ /.\@./) {
- $errors{testemail} = "Please enter a test email address to send a test";
- }
- unless ($testname) {
- $errors{testname} = "Please enter a test name to send a test";
- }
- if (keys %errors) {
- _send_errors($q, $cfg, $sub, \%errors);
- return;
- }
-
- 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;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- subscription => sub { escape_html($sub->{$_[0]}) },
- message => sub { $acts_message },
- user => sub { $acts_user ? escape_html($acts_user->{$_[0]}) : '' },
- ifUser => sub { $acts_user },
- ifError => sub { $is_error },
- testing => 1,
- );
- BSE::Template->show_replaced($prefix, $cfg, \%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);
- },
- \%recipient);
- print BSE::Template->replace($suffix, $cfg, \%acts);
-}
-
-sub _get_filtered_ids {
- my ($req) = @_;
-
- my @filters = BSE::SubscriptionTypes->filters($req->cfg);
-
- my $cgi = $req->cgi;
-
- # only want the enabled filters
- my @active;
- my $index = 1;
- for my $filter (@filters) {
- push @active, $filter
- if $cgi->param("criteria$index");
- ++$index;
- }
- @active
- or return;
-
- my $first = shift @active;
- my @ids = $first->members($req->cgi);
- for my $filter (@active) {
- my %members = map { $_=>1 } $filter->members($req->cgi);
- @ids = grep $members{$_}, @ids;
- }
-
- \@ids;
-}
-
-sub send_message {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_send')
- or return list($q, $req, $cfg, "You dont have access to send subscriptions");
-
- my %opts;
- my $sub;
- _send_setup($q, $req, $cfg, \%opts, \$sub)
- or return;
-
- 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;
- my %acts;
- %acts =
- (
- BSE::Util::Tags->basic(\%acts, $q, $cfg),
- BSE::Util::Tags->admin(\%acts, $cfg),
- subscription => sub { escape_html($sub->{$_[0]}) },
- message => sub { $acts_message },
- user => sub { $acts_user ? escape_html($acts_user->{$_[0]}) : '' },
- ifUser => sub { $acts_user },
- ifError => sub { $is_error },
- testing => 0,
- );
- BSE::Template->show_replaced($prefix, $cfg, \%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);
- }, $filtered_ids);
- print BSE::Template->replace($suffix, $cfg, \%acts);
-}
-
-sub req_delconfirm {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_delete')
- or return list($q, $req, $cfg, "You dont have access to delete subscriptions");
-
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, "No id supplied to be deleted");
-
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, "Cannot find record $id");
-
- sub_form($q, $req, $cfg, 'admin/subs/delete', $sub, 0);
-}
-
-sub req_delete {
- my ($q, $req, $cfg) = @_;
-
- $req->user_can('subs_delete')
- or return list($q, $req, $cfg, "You dont have access to delete subscriptions");
-
- my $id = $q->param('id')
- or return _refresh_list($q, $cfg, "No id supplied to be deleted");
+use BSE::Template;
+use Carp 'confess';
+use BSE::UI::AdminNewsletter;
- my $sub = BSE::SubscriptionTypes->getByPkey($id)
- or return _refresh_list($q, $cfg, "Cannot find record $id");
+$SIG{__DIE__} = sub { confess $@ };
- $sub->remove;
+my $req = BSE::Request->new;
- _refresh_list($q, $cfg, "Subscription deleted");
-}
+my $result = BSE::UI::AdminNewsletter->dispatch($req);
+$req->output_result($result);
use lib "$FindBin::Bin/../modules";
use BSE::DB;
use BSE::Request;
-use BSE::Template;
use Carp 'confess';
use BSE::UI::SiteUserUpdate;
my $req = BSE::Request->new;
my $result = BSE::UI::SiteUserUpdate->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
package BSE::AdminMenu;
use strict;
use BSE::Util::Tags;
-use BSE::Permissions;
+use base 'BSE::UI::AdminDispatch';
my %actions =
(
menu=>1,
);
-sub dispatch {
- my ($class, $req) = @_;
-
- my $cgi = $req->cgi;
- my $action;
- for my $check (keys %actions) {
- if ($cgi->param("a_$check")) {
- $action = $check;
- last;
- }
- }
- $action ||= 'menu';
- my $method = "req_$action";
- $class->$method($req);
-}
+sub actions { \%actions }
+
+sub rights { +{} }
+
+sub default_action { 'menu' }
sub req_menu {
my ($class, $req, $msg) = @_;
$msg ||= $req->cgi->param('m') || '';
- BSE::Permissions->check_logon($req)
- or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
my %acts;
%acts =
message => $msg,
);
- my $template = 'admin/menu';
- my $t = $req->cgi->param('_t');
- $template .= "_$t" if defined($t) && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/menu', \%acts);
}
1;
use BSE::SubscriptionTypes;
use BSE::CfgInfo qw(custom_class);
use constant SITEUSER_GROUP_SECT => 'BSE Siteuser groups validation';
+use BSE::Template;
my %actions =
(
'booking', 'bookings'),
);
- my $t = $req->cgi->param('_t');
- $template .= "_$t" if defined($t) && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response($template, \%acts);
}
sub iter_seminar_bookings {
[ \&tag_if_subscribed_register, $cgi, $req->cfg, \@subs, \$sub_index ],
);
- my $template = 'admin/users/add';
- my $t = $req->cgi->param('_t');
- $template .= "_$t" if defined($t) && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/users/add', \%acts);
}
sub req_add {
$it->make_iterator(undef, 'group', 'groups', \@groups),
);
- return $req->response('admin/users/grouplist', \%acts);
+ return $req->dyn_response('admin/users/grouplist', \%acts);
}
sub req_addgroupform {
error_img => [ \&tag_error_img, $req->cfg, $errors ],
);
- return $req->response('admin/users/groupadd', \%acts);
+ return $req->dyn_response('admin/users/groupadd', \%acts);
}
sub req_addgroup {
group => [ \&tag_hash, $group ],
);
- return $req->response($template, \%acts);
+ return $req->dyn_response($template, \%acts);
}
sub req_deletegroupform {
ifMember => [ \&tag_ifMember, \$user, \%members ],
);
- return $req->response('admin/users/groupmembers', \%acts);
+ return $req->dyn_response('admin/users/groupmembers', \%acts);
}
sub req_savegroupmembers {
use strict;
use BSE::Util::Tags qw/tag_error_img/;
use BSE::Permissions;
-use DevHelp::HTML;
+use DevHelp::HTML qw(:default popup_menu);
use BSE::CfgInfo qw(admin_base_url);
+use BSE::Template;
my %actions =
(
my %acts;
%acts = $class->common_tags($req, $msg, $errors);
- return BSE::Template->get_response('admin/userlist', $req->cfg, \%acts);
+ return $req->dyn_response('admin/userlist', \%acts);
}
sub req_adduserform {
my %acts;
%acts = $class->common_tags($req, $msg, $errors);
- return BSE::Template->get_response('admin/adduser', $req->cfg, \%acts);
+ return $req->dyn_response('admin/adduser', \%acts);
}
sub req_groups {
my %acts;
%acts = $class->common_tags($req, $msg, $errors);
- return BSE::Template->get_response('admin/grouplist', $req->cfg, \%acts);
+ return $req->dyn_response('admin/grouplist', \%acts);
}
sub req_addgroupform {
my ($class, $req, $msg, $errors) = @_;
my %acts;
- %acts = $class->common_tags($req, $msg, $errors);
+ %acts =
+ (
+ $class->common_tags($req, $msg, $errors),
+ template_set_popup => [ \&tag_template_set_popup, $req, undef ],
+ );
- return BSE::Template->get_response('admin/addgroup', $req->cfg, \%acts);
+ return $req->dyn_response('admin/addgroup', \%acts);
}
sub refresh {
defined $name && length $name
or $errors{name} = 'No name supplied';
$description = '' unless defined $description;
+ require BSE::TB::AdminGroups;
+ my %valid_sets = map { $_ => 1 }
+ BSE::TB::AdminGroups->group_template_set_values($req->cfg);
+ my $template_set = $cgi->param('template_set');
+ defined $template_set or $template_set = '';
+ exists $valid_sets{$template_set}
+ or $errors{template_set} =
+ $req->text(bse_invalid_group_template_set =>
+ 'Please select a valid template_set');
+
keys %errors
and return $class->req_addgroupform($req, undef, \%errors);
- require BSE::TB::AdminGroups;
my $old = BSE::TB::AdminGroups->getBy(name=>$name)
and return $class->req_addgroupform($req, "Group '$name' already exists");
my %group =
(
- type => 'g',
- name => $name,
- description => $description,
- perm_map => '',
+ type => 'g',
+ name => $name,
+ description => $description,
+ template_set => $template_set,
+ perm_map => '',
);
my @cols = BSE::TB::AdminGroup->columns;
shift @cols;
substr($obj->{perm_map}, $id, 1);
}
+sub tag_template_set_popup {
+ my ($req, $group) = @_;
+
+ my $set = $group ? $group->{template_set} : '';
+ require BSE::TB::AdminGroups;
+ my @values = BSE::TB::AdminGroups->group_template_set_values($req->cfg);
+ my %labels = BSE::TB::AdminGroups->group_template_set_labels($req);
+
+ popup_menu(-name => 'template_set',
+ -values => \@values,
+ -labels => \%labels,
+ -default => $set);
+}
+
sub showuser_tags {
my ($class, $req, $user, $msg, $errors) = @_;
$class->showuser_tags($req, $user, $msg, $errors),
);
- my $template = 'admin/showuser';
- my $t = $cgi->param('_t');
- $template .= "_$t" if $t && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/showuser', \%acts);
}
sub iter_get_kids {
$class->article_tags($req, $user, $article),
);
- my $template = 'admin/showuserart';
- my $t = $cgi->param('_t');
- $template .= "_$t" if $t && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/showuserart', \%acts);
}
sub req_showgroupart {
$class->article_tags($req, $group, $article),
);
- my $template = 'admin/showgroupart';
- my $t = $cgi->param('_t');
- $template .= "_$t" if $t && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/showgroupart', \%acts);
}
sub req_showobjectart {
([ \&iter_get_gperms, $req->cfg ], 'gperm', 'gperms' ),
ifGperm_set =>
[ \&tag_if_gperm_set, $group ],
+ template_set_popup => [ \&tag_template_set_popup, $req, $group ],
);
}
$class->showgroup_tags($req, $group, $msg, $errors),
);
- my $template = 'admin/showgroup';
- my $t = $cgi->param('_t');
- $template .= "_$t" if $t && $t =~ /^\w+$/;
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/showgroup', \%acts);
}
sub req_saveuser {
or return $class->req_groups($req, "Group id $groupid not found");
my $description = $cgi->param('description');
my $name = $cgi->param('name');
- $group->{description} = $description if defined $description;
+ my %valid_sets = map { $_ => 1 }
+ BSE::TB::AdminGroups->group_template_set_values($req->cfg);
+ my %errors;
+
+ my $template_set = $cgi->param('template_set');
+ if (defined $template_set and !exists $valid_sets{$template_set}) {
+ $errors{template_set} = "Invalid template set";
+ }
+
if (defined $name) {
- length $name
- or return $class->req_showgroup($req, undef, { name => 'No name supplied' });
-
- if (lc $name ne lc $group->{name}) {
- require BSE::TB::AdminGroups;
- my $old = BSE::TB::AdminGroups->getBy(name=>$name)
- and return $class->req_showgroup($req, undef,
- { name => "Group '$name' already exists" });
- $group->{name} = $name;
+ if (length $name) {
+ if (lc $name ne lc $group->{name}) {
+ require BSE::TB::AdminGroups;
+ my $old = BSE::TB::AdminGroups->getBy(name=>$name);
+ if ($old) {
+ $errors{name} = "Group '$name' already exists";
+ }
+ }
+ }
+ else {
+ $errors{name} = 'No name supplied';
}
}
+ keys %errors
+ and return $class->req_showgroup($req, undef, \%errors);
+
if ($cgi->param('savegperms') && $req->user_can("admin_group_save_gperms")) {
my $perms = '';
my @gperms = $cgi->param('gperms');
}
$group->{perm_map} = $perms;
}
+
+ defined $name and $group->{name} = $name;
+ defined $template_set and $group->{template_set} = $template_set;
+ defined $description and $group->{description} = $description;
+
$group->save;
if ($cgi->param('saveusers') && $req->user_can("admin_group_save_users")) {
package BSE::ChangePW;
use strict;
use BSE::Util::Tags qw(tag_error_img);
-use BSE::Permissions;
use DevHelp::HTML;
+use base 'BSE::UI::AdminDispatch';
my %actions =
(
change=>1
);
-sub dispatch {
- my ($class, $req) = @_;
+sub actions {
+ \%actions;
+}
- my $cgi = $req->cgi;
- my $action;
- for my $check (keys %actions) {
- if ($cgi->param("a_$check")) {
- $action = $check;
- last;
- }
- }
- $action ||= 'form';
- my $method = "req_$action";
- $class->$method($req);
+sub rights {
+ +{}
+}
+
+sub default_action {
+ 'form';
}
sub req_form {
error_img => [ \&tag_error_img, $req->cfg, $errors ],
);
- my $template = 'admin/changepw';
-
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response('admin/changepw', \%acts);
}
sub req_change {
select bs.*, gr.* from admin_base bs, admin_groups gr
where bs.id = gr.base_id and bs.id = ?
SQL
- addAdminGroup => 'insert into admin_groups values(?,?,?,?)',
- replaceAdminGroup => 'replace into admin_groups values(?,?,?,?)',
+ addAdminGroup => 'insert into admin_groups values(?,?,?,?,?)',
+ replaceAdminGroup => 'replace into admin_groups values(?,?,?,?,?)',
deleteAdminGroup => 'delete from admin_groups where base_id = ?',
groupUsers => 'select * from admin_membership where group_id = ?',
'AdminGroups.userPermissionGroups' => <<SQL,
my $template = $article->{id} ?
$self->edit_template($article, $cgi) : $self->add_template($article, $cgi);
- return BSE::Template->get_response($template, $request->cfg, \%acts);
+ return $request->dyn_response($template, \%acts);
}
sub edit_form {
%acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
my $template = 'admin/article_img';
- return BSE::Template->get_response($template, $req->cfg, \%acts);
+ return $req->dyn_response($template, \%acts);
}
sub save_image_changes {
return BSE::Permissions->check_logon($self);
}
+sub template_sets {
+ my ($self) = @_;
+
+ return () unless $self->access_control;
+
+ my $user = $self->user
+ or return;
+
+ return grep $_ ne '', map $_->{template_set}, $user->groups;
+}
my $site_article =
{
sub dyn_response {
my ($req, $template, $acts) = @_;
+ my @search = $template;
my $base_template = $template;
my $t = $req->cgi->param('t');
$t or $t = $req->cgi->param('_t');
if ($t && $t =~ /^\w+$/) {
$template .= "_$t";
+ unshift @search, $template;
+ }
+
+ require BSE::Template;
+ my @sets;
+ if ($template =~ m!^admin/!) {
+ @sets = $req->template_sets;
}
return BSE::Template->get_response($template, $req->cfg, $acts,
- $base_template);
+ $base_template, \@sets);
}
sub response {
sub columns {
return ($_[0]->SUPER::columns,
- qw/base_id name description perm_map/ );
+ qw/base_id name description perm_map template_set/ );
}
sub bases {
use strict;
use base 'Squirrel::Table';
use BSE::TB::AdminGroup;
+use constant SECT_TEMPLATE_SETS => 'admin group template sets';
sub rowClass {
return 'BSE::TB::AdminGroup';
}
+sub group_template_set_values {
+ my ($class, $cfg) = @_;
+
+ my %entries = $cfg->entries(SECT_TEMPLATE_SETS);
+ return
+ (
+ "",
+ sort keys %entries,
+ );
+}
+
+sub group_template_set_labels {
+ my ($class, $req) = @_;
+
+
+ my %entries = $req->cfg->entries(SECT_TEMPLATE_SETS);
+ return
+ (
+ "" => $req->text(bse_group_no_template_set => "(none)"),
+ %entries,
+ );
+}
+
1;
$self->SUPER::remove();
}
+sub groups {
+ my ($self) = @_;
+
+ require BSE::TB::AdminGroups;
+
+ BSE::TB::AdminGroups->getSpecial(forUser => $self->{id});
+}
+
1;
use Carp 'confess';
sub get_page {
- my ($class, $template, $cfg, $acts, $base_template) = @_;
+ my ($class, $template, $cfg, $acts, $base_template, $rsets) = @_;
- my @dirs = $class->template_dirs($cfg);
+ my @conf_dirs = $class->template_dirs($cfg);
my $file = $cfg->entry('templates', $template) || $template;
$file =~ /\.\w+$/ or $file .= ".tmpl";
-
+ my @dirs;
+ if ($rsets && @$rsets) {
+ for my $set (@$rsets) {
+ push @dirs, map "$_/$set", @conf_dirs;
+ }
+ push @dirs, @conf_dirs;
+ }
+ else {
+ @dirs = @conf_dirs;
+ }
my $obj = Squirrel::Template->new(template_dir => \@dirs);
}
sub get_response {
- my ($class, $template, $cfg, $acts, $base_template) = @_;
+ my ($class, $template, $cfg, $acts, $base_template, $rsets) = @_;
my $result =
{
type => $class->get_type($cfg, $template),
- content => scalar($class->get_page($template, $cfg, $acts, $base_template)),
+ content => scalar($class->get_page($template, $cfg, $acts,
+ $base_template, $rsets)),
};
push @{$result->{headers}}, "Content-Length: ".length($result->{content});
sub output_result {
my ($class, $req, $result) = @_;
+ $result
+ or return;
+
select STDOUT;
$| = 1;
push @{$result->{headers}}, "Content-Type: $result->{type}"
--- /dev/null
+package BSE::UI::AdminNewsletter;
+use strict;
+use BSE::SubscriptionTypes;
+use BSE::Util::Tags qw(tag_hash);
+use Articles;
+use BSE::Message;
+use DevHelp::HTML qw(:default popup_menu);
+use BSE::Util::Iterate;
+use base 'BSE::UI::AdminDispatch';
+
+my %actions =
+ (
+ list => '',
+ add => 'subs_add',
+ addsave => 'subs_add',
+ edit => 'subs_edit',
+ editsave => 'subs_edit',
+ start_send => 'subs_send',
+ send_form => 'subs_send',
+ html_preview => 'subs_send',
+ text_preview => 'subs_send',
+ filter_preview => 'subs_send',
+ send => 'subs_send',
+ send_test => 'subs_send',
+ delconfirm => 'subs_delete',
+ delete => 'subs_delete',
+ );
+
+sub actions {
+ \%actions;
+}
+
+sub rights {
+ \%actions;
+}
+
+sub default_action {
+ 'list';
+}
+
+sub action_prefix {
+ ''
+}
+
+sub tag_list_recipient_count {
+ my ($subs, $subindex) = @_;
+
+ $$subindex >= 0 && $$subindex < @$subs
+ or return '** subscriber_count only valid inside subscriptions iterator **';
+
+ $subs->[$$subindex]->recipient_count;
+}
+
+sub req_list {
+ my ($class, $req, $message) = @_;
+
+ my $q = $req->cgi;
+ my $cfg = $req->cfg;
+ $message ||= $q->param('m') || '';
+ my @subs = sort { lc $a->{name} cmp $b->{name} } BSE::SubscriptionTypes->all;
+ my $subindex;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ BSE::Util::Tags->make_iterator(\@subs, 'subscription', 'subscriptions',
+ \$subindex),
+ BSE::Util::Tags->secure($req),
+ BSE::Util::Tags->admin(\%acts, $cfg),
+ message => escape_html($message),
+ recipient_count => [ \&tag_list_recipient_count, \@subs, \$subindex ],
+ );
+
+ return $req->dyn_response('admin/subs/list', \%acts);
+}
+
+sub _template_popup {
+ my ($cfg, $q, $sub, $old, $args) = @_;
+
+ my ($name, $type, $optional) = split ' ', $args;
+
+ my @templates;
+ my $base = 'common';
+ if ($type) {
+ $base = $cfg->entry('subscriptions', "${type}_templates")
+ || $type;
+ }
+ for my $dir (BSE::Template->template_dirs($cfg)) {
+ if (opendir TEMPL, "$dir/$base") {
+ push(@templates, sort map "$base/$_",
+ grep -f "$dir/$base/$_" && /\.tmpl$/i, readdir TEMPL);
+ closedir TEMPL;
+ }
+ }
+ my %seen_templates;
+ @templates = sort grep !$seen_templates{$_}++, @templates;
+ @templates or push(@templates, "Could not find templates in $base");
+ my $def = $old ? $q->param($name) :
+ $sub ? $sub->{$name} : $templates[0];
+ my %labels;
+ @labels{@templates} = @templates;
+ if ($optional) {
+ unshift(@templates, '');
+ $labels{''} = "(no HTML part)";
+ }
+ return popup_menu(-name=>$name,
+ -values=>\@templates,
+ -labels=>\%labels,
+ -default=>$def);
+}
+
+sub _valid_archive_types {
+ my ($req) = @_;
+
+ my %valid;
+ my %types = $req->cfg->entriesCS('valid child types');
+ for my $type (keys %types) {
+ for my $child (split /,/, $types{$type}) {
+ if ($child eq 'Article') {
+ $valid{$type} = 1;
+ last;
+ }
+ }
+ }
+
+ return keys %valid;
+}
+
+sub _parent_popup {
+ my ($req, $sub, $old) = @_;
+
+ my %valid_types = map { $_ => 1 } _valid_archive_types($req);
+ my $shopid = $req->cfg->entryErr('articles', 'shop');
+ my @all = grep($req->user_can('edit_add_child', $_)
+ || ($sub && $sub->{parentId} == $_->{id}),
+ Articles->all());
+ @all =
+ grep
+ {
+ my $type = ($_->{generator} =~ /(\w+)$/)[0] || 'Article';
+
+ $valid_types{$type} && $_->{id} != $shopid
+ } @all;
+ my %labels = map { $_->{id}, "$_->{title} ($_->{id})" } @all;
+ @all = sort { lc $labels{$a->{id}} cmp lc $labels{$b->{id}} } @all;
+ my @extras;
+ unless ($old) {
+ if ($sub) {
+ @extras = ( -default=>$sub->{parentId} );
+ }
+ else {
+ # use the highest id, presuming the most recent article created
+ # was created to store subscriptions
+ my $max = -1;
+ $max < $_->{id} and $max = $_->{id} for @all;
+ @extras = ( -default=>$max );
+ }
+ }
+ return popup_menu(-name=>'parentId',
+ -values=> [ map $_->{id}, @all ],
+ -labels => \%labels,
+ @extras);
+}
+
+sub sub_form {
+ my ($req, $template, $sub, $old, $errors) = @_;
+
+ my $q = $req->cgi;
+ my $cfg = $req->cfg;
+ my %defs = ( archive => 1, visible => 1 );
+
+ my $message = '';
+ $errors ||= [];
+ $message = join("<br>\n", map escape_html($_->[1]), @$errors)
+ if @$errors;
+ my %errors;
+ for my $error (@$errors) {
+ push(@{$errors{$error->[0]}}, $error->[1]);
+ }
+ unless ($message) {
+ $message = $q->param('m');
+ defined $message or $message = '';
+ $message = escape_html($message);
+ }
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ BSE::Util::Tags->admin(\%acts, $cfg),
+ old =>
+ sub {
+ escape_html($old ? $q->param($_[0]) :
+ $sub ? $sub->{$_[0]} :
+ $defs{$_[0]} || '');
+ },
+ message => sub { $message },
+ template => sub { return _template_popup($cfg, $q, $sub, $old, $_[0]) },
+ parent=> sub { _parent_popup($req, $sub, $old) },
+ error =>
+ sub {
+ my ($name, $sep) = split ' ', $_[0], 2;
+ if (my $msgs = $errors{$_[0]}) {
+ $sep ||= ',';
+ return join($sep, map escape_html($_), @$msgs);
+ }
+ else {
+ return '';
+ }
+ },
+ ifNew => !defined($sub),
+ );
+ if ($sub) {
+ $acts{subscription} = [ \&tag_hash, $sub ];
+ }
+
+ return $req->dyn_response($template, \%acts);
+}
+
+sub req_add {
+ my ($class, $req) = @_;
+
+ return sub_form($req, 'admin/subs/edit', undef, 0);
+}
+
+sub validate {
+ my ($req, $q, $cfg, $errors, $sub) = @_;
+
+ my @needed = qw(name title description frequency text_template);
+ push(@needed, qw/article_template parentId/) if $q->param('archive');
+ for my $field (@needed) {
+ my $value = $q->param($field);
+ defined $value and length $value
+ or push(@$errors, [ $field, "\u$field must be entered" ]);
+ }
+ for my $field (qw(html_template text_template article_template)) {
+ my $value = $q->param($field);
+ if ($value) {
+ if ($value =~ /\.\./) {
+ push(@$errors, [ $field, "Template $value is invalid, contains .." ]);
+ }
+ elsif (!BSE::Template->find_source($value, $cfg)) {
+ push(@$errors, [ $field, "Template $value does not exist" ]);
+ }
+ }
+ }
+ if ($q->param('archive')) {
+ my $id = $q->param('parentId');
+ if ($id) {
+ my $article = Articles->getByPkey($id);
+ if ($article) {
+ unless ($req->user_can('edit_add_child', $article)
+ || ($sub && $sub->{parentId} == $id)) {
+ push @$errors, [ parentId => "You don't have permission to add children to that article" ];
+ }
+ }
+ else {
+ push(@$errors, [ 'parentId', "Select a parent for the archive" ]);
+ }
+ }
+ }
+
+ return !@$errors;
+}
+
+sub _refresh_list {
+ my ($req, $msg) = @_;
+
+ my $url = $req->cgi->param('r');
+ unless ($url) {
+ $url = "/cgi-bin/admin/subs.pl";
+ if ($msg) {
+ $url .= "?m=" . escape_uri($msg);
+ }
+ }
+
+ return BSE::Template->get_refresh($url, $req->cfg);
+}
+
+sub req_addsave {
+ my ($class, $req) = @_;
+
+ my $q = $req->cgi;
+ my $cfg = $req->cfg;
+ my @errors;
+ if (validate($req, $q, $cfg, \@errors)) {
+ my %subs;
+ my @fields = grep $_ ne 'id', BSE::SubscriptionType->columns;
+ for my $field (@fields) {
+ $subs{$field} = $q->param($field) if defined $q->param($field);
+ }
+ $subs{archive} = () = $q->param('archive');
+ $subs{visible} = 0 + defined $q->param('visible');
+ $subs{lastSent} = '0000-00-00 00:00';
+ my $sub = BSE::SubscriptionTypes->add(@subs{@fields});
+
+ return _refresh_list($req, "Subscription created");
+ }
+ else {
+ return sub_form($req, 'admin/subs/edit', undef, 1, \@errors);
+ }
+}
+
+sub req_edit {
+ my ($class, $req) = @_;
+
+ my $id = $req->cgi->param('id')
+ or return _refresh_list($req, "No id supplied to be edited");
+
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, "Cannot find record $id");
+
+ return sub_form($req, 'admin/subs/edit', $sub, 0);
+}
+
+sub req_editsave {
+ my ($class, $req) = @_;
+
+ my $q = $req->cgi;
+ my $cfg = $req->cfg;
+
+ my $id = $q->param('id')
+ or return _refresh_list($req, "No id supplied to be edited");
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, "Cannot find record $id");
+
+ my @errors;
+ if (validate($req, $q, $cfg, \@errors, $sub)) {
+ my @fields = grep $_ ne 'id', BSE::SubscriptionType->columns;
+ for my $field (@fields) {
+ $sub->{$field} = $q->param($field) if defined $q->param($field);
+ }
+ $sub->{archive} = () = $q->param('archive');
+ $sub->{visible} = 0 + defined $q->param('visible');
+ $sub->save();
+ return _refresh_list($req, "Subscription saved");
+ }
+ else {
+ return sub_form($req, 'admin/subs/edit', $sub, 1, \@errors);
+ }
+}
+
+sub req_start_send {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
+ my $id = $q->param('id')
+ or return _refresh_list($req, $msgs->(startnoid=>"No id supplied to be edited"));
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, $msgs->(startnosub=>"Cannot find record $id"));
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ sub => [ \&tag_hash, $sub ],
+ );
+
+ return $req->dyn_response('admin/subs/start_send', \%acts);
+}
+
+sub tag_recipient_count {
+ my ($sub, $rcount_cache) = @_;
+
+ defined $$rcount_cache or $$rcount_cache = $sub->recipient_count;
+
+ $$rcount_cache;
+}
+
+sub req_send_form {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my @filters = BSE::SubscriptionTypes->filters($cfg);
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
+ my $id = $q->param('id')
+ or return _refresh_list($req, $msgs->(startnoid=>"No id supplied to be edited"));
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, $msgs->(startnosub=>"Cannot find record $id"));
+ my $count_cache;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ BSE::Util::Tags->admin(\%acts, $cfg),
+ subscription => [ \&tag_hash, $sub ],
+ message => sub { '' },
+ ifError => sub { 0 },
+ old => sub { escape_html(defined $sub->{$_[0]} ? $sub->{$_[0]} : '') },
+ template => sub { return _template_popup($cfg, $q, $sub, 0, $_[0]) },
+ parent=> sub { _parent_popup($req, $sub) },
+ recipient_count => [ \&tag_recipient_count, $sub, \$count_cache ],
+ map($_->tags, @filters),
+ ifFilters => scalar(@filters),
+ );
+
+ return $req->dyn_response('admin/subs/send_form', \%acts);
+}
+
+sub req_html_preview {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
+ my $id = $q->param('id')
+ or return _refresh_list($req, $msgs->(startnoid=>"No id supplied to be edited"));
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, $msgs->(startnosub=>"Cannot find record $id"));
+ my %opts;
+ for my $key ($q->param()) {
+ # I'm not worried about multiple items
+ $opts{$key} = ($q->param($key))[0];
+ }
+ my $template = $q->param('html_template');
+ $template = $sub->{html_template} unless defined $template;
+ if ($template) {
+ # build a fake article
+ my $text = $sub->html_format($cfg, _dummy_user(), \%opts);
+ return
+ {
+ type => 'text/html',
+ content => $text,
+ };
+ }
+ else {
+ return
+ {
+ type => 'text/html',
+ content => 'You have no HTML template selected.',
+ };
+ }
+}
+
+sub _dummy_user {
+ my %user;
+ $user{id} = 0;
+ $user{userId} = "username";
+ $user{password} = "p455w0rd";
+ $user{email} = 'dummy@example.com';
+ $user{name1} = "Firstname";
+ $user{name2} = "Lastname";
+ $user{confirmSecret} = "X" x 32;
+
+ \%user;
+}
+
+sub req_text_preview {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
+ my $id = $q->param('id')
+ or return _refresh_list($req, $msgs->(startnoid=>"No id supplied to be edited"));
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, $msgs->(startnosub=>"Cannot find record $id"));
+
+ my %opts;
+ for my $key ($q->param()) {
+ # I'm not worried about multiple items
+ $opts{$key} = ($q->param($key))[0];
+ }
+ my $text = $sub->text_format($cfg, _dummy_user(), \%opts);
+
+ if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
+ return
+ {
+ type => 'text/html',
+ content => "<html><body><pre>".escape_html($text)."</pre></body></html>"
+ };
+ }
+ else {
+ return
+ {
+ type => 'text/plain',
+ content => $text,
+ };
+ }
+}
+
+sub req_filter_preview {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
+ my $id = $q->param('id')
+ or return _refresh_list($req, $msgs->(startnoid=>"No id supplied to be edited"));
+
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, $msgs->(startnosub=>"Cannot find record $id"));
+
+ my @filters = BSE::SubscriptionTypes->filters($cfg);
+ my @all_subscribers = $sub->recipients;
+ my @filter_res;
+ my @subscribers = @all_subscribers;
+
+ my $index = 1;
+ for my $filter (@filters) {
+ if ($q->param("criteria$index")) {
+ my @members = $filter->members($q);
+ my %members = map { $_ => 1 } @members;
+ @subscribers = grep $members{$_->{id}}, @subscribers;
+ # not much to say at this point
+ push @filter_res,
+ {
+ enabled => 1,
+ filter_count => scalar(@members),
+ subscriber_count => scalar(@subscribers),
+ };
+ }
+ else {
+ push @filter_res,
+ {
+ enabled => 0,
+ filter_count => 0,
+ subcriber_count => scalar(@subscribers),
+ };
+ }
+ ++$index;
+ }
+
+ my $it = BSE::Util::Iterate->new;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ BSE::Util::Tags->admin(\%acts, $cfg),
+ subscription => [ \&tag_hash, $sub ],
+ (map {;
+ "filter$_" => [ \&tag_hash, $filter_res[$_-1] ],
+ } 1..@filters),
+ $it->make_iterator(undef, 'filter', 'filters', \@filter_res),
+ total_count => scalar(@all_subscribers),
+ filter_count => scalar(@subscribers),
+ );
+
+ return $req->dyn_response('admin/subs/filter_preview', \%acts);
+}
+
+sub _first {
+ for (@_) {
+ return $_ if defined;
+ }
+ undef;
+}
+
+sub _send_errors {
+ my ($req, $sub, $errors) = @_;
+
+ my @errors = map +{ field=> $_, message => $errors->{$_} }, keys %$errors;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ subscription => [ \&tag_hash, $sub ],
+ BSE::Util::Tags->make_iterator(\@errors, 'error', 'errors'),
+ );
+
+ return $req->dyn_response('admin/subs/send_error', \%acts);
+}
+
+sub _send_setup {
+ my ($req, $opts, $rsub, $rresult) = @_;
+
+ my $q = $req->cgi;
+ my $cfg = $req->cfg;
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'subs');
+ my $id = $req->cgi->param('id');
+ unless ($id) {
+ $$rresult = _refresh_list($req, $msgs->(startnoid=>"No id supplied to be sent"));
+ return;
+ }
+ my $sub = BSE::SubscriptionTypes->getByPkey($id);
+ unless ($sub) {
+ $$rresult = _refresh_list($req, $msgs->(startnosub=>"Cannot find record $id"));
+ return;
+ }
+
+ my %errors;
+ for my $key ($q->param()) {
+ # I'm not worried about multiple items
+ $opts->{$key} = ($q->param($key))[0];
+ }
+ if ($q->param('have_archive_check')) {
+ $opts->{archive} = defined $q->param('archive')
+ }
+ # work our way through, so we have a consistent set of data to validate
+ for my $key (grep $_ ne 'id', BSE::SubscriptionType->columns) {
+ unless (exists $opts->{$key}) {
+ $opts->{$key} = $sub->{$key};
+ }
+ }
+ if ($opts->{archive} &&
+ ($opts->{parentId} && $opts->{parentId} != $sub->{parentId})) {
+ $req->user_can('edit_add_child', $opts->{parentId})
+ or $errors{parentId} = "You cannot add children to the archive parent";
+ }
+ $opts->{title} eq ''
+ and $errors{title} = "Please enter a title";
+ $opts->{body} eq ''
+ and $errors{body} = "Please enter a body";
+
+ if (keys %errors) {
+ $$rresult = _send_errors($req, $sub, \%errors);
+ return;
+ }
+
+ $$rsub = $sub;
+
+ return 1;
+}
+
+sub req_send_test {
+ my ($class, $req) = @_;
+
+ my %opts;
+ my $sub;
+ my $result;
+ _send_setup($req, \%opts, \$sub, \$result)
+ or return $result;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ $cfg->entry('subscriptions', 'testing', 1)
+ or return _send_errors($req, $sub,
+ { error => "Test subscription messages disabled" });
+
+ # make sure the user is being authenticated in some way
+ # this prevents spammers from using this to send their messages
+ $ENV{REMOTE_USER} || $req->getuser
+ or return _send_errors($req, $sub,
+ { error => "You must be authenticated to use this function. Either enable access control or setup .htpasswd." });
+
+ my $testemail = $q->param('testemail');
+ my $testname = $q->param('testname');
+ my $testtextonly = $q->param('testtextonly');
+
+ require SiteUsers;
+ my %recipient =
+ (
+ (map { $_ => '' } SiteUser->columns),
+ id => 999,
+ userId => 'xxxx',
+ email => $testemail,
+ name1 => $testname,
+ confirmSecret => 'TESTTESTTESTTESTTESTTESTTESTTEST',
+ textOnlyMail => (defined $testtextonly ? 1 : 0 ),
+ );
+
+ my %errors;
+ unless ($testemail && $testemail =~ /.\@./) {
+ $errors{testemail} = "Please enter a test email address to send a test";
+ }
+ unless ($testname) {
+ $errors{testname} = "Please enter a test name to send a test";
+ }
+ keys %errors
+ and return _send_errors($req, $sub, \%errors);
+
+ 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;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ BSE::Util::Tags->admin(\%acts, $cfg),
+ subscription => [ \&tag_hash, $sub ],
+ message => sub { $acts_message },
+ user => sub { $acts_user ? escape_html($acts_user->{$_[0]}) : '' },
+ ifUser => sub { $acts_user },
+ ifError => sub { $is_error },
+ testing => 1,
+ );
+ BSE::Template->show_replaced($prefix, $cfg, \%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);
+ },
+ \%recipient);
+ print BSE::Template->replace($suffix, $cfg, \%acts);
+ return;
+}
+
+sub _get_filtered_ids {
+ my ($req) = @_;
+
+ my @filters = BSE::SubscriptionTypes->filters($req->cfg);
+
+ my $cgi = $req->cgi;
+
+ # only want the enabled filters
+ my @active;
+ my $index = 1;
+ for my $filter (@filters) {
+ push @active, $filter
+ if $cgi->param("criteria$index");
+ ++$index;
+ }
+ @active
+ or return;
+
+ my $first = shift @active;
+ my @ids = $first->members($req->cgi);
+ for my $filter (@active) {
+ my %members = map { $_=>1 } $filter->members($req->cgi);
+ @ids = grep $members{$_}, @ids;
+ }
+
+ \@ids;
+}
+
+sub req_send {
+ my ($class, $req) = @_;
+
+ my %opts;
+ my $sub;
+ my $result;
+ _send_setup($req, \%opts, \$sub, \$result)
+ or return $result;
+
+ my $q = $req->cgi;
+ my $cfg = $req->cfg;
+
+ 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;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $q, $cfg),
+ BSE::Util::Tags->admin(\%acts, $cfg),
+ subscription => [ \&tag_hash, $sub ],
+ message => sub { $acts_message },
+ user => sub { $acts_user ? escape_html($acts_user->{$_[0]}) : '' },
+ ifUser => sub { $acts_user },
+ ifError => sub { $is_error },
+ testing => 0,
+ );
+ BSE::Template->show_replaced($prefix, $cfg, \%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);
+ }, $filtered_ids);
+ print BSE::Template->replace($suffix, $cfg, \%acts);
+
+ return;
+}
+
+sub req_delconfirm {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my $id = $q->param('id')
+ or return _refresh_list($req, "No id supplied to be deleted");
+
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, "Cannot find record $id");
+
+ return sub_form($req, 'admin/subs/delete', $sub, 0);
+}
+
+sub req_delete {
+ my ($class, $req) = @_;
+
+ my $cfg = $req->cfg;
+ my $q = $req->cgi;
+
+ my $id = $q->param('id')
+ or return _refresh_list($req, "No id supplied to be deleted");
+
+ my $sub = BSE::SubscriptionTypes->getByPkey($id)
+ or return _refresh_list($req, "Cannot find record $id");
+
+ $sub->remove;
+
+ return _refresh_list($req, "Subscription deleted");
+}
--- /dev/null
+package BSE::UI::AdminReport;
+use strict;
+use base 'BSE::UI::AdminDispatch';
+use BSE::Util::Tags;
+use BSE::Report;
+use DevHelp::HTML;
+
+my %actions =
+ (
+ prompt => '',
+ show => '',
+ list_reports => '',
+ );
+
+sub actions {
+ \%actions
+}
+
+sub action_prefix {
+ 's_'
+}
+
+sub rights {
+ \%actions
+}
+
+sub default_action {
+ 'list_reports'
+}
+
+sub req_list_reports {
+ my ($class, $req, $msg) = @_;
+
+ my $reports = BSE::Report->new($req);
+
+ $msg = '' unless defined $msg;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ $reports->list_tags(),
+ message => escape_html($msg),
+ );
+
+ return $req->dyn_response('admin/reports/list', \%acts);
+}
+
+sub req_prompt {
+ my ($class, $req, $msg, $errors) = @_;
+
+ my $reports = BSE::Report->new($req);
+
+ my $repname = $req->cgi->param('r');
+
+ defined $repname
+ or return $class->req_list_reports($req, 'No report id supplied');
+
+ $reports->valid_report($repname)
+ or return $class->req_list_reports($req, 'Invalid report id supplied');
+
+ $reports->report_accessible($repname)
+ or return $class->req_list_reports($req, 'Report not accessible');
+
+ defined $msg or $msg = '';
+ if (keys %$errors && $msg eq '') {
+ $msg = join "<br>", map "<b>".escape_html($_)."</b>", values %$errors;
+ }
+ else {
+ $msg = escape_html($msg);
+ }
+
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ $reports->prompt_tags($repname, $req->cgi, BSE::DB->single),
+ message => $msg,
+ );
+
+ my $template = $reports->prompt_template($repname) || 'admin/reports/prompt';
+
+ return $req->dyn_response($template, \%acts);
+}
+
+sub req_show {
+ my ($class, $req) = @_;
+
+ my $reports = BSE::Report->new($req);
+
+ my $repname = $req->cgi->param('r');
+
+ defined $repname
+ or return $class->req_list_reports($req, 'No report id supplied');
+
+ $reports->valid_report($repname)
+ or return $class->req_list_reports($req, 'Invalid report id supplied');
+
+ $reports->report_accessible($repname)
+ or return $class->req_list_reports($req, 'Report not accessible');
+
+ my %errors;
+ my @params = $reports->validate_params($repname, $req->cgi,
+ BSE::DB->single, \%errors);
+ keys %errors
+ and return $class->req_prompt($req, '', \%errors);
+
+ my $msg;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ $reports->show_tags($repname, BSE::DB->single, \$msg, @params),
+ );
+
+ $msg
+ and return prompt($req, $reports, $msg);
+
+ my $levels = $reports->levels($repname, BSE::DB->single);
+ my $template = $reports->show_template($repname) || 'admin/reports/show' . $levels;
+
+ return $req->dyn_response($template, \%acts);
+}
+
+1;
--- /dev/null
+package BSE::UI::AdminShop;
+use strict;
+use base 'BSE::UI::AdminDispatch';
+use Products;
+use Product;
+use BSE::TB::Orders;
+use BSE::TB::OrderItems;
+use BSE::Template;
+#use Squirrel::ImageEditor;
+use Constants qw(:shop $SHOPID $PRODUCTPARENT
+ $SHOP_URI $CGI_URI $IMAGES_URI $AUTO_GENERATE);
+use Images;
+use Articles;
+use BSE::Sort;
+use BSE::Util::Tags qw(tag_hash);
+use BSE::Util::Iterate;
+use BSE::WebUtil 'refresh_to_admin';
+use DevHelp::HTML qw(:default popup_menu);
+use BSE::Arrows;
+use BSE::CfgInfo 'product_options';
+
+my %actions =
+ (
+ order_list => 'shop_order_list',
+ order_list_filled => 'shop_order_list',
+ order_list_unfilled => 'shop_order_list',
+ order_list_unpaid => 'shop_order_list',
+ order_list_incomplete => 'shop_order_list',
+ order_detail => 'shop_order_detail',
+ order_filled => 'shop_order_filled',
+ product_detail => '',
+ product_list => '',
+ );
+
+sub actions {
+ \%actions;
+}
+
+sub rights {
+ \%actions;
+}
+
+sub default_action {
+ 'product_list'
+}
+
+sub action_prefix {
+ ''
+}
+
+#####################
+# product management
+
+sub embedded_catalog {
+ my ($req, $catalog, $template) = @_;
+
+ my $session = $req->session;
+ use POSIX 'strftime';
+ my $products = Products->new;
+ my @list;
+ if ($session->{showstepkids}) {
+ my @allkids = $catalog->allkids;
+ my %allgen = map { $_->{generator} => 1 } @allkids;
+ for my $gen (keys %allgen) {
+ (my $file = $gen . ".pm") =~ s!::!/!g;
+ require $file;
+ }
+ @list = grep UNIVERSAL::isa($_->{generator}, 'Generate::Product'), $catalog->allkids;
+ @list = map { $products->getByPkey($_->{id}) } @list;
+ }
+ else {
+ @list = sort { $b->{displayOrder} <=> $a->{displayOrder} }
+ $products->getBy(parentid=>$catalog->{id});
+ }
+ my $list_index = -1;
+ my $subcat_index = -1;
+ my @subcats = sort { $b->{displayOrder} <=> $a->{displayOrder} }
+ grep $_->{generator} eq 'Generate::Catalog',
+ Articles->children($catalog->{id});
+
+ my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
+
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ catalog => [ \&tag_hash, $catalog ],
+ date => sub { display_date($list[$list_index]{$_[0]}) },
+ money => sub { sprintf("%.2f", $list[$list_index]{$_[0]}/100.0) },
+ iterate_products_reset => sub { $list_index = -1; },
+ iterate_products =>
+ sub {
+ return ++$list_index < @list;
+ },
+ product => sub { escape_html($list[$list_index]{$_[0]}) },
+ ifProducts => sub { @list },
+ iterate_subcats_reset =>
+ sub {
+ $subcat_index = -1;
+ },
+ iterate_subcats => sub { ++$subcat_index < @subcats },
+ subcat => sub { escape_html($subcats[$subcat_index]{$_[0]}) },
+ ifSubcats => sub { @subcats },
+ hiddenNote =>
+ sub { $list[$list_index]{listed} == 0 ? "Hidden" : " " },
+ move =>
+ sub {
+ my ($arg, $acts, $funcname, $templater) = @_;
+
+ $req->user_can(edit_reorder_children => $catalog)
+ or return '';
+ my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
+ defined $img_prefix or $img_prefix = '';
+ defined $urladd or $urladd = '';
+ @list > 1 or return '';
+ # links to move products up/down
+ my $refreshto = $ENV{SCRIPT_NAME}."$urladd#cat".$catalog->{id};
+ my $down_url = '';
+ if ($list_index < $#list) {
+ if ($session->{showstepkids}) {
+ $down_url = "$CGI_URI/admin/move.pl?stepparent=$catalog->{id}&d=swap&id=$list[$list_index]{id}&other=$list[$list_index+1]{id}";
+ }
+ else {
+ $down_url = "$CGI_URI/admin/move.pl?id=$list[$list_index]{id}&d=swap&other=$list[$list_index+1]{id}";
+ }
+ }
+ my $up_url = '';
+ if ($list_index > 0) {
+ if ($session->{showstepkids}) {
+ $up_url = "$CGI_URI/admin/move.pl?stepparent=$catalog->{id}&d=swap&id=$list[$list_index]{id}&other=$list[$list_index-1]{id}";
+ }
+ else {
+ $up_url = "$CGI_URI/admin/move.pl?id=$list[$list_index]{id}&d=swap&other=$list[$list_index-1]{id}";
+ }
+ }
+ return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
+ },
+ script=>sub { $ENV{SCRIPT_NAME} },
+ embed =>
+ sub {
+ my ($which, $template) = split ' ', $_[0];
+ $which eq 'subcat' or return "Unknown object $which embedded";
+ return embedded_catalog($req, $subcats[$subcat_index], $template);
+ },
+ movecat =>
+ sub {
+ my ($arg, $acts, $funcname, $templater) = @_;
+
+ $req->user_can(edit_reorder_children => $catalog)
+ or return '';
+ @subcats > 1 or return '';
+ # links to move catalogs up/down
+ my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
+ defined $img_prefix or $img_prefix = '';
+ defined $urladd or $urladd = '';
+ my $refreshto = $ENV{SCRIPT_NAME}.$urladd;
+ my $down_url = "";
+ if ($subcat_index < $#subcats) {
+ $down_url = "$CGI_URI/admin/move.pl?id=$subcats[$subcat_index]{id}&d=swap&other=$subcats[$subcat_index+1]{id}&all=1";
+ }
+ my $up_url = "";
+ if ($subcat_index > 0) {
+ $up_url = "$CGI_URI/admin/move.pl?id=$subcats[$subcat_index]{id}&d=swap&other=$subcats[$subcat_index-1]{id}&all=1";
+ }
+ return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
+ },
+ );
+
+ return BSE::Template->get_page('admin/'.$template, $req->cfg, \%acts);
+}
+
+sub req_product_list {
+ my ($class, $req, $message) = @_;
+
+ my $cgi = $req->cgi;
+ my $session = $req->session;
+ my $shopid = $req->cfg->entryErr('articles', 'shop');
+ my $shop = Articles->getByPkey($shopid);
+ my @catalogs = sort { $b->{displayOrder} <=> $a->{displayOrder} }
+ grep $_->{generator} eq 'Generate::Catalog', Articles->children($shopid);
+ my $catalog_index = -1;
+ $message ||= $cgi->param('m') || $cgi->param('message') || '';
+ if (defined $cgi->param('showstepkids')) {
+ $session->{showstepkids} = $cgi->param('showstepkids');
+ }
+ exists $session->{showstepkids} or $session->{showstepkids} = 1;
+ my $products = Products->new;
+ my @products = sort { $b->{displayOrder} <=> $a->{displayOrder} }
+ $products->getBy(parentid => $shopid);
+ my $product_index;
+
+ my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
+
+ my $it = BSE::Util::Iterate->new;
+
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ catalog=> sub { escape_html($catalogs[$catalog_index]{$_[0]}) },
+ iterate_catalogs => sub { ++$catalog_index < @catalogs },
+ shopid=>sub { $shopid },
+ shop => [ \&tag_hash, $shop ],
+ script=>sub { $ENV{SCRIPT_NAME} },
+ message => sub { $message },
+ embed =>
+ sub {
+ my ($which, $template) = split ' ', $_[0];
+ $which eq 'catalog' or return "Unknown object $which embedded";
+ return embedded_catalog($req, $catalogs[$catalog_index], $template);
+ },
+ movecat =>
+ sub {
+ my ($arg, $acts, $funcname, $templater) = @_;
+
+ $req->user_can(edit_reorder_children => $shopid)
+ or return '';
+ @catalogs > 1 or return '';
+ # links to move catalogs up/down
+ my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
+ defined $img_prefix or $img_prefix = '';
+ defined $urladd or $urladd = '';
+ my $refreshto = $ENV{SCRIPT_NAME} . $urladd;
+ my $down_url = '';
+ if ($catalog_index < $#catalogs) {
+ $down_url = "$CGI_URI/admin/move.pl?id=$catalogs[$catalog_index]{id}&d=swap&other=$catalogs[$catalog_index+1]{id}";
+ }
+ my $up_url = '';
+ if ($catalog_index > 0) {
+ $up_url = "$CGI_URI/admin/move.pl?id=$catalogs[$catalog_index]{id}&d=swap&other=$catalogs[$catalog_index-1]{id}";
+ }
+ return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
+ },
+ ifShowStepKids => sub { $session->{showstepkids} },
+ $it->make_iterator(undef, 'product', 'products', \@products, \$product_index),
+ move =>
+ sub {
+ my ($arg, $acts, $funcname, $templater) = @_;
+
+ $req->user_can(edit_reorder_children => $shop)
+ or return '';
+ my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
+ defined $img_prefix or $img_prefix = '';
+ defined $urladd or $urladd = '';
+ @products > 1 or return '';
+ # links to move products up/down
+ my $refreshto = $ENV{SCRIPT_NAME}."$urladd#cat".$shop->{id};
+ my $down_url = '';
+ if ($product_index < $#products) {
+ if ($session->{showstepkids}) {
+ $down_url = "$CGI_URI/admin/move.pl?stepparent=$shop->{id}&d=swap&id=$products[$product_index]{id}&other=$products[$product_index+1]{id}";
+ }
+ else {
+ $down_url = "$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&d=swap&other=$products[$product_index+1]{id}";
+ }
+ }
+ my $up_url = '';
+ if ($product_index > 0) {
+ if ($session->{showstepkids}) {
+ $up_url = "$CGI_URI/admin/move.pl?stepparent=$shop->{id}&d=swap&id=$products[$product_index]{id}&other=$products[$product_index-1]{id}";
+ }
+ else {
+ $up_url = "$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&d=swap&other=$products[$product_index-1]{id}";
+ }
+ }
+ return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
+ },
+ );
+
+ return $req->dyn_response('admin/product_list', \%acts);
+}
+
+sub req_product_detail {
+ my ($class, $req) = @_;
+
+ my $cgi = $req->cgi;
+ my $id = $cgi->param('id');
+ if ($id and
+ my $product = Products->getByPkey($id)) {
+ return product_form($req, $product, '', '', 'admin/product_detail');
+ }
+ else {
+ return $class->req_product_list($req);
+ }
+}
+
+sub product_form {
+ my ($req, $product, $action, $message, $template) = @_;
+
+ my $cgi = $req->cgi;
+ $message ||= $cgi->param('m') || $cgi->param('message') || '';
+ $template ||= 'add_product';
+ my @catalogs;
+ my $shopid = $req->cfg->entryErr('articles', 'shop');
+ my @work = [ $shopid, '' ];
+ while (@work) {
+ my ($parent, $title) = @{shift @work};
+
+ push(@catalogs, { id=>$parent, display=>$title }) if $title;
+ my @kids = sort { $b->{displayOrder} <=> $a->{displayOrder} }
+ grep $_->{generator} eq 'Generate::Catalog',
+ Articles->children($parent);
+ $title .= ' / ' if $title;
+ unshift(@work, map [ $_->{id}, $title.$_->{title} ], @kids);
+ }
+ my @files;
+ if ($product->{id}) {
+ require 'ArticleFiles.pm';
+ @files = ArticleFiles->getBy(articleId=>$product->{id});
+ }
+ my $file_index;
+
+ my @templates;
+ push(@templates, "shopitem.tmpl")
+ if grep -e "$_/shopitem.tmpl", BSE::Template->template_dirs($req->cfg);
+ for my $dir (BSE::Template->template_dirs($req->cfg)) {
+ if (opendir PROD_TEMPL, "$dir/products") {
+ push @templates, map "products/$_",
+ grep -f "$dir/products/$_" && /\.tmpl$/i, readdir PROD_TEMPL;
+ closedir PROD_TEMPL;
+ }
+ }
+ my %seen_templates;
+ @templates = sort { lc($a) cmp lc($b) }
+ grep !$seen_templates{$_}++, @templates;
+
+ my $stepcat_index;
+ use OtherParents;
+ # ugh
+ my $realproduct;
+ $realproduct = UNIVERSAL::isa($product, 'Product') ? $product : Products->getByPkey($product->{id});
+ my @stepcats;
+ @stepcats = OtherParents->getBy(childId=>$product->{id})
+ if $product->{id};
+ my @stepcat_targets = $realproduct->step_parents if $realproduct;
+ my %stepcat_targets = map { $_->{id}, $_ } @stepcat_targets;
+ my @stepcat_possibles = grep !$stepcat_targets{$_->{id}}, @catalogs;
+ my @images;
+ @images = $product->images
+ if $product->{id};
+# @images = $imageEditor->images()
+# if $product->{id};
+ my $image_index;
+ my $avail_options = product_options($req->cfg);
+
+ my $blank = qq!<img src="$IMAGES_URI/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
+
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ catalogs =>
+ sub {
+ return popup_menu(-name=>'parentid',
+ -values=>[ map $_->{id}, @catalogs ],
+ -labels=>{ map { @$_{qw/id display/} } @catalogs },
+ -default=>($product->{parentid} || $PRODUCTPARENT));
+ },
+ product => [ \&tag_hash, $product ],
+ action => sub { $action },
+ message => sub { $message },
+ script=>sub { $ENV{SCRIPT_NAME} },
+ ifImage => sub { $product->{imageName} },
+ hiddenNote => sub { $product->{listed} ? " " : "Hidden" },
+ alloptions =>
+ sub { escape_html(join(',', sort keys %$avail_options)) },
+ templates =>
+ sub {
+ return popup_menu(-name=>'template', -values=>\@templates,
+ -default=>$product->{id} ? $product->{template} :
+ $templates[0]);
+ },
+ ifStepcats => sub { @stepcats },
+ iterate_stepcats_reset => sub { $stepcat_index = -1; },
+ iterate_stepcats => sub { ++$stepcat_index < @stepcats },
+ stepcat => sub { escape_html($stepcats[$stepcat_index]{$_[0]}) },
+ stepcat_targ =>
+ sub {
+ escape_html($stepcat_targets[$stepcat_index]{$_[0]});
+ },
+ movestepcat =>
+ sub {
+ my ($arg, $acts, $funcname, $templater) = @_;
+ return ''
+ unless $req->user_can(edit_reorder_stepparents => $product),
+ @stepcats > 1 or return '';
+ my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
+ $img_prefix = '' unless defined $img_prefix;
+ $urladd = '' unless defined $urladd;
+ my $refreshto = escape_uri($ENV{SCRIPT_NAME}
+ ."?id=$product->{id}&$template=1$urladd#step");
+ my $down_url = "";
+ if ($stepcat_index < $#stepcats) {
+ $down_url = "$CGI_URI/admin/move.pl?stepchild=$product->{id}&id=$stepcats[$stepcat_index]{parentId}&d=swap&other=$stepcats[$stepcat_index+1]{parentId}&all=1";
+ }
+ my $up_url = "";
+ if ($stepcat_index > 0) {
+ $up_url = "$CGI_URI/admin/move.pl?stepchild=$product->{id}&id=$stepcats[$stepcat_index]{parentId}&d=swap&other=$stepcats[$stepcat_index-1]{parentId}&all=1";
+ }
+ return make_arrows($req->cfg, $down_url, $up_url, $refreshto, $img_prefix);
+ },
+ ifStepcatPossibles => sub { @stepcat_possibles },
+ stepcat_possibles => sub {
+ popup_menu(-name=>'stepcat',
+ -values=>[ map $_->{id}, @stepcat_possibles ],
+ -labels=>{ map { $_->{id}, $_->{display}} @catalogs });
+ },
+ BSE::Util::Tags->
+ make_iterator(\@files, 'file', 'files', \$file_index),
+ BSE::Util::Tags->
+ make_iterator(\@images, 'image', 'images', \$image_index),
+ );
+
+ return $req->dyn_response($template, \%acts);
+}
+
+#####################
+# order management
+
+sub order_list_low {
+ my ($req, $template, $title, @orders) = @_;
+
+ my $cgi = $req->cgi;
+
+ my $from = $cgi->param('from');
+ my $to = $cgi->param('to');
+ use BSE::Util::SQL qw/now_sqldate sql_to_date date_to_sql/;
+ use BSE::Util::Valid qw/valid_date/;
+ my $today = now_sqldate();
+ for my $what ($from, $to) {
+ if (defined $what) {
+ if ($what eq 'today') {
+ $what = $today;
+ }
+ elsif (valid_date($what)) {
+ $what = date_to_sql($what);
+ }
+ else {
+ undef $what;
+ }
+ }
+ }
+ my $message = $cgi->param('m');
+ defined $message or $message = '';
+ $message = escape_html($message);
+ if (defined $from || defined $to) {
+ $from ||= '1900-01-01';
+ $to ||= '2999-12-31';
+ $cgi->param('from', sql_to_date($from));
+ $cgi->param('to', sql_to_date($to));
+ $to = $to."Z";
+ @orders = grep $from le $_->{orderDate} && $_->{orderDate} le $to,
+ @orders;
+ }
+ my @orders_work;
+ my $order_index = -1;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ #order=> sub { escape_html($orders_work[$order_index]{$_[0]}) },
+ DevHelp::Tags->make_iterator2
+ ( [ \&iter_orders, \@orders ],
+ 'order', 'orders', \@orders_work, \$order_index, 'NoCache'),
+ script => sub { $ENV{SCRIPT_NAME} },
+ title => sub { $title },
+ ifHaveParam => sub { defined $cgi->param($_[0]) },
+ ifParam => sub { $cgi->param($_[0]) },
+ cgi =>
+ sub {
+ my $value = $cgi->param($_[0]);
+ defined $value or $value = '';
+ escape_html($value);
+ },
+ message => $message,
+ );
+ $req->dyn_response("admin/$template", \%acts);
+}
+
+sub iter_orders {
+ my ($orders, $args) = @_;
+
+ return bse_sort({ id => 'n', total => 'n', filled=>'n' }, $args, @$orders);
+}
+
+sub req_order_list {
+ my ($class, $req) = @_;
+
+ my $orders = BSE::TB::Orders->new;
+ my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
+ grep $_->{complete}, $orders->all;
+ my $template = $req->cgi->param('template');
+ unless (defined $template && $template =~ /^\w+$/) {
+ $template = 'order_list';
+ }
+
+ return order_list_low($req, $template, 'Order list', @orders);
+}
+
+sub req_order_list_filled {
+ my ($class, $req) = @_;
+
+ my $orders = BSE::TB::Orders->new;
+ my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
+ grep $_->{complete} && $_->{filled} && $_->{paidFor}, $orders->all;
+
+ return order_list_low($req, 'order_list_filled', 'Order list - Filled orders', @orders);
+}
+
+sub req_order_list_unfilled {
+ my ($class, $req) = @_;
+
+ my $orders = BSE::TB::Orders->new;
+ my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
+ grep $_->{complete} && !$_->{filled} && $_->{paidFor}, $orders->all;
+
+ return order_list_low($req, 'order_list_unfilled',
+ 'Order list - Unfilled orders', @orders);
+
+}
+
+sub req_order_list_unpaid {
+ my ($class, $req) = @_;
+
+ my $orders = BSE::TB::Orders->new;
+ my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
+ grep $_->{complete} && !$_->{paidFor}, $orders->all;
+
+ return order_list_low($req, 'order_list_unpaid',
+ 'Order list - Incomplete orders', @orders);
+}
+
+sub req_order_list_incomplete {
+ my ($class, $req) = @_;
+
+ my $orders = BSE::TB::Orders->new;
+ my @orders = sort { $b->{orderDate} cmp $a->{orderDate} }
+ grep !$_->{complete}, $orders->all;
+
+ return order_list_low($req, 'order_list_incomplete',
+ 'Order list - Incomplete orders', @orders);
+}
+
+sub cart_item_opts {
+ my ($req, $cart_item, $product) = @_;
+
+ my $avail_options = product_options($req->cfg);
+
+ my @options = ();
+ my @values = split /,/, $cart_item->{options};
+ my @ids = split /,/, $product->{options};
+ for my $opt_index (0 .. $#ids) {
+ my $entry = $avail_options->{$ids[$opt_index]};
+ my $option = {
+ id=>$ids[$opt_index],
+ value=>$values[$opt_index],
+ desc => $entry->{desc} || $ids[$opt_index],
+ };
+ if ($entry->{labels}) {
+ $option->{label} = $entry->{labels}{$values[$opt_index]};
+ }
+ else {
+ $option->{label} = $option->{value};
+ }
+ push(@options, $option);
+ }
+
+ return @options;
+}
+
+sub nice_options {
+ my (@options) = @_;
+
+ if (@options) {
+ return '('.join(", ", map("$_->{desc} $_->{label}", @options)).')';
+ }
+ else {
+ return '';
+ }
+}
+
+sub tag_siteuser {
+ my ($order, $rsiteuser, $arg) = @_;
+
+ unless ($$rsiteuser) {
+ $$rsiteuser = $order->siteuser || {};
+ }
+
+ my $siteuser = $$rsiteuser;
+ return '' unless $siteuser->{id};
+
+ my $value = $siteuser->{$arg};
+ defined $value or $value = '';
+
+ return escape_html($value);
+}
+
+sub req_order_detail {
+ my ($class, $req, $message) = @_;
+
+ my $cgi = $req->cgi;
+ my $id = $cgi->param('id');
+ if ($id and
+ my $order = BSE::TB::Orders->getByPkey($id)) {
+ $message ||= $cgi->param('m') || '';
+ my @lines = $order->items;
+ my @products = map { Products->getByPkey($_->{productId}) } @lines;
+ my $line_index = -1;
+ my $product;
+ my @options;
+ my $option_index = -1;
+ my $siteuser;
+ my %acts;
+ %acts =
+ (
+ BSE::Util::Tags->basic(\%acts, $cgi, $req->cfg),
+ BSE::Util::Tags->admin(\%acts, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ item => sub { escape_html($lines[$line_index]{$_[0]}) },
+ iterate_items_reset => sub { $line_index = -1 },
+ iterate_items =>
+ sub {
+ if (++$line_index < @lines ) {
+ $option_index = -1;
+ @options = cart_item_opts($req,
+ $lines[$line_index],
+ $products[$line_index]);
+ return 1;
+ }
+ return 0;
+ },
+ order => [ \&tag_hash, $order ],
+ #money =>
+ #sub {
+# my ($func, $args) = split ' ', $_[0], 2;
+# return sprintf("%.2f", $acts{$func}->($args)/100.0)
+# },
+ date =>
+ sub {
+ my ($func, $args) = split ' ', $_[0], 2;
+ return display_date($acts{$func}->($args));
+ },
+ extension =>
+ sub {
+ sprintf("%.2f", $lines[$line_index]{units} * $lines[$line_index]{$_[0]}/100.0)
+ },
+ product => sub { escape_html($products[$line_index]{$_[0]}) },
+ script => sub { $ENV{SCRIPT_NAME} },
+ iterate_options_reset => sub { $option_index = -1 },
+ iterate_options => sub { ++$option_index < @options },
+ option => sub { CGI::escapeHTML($options[$option_index]{$_[0]}) },
+ ifOptions => sub { @options },
+ options => sub { nice_options(@options) },
+ message => sub { $message },
+ siteuser => [ \&tag_siteuser, $order, \$siteuser, ],
+ );
+
+ return $req->dyn_response('admin/order_detail', \%acts);
+ }
+ else {
+ return $class->req_order_list($req);
+ }
+}
+
+sub req_order_filled {
+ my ($class, $req) = @_;
+
+ my $id = $req->cgi->param('id');
+ if ($id and
+ my $order = BSE::TB::Orders->getByPkey($id)) {
+ my $filled = $req->cgi->param('filled');
+ $order->{filled} = $filled;
+ if ($order->{filled}) {
+ $order->{whenFilled} = epoch_to_sql_datetime(time);
+ my $user = $req->user;
+ if ($user) {
+ $order->{whoFilled} = $user->{logon};
+ }
+ else {
+ $order->{whoFilled} = defined($ENV{REMOTE_USER})
+ ? $ENV{REMOTE_USER} : "-unknown-";
+ }
+ }
+ $order->save();
+ if ($req->cgi->param('detail')) {
+ return $class->req_order_detail($req);
+ }
+ else {
+ return $class->req_order_list($req);
+ }
+ }
+ else {
+ return $class->req_order_list($req);
+ }
+}
+
+#####################
+# utilities
+# perhaps some of these belong in a class...
+
+# format an ANSI SQL date for display
+sub display_date {
+ my ($date) = @_;
+
+ if ( my ($year, $month, $day) =
+ ($date =~ /^(\d+)-(\d+)-(\d+)/)) {
+ return sprintf("%02d/%02d/%04d", $day, $month, $year);
+ }
+ return $date;
+}
+
+# convert a user entered date from dd/mm/yyyy to ANSI sql format
+# we try to parse flexibly here
+sub sql_date {
+ my $str = shift;
+ my ($year, $month, $day);
+
+ # look for a date
+ if (($day, $month, $year) = ($$str =~ m!(\d+)/(\d+)/(\d+)!)) {
+ $year += 2000 if $year < 100;
+
+ return $$str = sprintf("%04d-%02d-%02d", $year, $month, $day);
+ }
+ return undef;
+}
+
+sub money_to_cents {
+ my $money = shift;
+
+ $$money =~ /^\s*(\d+(\.\d*)|\.\d+)/
+ or return undef;
+ return $$money = sprintf("%.0f ", $$money * 100);
+}
+
+# convert an epoch time to sql format
+sub epoch_to_sql {
+ use POSIX 'strftime';
+ my ($time) = @_;
+
+ return strftime('%Y-%m-%d', localtime $time);
+}
+
+# convert an epoch time to sql format
+sub epoch_to_sql_datetime {
+ use POSIX 'strftime';
+ my ($time) = @_;
+
+ return strftime('%Y-%m-%d %H:%M', localtime $time);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+shopadmin.pl - administration for the online-store tables
+
+=head1 SYNOPSYS
+
+(This is a CGI script.)
+
+=head1 DESCRIPTION
+
+shopadmin.pl gives a UI to edit the product table, and view the orders and
+order_item tables.
+
+=head1 TEMPLATES
+
+shopadmin.pl uses a few templates from the templates/admin directory.
+
+=head2 product_list.tmpl
+
+=over 4
+
+=item product I<name>
+
+Access to product fields.
+
+=item date I<name>
+
+Formats the I<name> field of the product as a date.
+
+=item money I<name>
+
+Formats the I<name> integer field as a 2 decimal place money value.
+
+=item iterator ... products
+
+Iterates over the products database in reverse expire order.
+
+=item script
+
+The name of the current script for use in URLs.
+
+=item message
+
+An error message that may have been passed in the 'message' parameter.
+
+=item hiddenNote
+
+'Deleted' if the expire date of the current product has passed.
+
+=back
+
+=head2 add_product.tmpl
+=head2 edit_product.tmpl
+=head2 product_detail.tmpl
+
+These use the same tags.
+
+=over 4
+
+=item product I<name>
+
+The specified field of the product.
+
+=item date I<name>
+
+Formats the given field of the product as a date.
+
+=item money I<name>
+
+Formats the given integer field of the product as money.
+
+=item action
+
+Either 'Add New' or 'Edit'.
+
+=item message
+
+The message parameter passed into the script.
+
+=item script
+
+The name of the script, for use in urls.
+
+=item ifImage
+
+Conditional, true if the product has an image.
+
+=item hiddenNote
+
+"Hidden" if the product is hidden.
+
+=back
+
+=head2 order_list.tmpl
+
+Used to display the list of orders. You can also specify a template
+parameter to the order_list target, and perform filtering and sorting
+within the template.
+
+=over 4
+
+=item order I<name>
+
+The given field of the order.
+
+=item iterator ... orders [filter-sort-spec]
+
+Iterates over the orders in reverse orderDate order.
+
+The [filter-sort-spec] can contain none, either or both of the following:
+
+=over
+
+=item filter= field op value, ...
+
+filter the data by checking the given expression.
+
+eg. filter= filled == 0
+
+=item sort= [+|-] keyword, ...
+
+Sorts the result by the specified fields, in reverse if preceded by '-'.
+
+=back
+
+=item money I<name>
+
+The given field of the current order formatted as money.
+
+=item date I<name>
+
+The given field of the current order formatted as a date.
+
+=item script
+
+The name of the script, for use in urls.
+
+=back
+
+=head2 order_detail.tmpl
+
+Used to display the details for an order.
+
+=over 4
+
+=item item I<name>
+
+Displays the given field of a line item
+
+=item iterator ... items
+
+Iterates over the line items in the order.
+
+=item order I<name>
+
+The given field of the order.
+
+=item money I<func> I<args>
+
+Formats the given functions return value as money.
+
+=item date I<func> I<args>
+
+Formats the given function return value as a date.
+
+=item extension I<name>
+
+Takes the given field for the current item multiplied by the units column.
+
+=item product I<name>
+
+The given product field of the product for the current item.
+
+=item script
+
+The name of the current script (for use in urls).
+
+=item iterator ... options
+
+Iterates over the options set for the current order item.
+
+=item option I<field>
+
+Access to a field of the option, any of id, value, desc or label.
+
+=item ifOptions
+
+Conditional tag, true if the current product has any options.
+
+=item options
+
+A laid-out list of the options set for the current order item.
+
+=back
+
+=cut
+
elsif ($fmt eq 'x') {
return escape_xml(unescape_html($value));
}
+ elsif ($fmt eq 'z') {
+ return unescape_html($value);
+ }
return $value;
},
);
where ss.seminar_id = ? and sb.siteuser_id is null and lo.id = ss.location_id
SQL
+name: AdminGroups.forUser
+sql_statement: <<SQL
+select ab.*, ag.*
+ from admin_base ab, admin_groups ag, admin_membership am
+where am.user_id = ? and am.group_id = ab.id and ab.id = ag.base_id
+SQL
+
=head1 CHANGES
+=head2 0.15_50
+
+This release involves some large potentially destabilizing changes,
+especially in newsletter administration, shop administration and the
+reports script.
+
+=over
+
+=item *
+
+a template set can now be selected for admin groups, the list of
+template sets is configured via:
+
+ [admin group template sets]
+ setid=set description
+
+a template set is a subdirectory of the local and normal template
+directories.
+
+=item *
+
+modified BSE::Request::dyn_response() to supply any template sets set
+by the admin user's groups as part of the search path for templates,
+this means that an admin user will use templates from those
+subdirectories before the main directories if they're in the right
+group.
+
+=item *
+
+modified nearly all admin code to do display via dyn_response() so
+that they use the new template sets (and support _t for that matter)
+
+The exceptions are dynamic output, like the newletter progress display
+and some embedding like in the shop admin catalog tree.
+
+=item *
+
+added a formatting code z, that un-html escapes the provided value.
+
+=back
+
=head2 0.15_49
=over
<form method="POST" action="<:script:>">
- <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" class="table">
- <tr>
- <td>
<table cellpadding="6" border="0" cellspacing="1">
<tr>
<th bgcolor="#FFFFFF" align="left">Name: </th>
</td>
<td bgcolor="#FFFFFF"><:help addgroup description:> </td>
</tr>
+ <tr>
+ <th bgcolor="#FFFFFF" align="left">Template Set: </th>
+ <td bgcolor="#FFFFFF">
+ <:template_set_popup:>
+ </td>
+ <td bgcolor="#FFFFFF"><:help addgroup description:> </td>
+ </tr>
<tr>
<td bgcolor="#FFFFFF" colspan="3" align="right">
<input type="submit" name="a_addgroup" value=" Add Group " />
</td>
</tr>
</table>
- </td>
- </tr>
- </table>
</form>
<p><font size="-1">BSE Release <:release:></font></p>
</td>
<td bgcolor="#FFFFFF"><:help addgroup description:> </td>
</tr>
+ <tr>
+ <th bgcolor="#FFFFFF" align="left">Template Set: </th>
+ <td bgcolor="#FFFFFF">
+ <:template_set_popup:>
+ </td>
+ <td bgcolor="#FFFFFF"><:help addgroup description:> </td>
+ </tr>
<tr>
<th bgcolor="#FFFFFF" align="left"> Members: </th>
<td bgcolor="#FFFFFF">
sessionclass = Apache::Session::MySQL
# the location of mysql
mysql = mysql
-basic.access_control=0
+basic.access_control=1
basic.sign=0
#basic.htusers = /home/httpd/bsetest/htdocs/images/.htusers
#article uris.9 = /test
search highlight.body_suffix=</i>
search highlight.title_prefix=<i>
search highlight.title_suffix=</i>
-valid child types.Article=Article,Seminar
+;valid child types.Article=Article,Seminar
shop product options.book_flight=Flight Booking;Book a flight;Don't book a flight
;seminars.popup_date_format=%H:%M %d/%m/%Y
-seminars.free_bookings=1
\ No newline at end of file
+seminars.free_bookings=1
+
+admin group template sets.test=Test Templates
projects / bse.git / commitdiff