changelog | [dw-free] Finishing up payment system

[commit: http://hg.dwscoalition.org/dw-free/rev/580eeae9856a]

http://bugs.dwscoalition.org/show_bug.cgi?id=116

Add downgrader for testing, update sitemap, remove old file.

Patch by
mark.

Files modified:
bin/paid-expirations
bin/worker/paidstatus
htdocs/misc/downgrader.bml
htdocs/site/index.bml
--------------------------------------------------------------------------------
diff -r b70ef046b58e -r 580eeae9856a bin/paid-expirations
--- a/bin/paid-expirations	Wed Apr 29 06:45:23 2009 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,161 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use lib "$ENV{LJHOME}/cgi-bin";
-
-require 'ljlang.pl';
-require 'ljlib.pl';
-
-use Data::Dumper;
-
-# this script handles sending expiration notices for users as well as handling the actual
-# expirations.  it should be run at least once a day but can be run more often if you want
-# to have greater granularity on the expiration of accounts.
-
-my $note = sub {
-    my $u = shift;
-    LJ::statushistory_add( $u, undef, 'paidstatus', sprintf('Expiration: ' . shift, @_) );
-};
-
-# 1) let's grab people expiring in the next 14 days
-print "Searching for expirations in the next 14 days.\n";
-my $dbh = DW::Pay::get_db_writer()
-    or die "unable to get db\n";
-my $now = $dbh->selectrow_array( 'SELECT UNIX_TIMESTAMP()' );
-my $people = $dbh->selectall_arrayref( q{
-        SELECT userid, typeid, expiretime, permanent, lastemail
-        FROM dw_paidstatus
-        WHERE permanent = 0
-          AND expiretime IS NOT NULL
-          AND expiretime < UNIX_TIMESTAMP(DATE_ADD(NOW(), INTERVAL 14 DAY))
-          AND typeid > 0
-          AND ( lastemail IS NULL OR lastemail != 0 )
-    } );
-die $dbh->errstr if $dbh->err;
-
-# XXX: lastemail is a little lame, we use it to record which mails we have sent the user.
-# since the user SHOULD always rotate through the statuses in a nice predictable fashion
-# then this should work well enough.
-
-# 2) now iterate over this list and do stuff with it
-print "Got " . scalar( @$people ) . " records.\n";
-foreach my $user ( @$people ) {
-    my ( $uid, $typeid, $expiretime, $perm, $lastemail ) = @$user;
-
-    if ( $expiretime < $now ) {
-        if ( ! defined $lastemail || $lastemail != 0 ) {
-            handle_expired( $uid );
-        }
-
-    } elsif ( $expiretime < ( $now + 3600*24*3 ) ) {
-        # 3-day expiration, lastemail should be something other than 3
-        if ( $lastemail != 3 ) {
-            send_3day_warning( $uid );
-        }
-
-    } elsif ( $expiretime < ( $now + 3600*24*14 ) ) {
-        if ( $lastemail != 14 ) {
-            send_14day_warning( $uid );
-        }
-    }
-}
-print "Done.\n";
-
-sub handle_expired {
-    my $u = LJ::load_userid( shift )
-        or die;
-
-    print "$u->{user}($u->{userid}) gets expired\n";
-    $note->( $u, "paid account has expired" );
-    DW::Pay::update_paid_status( $u, lastemail => 0 );
-    DW::Pay::sync_caps( $u );
-
-    LJ::send_mail( {
-            to => $u->email_raw,
-            from => $LJ::BOGUS_EMAIL,
-            subject => "$LJ::SITENAME Account Expired",
-            body => <<EOF,
-Dear $u->{user},
-
-Your paid account status with $LJ::SITENAME has expired.  We hope that
-this is just an oversight, and would like to encourage you to come back
-and continue to support this site!
-
-You may renew your account here:
-
-    $LJ::SITEROOT/paidaccounts/
-
-Thank you for your support!
-
-
-Sincerely,
-The $LJ::SITENAME Team
-EOF
-        } );
-}
-
-sub send_3day_warning {
-    my $u = LJ::load_userid( shift )
-        or die;
-
-    print "$u->{user}($u->{userid}) gets a 3 day expiration mailing\n";
-    $note->( $u, "sending 3 day expiration warning" );
-    DW::Pay::update_paid_status( $u, lastemail => 3 );
-
-    LJ::send_mail( {
-            to => $u->email_raw,
-            from => $LJ::BOGUS_EMAIL,
-            subject => "$LJ::SITENAME Account Expiration in 3 Days",
-            body => <<EOF,
-Dear $u->{user},
-
-Your paid account status with $LJ::SITENAME is currently only 3 days from
-expiring and lapsing back to a free account.  Don't let this opportunity to
-continue supporting this site slip you by!  Continue to enjoy the extra
-features of a paid account by renewing now.
-
-You may renew your account here:
-
-    $LJ::SITEROOT/paidaccounts/
-
-Thank you for your support!
-
-
-Sincerely,
-The $LJ::SITENAME Team
-EOF
-        } );
-}
-
-sub send_14day_warning {
-    my $u = LJ::load_userid( shift )
-        or die;
-
-    print "$u->{user}($u->{userid}) gets a 14 day expiration mailing\n";
-    $note->( $u, "sending 14 day expiration warning" );
-    DW::Pay::update_paid_status( $u, lastemail => 14 );
-
-    LJ::send_mail( {
-            to => $u->email_raw,
-            from => $LJ::BOGUS_EMAIL,
-            subject => "$LJ::SITENAME Account Expiration in 14 Days",
-            body => <<EOF,
-Dear $u->{user},
-
-Your paid account status with $LJ::SITENAME is currently only 14 days from
-expiring and lapsing back to a free account.  Don't let this opportunity to
-continue supporting this site slip you by!  Continue to enjoy the extra
-features of a paid account by renewing now.
-
-You may renew your account here:
-
-    $LJ::SITEROOT/paidaccounts/
-
-Thank you for your support!
-
-
-Sincerely,
-The $LJ::SITENAME Team
-EOF
-        } );
-}
diff -r b70ef046b58e -r 580eeae9856a bin/worker/paidstatus
--- a/bin/worker/paidstatus	Wed Apr 29 06:45:23 2009 +0000
+++ b/bin/worker/paidstatus	Wed Apr 29 09:46:55 2009 +0000
@@ -75,9 +75,9 @@ while ( 1 ) {
 
     # now we sleep to the next five minute boundary, and if we're taking more
     # than five minutes to run, we fire off an alert
-    my $sleep_time = 300 - ( tv_interval( $begin_time ) % 300 );
+    my $sleep_time = 60 - ( tv_interval( $begin_time ) % 60 );
     if ( $sleep_time < 0 ) {
-        $alert->( 'Warning: main loop is taking longer than five minutes.' );
+        $alert->( 'Warning: main loop is taking longer than a minute.' );
         $sleep_time = 60;
     }
     $log->( 'Sleeping for %0.2f seconds.', $sleep_time );
diff -r b70ef046b58e -r 580eeae9856a htdocs/misc/downgrader.bml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/htdocs/misc/downgrader.bml	Wed Apr 29 09:46:55 2009 +0000
@@ -0,0 +1,70 @@
+<?_c
+#
+# misc/downgrader.bml
+#
+# Downgrades an account to free status, for testing the payment system.
+#
+# 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'.
+#
+_c?><?page
+body<=
+<?_code
+{
+    use strict;
+    use vars qw/ %GET %POST /;
+
+    # only while beta tools are on
+    return "Sorry, not enabled anymore."
+        unless $LJ::ENABLE_BETA_TOOLS || $LJ::IS_DEV_SERVER;
+
+    # for pages that require authentication
+    my $remote = LJ::get_remote();
+    return "<?needlogin?>" unless $remote;
+
+    # allow the remote user to authenticate as another account (community, etc)
+    my $authas = $GET{authas} || $remote->user;
+    my $u = LJ::get_authas_user( $authas );
+    return LJ::bad_input( $ML{'error.invalidauth'} )
+        unless $u;
+
+    # if no post, let them pick an account to downgrade
+    my $ret;
+    unless ( LJ::did_post() && $POST{doit} ) {
+        $ret .= '<form>';
+        $ret .= LJ::make_authas_select( $remote, { authas => $u->user } );
+        $ret .= "</form><form method='post'><input type='hidden' name='doit' value='1'><br />";
+        $ret .= LJ::form_auth();
+        $ret .= '<?p By clicking the below button you will expire any paid time the ';
+        $ret .= 'account in question has.  Note that expiration is not instant, it will ';
+        $ret .= 'take up to a minute for the paidstatus worker to note the expiration. ';
+        $ret .= 'You should get an email when it does. p?>';
+        $ret .= '<?p <strong>YOU WILL EXPIRE:</strong> ' . $u->ljuser_display . ' p?>';
+        $ret .= '<input type="submit" value="Expire!" /></form>';
+        return $ret;
+    }
+
+    return "Invalid form auth"
+        unless LJ::check_form_auth();
+
+    my $dbh = LJ::get_db_writer();
+    $dbh->do( 'UPDATE dw_paidstatus SET permanent = 0, lastemail = NULL, expiretime = UNIX_TIMESTAMP() ' .
+              'WHERE userid = ?', undef, $u->id );
+    die $dbh->errstr if $dbh->err;
+
+    $ret = $u->ljuser_display . " has been expired... wait for the email!<br /><br />";
+    $ret .= '<a href="/misc/downgrader.bml">That was fun, expire some more!</a>';
+    return $ret;
+}
+_code?>
+<=body
+title=>Account Downgrader
+head<=
+<=head
+page?>
diff -r b70ef046b58e -r 580eeae9856a htdocs/site/index.bml
--- a/htdocs/site/index.bml	Wed Apr 29 06:45:23 2009 +0000
+++ b/htdocs/site/index.bml	Wed Apr 29 09:46:55 2009 +0000
@@ -64,7 +64,7 @@ body<=
   <dd><ul>
    <li><a href='/manage/settings'><?_ml .maplinks.manage-settings _ml?></a></li>
    <li><a href='/inbox'><?_ml .maplinks.inbox _ml?></a></li>
-   <li><a href='/paidaccounts'><?_ml .maplinks.upgrade _ml?></a></li>
+   <li><a href='/shop'><?_ml .maplinks.upgrade _ml?></a></li>
    <li><a href='/changepassword.bml'><?_ml .maplinks.changepassword _ml?></a></li>
    <li><a href='/accountstatus.bml'><?_ml .maplinks.changestatus _ml?></a></li>
   </ul></dd>
--------------------------------------------------------------------------------
[dw-free] Finishing up payment system

no subject
