ikiwiki-hosting-common 0.20170622ubuntu1 / usr / share / perl5 / IkiWiki / Business.pm

#!/usr/bin/perl
# stub business logic
package IkiWiki::Business;
use warnings;
use strict;
use IkiWiki::Hosting;

our $tax=0.00; # for 1%, use 0.01

# Pricing plans may be defined here to enable the business logic.
#
# Example of a plan:
#	
#basic => {
#		name => "Default",
#		description => '$9.99 per month for 1 site (first month free)',
#		permonth => 999, # cents
#		peryear => 5999, # cents
#		maxsites => 1,
#		upgradefor => [],
#		monthsfreetrial => 1,
#		active => 1,
#		default => 1,
#		sendbills => 1,
#	},
#
# Note that the description field should not exceed 47 characters.
#
# Plans should never be deleted from this list when users are still
# using them. If a plan is changed, and existing users need to be
# grandfathered in under the old terms, a new plan should instead be
# added with the new terms, and the old plan left, flagged as not active.
#
# Only one plan can be the default plan, and only active plans should
# have upgradefor set -- this allows the interface to select active plans
# for new users, and allow users to upgrade to other active plans.
my %plans=(
	# None are defined by default, so price plan stuff is disabled.
);

# Given a plan name, returns its info hash.
sub planinfo ($) {
	my $plan=shift;

	return $plans{$plan};
}

# Based on the number of sites a user has, return their
# suggested best-fit price plan.
#
# The optional second parameter is a site name that should
# be assumed to exist whether or not it really does.
# (Maybe this site is being created.)
sub suggestedplan ($;$) {
	my $username=shift;
	my $assumesite=shift;

	return undef unless %plans;

	my $currentsites=currentsites($username, $assumesite);
	my @candidate_plans=sortprice(grep { 
		$plans{$_}{active} &&
		$plans{$_}{maxsites} >= $currentsites
	} upgradeset($username, 1));
	return $candidate_plans[0] if @candidate_plans;

	# just in case, fallback to the default plan.
	foreach my $plan (keys %plans) {
		return $plan if $plans{$plan}{default} && $plans{$plan}{active};
	}
	die "internal error; no default price plan!";
}

# Returns true if the user needs to change from their current plan
# to cover their sites. (Of if the user has no current plan.)
sub needchangeplan ($;$) {
	my $username=shift;
	my $assumesite=shift;
	
	return 0 unless %plans;

	my $currentsites=currentsites($username, $assumesite);
	my $currentplan=currentplan($username);
	return 1 unless defined $currentplan;
	if ($plans{$currentplan}{maxsites} < $currentsites) {
		return 1;
	}
	else {
		return 0;
	}
}

# Returns the current price plan for a user.
# Returns undef if the user is not currently enrolled in a plan.
sub currentplan ($) {
	my $username=shift;
	return undef unless %plans;

	eval q{use IkiWiki::Customer};
	die $@ if $@;
	
	my $plan=IkiWiki::Customer::customer_get($username, "currentplan");
	return $plan;
}

# Returns a list of sites a user currently owns.
# In a scalar context, returns the count of sites owned.
my $currentsites_cache;
my $currentsites_cache_owner;
sub currentsites ($;$) {
	my $username=shift;
	my $assumesite=shift;

	my @owned;
	if (defined $currentsites_cache_owner &&
	    $currentsites_cache_owner eq $username) {
		@owned=@$currentsites_cache;
	}
	else {
		# A single user may have multiple openids and emails
		# used in sites they own.
		eval q{use IkiWiki::Customer};
		die $@ if $@;
		my @accounts=IkiWiki::Customer::account_list($username);

		@owned=split(' ', IkiWiki::Hosting::getshell("ikisite-wrapper",
			"list", map {"--owner=$_"} @accounts));
		$currentsites_cache=\@owned;
		$currentsites_cache_owner=$username;
	}

	if (defined $assumesite) {
		@owned=((grep { $_ ne $assumesite } @owned), $assumesite);
	}

	return @owned;
}

