0.14_24 commit r0_14_24
authorTony Cook <tony@develop-help.com>
Wed, 18 Aug 2004 04:09:33 +0000 (04:09 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Wed, 18 Aug 2004 04:09:33 +0000 (04:09 +0000)
45 files changed:
MANIFEST
Makefile
schema/bse.sql
site/cgi-bin/admin/reorder.pl
site/cgi-bin/admin/shopadmin.pl
site/cgi-bin/admin/subadmin.pl [new file with mode: 0755]
site/cgi-bin/affiliate.pl [new file with mode: 0755]
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Edit/Product.pm
site/cgi-bin/modules/BSE/Permissions.pm
site/cgi-bin/modules/BSE/Request.pm
site/cgi-bin/modules/BSE/Session.pm
site/cgi-bin/modules/BSE/Shop/Util.pm
site/cgi-bin/modules/BSE/TB/Order.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/OrderItem.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/OrderItems.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Orders.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Subscription.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Subscriptions.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Template.pm
site/cgi-bin/modules/BSE/UI/AdminDispatch.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UI/Affiliate.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UI/Dispatch.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/UI/SubAdmin.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/Util/Tags.pm
site/cgi-bin/modules/DevHelp/Validate.pm [new file with mode: 0644]
site/cgi-bin/modules/Order.pm
site/cgi-bin/modules/OrderItem.pm
site/cgi-bin/modules/OrderItems.pm
site/cgi-bin/modules/Product.pm
site/cgi-bin/modules/SiteUser.pm
site/cgi-bin/modules/Squirrel/Template.pm
site/cgi-bin/shop.pl
site/docs/bse.pod
site/htdocs/css/admin.css
site/templates/admin/add_product.tmpl
site/templates/admin/base.tmpl
site/templates/admin/edit_product.tmpl
site/templates/admin/menu.tmpl
site/templates/admin/subscr/add.tmpl [new file with mode: 0644]
site/templates/admin/subscr/edit.tmpl [new file with mode: 0644]
site/templates/admin/subscr/list.tmpl [new file with mode: 0644]
site/templates/admin/xbase.tmpl
test.cfg

index c9afa66..b154d92 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -27,6 +27,7 @@ site/cgi-bin/admin/reorder.pl
 site/cgi-bin/admin/report.pl
 site/cgi-bin/admin/shopadmin.pl
 site/cgi-bin/admin/siteusers.pl
+#site/cgi-bin/admin/subadmin.pl
 site/cgi-bin/admin/subs.pl
 site/cgi-bin/admin/userlist.pl
 site/cgi-bin/bse.cfg
@@ -86,7 +87,16 @@ site/cgi-bin/modules/BSE/TB/AdminPerm.pm
 site/cgi-bin/modules/BSE/TB/AdminPerms.pm
 site/cgi-bin/modules/BSE/TB/AdminUser.pm
 site/cgi-bin/modules/BSE/TB/AdminUsers.pm
+site/cgi-bin/modules/BSE/TB/Order.pm
+site/cgi-bin/modules/BSE/TB/Orders.pm
+site/cgi-bin/modules/BSE/TB/OrderItem.pm
+site/cgi-bin/modules/BSE/TB/OrderItems.pm
+#site/cgi-bin/modules/BSE/TB/Subscription.pm
+#site/cgi-bin/modules/BSE/TB/Subscriptions.pm
 site/cgi-bin/modules/BSE/Template.pm
+#site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
+#site/cgi-bin/modules/BSE/UI/Dispatch.pm
+#site/cgi-bin/modules/BSE/UI/SubAdmin.pm
 site/cgi-bin/modules/BSE/UserReg.pm
 site/cgi-bin/modules/BSE/Util/DynSort.pm
 site/cgi-bin/modules/BSE/Util/Iterate.pm
@@ -103,6 +113,7 @@ site/cgi-bin/modules/DevHelp/HTML.pm
 site/cgi-bin/modules/DevHelp/Report.pm
 site/cgi-bin/modules/DevHelp/Tags.pm
 site/cgi-bin/modules/DevHelp/Tags/Iterate.pm
+site/cgi-bin/modules/DevHelp/Validate.pm
 site/cgi-bin/modules/Generate.pm
 site/cgi-bin/modules/Generate/Article.pm
 site/cgi-bin/modules/Generate/Catalog.pm
@@ -110,10 +121,6 @@ site/cgi-bin/modules/Generate/Product.pm
 site/cgi-bin/modules/Generate/Subscription.pm
 site/cgi-bin/modules/Image.pm
 site/cgi-bin/modules/Images.pm
-site/cgi-bin/modules/Order.pm
-site/cgi-bin/modules/OrderItem.pm
-site/cgi-bin/modules/OrderItems.pm
-site/cgi-bin/modules/Orders.pm
 site/cgi-bin/modules/OtherParent.pm
 site/cgi-bin/modules/OtherParents.pm
 site/cgi-bin/modules/Product.pm
@@ -261,6 +268,9 @@ site/templates/admin/subs/sending.tmpl
 site/templates/admin/subs/send_error.tmpl
 site/templates/admin/subs/send_form.tmpl
 site/templates/admin/subs/start_send.tmpl
+#site/templates/admin/subscr/add.tmpl
+#site/templates/admin/subscr/edit.tmpl
+#site/templates/admin/subscr/list.tmpl
 site/templates/admin/userlist.tmpl
 site/templates/admin/users/add.tmpl
 site/templates/admin/users/edit.tmpl
index f3066db..c9eb2bd 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.14_23
+VERSION=0.14_24
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index 4fe246e..c752e50 100644 (file)
@@ -148,6 +148,11 @@ create table product (
 
   -- options that can be specified for this product
   options varchar(255) not null,
+
+  subscription_id integer not null default -1,
+  subscription_period integer not null default 0,
+  subscription_usage integer not null default 3,
+  subscription_required integer not null default -1,
   
   primary key(articleId)
 );
@@ -232,6 +237,11 @@ create table orders (
   billFacsimile varchar(80) not null default '',
   billEmail varchar(255) not null default '',
 
+  siteuser_id integer,
+  affiliate_code varchar(40) not null default '',
+
+  shipping_cost integer not null default 0,
+
   primary key (id),
   index order_cchash(ccNumberHash),
   index order_userId(userId, orderDate)
@@ -265,6 +275,12 @@ create table order_item (
   customStr2 varchar(255) null,
   customStr3 varchar(255) null,
 
+  -- transferred from the product
+  title varchar(255) not null default '',
+  summary varchar(255) not null default '',
+  subscription_id integer not null default -1,
+  subscription_period integer not null default 0,
+
   primary key (id),
   index order_item_order(orderId, id)
 );
@@ -331,6 +347,7 @@ create table article_files (
   primary key (id)
 );
 
+-- these are mailing list subscriptions
 drop table if exists subscription_types;
 create table subscription_types (
   id integer not null auto_increment,
@@ -567,3 +584,29 @@ create table admin_perms (
   perm_map varchar(255),
   primary key (object_id, admin_id)
 );
+
+-- -- these are "product" subscriptions
+-- drop table if exists bse_subscriptions;
+-- create table bse_subscriptions (
+--   subscription_id integer not null auto_increment primary key,
+
+--   text_id varchar(20) not null,
+
+--   title varchar(255) not null,
+
+--   description text not null,
+
+--   max_lapsed integer not null,
+
+--   unique (text_id)
+-- );
+
+-- drop table if exists bse_user_subscribed;
+-- create table bse_user_subscribed (
+--   subscription_id integer not null,
+--   siteuser_id integer not null,
+--   started_at date not null,
+--   ends_at date not null,
+--   primary key (subscription_id, siteuser_id)
+-- );
+
index 6c3d688..53a4bfb 100755 (executable)
@@ -14,7 +14,7 @@ my $req = BSE::Request->new;
 my $cfg = $req->cfg;
 my $cgi = $req->cgi;
 unless ($req->check_admin_logon()) {
-  refresh_to_admin("/cgi-bin/admin/logon.pl");
+  refresh_to_admin($cfg, "/cgi-bin/admin/logon.pl");
   exit;
 }
 
@@ -38,7 +38,7 @@ if ($req->user_can(edit_reorder_children => $parentid)) {
     my $parent = Articles->getByPkey($stepparent);
     if ($parent) {
       my @otherlinks = OtherParents->getBy(parentId=>$stepparent);
-      my @normalkids = Articles->listedChildren($stepparent);
+      my @normalkids = Articles->children($stepparent);
       my @stepkids = $parent->stepkids;
       my %stepkids = map { $_->{id}, $_ } @stepkids;
       @kids = (
@@ -131,7 +131,7 @@ reorder.pl - reorder the article siblings, given their parent id
 =head1 SYNOPSIS
 
   <html>...
-  <a href="/cgi-bin/admin/reorder.pl?parentid=...&sort=...>Order</a>
+  <a href="/cgi-bin/admin/reorder.pl?parentid=...&amp;sort=...>Order</a>
   ...</html>
 
 =head1 DESCRIPTION
index 61a0615..c709c96 100755 (executable)
@@ -9,10 +9,8 @@ use lib "$FindBin::Bin/../modules";
 #use Carp; # 'verbose';
 use Products;
 use Product;
-use Orders;
-use Order;
-use OrderItems;
-use OrderItem;
+use BSE::TB::Orders;
+use BSE::TB::OrderItems;
 use BSE::Template;
 #use Squirrel::ImageEditor;
 use Constants qw(:shop $SHOPID $PRODUCTPARENT 
@@ -485,7 +483,7 @@ sub order_list {
   $req->user_can('shop_order_list')
     or return product_list($req, "You don't have access to the order list");
     
-  my $orders = Orders->new;
+  my $orders = BSE::TB::Orders->new;
   my @orders = sort { $b->{orderDate} cmp $a->{orderDate} } $orders->all;
   my $template = $req->cgi->param('template');
   unless (defined $template && $template =~ /^\w+$/) {
@@ -501,7 +499,7 @@ sub order_list_filled {
   $req->user_can('shop_order_list')
     or return product_list($req, "You don't have access to the order list");
 
-  my $orders = Orders->new;
+  my $orders = BSE::TB::Orders->new;
   my @orders = sort { $b->{orderDate} cmp $a->{orderDate} } 
     grep $_->{filled} && $_->{paidFor}, $orders->all;
 
@@ -514,7 +512,7 @@ sub order_list_unfilled {
   $req->user_can('shop_order_list')
     or return product_list($req, "You don't have access to the order list");
 
-  my $orders = Orders->new;
+  my $orders = BSE::TB::Orders->new;
   my @orders = sort { $b->{orderDate} cmp $a->{orderDate} } 
     grep !$_->{filled} && $_->{paidFor}, $orders->all;
 
@@ -528,7 +526,7 @@ sub order_list_unpaid {
   $req->user_can('shop_order_list')
     or return product_list($req, "You don't have access to the order list");
 
-  my $orders = Orders->new;
+  my $orders = BSE::TB::Orders->new;
   my @orders = sort { $b->{orderDate} cmp $a->{orderDate} } 
     grep !$_->{paidFor}, $orders->all;
 
@@ -597,9 +595,9 @@ sub order_detail {
   my $cgi = $req->cgi;
   my $id = $cgi->param('id');
   if ($id and
-      my $order = Orders->getByPkey($id)) {
+      my $order = BSE::TB::Orders->getByPkey($id)) {
     $message ||= $cgi->param('m') || '';
-    my @lines = OrderItems->getBy('orderId', $id);
+    my @lines = $order->items;
     my @products = map { Products->getByPkey($_->{productId}) } @lines;
     my $line_index = -1;
     my $product;
@@ -664,7 +662,7 @@ sub order_filled {
 
   my $id = $req->cgi->param('id');
   if ($id and
-      my $order = Orders->getByPkey($id)) {
+      my $order = BSE::TB::Orders->getByPkey($id)) {
     my $filled = $req->cgi->param('filled');
     $order->{filled} = $filled;
     if ($order->{filled}) {
diff --git a/site/cgi-bin/admin/subadmin.pl b/site/cgi-bin/admin/subadmin.pl
new file mode 100755 (executable)
index 0000000..3d9ef1c
--- /dev/null
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -w
+# -d:ptkdb
+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 Carp 'confess';
+use BSE::UI::SubAdmin;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+my $result = BSE::UI::SubAdmin->dispatch($req);
+BSE::Template->output_result($req, $result);
diff --git a/site/cgi-bin/affiliate.pl b/site/cgi-bin/affiliate.pl
new file mode 100755 (executable)
index 0000000..de1d9de
--- /dev/null
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -w
+# -d:ptkdb
+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 Carp 'confess';
+use BSE::UI::Affiliate;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+my $result = BSE::UI::Affiliate->dispatch($req);
+BSE::Template->output_result($req, $result);
index 9e96c97..fe0510a 100644 (file)
@@ -55,9 +55,9 @@ EOS
    searchIndexWC => 'select * from searchindex where id like ?',
    
    Products=> 'select article.*, product.* from article, product where id = articleId',
-   addProduct => 'insert product values(?,?,?,?,?,?,?)',
+   addProduct => 'insert product values(?,?,?,?,?,?,?,?,?,?,?)',
    getProductByPkey => 'select article.*, product.* from article, product where id=? and articleId = id',
-   replaceProduct => 'replace product values(?,?,?,?,?,?,?)',
+   replaceProduct => 'replace product values(?,?,?,?,?,?,?,?,?,?,?)',
    'Products.stepProducts' => <<EOS,
 select ar.*, pr.* from article ar, product pr, other_parents op
    where ar.id = pr.articleId and op.childId = ar.id and op.parentId = ?
@@ -71,9 +71,9 @@ EOS
    Orders => 'select * from orders',
    getOrderByPkey => 'select * from orders where id = ?',
    getOrderItemByOrderId => 'select * from order_item where orderId = ?',
-   addOrder => 'insert orders values(null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
-   replaceOrder => 'replace orders values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
-   addOrderItem => 'insert order_item values(null,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+   addOrder => 'insert orders values(null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+   replaceOrder => 'replace orders values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+   addOrderItem => 'insert order_item values(null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
    getOrderByUserId => 'select * from orders where userId = ?',
 
    getOrderItemByProductId => 'select * from order_item where productId = ?',
@@ -253,6 +253,15 @@ SQL
 select distinct ap.* 
 from admin_perms ap, admin_groups ag
 where ap.admin_id = ag.base_id and ag.name = 'everyone'
+SQL
+   Subscriptions => 'select * from bse_subscriptions',
+   addSubscription => 'insert bse_subscriptions values(null,?,?,?,?)',
+   replaceSubscription => 'replace bse_subscriptions values(?,?,?,?,?)',
+   deleteSubscription => <<SQL,
+delete from bse_subscriptions where subscription_id = ?
+SQL
+   getSubscriptionByPkey => <<SQL,
+select * from bse_subscriptions where subscription_id = ?
 SQL
   );
 
index 40ba53d..99f66e0 100644 (file)
@@ -881,6 +881,7 @@ sub tag_default {
   }
   else {
     my $value = $self->default_value($req, $article, $col);
+    defined $value or $value = '';
     return escape_html($value);
   }
 }
@@ -1236,7 +1237,7 @@ sub make_link {
   my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
   if ($link_titles) {
     (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
-    $link .= "/".$extra;
+    $link .= "/" . $extra . ".html";
   }
 
   $link;
@@ -1289,38 +1290,27 @@ sub save_new {
   $self->validate_parent(\%data, $articles, $parent, \$msg)
     or return $self->add_form($req, $articles, $msg);
 
-  $self->fill_new_data($req, \%data, $articles);
   my $level = $parent ? $parent->{level}+1 : 1;
+  $data{level} = $level;
   $data{displayOrder} = time;
-  $data{titleImage} ||= '';
-  $data{imagePos} = 'tr';
-  $data{release} = sql_date($data{release}) || now_sqldate();
-  $data{expire} = sql_date($data{expire}) || $Constants::D_99;
-  unless ($data{template}) {
-    $data{template} ||= 
-      $self->{cfg}->entry("children of $data{parentid}", 'template');
-    $data{template} ||=
-      $self->{cfg}->entry("level $level", 'template');
-  }
   $data{link} ||= '';
   $data{admin} ||= '';
-  if ($parent) {
-    $data{threshold} = $parent->{threshold}
-      if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
-    $data{summaryLength} = $parent->{summaryLength}
-      if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
-  }
-  else {
-    $data{threshold} = $self->{cfg}->entry("level $level", 'threshold', 5)
-      if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
-    $data{summaryLength} = 200
-      if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
-  }
   $data{generator} = $self->generator;
   $data{lastModified} = now_sqldatetime();
-  $data{level} = $level;
   $data{listed} = 1 unless defined $data{listed};
 
+  $self->fill_new_data($req, \%data, $articles);
+  for my $col (qw(titleImage imagePos template keyword)) {
+    defined $data{$col} 
+      or $data{$col} = $self->default_value($req, \%data, $col);
+  }
+
+  # these columns are handled a little differently
+  for my $col (qw(release expire  threshold summaryLength )) {
+    $data{$col} 
+      or $data{$col} = $self->default_value($req, \%data, $col);
+  }
+
   shift @columns;
   my $article = $table_object->add(@data{@columns});
 
@@ -2512,6 +2502,15 @@ sub hide {
   return $self->refresh($article, $req->cgi, undef, 'Article hidden');
 }
 
+my %defaults =
+  (
+   titleImage => '',
+   imagePos => 'tr',
+   expire => $Constants::D_99,
+   listed => 1,
+   keyword => '',
+  );
+
 sub default_value {
   my ($self, $req, $article, $col) = @_;
 
@@ -2525,8 +2524,30 @@ sub default_value {
   my $section = "level $article->{level}";
   my $value = $req->cfg->entry($section, $col);
   defined($value) and return $value;
+
+  exists $defaults{$col} and return $defaults{$col};
+
+  $col eq 'release' and return now_sqldate();
+
+  if ($col eq 'threshold') {
+    my $parent = $article->{parentid} != -1 
+      && Articles->getByPkey($article->{parentid}); 
+
+    $parent and return $parent->{threshold};
+    
+    return 5;
+  }
   
-  return '';
+  if ($col eq 'summaryLength') {
+    my $parent = $article->{parentid} != -1 
+      && Articles->getByPkey($article->{parentid}); 
+
+    $parent and return $parent->{summaryLength};
+    
+    return 200;
+  }
+  
+  return;
 }
 
 sub flag_sections {
index 0bcf2fb..52883aa 100644 (file)
@@ -4,6 +4,7 @@ use base 'BSE::Edit::Article';
 use Products;
 use HTML::Entities;
 use BSE::Template;
+use BSE::Util::Iterate;
 
 my %money_fields =
   (
@@ -45,15 +46,23 @@ sub hash_tag {
   return encode_entities($value);
 }
 
+#sub iter_subs {
+#  require BSE::TB::Subscriptions;
+#  BSE::TB::Subscriptions->all;
+#}
+
 sub low_edit_tags {
   my ($self, $acts, $req, $article, $articles, $msg, $errors) = @_;
  
+  my $it = BSE::Util::Iterate->new;
   return 
     (
      product => [ \&hash_tag, $article ],
      $self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg,
                                $errors),
      alloptions => join(",", sort keys %Constants::SHOP_PRODUCT_OPTS),
+     #$it->make_iterator
+     #([ \&iter_subs, $req ], 'subscription', 'subscriptions'),
     );
 }
 
@@ -94,15 +103,41 @@ sub _validate_common {
 
   for my $col (keys %money_fields) {
     my $value = $data->{$col};
+    defined $value or next;
     unless ($value =~ /^\d+(\.\d{1,2})?\s*/) {
       $errors->{$col} = "$money_fields{$col} invalid";
     }
   }
+  
+  if (defined $data->{options}) {
+    my @bad_opts =grep !$Constants::SHOP_PRODUCT_OPTS{$_}, 
+      split /,/, $data->{options};
+    if (@bad_opts) {
+      $errors->{options} = "Bad product options '". join(",", @bad_opts)."' entered";
+    }
+  }
 
-  my @bad_opts =grep !$Constants::SHOP_PRODUCT_OPTS{$_}, 
-  split /,/, $data->{options};
-  if (@bad_opts) {
-    $errors->{options} = "Bad product options '". join(",", @bad_opts)."' entered";
+  my @subs;
+  for my $sub_field (qw(subscription_id subscription_required)) {
+    my $value = $data->{$sub_field};
+    defined $value or next;
+    if ($value ne '-1') {
+      #require BSE::TB::Subscriptions;
+      #@subs = BSE::TB::Subscriptions->all unless @subs;
+      #unless (grep $_->{subscription_id} == $value, @subs) {
+       $errors->{$sub_field} = "Invalid $sub_field value";
+      #}
+    }
+  }
+  if (defined $data->{subscription_period}) {
+    unless ($data->{subscription_period} =~ /^(?:|\d+)$/) {
+      $errors->{subscription_period} = "Invalid subscription period, it must be the number of months to subscribe";
+    }
+  }
+  if (defined $data->{subscription_usage}) {
+    unless ($data->{subscription_usage} =~ /^[123]$/) {
+      $errors->{subscription_usage} = "Invalid subscription usage";
+    }
   }
 
   return !keys %$errors;
@@ -207,8 +242,15 @@ sub _fill_product_data {
       }
     }
   }
-  if (exists $src->{options}) {
-    $data->{options} = $src->{options};
+  for my $field (qw(options subscription_id subscription_period
+                    subscription_usage subscription_required)) {
+    if (exists $src->{$field}) {
+      $data->{$field} = $src->{$field};
+    }
+    elsif ($data == $src) {
+      # use the default
+      $data->{$field} = $self->default_value($req, $data, $field);
+    }
   }
 }
 
@@ -257,4 +299,25 @@ sub flag_sections {
   return ( 'product flags', $self->SUPER::flag_sections );
 }
 
+my %defaults =
+  (
+   options => '',
+   subscription_id => -1,
+   subscription_required => -1,
+   subscription_period => 1,
+   subscription_usage => 3,
+   retailPrice => 0,
+  );
+
+sub default_value {
+  my ($self, $req, $article, $col) = @_;
+
+  my $value = $self->SUPER::default_value($req, $article, $col);
+  defined $value and return $value;
+
+  exists $defaults{$col} and return $defaults{$col};
+
+  return;
+}
+
 1;
index 07d73ce..c09eb29 100644 (file)
@@ -390,8 +390,8 @@ sub _is_product_and_in_use {
 
   if ($article->{generator} eq 'Generate::Product') {
     # can't delete products that have been used in orders
-    require OrderItems;
-    my @items = OrderItems->getBy(productId=>$article->{id});
+    require BSE::TB::OrderItems;
+    my @items = BSE::TB::OrderItems->getBy(productId=>$article->{id});
     if (@items) {
       return 1;
     }
index 6cf0825..041c795 100644 (file)
@@ -127,6 +127,51 @@ sub output_result {
   BSE::Template->output_result($req, $result);
 }
 
+sub message {
+  my ($req, $errors) = @_;
+
+  my $msg = '';
+  if ($errors and keys %$errors) {
+    my @fields = $req->cgi->param;
+    my %work = %$errors;
+    my @lines;
+    for my $field (@fields) {
+      if (my $entry = delete $work{$field}) {
+       push @lines, ref($entry) ? grep $_, @$entry : $entry;
+      }
+    }
+    for my $entry (values %work) {
+      if (ref $entry) {
+       push @lines, grep $_, @$entry;
+      }
+      else {
+       push @lines, $entry;
+      }
+    }
+    my %seen;
+    @lines = grep !$seen{$_}++, @lines; # don't need duplicates
+    $msg = join "<br />", map escape_html($_), @lines;
+  }
+  if (!$msg && $req->cgi->param('m')) {
+    $msg = escape_html($req->cgi->param('m'));
+  }
+
+  return $msg;
+}
+
+sub dyn_response {
+  my ($req, $template, $acts) = @_;
+
+  my $base_template = $template;
+  my $t = $req->cgi->param('t');
+  if ($t && $t =~ /^\w+$/) {
+    $template .= "_$t";
+  }
+
+  return BSE::Template->get_response($template, $req->cfg, $acts,
+                                   $base_template);
+}
+
 sub DESTROY {
   my ($self) = @_;
   if ($self->{session}) {
index 6adec76..a5010b4 100644 (file)
@@ -137,7 +137,15 @@ set on the secure side
 
 =item *
 
-userid - 
+userid - id of the logged on normal user.
+
+=item *
+
+adminuserid - id of the logged on admin user.
+
+=item *
+
+affiliate_code - id of the affiliate set by affiliate.pl
 
 =back
 
index daab541..fd9f28f 100644 (file)
@@ -279,13 +279,20 @@ sub need_logon {
   my $user = get_siteuser($session, $cfg, $cgi);
 
   if (!$user && $reg_if_files) {
-    require 'ArticleFiles.pm';
+    require ArticleFiles;
     # scan to see if any of the products have files
+    # requires a subscription or subscribes
     for my $prod (@$cart_prods) {
       my @files = ArticleFiles->getBy(articleId=>$prod->{id});
       if (grep $_->{forSale}, @files) {
        return ("register before checkout", "shop/fileitems");
       }
+      if ($prod->{subscription_id} != -1) {
+       return ("you must be logged in to purchase a subscription", "shop/buysub");
+      }
+      if ($prod->{subscription_required} != -1) {
+       return ("must be logged in to purchse a product requiring a subscription", "shop/subrequired");
+      }
     }
   }
 
@@ -293,6 +300,29 @@ sub need_logon {
   if (!$user && $require_logon) {
     return ("register before checkout", "shop/logonrequired");
   }
+
+  # check the user has the right required subs
+  # and that they qualify to subscribe for limited subscription products
+  if ($user) {
+    for my $prod (@$cart_prods) {
+      my $sub = $prod->subscription_required;
+      unless ($user->is_subscribed($sub)) {
+       return ("you must be subscribed to $sub->{title} to purchase one of these products", "shop/subrequired");
+      }
+
+      $sub = $prod->subscription;
+      if ($sub->renew_only) {
+       unless ($user->is_subscribed_grace) {
+         return ("you must be subscribed to $sub->{title} to use this renew only product", "sub/renewsubonly");
+       }
+      }
+      if ($sub->new_only) {
+       if ($user->is_subscribed_grace) {
+         return ("you must not be subscribed to $sub->{title} already to use this new subscription only product", "sub/newsubonly");
+       }
+      }
+    }
+  }
   
   return;
 }
@@ -383,8 +413,8 @@ sub payment_types {
     $types{$type}{enabled} = 1;
   }
 
-  use Data::Dumper;
-  print STDERR Dumper \%types;
+  #use Data::Dumper;
+  #print STDERR Dumper \%types;
 
   return values %types;
 }
diff --git a/site/cgi-bin/modules/BSE/TB/Order.pm b/site/cgi-bin/modules/BSE/TB/Order.pm
new file mode 100644 (file)
index 0000000..311a8a8
--- /dev/null
@@ -0,0 +1,48 @@
+package BSE::TB::Order;
+use strict;
+# represents an order from the database
+use Squirrel::Row;
+use vars qw/@ISA/;
+@ISA = qw/Squirrel::Row/;
+
+sub columns {
+  return qw/id
+           delivFirstName delivLastName delivStreet delivSuburb delivState
+          delivPostCode delivCountry
+           billFirstName billLastName billStreet billSuburb billState
+           billPostCode billCountry
+           telephone facsimile emailAddress
+           total wholesaleTotal gst orderDate
+           ccNumberHash ccName ccExpiryHash ccType
+           filled whenFilled whoFilled paidFor paymentReceipt
+           randomId cancelled userId paymentType
+           customInt1 customInt2 customInt3 customInt4 customInt5
+           customStr1 customStr2 customStr3 customStr4 customStr5
+           instructions billTelephone billFacsimile billEmail
+           siteuser_id affiliate_code shipping_cost/;
+}
+
+=item siteuser
+
+returns the SiteUser object of the user who made this order.
+
+=cut
+
+sub siteuser {
+  my ($self) = @_;
+
+  $self->{userId} or return;
+
+  require SiteUsers;
+
+  return ( SiteUsers->getBy(userId=>$self->{userId}) )[0];
+}
+
+sub items {
+  my ($self) = @_;
+
+  require BSE::TB::OrderItems;
+  return BSE::TB::OrderItems->getBy(orderId => $self->{id});
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/OrderItem.pm b/site/cgi-bin/modules/BSE/TB/OrderItem.pm
new file mode 100644 (file)
index 0000000..297a2e2
--- /dev/null
@@ -0,0 +1,14 @@
+package BSE::TB::OrderItem;
+use strict;
+# represents an order line item from the database
+use Squirrel::Row;
+use vars qw/@ISA/;
+@ISA = qw/Squirrel::Row/;
+
+sub columns {
+  return qw/id productId orderId units price wholesalePrice gst options
+            customInt1 customInt2 customInt3 customStr1 customStr2 customStr3
+            title summary subscription_id subscription_period/;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/OrderItems.pm b/site/cgi-bin/modules/BSE/TB/OrderItems.pm
new file mode 100644 (file)
index 0000000..c66b43e
--- /dev/null
@@ -0,0 +1,12 @@
+package BSE::TB::OrderItems;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::OrderItem;
+
+sub rowClass {
+  return 'BSE::TB::OrderItem';
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/Orders.pm b/site/cgi-bin/modules/BSE/TB/Orders.pm
new file mode 100644 (file)
index 0000000..6dd5285
--- /dev/null
@@ -0,0 +1,12 @@
+package BSE::TB::Orders;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::Order;
+
+sub rowClass {
+  return 'BSE::TB::Order';
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/Subscription.pm b/site/cgi-bin/modules/BSE/TB/Subscription.pm
new file mode 100644 (file)
index 0000000..2033294
--- /dev/null
@@ -0,0 +1,45 @@
+package BSE::TB::Subscription;
+use strict;
+use Squirrel::Row;
+use vars qw/@ISA/;
+@ISA = qw/Squirrel::Row/;
+
+sub columns {
+  return qw/subscription_id text_id title description max_lapsed/;
+}
+
+sub primary { 'subscription_id' }
+
+# call as a method for edits
+sub valid_rules {
+  my ($self, $cfg) = @_;
+
+  my @subs = BSE::TB::Subscriptions->all;
+  if (ref $self) {
+    @subs = grep $_->{subscription_id} != $self->{subscription_id}, @subs;
+  }
+  my $notsubid_match = join '|', map $_->{text_id}, @subs;
+
+  return
+    (
+     identifier => { match => qr/^\w+$/,
+                  error => '$n must contain only letters and digits, and no spaces' },
+     notsubid => { nomatch => qr/^(?:$notsubid_match)$/,
+                error => 'Duplicate identifier' },
+    );
+}
+
+sub valid_fields {
+  return
+    (
+     text_id => { description=>"Identifier", 
+                 rules=>'required;identifier;notsubid' },
+     title => { description=>"Title",
+               required => 1 },
+     description => { description=>"Description" },
+     max_lapsed => { description => 'Max lapsed', 
+                    rules => 'required;natural', },
+    );
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/Subscriptions.pm b/site/cgi-bin/modules/BSE/TB/Subscriptions.pm
new file mode 100644 (file)
index 0000000..68eaaad
--- /dev/null
@@ -0,0 +1,12 @@
+package BSE::TB::Subscriptions;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::Subscription;
+
+sub rowClass {
+  return 'BSE::TB::Subscription';
+}
+
+1;
index eff85c0..9ce57a9 100644 (file)
@@ -101,11 +101,16 @@ sub get_response {
 sub get_refresh {
   my ($class, $url, $cfg) = @_;
 
+  # the commented out headers were meant to help Opera, but they didn't
   return
     {
      type=>$class->html_type($cfg),
      content=>"<html></html>",
-     headers=>[ qq/Refresh: 0; url=$url/ ],
+     headers=>[ qq/Refresh: 0; url=$url/,
+               #qq/Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0, max-age=0/,
+               #qq/Pragma: no-cache/,
+               #qq/Expires: Thu, 01 Jan 1970 00:00:00 GMT/
+             ],
     };
 }
 
diff --git a/site/cgi-bin/modules/BSE/UI/AdminDispatch.pm b/site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
new file mode 100644 (file)
index 0000000..fa2069c
--- /dev/null
@@ -0,0 +1,77 @@
+package BSE::UI::AdminDispatch;
+use strict;
+use base qw(BSE::UI::Dispatch);
+use BSE::CfgInfo qw(admin_base_url);
+use Carp qw(confess);
+
+# checks we're coming from HTTPS
+sub check_secure {
+  my ($class, $req, $rresult) = @_;
+
+  my $securl = admin_base_url($req->cfg);
+  my ($protocol, $host) = $securl =~ m!^(\w+)://([-\w.]+)!
+    or confess "Invalid [site].secureurl\n";
+  
+  $host = lc $host;
+
+  my $curr_host = lc $ENV{SERVER_NAME};
+  my $curr_https = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
+  my $curr_proto = $curr_https ? 'https' : 'http';
+
+  return 1 if $curr_host eq $host && $curr_proto eq $protocol;
+
+  print STDERR "User is coming to use via a non-secure URL\n";
+  print STDERR "curr host  >$curr_host< secure_host >$host<\n";
+  print STDERR "curr proto >$curr_proto< secure_proto >$protocol<\n";
+
+  # refresh back to the secure URL
+  my $target = ($ENV{SCRIPT_NAME} =~ /(\w+)\.pl$/)[0] or die;
+  my $url = $req->url($target => { $class->default_action => 1 });
+  $$rresult = BSE::Template->get_refresh($url, $req->cfg);
+
+  return;
+}
+
+sub check_action {
+  my ($class, $req, $action, $rresult) = @_;
+
+  # this is admin, the user must be logged on
+  unless ($req->check_admin_logon) {
+    # time to logon
+    # if this was a GET, try to refresh back to it after logon
+    my %extras =
+      (
+       'm' => 'You must logon to use this function'
+      );
+    if ($ENV{REQUEST_METHOD} eq 'GET') {
+      my $rurl = admin_base_url($req->cfg) . $ENV{SCRIPT_NAME};
+      $rurl .= "?" . $ENV{QUERY_STRING} if $ENV{QUERY_STRING};
+      $rurl .= $rurl =~ /\?/ ? '&' : '?';
+      $rurl .= "refreshed=1";
+      $extras{r} = $rurl;
+    }
+    my $url = $req->url(logon => \%extras);
+    $$rresult = BSE::Template->get_refresh($url, $req->cfg);
+    return;
+  }
+
+  my $security = $class->rights;
+
+  return 1 unless $security->{$action};
+
+  my $msg;
+  my $rights = $security->{$action};
+  ref $rights or $rights = [ split /,/, $rights ];
+  for my $right (@$rights) {
+    unless ($req->user_can($right, -1, \$msg)) {
+      my $url = $req->url(menu => 
+                         { 'm' => 'You do not have access to this function '.$msg });
+      $$rresult = BSE::Template->get_refresh($url, $req->cfg);
+      return;
+    }
+  }
+
+  return 1;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/UI/Affiliate.pm b/site/cgi-bin/modules/BSE/UI/Affiliate.pm
new file mode 100644 (file)
index 0000000..46181ae
--- /dev/null
@@ -0,0 +1,89 @@
+package BSE::UI::Affiliate;
+use strict;
+
+use base qw(BSE::UI::Dispatch);
+
+my %actions =
+  (
+   setaff => 1,
+   show => 1,
+   none => 1,
+  );
+
+sub actions { \%actions }
+
+sub default_action { 'none' }
+
+sub req_setaff {
+  my ($class, $req) = @_;
+
+  my $cgi = $req->cgi;
+  my $cgi = $req->cfg;
+  my $id = $cgi->param('id');
+
+  defined($id) && $id =~ /^\w+$/
+    or return $class->req_none($req, "Missing or invalid id");
+
+  my $allowed_referer = $cfg->entry('affiliate', 'allowed_referer');
+  my $require_referer = $cfg->entry('affiliate', 'require_referer');
+  if ($allowed_referer) {
+    my @allowed = split /;/, $allowed_referer;
+    my $referer = $ENV{HTTP_REFERER};
+    if ($referer) {
+      my ($domain) = ($referer =~ m!^\w+://([\w/]+)!);
+      $domain = lc $domain;
+      my $found = 0;
+      for my $entry (@allowed) {
+       $entry = lc $entry;
+
+       if ($length($entry) < $domain &&
+           $entry eq substr($domain, -length($entry))) {
+         ++$found;
+         last;
+       }
+      }
+      $found
+       or return $class->req_none($req, "$domain not in the permitted list of referers");
+    }
+    else {
+      $require_referer
+       and return $class->req_none($req, 'Referer not supplied');
+    }
+  }
+
+  my $url = $cgi->param('r');
+  $url ||= $cgi->entry('affiliate', 'default_refresh');
+  $url ||= $cgi->entryVar('site', 'url');
+
+  $req->session->{affiliate_code} = $id;
+
+  return BSE::Template->get_refresh($url, $cfg);
+}
+
+# display the affiliate page for a given user
+# this doesn't set the affiliate code (should it?)
+sub req_show {
+  my ($class, $req) = @_;
+
+  my $cgi = $req->cgi;
+  my $cfg = $req->cfg;
+
+  my $id = $cgi->param('id');
+  defined $id
+    or return $class->req_none($req, "No identifier supplied");
+  require SiteUsers;
+  require BSE::TB::Subscriptions;
+  my $user = SiteUsers->getBy(userId => $id);
+  $user
+    or return $class->req_none($req, "Unknown user");
+  my $subid = $cfg->entry('affiliate', 'subscription_required');
+  if ($subid) {
+    my $sub = BSE::TB::Subscriptions->getByPkey($subid)
+      || BSE::TB::Subscriptions->getBy(text_id => $subid)
+       or return $class->req_none($req, "Configuration error: Unknown subscription id");
+
+    
+  }
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/UI/Dispatch.pm b/site/cgi-bin/modules/BSE/UI/Dispatch.pm
new file mode 100644 (file)
index 0000000..23339b3
--- /dev/null
@@ -0,0 +1,43 @@
+package BSE::UI::Dispatch;
+use strict;
+use Carp 'confess';
+
+sub dispatch {
+  my ($class, $req) = @_;
+
+  my $result;
+  $class->check_secure($req, \$result)
+    or return $result;
+
+  my $actions = $class->actions;
+
+  my $cgi = $req->cgi;
+  my $action;
+  for my $check (keys %$actions) {
+    if ($cgi->param("a_$check")) {
+      $action = $check;
+      last;
+    }
+  }
+  $action ||= $class->default_action;
+
+  $class->check_action($req, $action, \$result)
+    or return $result;
+
+  my $method = "req_$action";
+  $class->$method($req);
+}
+
+sub check_secure {
+  my ($class, $req, $rresult) = @_;
+
+  return 1;
+}
+
+sub check_action {
+  my ($class, $req, $action, $rresult) = @_;
+
+  return 1;
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/UI/SubAdmin.pm b/site/cgi-bin/modules/BSE/UI/SubAdmin.pm
new file mode 100644 (file)
index 0000000..55f441e
--- /dev/null
@@ -0,0 +1,217 @@
+package BSE::UI::SubAdmin;
+use strict;
+use base qw(BSE::UI::AdminDispatch);
+use BSE::Util::Tags qw(tag_hash tag_error_img);
+use BSE::Util::DynSort qw(sorter tag_sorthelp);
+use DevHelp::Validate qw(dh_validate);
+use BSE::Template;
+use BSE::Util::Iterate;
+use BSE::TB::Subscriptions;
+use DevHelp::HTML;
+
+my %rights =
+  (
+   list => 'bse_subs_list',
+   addform => 'bse_subs_add',
+   add => 'bse_subs_add',
+   edit => 'bse_subs_edit',
+   save => 'bse_subs_edit',
+   detail => 'bse_subs_detail',
+  );
+
+sub actions { \%rights }
+
+sub rights { \%rights }
+
+sub default_action { 'list' }
+
+sub req_list {
+  my ($class, $req, $errors) = @_;
+
+  my $msg = $req->message($errors);
+  my $cgi = $req->cgi;
+  my @subs = BSE::TB::Subscriptions->all;
+  my ($sortby, $reverse) =
+    sorter(data=>\@subs, cgi=>$cgi, sortby=>'subscription_id', 
+          session=>$req->session,
+           name=>'subs', fields=> { subscription_id => {numeric => 1 },
+                                    max_lapsed => { numeric => 1}});
+  my $it = BSE::Util::Iterate->new;
+
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+     BSE::Util::Tags->admin(\%acts, $req->cfg),
+     BSE::Util::Tags->secure($req),
+     msg => $msg,
+     message => $msg,
+     $it->make_paged_iterator('isubscription', 'subscriptions', \@subs, undef,
+                              $cgi, undef, 'pp=20', $req->session, 
+                              'subscriptions'),
+     sorthelp => [ \&tag_sorthelp, $sortby, $reverse ],
+     sortby=>$sortby,
+     reverse=>$reverse,
+    );
+
+  return $req->dyn_response('admin/subscr/list', \%acts);
+}
+
+sub req_addform {
+  my ($class, $req, $errors) = @_;
+
+  my $msg = $req->message($errors);
+
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+     BSE::Util::Tags->admin(\%acts, $req->cfg),
+     BSE::Util::Tags->secure($req),
+     msg => $msg,
+     message => $msg,
+     error_img => [ \&tag_error_img, $req->cfg, $errors ],
+    );
+
+  return $req->dyn_response('admin/subscr/add', \%acts);
+}
+
+sub req_add {
+  my ($class, $req) = @_;
+
+  my $cgi = $req->cgi;
+  my $cfg = $req->cfg;
+  my %fields = BSE::TB::Subscription->valid_fields($cfg);
+  my %rules = BSE::TB::Subscription->valid_rules($cfg);
+  my %errors;
+  dh_validate($cgi, \%errors, 
+             { fields => \%fields, rules=> \%rules },
+             $cfg, "BSE Subscription Validation");
+
+  keys %errors
+    and return $class->req_addform($req, \%errors);
+
+  my %sub;
+  for my $field (keys %fields) {
+    $sub{$field} = $cgi->param($field);
+  }
+  my @cols = BSE::TB::Subscription->columns;
+  shift @cols;
+  my $sub = BSE::TB::Subscriptions->add(@sub{@cols});
+
+  my $r = $class->_list_refresh($req, "Subscription $sub{text_id} added");
+
+  return BSE::Template->get_refresh($r, $req->cfg);
+}
+
+sub req_edit {
+  my ($class, $req, $errors) = @_;
+
+  my $sub_id = $req->cgi->param('subscription_id');
+  $sub_id && $sub_id =~ /^\d+/
+    or return $class->req_list
+      ($req, { subscription_id=>'Missing or invalid subscription_id' });
+  my $sub = BSE::TB::Subscriptions->getByPkey($sub_id);
+  $sub
+    or return $class->req_list
+      ($req, { subscription_id=>'Unknown subscription_id' });
+
+  my $msg = $req->message($errors);
+
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+     BSE::Util::Tags->admin(\%acts, $req->cfg),
+     BSE::Util::Tags->secure($req),
+     msg => $msg,
+     message => $msg,
+     error_img => [ \&tag_error_img, $req->cfg, $errors ],
+     subscription => [ \&tag_hash, $sub ],
+    );
+
+  return $req->dyn_response('admin/subscr/edit', \%acts);
+}
+
+sub req_save {
+  my ($class, $req) = @_;
+
+  my $sub_id = $req->cgi->param('subscription_id');
+  $sub_id && $sub_id =~ /^\d+/
+    or return $class->req_list
+      ($req, { subscription_id=>'Missing or invalid subscription_id' });
+  my $sub = BSE::TB::Subscriptions->getByPkey($sub_id);
+  $sub
+    or return $class->req_list
+      ($req, { subscription_id=>'Unknown subscription_id' });
+
+  my $cgi = $req->cgi;
+  my $cfg = $req->cfg;
+  my %fields = $sub->valid_fields($cfg);
+  my %rules = $sub->valid_rules($cfg);
+  my %errors;
+  dh_validate($cgi, \%errors, 
+             { fields => \%fields, rules=> \%rules },
+             $cfg, "BSE Subscription Validation");
+
+  keys %errors
+    and return $class->req_edit($req, \%errors);
+
+  for my $field (keys %fields) {
+    $sub->{$field} = $cgi->param($field);
+  }
+
+  $sub->save;
+
+  my $r = $class->_list_refresh($req, "Subscription $sub->{text_id} saved");
+
+  return BSE::Template->get_refresh($r, $req->cfg);
+}
+
+sub req_detail {
+  my ($class, $req) = @_;
+
+  my $sub_id = $req->cgi->param('subscription_id');
+  $sub_id && $sub_id =~ /^\d+/
+    or return $class->req_list
+      ($req, { subscription_id=>'Missing or invalid subscription_id' });
+  my $sub = BSE::TB::Subscriptions->getByPkey($sub_id);
+  $sub
+    or return $class->req_list
+      ($req, { subscription_id=>'Unknown subscription_id' });
+
+  my $msg = $req->message($errors);
+
+  my %acts;
+  %acts =
+    (
+     BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
+     BSE::Util::Tags->admin(\%acts, $req->cfg),
+     BSE::Util::Tags->secure($req),
+     msg => $msg,
+     message => $msg,
+     subscription => [ \&tag_hash, $sub ],
+     # products that use it
+     # users subscribed to it
+    );
+
+  return $req->dyn_response('admin/subscr/detail', \%acts);
+}
+
+sub _list_refresh {
+  my ($class, $req, $msg) = @_;
+
+  my $r = $req->cgi->param('r') || $req->cgi->param('refreshto');
+  unless ($r) {
+    $r = "/cgi-bin/admin/subadmin.pl";
+  }
+  if ($msg) {
+    my $sep = $r =~ /\?/ ? '&' : '?';
+
+    $r .= $sep . escape_uri($msg);
+  }
+
+  return $r;
+}
+
+1;
index 711274a..093b3a9 100644 (file)
@@ -614,7 +614,7 @@ sub tag_if_user_can {
 
     # whew, so we should have an article
     $req->user_can($perm, $article)
-      or return;
+      or return 0;
   }
 
   return 1;
@@ -675,7 +675,7 @@ sub tag_replace {
        defined or $_ = '' for @out;
        my $tmp = $with;
        {
-         $tmp =~ s/\$([1-9\$])/$1 eq '$' ? '$' :
+         $tmp =~ s/\$([1-9\$])/
            $1 eq '$' ? '$' : $out[$1-1] /ge;
        }
        $tmp;
@@ -689,7 +689,7 @@ sub tag_replace {
        defined or $_ = '' for @out;
        my $tmp = $with;
        {
-         $tmp =~ s/\$([1-9\$])/$1 eq '$' ? '$' :
+         $tmp =~ s/\$([1-9\$])/
            $1 eq '$' ? '$' : $out[$1-1] /ge;
        }
        $tmp;
diff --git a/site/cgi-bin/modules/DevHelp/Validate.pm b/site/cgi-bin/modules/DevHelp/Validate.pm
new file mode 100644 (file)
index 0000000..26ca2f0
--- /dev/null
@@ -0,0 +1,548 @@
+package DevHelp::Validate;
+use strict;
+require Exporter;
+use vars qw(@EXPORT_OK @ISA);
+@EXPORT_OK = qw(dh_validate dh_validate_hash dh_fieldnames);
+@ISA = qw(Exporter);
+
+sub new {
+  my ($class, %opts) = @_;
+
+  return bless \%opts, $class;
+}
+
+my %built_ins =
+  (
+   email => 
+   {
+    match => qr/^[^\@]+\@[\w.-]+\.\w+$/,
+    error => '$n is not a valid email address',
+   },
+   phone => 
+   {
+    match => qr/\d(?:\D*\d){3}/,
+    error => '$n is not a valid phone number',
+   },
+   postcode => 
+   {
+    match => qr/\d(?:\D*\d){3}/,
+    error => '$n is not a valid post code',
+   },
+   url =>
+   {
+    match => qr!^\w+://[\w-]+(?:\.[\w-]+)+(?::\d+)?!,
+    error => '$n is not a valid URL',
+   },
+   weburl =>
+   {
+    match => qr!^https?://[\w-]+(?:\.[\w-]+)+(?::\d+)?!,
+    error => '$n is not a valid URL, it must start with http:// or https://',
+   },
+   newbieweburl =>
+   {
+    match => qr!^(?:https?://)?[\w-]+(?:\.[\w-]+)+(?::\d+)?!,
+    error => '$n is not a valid URL',
+   },
+   confirm =>
+   {
+    confirm=>'password',
+   },
+   newconfirm =>
+   {
+    newconfirm=>'password',
+   },
+   required =>
+   {
+    required => 1,
+   },
+   abn => 
+   {
+    match => qr/\d(?:\D*\d){7}/,
+    error => '$n is not a valid ABN',
+   },
+   creditcardnumber =>
+   {
+    match => qr/^\D*\d(?:\D*\d){11,15}\D*$/,
+    error => '$n is not a valid credit card number',
+   },
+   creditcardexpiry =>
+   {
+    ccexpiry => 1,
+   },
+   miaa =>
+   {
+    match => qr/^\s*\d{1,6}\s*$/,
+    error => 'Not a valid MIAA membership number',
+   },
+   decimal =>
+   {
+    match => qr/^\s*(?:\d+(?:\.\d*)?|\.\d+)\s*$/,
+    error => 'Not a valid number',
+   },
+   money =>
+   {
+    match => qr/^\s*(?:\d+(?:\.\d\d)?|\.\d\d)\s*$/,
+    error => 'Not a valid money amount',
+   },
+   date =>
+   {
+    date => 1,
+   },
+   birthdate =>
+   {
+    date => 1,
+    maxdate => '+0y',
+    maxdatemsg => 'Your $n must be in the past',
+   },
+   adultbirthdate =>
+   {
+    date => 1,
+    maxdate => '-10y',
+    maxdatemsg => 'You must be at least 10 years old...',
+    mindate => '-100y',
+   },
+   futuredate =>
+   {
+    date => 1,
+    mindate => '-1d',
+    mindatemsg => 'The date entered must be in the future',
+   },
+   natural => 
+   {
+    integer => '0-', # 0 or higher
+   },
+   positiveint =>
+   {
+    integer => '1-', # 1 or higher
+   },
+  );
+
+sub dh_validate {
+  my ($cgi, $errors, $validation, $cfg, $section) = @_;
+
+  return DevHelp::Validate::CGI->new(cfg=>$cfg, cgi=>$cgi, section=>$section)
+    ->validate($errors, $validation);
+}
+
+sub dh_validate_hash {
+  my ($hash, $errors, $validation, $cfg, $section) = @_;
+
+  return DevHelp::Validate::Hash->new(cfg=>$cfg, hash=>$hash, section=>$section)
+    ->validate($errors, $validation);
+}
+
+sub validate {
+  my ($self, $errors, $validation) = @_;
+
+  my $rules = $validation->{rules};
+  my $fields = $validation->{fields};
+  my $optional = $validation->{optional};
+  
+  my %cfg_rules;
+  _get_cfg_fields(\%cfg_rules, $self->{cfg}, $self->{section}, $fields)
+    if $self->{cfg} && $self->{section};
+
+  for my $rulename (keys %$rules) {
+    unless (exists $cfg_rules{rules}{$rulename}) {
+      $cfg_rules{rules}{$rulename} = $rules->{$rulename};
+    }
+  }
+  for my $rulename (keys %built_ins) {
+    unless (exists $cfg_rules{rules}{$rulename}) {
+      $cfg_rules{rules}{$rulename} = $built_ins{$rulename};
+    }
+  }
+
+  # merge the supplied fields into the config fields
+  my $cfg_fields = $cfg_rules{fields};
+  for my $field ( keys %$fields ) {
+    my $src = $fields->{$field};
+
+    my $dest = $cfg_fields->{$field} || {};
+
+    # the config overrides the software supplied fields
+    for my $override (qw(description required required_error)) {
+      if (defined $src->{$override} && !defined $dest->{$override}) {
+       $dest->{$override} = $src->{$override};
+      }
+    }
+
+    # but we add rules
+    if ($dest->{rules}) {
+      my $rules = $src->{rules};
+
+      # make a copy of the rules array if it's supplied that way so
+      # we don't modify someone else's data
+      $rules = ref $rules ? [ @$rules ] : [ split /;/, $rules ];
+
+      push @$rules, split /;/, $dest->{rules};
+    }
+    elsif ($src->{rules}) {
+      $dest->{rules} = $src->{rules};
+    }
+
+    $cfg_fields->{$field} = $dest if keys %$dest;
+  }
+  for my $field ( keys %$cfg_fields ) {
+    $self->validate_field($field, $cfg_fields->{$field}, $cfg_rules{rules}, 
+                         $optional, $errors);
+  }
+  
+  !keys %$errors;
+}
+
+sub validate_field {
+  my ($self, $field, $info, $rules, $optional, $errors) = @_;
+
+  my @data = $self->param($field);
+
+  my $required = $info->{required};
+  if (@data && $data[0] !~ /\S/ && $info->{required_if}) {
+    # field is required if any of the named fields are non-blank
+    for my $testfield (split /;/, $info->{required_if}) {
+      my $testvalue = $self->param($testfield);
+      if (defined $testvalue && $testvalue =~ /\S/) {
+       ++$required;
+       last;
+      }
+    }
+  }
+
+  my $rule_names = $info->{rules};
+  defined $rule_names or $rule_names = '';
+  $rule_names = [ split /;/, $rule_names ] unless ref $rule_names;
+  
+  push @$rule_names, 'required' if $required;
+
+  @$rule_names or return;
+
+ RULE: for my $rule_name (@$rule_names) {
+    my $rule = $rules->{$rule_name};
+    unless ($rule) {
+      $rule = $self->_get_cfg_rule($rule_name);
+      if ($rule) {
+       $rules->{$rule_name} = $rule;
+      }
+      else {
+       print STDERR "** Unknown validation rule $rule_name for $field\n";
+      }
+    }
+    if (!$optional && $rule->{required} && !@data ) {
+      $errors->{$field} = _make_error($field, $info, $rule,
+                                     $info->{required_error} ||
+                                     $rule->{required_error} || 
+                                     '$n is a required field');
+      last RULE;
+    }
+    for my $data (@data) {
+      if ($rule->{required} && $data !~ /\S/) {
+       $errors->{$field} = _make_error($field, $info, $rule, 
+                                       $info->{required_error} ||
+                                       $rule->{required_error} || 
+                                       '$n is a required field');
+       last RULE;
+      }
+      if ($rule->{newconfirm}) {
+       my $other = $self->param($rule->{newconfirm});
+       if ($other ne '' || $data ne '') {
+         if ($other ne $data) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           q!$n doesn't match the password!);
+           last RULE;
+         }
+       }
+      }
+      if ($data !~ /\S/ && !$rule->{required}) {
+       next RULE;
+      }
+      if ($rule->{match}) {
+       my $match = $rule->{match};
+       unless ($data =~ /$match/) {
+         $errors->{$field} = _make_error($field, $info, $rule);
+         last RULE;
+       }
+      }
+      if ($rule->{nomatch}) {
+       my $match = $rule->{nomatch};
+       if ($data =~ /$match/) {
+         $errors->{$field} = _make_error($field, $info, $rule);
+         last RULE;
+       }
+      }
+      if ($rule->{integer}) {
+       unless ($data =~ /^\s*([-+]?\d+)s*$/) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         '$n must be a whole number');
+         last RULE;
+       }
+       my $num = $1;
+       if (my ($from, $to) = $rule->{integer} =~ /^([+-]?\d+)-([+-]?\d+)$/) {
+         unless ($from <= $num and $num <= $to) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           $info->{range_error} ||
+                                           $rule->{range_error} ||
+                                           "\$n must be in the range $from to $to");
+           last RULE;
+         }
+       }
+       elsif (my ($from2) = $rule->{integer} =~ /^([+-]?\d+)-$/) {
+         unless ($from2 <= $num) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           $info->{range_error} ||
+                                           $rule->{range_error} ||
+                                           "\$n must be $from2 or higher");
+           last RULE;
+         }
+       }
+      }
+      if ($rule->{date}) {
+       unless ($data =~ m!^\s*(\d+)[-+/](\d+)[-+/](\d+)\s*$!) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         '$n must be a valid date');
+         last RULE;
+       }
+       my ($day, $month, $year) = ($1, $2, $3);
+       if ($day < 1 || $day > 31) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         '$n must be a valid date - day out of range');
+         last RULE;
+       }
+       if ($month < 1 || $month > 12) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         '$n must be a valid date - month out of range');
+         last RULE;
+       }
+       if ($rule->{mindate} || $rule->{maxdate}) {
+         require DevHelp::Date;
+         my $workdate = sprintf("%04d-%02d-%02d", $year, $month, $day);
+         if ($rule->{mindate}) {
+           my $mindate = DevHelp::Date::dh_parse_date_sql($rule->{mindate});
+           if ($workdate le $mindate) {
+             $errors->{$field} = 
+               _make_error($field, $info, $rule,
+                           $info->{mindatemsg} || $rule->{mindatemsg} || '$n is too early');
+           }
+         }
+         if (!$errors->{$field} && $rule->{maxdate}) {
+           my $maxdate = DevHelp::Date::dh_parse_date_sql($rule->{maxdate});
+           if ($workdate ge $maxdate) {
+             $errors->{$field} = 
+               _make_error($field, $info, $rule,
+                           $info->{mindatemsg} || $rule->{maxdatemsg} || '$n is too late');
+           }
+         }
+       }
+      }
+      if ($rule->{confirm}) {
+       my $other = $self->param($rule->{confirm});
+       unless ($other eq $data) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         q!$n doesn't match the password!);
+         last RULE;
+       }
+      }
+      if ($rule->{ccexpiry}) {
+       (my $year_field = $field) =~ s/month/year/;
+       
+       unless ($data =~ /^\s*\d+\s*$/) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         q!$n month isn't a number!);
+         last RULE;
+       }
+       my $year = $self->param($year_field);
+       unless (defined $year && $year =~ /\s*\d+\s*$/) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         q!$n year isn't a number!);
+         last RULE;
+       }
+       my ($now_year, $now_month) = (localtime)[5, 4];
+       $now_year += 1900;
+       ++$now_month;
+       if ($year < $now_year || $year == $now_year && $data < $now_month) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         q!$n is in the past, your card has expired!);
+         last RULE;
+       }
+      }
+    }
+  }
+}
+
+sub _make_error {
+  my ($field, $info, $rule, $message) = @_;
+
+  $message ||= $rule->{error} || 'Validation error on field $n';
+
+  my $name = $info->{description} || $field;
+  $message =~ s/\$n/$name/g;
+
+  return $message;
+}
+
+sub _get_cfg_fields {
+  my ($rules, $cfg, $section, $field_hash) = @_;
+
+  $rules->{rules} = {};
+  $rules->{fields} = {};
+
+  my $cfg_fields = $rules->{fields};
+
+  my $fields = $cfg->entry($section, 'fields', '');
+  my @names = ( split(/,/, $fields), keys %$field_hash );
+
+  for my $field (@names) {
+    for my $cfg_name (qw(required rules description required_error range_error mindatemsg maxdatemsg)) {
+      my $value = $cfg->entry($section, "${field}_$cfg_name");
+      if (defined $value) {
+       $cfg_fields->{$field}{$cfg_name} = $value;
+      }
+    }
+  }
+}
+
+sub _get_cfg_rule {
+  my ($self, $rulename) = @_;
+
+  my %rule = $self->{cfg}->entries("Validation Rule $rulename");
+
+  keys %rule or return;
+
+  \%rule;
+}
+
+sub dh_fieldnames {
+  my ($cfg, $section, $fields) = @_;
+
+  # this needs to be obsoleted now that dh_validate() checks the config
+
+  for my $field (keys %$fields) {
+    my $desc = $cfg->entry($section, $field);
+    defined $desc and $fields->{$field}{description} = $desc;
+  }
+}
+
+package DevHelp::Validate::CGI;
+use vars qw(@ISA);
+@ISA = qw(DevHelp::Validate);
+
+sub param {
+  my ($self, $field) = @_;
+
+  $self->{cgi}->param($field);
+}
+
+package DevHelp::Validate::Hash;
+use vars qw(@ISA);
+@ISA = qw(DevHelp::Validate);
+
+sub param {
+  my ($self, $field) = @_;
+
+  my $value = $self->{hash}{$field};
+
+  defined $value or return;
+
+  if (ref $value eq 'ARRAY') {
+    return @$value;
+  }
+
+  return $value;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DevHelp::Validate - handy configurable validation, I hope
+
+=head1 SYNOPSIS
+
+  use DevHelp::Validate qw(dh_validate);
+
+  dh_validate($cgi, \%errors, \%rules, $cfg)
+    or display_errors(..., \%errors);
+
+=head1 DESCRIPTION
+
+=head1 RULES PARAMETER
+
+The rules parameter is a hash with 2 keys:
+
+=over
+
+=item fields
+
+A hash of field names, for each of which the value is a hash.
+
+Each hash can have the following keys:
+
+=over
+
+=item rules
+
+A simple rule name, a ';' separated list of rule names or an array
+ref.
+
+=item description
+
+A short description of the field, for use in error messages.
+
+=back
+
+=item rules
+
+A hash of rules.  See the rules description under L<CONFIGURED
+VALIDATON>.
+
+=back
+
+=head1 CONFIGURED VALIDATION
+
+Rules can be configured in the database.
+
+For the specified section name, each key is a CGI field name.
+
+The values of those keys gives the name of a validation rule, a string
+id for internationlization of the field description and a default
+field description, separated by commas.
+
+Each validation rule name has a corresponding section, [Validate Rule
+I<rule-name>], which describes the rule.  Rule names can also refer to
+built-in rules,
+
+Values in the validation rule section are:
+
+=over
+
+=item required
+
+If this is non-zero the field is required.
+
+=item match
+
+If present, this is used as a regular expression the field must match.
+
+=item error
+
+Message returned as the error if the field fails validation.
+
+=item integer
+
+If set to 1, simply ensures the value is an integer.
+
+If set to a range I<integer>-I<integer> then ensures the value is an
+integer in that range.
+
+=item date
+
+If set to 1, simply validates the value as a date.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
index 1314a5b..4a9c125 100644 (file)
@@ -18,7 +18,8 @@ sub columns {
            randomId cancelled userId paymentType
            customInt1 customInt2 customInt3 customInt4 customInt5
            customStr1 customStr2 customStr3 customStr4 customStr5
-           instructions billTelephone billFacsimile billEmail/;
+           instructions billTelephone billFacsimile billEmail
+           siteuser_id affiliate_code/;
 }
 
 =item siteuser
@@ -37,4 +38,11 @@ sub siteuser {
   return ( SiteUsers->getBy(userId=>$self->{userId}) )[0];
 }
 
+sub items {
+  my ($self) = @_;
+
+  require BSE::TB::OrderItems;
+  return BSE::TB::OrderItems->getBy(orderId => $self->{id});
+}
+
 1;
index b898ffa..297a2e2 100644 (file)
@@ -1,4 +1,4 @@
-package OrderItem;
+package BSE::TB::OrderItem;
 use strict;
 # represents an order line item from the database
 use Squirrel::Row;
@@ -7,7 +7,8 @@ use vars qw/@ISA/;
 
 sub columns {
   return qw/id productId orderId units price wholesalePrice gst options
-            customInt1 customInt2 customInt3 customStr1 customStr2 customStr3/;
+            customInt1 customInt2 customInt3 customStr1 customStr2 customStr3
+            title summary subscription_id subscription_period/;
 }
 
 1;
index 2560b34..2aff2ea 100644 (file)
@@ -1,11 +1,11 @@
-package OrderItems;
+package BSE::TB::OrderItems;
 use strict;
 use Squirrel::Table;
 use vars qw(@ISA $VERSION);
 @ISA = qw(Squirrel::Table);
 
 sub rowClass {
-  return 'OrderItem';
+  return 'BSE::TB::OrderItem';
 }
 
 1;
index d1640a3..f8262cc 100644 (file)
@@ -7,11 +7,23 @@ use vars qw/@ISA/;
 
 sub columns {
   return ($_[0]->SUPER::columns(), 
-         qw/articleId summary leadTime retailPrice wholesalePrice gst options/ );
+         qw/articleId summary leadTime retailPrice wholesalePrice gst options
+             subscription_id subscription_period subscription_usage
+             subscription_required/ );
 }
 
 sub bases {
   return { articleId=>{ class=>'Article'} };
 }
 
+sub subscription_required {
+  my ($self) = @_;
+
+  my $id = $self->{subscription_required};
+  return if $id == -1;
+
+  require BSE::TB::Subscriptions;
+  return BSE::TB::Subscriptions->getByPkey($id);
+}
+
 1;
index 3a056fb..6173b10 100644 (file)
@@ -160,4 +160,19 @@ sub orders {
   return Orders->getBy(userId => $self->{userId});
 }
 
+# check if the user is subscribed to the given subscription
+sub subscribed_to {
+  my ($self, $sub) = @_;
+
+  return; # PH for now, not subscribed
+}
+
+# check if the user is subscribed to the given subscription, and allow
+# for the max_lapsed grace period
+sub subscribed_to_grace {
+  my ($self, $sub) = @_;
+
+  return; # PH for now, not subscribed
+}
+
 1;
index 052afdb..5cb8ac7 100644 (file)
@@ -99,7 +99,19 @@ sub perform {
   
   print STDERR "  > perform $func $args\n" if DEBUG > 1;
 
-  my $value = $self->low_perform($acts, $func, $args, $orig);
+  my $value;
+  eval {
+    $value = $self->low_perform($acts, $func, $args, $orig);
+  };
+
+  if ($@) {
+    my $msg = $@;
+    $msg =~ /^ENOIMPL\b/
+      and return $orig;
+    print STDERR "Eval error in cond: $msg\n";
+    $msg =~ s/([<>&])/"&#".ord($1).";"/ge;
+    return "<!-- ** $msg ** -->";
+  }
 
   unless (defined $value) {
     cluck "** undefined value returned by $func $args **";
index 3a4ca35..e4b7515 100755 (executable)
@@ -20,7 +20,6 @@ use BSE::Session;
 use BSE::Cfg;
 use BSE::Util::Tags qw(tag_hash);
 
-
 my $cfg = BSE::Cfg->new();
 
 my $subject = $cfg->entry('shop', 'subject', $SHOP_MAIL_SUBJECT);
@@ -49,13 +48,6 @@ my $toEmail= $cfg->entry('shop', 'to_email', $SHOP_TO_EMAIL);
 use constant PAYMENT_CC => 0;
 use constant PAYMENT_CHEQUE => 1;
 use constant PAYMENT_CALLME => 2;
-# my %valid_payment_types = 
-#   ( 
-#    PAYMENT_CC()     =>1, 
-#    PAYMENT_CHEQUE() =>1, 
-#    PAYMENT_CALLME() =>1
-#   );
-# my %payment_names = ;
 
 my $urlbase = $cfg->entryVar('site', 'url');
 my $securlbase = $cfg->entryVar('site', 'secureurl');
@@ -85,7 +77,7 @@ my %steps =
    recalc=>\&recalc,
    recalculate=>\&recalc,
    purchase=>\&purchase,
-   prePurchase=>\&prePurchase,
+   #prePurchase=>\&prePurchase,
   );
 
 for my $key (keys %steps) {
@@ -138,6 +130,28 @@ sub add_item {
   $today le $comp_expire
     or return show_cart("Product has expired");
   $product->{listed} or return show_cart("Product not available");
+  
+  my $user = get_siteuser(\%session, $cfg, $CGI::Q);
+  # need to be logged on if it has any subs
+  if ($product->{subscription_id} != -1 && !$user) {
+    refresh_logon("You must be logged on to add this product to your cart",
+                 'prodlogon');
+    return;
+  }
+  if ($product->{subscription_required} != -1) {
+    my $sub = $product->subscription_required;
+    if ($user) {
+      unless ($user->subscribed_to($sub)) {
+       show_cart("You must be subscribed to $sub->{title} to purchase this product");
+       return;
+      }
+    }
+    else {
+      refresh_logon("You must be logged on and subscribed to $sub->{title} to add this product to your cart",
+                   'prodlogonsub');
+      return;
+    }
+  }
 
   # we need a natural integer quantity
   $quantity =~ /^\d+$/
@@ -394,199 +408,197 @@ sub checkout_confirm {
 # processes the CC information and then displays the order complete
 # information
 # BUG!!: this duplicates the code in purchase() a great deal
-sub prePurchase {
-
-  my $cust_class = custom_class($cfg);
-  my @required = $cust_class->required_fields($CGI::Q, $session{custom}, $cfg);
-  for my $field (@required) {
-    defined(param($field)) && length(param($field))
-      or return checkout("Field $field is required", 1);
-  }
-  if (grep /email/, @required) {
-    defined(param('email')) && param('email') =~ /.\@./
-      or return checkout("Please enter a valid email address", 1);
-  }
+sub prePurchase {
+
+  my $cust_class = custom_class($cfg);
+  my @required = $cust_class->required_fields($CGI::Q, $session{custom}, $cfg);
+  for my $field (@required) {
+    defined(param($field)) && length(param($field))
+      or return checkout("Field $field is required", 1);
+  }
+  if (grep /email/, @required) {
+    defined(param('email')) && param('email') =~ /.\@./
+      or return checkout("Please enter a valid email address", 1);
+  }
   
-  use Orders;
-  use Order;
-  use OrderItems;
-  use OrderItem;
-
-  # map some form fields to order field names
-  my %field_map = 
-    (
-     name1 => 'delivFirstName',
-     name2 => 'delivLastName',
-     address => 'delivStreet',
-     city => 'delivSuburb',
-     postcode => 'delivPostCode',
-     state => 'delivState',
-     country => 'delivCountry',
-     email => 'emailAddress',
-     cardHolder => 'ccName',
-     cardType => 'ccType',
-    );
-  # paranoia, don't store these
-  my %nostore =
-    (
-     cardNumber => 1,
-     cardExpiry => 1,
-    );
-  my %order;
-  my @cart = @{$session{cart}};
-  @cart or return show_cart('You have no items in your shopping cart');
-
-  # so we can quickly check for columns
-  my @columns = Order->columns;
-  my %columns; 
-  @columns{@columns} = @columns;
-
-  for my $field (param()) {
-    $order{$field_map{$field} || $field} = param($field)
-      unless $nostore{$field};
-  }
-
-  my $ccNumber = param('cardNumber');
-  my $ccExpiry = param('cardExpiry');
-
-  use Digest::MD5 'md5_hex';
-  $ccNumber =~ tr/0-9//cd;
-  $order{ccNumberHash} = md5_hex($ccNumber);
-  $order{ccExpiryHash} = md5_hex($ccExpiry);
-
-  # work out totals
-  $order{total} = 0;
-  $order{gst} = 0;
-  $order{wholesale} = 0;
-  my @products;
-  my $today = epoch_to_sql(time);
-  for my $item (@cart) {
-    my $product = Products->getByPkey($item->{productId});
-    # double check that it's still a valid product
-    if (!$product) {
-      return show_cart("Product $item->{productId} not found");
-    }
-    else {
-      (my $comp_release = $product->{release}) =~ s/ .*//;
-      (my $comp_expire = $product->{expire}) =~ s/ .*//;
-      $comp_release le $today
-       or return show_cart("'$product->{title}' has not been released yet");
-      $today le $comp_expire
-       or return show_cart("'$product->{title}' has expired");
-      $product->{listed} 
-       or return show_cart("'$product->{title}' not available");
-    }
-    push(@products, $product); # used in page rendering
-    @$item{qw/price wholesalePrice gst/} = 
-      @$product{qw/retailPrice wholesalePrice gst/};
-    $order{total} += $item->{price} * $item->{units};
-    $order{wholesale} += $item->{wholesalePrice} * $item->{units};
-    $order{gst} += $item->{gst} * $item->{units};
-  }
-  use BSE::Util::SQL qw(now_sqldatetime);
-  $order{orderDate} = now_sqldatetime();
-
-  if (my ($msg, $id) = need_logon($cfg, \@cart, \@products, \%session, $CGI::Q)) {
-    refresh_logon($msg, $id);
-    return;
-  }
-
-  $order{total} += $cust_class->total_extras(\@cart, \@products, 
-                                            $session{custom}, $cfg, 'final');
-  ++$session{changed};
-  # blank anything else
-  for my $column (@columns) {
-    defined $order{$column} or $order{$column} = '';
-  }
-  # make sure the user can't set these behind our backs
-  $order{filled} = 0;
-  $order{paidFor} = 0;
+#   use BSE::TB::Orders;
+#   use BSE::TB::OrderItems;
+
+#   # map some form fields to order field names
+#   my %field_map = 
+#     (
+#      name1 => 'delivFirstName',
+#      name2 => 'delivLastName',
+#      address => 'delivStreet',
+#      city => 'delivSuburb',
+#      postcode => 'delivPostCode',
+#      state => 'delivState',
+#      country => 'delivCountry',
+#      email => 'emailAddress',
+#      cardHolder => 'ccName',
+#      cardType => 'ccType',
+#     );
+#   # paranoia, don't store these
+#   my %nostore =
+#     (
+#      cardNumber => 1,
+#      cardExpiry => 1,
+#     );
+#   my %order;
+#   my @cart = @{$session{cart}};
+#   @cart or return show_cart('You have no items in your shopping cart');
+
+#   # so we can quickly check for columns
+#   my @columns = BSE::TB::Order->columns;
+#   my %columns; 
+#   @columns{@columns} = @columns;
+
+#   for my $field (param()) {
+#     $order{$field_map{$field} || $field} = param($field)
+#       unless $nostore{$field};
+#   }
+
+#   my $ccNumber = param('cardNumber');
+#   my $ccExpiry = param('cardExpiry');
+
+#   use Digest::MD5 'md5_hex';
+#   $ccNumber =~ tr/0-9//cd;
+#   $order{ccNumberHash} = md5_hex($ccNumber);
+#   $order{ccExpiryHash} = md5_hex($ccExpiry);
+
+#   # work out totals
+#   $order{total} = 0;
+#   $order{gst} = 0;
+#   $order{wholesale} = 0;
+#   my @products;
+#   my $today = epoch_to_sql(time);
+#   for my $item (@cart) {
+#     my $product = Products->getByPkey($item->{productId});
+#     # double check that it's still a valid product
+#     if (!$product) {
+#       return show_cart("Product $item->{productId} not found");
+#     }
+#     else {
+#       (my $comp_release = $product->{release}) =~ s/ .*//;
+#       (my $comp_expire = $product->{expire}) =~ s/ .*//;
+#       $comp_release le $today
+#      or return show_cart("'$product->{title}' has not been released yet");
+#       $today le $comp_expire
+#      or return show_cart("'$product->{title}' has expired");
+#       $product->{listed} 
+#      or return show_cart("'$product->{title}' not available");
+#     }
+#     push(@products, $product); # used in page rendering
+#     @$item{qw/price wholesalePrice gst/} = 
+#       @$product{qw/retailPrice wholesalePrice gst/};
+#     $order{total} += $item->{price} * $item->{units};
+#     $order{wholesale} += $item->{wholesalePrice} * $item->{units};
+#     $order{gst} += $item->{gst} * $item->{units};
+#   }
+#   use BSE::Util::SQL qw(now_sqldatetime);
+#   $order{orderDate} = now_sqldatetime();
+
+#   if (my ($msg, $id) = need_logon($cfg, \@cart, \@products, \%session, $CGI::Q)) {
+#     refresh_logon($msg, $id);
+#     return;
+#   }
+
+#   $order{total} += $cust_class->total_extras(\@cart, \@products, 
+#                                           $session{custom}, $cfg, 'final');
+#   ++$session{changed};
+#   # blank anything else
+#   for my $column (@columns) {
+#     defined $order{$column} or $order{$column} = '';
+#   }
+#   # make sure the user can't set these behind our backs
+#   $order{filled} = 0;
+#   $order{paidFor} = 0;
   
-  # this should be hard to guess
-  $order{randomId} = md5_hex(time().rand().{}.$$);
-
-  # check if a customizer has anything to do
-  eval {
-    $cust_class->order_save($CGI::Q, \%order, \@cart, \@products, 
-                           $session{custom}, $cfg);
-    ++$session{changed};
-  };
-  if ($@) {
-    return checkout($@, 1);
-  }
-
-  # load up the database
-  my @data = @order{@columns};
-  shift @data; # lose the dummy id
-  my $order = Orders->add(@data)
-    or die "Cannot add order";
-  my @items;
-  my @item_cols = OrderItem->columns;
-  for my $row (@cart) {
-    $row->{orderId} = $order->{id};
-    my @data = @$row{@item_cols};
-    shift @data;
-    push(@items, OrderItems->add(@data));
-  }
-
-  my $item_index = -1;
-  my @options;
-  my $option_index;
-  my %acts;
-  %acts =
-    (
-     iterate_items_reset => sub { $item_index = -1; },
-     iterate_items => 
-     sub { 
-       if (++$item_index < @items) {
-        $option_index = -1;
-        @options = cart_item_opts($items[$item_index], 
-                                  $products[$item_index]);
-        return 1;
-       }
-       return 0;
-     },
-     item=> sub { CGI::escapeHTML($items[$item_index]{$_[0]}); },
-     product => 
-     sub { 
-       my $value = $products[$item_index]{$_[0]};
-       defined($value) or $value = '';
-       CGI::escapeHTML($value);
-     },
-     extended =>
-     sub { 
-       my $what = $_[0] || 'retailPrice';
-       $items[$item_index]{units} * $items[$item_index]{$what};
-     },
-     order => sub { CGI::escapeHTML($order->{$_[0]}) },
-     money =>
-     sub {
-       my ($func, $args) = split ' ', $_[0], 2;
-       $acts{$func} || return "<: money $_[0] :>";
-       return sprintf("%.02f", $acts{$func}->($args)/100);
-     },
-     old => sub { '' },
-     _format =>
-     sub {
-       my ($value, $fmt) = @_;
-       if ($fmt =~ /^m(\d+)/) {
-        return sprintf("%$1s", sprintf("%.2f", $value/100));
-       }
-       elsif ($fmt =~ /%/) {
-        return sprintf($fmt, $value);
-       }
-     },
-     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) },
-    );
-  # this should be reset once the order has been paid
-  $session{orderPayment} = $order->{id};
+  # this should be hard to guess
+  $order{randomId} = md5_hex(time().rand().{}.$$);
+
+  # check if a customizer has anything to do
+  eval {
+    $cust_class->order_save($CGI::Q, \%order, \@cart, \@products, 
+#                          $session{custom}, $cfg);
+    ++$session{changed};
+  };
+  if ($@) {
+    return checkout($@, 1);
+  }
+
+  # load up the database
+  my @data = @order{@columns};
+  shift @data; # lose the dummy id
+#   my $order = BSE::TB::Orders->add(@data)
+    or die "Cannot add order";
+  my @items;
+#   my @item_cols = BSE::TB::OrderItem->columns;
+  for my $row (@cart) {
+    $row->{orderId} = $order->{id};
+    my @data = @$row{@item_cols};
+    shift @data;
+#     push(@items, BSE::TB::OrderItems->add(@data));
+  }
+
+  my $item_index = -1;
+  my @options;
+  my $option_index;
+  my %acts;
+  %acts =
+    (
+     iterate_items_reset => sub { $item_index = -1; },
+     iterate_items => 
+     sub { 
+       if (++$item_index < @items) {
+#       $option_index = -1;
+#       @options = cart_item_opts($items[$item_index], 
+#                                 $products[$item_index]);
+#       return 1;
+       }
+       return 0;
+     },
+     item=> sub { CGI::escapeHTML($items[$item_index]{$_[0]}); },
+     product => 
+     sub { 
+       my $value = $products[$item_index]{$_[0]};
+       defined($value) or $value = '';
+       CGI::escapeHTML($value);
+     },
+     extended =>
+     sub { 
+       my $what = $_[0] || 'retailPrice';
+       $items[$item_index]{units} * $items[$item_index]{$what};
+     },
+     order => sub { CGI::escapeHTML($order->{$_[0]}) },
+     money =>
+     sub {
+       my ($func, $args) = split ' ', $_[0], 2;
+       $acts{$func} || return "<: money $_[0] :>";
+       return sprintf("%.02f", $acts{$func}->($args)/100);
+     },
+     old => sub { '' },
+     _format =>
+     sub {
+       my ($value, $fmt) = @_;
+       if ($fmt =~ /^m(\d+)/) {
+#       return sprintf("%$1s", sprintf("%.2f", $value/100));
+       }
+       elsif ($fmt =~ /%/) {
+#       return sprintf($fmt, $value);
+       }
+     },
+     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) },
+    );
+  # this should be reset once the order has been paid
+  $session{orderPayment} = $order->{id};
   
-  page('checkoutcard.tmpl', \%acts);
-}
+  page('checkoutcard.tmpl', \%acts);
+}
 
 sub tag_ifPayment {
   my ($payment, $types_by_name, $args) = @_;
@@ -617,8 +629,8 @@ sub purchase {
   my @pay_types = payment_types($cfg);
   my %pay_types = map { $_->{id} => $_ } @pay_types;
   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
-  use Data::Dumper;
-  print STDERR Dumper \%pay_types;
+  #use Data::Dumper;
+  #print STDERR Dumper \%pay_types;
   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
   if ($noencrypt) {
     @payment_types = grep $_ ne PAYMENT_CC, @payment_types;
@@ -649,10 +661,8 @@ sub purchase {
       or return checkout("Please enter a credit card number", 1);
   }
 
-  use Orders;
-  use Order;
-  use OrderItems;
-  use OrderItem;
+  use BSE::TB::Orders;
+  use BSE::TB::OrderItems;
 
   # map some form fields to order field names
   my %field_map = 
@@ -679,7 +689,7 @@ sub purchase {
   @cart or return show_cart('You have no items in your shopping cart');
 
   # so we can quickly check for columns
-  my @columns = Order->columns;
+  my @columns = BSE::TB::Order->columns;
   my %columns; 
   @columns{@columns} = @columns;
 
@@ -692,6 +702,8 @@ sub purchase {
   defined $ccNumber or $ccNumber = '';
   my $ccExpiry = param('cardExpiry');
   defined $ccExpiry or $ccExpiry = '';
+  $order{affiliate_code} = defined $session{affiliate_code} ?
+    $session{affiliate_code} : '';
 
   use Digest::MD5 'md5_hex';
   $ccNumber =~ tr/0-9//cd;
@@ -702,6 +714,7 @@ sub purchase {
   $order{total} = 0;
   $order{gst} = 0;
   $order{wholesale} = 0;
+  $order{shipping_cost} = 0;
   my @products;
   my $today = now_sqldate();
   for my $item (@cart) {
@@ -758,6 +771,7 @@ sub purchase {
   $order{randomId} = md5_hex(time().rand().{}.$$);
 
   # check if a customizer has anything to do
+  # if it sets shipping cost it must also update the total
   eval {
     my %custom = %{$session{custom}};
     $cust_class->order_save($CGI::Q, \%order, \@cart, \@products, 
@@ -771,18 +785,33 @@ sub purchase {
   $order{total} += $cust_class->total_extras(\@cart, \@products, 
                                             $session{custom}, $cfg, 'final');
 
+  my %subscribing_to;
+
   # load up the database
   my @data = @order{@columns};
   shift @data; # lose the dummy id
-  my $order = Orders->add(@data)
+  my $order = BSE::TB::Orders->add(@data)
     or die "Cannot add order";
   my @items;
-  my @item_cols = OrderItem->columns;
-  for my $row (@cart) {
+  my @item_cols = BSE::TB::OrderItem->columns;
+  my @prod_xfer = qw/title summary subscription_id subscription_period/;
+  for my $row_num (0..$#cart) {
+    my $row = $cart[$row_num];
+    my $product = $products[$row_num];
     $row->{orderId} = $order->{id};
+
+    # store product data too
+    @$row{@prod_xfer} = @{$product}{@prod_xfer};
+
     my @data = @$row{@item_cols};
+    
     shift @data;
-    push(@items, OrderItems->add(@data));
+    push(@items, BSE::TB::OrderItems->add(@data));
+
+#     my $sub = $product->subscription;
+#     if ($sub) {
+#       $subscribing_to{$sub->{text_id}} = $sub;
+#     }
   }
 
   my $item_index = -1;
@@ -834,23 +863,32 @@ sub purchase {
      ifOptions => sub { @options },
      options => sub { nice_options(@options) },
      ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
+     #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
     );
   for my $type (@pay_types) {
     my $id = $type->{id};
     my $name = $type->{name};
     $acts{"if${name}Payment"} = $order->{paymentType} == $id;
   }
-  send_order($order, \@items, \@products, $noencrypt);
+  send_order($order, \@items, \@products, $noencrypt, \%subscribing_to);
   $session{cart} = []; # empty the cart
   page('checkoutfinal.tmpl', \%acts);
 }
 
+# sub tag_ifSubscribingTo {
+#   my ($subscribing_to, $args) = @_;
+
+#   exists $subscribing_to->{$args};
+# }
+
 sub tag_with_wrap {
   my ($args, $text) = @_;
 
   my $margin = $args =~ /^\d+$/ && $args > 30 ? $args : 70;
 
   require Text::Wrap;
+  # do it twice to prevent a warning
+  $Text::Wrap::columns = $margin;
   $Text::Wrap::columns = $margin;
 
   return Text::Wrap::fill('', '', split /\n/, $text);
@@ -859,7 +897,7 @@ sub tag_with_wrap {
 # sends the email order confirmation and the PGP encrypted
 # email to the site owner
 sub send_order {
-  my ($order, $items, $products, $noencrypt) = @_;
+  my ($order, $items, $products, $noencrypt, $subscribing_to) = @_;
 
   my %extras = $cfg->entriesCS('extra tags');
   for my $key (keys %extras) {
@@ -924,6 +962,7 @@ sub send_order {
      ifOptions => sub { @options },
      options => sub { nice_options(@options) },
      with_wrap => \&tag_with_wrap,
+     ifSubscribingTo => [ \&tag_ifSubscribingTo, $subscribing_to ],
     );
 
   my $mailer = BSE::Mail->new(cfg=>$cfg);
index 068fe96..4af3528 100644 (file)
@@ -10,6 +10,78 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.14_24
+
+This release includes some structural changes to article editing,
+please test before deploying it.
+
+=over
+
+=item *
+
+doing a sort of all children wouldn't include the unreleased
+(step)childen in the sort (#389)
+
+=item *
+
+with access control enabled, using the reorder.pl script while not
+logged (including due to a cookie timeout) on would produce a server
+error (#419)
+
+=item *
+
+the Orders / Order / OrderItems / OrderItem classes are now
+BSE::TB::Orders / BSE::TB::Order / BSE::TB::OrderItems /
+BSE::TB::OrderItem, to try to use a more consistent naming system and
+clean up the top level namespace
+
+=item *
+
+the prePurchase target has been disabled in shop.pl, since it's
+effectively unmaintained, and probably completely broken
+
+=item *
+
+updated the document list of session values in BSE::Session.
+
+=item *
+
+defaults (both internal and configured) are now used to set
+article/product fields on creation, this should allow simplified
+creation templates to omit fields that don't need to be explicitly set
+
+=item *
+
+the warning about $Text::Wrap::columns only appearing once should
+disappear
+
+=item *
+
+a shipping_cost column has been added to the order table.  This is not
+set by BSE at all yet, but is available for use by custom order save
+code.
+
+=item *
+
+some fields and code have been added to support subscriptions (no, not
+the newsletter stuff)
+
+=item *
+
+removed some debug dump code from the shop
+
+=item *
+
+"link title" links now include ".html" at the end to allow Google to
+index them
+
+=item *
+
+some preperatory work has been done to handle affiliates and
+subscriptions
+
+=back
+
 =head2 0.14_23
 
 =over
@@ -56,7 +128,7 @@ basic help icon.
 =item *
 
 remove blank lines from the error messages produced on the admin user
-administration pages
+administration pages (#382)
 
 =item *
 
index 483aea1..de86c1c 100644 (file)
@@ -18,3 +18,4 @@ th {  font-size: 10px; font-weight: bold; background-color: #999999; color: #FFF
 .table {  background-color: #666666}
 h3 {  font-size: 14px}
 h4 {  font-size: 12px}
+.version { font-size: 10px }
\ No newline at end of file
index 93ad93e..dc7798b 100644 (file)
             </td>
             <td nowrap bgcolor="#FFFFFF" valign="top"><:help product thumb:></td>
           </tr>
+          <tr> 
+            <th nowrap align="left" bgcolor="#FFFFFF">Purchase subscribes to:</th>
+            <td nowrap bgcolor="#FFFFFF"> 
+             <select name="subscription_id">
+                <option value="-1">(nothing)</option>
+<:iterator begin subscriptions:>
+                <option value="<:subscription subscription_id:>"><:subscription title:></option>
+<:iterator end subscriptions:>
+             </select> for <input type="text" name="subscription_period" value="<:old subscription_period" /><:error_img subscription_period:> months.
+            </td>
+            <td nowrap bgcolor="#FFFFFF"><:help product subscription_id:></td>
+          </tr>
         </table>
       </td>
     </tr>
index f199261..4002ffb 100644 (file)
@@ -4,5 +4,6 @@
 </head>
 <body>
 <:wrap here:>
-<p><font size="-1">BSE Release <:release:> - page generated <:today:></font></p>
+<hr />
+<p class="version">BSE Release <:release:> - page generated <:today:></p>
 </body></html>
index 44b2a27..479fdfb 100644 (file)
             images:></td>
           </tr>
                  <:or Article:><:eif Article:>
+          <!-- tr> 
+            <th nowrap align="left" bgcolor="#FFFFFF">Purchase subscribes to:</th>
+            <td nowrap bgcolor="#FFFFFF"> 
+             <select name="subscription_id">
+                <option value="-1"<:ifEq [old subscription_id] "-1":> selected="selected"<:or:><:eif:>>(nothing)</option>
+<:iterator begin subscriptions:>
+                <option value="<:subscription subscription_id:>"<:ifEq [old subscription_id] [subscription subscription_id]:> selected="selected"<:or:><:eif:>><:subscription title:></option>
+<:iterator end subscriptions:>
+             </select> for <input type="text" name="subscription_period" value="<:old subscription_period:>" size="3" /><:error_img subscription_period:> months.
+            </td>
+            <td nowrap bgcolor="#FFFFFF"><:help product subscription_id:></td>
+          </tr>
+          <tr> 
+            <th nowrap align="left" bgcolor="#FFFFFF">Can be used to:</th>
+            <td nowrap bgcolor="#FFFFFF"> 
+             <select name="subscription_usage">
+                <option value="3"<:ifEq [old subscription_usage] "3":> selected="selected"<:or:><:eif:>>Start or renew a subscription</option>
+                <option value="1"<:ifEq [old subscription_usage] "1":> selected="selected"<:or:><:eif:>>Start a subscription only</option>
+                <option value="2"<:ifEq [old subscription_usage] "2":> selected="selected"<:or:><:eif:>>Renew a subscription only</option>
+             </select>
+            </td>
+            <td nowrap bgcolor="#FFFFFF"><:help product subscription_usage:></td>
+          </tr>
+          <tr> 
+            <th nowrap align="left" bgcolor="#FFFFFF">User must be subscribed to:</th>
+            <td nowrap bgcolor="#FFFFFF"> 
+             <select name="subscription_required">
+                <option value="-1"<:ifEq [old subscription_required] "-1":> selected="selected"<:or:><:eif:>>(nothing)</option>
+<:iterator begin subscriptions:>
+                <option value="<:subscription subscription_id:>"<:ifEq [old subscription_required] [subscription subscription_id]:> selected="selected"<:or:><:eif:>><:subscription title:></option>
+<:iterator end subscriptions:>
+             </select> to purchase this product
+            </td>
+            <td nowrap bgcolor="#FFFFFF"><:help product subscription_id:></td>
+          </tr -->
         </table>
       </td>
     </tr>
index 8f96f04..9188c70 100644 (file)
@@ -51,7 +51,9 @@ section</a></li>
 <ul><li><a href="/cgi-bin/admin/userlist.pl">Download member list</a></li></ul>
 <p>&nbsp;</p>
 
-<p><a href="/cgi-bin/admin/subs.pl">Subscriptions administration</a></p>
+<p><a href="/cgi-bin/admin/subs.pl">Newsletters administration</a></p>
+
+<p><a href="/cgi-bin/admin/subadmin.pl">Subscriptions administration</a></p>
   </td>
   <td bgcolor="#FFFFFF">
 <:ifUserCan regen_all:>
diff --git a/site/templates/admin/subscr/add.tmpl b/site/templates/admin/subscr/add.tmpl
new file mode 100644 (file)
index 0000000..eb2be87
--- /dev/null
@@ -0,0 +1,37 @@
+<:wrap admin/xbase.tmpl title=>"Add Subscription":>
+<h1>Add Subscription</h1>
+<p>
+| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> |
+<:if UserCan bse_subs_list :>
+<a href="<:script:>?a_list=1">List Subscriptions</a> |<:or UserCan:><:eif UserCan:>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:> 
+
+<form action="<:script:>" method="post" name="addsub">
+<table>
+<tr>
+  <th>Identifier:</th>
+  <td><input type="text" name="text_id" value="<:old text_id:>" /></td>
+  <td><:error_img text_id:><:help addsubscr text_id:></td>
+</tr>
+<tr>
+  <th>Title:</th>
+  <td><input type="text" name="title" value="<:old title:>" /></td>
+  <td><:error_img title:><:help addsubscr title:></td>
+</tr>
+<tr>
+  <th>Description:</th>
+  <td><input type="text" name="description" value="<:old description:>" /></td>
+  <td><:error_img description:><:help addsubscr description:></td>
+</tr>
+<tr>
+  <th>Max Lapsed:</th>
+  <td><input type="text" name="max_lapsed" value="<:old max_lapsed:>" /></td>
+  <td><:error_img max_lapsed:><:help addsubscr max_lapsed:></td>
+</tr>
+<tr>
+  <td colspan="2"><input type="submit" name="a_add" value="Add Subscription" /></td>
+  <td>&nbsp;</td>
+</table>
+</form>
\ No newline at end of file
diff --git a/site/templates/admin/subscr/edit.tmpl b/site/templates/admin/subscr/edit.tmpl
new file mode 100644 (file)
index 0000000..f73b5b2
--- /dev/null
@@ -0,0 +1,38 @@
+<:wrap admin/xbase.tmpl title=>"Edit Subscription":>
+<h1>Edit Subscription</h1>
+<p>
+| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> |
+<:if UserCan bse_subs_list :>
+<a href="<:script:>?a_list=1">List Subscriptions</a> |<:or UserCan:><:eif UserCan:>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:> 
+
+<form action="<:script:>" method="post" name="editsub">
+<input type="hidden" name="subscription_id" value="<:subscription subscription_id:>" />
+<table>
+<tr>
+  <th>Identifier:</th>
+  <td><input type="text" name="text_id" value="<:old text_id subscription text_id:>" /></td>
+  <td><:error_img text_id:><:help addsubscr text_id:></td>
+</tr>
+<tr>
+  <th>Title:</th>
+  <td><input type="text" name="title" value="<:old title subscription title:>" /></td>
+  <td><:error_img title:><:help addsubscr title:></td>
+</tr>
+<tr>
+  <th>Description:</th>
+  <td><input type="text" name="description" value="<:old description subscription description:>" /></td>
+  <td><:error_img description:><:help addsubscr description:></td>
+</tr>
+<tr>
+  <th>Max Lapsed:</th>
+  <td><input type="text" name="max_lapsed" value="<:old max_lapsed subscription max_lapsed:>" /></td>
+  <td><:error_img max_lapsed:><:help addsubscr max_lapsed:></td>
+</tr>
+<tr>
+  <td colspan="2"><input type="submit" name="a_save" value="Save Subscription" /></td>
+  <td>&nbsp;</td>
+</table>
+</form>
\ No newline at end of file
diff --git a/site/templates/admin/subscr/list.tmpl b/site/templates/admin/subscr/list.tmpl
new file mode 100644 (file)
index 0000000..6a68116
--- /dev/null
@@ -0,0 +1,51 @@
+<:wrap admin/xbase.tmpl title=>"Admin Subscriptions":>
+<h1>Admin Subscriptions</h1>
+<p>
+| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> |
+<:if UserCan bse_subs_add :>
+<a href="<:script:>?a_addform=1">Add Subscription</a> |<:or UserCan:><:eif UserCan:>
+<:ifMessage:>
+<p><b><:message:></b></p>
+<:or:><:eif:> 
+
+<p>This is for managing periodic subscriptions that a member can buy.
+It has nothing to do with the <a
+href="/cgi-bin/admin/subs.pl">newsletters system.</a></p>
+
+<p>Page <:subscriptions_pagenum:> of <:subscriptions_pagecount:>
+<:ifFirstSubscriptionsPage:>&lt;&lt;&lt;&lt; &lt;&lt;<:or:><a href="<:script:>?s=<:sortby:>&r=<:reverse:>&p=1&pp=<:subscriptions_perpage:>">&lt;&lt;&lt;&lt;</a> <a href="<:script:>?s=<:sortby:>&r=<:reverse:>&p=<:prevSubscriptionsPage:>&pp=<:subscriptions_perpage:>">&lt;&lt;</a><:eif:>
+<:iterator begin repeats [subscriptions_pagecount]:>
+<:if Eq [repeat value] [subscriptions_pagenum]:><:repeat value:><:or Eq:><a href="<:script:>?s=<:sortby:>&r=<:reverse:>&p=<:repeat value:>&pp=<:subscriptions_perpage:>"><:repeat value:></a><:eif Eq:>
+<:iterator end repeats:>
+<:ifLastSubscriptionsPage:>&gt;&gt; &gt;&gt;&gt;&gt;<:or:><a href="<:script:>?s=<:sortby:>&r=<:reverse:>&p=<:nextSubscriptionsPage:>&pp=<:subscriptions_perpage:>">&gt;&gt;</a> <a href="<:script:>?s=<:sortby:>&r=<:reverse:>&p=<:subscriptions_pagecount:>&pp=<:subscriptions_perpage:>">&gt;&gt;&gt;&gt;</a><:eif:>
+</p>
+<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" nowrap> <a href="<:script:>?<:sorthelp text_id:>&p=<:subscriptions_pagenum:>&pp=<:subscriptions_perpage:>">Id</a></th>
+            <th bgcolor="#FFFFFF" nowrap> <a href="<:script:>?<:sorthelp title:>&p=<:subscriptions_pagenum:>&pp=<:subscriptions_perpage:>">Title</a></th>
+            <th bgcolor="#FFFFFF" nowrap> <a href="<:script:>?<:sorthelp description:>&p=<:subscriptions_pagenum:>&pp=<:subscriptions_perpage:>">Description</a></th>
+            <th bgcolor="#FFFFFF" nowrap> <a href="<:script:>?<:sorthelp max_lapsed:>&p=<:subscriptions_pagenum:>&pp=<:subscriptions_perpage:>">Max Lapse</a></th>
+          </tr>
+          <:if Subscriptions:> <: iterator begin subscriptions :> 
+          <tr bgcolor="#FFFFFF"> 
+            <td nowrap> <a href="<:script:>?a_edit=1&subscription_id=<:isubscription subscription_id:>"><:isubscription text_id:></a></td>
+            <td valign="top"><:isubscription title:></td>
+            <td valign="top"><:isubscription description:></td>
+            <td valign="top"><:isubscription max_lapsed:></td>
+          </tr>
+          <: iterator end subscriptions :> 
+          <:or Subscriptions:> 
+          <tr bgcolor="#FFFFFF"> 
+            <td colspan="4" align="center">Your system has no subscriptions.</td>
+          </tr>
+          <:eif Subscriptions:> 
+        </table>
+</td>
+</tr>
+</table>
+</form>
+
index ef46d7e..7f531e3 100644 (file)
@@ -6,5 +6,6 @@
 </head>
 <body>
 <:wrap here:>
-<p><font size="-1">BSE Release <:release:> - page generated <:today:></font></p>
+<hr />
+<p class="version">BSE Release <:release:> - page generated <:today:></p>
 </body></html>
index af9d006..8da0fee 100644 (file)
--- a/test.cfg
+++ b/test.cfg
@@ -79,4 +79,4 @@ subscriptions.text_link_list=[$3] '$1'$n   => $2
 
 #paths.local_templates=/home/tony/dev/bse/base/altadmin/
 
-site.secureadmin=1
+site.secureadmin=0