mourningdove/bin/worker/paidstatus

#!/usr/bin/perl
#
# bin/worker/paidstatus
#
# Worker job that loops and looks for shopping carts that are in the need of
# processing.
#
# Authors:
#      Mark Smith <mark@dreamwidth.org>
#
# Copyright (c) 2009 by Dreamwidth Studios, LLC.
#
# This program is free software; you may redistribute it and/or modify it under
# the same terms as Perl itself.  For a copy of the license, please reference
# 'perldoc perlartistic' or 'perldoc perlgpl'.
#

use strict;

BEGIN {
    require "$ENV{LJHOME}/cgi-bin/ljlib.pl";
}

use Time::HiRes qw/ gettimeofday tv_interval /;
use LJ::Sendmail;
use LJ::Lang;
use DW::Shop;
use DW::Shop::Cart;
use DW::Pay;

################################################################################
## main setup
################################################################################

# setup logging routine
my $begin_time = [ gettimeofday() ];
my ( $logfile, $last_log_time );
my $log = sub {
    $last_log_time ||= [ gettimeofday() ];

    unless ($logfile) {
        open $logfile, ">>$LJ::HOME/logs/paidstatus.log"
            or die "Internal server error creating log.\n";
        print $logfile "[0.00s 0.00s] Log started at " . LJ::mysql_time( gmtime() ) . ".\n";
    }

    my $fmt = "[%0.4fs %0.1fs] " . shift() . "\n";
    my $msg = sprintf( $fmt, tv_interval($last_log_time), tv_interval($begin_time), @_ );

    # now log to both the file and STDERR if we're foregrounded
    print $logfile $msg;
    print STDERR $msg;

    $last_log_time = [ gettimeofday() ];
};

# setup alert routine, this sends a mail to some configurable alert address
my $alert = sub {
    LJ::send_mail(
        {
            to      => $LJ::PAYPAL_CONFIG{email},
            from    => $LJ::BOGUS_EMAIL,
            subject => "$LJ::SITENAME Payment System Alert",
            body    => shift(),
        }
    );
    return undef;
};

while (1) {
    $log->('Main loop beginning...');

    # do this in a sub so it can return on error
    main_loop();

    # now we sleep to the next one minute boundary, and if we're taking more
    # than one minute to run, we fire off an alert
    my $sleep_time = 10 - tv_interval($begin_time);
    if ( $sleep_time <= 0 ) {
        $alert->('Warning: main loop is taking longer than a minute.');
        $sleep_time = 10;
    }
    $log->( 'Sleeping for %0.2f seconds.', $sleep_time );
    select undef, undef, undef, $sleep_time;

    $log->('Main loop ended.');
    $begin_time = [ gettimeofday() ];
}

################################################################################
## main loop
################################################################################

sub main_loop {

    # disconnect dbs
    LJ::DB::disconnect_dbs();
    LJ::start_request();

    # now get a db or die
    my $dbh = LJ::get_db_writer()
        or return $log->('Unable to get database writer handle.');

## PHASE 0) REMOVE DEAD CARTS (open or closed for more than 30 days)

    my $ct = $dbh->do(
        q{DELETE FROM shop_carts
    WHERE state IN (?, ?) AND starttime < UNIX_TIMESTAMP() - 86400 * 30
    LIMIT 1000},
        undef, $DW::Shop::STATE_CLOSED, $DW::Shop::STATE_OPEN
    );
    return $log->( 'Database error cleaning carts: %s', $dbh->errstr )
        if $dbh->err;
    $log->( 'Cleaned %d carts that were unused for more than 30 days.', $ct + 0 );
    DW::Stats::increment( 'dw.shop.cart.expired', $ct );

## PHASE 1) PROCESS PAYMENTS

    # dig up carts that are in state paid and scannable
    my $cartids = $dbh->selectcol_arrayref(
        q{SELECT cartid FROM shop_carts WHERE state = ? AND nextscan < UNIX_TIMESTAMP()},
        undef, $DW::Shop::STATE_PAID );
    return $log->( 'Database error: %s', $dbh->errstr )
        if $dbh->err;
    return $log->('Invalid response looking for scannable carts.')
        unless $cartids && ref $cartids eq 'ARRAY';

    $log->( 'Found %d scannable carts.', scalar(@$cartids) );

    # now iterate over these and do something with them
    scan_cart( $dbh, $_ ) foreach @$cartids;

## PHASE 2) PROCESS EXPIRATIONS

    # dig up who has expired ... accounts
    my $uids = $dbh->selectcol_arrayref(
        q{SELECT userid FROM dw_paidstatus
          WHERE permanent = 0 AND (expiretime IS NOT NULL AND expiretime <= UNIX_TIMESTAMP())}
    );
    return $log->( 'Database error: %s', $dbh->errstr )
        if $dbh->err;

    $log->( 'Found %d expired users.', scalar(@$uids) );

    # now expire the user
    expire_user( $dbh, $_ ) foreach @$uids;

## PHASE 3) PROCESS EXPIRATION WARNING MAILS

    # dig up who expire soon
    my $rows = $dbh->selectall_arrayref(
        q{SELECT userid, lastemail, expiretime - UNIX_TIMESTAMP()
          FROM dw_paidstatus
          WHERE permanent = 0 AND
               (expiretime IS NOT NULL AND
                expiretime > UNIX_TIMESTAMP() AND
                expiretime < ( UNIX_TIMESTAMP() + 14*86400 )
              )}
    );
    return $log->( 'Database error: %s', $dbh->errstr )
        if $dbh->err;

    $log->( 'Found %d users expiring soon.', scalar(@$rows) );

    # now warn the user
    warn_user( $dbh, $_ ) foreach @$rows;

}

