Annotation of loncom/build/cpfiles.pl, revision 1.2

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";
1.2     ! www       105:       print "Enter 1: do nothing, continue\n";
        !           106:       print "Enter 2: stop\n";
        !           107:       print "or enter domain for user to be placed into\n";
        !           108:       print "Your input: ";
        !           109:       my $choice=<STDIN>;
        !           110:       if ($choice==2) { print "Stopped.\n"; exit; }
        !           111:       if ($choice!=1) {
        !           112:          chomp($choice);
        !           113:          if ($choice) {
        !           114:             my $dompath="/home/httpd/html/priv/$choice";
        !           115:             my $newpath="/home/httpd/html/priv/$choice/$author";
        !           116:             unless (-e $dompath) {
        !           117:                print "*** WARNING: $dompath does not yet exist.\n";
        !           118:             }
        !           119:             if ($commit) {
        !           120:                print "Making author $author in domain $choice\n";
        !           121:                unless (-e $dompath) {
        !           122:                   print "Making $dompath\n";
        !           123:                   mkdir($dompath);
        !           124:                   chown($uid,$gid,$dompath);
        !           125:                }
        !           126:                print "Making $newpath\n";
        !           127:                mkdir($newpath);
        !           128:                chown($uid,$gid,$newpath);
        !           129:             } else {
        !           130:                print "Would make author $author in domain $choice\n";
        !           131:                unless (-e $dompath) {
        !           132:                   print "Would make $dompath\n";
        !           133:                }
        !           134:                print "Would make $newpath\n";
        !           135:             }
        !           136:          }
        !           137:       }
1.1       www       138:    }
                    139: }
                    140: print "\nDone.\n";

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