--- loncom/lonnet/perl/lonnet.pm	2002/09/17 21:19:19	1.285
+++ loncom/lonnet/perl/lonnet.pm	2002/12/04 15:23:39	1.304
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.285 2002/09/17 21:19:19 matthew Exp $
+# $Id: lonnet.pm,v 1.304 2002/12/04 15:23:39 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -77,8 +77,8 @@ use Apache::File;
 use LWP::UserAgent();
 use HTTP::Headers;
 use vars 
-qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom 
-   %libserv %pr %prp %metacache %packagetab 
+qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
+   %libserv %pr %prp %metacache %packagetab %titlecache 
    %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf %courseresdatacache %domaindescription);
 use IO::Socket;
@@ -86,6 +86,8 @@ use GDBM_File;
 use Apache::Constants qw(:common :http);
 use HTML::LCParser;
 use Fcntl qw(:flock);
+use Apache::loncoursedata;
+
 my $readit;
 
 # --------------------------------------------------------------------- Logging
@@ -591,6 +593,59 @@ sub idput {
 
 # ------------------------------------- Find the section of student in a course
 
+sub getsection {
+    my ($udom,$unam,$courseid)=@_;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my %Pending; 
+    my %Expired;
+    #
+    # Each role can either have not started yet (pending), be active, 
+    #    or have expired.
+    #
+    # If there is an active role, we are done.
+    #
+    # If there is more than one role which has not started yet, 
+    #     choose the one which will start sooner
+    # If there is one role which has not started yet, return it.
+    #
+    # If there is more than one expired role, choose the one which ended last.
+    # If there is a role which has expired, return it.
+    #
+    foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+                        &homeserver($unam,$udom)))) {
+        my ($key,$value)=split(/\=/,$_);
+        $key=&unescape($key);
+        next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/);
+        my $section=$1;
+        if ($key eq $courseid.'_st') { $section=''; }
+        my ($dummy,$end,$start)=split(/\_/,&unescape($value));
+        my $now=time;
+        if (defined($end) && ($now > $end)) {
+            $Expired{$end}=$section;
+            next;
+        }
+        if (defined($start) && ($now < $start)) {
+            $Pending{$start}=$section;
+            next;
+        }
+        return $section;
+    }
+    #
+    # Presumedly there will be few matching roles from the above
+    # loop and the sorting time will be negligible.
+    if (scalar(keys(%Pending))) {
+        my ($time) = sort {$a <=> $b} keys(%Pending);
+        return $Pending{$time};
+    } 
+    if (scalar(keys(%Expired))) {
+        my @sorted = sort {$a <=> $b} keys(%Expired);
+        my $time = pop(@sorted);
+        return $Expired{$time};
+    }
+    return '-1';
+}
+
 sub usection {
     my ($udom,$unam,$courseid)=@_;
     $courseid=~s/\_/\//g;
@@ -644,6 +699,30 @@ sub chatsend {
 		   &escape($newentry)),$chome);
 }
 