sub expire_user {
    my ( $dbh, $uid ) = @_;

    my $u = LJ::load_userid($uid)
        or return 0;

    $log->( 'Expiring %s(%d).', $u->user, $u->id );

    if ( $u->is_community && $u->is_visible ) {

        # send an email to every maintainer
        my $maintus = LJ::load_userids( $u->maintainer_userids );
        foreach my $maintu ( values %$maintus ) {
            LJ::send_mail(
                {
                    to       => $maintu->email_raw,
                    fromname => $LJ::SITENAME,
                    from     => $LJ::ACCOUNTS_EMAIL,
                    subject  => LJ::Lang::ml(
                        "shop.expiration.comm.0.subject",
                        { sitename => $LJ::SITENAME }
                    ),
                    body => LJ::Lang::ml(
                        "shop.expiration.comm.0.body",
                        {
                            touser   => $maintu->display_name,
                            commname => $u->display_name,
                            shopurl  => "$LJ::SHOPROOT/account?for=gift&user=" . $u->user,
                            sitename => $LJ::SITENAME,
                        }
                    ),
                }
            );
        }
    }
    elsif ( $u->is_visible ) {
        LJ::send_mail(
            {
                to       => $u->email_raw,
                fromname => $LJ::SITENAME,
                from     => $LJ::ACCOUNTS_EMAIL,
                subject =>
                    LJ::Lang::ml( "shop.expiration.user.0.subject", { sitename => $LJ::SITENAME } ),
                body => LJ::Lang::ml(
                    "shop.expiration.user.0.body",
                    {
                        touser   => $u->display_name,
                        shopurl  => "$LJ::SHOPROOT/account?for=self",
                        sitename => $LJ::SITENAME,
                    }
                ),
            }
        );
    }

    # this is pretty easy, we just tell DW::Pay to do it
    return DW::Pay::expire_user($uid);
}

sub warn_user {
    my ( $dbh, $row ) = @_;
    my ( $uid, $lastmail, $timeleft ) = @$row;

    my $u = LJ::load_userid($uid)
        or return 0;
    return 0 unless $u->is_visible;

    my $mail;
    if ( $timeleft < 86400 * 3 && ( !defined $lastmail || $lastmail == 14 ) ) {
        $log->( 'Sending 3-day expiration mail to %s(%d).', $u->user, $u->id );
        $mail = '3';

    }
    elsif ( $timeleft < 86400 * 14 && !defined $lastmail ) {
        $log->( 'Sending 14-day expiration mail to %s(%d).', $u->user, $u->id );
        $mail = '14';
    }

    return 1 unless defined $mail;

    DW::Stats::increment( 'dw.shop.paid_account.warn_' . $mail, 1 );

    # alter warning message body for premium paid accounts
    my $bodytype = $mail;
    my $status   = DW::Pay::get_account_type($u);
    $bodytype = "$status.$mail" if $status eq "premium";

    if ( $u->is_community ) {

        # send an email to every maintainer
        my $maintus = LJ::load_userids( $u->maintainer_userids );
        foreach my $maintu ( values %$maintus ) {
            LJ::send_mail(
                {
                    to       => $maintu->email_raw,
                    fromname => $LJ::SITENAME,
                    from     => $LJ::ACCOUNTS_EMAIL,
                    subject  => LJ::Lang::ml(
                        "shop.expiration.comm.$mail.subject",
                        { sitename => $LJ::SITENAME }
                    ),
                    body => LJ::Lang::ml(
                        "shop.expiration.comm.$bodytype.body",
                        {
                            touser   => $maintu->display_name,
                            commname => $u->display_name,
                            shopurl  => "$LJ::SHOPROOT/account?for=gift&user=" . $u->user,
                            sitename => $LJ::SITENAME,
                        }
                    ),
                }
            );
        }
    }
    else {
        LJ::send_mail(
            {
                to       => $u->email_raw,
                fromname => $LJ::SITENAME,
                from     => $LJ::ACCOUNTS_EMAIL,
                subject  => LJ::Lang::ml(
                    "shop.expiration.user.$mail.subject",
                    { sitename => $LJ::SITENAME }
                ),
                body => LJ::Lang::ml(
                    "shop.expiration.user.$bodytype.body",
                    {
                        touser   => $u->display_name,
                        shopurl  => "$LJ::SHOPROOT/account?for=self",
                        sitename => $LJ::SITENAME,
                    }
                ),
            }
        );
    }

    # now update the db
    $dbh->do( 'UPDATE dw_paidstatus SET lastemail = ? WHERE userid = ?', undef, $mail + 0, $u->id );
    return 0
        if $dbh->err;

    return 1;
}