# Given a user, returns how many additional sites they can make, under
# their current plan.
sub sitesavailable ($) {
	my $username=shift;
	
	return undef unless %plans;

	my $currentplan=currentplan($username);
	return 0 unless defined $currentplan;
	my $maxsites=$plans{$currentplan}{maxsites};
	my @currentsites=currentsites($username);

	if (@currentsites > $maxsites) {
		# could happen if user's plan was downgraded, or something
		return 0;
	}
	else {
		return $maxsites - @currentsites;
	}
}

# Given a user, returns the set of plans the user could upgrade to.
sub upgradeset ($;$) {
	my $username=shift;
	my $includecurrent=shift;
	
	return () unless %plans;

	my $currentplan=currentplan($username);
	if (! defined $currentplan) {
		return keys %plans;
	}
	
	my @ret;
	foreach my $plan (keys %plans) {
		next if $plan eq $currentplan && ! $includecurrent;
		if ($plan eq $currentplan ||
		    grep { $_ eq $currentplan } @{$plans{$plan}{upgradefor}}) {
			push @ret, $plan;
		}
	}
	return @ret;
}

# Given a list of plans, sorts them by price.
sub sortprice (@) {
	sort {
		$plans{$a}{permonth} <=> $plans{$b}{permonth},
	} @_
}

# Returns a date a certian number of months from the passed date.
# The date will be the same day of the month, when possible.
sub monthfrom ($;$) {
	my $date=shift;
	my $months=shift || 1;

	eval q{use DateTime; use DateTime::Duration};
	die $@ if $@;
	my $d=DateTime->from_epoch(epoch => $date);
	my $offset=DateTime::Duration->new(months => $months,
		end_of_month => "preserve");
	return $d->add_duration($offset)->epoch;
}

# Returns when the next bill should be sent for a user.
sub nextbilldate ($) {
	my $username=shift;
	
	eval q{use IkiWiki::Customer};
	die $@ if $@;

	my $bill_enddate=IkiWiki::Customer::customer_get($username, "bill_enddate");
	if (! defined $bill_enddate) {
		# no bill sent yet; one should be sent immediatly
		return time;
	}
	
	# Next bill is normally sent just after the end of the billing
	# period for the previous bill.
	return $bill_enddate;
}

# Checks if it's time to send a reminder bill to a user.
sub billreminderdue ($) {
	my $username=shift;
	
	eval q{use IkiWiki::Customer};
	die $@ if $@;
	
	my $balance=IkiWiki::Customer::customer_get($username, "balance");
	if (! defined $balance || $balance <= 0) {
		return 0;
	}
	my $lastbilldate=IkiWiki::Customer::customer_get($username, "lastbilldate");
	if (! defined $lastbilldate) {
		# Customer has never been billed, so no reminder is due.
		return 0;
	}
	
	# Currently reminder bills are hardcoded 1 week after original bill.
	eval q{use DateTime; use DateTime::Duration};
	die $@ if $@;
	my $d=DateTime->from_epoch(epoch => $lastbilldate);
	my $offset=DateTime::Duration->new(weeks => 1);
	my $when=$d->add_duration($offset)->epoch;
	
	return 0 if time < $when; # not due yet

	my $lastreminderdate=IkiWiki::Customer::customer_get($username, "lastreminderdate");
	if (defined $lastreminderdate && $lastreminderdate >= $when) {
		# Bill reminder has already been sent.
		return 0;
	}
	
	return 1;
}

sub curryear () {
	return (gmtime(time))[5]+1900;
}

sub currmonth () {
	return (gmtime(time))[4]+1;
}

# Generates and returns a new, unique invoice id.
#
# Invoice ids are of the form: BR-001/2010;
# the invoice numbering resets at the start of each year.
sub geninvoiceid ($;$) {
	my $username=shift;
	my $dry_run=shift;
	
	my $invoice = IkiWiki::Customer::dir_get("invoice", "last");
	my ($prefix, $num, $year)=$invoice=~/^(.*?)-(\d+)\/(\d+)$/
		if defined $invoice;
	if (! defined $num || ! defined $year || $year ne curryear()) {
		$year=curryear();
		$num=0;
	}
	if (! defined $prefix) {
		$prefix='BR';
	}
	$invoice=sprintf("%s-%03i/%s", $prefix, $num+1, $year);
	$invoice.="-dryrun" if $dry_run;

	if (! $dry_run) {
		IkiWiki::Customer::dir_lock_write("invoice", sub {
			IkiWiki::Customer::dir_set("invoice", "last", $invoice);
			IkiWiki::Customer::dir_commit("invoice");
		});
	}

	return $invoice;
}

