[LON-CAPA-cvs] cvs: modules /gerd/authorspace cpfiles.pl

[www]

www		Fri Jun 24 15:54:50 2011 EDT

  Modified files:              
    /modules/gerd/authorspace	cpfiles.pl 
  Log:
  Further work on domain moving script
  
  
Index: modules/gerd/authorspace/cpfiles.pl
diff -u modules/gerd/authorspace/cpfiles.pl:1.1 modules/gerd/authorspace/cpfiles.pl:1.2
--- modules/gerd/authorspace/cpfiles.pl:1.1	Thu Jun 23 21:03:15 2011
+++ modules/gerd/authorspace/cpfiles.pl	Fri Jun 24 15:54:50 2011
@@ -1,17 +1,54 @@
+#!/usr/bin/perl
+#
+# Script to move author spaces from
+# /home/author
+# to
+# /home/httpd/html/priv/domain/author
+#
+# Should not be run automatically, but manually as part of the installation for 3.0
+#
+# Since this is going to be run during installation, we cannot rely on lonc/lond/lonnet,
+# and need to collect information the pedestrian way
+#
 use strict;
+use File::Copy;
 
-# Domains hosted on this server
-my @thislibdoms=();
-# Read the host table
-open(IN,"/home/httpd/lonTabs/dns_hosts.tab");
-while (my $line=<IN>) {
-   if ($line=~/^\s*\#/) { next; }
-   chomp($line);
-   unless ($line=~/\S/) { next; }
-   my ($server,$domain,$function,$ip,$protocol,$interdom)=split(/\:/,$line);
-# Okay, now is this me?
+print "\nScript to move author spaces\n";
+print "-----------------------------\n\n";
+print "If run without parameters, the script will just tell you what it *would* do\n";
+print "and give you warnings regarding possible problems.\n\n";
+
+my $parameter=shift;
+
+my $commit=($parameter=~/commit/);
+
+if ($commit) {
+   print "\n *** Really running this\n";
+} else {
+   print "\nJust running in exploratory mode.\n";
+   print "Run with parameter 'commit' to actually move the author spaces, e.g.\n";
+   print "cpfiles.pl commit\n\n";
+}
+
+if ($commit) {
+   print "\nMaking /home/httpd/html/priv\n";
+   mkdir('/home/httpd/html/priv');
+}
+
+# Authors hosted on this server
+my %domauthors=();
+
+foreach my $domain_directory (</home/httpd/lonUsers/*>) {
+   my ($domain) = ($domain_directory=~/\/([^\/]+)$/);
+   print "Found domain: $domain\n";
+   my @domauth=();
+   foreach my $domain_author (</home/httpd/html/res/$domain/*>) {
+      my ($author)=($domain_author=~/\/([^\/]+)$/);
+      push(@domauth,$author);
+   }
+   $domauthors{$domain}=join(',',@domauth);
+   print "Authors in $domain: $domauthors{$domain}\n";
 }
-close(IN);
 
 # Go over all directories in the /home-directory
 foreach my $home_directory (</home/*>) {
@@ -19,5 +56,31 @@
    my ($author) = ($home_directory=~/\/([^\/]+)$/); 
 # Does this have a public_html-directory?
    unless (-e "/home/$author/public_html") { next; }
-   print "$author\n";
+   print "Found author: $author\n";
+   my $domain='';
+   foreach my $trydom (keys(%domauthors)) {
+      foreach my $domauth (split(/\,/,$domauthors{$trydom})) {
+         if ($author eq $domauth) {
+            print "$author found in $domauth\n";
+            if ($domain) {
+               print "*** ERROR: $author found in $domain earlier\n";
+               print "*** This could be a serious problem\n";
+               print "Enter 1: use $domain\n";
+               print "Enter 2: use $trydom\n";
+               print "Enter 3: stop\n";
+               print "Your input: ";
+               my $choice=<STDIN>;
+               if ($choice==3) { print "Stopped.\n"; exit; }
+               if ($choice==2) { $domain=$trydom; }
+            } else {
+               $domain=$trydom;
+            }
+            print "Will use $domain for $author\n";
+         }   
+      }  
+   }
+   unless ($domain) {
+      print "*** WARNING: $author has no domain. The author may not have published.\n";
+   }
+   
 }