[dw-free] Memcache clear tool

[fu]

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

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

Add a tool to clear memcache, available to siteadmins with the proper privs.
Also adds a convenience method to sort the keys of a hash by two orders
applied one aftera nother.

Patch by exor674.

Files modified:

• cgi-bin/DW/Controller/Admin/MemcacheClear.pm
• cgi-bin/DW/Template/VMethods.pm
• views/admin/memcache_clear.tt
• views/admin/memcache_clear.tt.text

--------------------------------------------------------------------------------
diff -r 1bbe1e229f5f -r ba456f5dde11 cgi-bin/DW/Controller/Admin/MemcacheClear.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Controller/Admin/MemcacheClear.pm	Wed Nov 10 20:44:26 2010 +0800
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+#
+# DW::Controller::MemcacheClear
+#
+# Clear memcache for a user
+#
+# Authors:
+#      Andrea Nall <anall@andreanall.com>
+#
+# Copyright (c) 2010 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::Controller::Admin::MemcacheClear;
+
+use strict;
+use warnings;
+use DW::Controller;
+use DW::Routing;
+use DW::Template;
+use DW::Controller::Admin;
+
+use LJ::User;
+use LJ::Userpic;
+
+DW::Routing->register_string( "/admin/memcache_clear", \&index_controller );
+DW::Controller::Admin->register_admin_page( '/',
+    path => 'memcache_clear',
+    ml_scope => '/admin/memcache_clear.tt',
+    privs => [ 'siteadmin:memcacheclear' ]
+);
+
+my %clear = (
+    all => {
+        order => -1,
+        action => sub { LJ::wipe_major_memcache( $_[0] ); },
+    },
+    userpic => {
+        action => sub { LJ::Userpic->delete_cache( $_[0] ); },
+    }
+);
+
+map {
+    $clear{$_}->{key} = $_;
+    $clear{$_}->{name_ml} = ".purge.$_";
+} keys %clear;
+
+sub index_controller {
+    my ( $ok, $rv ) = controller( privcheck => [ "siteadmin:memcacheclear" ] );
+    return $rv unless $ok;
+
+    my $r = DW::Request->get;
+    my $args = $r->post_args || $r->get_args || {};
+
+    my $vars = {
+        %$rv,
+
+        # so the controller looking up the ML strings does not pollute our hash.
+        clear_options => [ map { { %$_ } } values %clear ],
+    };
+
+    if ( $r->method eq 'POST' ) {
+        eval {
+            die "Invalid form auth" unless LJ::check_form_auth( $args->{lj_form_auth} );
+
+            my $u = LJ::load_user( $args->{username} );
+            die "Invalid username" unless $u;
+
+            my $what = $clear{ $args->{what} || 'all' };
+            die "Invalid key" unless $what;
+
+            $what->{action}->( $u );
+            $vars->{cleared} = 1;
+        };
+        if ( $@ ) {
+            $vars->{error} = $@;
+        }
+    }
+
+    return DW::Template->render_template( 'admin/memcache_clear.tt', $vars );
+}
+
+1;
diff -r 1bbe1e229f5f -r ba456f5dde11 cgi-bin/DW/Template/VMethods.pm
--- a/cgi-bin/DW/Template/VMethods.pm	Wed Nov 10 19:14:37 2010 +0800
+++ b/cgi-bin/DW/Template/VMethods.pm	Wed Nov 10 20:44:26 2010 +0800
@@ -18,15 +18,32 @@ use strict;
 use strict;
 use Template::Stash;
 
+my $sort_subs = {
+    alpha => sub { $_[0] cmp $_[1] },
+    numeric => sub { $_[0] <=> $_[1] },
+};
+
 $Template::Stash::LIST_OPS->{ sort_by_key } = sub {
-    my ( $lst, $k, $type ) = @_;
+    my ( $lst, $k, $type, @rest ) = @_;
 
     my @r = ();
-    $type ||= 'alpha';
-    if ( $type eq 'alpha' ) {
-        @r = sort { $a->{$k} cmp $b->{$k} } @$lst; 
-    } elsif ( $type eq 'numeric' ) {
-        @r = sort { $a->{$k} <=> $b->{$k} } @$lst; 
+    my $sb = $sort_subs->{ $type || 'alpha' };
+
+    if ( $type eq 'order' ) {
+        my ( $v_type, $o_ky ) = @rest;
+        $o_ky ||= 'order';
+
+        $sb = $sort_subs->{ $v_type || 'alpha' };
+        return $lst unless defined $sb;
+
+        @r = sort {
+                ( $a->{$o_ky} || 0 ) <=> ( $a->{$o_ky} || 0 ) ||
+                $sb->( $a->{$k}, $b->{$k} )
+            } @$lst;
+    } elsif ( defined $sb ) {
+        @r = sort { $sb->( $a->{$k}, $b->{$k} ) } @$lst;
+    } else {
+        return $lst;
     }
 
     return \@r;
diff -r 1bbe1e229f5f -r ba456f5dde11 views/admin/memcache_clear.tt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/views/admin/memcache_clear.tt	Wed Nov 10 20:44:26 2010 +0800
@@ -0,0 +1,15 @@
+[%- sections.title = '.admin.link' | ml -%]
+
+[%- IF cleared -%]<p>[% '.cleared' | ml %]</p>[%- END -%]
+[%- IF error -%]<p><strong>[% error %]</strong></p>[%- END -%]
+<form action="/admin/memcache_clear" method="POST">
+    [% dw.form_auth %]
+    <div><label for="username">[% '.username.label' | ml %]</label><input id="username" name="username" /></div>
+    <div><label for="what">[% '.what.label' | ml %]</label><select id="what" name="what">
+        [%- FOREACH opt IN clear_options -%][%- opt.name = opt.name_ml | ml -%][%- END -%]
+        [%- FOREACH opt IN clear_options.sort_by_key( 'name', 'order', 'alpha' ) -%]
+            <option value="[% opt.key %]">[% opt.name %]</option>
+        [%- END -%]
+    </select></div>
+    <div><input type="submit" value="[% '.purge.btn' | ml %]" /></div>
+</form>
diff -r 1bbe1e229f5f -r ba456f5dde11 views/admin/memcache_clear.tt.text
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/views/admin/memcache_clear.tt.text	Wed Nov 10 20:44:26 2010 +0800
@@ -0,0 +1,14 @@
+;; -*- coding: utf-8 -*-
+
+.admin.link=Memcache Clear
+.admin.text=Clear memcache data for a user.
+
+.cleared=Memcache data cleared.
+
+.username.label=Username:
+.what.label=Purge:
+
+.purge.all=All (Major Memcache)
+.purge.userpic=Userpic
+
+.purge.btn=Clear for User
--------------------------------------------------------------------------------