0.14_30 commit r0_14_30
authorTony Cook <tony@develop-help.com>
Fri, 3 Sep 2004 05:24:36 +0000 (05:24 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Fri, 3 Sep 2004 05:24:36 +0000 (05:24 +0000)
25 files changed:
MANIFEST
Makefile
schema/bse.sql
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Shop/Util.pm
site/cgi-bin/modules/BSE/TB/OrderItem.pm
site/cgi-bin/modules/BSE/TB/Subscription.pm
site/cgi-bin/modules/BSE/TB/Subscription/Calc.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Subscriptions.pm
site/cgi-bin/modules/BSE/UI/SubAdmin.pm
site/cgi-bin/modules/BSE/Util/SQL.pm
site/cgi-bin/modules/DevHelp/Tags/Iterate.pm
site/cgi-bin/modules/OrderItem.pm
site/cgi-bin/modules/Product.pm
site/cgi-bin/modules/SiteUser.pm
site/cgi-bin/modules/SiteUsers.pm
site/cgi-bin/modules/Squirrel/Row.pm
site/cgi-bin/modules/Squirrel/Template.pm
site/cgi-bin/shop.pl
site/docs/bse.pod
site/docs/config.pod
site/templates/admin/subscr/detail.tmpl
site/templates/admin/subscr/list.tmpl
t/t070sqldates.t [new file with mode: 0644]
t/t50subscalc.t [new file with mode: 0644]

index 2552aac..6840c21 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -93,6 +93,7 @@ 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/Subscription/Calc.pm
 site/cgi-bin/modules/BSE/TB/Subscriptions.pm
 site/cgi-bin/modules/BSE/Template.pm
 site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
@@ -373,10 +374,12 @@ t/t00smoke.t      makes a request to most of the scripts
 t/t010template.t       Tests Squirrel::Template
 t/t050format.t DevHelp::Formatter tests
 t/t060parms.t
+t/t070sqldates.t       Test SQL date tools
 t/t10edit.t
 t/t20gen.t
 t/t30rules.t   Check for use strict and warnings
 t/t40images.t  Tests image management
+t/t50subscalc.t        Test subscriptions calculations
 t/templates/included.include   Used by t010template.t
 t/templates/wraptest.tmpl      Used by t010template.t
 test.cfg.base
index 5ae3353..7836792 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.14_29
+VERSION=0.14_30
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index ec91568..4ce6877 100644 (file)
@@ -281,6 +281,9 @@ create table order_item (
   subscription_id integer not null default -1,
   subscription_period integer not null default 0,
 
+  -- transferred from the subscription
+  max_lapsed integer not null default 0,
+
   primary key (id),
   index order_item_order(orderId, id)
 );
@@ -596,29 +599,30 @@ create table admin_perms (
 );
 
 -- -- these are "product" subscriptions
--- drop table if exists bse_subscriptions;
--- create table bse_subscriptions (
---   subscription_id integer not null auto_increment primary key,
+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,
+  text_id varchar(20) not null,
 
---   title varchar(255) not null,
+  title varchar(255) not null,
 
---   description text not null,
+  description text not null,
 
---   max_lapsed integer not null,
+  max_lapsed integer not null,
 
---   unique (text_id)
--- );
+  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)
--- );
+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,
+  max_lapsed integer not null,
+  primary key (subscription_id, siteuser_id)
+);
 
 drop table if exists bse_siteuser_images;
 create table bse_siteuser_images (
index 9ef5ccd..3162175 100644 (file)
@@ -82,7 +82,7 @@ SQL
    getOrderItemByOrderId => 'select * from order_item where orderId = ?',
    addOrder => 'insert orders values(null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
    replaceOrder => 'replace orders values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
-   addOrderItem => 'insert order_item values(null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+   addOrderItem => 'insert order_item values(null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
    getOrderByUserId => 'select * from orders where userId = ?',
 
    getOrderItemByProductId => 'select * from order_item where productId = ?',
@@ -135,6 +135,12 @@ select si.* from site_users si, subscribed_users su
   where confirmed <> 0 and disabled = 0 and si.id = su.userId and su.subId = ?
 EOS
    SiteUsers => 'select * from site_users',
+   'SiteUsers.allSubscribers' => <<SQL,
+select distinct su.* 
+  from site_users su, orders od, order_item oi
+  where su.id = od.siteuser_id and od.id = oi.orderId 
+        and oi.subscription_id <> -1
+SQL
    getBSESiteuserImage => <<SQL,
 select * from bse_siteuser_images
   where siteuser_id = ? and image_id = ?
@@ -300,10 +306,31 @@ select od.id, od.userId, od.orderDate, od.siteuser_id,
   where oi.subscription_id = ? and od.id = oi.orderId
   group by od.id, od.userId, od.orderDate, od.siteuser_id
   order by od.orderDate desc
+SQL
+   subscriptionUserSummary => <<SQL,
+select su.*, us.*
+  from site_users su, bse_user_subscribed us
+where su.id = us.siteuser_id and us.subscription_id = ?
 SQL
    subscriptionProductCount => <<SQL,
 select count(*) as "count" from product 
   where subscription_id = ? or subscription_required = ?
+SQL
+   removeUserSubscribed => <<SQL,
+delete from bse_user_subscribed where subscription_id = ? and siteuser_id = ?
+SQL
+   addUserSubscribed => <<SQL,
+insert bse_user_subscribed values (?,?,?,?,?)
+SQL
+   subscriptionUserBought => <<SQL,
+select od.orderDate, oi.subscription_period, oi.max_lapsed, 
+  od.id as "order_id", oi.id as "item_id", oi.productId as "product_id"
+  from orders od, order_item oi
+  where oi.subscription_id = ? and od.id = oi.orderId and od.siteuser_id = ?
+SQL
+   userSubscribedEntry => <<SQL,
+select * from bse_user_subscribed 
+  where siteuser_id = ? and subscription_id = ?
 SQL
   );
 
index 097fa20..027670d 100644 (file)
@@ -309,13 +309,13 @@ sub need_logon {
       }
 
       $sub = $prod->subscription;
-      if ($sub && $sub->renew_only) {
-       unless ($user->is_subscribed_grace) {
+      if ($sub && $prod->is_renew_sub_only) {
+       unless ($user->is_subscribed_grace($sub)) {
          return ("you must be subscribed to $sub->{title} to use this renew only product", "sub/renewsubonly");
        }
       }
-      if ($sub && $sub->new_only) {
-       if ($user->is_subscribed_grace) {
+      if ($sub && $prod->is_start_sub_only) {
+       if ($user->is_subscribed_grace($sub)) {
          return ("you must not be subscribed to $sub->{title} already to use this new subscription only product", "sub/newsubonly");
        }
       }
index 297a2e2..0077f0c 100644 (file)
@@ -8,7 +8,7 @@ use vars qw/@ISA/;
 sub columns {
   return qw/id productId orderId units price wholesalePrice gst options
             customInt1 customInt2 customInt3 customStr1 customStr2 customStr3
-            title summary subscription_id subscription_period/;
+            title summary subscription_id subscription_period max_lapsed/;
 }
 
 1;
index 1cbca1d..3bab531 100644 (file)
@@ -93,4 +93,46 @@ sub order_summary {
   BSE::DB->query(subscriptionOrderSummary=>$self->{subscription_id});
 }
 
+sub subscribed_user_summary {
+  my ($self) = @_;
+
+  BSE::DB->query(subscriptionUserSummary => $self->{subscription_id});
+}
+
+my @expiry_cols = qw(subscription_id siteuser_id started_at ends_at);
+
+sub update_user_expiry {
+  my ($self, $user, $cfg) = @_;
+
+  my $debug = $cfg->entry('debug', 'subscription_expiry', 0);
+
+  # gather the orders/items this user has bought for this sub
+  my @sub_info = sort { $a->{orderDate} cmp $b->{orderDate} }
+    BSE::DB->query(subscriptionUserBought => 
+                  $self->{subscription_id}, $user->{id});
+
+  if (@sub_info) {
+    require BSE::TB::Subscription::Calc;
+
+    my @periods = BSE::TB::Subscription::Calc->calculate_period
+      ($debug, @sub_info);
+
+    my $period = $periods[-1];
+
+    # remove the old one
+    BSE::DB->run(removeUserSubscribed => $self->{subscription_id}, 
+                $user->{id});
+
+    # put it back
+    BSE::DB->run(addUserSubscribed =>  $self->{subscription_id}, 
+                $user->{id}, $period->{start}, $period->{end},
+                $period->{max_lapsed});
+  }
+  else {
+    # user not subscribed in any way
+    BSE::DB->run(removeUserSubscribed => $self->{subscription_id}, 
+                $user->{id});
+  }
+}
+
 1;
diff --git a/site/cgi-bin/modules/BSE/TB/Subscription/Calc.pm b/site/cgi-bin/modules/BSE/TB/Subscription/Calc.pm
new file mode 100644 (file)
index 0000000..b4ed516
--- /dev/null
@@ -0,0 +1,55 @@
+package BSE::TB::Subscription::Calc;
+use strict;
+use BSE::Util::SQL qw(:datemath);
+
+# this code is here to allow testing of it without having real data
+# in the database.
+
+sub calculate_period {
+  my ($class, $debug, @sub_info) = @_;
+  
+  my $start = sql_normal_date($sub_info[0]{orderDate});
+  my $duration = 0;
+  my $max_lapsed = 0;
+  my $end = $start;
+  
+  my @periods = (
+                {
+                 start => $start,
+                 duration => 0,
+                 end => $end,
+                 order_ids => [],
+                 product_ids => [],
+                 item_ids => [],
+                 max_lapsed => 0,
+                }
+               );
+  
+  for my $entry (@sub_info) {
+    my $grace_end = sql_add_date_days($end, $max_lapsed);
+    
+    my $order_date = sql_normal_date($entry->{orderDate});
+    if ($grace_end ge $order_date) {
+      # extend the existing period
+      $duration += $entry->{subscription_period};
+    }
+    else {
+      # starting a new period
+      $start = $order_date;
+      $duration = $entry->{subscription_period};
+      push @periods, { start => $start, duration => 0 };
+    }
+    $max_lapsed = $entry->{max_lapsed};
+    $end = sql_add_date_months($start, $duration);
+    $periods[-1]{duration} = $duration;
+    $periods[-1]{end} = $end;
+    $periods[-1]{max_lapsed} = $max_lapsed;
+    push @{$periods[-1]{order_ids}}, $entry->{order_id};
+    push @{$periods[-1]{product_ids}}, $entry->{product_id};
+    push @{$periods[-1]{item_ids}}, $entry->{item_id};
+  }
+
+  return @periods;
+}
+
+1;
index 68eaaad..5f57442 100644 (file)
@@ -9,4 +9,21 @@ sub rowClass {
   return 'BSE::TB::Subscription';
 }
 
+sub calculate_all_expiries {
+  my ($class, $cfg) = @_;
+
+  require SiteUsers;
+  
+  # get a list of all siteusers that have made an order with a subscription
+  my @users = SiteUsers->all_subscribers;
+
+  my @subs = $class->all;
+
+  for my $user (@users) {
+    for my $sub (@subs) {
+      $sub->update_user_expiry($user, $cfg);
+    }
+  }
+}
+
 1;
index 96ad1bb..272ed5c 100644 (file)
@@ -18,6 +18,7 @@ my %rights =
    save => 'bse_subs_edit',
    detail => 'bse_subs_detail',
    remove => 'bse_subs_delete',
+   update => 'bse_subs_update',
   );
 
 sub actions { \%rights }
@@ -207,6 +208,16 @@ sub req_detail {
   return $req->dyn_response('admin/subscr/detail', \%acts);
 }
 
+sub req_update {
+  my ($class, $req) = @_;
+
+  BSE::TB::Subscriptions->calculate_all_expiries($req->cfg);
+
+  my $r = $class->_list_refresh($req, "User subscription expiry dates updated");
+
+  return BSE::Template->get_refresh($r, $req->cfg);
+}
+
 sub iter_products {
   my ($sub) = @_;
 
@@ -220,7 +231,9 @@ sub iter_orders {
 }
 
 sub iter_users {
-  return;
+  my ($sub) = @_;
+
+  $sub->subscribed_user_summary;
 }
 
 sub req_remove {
@@ -266,7 +279,7 @@ sub _list_refresh {
   if ($msg) {
     my $sep = $r =~ /\?/ ? '&' : '?';
 
-    $r .= $sep . escape_uri($msg);
+    $r .= $sep . "m=" . escape_uri($msg);
   }
 
   return $r;
index 8a71bd2..07c0730 100644 (file)
@@ -1,11 +1,19 @@
 package BSE::Util::SQL;
 use strict;
-use vars qw(@EXPORT_OK @ISA);
+use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS);
 require 'Exporter.pm';
 @EXPORT_OK = qw/now_datetime sql_datetime date_to_sql sql_to_date sql_date 
-                now_sqldate now_sqldatetime sql_datetime_to_epoch/;
+                now_sqldate now_sqldatetime sql_datetime_to_epoch
+                sql_normal_date sql_add_date_days sql_add_date_months/;
+%EXPORT_TAGS = 
+  (
+   datemath => [ qw/sql_normal_date sql_add_date_days sql_add_date_months/ ],
+   all => \@EXPORT_OK,
+  );
 @ISA = qw/Exporter/;
 
+use constant SECONDS_PER_DAY => 86400;
+
 =head1 NAME
 
   BSE::Util::SQL - very basic tools for working with databases.
@@ -78,4 +86,61 @@ sub sql_datetime_to_epoch {
   return mktime($sec, $min, $hour, $day, $month-1, $year-1900);
 }
 
+sub sql_normal_date {
+  my ($sqldate) = @_;
+
+  return unless $sqldate =~ /^(\d+)\D+(\d+)\D+(\d+)/;
+
+  return sprintf("%04d-%02d-%02d", $1, $2, $3);
+}
+
+sub sql_add_date_days {
+  my ($sqldate, $days) = @_;
+
+  $sqldate = sql_normal_date($sqldate)
+    or return;
+
+  my $epoch = sql_datetime_to_epoch("$sqldate 12:00:00");
+  $epoch += $days * SECONDS_PER_DAY;
+  return strftime("%Y-%m-%d", localtime $epoch);
+}
+
+my @leap_days_per_month =
+  qw(31 29 31
+     30 31 30
+     31 31 30
+     31 30 31);
+
+my @noleap_days_per_month =
+  qw(31 28 31
+     30 31 30
+     31 31 30
+     31 30 31);
+
+sub sql_add_date_months {
+  my ($sqldate, $months) = @_;
+
+  my ($year, $month, $day) = $sqldate =~ /^(\d+)\D+(\d+)\D+(\d+)/
+    or return;
+
+  my $years = int($months / 12);
+  $months -= 12 * $years;
+
+  $year += $years;
+  $month += $months;
+  if ($month > 12) {
+    ++$year;
+    $month -= 12;
+  }
+
+  # make sure the dom is still within the month
+  my $leap = $year % 4 == 0 && $year % 100 != 0;
+  my $days_per_month = $leap ? \@leap_days_per_month : \@noleap_days_per_month;
+
+  my $days_in_month = $days_per_month->[$month-1];
+  $day > $days_in_month and $day = $days_in_month;
+
+  return sprintf("%04d-%02d-%02d", $year, $month, $day);
+}
+
 1;
index dbae778..912a11d 100644 (file)
@@ -36,7 +36,12 @@ sub _iter_item {
 
   $$rindex >= 0 && $$rindex < @$rdata
     or return "** $single should only be used inside iterator $plural **";
-  return $self->escape($rdata->[$$rindex]{$args});
+
+  my $value = $rdata->[$$rindex]{$args};
+
+  defined $value or return '';
+
+  return $self->escape($value);
 }
 
 sub _iter_number_paged {
@@ -240,7 +245,7 @@ sub make_iterator {
      "iterate_${plural}_reset" => 
      [ _iter_reset=>$self, $rdata, $rindex, $code, \$loaded, $nocache, $rstore ],
      "iterate_${plural}" =>
-     [ _iter_iterate=>$self, $rdata, $rindex, $nocache, $rstore ],
+     [ _iter_iterate=>$self, $rdata, $rindex, $rstore ],
      $single => 
      [ _iter_item=>$self, $rdata, $rindex, $single, $plural ],
      "${single}_index" => [ _iter_index=>$self, $rindex ],
index 297a2e2..0077f0c 100644 (file)
@@ -8,7 +8,7 @@ use vars qw/@ISA/;
 sub columns {
   return qw/id productId orderId units price wholesalePrice gst options
             customInt1 customInt2 customInt3 customStr1 customStr2 customStr3
-            title summary subscription_id subscription_period/;
+            title summary subscription_id subscription_period max_lapsed/;
 }
 
 1;
index 7ead46c..67c2588 100644 (file)
@@ -5,6 +5,11 @@ use Article;
 use vars qw/@ISA/;
 @ISA = qw/Article/;
 
+# subscription_usage values
+use constant SUBUSAGE_START_ONLY => 1;
+use constant SUBUSAGE_RENEW_ONLY => 2;
+use constant SUBUSAGE_EITHER => 3;
+
 sub columns {
   return ($_[0]->SUPER::columns(), 
          qw/articleId summary leadTime retailPrice wholesalePrice gst options
@@ -36,4 +41,16 @@ sub subscription {
   return BSE::TB::Subscriptions->getByPkey($id);
 }
 
+sub is_renew_sub_only {
+  my ($self) = @_;
+
+  $self->{subscription_usage} == SUBUSAGE_RENEW_ONLY;
+}
+
+sub is_start_sub_only {
+  my ($self) = @_;
+
+  $self->{subscription_usage} == SUBUSAGE_START_ONLY;
+}
+
 1;
index 06affde..1ba3cb3 100644 (file)
@@ -5,7 +5,7 @@ use Squirrel::Row;
 use vars qw/@ISA/;
 @ISA = qw/Squirrel::Row/;
 use Constants qw($SHOP_FROM);
-use BSE::Util::SQL qw/now_datetime/;
+use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date/;
 
 use constant MAX_UNACKED_CONF_MSGS => 3;
 use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
@@ -163,11 +163,26 @@ sub orders {
   return BSE::TB::Orders->getBy(userId => $self->{userId});
 }
 
+sub _user_sub_entry {
+  my ($self, $sub) = @_;
+
+  my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id}, 
+                              $sub->{subscription_id})
+    or return;
+
+  return $entry;
+}
+
 # check if the user is subscribed to the given subscription
 sub subscribed_to {
   my ($self, $sub) = @_;
 
-  return; # PH for now, not subscribed
+  my $entry = $self->_user_sub_entry($sub)
+    or return;
+
+  my $today = now_sqldate;
+  my $end_date = sql_normal_date($entry->{end});
+  return $today le $end_date;
 }
 
 # check if the user is subscribed to the given subscription, and allow
@@ -175,7 +190,12 @@ sub subscribed_to {
 sub subscribed_to_grace {
   my ($self, $sub) = @_;
 
-  return; # PH for now, not subscribed
+  my $entry = $self->_user_sub_entry($sub)
+    or return;
+
+  my $today = now_sqldate;
+  my $end_date = sql_add_date_days($entry->{end}, $entry->{max_lapsed});
+  return $today le $end_date;
 }
 
 my @image_cols = 
@@ -256,5 +276,14 @@ sub remove_image {
   }
 }
 
+sub recalculate_subscriptions {
+  my ($self, $cfg) = @_;
+
+  require BSE::TB::Subscriptions;
+  my @subs = BSE::TB::Subscriptions->all;
+  for my $sub (@subs) {
+    $sub->update_user_expiry($self, $cfg);
+  }
+}
 
 1;
index 1d8b000..3e8e6d2 100644 (file)
@@ -9,4 +9,10 @@ sub rowClass {
   return 'SiteUser';
 }
 
+sub all_subscribers {
+  my ($class) = @_;
+
+  $class->getSpecial('allSubscribers');
+}
+
 1;
index 47ba63f..b611f0c 100644 (file)
@@ -52,6 +52,7 @@ sub new {
        or confess "Could not add $class(@data{1..$#save_cols})";
     }
     else {
+      print STDERR "add$class\n";
       my $sth = $dh->stmt("add$class")
        or confess "No add$class member in DatabaseHandle";
       my $ret = $sth->execute(@values[1..$#values]);
index 5e88477..5cb8ac7 100644 (file)
@@ -2,7 +2,7 @@ package Squirrel::Template;
 use vars qw($VERSION);
 use strict;
 use Carp qw/cluck confess/;
-use constant DEBUG => 1;
+use constant DEBUG => 0;
 
 $VERSION="0.08";
 
index c86df6c..9464290 100755 (executable)
@@ -614,15 +614,27 @@ sub purchase {
     # store product data too
     @$row{@prod_xfer} = @{$product}{@prod_xfer};
 
+    # store the lapsed value, this prevents future changes causing
+    # variation of the expiry date
+    $row->{max_lapsed} = 0;
+    if ($product->{subscription_id} != -1) {
+      my $sub = $product->subscription;
+      $row->{max_lapsed} = $sub->{max_lapsed} if $sub;
+    }
+
     my @data = @$row{@item_cols};
     
     shift @data;
     push(@items, BSE::TB::OrderItems->add(@data));
 
-#     my $sub = $product->subscription;
-#     if ($sub) {
-#       $subscribing_to{$sub->{text_id}} = $sub;
-#     }
+    my $sub = $product->subscription;
+    if ($sub) {
+      $subscribing_to{$sub->{text_id}} = $sub;
+    }
+  }
+
+  if ($user) {
+    $user->recalculate_subscriptions($cfg);
   }
 
   my $item_index = -1;
@@ -686,11 +698,11 @@ sub purchase {
   page('checkoutfinal.tmpl', \%acts);
 }
 
-sub tag_ifSubscribingTo {
-  my ($subscribing_to, $args) = @_;
+sub tag_ifSubscribingTo {
+  my ($subscribing_to, $args) = @_;
 
-  exists $subscribing_to->{$args};
-}
+  exists $subscribing_to->{$args};
+}
 
 sub tag_with_wrap {
   my ($args, $text) = @_;
@@ -947,6 +959,11 @@ This is split out for these forms.
 
 Order fields.
 
+=item ifSubscribingTo I<subid>
+
+Can be used to check if this order is intended to be subscribing to a
+subscription.
+
 =back
 
 You can also use "|format" at the end of a field to perform some
index 28499d1..cddad88 100644 (file)
@@ -10,6 +10,59 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.14_30
+
+The basic processing for subscriptions is now done.
+
+=over
+
+=item *
+
+added max_lapsed to the order_item table, to make sure subscription
+expiries remain consistent.
+
+=item *
+
+the bse_subscriptions table was commented out for the last release (it
+worked here because the table was created before I commented it out
+<sigh>)
+
+=item *
+
+ordering items with a subscription now results in the
+bse_user_subscribed table being updated, and hence most of the code
+which checks if a user has subscribed now has something to check
+
+=item *
+
+the users iterator on the subscription details page now works
+
+=item *
+
+subadmin.pl now has a target to update all users subscription expiry
+dates from their orders.
+
+=item *
+
+messages usually weren't displayed from a refresh by subadmin.pl, when
+they should have been
+
+=item *
+
+modern iterators could cause 500 errors (bad parameter list
+internally)
+
+=item *
+
+modern iterators could generated undefined value warning in the logs
+
+=item *
+
+switched off debugging for Squirrel::Template, which should reduce log
+pollution considerably.
+
+=back
+
 =head2 0.14_29
 
 =over
index f16152f..084153a 100644 (file)
@@ -662,6 +662,11 @@ STDERR (hence to the error log on Apache.)
 If nonzero the session hash is dumped to STDERR after it is retrived
 from the database.
 
+=item subscription_expiry
+
+If non-zero then subscription expiry date calculations are dumped to
+STDERR.
+
 =back
 
 =head2 [uri]
index d3a6288..4a2e158 100644 (file)
@@ -89,7 +89,7 @@ There are no products that subscribe to or require this subscription.
   <:iterator begin users:>
   <tr>
     <td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&amp;id=<:user id:>"><:user id:></a></td>
-    <td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&amp;id=<:user userId:>"><:user id:></a></td>
+    <td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&amp;id=<:user userId:>"><:user userId:></a></td>
     <td><a href="mailto:<:user email:>"><:user email:></a></td>
     <td><:date user ends_at:></td>
   </tr>
index 8f20383..f5f23c9 100644 (file)
@@ -4,6 +4,8 @@
 | <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:>
+<:if UserCan bse_subs_update :>
+<a href="<:script:>?a_update=1">Recalculate Expiry Dates</a> |<:or UserCan:><:eif UserCan:>
 <:ifMessage:>
 <p><b><:message:></b></p>
 <:or:><:eif:> 
diff --git a/t/t070sqldates.t b/t/t070sqldates.t
new file mode 100644 (file)
index 0000000..efd0560
--- /dev/null
@@ -0,0 +1,32 @@
+#!perl -w
+use strict;
+use Test::More tests=>11;
+
+use BSE::Util::SQL qw(:all);
+
+is(sql_normal_date("2004/02/10"), "2004-02-10", "separators");
+is(sql_normal_date("2004-02-10 10:00:00"), "2004-02-10", "strip time");
+
+# sql_add_date_months():
+is(sql_add_date_months("2004-02-10", 2), "2004-04-10", 
+   "add months, simple");
+is(sql_add_date_months("2004-02-10", 12), "2005-02-10",
+   "add months, one year");
+is(sql_add_date_months("2004-02-10", 11), "2005-01-10",
+   "add months, 11 months");
+is(sql_add_date_months("2004-02-10", 13), "2005-03-10",
+   "add months, 13 months");
+is(sql_add_date_months("2004-01-30", 1), "2004-02-29",
+   "add months, to a shorter month");
+is(sql_add_date_months("2004-01-30", 13), "2005-02-28",
+   "add months, to a shorter month in non-leap year");
+
+
+# sql_add_date_days():
+is(sql_add_date_days("2004-02-10", 2), "2004-02-12",
+   "add days, simple");
+is(sql_add_date_days("2004-02-29", 1), "2004-03-01",
+   "add days, span month");
+is(sql_add_date_days("2004-12-31", 1), "2005-01-01",
+   "add days, span year");
+
diff --git a/t/t50subscalc.t b/t/t50subscalc.t
new file mode 100644 (file)
index 0000000..0618674
--- /dev/null
@@ -0,0 +1,142 @@
+#!perl -w
+use strict;
+use Test::More tests=>9;
+
+my $gotmodule = require_ok('BSE::TB::Subscription::Calc');
+
+SKIP: {
+  skip "couldn't load module", 9 unless $gotmodule;
+
+  # simple as it gets
+  my @result = BSE::TB::Subscription::Calc->calculate_period
+    (1,
+     { 
+      orderDate => '2004/02/04 10:00', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 1,
+      product_id => 3,
+      item_id => 2,
+      max_lapsed => 0,
+     }
+    );
+  is(@result, 1, "simple, correct period count");
+  is_deeply(\@result,
+           [
+            { start => '2004-02-04',
+              end => '2004-03-04',
+              duration => 1,
+              order_ids => [ 1 ],
+              product_ids => [ 3 ],
+              item_ids => [ 2 ],
+              max_lapsed => 0,
+            },
+           ], "simple, correct period");
+
+  # overlapping ranges
+  @result = BSE::TB::Subscription::Calc->calculate_period
+    (1,
+     { 
+      orderDate => '2004/02/04', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 1,
+      product_id => 3,
+      item_id => 2,
+      max_lapsed => 0,
+     },
+     {
+      orderDate => '2004/02/28', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 2,
+      product_id => 3,
+      item_id => 4,
+      max_lapsed => 0,
+     },
+    );
+  is(@result, 1, "connected, correct period count");
+  is_deeply(\@result,
+           [
+            { start => '2004-02-04',
+              end => '2004-04-04',
+              duration => 2,
+              order_ids => [ 1, 2 ],
+              product_ids => [ 3, 3 ],
+              item_ids => [ 2, 4 ],
+              max_lapsed => 0,
+            },
+           ], "connected, correct period");
+
+  # completely disconnected ranges
+  @result = BSE::TB::Subscription::Calc->calculate_period
+    (1,
+     { 
+      orderDate => '2004/02/04', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 1,
+      product_id => 3,
+      item_id => 2,
+      max_lapsed => 0,
+     },
+     {
+      orderDate => '2004/03/05', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 2,
+      product_id => 3,
+      item_id => 4,
+      max_lapsed => 0,
+     },
+    );
+  is(@result, 2, "disconnected, correct period count");
+  is_deeply(\@result,
+           [
+            { start => '2004-02-04',
+              end => '2004-03-04',
+              duration => 1,
+              order_ids => [ 1 ],
+              product_ids => [ 3 ],
+              item_ids => [ 2 ],
+              max_lapsed => 0,
+            },
+            { start => '2004-03-05',
+              end => '2004-04-05',
+              duration => 1,
+              order_ids => [ 2 ],
+              product_ids => [ 3 ],
+              item_ids => [ 4 ],
+              max_lapsed => 0,
+            },
+           ], "disconnected, correct period");
+
+  # connected by grace period
+  @result = BSE::TB::Subscription::Calc->calculate_period
+    (1,
+     { 
+      orderDate => '2004/02/04', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 1,
+      product_id => 3,
+      item_id => 2,
+      max_lapsed => 1,
+     },
+     {
+      orderDate => '2004/03/05', # seconds should get stripped in code
+      subscription_period=>1,
+      order_id => 2,
+      product_id => 3,
+      item_id => 4,
+      max_lapsed => 2,
+     },
+    );
+
+  is(@result, 1, "grace period, correct period count");
+  is_deeply(\@result,
+           [
+            { start => '2004-02-04',
+              end => '2004-04-04',
+              duration => 2,
+              order_ids => [ 1, 2 ],
+              product_ids => [ 3, 3 ],
+              item_ids => [ 2, 4 ],
+              max_lapsed => 2,
+            },
+           ], "grace period, correct period");
+}