--- loncom/lonnet/perl/lonnet.pm	2005/06/13 20:23:54	1.638
+++ loncom/lonnet/perl/lonnet.pm	2005/06/29 11:57:17	1.644
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.638 2005/06/13 20:23:54 albertel Exp $
+# $Id: lonnet.pm,v 1.644 2005/06/29 11:57:17 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1379,118 +1379,79 @@ sub extract_embedded_items {
                       src => '',
                       movie => '',
                      );
-    my $p = HTML::Parser->new
-    (
-        xml_mode => 1,
-        start_h =>
-            [sub {
-                 my ($tagname, $attr) = @_;
-                 push (@state, $tagname);
-                 if (lc($tagname) eq 'img') {
-                     if (exists($$allfiles{$attr->{'src'}})) {
-                         unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) {
-                             push (@{$$allfiles{$attr->{'src'}}},&escape('src'));
-                         }
-                     } else {
-                         @{$$allfiles{$attr->{'src'}}} = (&escape('src'));
-                     }
-                 }
-                 if (lc($tagname) eq 'object') {
-                     foreach my $item (keys (%javafiles)) {
-                         $javafiles{$item} = '';
-                     }
-                 }
-                 if (lc($state[-2]) eq 'object') {
-                     if (lc($tagname) eq 'param') {
-                         my $name = lc($attr->{'name'});
-                         foreach my $item (keys (%mediafiles)) {
-                             if ($name eq $item) {
-                                 if (exists($$allfiles{$attr->{'value'}})) {
-                                     unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) {
-                                         push(@{$$allfiles{$attr->{'value'}}},&escape('value'));
-                                     }
-                                 } else {
-                                     @{$$allfiles{$attr->{'value'}}} = (&escape('value'));
-                                 }
-                                 last;
-                             }
-                         }
-                         foreach my $item (keys (%javafiles)) {
-                             if ($name eq $item) {
-                                 $javafiles{$item} = $attr->{'value'};
-                                 last;
-                             }
-                         }
-                     }
-                 }
-                 if (lc($tagname) eq 'embed') {
-                     unless (lc($state[-2]) eq 'object') {
-                         foreach my $item (keys (%javafiles)) {
-                             $javafiles{$item} = '';
-                         }
-                     }
-                     foreach my $item (keys (%javafiles)) {
-                         if ($attr->{$item}) {
-                             $javafiles{$item} = $attr->{$item};
-                             last;
-                         }
-                     }
-                     foreach my $item (keys (%mediafiles)) {
-                         if ($attr->{$item}) {
-                             if (exists($$allfiles{$attr->{$item}})) {
-                                 unless (grep/^$item$/,@{$$allfiles{$item}}) {
-                                     push(@{$$allfiles{$attr->{$item}}},&escape($item));
-                                 }
-                             } else {
-                                 @{$$allfiles{$attr->{$item}}} = (&escape($item));
-                             }
-                             last;
-                         }
-                     }
-                 }
-            }, "tagname, attr"],
-        text_h =>
-             [sub {
-                 my ($text) = @_;
-        }, "dtext"],
-        end_h =>
-               [sub {
-                   my ($tagname) = @_;
-                   unless ($javafiles{'codebase'} eq '') {
-                       $javafiles{'codebase'} .= '/';
-                   }  
-                   if (lc($tagname) eq 'object') {
-                       &extract_java_items(\%javafiles,$allfiles,$codebase);
-                   } 
-                   if (lc($tagname) eq 'embed') {
-                       unless (lc($state[-2]) eq 'object') {
-                           &extract_java_items(\%javafiles,$allfiles,$codebase);
-                       }
-                   }
-                   pop @state;
-                }, "tagname"],
-    );
-    $p->parse_file($filepath.'/'.$file);
-    $p->eof;
+    my $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 'img') {
+		&add_filetype($allfiles,$attr->{'src'},'src');
+	    }
+	    if (lc($tagname) eq 'object' ||
+		(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {
+		foreach my $item (keys(%javafiles)) {
+		    $javafiles{$item} = '';
+		}
+	    }
+	    if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {
+		my $name = lc($attr->{'name'});
+		foreach my $item (keys(%javafiles)) {
+		    if ($name eq $item) {
+			$javafiles{$item} = $attr->{'value'};
+			last;
+		    }
+		}
+		foreach my $item (keys(%mediafiles)) {
+		    if ($name eq $item) {
+			&add_filetype($allfiles, $attr->{'value'}, 'value');
+			last;
+		    }
+		}
+	    }
+	    if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') {
+		foreach my $item (keys(%javafiles)) {
+		    if ($attr->{$item}) {
+			$javafiles{$item} = $attr->{$item};
+			last;
+		    }
+		}
+		foreach my $item (keys(%mediafiles)) {
+		    if ($attr->{$item}) {
+			&add_filetype($allfiles,$attr->{$item},$item);
+			last;
+		    }
+		}
+	    }
+	} elsif ($t->[0] eq 'E') {
+	    my ($tagname) = ($t->[1]);
+	    if ($javafiles{'codebase'} ne '') {
+		$javafiles{'codebase'} .= '/';
+	    }  
+	    if (lc($tagname) eq 'applet' ||
+		lc($tagname) eq 'object' ||
+		(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')
+		) {
+		foreach my $item (keys(%javafiles)) {
+		    if ($item ne 'codebase' && $javafiles{$item} ne '') {
+			my $file=$javafiles{'codebase'}.$javafiles{$item};
+			&add_filetype($allfiles,$file,$item);
+		    }
+		}
+	    } 
+	    pop @state;
+	}
+    }
     return 'ok';
 }
 
