Annotation of loncom/build/cpfiles.pl, revision 1.1
1.1 ! www 1: #!/usr/bin/perl
! 2: #
! 3: # Script to move author spaces from
! 4: # /home/author
! 5: # to
! 6: # /home/httpd/html/priv/domain/author
! 7: #
! 8: # Should not be run automatically, but manually as part of the installation
! 9: #
! 10: # Since this is going to be run during installation, we cannot rely on lonc/lond/lonnet,
! 11: # and need to collect information the pedestrian way
! 12: #
! 13: use strict;
! 14: use File::Copy;
! 15:
! 16: print "\nScript to move author spaces\n";
! 17: print "-----------------------------\n\n";
! 18: print "If run without parameters, the script will just tell you what it *would* do\n";
! 19: print "and give you warnings regarding possible problems.\n\n";
! 20:
! 21: my $parameter=shift;
! 22:
! 23: my ($login,$pass,$uid,$gid) = getpwnam('www');
! 24:
! 25: my $commit=($parameter=~/commit/);
! 26:
! 27: if ($commit) {
! 28: print "\n *** Really running this\n";
! 29: } else {
! 30: print "\nJust running in exploratory mode.\n";
! 31: print "Run with parameter 'commit' to actually move the author spaces, e.g.\n";
! 32: print "cpfiles.pl commit\n\n";
! 33: }
! 34:
! 35: if ($commit) {
! 36: print "\nMaking /home/httpd/html/priv\n";
! 37: mkdir('/home/httpd/html/priv');
! 38: chown($uid,$gid,'/home/httpd/html/priv');
! 39: }
! 40:
! 41: # Authors hosted on this server
! 42: my %domauthors=();
! 43:
! 44: foreach my $domain_directory (</home/httpd/lonUsers/*>) {
! 45: my ($domain) = ($domain_directory=~/\/([^\/]+)$/);
! 46: print "Found domain: $domain\n";
! 47: my $dom_target="/home/httpd/html/priv/$domain";
! 48: if ($commit) {
! 49: print "Making $dom_target\n";
! 50: mkdir($dom_target);
! 51: chown($uid,$gid,$dom_target);
! 52: } else {
! 53: print "Would make $dom_target\n";
! 54: }
! 55: my @domauth=();
! 56: foreach my $domain_author (</home/httpd/html/res/$domain/*>) {
! 57: my ($author)=($domain_author=~/\/([^\/]+)$/);
! 58: push(@domauth,$author);
! 59: }
! 60: $domauthors{$domain}=join(',',@domauth);
! 61: print "Authors in $domain: $domauthors{$domain}\n";
! 62: }
! 63:
! 64: # Go over all directories in the /home-directory
! 65: foreach my $home_directory (</home/*>) {
! 66: # Extract the author name
! 67: my ($author) = ($home_directory=~/\/([^\/]+)$/);
! 68: # Does this have a public_html-directory?
! 69: unless (-e "/home/$author/public_html") { next; }
! 70: print "Found author: $author\n";
! 71: my $domain='';
! 72: foreach my $trydom (keys(%domauthors)) {
! 73: foreach my $domauth (split(/\,/,$domauthors{$trydom})) {
! 74: if ($author eq $domauth) {
! 75: print "$author found in $domauth\n";
! 76: if ($domain) {
! 77: print "*** ERROR: $author found in $domain earlier\n";
! 78: print "*** This could be a serious problem\n";
! 79: print "Enter 1: use $domain\n";
! 80: print "Enter 2: use $trydom\n";
! 81: print "Enter 3: stop\n";
! 82: print "Your input: ";
! 83: my $choice=<STDIN>;
! 84: if ($choice==3) { print "Stopped.\n"; exit; }
! 85: if ($choice==2) { $domain=$trydom; }
! 86: } else {
! 87: $domain=$trydom;
! 88: }
! 89: print "Will use $domain for $author\n";
! 90: }
! 91: }
! 92: }
! 93: if ($domain) {
! 94: my $source_path="/home/$author/public_html";
! 95: my $target_path="/home/httpd/html/priv/$domain/$author";
! 96: if ($commit) {
! 97: print "Moving $source_path to $target_path\n";
! 98: move($source_path,$target_path);
! 99: chown($uid,$gid,$target_path);
! 100: } else {
! 101: print "Would move $source_path to $target_path\n";
! 102: }
! 103: } else {
! 104: print "*** WARNING: $author has no domain. The author may not have published.\n";
! 105: }
! 106: }
! 107: print "\nDone.\n";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>