[prev in list] [next in list] [prev in thread] [next in thread]
List: lon-capa-cvs
Subject: [LON-CAPA-cvs] cvs: loncom /debugging_tools
From: raeburn <raeburn () source ! lon-capa ! org>
Date: 2011-10-27 14:01:21
Message-ID: cvsraeburn1319724081 () cvsserver
[Download RAW message or body]
This is a MIME encoded message
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".
["raeburn-20111027140121.txt" (text/plain)]
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$/,@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$/,@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) = @_;
_______________________________________________
LON-CAPA-cvs mailing list
LON-CAPA-cvs@mail.lon-capa.org
http://mail.lon-capa.org/mailman/listinfo/lon-capa-cvs
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic