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
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
-VERSION=0.14_29
+VERSION=0.14_30
DISTNAME=bse-$(VERSION)
DISTBUILD=$(DISTNAME)
DISTTAR=../$(DISTNAME).tar
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)
);
);
-- -- 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 (
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 = ?',
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 = ?
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
);
}
$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");
}
}
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;
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;
--- /dev/null
+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;
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;
save => 'bse_subs_edit',
detail => 'bse_subs_detail',
remove => 'bse_subs_delete',
+ update => 'bse_subs_update',
);
sub actions { \%rights }
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) = @_;
}
sub iter_users {
- return;
+ my ($sub) = @_;
+
+ $sub->subscribed_user_summary;
}
sub req_remove {
if ($msg) {
my $sep = $r =~ /\?/ ? '&' : '?';
- $r .= $sep . escape_uri($msg);
+ $r .= $sep . "m=" . escape_uri($msg);
}
return $r;
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.
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;
$$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 {
"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 ],
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;
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
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;
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;
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
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 =
}
}
+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;
return 'SiteUser';
}
+sub all_subscribers {
+ my ($class) = @_;
+
+ $class->getSpecial('allSubscribers');
+}
+
1;
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]);
use vars qw($VERSION);
use strict;
use Carp qw/cluck confess/;
-use constant DEBUG => 1;
+use constant DEBUG => 0;
$VERSION="0.08";
# 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;
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) = @_;
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
=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
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]
<:iterator begin users:>
<tr>
<td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&id=<:user id:>"><:user id:></a></td>
- <td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&id=<:user userId:>"><:user id:></a></td>
+ <td><a href="/cgi-bin/admin/siteusers.pl?a_edit=1&id=<:user userId:>"><:user userId:></a></td>
<td><a href="mailto:<:user email:>"><:user email:></a></td>
<td><:date user ends_at:></td>
</tr>
| <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:>
--- /dev/null
+#!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");
+
--- /dev/null
+#!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");
+}
projects / bse.git / commitdiff