+# ------------------------------------------ Find current version of a resource
+
+sub getversion {
+    my $fname=&clutter(shift);
+    unless ($fname=~/^\/res\//) { return -1; }
+    return &currentversion(&filelocation('',$fname));
+}
+
+sub currentversion {
+    my $fname=shift;
+    my $author=$fname;
+    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+    my ($udom,$uname)=split(/\//,$author);
+    my $home=homeserver($uname,$udom);
+    if ($home eq 'no_host') { 
+        return -1; 
+    }
+    my $answer=reply("currentversion:$fname",$home);
+    if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
+	return -1;
+    }
+    return $answer;
+}
+
 # ----------------------------- Subscribe to a resource, return URL if possible
 
 sub subscribe {
@@ -652,7 +731,7 @@ sub subscribe {
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);
     my $home=homeserver($uname,$udom);
-    if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
+    if ($home eq 'no_host') { 
         return 'not_found'; 
     }
     my $answer=reply("sub:$fname",$home);
@@ -683,6 +762,11 @@ sub repcopy {
     } elsif ($remoteurl eq 'directory') {
            return OK;
     } else {
+        my $author=$filename;
+        $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+        my ($udom,$uname)=split(/\//,$author);
+        my $home=homeserver($uname,$udom);
+        unless ($home eq $perlvar{'lonHostID'}) {
            my @parts=split(/\//,$filename);
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
            if ($path ne "$perlvar{'lonDocRoot'}/res") {
@@ -718,6 +802,7 @@ sub repcopy {
                rename($transname,$filename);
                return OK;
            }
+       }
     }
 }
 
@@ -755,7 +840,8 @@ sub tokenwrapper {
     if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
 	&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
         return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
-               (($uri=~/\?/)?'&':'?').'token='.$token;
+               (($uri=~/\?/)?'&':'?').'token='.$token.
+                               '&tokenissued='.$perlvar{'lonHostID'};
     } else {
 	return '/adm/notfound.html';
     }
@@ -808,13 +894,16 @@ sub finishuserfileupload {
     }
 # Notify homeserver to grep it
 #
-    if 
-(&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok') 
-    {
+    
+    my $fetchresult= 
+ &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome);
+    if ($fetchresult eq 'ok') {
 #
 # Return the URL to it
         return '/uploaded/'.$path.$fname;
     } else {
+        &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname.
+         ' to host '.$docuhome.': '.$fetchresult);
         return '/adm/notfound.html';
     }    
 }
@@ -1015,7 +1104,7 @@ sub devalidate {
     if ($cid) {
 	my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
         my $status=
-	    &del('nohist_calculatedsheet',
+	    &del('nohist_calculatedsheets',
 		 [$key.'studentcalc'],
 		 $ENV{'course.'.$cid.'.domain'},
 		 $ENV{'course.'.$cid.'.num'})
@@ -1454,11 +1543,15 @@ sub coursedescription {
     $courseid=~s/\_/\//g;
     my ($cdomain,$cnum)=split(/\//,$courseid);
     my $chome=&homeserver($cnum,$cdomain);
+    my $normalid=$cdomain.'_'.$cnum;
+    # need to always cache even if we get errors otherwise we keep 
+    # trying and trying and trying to get the course description.
+    my %envhash=();
+    my %returnhash=();
+    $envhash{'course.'.$normalid.'.last_cache'}=time;
     if ($chome ne 'no_host') {
-       my %returnhash=&dump('environment',$cdomain,$cnum);
+       %returnhash=&dump('environment',$cdomain,$cnum);
        if (!exists($returnhash{'con_lost'})) {
-           my $normalid=$cdomain.'_'.$cnum;
-           my %envhash=();
            $returnhash{'home'}= $chome;
 	   $returnhash{'domain'} = $cdomain;
 	   $returnhash{'num'} = $cnum;
@@ -1468,15 +1561,13 @@ sub coursedescription {
            $returnhash{'url'}=&clutter($returnhash{'url'});
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
 	       $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
-           $envhash{'course.'.$normalid.'.last_cache'}=time;
            $envhash{'course.'.$normalid.'.home'}=$chome;
            $envhash{'course.'.$normalid.'.domain'}=$cdomain;
            $envhash{'course.'.$normalid.'.num'}=$cnum;
-           &appenv(%envhash);
-           return %returnhash;
        }
     }
-    return ();
+    &appenv(%envhash);
+    return %returnhash;
 }
 
 # -------------------------------------------------------- Get user privileges
@@ -1714,7 +1805,9 @@ sub allowed {
 
     if ($priv eq 'bre') {
         my $copyright=&metadata($uri,'copyright');
-	if ($copyright eq 'public') { return 'F'; }
+	if (($copyright eq 'public') && (!$ENV{'request.course.id'})) { 
+           return 'F'; 
+        }
         if ($copyright eq 'priv') {
             $uri=~/([^\/]+)\/([^\/]+)\//;
 	    unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) {
@@ -1986,14 +2079,15 @@ sub is_on_map {
     my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
-    $pathname=~s/\/$filename$//;
+    $pathname=~s|/\Q$filename\E$||;
+    #Trying to find the conditional for the file
     my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
-	       /\&$filename\:([\d\|]+)\&/);
+	       /\&\Q$filename\E\:([\d\|]+)\&/);
     if ($match) {
-       return (1,$1);
-   } else {
-       return (0,0);
-   }
+	return (1,$1);
+    } else {
+	return (0,0);
+    }
 }
 
 # ----------------------------------------------------------------- Define Role
@@ -2284,20 +2378,59 @@ sub modifystudent {
 	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
          $desiredhome);
     unless ($reply eq 'ok') { return $reply; }
+    # This will cause &modify_student_enrollment to get the uid from the
+    # students environment
+    $uid = undef if (!$forceid);
+    $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,
+                                        $last,$gene,$usec,$end,$start);
+    return $reply;
+}
+
+sub modify_student_enrollment {
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_;
+    # Get the course id from the environment
+    my $cid='';
+    unless ($cid=$ENV{'request.course.id'}) {
+	return 'not_in_class';
+    }
+    # Make sure the user exists
     my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such user';
     }
-# -------------------------------------------------- Add student to course list
-    $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+    #
+    # Get student data if we were not given enough information
+    if (!defined($first)  || $first  eq '' || 
+        !defined($last)   || $last   eq '' || 
+        !defined($uid)    || $uid    eq '' || 
+        !defined($middle) || $middle eq '' || 
+        !defined($gene)   || $gene   eq '') {
+        # They did not supply us with enough data to enroll the student, so
+        # we need to pick up more information.
+        my %tmp = &get('environment',
+                       ['firstname','middlename','lastname', 'generation','id']
+                       ,$udom,$uname);
+
+        foreach (keys(%tmp)) {
+            &logthis("key $_ = ".$tmp{$_});
+        }
+        $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
+        $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
+        $last   = $tmp{'lastname'}   if (!defined($last)   || $last eq '');
+        $gene   = $tmp{'generation'} if (!defined($gene)   || $gene eq '');
+        $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');
+    }
+    my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,
+                                                           $first,$middle);
+    my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
                       &escape($uname.':'.$udom).'='.
-                      &escape($end.':'.$start),
+                      &escape(join(':',$end,$start,$uid,$usec,$fullname)),
 	              $ENV{'course.'.$cid.'.home'});
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {
 	return 'error: '.$reply;
     }
-# ---------------------------------------------------- Add student role to user
+    # Add student role to user
     my $uurl='/'.$cid;
     $uurl=~s/\_/\//g;
     if ($usec) {
@@ -2588,11 +2721,11 @@ sub courseresdata {
 	}
     }
     foreach my $item (@which) {
-	if ($courseresdatacache{$hashid}->{$item}) {
+	if (defined($courseresdatacache{$hashid}->{$item})) {
 	    return $courseresdatacache{$hashid}->{$item};
 	}
     }
-    return '';
+    return undef;
 }
 
 # --------------------------------------------------------- Value of a Variable
@@ -2739,7 +2872,7 @@ sub EXT {
 					  ($seclevelr,$seclevelm,$seclevel,
 					   $courselevelr,$courselevelm,
 					   $courselevel));
-	    if ($coursereply) { return $coursereply; }
+	    if (defined($coursereply)) { return $coursereply; }
 
 # ------------------------------------------------------ third, check map parms
 	    my %parmhash=();
@@ -2763,9 +2896,9 @@ sub EXT {
 	    $filename=$ENV{'request.filename'};
 	}
 	my $metadata=&metadata($filename,$spacequalifierrest);
-	if ($metadata) { return $metadata; }
+	if (defined($metadata)) { return $metadata; }
 	$metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
-	if ($metadata) { return $metadata; }
+	if (defined($metadata)) { return $metadata; }
 
 # ------------------------------------------------------------------ Cascade up
 	unless ($space eq '0') {
@@ -2773,11 +2906,11 @@ sub EXT {
 	    if ($id) {
 		my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
 				     $symbparm,$udom,$uname);
-		if ($partgeneral) { return $partgeneral; }
+		if (defined($partgeneral)) { return $partgeneral; }
 	    } else {
 		my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
 					 $symbparm,$udom,$uname);
-		if ($resourcegeneral) { return $resourcegeneral; }
+		if (defined($resourcegeneral)) { return $resourcegeneral; }
 	    }
 	}
 
@@ -2806,6 +2939,11 @@ sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
 
     $uri=&declutter($uri);
+    # if it is a non metadata possible uri return quickly
+    if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
+        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|)) {
+	return '';
+    }
     my $filename=$uri;
     $uri=~s/\.meta$//;
 #
@@ -2963,6 +3101,33 @@ sub metadata_generate_part0 {
     }
 }
 
