0.15_50 commit r0_15_50
authorTony Cook <tony@develop-help.com>
Wed, 25 Oct 2006 04:36:16 +0000 (04:36 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Wed, 25 Oct 2006 04:36:16 +0000 (04:36 +0000)
34 files changed:
MANIFEST
Makefile
schema/bse.sql
site/cgi-bin/admin/add.pl
site/cgi-bin/admin/admin_seminar.pl
site/cgi-bin/admin/adminusers.pl
site/cgi-bin/admin/changepw.pl
site/cgi-bin/admin/logon.pl
site/cgi-bin/admin/menu.pl
site/cgi-bin/admin/report.pl
site/cgi-bin/admin/shopadmin.pl
site/cgi-bin/admin/siteusers.pl
site/cgi-bin/admin/subs.pl
site/cgi-bin/admin/userupdate.pl
site/cgi-bin/modules/BSE/AdminMenu.pm
site/cgi-bin/modules/BSE/AdminSiteUsers.pm
site/cgi-bin/modules/BSE/AdminUsers.pm
site/cgi-bin/modules/BSE/ChangePW.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Request.pm
site/cgi-bin/modules/BSE/TB/AdminGroup.pm
site/cgi-bin/modules/BSE/TB/AdminGroups.pm
site/cgi-bin/modules/BSE/TB/AdminUser.pm
site/cgi-bin/modules/BSE/Template.pm
site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UI/AdminReport.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UI/AdminShop.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Util/Tags.pm
site/data/db/sql_statements.data
site/docs/bse.pod
site/templates/admin/addgroup.tmpl
site/templates/admin/showgroup.tmpl
test.cfg

index 91a1a16..369a2e7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -129,7 +129,10 @@ site/cgi-bin/modules/BSE/TB/Subscriptions.pm
 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
index 0bc694c..14b6048 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.15_49
+VERSION=0.15_50
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index c8e82cc..812c745 100644 (file)
@@ -640,6 +640,7 @@ create table admin_groups (
   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)
 );
index 930f050..c7d0ec4 100755 (executable)
@@ -8,7 +8,6 @@ use Articles;
 use Article;
 use BSE::DB;
 use BSE::Request;
-use BSE::Template;
 use BSE::Edit::Base;
 use Carp qw'verbose';
 use Carp 'confess';
@@ -65,20 +64,7 @@ else {
   $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) = @_;
index 5407112..4b86d6d 100755 (executable)
@@ -15,4 +15,4 @@ $SIG{__DIE__} = sub { confess $@ };
 my $req = BSE::Request->new;
 
 my $result = BSE::UI::AdminSeminar->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
index 83bb942..3dd37ff 100755 (executable)
@@ -6,7 +6,6 @@ use FindBin;
 use lib "$FindBin::Bin/../modules";
 use BSE::DB;
 use BSE::Request;
-use BSE::Template;
 use Carp 'confess';
 use BSE::AdminUsers;
 
@@ -15,17 +14,4 @@ $SIG{__DIE__} = sub { confess $@ };
 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);
index c0c0e79..79accd8 100755 (executable)
@@ -25,4 +25,4 @@ else {
   $result = BSE::Template->get_refresh($req->url('logon'), $req->cfg);
 }
 
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
index 29b0761..d3bdac3 100755 (executable)
@@ -15,4 +15,4 @@ $SIG{__DIE__} = sub { confess $@ };
 my $req = BSE::Request->new;
 
 my $result = BSE::AdminLogon->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
index 56b26dd..c78010c 100755 (executable)
@@ -15,4 +15,4 @@ $SIG{__DIE__} = sub { confess $@ };
 my $req = BSE::Request->new;
 
 my $result = BSE::AdminMenu->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
index 33443f7..45fae42 100755 (executable)
@@ -4,122 +4,14 @@ BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0' }
 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);
index a0e14f0..75e7664 100755 (executable)
@@ -5,1036 +5,14 @@ BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0'; }
 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" : "&nbsp;" },