sub scan_cart {
    my $dbh    = shift;
    my $cartid = shift() + 0;

    # easy sub for setting nextscan on this cart
    my $nextscan = sub {
        $dbh->do( q{UPDATE shop_carts SET nextscan = UNIX_TIMESTAMP() + ? WHERE cartid = ?},
            undef, shift() || 3600, $cartid );
        $log->( 'Database error: %s', $dbh->errstr )
            if $dbh->err;
        return 1;
    };

    # setup a failure sub, this will log and alert on errors plus mark the cart as
    # not being scannable for another hour
    my $fail = sub {
        my $msg = 'scan_cart(%d): ' . shift();
        $msg = sprintf( $msg, $cartid, @_ );

        $log->($msg);
        $alert->($msg);

        return undef;
    };

    # prepend our logging function with useful information
    my $log = sub {
        $log->( 'scan_cart(%d): ' . shift(), $cartid, @_ );
    };

    $log->( '-' x 60 );

    my $cart = DW::Shop::Cart->get_from_cartid($cartid);
    return $fail->('Failed creating cart.')
        unless $cart && ref $cart eq 'DW::Shop::Cart';

    # error check this cart
    return $fail->('Cart not in a valid state.')
        unless $cart->state == $DW::Shop::STATE_PAID;
    return $fail->('Cart has no items.')
        unless $cart->has_items;

    # try to apply each item
    my ( $unapplied, %saw_ids ) = (0);
    $log->('Iterating over items.');
    foreach my $item ( @{ $cart->items } ) {
        next unless $item->apply_automatically;

        $log->( 'Found item [%d] %s.', $item->id, $item->short_desc );

        # rare case where we've found the cart generating items with the same
        # id, leading to failures in sending invite codes
        while ( exists $saw_ids{ $item->id } ) {
            if ( $item->applied ) {
                $log->('Item id duplicate, but item safely applied.  Ignoring dupe id.');
                next;
            }

            # this item has NOT been applied, so renumber it
            $item->id( $item->id + 1 );
            $log->( 'Item id already found, renumbering to %d.', $item->id );
        }

        # record the id in our list so we know we've seen it
        $saw_ids{ $item->id } = 1;

        # this is the normal 'bail' point for already applied items
        if ( $item->applied ) {
            $log->('Item already applied.');
            next;
        }

        # try to apply it
        my $rv = eval { $item->apply };
        if ($rv) {
            $log->('Successfully applied item.');
        }
        else {
            $log->( 'Failed to apply item: %s', DW::Pay::error_text() || $@ || 'unknown error' );
            $unapplied = 1;
        }

        # yes, we save the cart a lot... oh well
        $cart->save( no_memcache => 1 );
    }

    # two possible results: we have items still unapplied or we did
    # get everything applied.  try again in 1-2 hours.
    if ($unapplied) {
        $nextscan->( 3600 + int( rand() * 3600 ) );
        $log->('One or more items not applied, will retry later.');
        return;
    }

    # everything in this order has been applyed, restate it
    $cart->state( $DW::Shop::STATE_PROCESSED, no_memcache => 1 );

    # main loop done!
    $log->('Cart->state is now PROCESSED.');
}