+# ------------------------------------------------- Get the title of a resource
+
+sub gettitle {
+    my $urlsymb=shift;
+    my $symb=&symbread($urlsymb);
+    unless ($symb) {
+	unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
+        return &metadata($urlsymb,'title'); 
+    }
+    if ($titlecache{$symb}) { return $titlecache{$symb}; }
+    my ($map,$resid,$url)=split(/\_\_\_/,$symb);
+    my $title='';
+    my %bighash;
+    if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+                            &GDBM_READER(),0640)) {
+        my $mapid=$bighash{'map_pc_'.&clutter($map)};
+        $title=$bighash{'title_'.$mapid.'.'.$resid};
+        untie %bighash;
+    }
+    if ($title) {
+        $titlecache{$symb}=$title;
+        return $title;
+    } else {
+	return &metadata($urlsymb,'title');
+    }
+}
+    
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -3309,12 +3474,14 @@ BEGIN {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
 
     while (my $configline=<$config>) {
+       next if ($configline =~ /^(\#|\s*$)/);
        chomp($configline);
        my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
        if ($id && $domain && $role && $name && $ip) {
 	 $hostname{$id}=$name;
 	 $hostdom{$id}=$domain;
 	 $hostip{$id}=$ip;
+	 $iphost{$ip}=$id;
 	 if ($domdescr) { $domaindescription{$domain}=$domdescr; }
 	 if ($role eq 'library') { $libserv{$id}=$name; }
        } else {
@@ -3595,7 +3762,83 @@ modify user
 
 =item *
 
-modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,$end,$start) : modify student
+modifystudent
+
+modify a students enrollment and identification information.
+The course id is resolved based on the current users environment.  
+This means the envoking user must be a course coordinator or otherwise
+associated with a course.
+
+This call is essentially a wrapper for lonnet::modifyuser and
+lonnet::modify_student_enrollment
+
+Inputs: 
+
+=over 4
+
+=item B<$udom> Students loncapa domain
+
+=item B<$uname> Students loncapa login name
+
+=item B<$uid> Students id/student number
+
+=item B<$umode> Students authentication mode
+
+=item B<$upass> Students password
+
+=item B<$first> Students first name
+
+=item B<$middle> Students middle name
+
+=item B<$last> Students last name
+
+=item B<$gene> Students generation
+
+=item B<$usec> Students section in course
+
+=item B<$end> Unix time of the roles expiration
+
+=item B<$start> Unix time of the roles start date
+
+=item B<$forceid> If defined, allow $uid to be changed
+
+=item B<$desiredhome> server to use as home server for student
+
+=back
+
+=item *
+
+modify_student_enrollment
+
+Change a students enrollment status in a class.  The environment variable
+'role.request.course' must be defined for this function to proceed.
+
+Inputs:
+
+=over 4
+
+=item $udom, students domain
+
+=item $uname, students name
+
+=item $uid, students user id
+
+=item $first, students first name
+
+=item $middle
+
+=item $last
+
+=item $gene
+
+=item $usec
+
+=item $end
+
+=item $start
+
+=back
+
 
 =item *