--- loncom/lonnet/perl/lonnet.pm	2006/02/07 05:08:29	1.706
+++ loncom/lonnet/perl/lonnet.pm	2006/03/27 23:00:18	1.722
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.706 2006/02/07 05:08:29 raeburn Exp $
+# $Id: lonnet.pm,v 1.722 2006/03/27 23:00:18 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -260,6 +260,13 @@ sub critical {
 
 sub transfer_profile_to_env {
     my ($lonidsdir,$handle)=@_;
+    if (!defined($lonidsdir)) {
+	$lonidsdir = $perlvar{'lonIDsDir'};
+    }
+    if (!defined($handle)) {
+        ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );
+    }
+
     my @profile;
     {
 	open(my $idf,"$lonidsdir/$handle.id");
@@ -843,6 +850,7 @@ sub save_cache {
     my ($r)=@_;
     if (! $r->is_initial_req()) { return DECLINED; }
     &purge_remembered();
+    #&Apache::loncommon::validate_page();
     undef(%env);
     return OK;
 }
@@ -948,12 +956,12 @@ sub studentphoto {
     my ($udom,$unam,$ext) = @_;
     my $home=&Apache::lonnet::homeserver($unam,$udom);
     if (defined($env{'request.course.id'})) {
-        if ($env{'course.'.$env{'request.course.id'}.'.internal.showphotos'}) {
+        if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
             if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
                 return(&retrievestudentphoto($udom,$unam,$ext)); 
             } else {
                 my ($result,$perm_reqd)=
-                        &Apache::lonnet::auto_photo_permission($unam,$udom);
+		    &Apache::lonnet::auto_photo_permission($unam,$udom);
                 if ($result eq 'ok') {
                     if (!($perm_reqd eq 'yes')) {
                         return(&retrievestudentphoto($udom,$unam,$ext));
@@ -963,7 +971,7 @@ sub studentphoto {
         }
     } else {
         my ($result,$perm_reqd) = 
-                           &Apache::lonnet::auto_photo_permission($unam,$udom);
+	    &Apache::lonnet::auto_photo_permission($unam,$udom);
         if ($result eq 'ok') {
             if (!($perm_reqd eq 'yes')) {
                 return(&retrievestudentphoto($udom,$unam,$ext));
@@ -1145,7 +1153,9 @@ sub ssi {
     my $ua=new LWP::UserAgent;
     
     my $request;
-    
+
+    $form{'no_update_last_known'}=1;
+
     if (%form) {
       $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
@@ -1318,7 +1328,7 @@ sub clean_filename {
 
 # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}
-#                    the desired filenam is in $env{"form.$formname"}
+#                    the desired filenam is in $env{"form.$formname.filename"}
 #        $coursedoc - if true up to the current course
 #                     if false
 #        $subdir - directory in userfile to store the file into
@@ -1329,7 +1339,7 @@ sub clean_filename {
 
 
 sub userfileupload {
-    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;
+    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,$destudom)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);
@@ -1352,6 +1362,7 @@ sub userfileupload {
         close($fh);
         return $fullpath.'/'.$fname; 
     }
+    
 # Create the directory if not present
     $fname="$subdir/$fname";
     if ($coursedoc) {
@@ -1367,9 +1378,19 @@ sub userfileupload {
 				       $fname,$formname,$parser,
 				       $allfiles,$codebase);
         }
+    } elsif (defined($destuname)) {
+        my $docuname=$destuname;
+        my $docudom=$destudom;
+	return &finishuserfileupload($docuname,$docudom,$formname,
+				     $fname,$parser,$allfiles,$codebase);
+        
     } else {
         my $docuname=$env{'user.name'};
         my $docudom=$env{'user.domain'};
+        if (exists($env{'form.group'})) {
+            $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+            $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+        }
 	return &finishuserfileupload($docuname,$docudom,$formname,
 				     $fname,$parser,$allfiles,$codebase);
     }
@@ -2849,6 +2870,13 @@ sub dump {
    return %returnhash;
 }
 
+# --------------------------------------------------------- dumpstore interface
+
+sub dumpstore {
+   my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+   return &dump($namespace,$udomain,$uname,$regexp,$range);
+}
+
 # -------------------------------------------------------------- keys interface
 
 sub getkeys {
@@ -2990,25 +3018,53 @@ sub newput {
 # ---------------------------------------------------------  putstore interface
 
 sub putstore {
-   my ($namespace,$storehash,$udomain,$uname)=@_;
+   my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
    my $items='';
-   my %allitems = ();
-   foreach (keys %$storehash) {
-       if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
-           my $key = $1.':keys:'.$2;
-           $allitems{$key} .= $3.':';
-       }
-       $items.=$_.'='.&freeze_escape($$storehash{$_}).'&';
-   }
-   foreach (keys %allitems) {
-       $allitems{$_} =~ s/\:$//;
-       $items.= $_.'='.$allitems{$_}.'&';
+   foreach my $key (keys(%$storehash)) {
+       $items.= &escape($key).'='.&freeze_escape($storehash->{$key}).'&';
    }
    $items=~s/\&$//;
-   return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
+   my $esc_symb=&escape($symb);
+   my $esc_v=&escape($version);
+   my $reply =
+       &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",
+	      $uhome);
+   if ($reply eq 'unknown_cmd') {
+       # gfall back to way things use to be done
+       return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
+			    $uname);
+   }
+   return $reply;
+}
+
+sub old_putstore {
+    my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
+    if (!$udomain) { $udomain=$env{'user.domain'}; }
+    if (!$uname) { $uname=$env{'user.name'}; }
+    my $uhome=&homeserver($uname,$udomain);
+    my %newstorehash;
+    foreach (keys %$storehash) {
+	my $key = $version.':'.&escape($symb).':'.$_;
+	$newstorehash{$key} = $storehash->{$_};
+    }
+    my $items='';
+    my %allitems = ();
+    foreach (keys %newstorehash) {
+	if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
+	    my $key = $1.':keys:'.$2;
+	    $allitems{$key} .= $3.':';
+	}
+	$items.=$_.'='.&freeze_escape($newstorehash{$_}).'&';
+    }
+    foreach (keys %allitems) {
+	$allitems{$_} =~ s/\:$//;
+	$items.= $_.'='.$allitems{$_}.'&';
+    }
+    $items=~s/\&$//;
+    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
 # ------------------------------------------------------ critical put interface
@@ -3020,7 +3076,7 @@ sub cput {
    my $uhome=&homeserver($uname,$udomain);
    my $items='';
    foreach (keys %$storehash) {
-       $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+       $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
    }
    $items=~s/\&$//;
    return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
@@ -3131,12 +3187,29 @@ sub allowed {
     }
 
 # Free bre access to user's own portfolio contents
-    my ($space,$domain,$name,$dir)=split('/',$uri);
+    my ($space,$domain,$name,@dir)=split('/',$uri);
     if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && 
-	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
+	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) {
         return 'F';
     }
 
+# bre access to group if user has rgf priv for this group and course.
+    if (($space=~/^(uploaded|editupload)$/) && ($dir[0] eq 'groups') 
+         && ($dir[2] eq 'portfolio') && ($priv eq 'bre')) {
+        if (exists($env{'request.course.id'})) {
+            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            if (($domain eq $cdom) && ($name eq $cnum)) {
+                my $courseprivid=$env{'request.course.id'};
+                $courseprivid=~s/\_/\//;
+                if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid
+                    .'/'.$dir[1]} =~/rgf\&([^\:]*)/) {
+                    return $1; 
+                }
+            }
+        }
+    }
+
 # Free bre to public access
 
     if ($priv eq 'bre') {
@@ -3450,16 +3523,17 @@ sub allowed {
    return 'F';
 }
 
+sub split_uri_for_cond {
+    my $uri=&deversion(&declutter(shift));
+    my @uriparts=split(/\//,$uri);
+    my $filename=pop(@uriparts);
+    my $pathname=join('/',@uriparts);
+    return ($pathname,$filename);
+}
 # --------------------------------------------------- Is a resource on the map?
 
 sub is_on_map {
-    my $uri=&deversion(&declutter(shift));
-    my @uriparts=split(/\//,$uri);
-    my $filename=$uriparts[$#uriparts];
-    my $pathname=$uri;
-    $pathname=~s|/\Q$filename\E$||;
-    $pathname=~s/^adm\/wrapper\///;
-    $pathname=~s/^adm\/coursedocs\/showdoc\///;
+    my ($pathname,$filename) = &split_uri_for_cond(shift);
     #Trying to find the conditional for the file
     my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~
 	       /\&\Q$filename\E\:([\d\|]+)\&/);
@@ -3735,8 +3809,11 @@ sub auto_create_password {
 sub auto_photo_permission {
     my ($cnum,$cdom,$students) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
-    my ($outcome,$perm_reqd,$conditions) = split(/:/,&unescape(
-                          &reply('autophotopermission:'.$cdom,$homeserver)),3);
+    my ($outcome,$perm_reqd,$conditions) = 
+	split(/:/,&unescape(&reply('autophotopermission:'.$cdom,$homeserver)),3);
+    if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
+	return (undef,undef);
+    }
     return ($outcome,$perm_reqd,$conditions);
 }
 
@@ -3745,7 +3822,11 @@ sub auto_checkphotos {
     my $homeserver = &homeserver($uname,$udom);
     my ($result,$resulttype);
     my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.
-                               &escape($uname).':'.&escape($pid),$homeserver));
+				   &escape($uname).':'.&escape($pid),
+				   $homeserver));
+    if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
+	return (undef,undef);
+    }
     if ($outcome) {
         ($result,$resulttype) = split(/:/,$outcome);
     } 
@@ -3756,7 +3837,11 @@ sub auto_photochoice {
     my ($cnum,$cdom) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
     my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.
-                                                &escape($cdom),$homeserver)));
+						       &escape($cdom),
+						       $homeserver)));
+    if ($update =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
+	return (undef,undef);
+    }
     return ($update,$comment);
 }
 
@@ -4653,13 +4738,70 @@ sub GetFileTimestamp {
     }
 }
 
+sub stat_file {
+    my ($uri) = @_;
+    $uri = &clutter($uri);
+
+    # we want just the url part without the unneeded accessor url bits
+    if ($file =~ m-^/adm/-) {
+	$file=~s-^/adm/wrapper/-/-;
+	$file=~s-^/adm/coursedocs/showdoc/-/-;
+    }
+    
+    my ($udom,$uname,$file,$dir);
+    if ($uri =~ m-^/(uploaded|editupload)/-) {
+	($udom,$uname,$file) =
+	    ($uri =~ m-/(?:uploaded|editupload)/?([^/]*)/?([^/]*)/?(.*)-);
+	$file = 'userfiles/'.$file;
+	$dir = &Apache::loncommon::propath($udom,$uname);
+    }
+    if ($uri =~ m-^/res/-) {
+	($udom,$uname) = 
+	    ($uri =~ m-/(?:res)/?([^/]*)/?([^/]*)/-);
+	$file = $uri;
+    }
+
+    if (!$udom || !$uname || !$file) {
+	# unable to handle the uri
+	return ();
+    }
+
+    my ($result) = &dirlist($file,$udom,$uname,$dir);
+    my @stats = split('&', $result);
+    
+    if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
+	shift(@stats); #filename is first
+	return @stats;
+    }
+    return ();
+}
+
 # -------------------------------------------------------- Value of a Condition
 
