1 files changed, 58 insertions, 0 deletions
diff --git a/purge b/purge
new file mode 100755
index 0000000..32f178c
--- /dev/null
+++ b/purge
@@ -0,0 +1,58 @@
+#!/usr/bin/perl -T
+
+#----------------------------------------------------------------------
+# Fripost's admin panel - session prune job
+# Copyright © 2018 Fripost
+# Copyright © 2018 Guilhem Moulin <guilhem@fripost.org>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#----------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use lib "lib";
+use Fripost::Util "read_config";
+
+my %CONFIG = read_config();
+$CONFIG{www} //= {};
+
+my $cache = Fripost::Util::session_cache(%{$CONFIG{www}});
+
+if (-t \*STDOUT) {
+    my $count = 0;
+    my $count_expired = 0;
+    require "POSIX.pm";
+
+    foreach my $k ($cache->get_keys()) {
+        $count++;
+        my $obj = $cache->get_object($k) // next;
+        if ($obj->is_expired) {
+            $count_expired++;
+            my $date = POSIX::strftime("%Y-%m-%d %T %z",
+                    localtime($obj->expires_at()));
+            printf "  - %-32s expired on %s\n", $k, $date; 
+        }
+    }
+    print "$count keys founds (incl. $count_expired expired keys)\n";
+    print "Purging...\n"
+}
+
+$cache->purge();
+
+if (-t \*STDOUT) {
+    my $count = 0;
+    $count++ foreach $cache->get_keys();
+    print "$count keys left after purge()\n";
+}