File: expire.pl

package info (click to toggle)
slash 2.2.6-8etch1
  • links: PTS
  • area: main
  • in suites: etch
  • size: 3,672 kB
  • ctags: 1,915
  • sloc: perl: 23,113; sql: 1,878; sh: 433; makefile: 233
file content (44 lines) | stat: -rwxr-xr-x 1,458 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2001 by Open Source Development Network. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id: expire.pl,v 1.1.2.10 2001/09/17 20:17:20 jamie Exp $

use strict;
use vars qw( %task $me );
use Slash;
use Slash::DB;
use Slash::Display;
use Slash::Utility;

(my $VERSION) = ' $Revision: 1.1.2.10 $ ' =~ /\$Revision:\s+([^\s]+)/;

$task{$me}{timespec} = '2 6 * * *';
$task{$me}{timespec_panic_2} = ''; # if major panic, this can wait

# Handles mail and administrivia necessary for RECENTLY expired users.
$task{$me}{code} = sub {
	my($virtual_user, $constants, $slashdb, $user) = @_;

	# We only perform the check if any of the following are turned on.
	# the logic below, should probably be moved into Slash::Utility.
	if (!allowExpiry()) {
		return "user expiration disabled";
	}

	# This may need to go into a template somewhere.
	my $reg_subj = "Your $constants->{sitename} password has expired.";
	# Loop over all about-to-expire users.
	my @users_to_expire = @{$slashdb->checkUserExpiry()};
	for my $e_user (@users_to_expire) {
		# Put user in read-only mode for all forms and other 'pages' that
		# should be. This should also send the appropriate email. This
		# is better off in the API, as it is used in users.pl, as well.
		setUserExpired($e_user, 1);
	}

	return "expired " . scalar(@users_to_expire) . " users";
};

1;