From: Chris W. <la...@us...> - 2005-02-26 05:52:28
|
Update of /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Manage/Website In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28850/lib/OpenInteract2/Manage/Website Added Files: CleanOrphanedUsers.pm Log Message: OIN-91: add management task to cleanup orphaned users and modify the newuser action to read waittime from server configuration --- NEW FILE: CleanOrphanedUsers.pm --- package OpenInteract2::Manage::Website::CleanOrphanedUsers; # $Id: CleanOrphanedUsers.pm,v 1.1 2005/02/26 05:52:18 lachoy Exp $ use strict; use base qw( OpenInteract2::Manage::Website ); use Log::Log4perl qw( get_logger ); use OpenInteract2::Constants qw( :log ); use OpenInteract2::Context qw( CTX ); use OpenInteract2::Exception qw( oi_error ); $OpenInteract2::Manage::Website::CleanOrphanedUsers::VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/); sub get_name { return 'clean_users'; } sub get_brief_description { return "Remove users who created themselves via the wizard but did " . "not login within the time alloted."; } sub run_task { my ( $self ) = @_; my $users = OpenInteract2::User->fetch_group({ where => 'removal_date IS NOT NULL', order => 'removal_date DESC', }); my $now = CTX->create_date(); my @to_remove = (); foreach my $user ( @{ $users } ) { if ( $user->{removal_date} < $now ) { push @to_remove, $user; } } my $total = scalar @to_remove; my ( $success, $failed ) = ( 0, 0 ); my @errors = (); foreach my $user ( @to_remove ) { eval { $user->remove }; if ( $@ ) { $failed++; push @errors, "$@"; } else { $success++; } } if ( $success == $total ) { $self->_ok( 'clean users', "All available users ($total) removed" ); } else { my $msg = "$total users to delete, $success ok, $failed failed; errors:\n" . join( "\n", @errors ); $self->_fail( 'clean users', $msg ); } } OpenInteract2::Manage->register_factory_type( get_name() => __PACKAGE__ ); 1; __END__ =head1 NAME OpenInteract2::Manage::Website::CleanOrphanedUsers - Remove users who created an account but never logged in =head1 SYNOPSIS #!/usr/bin/perl use strict; use OpenInteract2::Manage; my $website_dir = '/home/httpd/mysite'; my $task = OpenInteract2::Manage->new( 'clean_users', website_dir => $website_dir ); my @status = $task->execute; foreach my $s ( @status ) { my $ok_label = ( $s->{is_ok} eq 'yes' ) ? 'OK' : 'NOT OK'; my $default_label = ( $s->{is_default} eq 'yes' ) ? ' (default) ' : ''; print "Status OK? $s->{is_ok}\n", "$s->{message}\n"; } =head1 STATUS INFORMATION No additional information. =head1 COPYRIGHT Copyright (C) 2005 Chris Winters. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Chris Winters, E<lt>ch...@cw...E<gt> |