[LON-CAPA-cvs] cvs: loncom /debugging_tools move_construction_spaces.pl
raeburn
raeburn at source.lon-capa.org
Thu Oct 27 10:01:21 EDT 2011
raeburn Thu Oct 27 14:01:21 2011 EDT
Modified files:
/loncom/debugging_tools move_construction_spaces.pl
Log:
- Retrieval of perlvars moved to BEGIN block.
- Checking domain for /home/<user> now in order:
(1) Look in nohist_domainroles.db for each domain hosted on server.
(2) Look in /home/httpd/html/res/<domain> for each domain hosted on server.
(3) Look in /home/httpd/lonUsers/<domain>1/2/3/<user>/roles.db for
each domain hosted for author role.
- Where domain is specified from command line
- sanity checking.
- request confirmation to proceed with chosen domain.
- Counts of number skipped and number moved/would be moved
displayed when run complete, logged if mode is: "move".
-------------- next part --------------
Index: loncom/debugging_tools/move_construction_spaces.pl
diff -u loncom/debugging_tools/move_construction_spaces.pl:1.4 loncom/debugging_tools/move_construction_spaces.pl:1.5
--- loncom/debugging_tools/move_construction_spaces.pl:1.4 Thu Oct 27 03:43:53 2011
+++ loncom/debugging_tools/move_construction_spaces.pl Thu Oct 27 14:01:21 2011
@@ -5,7 +5,7 @@
# Move Construction Spaces from /home/$user/public_html
# to /home/httpd/html/priv/$domain/$user and vice versa
#
-# $Id: move_construction_spaces.pl,v 1.4 2011/10/27 03:43:53 raeburn Exp $
+# $Id: move_construction_spaces.pl,v 1.5 2011/10/27 14:01:21 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,6 +39,18 @@
use File::Copy;
use GDBM_File;
+my ($lonusersdir,$londocroot,$londaemons);
+
+BEGIN {
+ my $perlvar=&LONCAPA::Configuration::read_conf();
+ if (ref($perlvar) eq 'HASH') {
+ $lonusersdir = $perlvar->{'lonUsersDir'};
+ $londocroot = $perlvar->{'lonDocRoot'};
+ $londaemons = $perlvar->{'lonDaemons'};
+ }
+ undef($perlvar);
+}
+
my $lang = &Apache::lonlocal::choose_language();
&Apache::lonlocal::get_language_handle(undef,$lang);
@@ -48,16 +60,7 @@
exit;
}
-my $perlvar=&LONCAPA::Configuration::read_conf();
-my ($lonuserdir,$londocroot,$londaemons);
-if (ref($perlvar) eq 'HASH') {
- $lonuserdir = $perlvar->{'lonUsersDir'};
- $londocroot = $perlvar->{'lonDocRoot'};
- $londaemons = $perlvar->{'lonDaemons'};
-}
-undef($perlvar);
-
-if ($lonuserdir eq '') {
+if ($lonusersdir eq '') {
print &mt('Could not determine location of [_1] directory.',"'lonUsersDir'")."\n".
&mt('Stopping')."\n";
exit;
@@ -168,7 +171,7 @@
}
if ($action eq 'dryrun') {
- print "\n".
+ print "\n\n".
&mt('Running in exploratory mode ...')."\n\n".
&mt('Run with argument [_1] to actually move Construction Spaces to [_2], i.e., [_3]',
"'move'","'$londocroot/priv'","\n\nperl move_construction_spaces.pl move")."\n\n\n".
@@ -247,12 +250,12 @@
}
my @machinedoms;
-if ($lonuserdir) {
+if ($lonusersdir) {
my ($dir,$output);
- if (opendir($dir,$lonuserdir)) {
+ if (opendir($dir,$lonusersdir)) {
my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
foreach my $item (@contents) {
- if (-d "$lonuserdir/$item") {
+ if (-d "$lonusersdir/$item") {
if ($item =~ /^$match_domain$/) {
my $domain = $item;
unless (grep(/^\Q$domain\E$/, at machinedoms)) {
@@ -279,7 +282,7 @@
}
}
my %authors=();
- my $fname = "$lonuserdir/$domain/nohist_domainroles.db";
+ my $fname = "$lonusersdir/$domain/nohist_domainroles.db";
my $dbref;
if (-e $fname) {
$dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
@@ -300,7 +303,7 @@
}
closedir($dir);
} else {
- $output = &mt('Could not open [_1].',"'$lonuserdir'")."\n";
+ $output = &mt('Could not open [_1].',"'$lonusersdir'")."\n";
print $output;
&stop_logging($logfh,$output);
print &mt('Stopping')."\n";
@@ -390,32 +393,67 @@
exit;
}
+my @allskipped;
+my %allmoved;
+
# Iterate over directories in /home
if (opendir(my $dir,"/home")) {
- foreach my $item (grep(!/^\.{1,2}$/,readdir($dir))) {
+ my @possibles = grep(!/^\.{1,2}$/,readdir($dir));
+ foreach my $item (sort(@possibles)) {
next if ($item eq 'www');
if ((-d "/home/$item") && ($item ne '')) {
# Is there a public_html-directory?
if (-d "/home/$item/public_html") {
my $author = $item;
my ($domain,$skipped,$output);
- if (ref($pubusers{$author}) eq 'ARRAY') {
- ($domain,$skipped) = &choose_domain($action,$author,$pubusers{$author});
+ if (ref($allauthors{$author}) eq 'ARRAY') {
+ ($domain,$skipped) = &choose_domain($action,$author,$allauthors{$author});
}
if (($domain eq '') && (!$skipped)) {
- if (ref($allauthors{$author}) eq 'ARRAY') {
- ($domain,$skipped) = &choose_domain($action,$author,$allauthors{$author});
+ if (ref($pubusers{$author}) eq 'ARRAY') {
+ ($domain,$skipped) = &choose_domain($action,$author,$pubusers{$author});
+ }
+ }
+ if (($domain eq '') && (!$skipped)) {
+ my @foundauthor = ();
+ foreach my $dom (@machinedoms) {
+ my $posspath = &LONCAPA::propath($dom,$author);
+ if (-e $posspath) {
+ my $rolesdbref;
+ my $fname = "$posspath/roles.db";
+ if (-e "$fname") {
+ $rolesdbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
+ if (!$rolesdbref) {
+ print &mt('Unable to tie to [_1].',"'$fname'")."\n";
+ } elsif (ref($rolesdbref) eq 'HASH') {
+ foreach my $key (keys(%{$rolesdbref})) {
+ if ($key eq "/$dom/_au") {
+ unless(grep(/^\Q$dom\E$/, at foundauthor)) {
+ push(@foundauthor,$dom);
+ }
+ }
+ }
+ &LONCAPA::locking_hash_untie($rolesdbref);
+ }
+ }
+ }
+ }
+ if (@foundauthor > 0) {
+ ($domain,$skipped) = &choose_domain($action,$author,\@foundauthor);
}
}
my $source_path="/home/$author/public_html";
- if ($domain) {
+ if ($domain) {
my $target_path="$londocroot/priv/$domain/$author";
if ($action eq 'move') {
if (move($source_path,$target_path)) {
- chown($uid,$gid,$target_path);
- chmod($target_path,0750);
+ my (undef,undef,$userid,$groupid) = getpwnam($author);
+ if ($userid eq '' && $groupid eq '' && $author ne '') {
+ chown($uid,$gid,$target_path);
+ }
$output = &mt('Moved [_1] to [_2].',
"'$source_path'","'$target_path'")."\n";
+ push(@{$allmoved{$domain}},$author);
my (undef,undef,$userid,$groupid) = getpwnam($author);
if ($userid eq '' && $groupid eq '' && $author ne '') {
&check_for_restore_files($londaemons,$author,$domain);
@@ -447,22 +485,33 @@
print $output;
print $logfh $output;
} elsif ($action eq 'dryrun') {
+ push(@{$allmoved{$domain}},$author);
print &mt('Would move [_1] to [_2].',"'$source_path'","'$target_path'")."\n";
}
} elsif ($skipped) {
+ push(@allskipped,$author);
if ($action ne 'dryrun') {
- print $logfh &mt('Skipping this user: [_1].',"'$author'")."\n";
+ my $output = &mt('Skipping this user: [_1].',"'$author'")."\n";
+ print $logfh $output;
}
} else {
print '*** '.&mt('WARNING: [_1] has no domain.',"'$author'")."\n".
&mt('Enter [_1]: do nothing, continue.','1')."\n".
- &mt('Enter [_2]: stop.','2')."\n".
+ &mt('Enter [_1]: stop.','2')."\n".
&mt('or enter domain for user to be placed into')."\n".
&mt('Your input: ');
my $choice=<STDIN>;
chomp($choice);
- if ($choice ==1) {
- print $logfh &mt('Skipping -- no domain for user: [_1].',"'$author'")."\n";
+ $choice =~ s/^\s+//;
+ $choice =~ s/\s+$//;
+ if ($choice == 1) {
+ my $output = &mt('Skipping -- no domain for user: [_1].',"'$author'")."\n";
+ print $output;
+ if ($action ne 'dryrun') {
+ print $logfh $output;
+ }
+ push(@allskipped,$author);
+ next;
}
if ($choice == 2) {
print &mt('Stopped.')."\n";
@@ -472,12 +521,53 @@
&stop_logging($logfh,$output);
}
exit;
- }
- if ($choice =~ /^$match_domain$/) {
+ } elsif ($choice =~ /^$match_domain$/) {
+ print &mt('You entered:')." $choice\n".
+ &mt('Is this ok? ~[Y/n~] ');
+ if (!&get_user_selection(1)) {
+ print &mt('Try again ...')."\n".
+ &mt('Enter [_1]: do nothing, continue.','1')."\n".
+ &mt('Enter [_1]: stop.','2')."\n".
+ &mt('or enter domain for user to be placed into')."\n".
+ &mt('Your input: ');
+ $choice=<STDIN>;
+ chomp($choice);
+ $choice =~ s/^\s+//;
+ $choice =~ s/\s+$//;
+ if ($choice == 1) {
+ my $output = &mt('Skipping -- no domain for user: [_1].',"'$author'")."\n";
+ print $output;
+ if ($action ne 'dryrun') {
+ print $logfh $output;
+ }
+ push(@allskipped,$author);
+ next;
+ }
+ if ($choice == 2) {
+ print &mt('Stopped.')."\n";
+ if ($action ne 'dryrun') {
+ my $output = &mt('Stopped by user because of author without domain: [_1].',
+ "'$author'")/"\n";
+ &stop_logging($logfh,$output);
+ }
+ exit;
+ } elsif ($choice !~ /^$match_domain$/) {
+ print &mt('Invalid domain entered:')." $choice\n";
+ my $output = &mt('Skipping -- no domain for user: [_1].',"'$author'")."\n";
+ print $output;
+ if ($action ne 'dryrun') {
+ print $logfh $output;
+ }
+ push(@allskipped,$author);
+ next;
+ }
+ }
my $dompath="$londocroot/priv/$choice";
my $newpath="$londocroot/priv/$choice/$author";
unless (-e $dompath) {
- print '*** '.&mt('WARNING: [_1] does not yet exist.',"'$dompath'")."\n";
+ if ($action eq 'move') {
+ print '*** '.&mt('WARNING: [_1] does not yet exist.',"'$dompath'")."\n";
+ }
}
if ($action eq 'move') {
unless (-e $dompath) {
@@ -509,16 +599,46 @@
}
print &mt('Would make [_1].',"'$newpath'")."\n";
}
+ } else {
+ print &mt('Invalid domain:')." $choice\n";
+ if ($action eq 'move') {
+ print $logfh &mt('Skipping -- no domain for user: [_1].',"'$author'")."\n";
+ }
+ push(@allskipped,$author);
+ next;
}
}
}
}
}
}
+
+my ($moveinfo,$skipcount);
+if (keys(%allmoved) == 0) {
+ $moveinfo = &mt('None')."\n";
+} else {
+ foreach my $dom (sort(keys(%allmoved))) {
+ if (ref($allmoved{$dom}) eq 'ARRAY') {
+ $moveinfo .= "\n ".&mt('Domain: [_1], number of authors: [_2]',
+ "'$dom'",scalar(@{$allmoved{$dom}}));
+ }
+ }
+}
+
+$skipcount = scalar(@allskipped);
+
+print "\n";
if ($action ne 'dryrun') {
+ my $output = &mt('You skipped: [_1].',$skipcount)."\n".
+ &mt('Moved ... [_1]',$moveinfo);
+ print $output;
+ print $logfh $output;
&stop_logging($logfh);
+} else {
+ print &mt('You would have skipped: [_1].',$skipcount)."\n".
+ &mt('You would have moved ... [_1]',$moveinfo);
}
-print "\n".&mt('Done.')."\n";
+print "\n\n".&mt('Done.')."\n";
sub choose_domain {
my ($action,$author,$domarrayref) = @_;
More information about the LON-CAPA-cvs
mailing list