-sub extract_java_items {
-    my ($javafiles,$allfiles,$codebase) = @_;
-    foreach my $item (keys(%{$javafiles})) {
-        if ($item ne 'codebase') {
-            if ($$javafiles{$item} ne '') {
-		my $file=$javafiles->{'codebase'}.$javafiles->{$item};
-                if (exists($allfiles->{$file})) {
-                    unless (scalar(grep(/^$item$/, @{$allfiles->{$file}}))) {
-                        push(@{$allfiles->{$file}}, &escape($item));
-		    }
-		} else {
-                    @{$allfiles->{$file}} = (&escape($item));
-                    $codebase->{$file} = $javafiles->{'codebase'};
-                }
-            }
-        }
+sub add_filetype {
+    my ($allfiles,$file,$type)=@_;
+    if (exists($allfiles->{$file})) {
+	unless (grep/^\Q$type\E$/, @{$allfiles->{$file}}) {
+	    push(@{$allfiles->{$file}}, &escape($type));
+	}
+    } else {
+	@{$allfiles->{$file}} = (&escape($type));
     }
 }
 
@@ -3007,7 +2968,16 @@ sub allowed {
 
 # If this is generating or modifying users, exit with special codes
 
-    if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:\Q$priv\E\:/) {
+    if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) {
+	if (($priv eq 'cca') || ($priv eq 'caa')) {
+	    my ($audom,$auname)=split('/',$uri);
+# no author name given, so this just checks on the general right to make a co-author in this domain
+	    unless ($auname) { return $thisallowed; }
+# an author name is given, so we are about to actually make a co-author for a certain account
+	    if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) ||
+		(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&
+		 ($audom ne $env{'request.role.domain'}))) { return ''; }
+	}
 	return $thisallowed;
     }
 #
@@ -4915,7 +4885,7 @@ sub metadata_generate_part0 {
 					   '.type'};
       my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.
 			     '.display'};
-      my $expr='\\[Part: '.$allnames{$name}.'\\]';
+      my $expr='[Part: '.$allnames{$name}.']';
       $olddis=~s/\Q$expr\E/\[Part: 0\]/;
       $$metacache{"$key.display"}=$olddis;
     }
@@ -5020,7 +4990,7 @@ sub symbverify {
         if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
 	    foreach (split(/\,/,$ids)) {
-               my ($mapid,$resid)=split(/\./,$_);
+	       my ($mapid,$resid)=split(/\./,$_);
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) {