976 lines
31 KiB
Perl
976 lines
31 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# DW::Pay
|
|
#
|
|
# Core of the payment system.
|
|
#
|
|
# Authors:
|
|
# Mark Smith <mark@dreamwidth.org>
|
|
#
|
|
# Copyright (c) 2008-2013 by Dreamwidth Studios, LLC.
|
|
#
|
|
# This program is free software; you may redistribute it and/or modify it under
|
|
# the same terms as Perl itself. For a copy of the license, please reference
|
|
# 'perldoc perlartistic' or 'perldoc perlgpl'.
|
|
#
|
|
|
|
package DW::Pay;
|
|
|
|
use strict;
|
|
use v5.10;
|
|
use Log::Log4perl;
|
|
my $log = Log::Log4perl->get_logger(__PACKAGE__);
|
|
|
|
use Carp qw/ confess /;
|
|
use HTTP::Request;
|
|
use LWP::UserAgent;
|
|
use DW::BusinessRules::Pay;
|
|
use DW::Task::SphinxCopier;
|
|
|
|
our $error_code = undef;
|
|
our $error_text = undef;
|
|
|
|
use constant ERR_FATAL => 1;
|
|
use constant ERR_TEMP => 2;
|
|
|
|
################################################################################
|
|
# DW::Pay::type_is_valid
|
|
#
|
|
# ARGUMENTS: typeid
|
|
#
|
|
# typeid required the id of the type we're checking
|
|
#
|
|
# RETURN: 1/0 if the type is a valid type
|
|
#
|
|
sub type_is_valid {
|
|
return 1
|
|
if $LJ::CAP{ $_[0] }
|
|
&& $LJ::CAP{ $_[0] }->{_account_type}
|
|
&& $LJ::CAP{ $_[0] }->{_visible_name};
|
|
return 0;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::type_name
|
|
#
|
|
# ARGUMENTS: typeid
|
|
#
|
|
# typeid required the id of the type we're checking
|
|
#
|
|
# RETURN: string name of type, else undef
|
|
#
|
|
sub type_name {
|
|
confess "invalid typeid $_[0]"
|
|
unless DW::Pay::type_is_valid( $_[0] );
|
|
return $LJ::CAP{ $_[0] }->{_visible_name};
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::type_shortname
|
|
#
|
|
# ARGUMENTS: typeid
|
|
#
|
|
# typeid required the id of the type we're checking
|
|
#
|
|
# RETURN: string short name of type, else undef
|
|
#
|
|
sub type_shortname {
|
|
confess "invalid typeid $_[0]"
|
|
unless DW::Pay::type_is_valid( $_[0] );
|
|
return $LJ::CAP{ $_[0] }->{_account_type};
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::all_shortnames
|
|
#
|
|
# ARGUMENTS: (none)
|
|
#
|
|
# RETURN: { typeid => shortname } hashref
|
|
#
|
|
sub all_shortnames {
|
|
my %names;
|
|
while ( my ( $typeid, $data ) = each %LJ::CAP ) {
|
|
|
|
# Avoid calling DW::Pay::type_is_valid a zillion times for the same typeid
|
|
$names{$typeid} = $data->{_account_type}
|
|
if DW::Pay::type_is_valid($typeid);
|
|
}
|
|
return \%names;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_paid_status
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get paid status of
|
|
#
|
|
# RETURN: Hashref if paid (or has ever been), undef if free:
|
|
#
|
|
# {
|
|
# typeid => ...
|
|
# expiretime => db time epoch seconds they expire at
|
|
# expiresin => seconds until they expire
|
|
# permanent => 1/0 if they're permanent
|
|
# }
|
|
#
|
|
sub get_paid_status {
|
|
DW::Pay::clear_error();
|
|
|
|
my ( $uuid, %opts ) = @_;
|
|
my $uid;
|
|
|
|
my $use_cache = !$opts{no_cache};
|
|
|
|
$uid = LJ::want_userid($uuid) if defined $uuid;
|
|
return error( ERR_FATAL, "Invalid user object/userid passed in." )
|
|
unless defined $uid && $uid > 0;
|
|
|
|
return $LJ::PAID_STATUS{$uid} if $use_cache && $LJ::PAID_STATUS{$uid};
|
|
|
|
my $dbr = DW::Pay::get_db_reader()
|
|
or return error( ERR_TEMP, "Failed acquiring database reader handle." );
|
|
my $row = $dbr->selectrow_hashref(
|
|
q{
|
|
SELECT IFNULL(expiretime, 0) - UNIX_TIMESTAMP() AS 'expiresin', typeid, expiretime, permanent
|
|
FROM dw_paidstatus
|
|
WHERE userid = ?
|
|
}, undef, $uid
|
|
);
|
|
return error( ERR_FATAL, "Database error: " . $dbr->errstr )
|
|
if $dbr->err;
|
|
|
|
$LJ::PAID_STATUS{$uid} = $row;
|
|
return $row;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::default_typeid
|
|
#
|
|
# RETURN: typeid of the default account type.
|
|
#
|
|
sub default_typeid {
|
|
|
|
# try to get the default cap class. note that we confess here because
|
|
# these errors are bad enough to warrant bailing whoever is calling us.
|
|
my @defaults = grep { $LJ::CAP{$_}->{_account_default} } keys %LJ::CAP;
|
|
confess 'must have one %LJ::CAP class set _account_default to use the payment system'
|
|
if scalar(@defaults) < 1;
|
|
confess 'only one %LJ::CAP class can be set as _account_default'
|
|
if scalar(@defaults) > 1;
|
|
|
|
# There Can Be Only One
|
|
return $defaults[0];
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::is_default_type
|
|
#
|
|
# ARGUMENTS: hashref returned from get_paid_status
|
|
#
|
|
# RETURN: 1 if default_typeid should be used, 0 otherwise
|
|
#
|
|
sub is_default_type {
|
|
my $stat = $_[0];
|
|
|
|
# free accounts: no row, or expired (but not permanent)
|
|
return 1 unless defined $stat;
|
|
return 1 unless $stat->{permanent} || $stat->{expiresin} > 0;
|
|
|
|
# use typeid defined in row
|
|
return 0;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_current_account_status
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get paid status of
|
|
#
|
|
# RETURN: typeid from get_paid_status, or else default_typeid
|
|
#
|
|
sub get_current_account_status {
|
|
my $uid = LJ::want_userid( $_[0] );
|
|
return DW::Pay::default_typeid() unless $uid;
|
|
|
|
# check memcache first
|
|
my $memkey = [ $uid, "accttype:$uid" ];
|
|
my $typeid = LJ::MemCache::get($memkey);
|
|
return $typeid if defined $typeid;
|
|
|
|
# try to get current paid status if not in memcache
|
|
my $stat = DW::Pay::get_paid_status(@_);
|
|
|
|
# default check
|
|
$typeid = DW::Pay::is_default_type($stat) ? DW::Pay::default_typeid() : $stat->{typeid};
|
|
|
|
# store in memcache for 15 minutes
|
|
LJ::MemCache::set( $memkey, $typeid, 900 );
|
|
|
|
return $typeid;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::expire_status_cache
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to expire status cache of
|
|
#
|
|
# RETURN: undef on error, else 1 on success.
|
|
#
|
|
sub expire_status_cache {
|
|
my $uid = LJ::want_userid( $_[0] );
|
|
return undef unless $uid;
|
|
|
|
my $memkey = [ $uid, "accttype:$uid" ];
|
|
LJ::MemCache::delete($memkey);
|
|
delete $LJ::PAID_STATUS{$uid};
|
|
|
|
return 1;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_account_expiration_time
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get paid status of
|
|
#
|
|
# RETURN: -1 for free or perm, 0 for expired paid, else the unix timestamp this
|
|
# account expires on...
|
|
#
|
|
# yes, this function has a very weird return value. :(
|
|
#
|
|
sub get_account_expiration_time {
|
|
|
|
# try to get current paid status
|
|
my $stat = DW::Pay::get_paid_status(@_);
|
|
|
|
# free accounts: no row, or expired
|
|
# perm accounts: no expiration
|
|
return -1 if !defined $stat || $stat->{permanent};
|
|
return 0 unless $stat->{expiresin} > 0;
|
|
|
|
# valid row, return whatever the expiration time is
|
|
return time() + $stat->{expiresin};
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_account_type
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get paid status of
|
|
#
|
|
# RETURN: value defined as _account_type in %LJ::CAP.
|
|
#
|
|
sub get_account_type {
|
|
my $typeid = DW::Pay::get_current_account_status(@_);
|
|
confess 'account has no valid typeid'
|
|
unless $typeid && $typeid > 0;
|
|
confess "typeid $typeid not a valid account level"
|
|
unless DW::Pay::type_is_valid($typeid);
|
|
return $LJ::CAP{$typeid}->{_account_type};
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_refund_points_rate
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get paid status of
|
|
#
|
|
# RETURN: value defined as _refund_points in %LJ::CAP.
|
|
#
|
|
sub get_refund_points_rate {
|
|
my $typeid = DW::Pay::get_current_account_status(@_);
|
|
confess 'account has no valid typeid'
|
|
unless $typeid && $typeid > 0;
|
|
confess "typeid $typeid not a valid account level"
|
|
unless DW::Pay::type_is_valid($typeid);
|
|
return $LJ::CAP{$typeid}->{_refund_points} || 0;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::can_refund_points
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get refundable status of
|
|
#
|
|
# RETURN: 1/0
|
|
#
|
|
sub can_refund_points {
|
|
my $u = LJ::want_user( $_[0] );
|
|
return 0 unless LJ::isu($u);
|
|
|
|
my $secs_since_refund = time() - ( $u->prop("shop_refund_time") || 0 );
|
|
return $secs_since_refund > 86400 * 30 ? 1 : 0;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_account_type_name
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to get paid status of
|
|
#
|
|
# RETURN: value defined as _visible_name in %LJ::CAP.
|
|
#
|
|
sub get_account_type_name {
|
|
my $typeid = DW::Pay::get_current_account_status(@_);
|
|
confess 'account has no valid typeid'
|
|
unless $typeid && $typeid > 0;
|
|
confess "typeid $typeid not a valid account level"
|
|
unless DW::Pay::type_is_valid($typeid);
|
|
return $LJ::CAP{$typeid}->{_visible_name};
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_current_paid_userids
|
|
#
|
|
# ARGUMENTS: limit => #rows, typeid => paid account type, permanent => 0|1
|
|
#
|
|
# limit optional how many userids to return (default: no limit)
|
|
# typeid optional 1 to restrict to basic paid, 2 for premium paid
|
|
# (default: both)
|
|
# permanent optional false to restrict to expiring accounts, true to
|
|
# permanent (default: both)
|
|
#
|
|
# RETURN: arrayref of userids for currently paid accounts matching the above
|
|
# restrictions
|
|
#
|
|
sub get_current_paid_userids {
|
|
DW::Pay::clear_error();
|
|
|
|
my %opts = @_;
|
|
|
|
my $sql = 'SELECT userid FROM dw_paidstatus WHERE ';
|
|
my ( @where, @values );
|
|
|
|
if ( exists $opts{permanent} ) {
|
|
push @where, 'permanent = ?';
|
|
push @values, ( $opts{permanent} ? 1 : 0 );
|
|
push @where, 'expiretime > UNIX_TIMESTAMP(NOW())'
|
|
unless $opts{permanent};
|
|
}
|
|
else {
|
|
push @where, '(permanent = 1 OR expiretime > UNIX_TIMESTAMP(NOW()))';
|
|
}
|
|
|
|
if ( exists $opts{typeid} ) {
|
|
push @where, 'typeid = ?';
|
|
push @values, $opts{typeid};
|
|
}
|
|
|
|
$sql .= join ' AND ', @where;
|
|
|
|
if ( exists $opts{limit} ) {
|
|
$sql .= ' LIMIT ?';
|
|
push @values, $opts{limit};
|
|
}
|
|
|
|
my $dbr = DW::Pay::get_db_reader()
|
|
or return error( ERR_TEMP, "Unable to get db reader." );
|
|
my $uids = $dbr->selectcol_arrayref( $sql, {}, @values );
|
|
return error( ERR_FATAL, "Database error: " . $dbr->errstr )
|
|
if $dbr->err;
|
|
return $uids;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::expire_user
|
|
#
|
|
# ARGUMENTS: uuserid
|
|
#
|
|
# uuserid required user object or userid to set paid status for
|
|
#
|
|
# RETURN: undef on error, else 1 on success.
|
|
#
|
|
# This is a low level function that expires a user if they need to be. It's a
|
|
# no-op if the user is not supposed to be expired, but don't call it if you know
|
|
# that's the case.
|
|
#
|
|
sub expire_user {
|
|
DW::Pay::clear_error();
|
|
|
|
my ( $u, %opts ) = @_;
|
|
$u = LJ::want_user($u)
|
|
or return error( ERR_FATAL, "Invalid/not a user object." );
|
|
|
|
unless ( $opts{force} ) {
|
|
my $ps = DW::Pay::get_paid_status($u);
|
|
return 1 unless $ps; # free already
|
|
return error( ERR_FATAL, "Cannot expire a permanent account." )
|
|
if $ps->{permanent};
|
|
return error( ERR_FATAL, "Account not ready for expiration." )
|
|
if $ps->{expiresin} > 0;
|
|
}
|
|
|
|
# so we have to update their status now
|
|
LJ::statushistory_add( $u, undef, 'paidstatus',
|
|
'Expiring account; forced=' . ( $opts{force} ? 1 : 0 ) . '.' );
|
|
DW::Pay::update_paid_status( $u, _expire => 1 );
|
|
DW::Pay::sync_caps($u);
|
|
|
|
my $rv = eval {
|
|
|
|
# activate also does inactivations
|
|
$u->activate_userpics;
|
|
$u->delete_email_alias;
|
|
1;
|
|
};
|
|
warn "Failed to perform one or more payment postflight tasks!\n"
|
|
unless $rv;
|
|
|
|
# happy times
|
|
DW::Stats::increment( 'dw.shop.paid_account.expired', 1 );
|
|
return 1;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::add_paid_time
|
|
#
|
|
# ARGUMENTS: uuserid, class, months
|
|
#
|
|
# uuserid required user object or userid to set paid status for
|
|
# class required type of account to be using (_account_type)
|
|
# months required how many months to grant, 99 = perm
|
|
# days required how many days (in addition to months) to grant
|
|
#
|
|
# RETURN: undef on error, else 1 on success.
|
|
#
|
|
# This is a low level function, you better be logging!
|
|
#
|
|
sub add_paid_time {
|
|
DW::Pay::clear_error();
|
|
|
|
my $u = LJ::want_user( shift() )
|
|
or return error( ERR_FATAL, "Invalid/not a user object." );
|
|
|
|
my $type = shift();
|
|
my ($typeid) = grep { $LJ::CAP{$_}->{_account_type} && $LJ::CAP{$_}->{_account_type} eq $type }
|
|
keys %LJ::CAP;
|
|
return error( ERR_FATAL, 'Invalid type, no typeid found.' )
|
|
unless $typeid;
|
|
|
|
my ( $months, $days ) = @_;
|
|
return error( ERR_FATAL, 'Invalid value for months.' )
|
|
unless $months >= 0 && $months <= 99;
|
|
|
|
return error( ERR_FATAL, 'Invalid value for days.' )
|
|
unless $days >= 0 && $days <= 31;
|
|
|
|
return error( ERR_FATAL, 'Empty time increment' )
|
|
unless $months > 0 || $days > 0;
|
|
|
|
# okay, let's see what the user is right now to decide what to do
|
|
my $permanent = $months == 99 ? 1 : 0;
|
|
|
|
my ( $newtypeid, $amonths, $adays, $asecs ) = ( $typeid, $months, $days, 0 );
|
|
$amonths = 0 if $permanent;
|
|
|
|
# if they have a $ps hashref, they have or had paid time at some point
|
|
if ( my $ps = DW::Pay::get_paid_status( $u, no_cache => 1 ) ) {
|
|
|
|
# easy bail if they're permanent
|
|
return error( ERR_FATAL, 'User is already permanent, cannot apply more time.' )
|
|
if $ps->{permanent};
|
|
|
|
# not permanent, but do they have at least a minute left?
|
|
if ( $ps->{expiresin} > 60 ) {
|
|
|
|
# if it's the same type as what we've got, we just carry it forward by
|
|
# however much time they have left
|
|
if ( $ps->{typeid} == $typeid ) {
|
|
$asecs = $ps->{expiresin};
|
|
|
|
# but if they're going permanent...
|
|
}
|
|
elsif ($permanent) {
|
|
$asecs = $ps->{expiresin};
|
|
|
|
# but the types are different...
|
|
}
|
|
else {
|
|
# FIXME: this needs to not be dw-nonfree logic
|
|
my $from_type = $LJ::CAP{ $ps->{typeid} }->{_account_type};
|
|
my $to_type = $LJ::CAP{$typeid}->{_account_type};
|
|
|
|
# paid->premium, we convert any existing time to premium
|
|
# ($amonths are already premium and are added later)
|
|
if ( $from_type eq 'paid' && $to_type eq 'premium' ) {
|
|
$asecs = DW::BusinessRules::Pay::convert( $from_type, $to_type, undef, undef,
|
|
$ps->{expiresin} );
|
|
|
|
# premium->paid, upgrade the new buy to premium. we give them 21
|
|
# days of premium time for every month of paid time they were buying.
|
|
# We also need to convert any day value provided, for use from /admin/pay
|
|
}
|
|
elsif ( $from_type eq 'premium' && $to_type eq 'paid' ) {
|
|
$newtypeid = $ps->{typeid};
|
|
|
|
# we are not sending their current time to the conversion function
|
|
# because it is already premium. just convert the newly purchased time.
|
|
# But, we do include any value in $adays to accomodate arbitrary additions.
|
|
$asecs =
|
|
$ps->{expiresin} +
|
|
DW::BusinessRules::Pay::convert( $to_type, $from_type, $amonths, $adays,
|
|
undef );
|
|
$amonths = 0;
|
|
$adays = 0;
|
|
|
|
}
|
|
else {
|
|
return error( ERR_FATAL, 'Invalid conversion.' );
|
|
}
|
|
}
|
|
}
|
|
|
|
# at this point we can ignore whatever they have in $ps, as we're going
|
|
# overwrite it with our own stuff
|
|
}
|
|
$asecs += $adays * 86400;
|
|
|
|
# so at this point, we can do whatever we're supposed to do
|
|
my $rv = DW::Pay::update_paid_status(
|
|
$u,
|
|
typeid => $newtypeid,
|
|
permanent => $permanent,
|
|
_set_months => $amonths,
|
|
_add_secs => $asecs,
|
|
);
|
|
|
|
# and make sure caps are always in sync
|
|
DW::Pay::sync_caps($u)
|
|
if $rv;
|
|
|
|
# the following updates can error, and if they do then we don't want to break the
|
|
# whole payment flow
|
|
my $do_postflight = eval {
|
|
$u->activate_userpics;
|
|
$u->update_email_alias;
|
|
1;
|
|
};
|
|
warn "Failed to perform one or more payment postflight tasks!\n"
|
|
unless $do_postflight;
|
|
|
|
# all good, we hope :-)
|
|
return $rv;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::update_paid_status
|
|
#
|
|
# ARGUMENTS: uuserid, key => value pairs
|
|
#
|
|
# uuserid required user object or userid to set paid status for
|
|
# key required column being set
|
|
# value required new value to set column to
|
|
#
|
|
# RETURN: undef on error, else 1 on success.
|
|
#
|
|
# NOTE: this function is a low level function intended to be use for admin
|
|
# pages and similar functionality. don't use this willy-nilly in anything
|
|
# else as it is probably not what you want!
|
|
#
|
|
# NOTE: you can set special keys if you want to extend time by months, use
|
|
# _set_months to set expiretime to now + N months, and _add_months to append
|
|
# that many months. This is more than likely only useful for such things as
|
|
# admin tools. You may also specify _add_secs if you really want to dig in
|
|
# and get an exact expiration time.
|
|
#
|
|
sub update_paid_status {
|
|
DW::Pay::clear_error();
|
|
|
|
my $u = LJ::want_user( shift() )
|
|
or return error( ERR_FATAL, "Invalid/not a user object." );
|
|
my %cols = (@_)
|
|
or return error( ERR_FATAL, "Nothing to change!" );
|
|
DW::Pay::expire_status_cache( $u->id );
|
|
|
|
my $dbh = DW::Pay::get_db_writer()
|
|
or return error( ERR_TEMP, "Unable to get db writer." );
|
|
|
|
# don't let them add months if the user expired, convert it to set months
|
|
if ( $cols{_add_months} ) {
|
|
my $row = DW::Pay::get_paid_status( $u, no_cache => 1 );
|
|
if ( $row && $row->{expiresin} > 0 ) {
|
|
my $time = $dbh->selectrow_array(
|
|
"SELECT UNIX_TIMESTAMP(DATE_ADD(FROM_UNIXTIME($row->{expiretime}), "
|
|
. "INTERVAL $cols{_add_months} MONTH))" );
|
|
$cols{expiretime} = $time;
|
|
delete $cols{_add_months};
|
|
|
|
}
|
|
else {
|
|
$cols{_set_months} = delete $cols{_add_months};
|
|
}
|
|
}
|
|
|
|
if ( exists $cols{_set_months} ) {
|
|
$cols{expiretime} = $dbh->selectrow_array(
|
|
"SELECT UNIX_TIMESTAMP(DATE_ADD(NOW(), INTERVAL $cols{_set_months} MONTH))");
|
|
delete $cols{_set_months};
|
|
}
|
|
|
|
if ( exists $cols{_add_secs} ) {
|
|
$cols{expiretime} += delete $cols{_add_secs};
|
|
}
|
|
|
|
return error( ERR_FATAL, "Can't change the userid!" )
|
|
if exists $cols{userid};
|
|
return error( ERR_FATAL, "Permanent must be 0/1." )
|
|
if exists $cols{permanent} && $cols{permanent} !~ /^(?:0|1)$/;
|
|
return error( ERR_FATAL, "Typeid must be some number and valid." )
|
|
if exists $cols{typeid}
|
|
&& !( $cols{typeid} =~ /^(?:\d+)$/ && DW::Pay::type_is_valid( $cols{typeid} ) );
|
|
return error( ERR_FATAL, "Expiretime must be some number." )
|
|
if exists $cols{expiretime} && $cols{expiretime} !~ /^(?:\d+)$/;
|
|
return error( ERR_FATAL, "Lastemail must be 0, 3, or 14." )
|
|
if exists $cols{lastemail}
|
|
&& defined $cols{lastemail}
|
|
&& $cols{lastemail} !~ /^(?:0|3|14)$/;
|
|
|
|
if ( delete $cols{_expire} ) {
|
|
$cols{typeid} = DW::Pay::default_typeid();
|
|
$cols{lastemail} = undef;
|
|
$cols{expiretime} = undef;
|
|
$cols{permanent} = 0; # has to be!
|
|
}
|
|
|
|
my $cols = join( ', ', map { "$_ = ?" } sort keys %cols );
|
|
my @bind = map { $cols{$_} } sort keys %cols;
|
|
|
|
my $ct = $dbh->do(
|
|
qq{
|
|
UPDATE dw_paidstatus SET $cols WHERE userid = ?
|
|
}, undef, @bind, $u->id
|
|
);
|
|
return error( ERR_FATAL, "Database error: " . $dbh->errstr )
|
|
if $dbh->err;
|
|
|
|
# if we got 0 rows edited, we have to insert a new row
|
|
if ( $ct == 0 ) {
|
|
|
|
# fail if we don't have some valid values
|
|
return error( ERR_FATAL, "Typeid must be some number and valid." )
|
|
unless $cols{typeid} =~ /^(?:\d+)$/ && DW::Pay::type_is_valid( $cols{typeid} );
|
|
|
|
# now try the insert
|
|
$dbh->do(
|
|
q{INSERT INTO dw_paidstatus (userid, typeid, expiretime, permanent, lastemail)
|
|
VALUES (?, ?, ?, ?, ?)},
|
|
undef, $u->id, $cols{typeid}, $cols{expiretime}, $cols{permanent} + 0, $cols{lastemail}
|
|
);
|
|
return error( ERR_FATAL, "Database error: " . $dbh->errstr )
|
|
if $dbh->err;
|
|
}
|
|
|
|
# and now, at this last step, we kick off a job to check if this user
|
|
# needs to have their search index setup/messed with.
|
|
if (@LJ::SPHINX_SEARCHD) {
|
|
DW::TaskQueue->dispatch(
|
|
DW::Task::SphinxCopier->new( { userid => $u->id, source => "paidstat" } ) );
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::edit_expiration_datetime
|
|
#
|
|
# ARGUMENTS: uuserid, expiration datetime
|
|
#
|
|
# uuserid required user object or userid to set paid status for
|
|
# datetime required new expiration datetime
|
|
#
|
|
# RETURN: undef on error, else 1 on success.
|
|
#
|
|
#
|
|
sub edit_expiration_datetime {
|
|
DW::Pay::clear_error();
|
|
|
|
my $u = LJ::want_user( shift() )
|
|
or return error( ERR_FATAL, "Invalid/not a user object." );
|
|
my $datetime = shift();
|
|
|
|
my $ps = DW::Pay::get_paid_status( $u, no_cache => 1 );
|
|
return error( ERR_FATAL, "Can't set expiration date for this type of account" )
|
|
if $ps->{expiresin} <= 0 || $ps->{permanent};
|
|
|
|
my $dbh = DW::Pay::get_db_writer()
|
|
or return error( ERR_TEMP, "Unable to get db writer." );
|
|
|
|
my $row = $dbh->selectrow_hashref( "SELECT UNIX_TIMESTAMP(?) AS datetime, ? < NOW() AS expired",
|
|
undef, $datetime, $datetime );
|
|
|
|
return error( ERR_FATAL, "Invalid expiration date/time" ) unless $row->{datetime};
|
|
return error( ERR_FATAL, "Expiration date/time is in the past" ) if $row->{expired};
|
|
return error( ERR_FATAL, "Expiration date/time is unchanged" )
|
|
if $row->{datetime} == $ps->{expiretime};
|
|
|
|
$dbh->do( q{UPDATE dw_paidstatus SET expiretime=? WHERE userid=?},
|
|
undef, $row->{datetime}, $u->id );
|
|
return error( ERR_FATAL, "Database error: " . $dbh->errstr )
|
|
if $dbh->err;
|
|
DW::Pay::expire_status_cache( $u->id );
|
|
return 1;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::num_permanent_accounts_available
|
|
#
|
|
# ARGUMENTS: none
|
|
#
|
|
# RETURN: number of permanent accounts that are still available for purchase
|
|
# -1 if there is no limit on how many permanent accounts can be
|
|
# purchased
|
|
#
|
|
sub num_permanent_accounts_available {
|
|
DW::Pay::clear_error();
|
|
|
|
return 0 unless $LJ::PERMANENT_ACCOUNT_LIMIT;
|
|
return -1 if $LJ::PERMANENT_ACCOUNT_LIMIT < 0;
|
|
|
|
# 1. figure out how many permanent accounts have been purchased
|
|
|
|
# try memcache first
|
|
my $ct = LJ::MemCache::get('numpermaccts');
|
|
|
|
unless ( defined $ct ) {
|
|
|
|
# not in memcache, so let's hit the database
|
|
# FIXME: add ddlockd so we don't hit the db in waves every 60 seconds
|
|
my $dbh = DW::Pay::get_db_writer()
|
|
or return error( ERR_TEMP, "Unable to get db writer." );
|
|
$ct = $dbh->selectrow_array('SELECT COUNT(*) FROM dw_paidstatus WHERE permanent = 1') + 0;
|
|
LJ::MemCache::set( 'numpermaccts', $ct, 60 );
|
|
}
|
|
|
|
# 2. figure out how many are left to purchase
|
|
|
|
my $num_available = $LJ::PERMANENT_ACCOUNT_LIMIT - $ct;
|
|
return $num_available > 0 ? $num_available : 0;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::num_permanent_accounts_available_estimated
|
|
#
|
|
# ARGUMENTS: none
|
|
#
|
|
# RETURN: estimated number of permanent accounts that are still available for
|
|
# purchase
|
|
# -1 if there is no limit on how many permanent accounts can be
|
|
# purchased
|
|
#
|
|
sub num_permanent_accounts_available_estimated {
|
|
my $num_available = DW::Pay::num_permanent_accounts_available();
|
|
return $num_available if $num_available < 1;
|
|
|
|
return 10 if $num_available <= 10;
|
|
return 25 if $num_available <= 25;
|
|
return 50 if $num_available <= 50;
|
|
return 100 if $num_available <= 100;
|
|
return 150 if $num_available <= 150;
|
|
return 200 if $num_available <= 200;
|
|
return 300 if $num_available <= 300;
|
|
return 400 if $num_available <= 400;
|
|
return 500;
|
|
}
|
|
|
|
################################################################################
|
|
# DW::Pay::get_random_active_free_user
|
|
#
|
|
# ARGUMENTS: journaltype = type (user 'P' or community 'C') of the requested
|
|
# user ('P' if not given)
|
|
# for_u = user that is requesting the random free user (remote if
|
|
# no user is given)
|
|
#
|
|
# RETURN: a random active free user that for_u can purchase a paid account for,
|
|
# or undef if there aren't any valid results
|
|
#
|
|
sub get_random_active_free_user {
|
|
my $journaltype = shift || 'P';
|
|
my $for_u = shift || LJ::get_remote();
|
|
|
|
my $dbr = LJ::get_db_reader();
|
|
my $rows = $dbr->selectall_arrayref(
|
|
q{SELECT userid, points FROM users_for_paid_accounts
|
|
WHERE journaltype = ? ORDER BY RAND() LIMIT 10},
|
|
{ Slice => {} }, $journaltype
|
|
);
|
|
|
|
my @active_us;
|
|
my $us = LJ::load_userids( map { $_->{userid} } @$rows );
|
|
foreach my $row (@$rows) {
|
|
my $userid = $row->{userid};
|
|
my $points = $row->{points};
|
|
my $u = $us->{$userid};
|
|
|
|
next unless $u && $u->is_visible;
|
|
next if $u->is_paid;
|
|
next unless $u->opt_randompaidgifts;
|
|
next if LJ::sysban_check( 'pay_user', $u->user );
|
|
if ( $journaltype eq 'P' ) {
|
|
next if $for_u && $u->equals($for_u);
|
|
next if $for_u && $u->has_banned($for_u);
|
|
}
|
|
|
|
# each point that a user has gives them an extra chance of being chosen out of the array
|
|
push @active_us, $u;
|
|
if ($points) {
|
|
foreach my $point ( 1 .. $points ) {
|
|
push @active_us, $u;
|
|
}
|
|
}
|
|
}
|
|
|
|
return undef unless scalar @active_us;
|
|
|
|
my @shuffled_us = List::Util::shuffle(@active_us);
|
|
|
|
return $shuffled_us[0];
|
|
}
|
|
|
|
################################################################################
|
|
################################################################################
|
|
################################################################################
|
|
|
|
# this internal method takes a user's paid status (which is the accurate record
|
|
# of what caps and things a user should have) and then updates their caps. i.e.,
|
|
# this method is used to make the user's actual caps reflect reality.
|
|
sub sync_caps {
|
|
my $u = LJ::want_user(shift)
|
|
or return error( ERR_FATAL, "Must provide a user to sync caps for." );
|
|
my $ps = DW::Pay::get_paid_status($u);
|
|
|
|
# calculate list of caps that we care about
|
|
my @bits = grep { $LJ::CAP{$_}->{_account_type} } keys %LJ::CAP;
|
|
my $default = DW::Pay::default_typeid();
|
|
|
|
# either they're free, or they expired (not permanent)
|
|
if ( DW::Pay::is_default_type($ps) ) {
|
|
|
|
# reset back to the default, and turn off all other bits; then set the
|
|
# email count to defined-but-0
|
|
$u->modify_caps( [$default], [ grep { $_ != $default } @bits ] );
|
|
DW::Pay::update_paid_status( $u, lastemail => 0 );
|
|
|
|
}
|
|
else {
|
|
# this is a really bad error we should never have... we can't
|
|
# handle this user
|
|
# FIXME: candidate for email-site-admins
|
|
return error( ERR_FATAL, "Unknown typeid." )
|
|
unless DW::Pay::type_is_valid( $ps->{typeid} );
|
|
|
|
# simply modify it to use the typeid specified, as typeids are bits... but
|
|
# turn off any other bits
|
|
$u->modify_caps( [ $ps->{typeid} ], [ grep { $_ != $ps->{typeid} } @bits ] );
|
|
DW::Pay::update_paid_status( $u, lastemail => undef );
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub error {
|
|
$DW::Pay::error_code = $_[0] + 0;
|
|
$DW::Pay::error_text = $_[1] || "Unknown error.";
|
|
return undef;
|
|
}
|
|
|
|
sub error_code {
|
|
return $DW::Pay::error_code;
|
|
}
|
|
|
|
sub error_text {
|
|
return $DW::Pay::error_text;
|
|
}
|
|
|
|
sub was_error {
|
|
return defined $DW::Pay::error_code;
|
|
}
|
|
|
|
sub clear_error {
|
|
$DW::Pay::error_code = $DW::Pay::error_text = undef;
|
|
}
|
|
|
|
sub get_db_reader {
|
|
|
|
# we always use the master, but perhaps we want to use a specific role for
|
|
# payments later? so we abstracted this...
|
|
return LJ::get_db_writer();
|
|
}
|
|
|
|
sub get_db_writer {
|
|
return LJ::get_db_writer();
|
|
}
|
|
|
|
# return whether we're allowed to buy something for another user
|
|
# retuning an error if we can't.
|
|
sub validate_target_user {
|
|
my ( $target_u, $remote ) = @_;
|
|
return { error => 'widget.shopitemoptions.error.invalidusername' }
|
|
unless LJ::isu($target_u);
|
|
|
|
return { error => 'widget.shopitemoptions.error.expungedusername' }
|
|
if $target_u->is_expunged;
|
|
|
|
return { error => 'widget.shopitemoptions.error.banned' }
|
|
if $remote && $target_u->has_banned($remote);
|
|
|
|
return { success => 1 };
|
|
}
|
|
|
|
sub for_self {
|
|
my ( $remote, $item_data ) = @_;
|
|
if ( $remote && $remote->is_personal ) {
|
|
$item_data->{target_userid} = $remote->id;
|
|
}
|
|
else {
|
|
return error_ml('widget.shopitemoptions.error.notloggedin');
|
|
}
|
|
}
|
|
|
|
sub for_gift {
|
|
my ( $remote, $target, $errors, $item_data ) = @_;
|
|
my $target_u = LJ::load_user($target);
|
|
my $user_check = validate_target_user( $target_u, $remote );
|
|
|
|
if ( defined $user_check->{error} ) {
|
|
$errors->add( 'username', $user_check->{error} );
|
|
}
|
|
else {
|
|
$item_data->{target_userid} = $target_u->id;
|
|
}
|
|
}
|
|
|
|
sub validate_deliverydate {
|
|
my ( $deliverydate, $errors, $item_data ) = @_;
|
|
$deliverydate =~ /(\d{4})-(\d{2})-(\d{2})/;
|
|
my $given_date = DateTime->new(
|
|
year => $1,
|
|
month => $2,
|
|
day => $3,
|
|
);
|
|
|
|
my $time_check = DateTime->compare( $given_date, DateTime->today );
|
|
|
|
if ( $time_check < 0 ) {
|
|
|
|
# we were given a date in the past
|
|
$errors->add_string( 'deliverydate', 'time cannot be in the past' ); #FIXME
|
|
}
|
|
elsif ( $time_check > 0 ) {
|
|
|
|
# date is in the future, add it.
|
|
$item_data->{deliverydate} = $given_date->date;
|
|
}
|
|
|
|
}
|
|
|
|
1;
|
|
|