# ==================================================================
# Links SQL - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: Payment.pm,v 1.52 2004/06/25 20:26:44 jagerman 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;

@ISA = qw(Exporter Links); # Inherit from Exporter and Links
@EXPORT_OK = qw/PENDING COMPLETED DECLINED ERROR LOG_INFO LOG_ACCEPTED LOG_DECLINED LOG_ERROR/;
%EXPORT_TAGS = (
    status => [qw/PENDING COMPLETED DECLINED ERROR/],
    log => [qw/LOG_INFO LOG_ACCEPTED LOG_DECLINED LOG_ERROR/],
    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 $pt = $DB->table('Payments');
        $pt->insert({
            payments_linkid => $IN->param('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');
    $pt->insert({
        payments_linkid => $IN->param('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) {
                $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      => $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 if @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_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};

    return $conf;
}
END_OF_SUB


$COMPILE{save_config} = __LINE__ . <<'END_OF_SUB';
sub save_config {
# -----------------------------------------------------------------------------
#
    my $save;
    if ($CFG->{payment}->{enabled} ne $IN->param('payment_enabled')) {
        $CFG->{payment}->{enabled} = $IN->param('payment_enabled');
        $save++;
    }
    if ($CFG->{payment}->{mode} ne $IN->param('payment_mode')) {
        $CFG->{payment}->{mode} = $IN->param('payment_mode');
        $save++;
    }
    if ($CFG->{payment}->{auto_validate} ne $IN->param('payment_auto_validate')) {
        $CFG->{payment}->{auto_validate} = $IN->param('payment_auto_validate');
        $save++;
    }
    if ($CFG->{payment}->{description} ne $IN->param('payment_description')) {
        $CFG->{payment}->{description} = $IN->param('payment_description');
        $save++;
    }

    if ($CFG->{payment}->{expiry_notify} ne $IN->param('payment_expiry_notify')) {
        $CFG->{payment}->{expiry_notify} = $IN->param('payment_expiry_notify') || 7;
        $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_length 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('CATCATID') };
        $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 paticular category, and returns it to a template. 
# 
    my ($cat_id) = @_;
    my $data;
    my $out;

# Default global payment option
    $out->{payment_mode} = $CFG->{payment}->{mode};

# Get category info
    ($cat_id =~ /^\d+$/) or return { payment_invalid_cat_id => 1 };
    $out = $DB->table('Category')->get($cat_id);
    $out->{term_cnt} = $DB->table('CatPrice')->count({ 'cp_cat_id_fk' => $cat_id });
    $out->{Payment_Mode} and $out->{payment_mode} = $out->{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); 
        }
        foreach my $type ('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 };

    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_length 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_length 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

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')) {
        delete $CFG->{payment}->{$type}->{used}->{$method};
        $CFG->save();
        return { method_removed => 1 };
    }
    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'
    );

    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 $mh = $IN->param('mh');
    $mh = 50 unless $mh and $mh >= 1;
    my $page = $IN->param('pg');
    $page = 1 unless $page and $page >= 1;
    my $count = $tables->count({ paylogs_type => $log_type });
    $tables->select_options("ORDER BY paylogs_time DESC", "LIMIT " . ($page - 1) * $mh . ", $mh");
    my $results = $tables->select(defined $log_type ? ({ paylogs_type => $log_type }) : ())->fetchall_hashref;
    my @viewing;
    for (@$results) {
        push @viewing, $_->{paylogs_id};
    }

    $DB->table('PaymentLogs')->update({ paylogs_viewed => 1 }, { paylogs_id => \@viewing });
    return { db_prefix => $tables->{connect}->{PREFIX}, log_type => $log_type, logs => $results, num_logs => $count, page => $page, mh => $mh };
}
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' or $term eq 'unlimite') {
        $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 ? $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   
    $CFG->{payment}->{auto_validate} and $link->{isValidated} = 'Yes';

# Update the link
    $DB->table('Links')->modify($link);

# Send notification email
    _send_email($link);

    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 ($self, $payment_id) = @_;

    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->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_userid}, $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

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->param('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}; # payment is disabled

# required modules
    require GT::Date;
    require GT::SQL::Condition;

    my $notify   = time + $days * (24*60*60);
    my $db       = $DB->table('Users', 'Links');
    my $payments = $DB->table('Payments');

    my (%users, %links, %exp_users, %exp_links, %head);
    my $date_format = $CFG->{date_user_format} || '%dddd% %mmm% %dd% %yyyy%';

# Load links that are about to expiry    
    $db->select_options('ORDER BY Username');
    my $links = $db->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;
    my $cfg   = Links::Config::load_vars();

    my $root = Links::template_exists($CFG->{build_default_tpl}, "email-notify.txt")
        ? "$CFG->{admin_root_path}/templates/$CFG->{build_default_tpl}"
        : "$CFG->{admin_root_path}/templates/default";

    $head{from}    = $CFG->{db_admin_email};
    $head{subject} = Links::language('LINKS_NOTIFY_SUBJECT');
    if (%links) {
        $count += expiry_process('nofity', \%links, \%users, \%head, $root, $cfg);
    }

# Load links that have been expired
    $db->select_options('ORDER BY Username');
    my $exp_links = $db->select(
        'Username', 'Email', 'Name', 'ID', 'Title', 'ExpiryDate',
        GT::SQL::Condition->new(
            ExpiryDate   => '<' => time,
            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, \%head, $root, $cfg);
    }
    print "$count emails were sent.\n";
}

sub expiry_process {
    my ($type, $links, $users, $head, $path, $args) = @_;

    require GT::Mail;
    my $db_link  = $DB->table('Links');
    my $email    = ($type eq 'expired') ? 'email-expired.txt' : 'email-notify.txt';
    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};
        $head->{to}  = %{$users->{$u}}->[0];
        $head->{msg} = GT::Template->parse(
            $email,
            { expiry_links => $lks, Name => %{$users->{$u}}->[1], %$args },
            { compress => 0, root => $path }
        );

        $GT::Mail::error ||= ''; # Silence -w
        GT::Mail->send(
            %$head,
            smtp      => $CFG->{db_smtp_server},
            sendmail  => $CFG->{db_mail_path},
            debug     => $Links::DEBUG
        ) or warn "Unable to send mail: $GT::Mail::error";

        if (!$GT::Mail::error) {
            $db_link->update({ ExpiryNotify => $notified }, GT::SQL::Condition->new(ID => 'IN' => \@ids));
            $count++ ;
        }
    }
    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.