+# gets the value of a specific preevaluated condition
+#    stored in the string  $env{user.state.<cid>}
+# or looks up a condition reference in the bighash and if if hasn't
+# already been evaluated recurses into docondval to get the value of
+# the condition, then memoizing it to 
+#   $env{user.state.<cid>.<condition>}
 sub directcondval {
     my $number=shift;
     if (!defined($env{'user.state.'.$env{'request.course.id'}})) {
 	&Apache::lonuserstate::evalstate();
     }
+    if (exists($env{'user.state.'.$env{'request.course.id'}.".$number"})) {
+	return $env{'user.state.'.$env{'request.course.id'}.".$number"};
+    } elsif ($number =~ /^_/) {
+	my $sub_condition;
+	if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
+		&GDBM_READER(),0640)) {
+	    $sub_condition=$bighash{'conditions'.$number};
+	    untie(%bighash);
+	}
+	my $value = &docondval($sub_condition);
+	&appenv('user.state.'.$env{'request.course.id'}.".$number" => $value);
+	return $value;
+    }
     if ($env{'user.state.'.$env{'request.course.id'}}) {
        return substr($env{'user.state.'.$env{'request.course.id'}},$number,1);
     } else {
@@ -4667,43 +4809,49 @@ sub directcondval {
     }
 }
 