# Saves an invoice for a customer for accountant review.
#
# Invoice BR-XXX/YYYY is stored in the customersite, in the file
# invoice/YYYY-MM/BR-XXX.
sub saveinvoice ($$$$) {
	my $username=shift;
	my $invoicetext=shift;
	my $dry_run=shift;
	my $overwrite=shift;

	return if $dry_run;
	
	my $invoiceid=IkiWiki::Customer::customer_get($username, "lastinvoiceid");
	if (! defined $invoiceid) {
		die "saveinvoice: failed to find lastinvoiceid";
	}

	my ($year) = $invoiceid =~ m/\/(\d\d\d\d)$/;
	$invoiceid =~ s/\/$year$//;
	my $month = currmonth();
	my $dir="invoice/$year-$month";
	
	if (! $overwrite) {
		my $old = IkiWiki::Customer::dir_get($dir, $invoiceid);
		if (defined $old && length $old) {
			# Don't overwrite the first copy of an invoice that is
			# sent.
			# Assumes that later copies do not change any relevant
			# information for accounting. (Ie, that the price,
			# dates, etc are stable.)
			return 0; 
		}
	}

	IkiWiki::Customer::dir_lock_write($dir, sub {
		IkiWiki::Customer::dir_set($dir, $invoiceid, $invoicetext);
		IkiWiki::Customer::dir_commit($dir);
	});

	return 1;
}

