[BACK]Return to expire_DC_role.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/expire_DC_role.pl between versions 1.1 and 1.2

version 1.1, 2011/03/07 23:13:40 version 1.2, 2011/03/28 21:16:08
Line 69  use lib '/home/httpd/lib/perl/'; Line 69  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonlocal;  use Apache::lonlocal();
 &Apache::lonlocal::get_language_handle();  
   
 =pod  =pod
   
Line 87  The second argument specifies the domain Line 86  The second argument specifies the domain
   
 =cut  =cut
   
   my ($user,$role_domain) = (@ARGV);
   my $lang = &Apache::lonlocal::choose_language();
   &Apache::lonlocal::get_language_handle(undef,$lang);
   
   if ($< != 0) { # Am I root?
       print(&mt('You must be root in order to expire a domain coordinator role.').
             "\n");
       exit;
   }
 # ----------------------------------------------- So, are we invoked correctly?  # ----------------------------------------------- So, are we invoked correctly?
 # Two arguments or abort  # Two arguments or abort
 if (@ARGV!=2) {  if (@ARGV!=2) {
     die('usage: expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]'.      print(&mt('usage: [_1]','expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]').
  "\n");   "\n");
       exit;
 }  }
 my ($user,$role_domain)=(@ARGV);  my ($user,$role_domain)=(@ARGV);
 my ($username,$domain)=split(':',$user);  my ($username,$domain)=split(':',$user);
 if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {  if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {
     die('**** ERROR **** Domain '.$role_domain.' is not a domain for which this server is a library server.'."\n");      print(&mt('**** ERROR **** Domain [_1] is not a domain for which this server is a library server.',$role_domain)."\n");
       exit;
 }  }
   
 my $udpath=&propath($domain,$username);  my $udpath=&propath($domain,$username);
 if (!-d $udpath) {  if (!-d $udpath) {
     die ('**** ERROR **** '.$user.' is not a LON-CAPA user for which this is the homeserver.'."\n");      print(&mt('**** ERROR **** [_1] is not a LON-CAPA user for which this is the homeserver.',$user)."\n");
       exit;
 }  }
   
 use GDBM_File; # A simple key-value pairing database.  use GDBM_File; # A simple key-value pairing database.
   
 my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());  my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
 if (!$rolesref) {  if (!$rolesref) {
     die('unable to tie roles db: '."$udpath/roles.db");      print(&mt('unable to tie [_1]',"roles db: $udpath/roles.db")."\n");
       exit;
 }  }
 my ($start,$status,$now);  my ($start,$status,$now);
 $now = time();  $now = time();
Line 175  my $dompath = $perlvar{'lonUsersDir'}.'/ Line 187  my $dompath = $perlvar{'lonUsersDir'}.'/
 my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());  my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
   
 if (!$domrolesref) {  if (!$domrolesref) {
     die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db");      print(&mt('unable to tie [_1]',"nohist_domainroles db: $dompath/nohist_domainroles.db")."\n");
       exit;
 }  }
   
 # Store in nohist_domainroles.db  # Store in nohist_domainroles.db
Line 189  $domrolesref->{$domkey}= &LONCAPA::escap Line 202  $domrolesref->{$domkey}= &LONCAPA::escap
 # Output success message.  # Output success message.
 print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");  print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
   
   exit;
Removed from v.1.1  
changed lines
  Added in v.1.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>