--- loncom/lonnet/perl/lonnet.pm	2005/06/29 11:57:17	1.644
+++ loncom/lonnet/perl/lonnet.pm	2005/10/10 17:57:22	1.660
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.644 2005/06/29 11:57:17 www Exp $
+# $Id: lonnet.pm,v 1.660 2005/10/10 17:57:22 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -767,6 +767,13 @@ sub validate_access_key {
 }
 
 # ------------------------------------- Find the section of student in a course
+sub devalidate_getsection_cache {
+    my ($udom,$unam,$courseid)=@_;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my $hashid="$udom:$unam:$courseid";
+    &devalidate_cache_new('getsection',$hashid);
+}
 
 sub getsection {
     my ($udom,$unam,$courseid)=@_;
@@ -1302,7 +1309,7 @@ sub userfileupload {
     if ($coursedoc) {
 	my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
 	my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
-        if ($env{'form.folder'} =~ m/^default/) {
+        if ($env{'form.folder'} =~ m/^(default|supplemental)/) {
             return &finishuserfileupload($docuname,$docudom,
 					 $formname,$fname,$parser,$allfiles,
 					 $codebase);
@@ -1368,7 +1375,7 @@ sub finishuserfileupload {
 }
 
 sub extract_embedded_items {
-    my ($filepath,$file,$allfiles,$codebase) = @_;
+    my ($filepath,$file,$allfiles,$codebase,$content) = @_;
     my @state = ();
     my %javafiles = (
                       codebase => '',
@@ -1379,14 +1386,34 @@ sub extract_embedded_items {
                       src => '',
                       movie => '',
                      );
-    my $p = HTML::LCParser->new($filepath.'/'.$file);
+    my $p;
+    if ($content) {
+        $p = HTML::LCParser->new($content);
+    } else {
+        $p = HTML::LCParser->new($filepath.'/'.$file);
+    }
     while (my $t=$p->get_token()) {
 	if ($t->[0] eq 'S') {
 	    my ($tagname, $attr) = ($t->[1],$t->[2]);
 	    push (@state, $tagname);
+            if (lc($tagname) eq 'allow') {
+                &add_filetype($allfiles,$attr->{'src'},'src');
+            }
 	    if (lc($tagname) eq 'img') {
 		&add_filetype($allfiles,$attr->{'src'},'src');
 	    }
+            if (lc($tagname) eq 'script') {
+                if ($attr->{'archive'} =~ /\.jar$/i) {
+                    &add_filetype($allfiles,$attr->{'archive'},'archive');
+                } else {
+                    &add_filetype($allfiles,$attr->{'src'},'src');
+                }
+            }
+            if (lc($tagname) eq 'link') {
+                if (lc($attr->{'rel'}) eq 'stylesheet') { 
+                    &add_filetype($allfiles,$attr->{'href'},'href');
+                }
+            }
 	    if (lc($tagname) eq 'object' ||
 		(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {
 		foreach my $item (keys(%javafiles)) {
@@ -1616,7 +1643,7 @@ sub courseacclog {
     my $fnsymb=shift;
     unless ($env{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};
-    if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) {
+    if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
         $what.=':POST';
         # FIXME: Probably ought to escape things....
 	foreach (keys %env) {
@@ -1689,7 +1716,11 @@ sub get_course_adv_roles {
 	if ($username eq '' || $domain eq '') { next; }
 	if ((&privileged($username,$domain)) && 
 	    (!$nothide{$username.':'.$domain})) { next; }
+	if ($role eq 'cr') { next; }
         my $key=&plaintext($role);
+	if ($role =~ /^cr/) {
+	    $key=(split('/',$role))[3];
+	}
         if ($section) { $key.=' (Sec/Grp '.$section.')'; }
         if ($returnhash{$key}) {
 	    $returnhash{$key}.=','.$username.':'.$domain;
@@ -1780,7 +1811,27 @@ sub courseiddump {
     return %returnhash;
 }
 
-#
+# ---------------------------------------------------------- DC e-mail
+sub dcmaildump {
+    my ($dom,$startdate,$enddate,$senders) = @_;
+    my %returnhash=(); 
+    foreach my $tryserver (keys(%libserv)) {
+        if ($hostdom{$tryserver} eq $dom) {
+            %{$returnhash{$tryserver}}=();
+            foreach (
+                split(/\&/,&reply('dcmaildump:'.$dom.':'.
+                   &escape($startdate).':'.&escape($enddate).':'.
+                   &escape($senders), ,$tryserver))) {
+                my($key,$value) = split(/\=/,$_);
+                if (($key) && ($value)) {
+                    $returnhash{$tryserver}{&unescape($key)} = &unescape($value);
+                }
+            }
+        }
+    }
+    return %returnhash;
+}
+
 # ----------------------------------------------------------- Check out an item
 
 sub get_first_access {
@@ -2458,8 +2509,12 @@ sub rolesinit {
 	    
             my ($trole,$tend,$tstart);
 	    if ($role=~/^cr/) { 
-		($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
-		($tend,$tstart)=split('_',$trest);
+		if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
+		    ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
+		    ($tend,$tstart)=split('_',$trest);
+		} else {
+		    $trole=$role;
+		}
 	    } else {
 		($trole,$tend,$tstart)=split(/_/,$role);
 	    }
@@ -2881,7 +2936,7 @@ sub allowed {
 
 # Free bre access to user's own portfolio contents
     my ($space,$domain,$name,$dir)=split('/',$uri);
-    if (($space=~/^(uploaded|ediupload)$/) && ($env{'user.name'} eq $name) && 
+    if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && 
 	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
         return 'F';
     }
@@ -3173,8 +3228,7 @@ sub allowed {
 # --------------------------------------------------- Is a resource on the map?
 
 sub is_on_map {
-    my $uri=&declutter(shift);
-    $uri=~s/\.\d+\.(\w+)$/\.$1/;
+    my $uri=&deversion(&declutter(shift));
     my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
@@ -3747,6 +3801,8 @@ sub modify_student_enrollment {
 		   $cdom,$cnum);
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {
 	return 'error: '.$reply;
+    } else {
+	&devalidate_getsection_cache($udom,$uname,$cid);
     }
     # Add student role to user
     my $uurl='/'.$cid;
@@ -4054,28 +4110,25 @@ sub unmark_as_readonly {
     my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }
     my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
-    foreach my $file(@readonly_files){
-        my $current_locks = $current_permissions{$file};
+    foreach my $file (@readonly_files) {
+	if (defined($file_name) && ($file_name ne $file)) { next; }
+	my $current_locks = $current_permissions{$file};
         my @new_locks;
         my @del_keys;
         if (ref($current_locks) eq "ARRAY"){
             foreach my $locker (@{$current_locks}) {
                 my $compare=$locker;
                 if (ref($locker)) { $compare=join('',@{$locker}) };
-                if ($compare eq $symb_crs) {
-                    if (defined($file_name) && ($file_name ne $file)) {
-                        push(@new_locks, $what);
-                    }
-                } else {
-                    push(@new_locks, $what);
+                if ($compare ne $symb_crs) {
+                    push(@new_locks, $locker);
                 }
             }
-            if (@new_locks > 0) {
+            if (scalar(@new_locks) > 0) {
                 $current_permissions{$file} = \@new_locks;
             } else {
                 push(@del_keys, $file);
                 &del('file_permissions',\@del_keys, $domain, $user);
-                delete $current_permissions{$file};
+                delete($current_permissions{$file});
             }
         }
     }
@@ -4403,8 +4456,10 @@ sub EXT {
     if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource
 	if ($space eq 'resource') {
-	    if (defined($Apache::lonhomework::parsing_a_problem) ||
-		defined($Apache::lonhomework::parsing_a_task)) {
+	    if ( (defined($Apache::lonhomework::parsing_a_problem)
+		  || defined($Apache::lonhomework::parsing_a_task))
+		 &&
+		 ($symbparm eq &symbread()) ) {
 		return $Apache::lonhomework::history{$qualifierrest};
 	    } else {
 		my %restored;
@@ -5624,6 +5679,9 @@ sub filelocation {
     if ($file=~m:^/~:) { # is a contruction space reference
         $location = $file;
         $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
+    } elsif ($file=~m:^/home/[^/]*/public_html/:) {
+	# is a correct contruction space reference
+        $location = $file;
     } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=
   	    ($file=~m -^/+(?:uploaded|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);
@@ -5865,14 +5923,21 @@ BEGIN {
 
 sub get_iphost {
     if (%iphost) { return %iphost; }
+    my %name_to_ip;
     foreach my $id (keys(%hostname)) {
 	my $name=$hostname{$id};
-	my $ip = gethostbyname($name);
-	if (!$ip || length($ip) ne 4) {
-	    &logthis("Skipping host $id name $name no IP found\n");
-	    next;
+	my $ip;
+	if (!exists($name_to_ip{$name})) {
+	    $ip = gethostbyname($name);
+	    if (!$ip || length($ip) ne 4) {
+		&logthis("Skipping host $id name $name no IP found\n");
+		next;
+	    }
+	    $ip=inet_ntoa($ip);
+	    $name_to_ip{$name} = $ip;
+	} else {
+	    $ip = $name_to_ip{$name};
 	}
-	$ip=inet_ntoa($ip);
 	push(@{$iphost{$ip}},$id);
     }
     return %iphost;