# Bills a user for the next month of service, updating their balance
# appropriately. Suitable to be called from a daily (or more frequent) 
# cron job.
#
# The passed template is filled out with info about the bill. If the user
# is in fact billed (or needs to be sent a reminder), the template will
# be returned. Returns undef if no billing is currently needed for a
# user. Throws an error if the customer should be billed, but cannot
# due to some problem.
sub bill ($$;$) {
	my $username=shift;
	my $template=shift;
	my $dry_run=shift;
	
	eval q{use IkiWiki::Customer};
	die $@ if $@;
	
	return if IkiWiki::Customer::customer_get($username, "disable_billing");
	
	$template->param(username => $username);

	foreach my $field (qw{name email}) {
		my $val=IkiWiki::Customer::customer_get($username, $field);
		unless (defined $val && length $val) {
			die "cannot bill $username: missing $field\n";
		}
		$template->param($field => $val);
	}

	my $nextbilldate=nextbilldate($username);
	my $plan;
	my $trial=0;
	if ($nextbilldate <= time) {
		# Time for a new bill.
		my $now=time;
		my $startdate = IkiWiki::Customer::customer_get($username, "startdate");
		my $lastbilldate = IkiWiki::Customer::customer_get($username, "lastbilldate");
		my $lastbill_enddate = IkiWiki::Customer::customer_get($username, "bill_enddate");
		$plan = currentplan($username);
		if (! defined $startdate || ! defined $plan) {
			die "cannot bill $username; missing startdate or currentplan\n";
		}

		my $new=0;
		if (monthfrom($startdate) >= $now) {
			$template->param(new => 1);
			$new=1;
		}

		my $bill_startdate=($lastbill_enddate || $startdate);
		my $bill_enddate=monthfrom($bill_startdate);
		if ($bill_enddate <= $now) {
			$bill_enddate=monthfrom($now);
		}
		$template->param(bill_startdate => $bill_startdate);
		$template->param(bill_enddate => $bill_enddate);
		$template->param(lastbilldate => $now);

		my $invoiceid;
		my $balance=IkiWiki::Customer::customer_get($username, "balance") || 0;
		my $origbalance=$balance;
		if ($plans{$plan}{monthsfreetrial} &&
		    monthfrom($startdate, $plans{$plan}{monthsfreetrial}) > $nextbilldate) {
			$template->param(trial => 1);
			$trial=1;
		}
		else {
			$balance+=$plans{$plan}{permonth};
			if ($plans{$plan}{permonth} > 0) {
				$invoiceid=geninvoiceid($username, $dry_run);
				$template->param(invoiceid => $invoiceid);
			}
		}
		
		if (! $dry_run) {
			IkiWiki::Customer::customer_lock_write($username, sub {
				IkiWiki::Customer::customer_set($username, "previous_balance", $origbalance);
				IkiWiki::Customer::customer_set($username, "balance", $balance);
				IkiWiki::Customer::customer_set($username, "lastbilldate", $now);
				IkiWiki::Customer::customer_set($username, "lastplan", $plan);
				if (defined $invoiceid) {
					IkiWiki::Customer::customer_set($username, "lastinvoiceid", $invoiceid);
				}
				IkiWiki::Customer::customer_set($username, "bill_startdate", $bill_startdate);
				IkiWiki::Customer::customer_set($username, "bill_enddate", $bill_enddate);
				IkiWiki::Customer::customer_commit($username);
			});
		}
	}
	elsif (billreminderdue($username)) {
		# Time for a reminder bill.
		$template->param(reminder => 1);
		$template->param(bill_startdate =>
			IkiWiki::Customer::customer_get($username, "bill_startdate"));
		$template->param(bill_enddate =>
			IkiWiki::Customer::customer_get($username, "bill_enddate"));
		$template->param(lastbilldate =>
			IkiWiki::Customer::customer_get($username, "lastbilldate"));
		$template->param(invoiceid =>
			IkiWiki::Customer::customer_get($username, "lastinvoiceid"));

		if (! $dry_run) {
			IkiWiki::Customer::customer_lock_write($username, sub {
				IkiWiki::Customer::customer_set($username, "lastreminderdate", time);
				IkiWiki::Customer::customer_commit($username);
			});
		}
		
		$plan = IkiWiki::Customer::customer_get($username, "lastplan");
	}
	else {
		return undef;
	}
	
	return undef if ! $plans{$plan}{sendbills};
	
	$template->param(plan_name => $plans{$plan}{name});
	$template->param(plan_description => $plans{$plan}{description});
	$template->param(plan_maxsites => $plans{$plan}{maxsites});
	my $price=$plans{$plan}{permonth};
	if (defined $price && $price > 0) {
		$price=0 if $trial;
		my $price_tax=calculate_tax($price);
		$template->param(permonth_tax => show_dollars($price_tax));
		$template->param(permonth_pretax => show_dollars($price - $price_tax));
		$template->param(permonth_total => show_dollars($price));
		$template->param(tax_percent => $tax * 100);

		my $yprice=$plans{$plan}{peryear};
		$template->param(peryear_total => show_dollars($yprice));
	}
	
	return balanceinfo($username, $template);
}

# The passed template is filled out with info about the user's balance,
# and returned.
sub balanceinfo ($$) {
	my $username=shift;
	my $template=shift;
	
	foreach my $field (qw{balance previous_balance}) {
		my $value=IkiWiki::Customer::customer_get($username, $field);
		next unless defined $value;
		$template->param("has_$field" => 1);
		$template->param($field => show_dollars(abs($value)));
		$template->param("zero_$field" => ($value == 0));
		$template->param("negative_$field" => ($value < 0));
		$template->param("positive_$field" => ($value > 0));
	}

	return $template;
}

sub show_dollars ($) {
	my $cents=shift;

	my $dollars=int($cents/100);
	my $remainder=abs($cents-($dollars*100));
	return sprintf("%01i.%02i", $dollars, $remainder);
}

# Given a total price in cents, returns the number of cents of that
# price that are tax.
#
# XXX Fractional cents are rounded up, to ensure that we don't pay
# slightly too little tax. An accountant could probably improve the
# rounding to avoid us paying too much tax.
sub calculate_tax ($) {
	my $price=shift;

	return int($price * $tax + 0.9); # int(foo+0.9) = ceil(foo)
}

# Short, human-readable date.
sub shortdate ($) {
	my $date=shift;

	POSIX::setlocale(&POSIX::LC_TIME, "C");
	return POSIX::strftime("%d %B %Y", gmtime($date));
}

1