-     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} ? "&nbsp;" : "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);
index b8aee49..149e107 100755 (executable)
@@ -6,7 +6,6 @@ use FindBin;
 use lib "$FindBin::Bin/../modules";
 use BSE::DB;
 use BSE::Request;
-use BSE::Template;
 use Carp 'confess';
 use BSE::AdminSiteUsers;
 
@@ -15,4 +14,4 @@ $SIG{__DIE__} = sub { confess $@ };
 my $req = BSE::Request->new;
 
 my $result = BSE::AdminSiteUsers->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
index 85ef69e..2a9ccf9 100755 (executable)
 #!/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);
index b367389..e1fc82a 100755 (executable)
@@ -6,7 +6,6 @@ use FindBin;
 use lib "$FindBin::Bin/../modules";
 use BSE::DB;
 use BSE::Request;
-use BSE::Template;
 use Carp 'confess';
 use BSE::UI::SiteUserUpdate;
 
@@ -15,4 +14,4 @@ $SIG{__DIE__} = sub { confess $@ };
 my $req = BSE::Request->new;
 
 my $result = BSE::UI::SiteUserUpdate->dispatch($req);
-BSE::Template->output_result($req, $result);
+$req->output_result($result);
index 9c1ef90..934cfb0 100644 (file)
@@ -1,35 +1,23 @@
 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 =
