1664 lines
59 KiB
Perl
1664 lines
59 KiB
Perl
# ==================================================================
|
|
# Gossamer Links - enhanced directory management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# CVS Info : 087,071,086,086,085
|
|
# Revision : $Id: Payment.pm,v 1.84 2012/02/02 08:51:47 brewt Exp $
|
|
#
|
|
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
|
|
# Redistribution in part or in whole strictly prohibited. Please
|
|
# see LICENSE file for full details.
|
|
# ==================================================================
|
|
|
|
# Terminology:
|
|
# payment_type: signup (0), renewal (1), recurring (2)
|
|
# payment_term: 1y, 2y, etc
|
|
# payment_method: PayPal, WorldPay, AuthorizeDotNet, Moneris, etc
|
|
# payment_method_type: direct or remote
|
|
|
|
package Links::Payment;
|
|
|
|
# Pragmas
|
|
use strict;
|
|
use vars qw/@ISA @EXPORT_OK %EXPORT_TAGS %Ptd %Lang_map/;
|
|
|
|
# Internal Modules
|
|
use Links qw/:objects :payment/;
|
|
use GT::AutoLoader;
|
|
use GT::Date qw/timelocal/;
|
|
use Exporter;
|
|
|
|
use constants
|
|
PENDING => 0,
|
|
COMPLETED => 1,
|
|
DECLINED => 2,
|
|
ERROR => 3,
|
|
|
|
INITIAL => 0,
|
|
RENEWAL => 1,
|
|
RECURRING => 2,
|
|
|
|
LOG_INFO => 0,
|
|
LOG_ACCEPTED => 1,
|
|
LOG_DECLINED => 2,
|
|
LOG_ERROR => 3,
|
|
LOG_MANUAL => 4;
|
|
|
|
|
|
@ISA = qw(Exporter Links); # Inherit from Exporter and Links
|
|
@EXPORT_OK = qw/PENDING COMPLETED DECLINED ERROR LOG_INFO LOG_ACCEPTED LOG_DECLINED LOG_ERROR LOG_MANUAL/;
|
|
%EXPORT_TAGS = (
|
|
status => [qw/PENDING COMPLETED DECLINED ERROR/],
|
|
log => [qw/LOG_INFO LOG_ACCEPTED LOG_DECLINED LOG_ERROR LOG_MANUAL/],
|
|
all => \@EXPORT_OK
|
|
);
|
|
|
|
%Ptd = (
|
|
d => 1,
|
|
w => 7,
|
|
m => 30,
|
|
y => 365
|
|
);
|
|
|
|
%Lang_map = (
|
|
d => 'DATE_UNIT_DAY',
|
|
w => 'DATE_UNIT_WEEK',
|
|
m => 'DATE_UNIT_MONTH',
|
|
y => 'DATE_UNIT_YEAR'
|
|
);
|
|
|
|
$COMPILE{method} = __LINE__ . <<'END_OF_SUB';
|
|
sub method {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
|
|
my $term = _check_term(scalar $IN->param('payment_term'));
|
|
return $self->error($term, 'WARN') unless ref $term;
|
|
my $methods;
|
|
if ($term->{recurring}) {
|
|
$methods = $self->methods(1, 1);
|
|
}
|
|
else {
|
|
$methods = $self->methods(0, 1);
|
|
}
|
|
return $self->error($term, 'WARN') unless ref $term;
|
|
|
|
# If we only have one usable payment method, just pass the user onto the
|
|
# payment form.
|
|
if (@{$methods->{payment_methods}} == 1) {
|
|
$IN->param(payment_method => ($methods->{payment_methods}->[0]->{payment_direct} ? "direct_" : "remote_") . $methods->{payment_methods}->[0]->{payment_method});
|
|
$IN->param(page => 'payment_form');
|
|
return $self->form();
|
|
}
|
|
|
|
return {
|
|
%$methods,
|
|
payment_name => $term->{name},
|
|
payment_description => $CFG->{payment}->{description},
|
|
payment_term => $term->{term},
|
|
payment_term_num => $term->{term_num},
|
|
payment_term_u => $term->{term_unit},
|
|
payment_term_unit => $term->{term_unit} && Links::language($Lang_map{$term->{term_unit}} . ($term->{term_num} != 1 ? 'S' : '')),
|
|
payment_amount => $term->{amount},
|
|
payment_type => $term->{recurring} ? 2 : $term->{type} eq 'renewal' ? 1 : 0,
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{form} = __LINE__ . <<'END_OF_SUB';
|
|
sub form {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
my @vars;
|
|
|
|
my $term = _check_term(scalar $IN->param('payment_term'));
|
|
return $self->error($term, 'WARN') unless ref $term;
|
|
my $payment_vars = {
|
|
payment_term => $term->{term},
|
|
payment_term_num => $term->{term_num},
|
|
payment_term_u => $term->{term_unit},
|
|
payment_term_unit => $term->{term_unit} && Links::language($Lang_map{$term->{term_unit}} . ($term->{term_num} != 1 ? 'S' : '')),
|
|
payment_amount => $term->{amount},
|
|
payment_type => $term->{recurring} ? 2 : 1,
|
|
payment_name => $term->{name},
|
|
payment_description => $CFG->{payment}->{description},
|
|
};
|
|
|
|
my $method = _check_method($term->{recurring}, scalar $IN->param('payment_method'), scalar $IN->param('payment_method_type'));
|
|
return $self->error($method, 'WARN', $payment_vars) unless ref($method);
|
|
|
|
my $method_info = _method($method->{method}, $method->{method_type} eq 'direct');
|
|
push @vars, {%$method_info};
|
|
|
|
if ($method->{method_type} eq 'remote') {
|
|
my $payment_unique = generate_unique_id();
|
|
my $link_id = $IN->param('link_id');
|
|
if (!$CFG->{user_required}) {
|
|
$DB->table('Links')->count({ ID => $link_id }) or return $self->error('PAYMENTERR_INVALIDLINKID', 'WARN');
|
|
}
|
|
elsif (!$DB->table('Links')->count({ ID => $link_id, LinkOwner => $USER->{Username} })) {
|
|
return $self->error('PAYMENTERR_INVALIDLINKID', 'WARN');
|
|
}
|
|
$DB->table('Payments')->insert({
|
|
payments_linkid => $link_id,
|
|
payments_id => $payment_unique,
|
|
payments_status => PENDING,
|
|
payments_method => $method->{method_type} . '_' . $method->{method},
|
|
payments_type => $term->{type} eq 'recurring' ? RECURRING : $term->{type} eq 'renewal' ? RENEWAL : INITIAL,
|
|
payments_amount => $term->{amount},
|
|
payments_term => $term->{term},
|
|
payments_start => time,
|
|
payments_last => time,
|
|
}) or die "Insert failed (No payment was charged): $GT::SQL::error";
|
|
push @vars, { unique_id => $payment_unique };
|
|
}
|
|
|
|
$payment_vars->{payment_method_type} = $method->{method_type};
|
|
push @vars, $payment_vars;
|
|
|
|
my $pkg = $method_info->{payment_package};
|
|
require $method_info->{payment_module};
|
|
my $meth_info = $pkg->can('payment_info') ? $pkg->payment_info() : {};
|
|
push @vars, {%$meth_info};
|
|
|
|
return { map { %$_ } @vars };
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{direct} = __LINE__ . <<'END_OF_SUB';
|
|
sub direct {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
|
|
my $term = _check_term(scalar $IN->param('payment_term'));
|
|
return $self->error($term, 'WARN') unless ref($term);
|
|
|
|
my $method = _check_method($term->{recurring}, scalar $IN->param('payment_method'), scalar $IN->param('payment_method_type'));
|
|
return $self->error($method, 'WARN') unless ref($method);
|
|
|
|
my $pkg = $CFG->{payment}->{$method->{method_type}}->{methods}->{$method->{method}}->{package};
|
|
require $CFG->{payment}->{$method->{method_type}}->{methods}->{$method->{method}}->{module};
|
|
|
|
my $payment_unique = generate_unique_id();
|
|
$IN->param(order_id => $payment_unique);
|
|
$IN->param(charge_total => $term->{amount});
|
|
my $verify = $pkg->verify();
|
|
# An array reference return value indicates that the fields in the array
|
|
# reference had incorrect values.
|
|
if (ref $verify eq 'ARRAY') {
|
|
my %errors;
|
|
for (@{$verify->[0]}, @{$verify->[1]}) {
|
|
$errors{$_ . "_error"}++;
|
|
}
|
|
if (exists $errors{credit_card_expiry_month_error} or exists $errors{credit_card_expiry_year_error}) {
|
|
$errors{credit_card_expiry_error}++;
|
|
}
|
|
return $self->error('PAYMENTERR_DIRECT', 'WARN', \%errors) if keys %errors;
|
|
}
|
|
|
|
my $pt = $DB->table('Payments');
|
|
my $pl = $DB->table('PaymentLogs');
|
|
my $link_id = $IN->param('link_id');
|
|
if (!$CFG->{user_required}) {
|
|
$DB->table('Links')->count({ ID => $link_id }) or return $self->error('PAYMENTERR_INVALIDLINKID', 'WARN');
|
|
}
|
|
elsif (!$DB->table('Links')->count({ ID => $link_id, LinkOwner => $USER->{Username} })) {
|
|
return $self->error('PAYMENTERR_INVALIDLINKID', 'WARN');
|
|
}
|
|
$pt->insert({
|
|
payments_linkid => $link_id,
|
|
payments_id => $payment_unique,
|
|
payments_status => PENDING,
|
|
payments_method => $method->{method_type} . '_' . $method->{method},
|
|
payments_type => $term->{type} eq 'recurring' ? RECURRING : $term->{type} eq 'renewal' ? RENEWAL : INITIAL,
|
|
payments_amount => $term->{amount},
|
|
payments_term => $term->{term},
|
|
payments_start => time,
|
|
payments_last => time,
|
|
}) or die "Insert failed (No payment was charged): $GT::SQL::error";
|
|
|
|
# Actually perform the direct payment:
|
|
my ($complete, $message, $receipt) = $pkg->complete();
|
|
if ($complete == 1) {
|
|
$pt->update({ payments_status => COMPLETED, payments_last => time }, { payments_id => $payment_unique });
|
|
$pl->insert({
|
|
paylogs_payments_id => $payment_unique,
|
|
paylogs_type => LOG_ACCEPTED,
|
|
paylogs_time => time,
|
|
paylogs_text => $message . "\n\nReceipt:\n$receipt"
|
|
});
|
|
process_payment($IN->param('link_id'), $term->{term}, 0);
|
|
}
|
|
elsif ($complete == 0) {
|
|
$pt->update({ payments_status => DECLINED, payments_last => time }, { payments_id => $payment_unique });
|
|
$pl->insert({
|
|
paylogs_payments_id => $payment_unique,
|
|
paylogs_type => LOG_DECLINED,
|
|
paylogs_time => time,
|
|
paylogs_text => $message
|
|
});
|
|
return $self->error('PAYMENTERR_DECLINED', 'WARN', { payment_declined => 1, payment_errmsg => $message });
|
|
}
|
|
else {
|
|
$pt->update({ payments_status => ERROR, payments_last => time }, { payments_id => $payment_unique });
|
|
$pl->insert({
|
|
paylogs_payments_id => $payment_unique,
|
|
paylogs_type => LOG_ERROR,
|
|
paylogs_time => time,
|
|
paylogs_text => $message
|
|
});
|
|
return $self->error('PAYMENTERR_DIRECT', 'WARN', { payment_erred => 1, payment_errmsg => $message });
|
|
}
|
|
|
|
return {};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{confirm} = __LINE__ . <<'END_OF_SUB';
|
|
sub confirm {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $self = shift;
|
|
return {};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_check_term} = __LINE__ . <<'END_OF_SUB';
|
|
sub _check_term {
|
|
# -----------------------------------------------------------------------------
|
|
# Checks that a payment term is valid and either returns an error string, or a hash
|
|
# of information that has been parsed from the input.
|
|
#
|
|
my $payment_term = shift;
|
|
my ($term, $term_num, $term_unit, $rec, $type, $lifetime, $cost);
|
|
my $cat_id = $IN->param('cat_id');
|
|
($cat_id =~ /^\d+$/) or return 'PAYMENTERR_INVALIDCATID';
|
|
my $conf = load_cat_price($cat_id); # load payment terms for this category
|
|
if ($payment_term) {
|
|
if ($payment_term =~ m/^(?:(\d+)([dwmy])|(\w+))(?:-(\w+))?$/) {
|
|
$term_num = $1;
|
|
$term_unit = $2;
|
|
$lifetime = $3;
|
|
$rec = $4;
|
|
$term = $term_num ? "$term_num$term_unit" : $lifetime;
|
|
}
|
|
if ($rec) {
|
|
$type = 'recurring';
|
|
}
|
|
else {
|
|
my $link_expiry = $DB->table('Links')->select(ExpiryDate => { ID => scalar $IN->param('link_id') })->fetchrow;
|
|
if ($link_expiry == UNPAID or $link_expiry == FREE) {
|
|
$type = 'signup'
|
|
}
|
|
else {
|
|
$type = 'renewal';
|
|
}
|
|
}
|
|
|
|
# Check that the payment term actually exists
|
|
if ($conf->{payment_mode} and $conf->{term_cnt}) {
|
|
my $cond;
|
|
$cond->{cp_cat_id_fk} = $cat_id;
|
|
$cond->{cp_term} = $term;
|
|
$rec and $cond->{cp_type} = '2';# 2 = recurring
|
|
my $db_term = $DB->table('CatPrice')->select($cond)->fetchrow_hashref;
|
|
$db_term or return 'PAYMENTERR_INVALIDTERM';
|
|
$cost = $db_term->{cp_cost};
|
|
}
|
|
else{
|
|
unless ((!$rec and exists $CFG->{payment}->{term}->{types}->{signup}->{$term}) or
|
|
(!$rec and exists $CFG->{payment}->{term}->{types}->{renewal}->{$term}) or
|
|
($rec and exists $CFG->{payment}->{term}->{types}->{recurring}->{$term})) {
|
|
return 'PAYMENTERR_INVALIDTERM';
|
|
}
|
|
$cost = ($type eq 'renewal' and !exists $CFG->{payment}->{term}->{types}->{$type}->{$term})
|
|
? $CFG->{payment}->{term}->{types}->{signup}->{$term}
|
|
: $CFG->{payment}->{term}->{types}->{$type}->{$term};
|
|
}
|
|
|
|
}
|
|
else {
|
|
return 'PAYMENTERR_NOLEVEL';
|
|
}
|
|
|
|
# Check payment discount and adjust the cost
|
|
my $discount = check_discount();
|
|
$discount and $cost and $cost = $cost * (100 - $discount->{percent}) / 100;
|
|
$cost = sprintf("%.2f", $cost);
|
|
return {
|
|
%$conf,
|
|
term => $payment_term,
|
|
term_num => $term_num,
|
|
term_unit => $term_unit,
|
|
recurring => $rec,
|
|
type => $type,
|
|
lifetime => $lifetime,
|
|
amount => $cost
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_check_method} = __LINE__ . <<'END_OF_SUB';
|
|
sub _check_method {
|
|
# -----------------------------------------------------------------------------
|
|
# Checks that a method is valid and either returns an error string, or a hash
|
|
# of information that has been parsed from the input.
|
|
#
|
|
# The first argument is whether or not the selected payment is a recurring
|
|
# type or not. The third argument, method_type_in, is optional. If it is not
|
|
# supplied, then method_in must be in format <type>_<method>.
|
|
#
|
|
my ($recurring, $method_in, $method_type_in) = @_;
|
|
|
|
my ($method_type, $method);
|
|
if ($method_in) {
|
|
if ($method_type_in) {
|
|
$method = $method_in;
|
|
$method_type = $method_type_in;
|
|
}
|
|
else {
|
|
($method_type, $method) = split(/_/, $method_in, 2);
|
|
}
|
|
unless (exists $CFG->{payment}->{$method_type} and exists $CFG->{payment}->{$method_type}->{used}->{$method}) {
|
|
return 'PAYMENTERR_INVALIDMETHOD';
|
|
}
|
|
|
|
if ($recurring and !$CFG->{payment}->{$method_type}->{methods}->{$method}->{recurring}) {
|
|
return 'PAYMENTERR_INVALIDMETHOD';
|
|
}
|
|
}
|
|
else {
|
|
return 'PAYMENTERR_NOMETHOD';
|
|
}
|
|
|
|
return {
|
|
method_type => $method_type,
|
|
method => $method,
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{load_config} = __LINE__ . <<'END_OF_SUB';
|
|
sub load_config {
|
|
# -----------------------------------------------------------------------------
|
|
# Loads information from config file, and returns it to a template.
|
|
#
|
|
my ($self) = @_;
|
|
my $conf;
|
|
my $term = {%{$CFG->{payment}->{term}}};
|
|
my $discount = check_discount();
|
|
for my $type (keys %{$term->{types}}) {
|
|
my @terms;
|
|
for my $item (sort { convert_to_days($a) <=> convert_to_days($b) } keys %{$term->{types}->{$type}}) {
|
|
my ($num, $unit) = $item =~ m/^(\d+)([dwmy])$/;
|
|
my $cost = $term->{types}->{$type}->{$item};
|
|
$discount and $cost and $cost = $cost*(100-$discount->{percent})/100;
|
|
push @terms, {
|
|
term => $item,
|
|
term_num => $num,
|
|
term_unit => $unit && Links::language($Lang_map{$unit} . ($num != 1 ? 'S' : '')),
|
|
cost => sprintf("%.2f", $cost),
|
|
};
|
|
}
|
|
|
|
$conf->{$type} = \@terms;
|
|
$conf->{"num_$type"} = @terms;
|
|
}
|
|
# If no renewal terms are defined, use the signup terms
|
|
if (not $conf->{renewal} or not $conf->{num_renewal}) {
|
|
$conf->{renewal} = [@{$conf->{signup}}];
|
|
for (my $i = 0; $i < @{$conf->{renewal}}; $i++) {
|
|
if ($conf->{renewal}->[$i]->{cost} == 0) {
|
|
splice @{$conf->{renewal}}, $i--, 1;
|
|
}
|
|
}
|
|
$conf->{num_renewal} = @{$conf->{renewal}};
|
|
$conf->{renewal_differs} = undef;
|
|
}
|
|
else {
|
|
$conf->{renewal_differs} = 1;
|
|
}
|
|
|
|
# Load discounts
|
|
my $discounts = $CFG->{payment}->{discounts};
|
|
my @payment_discounts;
|
|
for my $num (sort { $a <=> $b } keys %$discounts) {
|
|
push @payment_discounts, {
|
|
num => $num,
|
|
percent => $discounts->{$num}->{percent},
|
|
description => $discounts->{$num}->{description}
|
|
};
|
|
}
|
|
$conf->{payment_discounts} = \@payment_discounts if @payment_discounts;
|
|
|
|
# Load other info
|
|
$conf->{payment_enabled} = (
|
|
$CFG->{payment}->{enabled} and (
|
|
keys %{$CFG->{payment}->{remote}->{used}}
|
|
or
|
|
keys %{$CFG->{payment}->{direct}->{used}}
|
|
)
|
|
);
|
|
$conf->{payment_config_enabled} = $CFG->{payment}->{enabled};
|
|
$conf->{payment_mode} = $CFG->{payment}->{mode};
|
|
$conf->{payment_auto_validate} = $CFG->{payment}->{auto_validate};
|
|
$conf->{payment_description} = $CFG->{payment}->{description};
|
|
$conf->{payment_expiry_notify} = $CFG->{payment}->{expiry_notify};
|
|
$conf->{payment_expired_is_free} = $CFG->{payment}->{expired_is_free};
|
|
|
|
return $conf;
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{save_config} = __LINE__ . <<'END_OF_SUB';
|
|
sub save_config {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
|
|
|
|
my $save;
|
|
for (qw/enabled mode auto_validate description expired_is_free/) {
|
|
if ($CFG->{payment}->{$_} ne (my $v = $IN->param("payment_$_"))) {
|
|
$CFG->{payment}->{$_} = $v;
|
|
$save++;
|
|
}
|
|
}
|
|
if ($CFG->{payment}->{expiry_notify} ne (my $v = $IN->param('payment_expiry_notify') || 7)) {
|
|
$CFG->{payment}->{expiry_notify} = $v;
|
|
$save++;
|
|
}
|
|
|
|
# Handle any deletions
|
|
for ($IN->param('delete_discount')) {
|
|
if (exists $CFG->{payment}->{discounts}->{$_}) {
|
|
delete $CFG->{payment}->{discounts}->{$_};
|
|
$save++;
|
|
}
|
|
}
|
|
for my $p ($IN->param) {
|
|
if ($p =~ /^delete_(signup|renewal|recurring)$/) {
|
|
my $type = $1;
|
|
for my $item ($IN->param($p)) {
|
|
if (exists $CFG->{payment}->{term}->{types}->{$type}->{$item}) {
|
|
delete $CFG->{payment}->{term}->{types}->{$type}->{$item};
|
|
$save++;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Add new term
|
|
my $new_fee = $IN->param('signup_cost');
|
|
my $term_length = $IN->param('term_length');
|
|
my $term_unit = $IN->param('term_unit');
|
|
my $add_type = $IN->param('add_type') || 'signup';
|
|
my $trying = length($new_fee) + length($term_length);
|
|
my $ok;
|
|
|
|
if (!$trying or ($term_unit eq 'unlimited' and $add_type ne 'recurring') or (
|
|
$term_length =~ /^(\d+)$/ and $term_length > 0 and
|
|
$term_unit =~ /^[dwmy]$/)
|
|
) {
|
|
$ok = 1;
|
|
}
|
|
else {
|
|
return { payment_config_invalid_term => 1 };
|
|
}
|
|
if (!$trying or $new_fee =~ /^(\d+\.\d\d|\.\d\d|\d+)$/ and $new_fee > 0) {
|
|
$ok = 1;
|
|
}
|
|
else {
|
|
return { payment_config_invalid_fee => 1 };
|
|
}
|
|
if ($trying and $ok) {
|
|
$CFG->{payment}->{term}->{types}->{$add_type}->{$term_unit eq 'unlimited' ? 'unlimited' : "$term_length$term_unit"} = sprintf "%.2f", $new_fee;
|
|
$save++;
|
|
}
|
|
|
|
# Add a new payment discount
|
|
my $num_links = $IN->param('discount_num_links');
|
|
my $description = $IN->param('discount_description');
|
|
my $percent = scalar $IN->param('discount_percent') || 0;
|
|
if ($num_links or $percent) {
|
|
if (($num_links =~ /^(\d+)$/) and ($num_links > 1) and (($percent =~ /^(\d?\d)$/) and ($percent > 0) and ($percent < 100))) {
|
|
$CFG->{payment}->{discounts}->{$num_links} = {
|
|
description => $description,
|
|
percent => $percent
|
|
};
|
|
$save++;
|
|
}
|
|
else {
|
|
return { payment_config_invalid_discount => 1 };
|
|
}
|
|
}
|
|
$CFG->save() if $save;
|
|
return { config_saved_done => 1 };
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub direct_methods_used {
|
|
return (
|
|
$CFG->{payment}->{enabled} and
|
|
keys %{$CFG->{payment}->{direct}->{used}}
|
|
);
|
|
}
|
|
|
|
$COMPILE{cat_payment_info} = __LINE__ . <<'END_OF_SUB';
|
|
sub cat_payment_info {
|
|
# -----------------------------------------------------------------------------
|
|
# Loads payment mode from database for a specific category or from global config.
|
|
# Used in displaying a category or search_results function
|
|
# IN : Category ID
|
|
# OUT: mode => 0|1|2 (Not Accepted|Optional|Required)
|
|
# or error => Error messages
|
|
#
|
|
my $cat_id = shift;
|
|
my $ret;
|
|
$ret->{mode} = $CFG->{payment}->{mode};
|
|
|
|
# Get category info
|
|
if ($cat_id =~ /^\d+$/) {
|
|
my $cat = $DB->table('Category')->get($cat_id) or return { error => Links::language('PAYMENTERR_INVALIDCATID') };
|
|
$cat->{Payment_Mode} and $ret->{mode} = $cat->{Payment_Mode};
|
|
}
|
|
return $ret;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{load_cat_price} = __LINE__ . <<'END_OF_SUB';
|
|
sub load_cat_price {
|
|
# -----------------------------------------------------------------------------
|
|
# Loads payment terms from database for a particular category and returns it to a template.
|
|
#
|
|
my ($cat_id) = @_;
|
|
my $data;
|
|
my $out;
|
|
|
|
if (ref $cat_id and @$cat_id == 1) {
|
|
$cat_id = $cat_id->[0];
|
|
}
|
|
# If more than one category is passed in, then a single category needs to be chosen.
|
|
elsif (ref $cat_id) {
|
|
my $category = $DB->table('Category');
|
|
# Order the results so we get consistent results
|
|
$category->select_options('ORDER BY ID');
|
|
my $sth = $category->select('ID', 'Payment_Mode', { ID => $cat_id });
|
|
my $modes;
|
|
while (my $row = $sth->fetchrow_hashref) {
|
|
push @{$modes->{$row->{Payment_Mode}}}, $row->{ID};
|
|
if ($row->{Payment_Mode} == GLOBAL) {
|
|
push @{$modes->{$CFG->{payment}->{mode}}}, $row->{ID};
|
|
}
|
|
}
|
|
|
|
# Choose the global payment terms over custom one which a global payment term exists
|
|
if (exists $modes->{REQUIRED . ''}) {
|
|
if ($CFG->{payment}->{mode} == REQUIRED and exists $modes->{GLOBAL . ''}) {
|
|
$cat_id = $modes->{GLOBAL . ''}->[0];
|
|
}
|
|
else {
|
|
$cat_id = $modes->{REQUIRED . ''}->[0];
|
|
}
|
|
}
|
|
elsif (exists $modes->{OPTIONAL . ''}) {
|
|
if ($CFG->{payment}->{mode} == OPTIONAL and exists $modes->{GLOBAL . ''}) {
|
|
$cat_id = $modes->{GLOBAL . ''}->[0];
|
|
}
|
|
else {
|
|
$cat_id = $modes->{OPTIONAL . ''}->[0];
|
|
}
|
|
}
|
|
elsif (exists $modes->{NOT_ACCEPTED . ''}) {
|
|
$cat_id = $modes->{NOT_ACCEPTED . ''}->[0];
|
|
}
|
|
}
|
|
|
|
# Get category info
|
|
($cat_id =~ /^\d+$/) or return { payment_invalid_cat_id => 1 };
|
|
$out = $DB->table('Category')->select({ ID => $cat_id })->fetchrow_hashref;
|
|
# Only check for existing category payment terms if the category's Payment_Mode isn't using the global terms
|
|
if ($out->{Payment_Mode}) {
|
|
$out->{term_cnt} = $DB->table('CatPrice')->count({ 'cp_cat_id_fk' => $cat_id });
|
|
}
|
|
# Payment_Mode allows the category to override the global setting (0 = use global setting)
|
|
$out->{payment_mode} = $out->{Payment_Mode} || $CFG->{payment}->{mode};
|
|
$out->{payment_description} = $CFG->{payment}->{description};
|
|
|
|
# If we need to check global config, or if no payments are defined for this category
|
|
if (!$IN->param('not_global') and (!$out->{Payment_Mode} or !$out->{term_cnt})) {
|
|
my $conf = load_config();
|
|
foreach (keys %$conf) {
|
|
!exists $out->{$_} and $out->{$_} = $conf->{$_}
|
|
}
|
|
}
|
|
# Otherwise load info from database
|
|
else {
|
|
my $db = $DB->table('CatPrice');
|
|
my $sth = $db->select({ 'cp_cat_id_fk' => $cat_id });
|
|
while (my $term = $sth->fetchrow_hashref) {
|
|
push @$data => _get_term($term);
|
|
}
|
|
for my $type (qw/signup renewal recurring/) {
|
|
my @terms = grep {$_->{type} eq $type} sort { convert_to_days($a->{term}) <=> convert_to_days($b->{term}) } @$data;
|
|
$out->{$type} = \@terms if @terms;
|
|
$out->{"num_$type"} = @terms;
|
|
}
|
|
|
|
# If no renewal terms are defined, use the signup terms
|
|
if (not $out->{renewal} or not $out->{num_renewal}) {
|
|
$out->{renewal} = [@{$out->{signup}}];
|
|
for (my $i = 0; $i < @{$out->{renewal}}; $i++) {
|
|
if ($out->{renewal}->[$i]->{cost} == 0) {
|
|
splice @{$out->{renewal}}, $i--, 1;
|
|
}
|
|
}
|
|
$out->{num_renewal} = @{$out->{renewal}};
|
|
$out->{renewal_differs} = undef;
|
|
}
|
|
else {
|
|
$out->{renewal_differs} = 1;
|
|
}
|
|
}
|
|
|
|
# Return some values for using in templates
|
|
$out->{cat_id} = $cat_id;
|
|
my $discount = check_discount();
|
|
defined $discount->{percent} and $out->{discount_percent} = $discount->{percent};
|
|
defined $discount->{description} and $out->{discount_description} = $discount->{description};
|
|
|
|
return $out;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{save_cat_price} = __LINE__ . <<'END_OF_SUB';
|
|
sub save_cat_price {
|
|
# -----------------------------------------------------------------------------
|
|
# Store payment terms for a particular category into database
|
|
#
|
|
|
|
my $cgi = $IN->get_hash;
|
|
my $save;
|
|
my $dels = $cgi->{delete_term};
|
|
ref $dels or $dels = [$dels];
|
|
foreach my $id (@$dels) {
|
|
$DB->table('CatPrice')->delete($id) and $save++;
|
|
}
|
|
# Add new term
|
|
my $new_fee = $IN->param('signup_cost');
|
|
my $term_length = $IN->param('term_length');
|
|
my $term_unit = $IN->param('term_unit');
|
|
my $add_type = $IN->param('add_type') || 'signup';
|
|
my $trying = length($new_fee) + length($term_length);
|
|
my $ok;
|
|
my $cat_id = $IN->param('ID');
|
|
($cat_id =~ /^\d+$/) or return { payment_invalid_cat_id => 1 };
|
|
|
|
# Copy global terms
|
|
if ($IN->param('copy_global')) {
|
|
my $types = $CFG->{payment}->{term}->{types};
|
|
foreach my $type (keys %$types) {
|
|
my $cp_type = $type eq 'recurring' ? 2 : $type eq 'renewal' ? 1 : 0;
|
|
foreach my $term (keys %{$types->{$type}}) {
|
|
my $new_term;
|
|
$new_term->{cp_term} = $term;
|
|
$new_term->{cp_cat_id_fk} = $cat_id;
|
|
$new_term->{cp_type} = $cp_type;
|
|
$DB->table('CatPrice')->count($new_term) and next ;
|
|
$new_term->{cp_cost} = sprintf "%.2f", $types->{$type}->{$term};
|
|
$DB->table('CatPrice')->add($new_term) or die "$GT::SQL::error";
|
|
}
|
|
}
|
|
return { config_copied_done => 1};
|
|
}
|
|
|
|
|
|
if (!$trying or ($term_unit eq 'unlimited' and $add_type ne 'recurring') or (
|
|
$term_length =~ /^(\d+)$/ and $term_length > 0 and
|
|
$term_unit =~ /^[dwmy]$/)
|
|
) {
|
|
$ok = 1;
|
|
}
|
|
else {
|
|
return { payment_config_invalid_term => 1 };
|
|
}
|
|
if (!$trying or $new_fee =~ /^(\d+\.\d\d|\.\d\d|\d+)$/ and $new_fee > 0) {
|
|
my $term_cnt = $DB->table('CatPrice')->count({
|
|
cp_term => $term_unit eq 'unlimited' ? 'unlimited' : "$term_length$term_unit",
|
|
cp_cat_id_fk => $cat_id,
|
|
cp_type => $add_type eq 'recurring' ? 2 : $add_type eq 'renewal' ? 1 : 0
|
|
});
|
|
$term_cnt and return { payment_term_exists => 1 };
|
|
$ok = 1;
|
|
}
|
|
else {
|
|
return { payment_config_invalid_fee => 1 };
|
|
}
|
|
if ($trying and $ok) {
|
|
my $input;
|
|
$input->{cp_cat_id_fk} = $cat_id;
|
|
$input->{cp_type} = $add_type eq 'recurring' ? 2 : $add_type eq 'renewal' ? 1 : 0;
|
|
$input->{cp_term} = $term_unit eq 'unlimited' ? 'unlimited' : "$term_length$term_unit";
|
|
$input->{cp_cost} = sprintf "%.2f", $new_fee;
|
|
my $cp_id = $DB->table('CatPrice')->add($input) or die "$GT::SQL::error";
|
|
$save++;
|
|
}
|
|
$save and return { config_saved_done => 1};
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{check_expiry_date} = __LINE__ . <<'END_OF_SUB';
|
|
sub check_expiry_date {
|
|
# -----------------------------------------------------------------------------
|
|
# Make sure that the ExpiryDate of a link is valid for the category/categories
|
|
# that the link is in.
|
|
#
|
|
# A link ID or a hash of link data (that has the original ExpiryDate) is
|
|
# required and the array ref of categories the link is in is optional. A new
|
|
# ExpiryDate is returned if the current one is invalid.
|
|
#
|
|
my ($link, $cats) = @_;
|
|
|
|
if ($CFG->{payment}->{enabled}) {
|
|
$link = ref $link ? $link : $DB->table('Links')->select('ExpiryDate', { ID => $link })->fetchrow;
|
|
$cats ||= [$IN->param('CatLinks.CategoryID')];
|
|
|
|
my $modes;
|
|
my $category = $DB->table('Category');
|
|
$category->select_options('GROUP BY Payment_Mode');
|
|
my $sth = $category->select('Payment_Mode', { ID => $cats });
|
|
while (defined(my $mode = $sth->fetchrow)) {
|
|
$modes->{$mode == GLOBAL ? $CFG->{payment}->{mode} : $mode}++;
|
|
}
|
|
|
|
# If any of the categories the link is in requires payment, then payment is required
|
|
if (exists $modes->{REQUIRED . ''}) {
|
|
# Every ExpiryDate value is valid except for FREE
|
|
return UNPAID if $link->{ExpiryDate} == FREE;
|
|
}
|
|
# Payments are optional in one or more categories, ExpiryDate can be set to anything
|
|
elsif (exists $modes->{OPTIONAL . ''}) {
|
|
return;
|
|
}
|
|
# No payments are accepted for any of the categories, the ExpiryDate should be set to FREE
|
|
elsif (exists $modes->{NOT_ACCEPTED . ''}) {
|
|
return FREE if $link->{ExpiryDate} != FREE;
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub _get_term {
|
|
# -----------------------------------------------------------------------------
|
|
# Prepare a term (from database) to return to the template
|
|
#
|
|
my $term = shift;
|
|
my $ret;
|
|
($ret->{term_num}, $ret->{term_unit}) = $term->{cp_term} =~ m/^(\d+)([dwmy])$/;
|
|
$ret->{term} = $term->{cp_term};
|
|
$ret->{term_unit} = $ret->{term_unit} && Links::language($Lang_map{$ret->{term_unit}} . ($ret->{term_num} != 1 ? 'S' : ''));
|
|
my $discount = check_discount();
|
|
$discount and $term->{cp_cost} and $term->{cp_cost} = $term->{cp_cost}*(100-$discount->{percent})/100;
|
|
$ret->{cost} = sprintf("%.2f", $term->{cp_cost});
|
|
$ret->{type} = $term->{cp_type} eq '2' ? 'recurring' : $term->{cp_type} eq '1' ? 'renewal' : 'signup';
|
|
$ret->{cp_id} = $term->{cp_id};
|
|
return $ret;
|
|
}
|
|
|
|
|
|
$COMPILE{methods} = __LINE__ . <<'END_OF_SUB';
|
|
sub methods {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns template loop variables 'payment_methods'. Loop variables available:
|
|
# payment_direct: 1 (direct) or 0 (remote)
|
|
# payment_name: 'Authorize.Net', 'Moneris', 'PayPal', et cetera
|
|
# payment_module: 'AuthorizeDotNet', 'Moneris', 'PayPal', et cetera
|
|
# payment_used: 1 (used), 0 (not used)
|
|
#
|
|
# You may optionally pass in a true value in order to only return payment
|
|
# methods capable of handling recurring payments. A second value, if true,
|
|
# indicates that you want only enabled methods.
|
|
#
|
|
my ($self, $want_recurring, $want_used) = @_;
|
|
my @methods;
|
|
my ($used_direct, $used_remote) = (0, 0);
|
|
my ($d, $r) = @{$CFG->{payment}}{'direct', 'remote'};
|
|
|
|
for my $w ($d, $r) {
|
|
for (sort keys %{$w->{methods}}) {
|
|
my $method = _method($_, $w == $d ? 1 : 0);
|
|
push @methods, $method if
|
|
(not $want_recurring or $method->{payment_recurring}) # want_recurring -> payment_recurring
|
|
and
|
|
(not $want_used or $method->{payment_used}); # want_used -> payment_used
|
|
}
|
|
}
|
|
|
|
for (@methods) { $_->{payment_direct} ? $used_direct++ : $used_remote++ if $_->{payment_used} }
|
|
|
|
return {
|
|
payment_methods => \@methods,
|
|
direct_methods => scalar keys %{$d->{methods}},
|
|
direct_methods_used => $used_direct,
|
|
direct_methods_unused => keys(%{$d->{methods}}) - $used_direct,
|
|
remote_methods => scalar keys %{$r->{methods}},
|
|
remote_methods_used => $used_remote,
|
|
remote_methods_unused => keys(%{$r->{methods}}) - $used_remote
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_method} = __LINE__ . <<'END_OF_SUB';
|
|
sub _method {
|
|
# -----------------------------------------------------------------------------
|
|
# Takes two arguments - the first is the payment scheme (AuthorizeDotNet,
|
|
# PayPal, etc.) and the second is a boolean indicating whether you are looking
|
|
# for a "direct" payment method - true means direct, false means remote.
|
|
#
|
|
my ($method_name, $direct) = @_;
|
|
my $p = $CFG->{payment}->{$direct ? 'direct' : 'remote'};
|
|
return unless exists $p->{methods}->{$method_name};
|
|
my $method = {
|
|
payment_types => [@{$p->{methods}->{$method_name}->{types}}],
|
|
payment_module => $p->{methods}->{$method_name}->{module},
|
|
payment_package => $p->{methods}->{$method_name}->{package},
|
|
payment_recurring => $p->{methods}->{$method_name}->{recurring}
|
|
};
|
|
if ($direct) {
|
|
$method->{payment_direct} = 1;
|
|
$method->{_lang_prefix} = 'DIRECT';
|
|
}
|
|
else {
|
|
$method->{payment_direct} = 0;
|
|
$method->{_lang_prefix} = 'REMOTE';
|
|
}
|
|
|
|
$method->{payment_method} = $method_name;
|
|
$method->{payment_name} = Links::language("PAYMENT_$method->{_lang_prefix}_$method_name");
|
|
$method->{payment_description} = Links::language("PAYMENT_$method->{_lang_prefix}_${method_name}_description");
|
|
for (@{$method->{payment_types}}) {
|
|
$_ = {
|
|
code => $_,
|
|
name => Links::language("PAYMENT_TYPE_$_")
|
|
};
|
|
}
|
|
|
|
if (Links::language("PAYMENT_$method->{_lang_prefix}_${method_name}_notes")) {
|
|
$method->{payment_notes} = Links::language("PAYMENT_$method->{_lang_prefix}_${method_name}_notes");
|
|
}
|
|
|
|
if (Links::language("PAYMENT_URL_$method->{_lang_prefix}_$method_name")) {
|
|
$method->{payment_url} = Links::language("PAYMENT_URL_$method->{_lang_prefix}_$method_name");
|
|
}
|
|
|
|
my $used = exists $CFG->{payment}->{$method->{payment_direct} ? 'direct' : 'remote'}->{used}->{$method_name};
|
|
$method->{payment_used} = $used ? 1 : 0;
|
|
delete $method->{_lang_prefix};
|
|
$method;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{add_method} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_method {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $method = $IN->param('method');
|
|
my $type = $IN->param('type');
|
|
my ($d, $r) = @{$CFG->{payment}}{'direct', 'remote'};
|
|
|
|
if ($type eq 'direct') {
|
|
if (not exists $d->{methods}->{$method}) { return { method_invalid => 1 } }
|
|
}
|
|
elsif ($type eq 'remote') {
|
|
if (not exists $r->{methods}->{$method}) { return { method_invalid => 1 } }
|
|
}
|
|
else { return { method_invalid => 1 } }
|
|
|
|
my $p = _method($method, $type eq 'direct');
|
|
my $modifying = $IN->param('modify');
|
|
|
|
if (!$p) {
|
|
return { method_invalid => 1 };
|
|
}
|
|
elsif ($p->{payment_used} and not $modifying) {
|
|
return { method_used => 1 };
|
|
}
|
|
|
|
eval { require $p->{payment_module} };
|
|
if ($@) {
|
|
my $reason = $@;
|
|
$reason =~ s/\n/<br>\n/g;
|
|
return { method_failed => 1, method_failed_reason => \$reason };
|
|
}
|
|
my $pkg = $p->{payment_package};
|
|
|
|
my $ret = { %$p };
|
|
|
|
my @required = $pkg->required();
|
|
my @optional = $pkg->optional();
|
|
|
|
my $lang_prefix = 'PAYMENT_' . ($type eq 'direct' ? 'DIRECT_' : 'REMOTE_');
|
|
for my $f (\@required, \@optional) {
|
|
for (my $i = 0; $i < @$f; $i += 2) {
|
|
my ($field, $spec) = @$f[$i, $i + 1];
|
|
|
|
my $opt = {
|
|
%$spec,
|
|
field => $field,
|
|
field_title => Links::language("$lang_prefix${method}_$field"),
|
|
field_description => Links::language("$lang_prefix${method}_${field}_description"),
|
|
};
|
|
if ($modifying and exists $CFG->{payment}->{$type}->{used}->{$method}->{$field}) {
|
|
$opt->{field_value} = $CFG->{payment}->{$type}->{used}->{$method}->{$field};
|
|
}
|
|
|
|
delete $opt->{options};
|
|
if (ref $spec->{options} eq 'ARRAY') {
|
|
for (my $o = 0; $o < @{$spec->{options}}; $o += 2) {
|
|
push @{$opt->{options}}, { value => $spec->{options}->[$o], string => $spec->{options}->[$o + 1] };
|
|
}
|
|
}
|
|
|
|
push @{$ret->{$f == \@required ? 'required_fields' : 'optional_fields'}}, $opt;
|
|
}
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{add_method_submit} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_method_submit {
|
|
# -----------------------------------------------------------------------------
|
|
# Tasks to perform here: Check that all required fields are set, and make sure
|
|
# they have valid values. Check that any optional fields set have valid values.
|
|
# If it all checks out, save it in $CFG->{payment}.
|
|
#
|
|
|
|
my $type = $IN->param('type');
|
|
my $method_name = $IN->param('method');
|
|
my $method = _method($method_name, $type eq 'direct');
|
|
if (!$method) {
|
|
return {
|
|
method_success => undef,
|
|
method_invalid => 1
|
|
};
|
|
}
|
|
elsif ($method->{payment_used} and not $IN->param('modify')) {
|
|
return {
|
|
method_success => undef,
|
|
method_used => 1
|
|
};
|
|
}
|
|
|
|
eval { require $method->{payment_module} };
|
|
if ($@) {
|
|
my $reason = $@;
|
|
$reason =~ s/\n/<br>\n/g;
|
|
return {
|
|
method_success => undef,
|
|
method_failed => 1,
|
|
method_failed_reason => \$reason
|
|
};
|
|
}
|
|
my $pkg = $method->{payment_package};
|
|
|
|
my @required = $pkg->required();
|
|
my @optional = $pkg->optional();
|
|
|
|
my (%settings, %missing, %opt_invalid);
|
|
for (my $i = 0; $i < @required; $i += 2) {
|
|
my $val = $IN->param($required[$i]);
|
|
my $langed = Links::language('PAYMENT_' . ($type eq 'direct' ? 'DIRECT' : 'REMOTE') . "_${method_name}_$required[$i]");
|
|
my $info = $required[$i + 1];
|
|
if ($info->{type} eq 'SELECT' or $info->{type} eq 'RADIO') {
|
|
my $good;
|
|
for (my $i = 0; $i < @{$info->{options}}; $i += 2) {
|
|
if ($val eq $info->{options}->[$i]) {
|
|
$good = 1;
|
|
last;
|
|
}
|
|
}
|
|
if (!$good) {
|
|
$missing{$required[$i]} = sprintf Links::language('PAYMENT_ADD_NONE') => $langed;
|
|
}
|
|
elsif ($val eq 'custom' and $info->{custom}) {
|
|
my $custom_val = $IN->param("$required[$i]_custom");
|
|
if ($info->{valid} and $custom_val !~ /$info->{valid}/) {
|
|
$missing{$required[$i]} = sprintf Links::language('PAYMENT_ADD_INVALID') => $langed, $custom_val;
|
|
}
|
|
elsif ($custom_val !~ /\S/) {
|
|
$missing{$required[$i]} = sprintf Links::language('PAYMENT_ADD_NONE') => $langed;
|
|
}
|
|
|
|
$settings{"$required[$i]_custom"} = $custom_val unless $missing{$required[$i]};
|
|
}
|
|
}
|
|
elsif ($info->{type} eq 'YESNO') {
|
|
if (defined $val and $val eq '1' || $val eq '0') {
|
|
$val = $val ? 1 : 0;
|
|
}
|
|
else {
|
|
$missing{$required[$i]} = sprintf Links::language('PAYMENT_ADD_NONE') => $langed;
|
|
}
|
|
}
|
|
else {
|
|
if ($info->{valid}) {
|
|
if ($val !~ /$info->{valid}/) {
|
|
$missing{$required[$i]} = sprintf Links::language('PAYMENT_ADD_INVALID') => $langed, $val;
|
|
}
|
|
}
|
|
elsif ($val !~ /\S/) {
|
|
$missing{$required[$i]} = sprintf Links::language('PAYMENT_ADD_NONE') => $langed;
|
|
}
|
|
}
|
|
$settings{$required[$i]} = $val unless exists $missing{$required[$i]};
|
|
}
|
|
|
|
for (my $i = 0; $i < @optional; $i += 2) {
|
|
my $val = $IN->param($optional[$i]);
|
|
defined($val) and $val =~ /\S/ or next;
|
|
my $langed = Links::language('PAYMENT_' . ($type eq 'direct' ? 'DIRECT' : 'REMOTE') . "_${method_name}_$optional[$i]");
|
|
my $info = $optional[$i + 1];
|
|
if ($info->{type} eq 'SELECT' or $info->{type} eq 'RADIO') {
|
|
my $good;
|
|
for (my $i = 0; $i < @{$info->{options}}; $i += 2) {
|
|
if ($val eq $info->{options}->[$i]) {
|
|
$good = 1;
|
|
last;
|
|
}
|
|
}
|
|
unless ($good) {
|
|
$opt_invalid{$optional[$i]} = sprintf Links::language('PAYMENT_ADD_OPT_INVALID') => $langed;
|
|
}
|
|
}
|
|
elsif ($info->{type} eq 'YESNO') {
|
|
$val = $val ? 1 : 0;
|
|
}
|
|
else {
|
|
if ($info->{valid}) {
|
|
if ($val !~ /$info->{valid}/) {
|
|
$opt_invalid{$optional[$i]} = sprintf Links::language('PAYMENT_ADD_INVALID') => $langed, $val;
|
|
}
|
|
}
|
|
}
|
|
$settings{$optional[$i]} = $val unless exists $opt_invalid{$optional[$i]};
|
|
}
|
|
|
|
if (keys %opt_invalid or keys %missing) {
|
|
my $ret = { %{add_method()} };
|
|
$ret->{method_success} = undef;
|
|
$ret->{method_insufficient} = \join '<br>', values %missing, values %opt_invalid;
|
|
for (@{$ret->{required_fields}}) {
|
|
if (exists $missing{$_->{field}}) {
|
|
$_->{missing} = 1;
|
|
}
|
|
$_->{field_value} = $IN->param($_->{field});
|
|
}
|
|
for (@{$ret->{optional_fields}}) {
|
|
if (exists $opt_invalid{$_->{field}}) {
|
|
$_->{invalid} = 1;
|
|
}
|
|
$_->{field_value} = $IN->param($_->{field});
|
|
}
|
|
return $ret;
|
|
}
|
|
|
|
$CFG->{payment}->{$type eq 'direct' ? 'direct' : 'remote'}->{used}->{$method_name} = \%settings;
|
|
|
|
$CFG->save();
|
|
|
|
return { %$method, method_success => 1 };
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{remove_method} = __LINE__ . <<'END_OF_SUB';
|
|
sub remove_method {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $method = $IN->param('method');
|
|
my $type = $IN->param('type');
|
|
|
|
return { method_invalid => 1 } if
|
|
$type ne 'direct' and $type ne 'remote' or
|
|
not exists $CFG->{payment}->{$type eq 'direct' ? 'direct' : 'remote'}->{methods}->{$method};
|
|
return { method_not_used => 1 }
|
|
if not exists $CFG->{payment}->{$type eq 'direct' ? 'direct' : 'remote'}->{used}->{$method};
|
|
|
|
my $p = _method($method, $type eq 'direct');
|
|
|
|
if (!$p) {
|
|
return { method_invalid => 1 };
|
|
}
|
|
elsif (not $p->{payment_used}) {
|
|
return { method_not_used => 1 };
|
|
}
|
|
|
|
|
|
if ($IN->param('confirm')) {
|
|
my %ret = (method_removed => 1);
|
|
delete $CFG->{payment}->{$type}->{used}->{$method};
|
|
|
|
if ($CFG->{payment}->{enabled} and
|
|
!keys %{$CFG->{payment}->{remote}->{used}} and
|
|
!keys %{$CFG->{payment}->{direct}->{used}}) {
|
|
$ret{no_methods_left}++;
|
|
}
|
|
|
|
$CFG->save();
|
|
return \%ret;
|
|
}
|
|
else {
|
|
return $p;
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{recurring_enabled} = __LINE__ . <<'END_OF_SUB';
|
|
sub recurring_enabled {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns whether or not recurring payments can be accepted.
|
|
#
|
|
# There are two requirements:
|
|
# - Recurring term must be defined for a particular category in Database section
|
|
# - A payment method supporting recurring payments must be configured.
|
|
#
|
|
my $recurring_method;
|
|
# Look for an enabled method which supports recurring payments
|
|
for my $which (qw/remote direct/) {
|
|
for my $meth (keys %{$CFG->{payment}->{$which}->{used}}) {
|
|
if ($CFG->{payment}->{$which}->{methods}->{$meth}->{recurring}) {
|
|
$recurring_method = 1;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
my $recurring;
|
|
if (exists $CFG->{payment}->{term}->{types}->{recurring} and keys %{$CFG->{payment}->{term}->{types}->{recurring}}) {
|
|
$recurring = 1;
|
|
}
|
|
|
|
return $recurring && $recurring_method;
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{log_counts} = __LINE__ . <<'END_OF_SUB';
|
|
sub log_counts {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns a number of template variables related to the number of entries in
|
|
# the payment logs.
|
|
#
|
|
my $PaymentLog = $DB->table('PaymentLogs');
|
|
$PaymentLog->select_options('GROUP BY paylogs_viewed, paylogs_type');
|
|
my $sth = $PaymentLog->select('paylogs_viewed', 'paylogs_type', 'COUNT(*)');
|
|
|
|
my %map = ( # Using ',' instead of '=>' because these are constants, not strings
|
|
LOG_ACCEPTED, 'num_successful',
|
|
LOG_DECLINED, 'num_declined',
|
|
LOG_INFO, 'num_info',
|
|
LOG_ERROR, 'num_error',
|
|
LOG_MANUAL, 'num_manual'
|
|
);
|
|
|
|
my $ret;
|
|
while (my ($viewed, $type, $count) = $sth->fetchrow) {
|
|
next unless exists $map{$type};
|
|
$ret->{$viewed ? $map{$type} : "$map{$type}_unviewed"} = $count;
|
|
}
|
|
return $ret;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{view_log} = __LINE__ . <<'END_OF_SUB';
|
|
sub view_log {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
my $log_type = shift;
|
|
my $tables = $DB->table('PaymentLogs', 'Payments', 'Links');
|
|
|
|
my ($limit, $offset, $page) = Links::limit_offset(scalar $IN->param('mh'), scalar $IN->param('pg'), 50);
|
|
|
|
my $count = $tables->count({ paylogs_type => $log_type });
|
|
|
|
$tables->select_options("ORDER BY paylogs_time DESC", "LIMIT $limit OFFSET $offset");
|
|
my $results = $tables->select(defined $log_type ? ({ paylogs_type => $log_type }) : ())->fetchall_hashref;
|
|
my @viewing = map $_->{paylogs_id}, @$results;
|
|
|
|
$DB->table('PaymentLogs')->update({ paylogs_viewed => 1 }, { paylogs_id => \@viewing });
|
|
return { db_prefix => $DB->prefix, log_type => $log_type, logs => $results, num_logs => $count, page => $page, mh => $limit };
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{delete_log} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_log {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
|
|
my $id = shift;
|
|
my %ret;
|
|
if ($id =~ /\D/) {
|
|
$ret{error} = Links::language('PAYLOG_INVALID_ID');
|
|
}
|
|
else {
|
|
my $logs = $DB->table('PaymentLogs');
|
|
my $deleted = $logs->delete({ paylogs_id => $id });
|
|
if ($deleted > 0) {
|
|
$ret{message} = Links::language('PAYLOG_DEL_SUCCESS');
|
|
}
|
|
else {
|
|
$ret{error} = Links::language('PAYLOG_INVALID_ID');
|
|
}
|
|
}
|
|
return \%ret;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{view_details} = __LINE__ . <<'END_OF_SUB';
|
|
sub view_details {
|
|
my $payment_id = shift;
|
|
my $payment = $DB->table('Payments' => 'Links')->select({ payments_id => $payment_id })->fetchrow_hashref;
|
|
$payment or return;
|
|
|
|
my ($type, $method) = $payment->{payments_method} =~ /^(direct|remote)_(\w+)$/;
|
|
$payment->{payments_direct} = 1 if $type eq 'direct';
|
|
$payment->{payments_remote} = 1 if $type eq 'remote';
|
|
$payment->{payments_method} = $method if $method;
|
|
|
|
if (my ($num, $unit) = $payment->{payments_term} =~ /^(\d+)([dwmy])$/) {
|
|
$payment->{payments_term_num} = $num;
|
|
$payment->{payments_term_unit} = Links::language($Lang_map{$unit} . ($num == 1 ? '' : 'S'));
|
|
}
|
|
|
|
unless ($payment->{payments_method} eq 'trial') {
|
|
$payment->{payments_method} = Links::language(($payment->{payments_direct} ? 'PAYMENT_DIRECT_' : 'PAYMENT_REMOTE_') . $payment->{payments_method});
|
|
}
|
|
|
|
my $pl = $DB->table('PaymentLogs');
|
|
$pl->select_options('ORDER BY paylogs_time DESC');
|
|
my $logs = $pl->select({ paylogs_payments_id => $payment->{payments_id} })->fetchall_hashref;
|
|
|
|
for (@$logs) {
|
|
$_->{paylogs_text} =~ s/\n/<br>\n/g;
|
|
}
|
|
|
|
return {
|
|
%$payment,
|
|
logs => $logs,
|
|
db_prefix => $pl->{connect}->{PREFIX}
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub process_payment {
|
|
# -----------------------------------------------------------------------------
|
|
# Processes a signup/renewal/recurring payment. Takes the link ID, payment
|
|
# term (such as "3d", "1m", "6w", "2y"), and optionally an extra
|
|
# true variable that adds a day to the payment time (to cover delays in the
|
|
# recurring post). Typically this extra day is for the initial payment in a
|
|
# series of recurring payments, and is _not_ applied for the remaining
|
|
# recurring payments.
|
|
my ($link_id, $term, $extra_day) = @_;
|
|
my $expiry;
|
|
if ($term eq 'unlimited') {
|
|
$expiry = UNLIMITED;
|
|
}
|
|
else {
|
|
my ($signup_num, $signup_unit) = $term =~ /^(\d+)([dwmy])(?:-rec)?$/;
|
|
|
|
$expiry = $DB->table('Links')->select(ExpiryDate => { ID => $link_id })->fetchrow;
|
|
|
|
$extra_day = 0 if $expiry >= time + 24 * 60 * 60; # Don't give an extra day if there is already >1 day of time left
|
|
|
|
my @lt = localtime(($expiry > time and $expiry < UNLIMITED) ? $expiry : time);
|
|
if ($signup_unit eq 'w') { $lt[3] += $signup_num * 7 }
|
|
elsif ($signup_unit eq 'm') { $lt[4] += $signup_num } # This can be weird; Jan 31st + 1 month = Mar 3rd, but Feb 1st + 1 month = Mar 1st
|
|
elsif ($signup_unit eq 'y') { $lt[5] = ($lt[5] + $signup_num <= 137 ? $lt[5] + $signup_num : 137) } # 137 is 2037 - 2038 introduces 32-bit date problems.
|
|
else { $lt[3] += $signup_num } # Assume days
|
|
|
|
# This must be GT::Date's timelocal() - Time::Local doesn't allow something
|
|
# like Feb 31th (Jan 31th + 1 month). GT::Date::timelocal() treats it as
|
|
# Mar. 3rd (or 2nd in a leap year).
|
|
$expiry = timelocal(@lt);
|
|
$expiry += 24 * 60 * 60 if $extra_day;
|
|
}
|
|
|
|
# Get the link and prepare some default values
|
|
my $link = $DB->table('Links')->get($link_id);
|
|
$link->{'CatLinks.CategoryID'} = $IN->param('cat_id');
|
|
$link->{'CatLinks.CategoryID'} ||= $DB->table('CatLinks')->select(CategoryID => { LinkID => $link_id })->fetchrow; # postback processing
|
|
$link->{ExpiryDate} = $expiry;
|
|
$link->{ExpiryNotify} = 0;
|
|
|
|
# Validate the link if payment auto-validation or manually aproved by admin
|
|
$CFG->{payment}->{auto_validate} and $link->{isValidated} = 'Yes';
|
|
my $payment = $DB->table('Payments')->select({
|
|
payments_linkid => $link_id,
|
|
payments_status => COMPLETED
|
|
})->fetchrow_hashref;
|
|
$payment->{payments_method} eq 'remote_Manual' and $link->{isValidated} = 'Yes';
|
|
|
|
# Update the link
|
|
$DB->table('Links')->modify($link);
|
|
|
|
# Make sure the ExpiryDate isn't overwritten by the one in the Changes table
|
|
my $changes = $DB->table('Changes');
|
|
my $change = $changes->select('ChgRequest', { LinkID => $link_id })->fetchrow;
|
|
if ($change) {
|
|
$change = eval $change;
|
|
if (exists $change->{ExpiryDate}) {
|
|
$change->{ExpiryDate} = $expiry;
|
|
require GT::Dumper;
|
|
$changes->update({ ChgRequest => GT::Dumper->dump({ data => $change, var => '' }) }, { LinkID => $link_id });
|
|
}
|
|
}
|
|
|
|
# Send notification email
|
|
my ($type, $method) = $payment->{payments_method} =~ /^(direct|remote)_(\w+)$/;
|
|
$link->{Category} = $DB->table('Category', 'CatLinks')->select('Category.Full_Name' => { 'CatLinks.LinkID' => $link->{ID} })->fetchrow;
|
|
if ($CFG->{admin_email_add}) {
|
|
Links::send_email('link_added.eml', $link, { admin_email => 1 }) or die "Unable to send mail: $GT::Mail::error";
|
|
}
|
|
if ($CFG->{email_payment} and $link->{isValidated} eq 'Yes') {
|
|
Links::send_email('payment_received.eml', $link) or die "Unable to send mail: $GT::Mail::error";
|
|
}
|
|
return $expiry;
|
|
}
|
|
|
|
sub admin_approve_payment {
|
|
# -----------------------------------------------------------------------------
|
|
# This subroutine is called from the admin payment details page giving you the
|
|
# ability to manually approve a payment.
|
|
#
|
|
my $payment_id = shift;
|
|
|
|
my $pay = $DB->table('Payments');
|
|
my $log = $DB->table('PaymentLogs');
|
|
|
|
my $payment = $pay->select({ payments_id => $payment_id })->fetchrow_hashref;
|
|
$payment and $payment->{payments_status} != COMPLETED or return;
|
|
$pay->update(
|
|
{ payments_status => COMPLETED, payments_last => time },
|
|
{ payments_id => $payment->{payments_id} }
|
|
);
|
|
|
|
$log->delete({
|
|
paylogs_payments_id => $payment->{payments_id},
|
|
paylogs_type => LOG_MANUAL
|
|
});
|
|
|
|
$log->insert({
|
|
paylogs_payments_id => $payment->{payments_id},
|
|
paylogs_type => LOG_ACCEPTED,
|
|
paylogs_time => time,
|
|
paylogs_text => Links::language('PAYMENT_MANUAL') || 'Payment manually approved'
|
|
});
|
|
|
|
process_payment($payment->{payments_linkid}, $payment->{payments_term});
|
|
|
|
return { manual_payment_success => 1 };
|
|
}
|
|
|
|
$COMPILE{postback} = __LINE__ . <<'END_OF_SUB';
|
|
sub postback {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
shift if UNIVERSAL::isa($_[0], __PACKAGE__);
|
|
my $postback = shift or return;
|
|
my $type = $postback->{method_type} || 'remote';
|
|
my $meth = $postback->{method} or return;
|
|
return unless exists $CFG->{payment}->{$type}->{used}->{$meth};
|
|
|
|
my $method = _method($meth, $type eq 'direct') or return;
|
|
|
|
require $method->{payment_module};
|
|
my $pkg = $method->{payment_package};
|
|
|
|
$pkg->postback();
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{invalid_postback} = __LINE__ . <<'END_OF_SUB';
|
|
sub invalid_postback {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
shift if UNIVERSAL::isa($_[0], __PACKAGE__);
|
|
my $pay = $DB->table('Payments');
|
|
my $log = $DB->table('PaymentLogs');
|
|
my $unique = $IN->param('invoice') || $IN->param('cartId') || $IN->param('cart_order_id');
|
|
my $payment = $pay->select({ payments_id => $unique })->fetchrow_hashref or return;
|
|
my $text = "Invalid postback: \n";
|
|
$text .= join "\n" => map "$_: ".$IN->get_hash->{$_} => keys %{$IN->get_hash};
|
|
$log->insert({
|
|
paylogs_payments_id => $payment->{payments_id},
|
|
paylogs_type => LOG_INFO,
|
|
paylogs_time => time,
|
|
paylogs_text => $text
|
|
});
|
|
}
|
|
END_OF_SUB
|
|
|
|
sub error {
|
|
# -----------------------------------------------------------------------------
|
|
# Override Links::error(), this hacks around not being able to easily specify
|
|
# what template to send the user to and to pass template variables to that page.
|
|
# This was really only designed to be used in the method(), form(), and
|
|
# direct() subs.
|
|
#
|
|
my ($self, $msg, $sev, $vars, @args) = @_;
|
|
$msg ||= '';
|
|
$sev ||= 'FATAL';
|
|
if (uc $sev eq 'FATAL') {
|
|
return $self->SUPER::error($msg, $sev, @args);
|
|
}
|
|
|
|
my %valid_subs = (
|
|
'method' => 1,
|
|
'form' => 1,
|
|
'direct' => 1
|
|
);
|
|
|
|
my @ret;
|
|
push @ret, $vars if $vars;
|
|
if (my $method = $IN->delete('last_step')) {
|
|
if (exists $valid_subs{$method}) {
|
|
push @ret, $self->$method();
|
|
}
|
|
}
|
|
my $error = $msg;
|
|
$error = Links::language($msg);
|
|
|
|
if ($error) {
|
|
$error = sprintf($error, map { ref($_) ? () : defined($_) ? $_ : '' } @args) if @args and index($error, '%') >= 0;
|
|
push @ret, { error => $error };
|
|
}
|
|
|
|
if ($IN->param('last_page')) {
|
|
$IN->param(page => scalar $IN->param('last_page'));
|
|
}
|
|
return { map { %$_ } @ret };
|
|
}
|
|
|
|
sub expiry {
|
|
#------------------------------------------------------------------------------
|
|
# Sending email to links that are about to reach the expiry date.
|
|
#
|
|
my $days = shift || 7;
|
|
|
|
return unless $CFG->{payment}->{enabled};
|
|
|
|
# required modules
|
|
require GT::Date;
|
|
require GT::SQL::Condition;
|
|
|
|
my $notify = time + $days * 24 * 60 * 60;
|
|
my $users_links = $DB->table('Users', 'Links');
|
|
my $payments = $DB->table('Payments');
|
|
|
|
my (%users, %links, %exp_users, %exp_links);
|
|
my $date_format = $CFG->{date_user_format} || '%dddd% %mmm% %dd% %yyyy%';
|
|
|
|
# Load links that are about to expire
|
|
$users_links->select_options('ORDER BY Username');
|
|
my $links = $users_links->select(
|
|
'Username', 'Email', 'Name', 'ID', 'Title', 'ExpiryDate',
|
|
GT::SQL::Condition->new(
|
|
ExpiryDate => '>=' => time,
|
|
ExpiryDate => '<=' => $notify,
|
|
ExpiryNotify => '=' => 0
|
|
)
|
|
) or die $GT::SQL::error;
|
|
while (my ($user, $email, $name, $id, $title, $expiry) = $links->fetchrow) {
|
|
$payments->select_options("ORDER BY payments_last DESC", "LIMIT 1");
|
|
my $last_payment_type = $payments->select(payments_type => {
|
|
payments_linkid => $id,
|
|
payments_status => COMPLETED
|
|
})->fetchrow;
|
|
next if $last_payment_type == RECURRING;
|
|
|
|
$users{$user} ||= [$email, $name];
|
|
$links{$user} ||= [];
|
|
push @{$links{$user}}, {
|
|
ID => $id,
|
|
Title => $title,
|
|
ExpiryDate => GT::Date::date_get($expiry, $date_format),
|
|
renewal_url => "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$id"
|
|
};
|
|
}
|
|
my $count = 0;
|
|
|
|
if (%links) {
|
|
$count += expiry_process('notify', \%links, \%users);
|
|
}
|
|
|
|
# Load links that have already expired
|
|
$users_links->select_options('ORDER BY Username');
|
|
my $exp_links = $users_links->select(
|
|
'Username', 'Email', 'Name', 'ID', 'Title', 'ExpiryDate',
|
|
GT::SQL::Condition->new(
|
|
ExpiryDate => '<' => time,
|
|
ExpiryDate => '>' => UNPAID,
|
|
ExpiryNotify => '<' => 2
|
|
)
|
|
) or die $GT::SQL::error;
|
|
while (my ($user, $email, $name, $id, $title, $expiry) = $exp_links->fetchrow) {
|
|
$exp_users{$user} ||= [$email, $name];
|
|
$exp_links{$user} ||= [];
|
|
push @{$exp_links{$user}}, {
|
|
ID => $id,
|
|
Title => $title,
|
|
ExpiryDate => GT::Date::date_get($expiry, $date_format),
|
|
renewal_url=> "$CFG->{db_cgi_url}/modify.cgi?do=payment_linked;process_payment=1;modify=1;ID=$id"
|
|
};
|
|
}
|
|
|
|
if (%exp_links) {
|
|
$count += expiry_process('expired', \%exp_links, \%exp_users);
|
|
}
|
|
print "$count email(s) were sent.\n";
|
|
}
|
|
|
|
sub expiry_process {
|
|
my ($type, $links, $users) = @_;
|
|
|
|
my $db_link = $DB->table('Links');
|
|
my $email = ($type eq 'expired') ? 'link_expired.eml' : 'link_expiry_notify.eml';
|
|
my $notified = ($type eq 'expired') ? 2 : 1;
|
|
my $count;
|
|
foreach my $u (keys %$users) {
|
|
my $lks = $links->{$u};
|
|
next if ($#$lks == -1);
|
|
|
|
my @ids = map $_->{ID}, @{$lks};
|
|
if (Links::send_email($email, { Name => $users->{$u}->[1], Email => $users->{$u}->[0], expiry_links => $lks })) {
|
|
$db_link->update({ ExpiryNotify => $notified }, GT::SQL::Condition->new(ID => 'IN' => \@ids));
|
|
$count++;
|
|
}
|
|
else {
|
|
warn "Unable to send mail: $GT::Mail::error";
|
|
}
|
|
}
|
|
return $count;
|
|
}
|
|
|
|
sub currency {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
\sprintf Links::language('PAYMENT_CURRENCY_FORMAT') => @_;
|
|
}
|
|
|
|
sub next_years {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns the next x years, in template loop variable "next_years".
|
|
#
|
|
shift;
|
|
my $years = shift;
|
|
|
|
$years = 10 if !$years or $years < 1;
|
|
my $year = (localtime)[5] + 1900;
|
|
return {
|
|
next_years => [$year .. $year + $years]
|
|
};
|
|
}
|
|
|
|
sub generate_unique_id {
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
require GT::MD5;
|
|
my $id;
|
|
do {
|
|
$id = substr(GT::MD5::md5_hex(time . $$ . rand(16000)), 0, 16)
|
|
} while $DB->table('Payments')->count(payments_id => $id) > 0;
|
|
|
|
return $id;
|
|
}
|
|
|
|
sub convert_to_days {
|
|
# -----------------------------------------------------------------------------
|
|
# Given a payment_term time interval, this returns the equivalent number of days.
|
|
#
|
|
my $date = shift;
|
|
|
|
if ($date and $date =~ /^(\d+)([dwmy])$/) {
|
|
return $1 * $Ptd{$2};
|
|
}
|
|
return 0x7fff_ffff;
|
|
}
|
|
|
|
sub check_discount {
|
|
# -----------------------------------------------------------------------------
|
|
# This returns the number of discount percent for current user.
|
|
#
|
|
return unless $USER;
|
|
|
|
my $id = $IN->param('ID') || $IN->param('link_id');
|
|
|
|
# Skip discount if renewal payment
|
|
if ($id and $id =~ /^\d+$/) {
|
|
my $link = $DB->table('Links')->get($id);
|
|
return if ($link->{ExpiryDate} > 0 and $link->{ExpiryDate} < UNLIMITED);
|
|
}
|
|
my $link_count = $DB->table('Links')->count(
|
|
GT::SQL::Condition->new(
|
|
LinkOwner => '=' => $USER->{Username},
|
|
ExpiryDate => '>=' => time,
|
|
ExpiryDate => '<' => FREE
|
|
)
|
|
);
|
|
my $discount;
|
|
foreach my $num (sort { $a <=> $b } keys %{$CFG->{payment}->{discounts}}) {
|
|
($link_count < $num - 1) and last;
|
|
$discount = $CFG->{payment}->{discounts}->{$num};
|
|
}
|
|
return $discount;
|
|
}
|
|
|
|
1;
|