#
    my $id = $IN->param('ID') || $IN->param('link_id');

# Skip discount if renewal payment        
    if ($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)
    );
    my $discount;
    foreach my $num (sort keys %{$CFG->{payment}->{discounts}}) {
        ($link_count < $num - 1) and last;
        $discount = $CFG->{payment}->{discounts}->{$num};
    }
    return $discount;
}

sub _send_email {
# -------------------------------------------------------------------
# Send notification email
#
    my $input = shift;
    $input->{'Category'} = $DB->table('Category','CatLinks')->select({ 'CatLinks.LinkID' => $input->{ID} },['Category.Full_Name'])->fetchrow;
    $input->{Host}       = $ENV{REMOTE_HOST}  ? "$ENV{REMOTE_HOST} ($ENV{REMOTE_ADDR})" : $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : 'none';
    $input->{Referer}    = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : 'none';

# Mail the email.
    if ($CFG->{admin_email_add}) {
        my $to      = $CFG->{db_admin_email};
        my $from    = $input->{'Contact_Email'};
        my $subject = "Addition to Database: $input->{'Title'}\n";
        my $cfg     = Links::Config::load_vars();
        my $msg     = GT::Template->parse('email-val.txt', { %$input, %$cfg }, { compress => 0, root => "$CFG->{admin_root_path}/templates/admin" } );
        require GT::Mail;
        $GT::Mail::error ||= ''; # Silence -w
        GT::Mail->send(
            smtp      => $CFG->{db_smtp_server},
            sendmail  => $CFG->{db_mail_path},
            from      => $from,
            subject   => $subject,
            to        => $to,
            msg       => $msg,
            debug     => $Links::DEBUG
        ) or die "Unable to send mail: $GT::Mail::error";
    }
}

1;