@@ -40,11 +28,7 @@ sub req_menu {
      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;
index 6566dde..3e43fb0 100644 (file)
@@ -10,6 +10,7 @@ use BSE::Util::SQL qw/now_datetime/;
 use BSE::SubscriptionTypes;
 use BSE::CfgInfo qw(custom_class);
 use constant SITEUSER_GROUP_SECT => 'BSE Siteuser groups validation';
+use BSE::Template;
 
 my %actions =
   (
@@ -273,10 +274,7 @@ sub _display_user {
                        '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 {
@@ -525,11 +523,7 @@ sub req_addform {
      [ \&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 {
@@ -787,7 +781,7 @@ sub req_grouplist {
      $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 {
@@ -806,7 +800,7 @@ 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 {
@@ -889,7 +883,7 @@ sub _common_group {
      group => [ \&tag_hash, $group ],
     );
 
-  return $req->response($template, \%acts);
+  return $req->dyn_response($template, \%acts);
 }
 
 sub req_deletegroupform {
@@ -951,7 +945,7 @@ sub req_groupmemberform {
      ifMember => [ \&tag_ifMember, \$user, \%members ],
     );
 
-  return $req->response('admin/users/groupmembers', \%acts);
+  return $req->dyn_response('admin/users/groupmembers', \%acts);
 }
 
 sub req_savegroupmembers {
index 191929e..6beb836 100644 (file)
@@ -2,8 +2,9 @@ package BSE::AdminUsers;
 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 =
   (
@@ -157,7 +158,7 @@ sub req_users {
 
   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 {
@@ -168,7 +169,7 @@ 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 {
@@ -177,16 +178,20 @@ 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 {
@@ -283,17 +288,27 @@ sub req_addgroup {
   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;
@@ -332,6 +347,20 @@ sub tag_if_gperm_set {
   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) = @_;
 
@@ -365,11 +394,7 @@ sub req_showuser {
      $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 {
@@ -513,11 +538,7 @@ sub req_showuserart {
      $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 {
@@ -543,11 +564,7 @@ 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 {
@@ -601,6 +618,7 @@ sub showgroup_tags {
      ([ \&iter_get_gperms, $req->cfg ], 'gperm', 'gperms' ),
      ifGperm_set =>
      [ \&tag_if_gperm_set, $group ],
+     template_set_popup => [ \&tag_template_set_popup, $req, $group ],
     );
 }
 
@@ -620,11 +638,7 @@ sub req_showgroup {
      $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 {
@@ -755,20 +769,33 @@ sub req_savegroup {
     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');
@@ -780,6 +807,11 @@ sub req_savegroup {
     }
     $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")) {
index 2114c92..cf5d449 100644 (file)
@@ -1,8 +1,8 @@
 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 =
   (
@@ -10,20 +10,16 @@ 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 {
@@ -49,9 +45,7 @@ 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 {
index 4e0de07..e115066 100644 (file)
@@ -267,8 +267,8 @@ SQL
 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,
index ef282fb..ede3375 100644 (file)
@@ -1185,7 +1185,7 @@ sub low_edit_form {
   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 {
@@ -2130,7 +2130,7 @@ sub show_images {
   %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 {
index 5145009..28478db 100644 (file)
@@ -77,6 +77,16 @@ sub check_admin_logon {
   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 = 
   { 
@@ -167,15 +177,23 @@ sub message {
 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 {
index 5f47e3f..3c06d63 100644 (file)
@@ -4,7 +4,7 @@ use base qw(BSE::TB::AdminBase);
 
 sub columns {
   return ($_[0]->SUPER::columns,
-         qw/base_id name description perm_map/ );
+         qw/base_id name description perm_map template_set/ );
 }
 
 sub bases {
index f8cc225..ac12a8a 100644 (file)
@@ -2,9 +2,33 @@ package BSE::TB::AdminGroups;
 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;
index adcc958..9e98cad 100644 (file)
@@ -19,5 +19,13 @@ sub remove {
   $self->SUPER::remove();
 }
 
+sub groups {
+  my ($self) = @_;
+
+  require BSE::TB::AdminGroups;
+
+  BSE::TB::AdminGroups->getSpecial(forUser => $self->{id});
+}
+
 1;
 
index a388665..75d1f88 100644 (file)
@@ -4,12 +4,21 @@ use Squirrel::Template;
 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);
 
@@ -86,12 +95,13 @@ sub show_literal {
 }
 
 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});
 
@@ -170,6 +180,9 @@ sub get_source {
 sub output_result {
   my ($class, $req, $result) = @_;
 
+  $result 
+    or return;
+
   select STDOUT;
   $| = 1;
   push @{$result->{headers}}, "Content-Type: $result->{type}"
diff --git a/site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm b/site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
new file mode 100644 (file)
index 0000000..643ee61
--- /dev/null
@@ -0,0 +1,810 @@
+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");
+}
diff --git a/site/cgi-bin/modules/BSE/UI/AdminReport.pm b/site/cgi-bin/modules/BSE/UI/AdminReport.pm
new file mode 100644 (file)
index 0000000..bf0d93c
--- /dev/null
@@ -0,0 +1,130 @@
+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;
diff --git a/site/cgi-bin/modules/BSE/UI/AdminShop.pm b/site/cgi-bin/modules/BSE/UI/AdminShop.pm
new file mode 100644 (file)
index 0000000..51f6d89
--- /dev/null
@@ -0,0 +1,959 @@
+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" : "&nbsp;" },
+     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} ? "&nbsp;" : "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
+
index 65cdcef..4013957 100644 (file)
@@ -289,6 +289,9 @@ sub static {
        elsif ($fmt eq 'x') {
         return escape_xml(unescape_html($value));
        }
+       elsif ($fmt eq 'z') {
+        return unescape_html($value);
+       }
        return $value;
      },
     );  
index 380949e..4d562b6 100644 (file)
@@ -85,3 +85,10 @@ select ss.*, lo.*, ss.id as session_id
 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
+
index a0d50a3..93a9162 100644 (file)
@@ -10,6 +10,47 @@ Maybe I'll add some other bits here.
 
 =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
index 8a65167..2d34489 100644 (file)
@@ -22,9 +22,6 @@
 
 <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>
index 53b265d..4d9ad4f 100644 (file)
             </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"> 
index a87647a..b5cb94a 100644 (file)
--- a/test.cfg
+++ b/test.cfg
@@ -11,7 +11,7 @@ dbclass = BSE::DB::Mysql
 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
@@ -231,8 +231,10 @@ search highlight.body_prefix=<i>
 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