+# get the collection of conditions for this resource
 sub condval {
     my $condidx=shift;
-    my $result=0;
     my $allpathcond='';
-    foreach (split(/\|/,$condidx)) {
-       if (defined($env{'acc.cond.'.$env{'request.course.id'}.'.'.$_})) {
-	   $allpathcond.=
-               '('.$env{'acc.cond.'.$env{'request.course.id'}.'.'.$_}.')|';
-       }
+    foreach my $cond (split(/\|/,$condidx)) {
+	if (defined($env{'acc.cond.'.$env{'request.course.id'}.'.'.$cond})) {
+	    $allpathcond.=
+		'('.$env{'acc.cond.'.$env{'request.course.id'}.'.'.$cond}.')|';
+	}
     }
     $allpathcond=~s/\|$//;
-    if ($env{'request.course.id'}) {
-       if ($allpathcond) {
-          my $operand='|';
-	  my @stack;
-           foreach ($allpathcond=~/(\d+|\(|\)|\&|\|)/g) {
-              if ($_ eq '(') {
-                 push @stack,($operand,$result)
-              } elsif ($_ eq ')') {
-                  my $before=pop @stack;
-		  if (pop @stack eq '&') {
-		      $result=$result>$before?$before:$result;
-                  } else {
-                      $result=$result>$before?$result:$before;
-                  }
-              } elsif (($_ eq '&') || ($_ eq '|')) {
-                  $operand=$_;
-              } else {
-                  my $new=directcondval($_);
-                  if ($operand eq '&') {
-                     $result=$result>$new?$new:$result;
-                  } else {
-                     $result=$result>$new?$result:$new;
-                  }
-              }
-          }
-       }
+    return &docondval($allpathcond);
+}
+
+#evaluates an expression of conditions
+sub docondval {
+    my ($allpathcond) = @_;
+    my $result=0;
+    if ($env{'request.course.id'}
+	&& defined($allpathcond)) {
+	my $operand='|';
+	my @stack;
+	foreach my $chunk ($allpathcond=~/(\d+|_\d+\.\d+|\(|\)|\&|\|)/g) {
+	    if ($chunk eq '(') {
+		push @stack,($operand,$result);
+	    } elsif ($chunk eq ')') {
+		my $before=pop @stack;
+		if (pop @stack eq '&') {
+		    $result=$result>$before?$before:$result;
+		} else {
+		    $result=$result>$before?$result:$before;
+		}
+	    } elsif (($chunk eq '&') || ($chunk eq '|')) {
+		$operand=$chunk;
+	    } else {
+		my $new=directcondval($chunk);
+		if ($operand eq '&') {
+		    $result=$result>$new?$new:$result;
+		} else {
+		    $result=$result>$new?$result:$new;
+		}
+	    }
+	}
     }
     return $result;
 }
@@ -4820,8 +4968,8 @@ sub EXT_cache_set {
 
 # --------------------------------------------------------- Value of a Variable
 sub EXT {
-    my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
 
+    my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
     unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb
     my $courseid;
@@ -5104,10 +5252,7 @@ sub check_group_parms {
 
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($grouplist,$courseid) = @_;
-    my @groups = split/:/,$grouplist;
-    if (@groups > 1) {
-        @groups = sort(@groups);
-    }
+    my @groups = sort(split(/:/,$grouplist));
     return @groups;
 }
 
@@ -5459,9 +5604,12 @@ sub symblist {
     if (($env{'request.course.fn'}) && (%newhash)) {
         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                       &GDBM_WRCREAT(),0640)) {
-	    foreach (keys %newhash) {
-                $hash{declutter($_)}=&encode_symb($mapname,$newhash{$_}->[1],
-						  $newhash{$_}->[0]);
+	    foreach my $url (keys %newhash) {
+		next if ($url eq 'last_known'
+			 && $env{'form.no_update_last_known'});
+		$hash{declutter($url)}=&encode_symb($mapname,
+						    $newhash{$url}->[1],
+						    $newhash{$url}->[0]);
             }
             if (untie(%hash)) {
 		return 'ok';
@@ -6308,7 +6456,7 @@ sub clutter {
 		     && $thisfn!~/\.(sequence|page)$/) {
 		$thisfn='/adm/coursedocs/showdoc'.$thisfn;
 	    } else {
-		&logthis("Got a blank emb style");
+#		&logthis("Got a blank emb style");
 	    }
 	}
     }
@@ -7129,6 +7277,27 @@ all args are optional
 
 =item *
 
+dumpstore($namespace,$udom,$uname,$regexp,$range) : 
+dumps the complete (or key matching regexp) namespace into a hash
+($udom, $uname, $regexp, $range are optional) for a namespace that is
+normally &store()ed into
+
+$range should be either an integer '100' (give me the first 100
+                                           matching records)
+              or be  two integers sperated by a - with no spaces
+                 '30-50' (give me the 30th through the 50th matching
+                          records)
+
+
+=item *
+
+putstore($namespace,$symb,$version,$storehash,$udomain,$uname) :
+replaces a &store() version of data with a replacement set of data
+for a particular resource in a namespace passed in the $storehash hash 
+reference
+
+=item *
+
 tmpstore($storehash,$symb,$namespace,$udom,$uname) : storage that
 works very similar to store/cstore, but all data is stored in a
 temporary location and can be reset using tmpreset, $storehash should
@@ -7182,17 +7351,6 @@ put($namespace,$storehash,$udom,$uname)
 
 =item *
 
-putstore($namespace,$storehash,$udomain,$uname) : stores hash in namesp
-keys used in storehash include version information (e.g., 1:$symb:message etc.) as
-used in records written by &store and retrieved by &restore.  This function 
-was created for use in editing discussion posts, without incrementing the
-version number included in the key for a particular post. The colon 
-separated list of attribute names (e.g., the value associated with the key 
-1:keys:$symb) is also generated and passed in the ampersand separated 
-items sent to lonnet::reply().  
-
-=item *
-
 cput($namespace,$storehash,$udom,$uname) : critical put
 ($udom and $uname are optional)
 
@@ -7322,6 +7480,16 @@ getfile($file,$caller) : two cases - req
    - returns the entire contents of a file or -1; 
    it properly subscribes to and replicates the file if neccessary.
 
+
+=item *
+
+stat_file($url) : $url is expected to be a /res/ or /uploaded/ style file
+                  reference
+
+returns either a stat() list of data about the file or an empty list
+if the file doesn't exist or couldn't find out about it (connection
+problems or user unknown)
+
 =item *
 
 filelocation($dir,$file) : returns file system location of a file