--- loncom/publisher/lonpublisher.pm	2014/08/03 13:52:59	1.292
+++ loncom/publisher/lonpublisher.pm	2014/12/12 18:27:34	1.294
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.292 2014/08/03 13:52:59 raeburn Exp $
+# $Id: lonpublisher.pm,v 1.294 2014/12/12 18:27:34 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -200,12 +200,12 @@ sub metaeval {
 	    if (defined($token->[2]->{'name'})) { 
 		$unikey.="\0".$token->[2]->{'name'}; 
 	    }
-	    foreach (@{$token->[3]}) {
-		$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
+	    foreach my $item (@{$token->[3]}) {
+		$metadatafields{$unikey.'.'.$item}=$token->[2]->{$item};
 		if ($metadatakeys{$unikey}) {
-		    $metadatakeys{$unikey}.=','.$_;
+		    $metadatakeys{$unikey}.=','.$item;
 		} else {
-		    $metadatakeys{$unikey}=$_;
+		    $metadatakeys{$unikey}=$item;
 		}
 	    }
 	    my $newentry=$parser->get_text('/'.$entry);
@@ -293,8 +293,8 @@ sub coursedependencies {
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
 				       $aauthor,$regexp);
     my %courses=();
-    foreach (keys %evaldata) {
-	if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
+    foreach my $item (keys(%evaldata)) {
+	if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
 	    $courses{$1}=1;
         }
     }
@@ -382,12 +382,12 @@ sub selectbox {
     }
     my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
               .'<select name="'.$name.'">';
-    foreach (@idlist) {
-        $selout.='<option value="'.$_.'"';
-        if ($_ eq $value) {
+    foreach my $id (@idlist) {
+        $selout.='<option value="'.$id.'"';
+        if ($id eq $value) {
 	    $selout.=' selected="selected"';
         }
-        $selout.='>'.&{$functionref}($_).'</option>';
+        $selout.='>'.&{$functionref}($id).'</option>';
     }
     $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
     return $selout;
@@ -787,12 +787,12 @@ sub fix_ids_and_indices {
 		}
 		my $newparmstring='';
 		my $endtag='';
-		foreach (keys %parms) {
-		    if ($_ eq '/') {
+		foreach my $parkey (keys(%parms)) {
+		    if ($parkey eq '/') {
 			$endtag=' /';
 		    } else { 
-			my $quote=($parms{$_}=~/\"/?"'":'"');
-			$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
+			my $quote=($parms{$parkey}=~/\"/?"'":'"');
+			$newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
 		    }
 		}
 		if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
@@ -825,6 +825,14 @@ sub fix_ids_and_indices {
 #
                                                     my $spritesheet = $1.'express_show/spritesheet.png';
                                                     $allow{&absoluteurl($spritesheet,$target)}=1;
+
+#
+# Camtasia 8.4: skins/express_show/spritesheet.min.css needed, and included in zip archive.
+# Not referenced directly in <main>.html or <main>_player.html files,
+# so add this file to %allow (where <main> is name user gave to file/archive).
+#
+                                                    my $spritecss = $1.'express_show/spritesheet.min.css';
+                                                    $allow{&absoluteurl($spritecss,$target)}=1;
                                                 }
                                             } elsif ($srctype eq 'PosterImageSrc') {
                                                 if ($url =~ m{^(.+)_First_Frame\.png$}) {
@@ -843,6 +851,15 @@ sub fix_ids_and_indices {
                                 }
                             }
                         }
+                        if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
+                            my $src = $2;
+                            if ($src) {
+                                my $url = &urlfixup($src);
+                                unless ($url=~m{^(?:http|https|ftp)://}) {
+                                    $allow{&absoluteurl($url,$target)}=1;
+                                }
+                            }
+                        }
                         if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
                             my $scriptslist = $2;
                             my @srcs = split(/\s*,\s*/,$scriptslist);
@@ -857,6 +874,15 @@ sub fix_ids_and_indices {
                                 }
                             }
                         }
+                        if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
+                            my $src = $2;
+                            if ($src) {
+                                my $url = &urlfixup($src);
+                                unless ($url=~m{^(?:http|https|ftp)://}) {
+                                    $allow{&absoluteurl($url,$target)}=1;
+                                }
+                            }
+                        }
                         $outstring .= $script;
                     }
                 }
@@ -1171,9 +1197,9 @@ sub publish {
 
 # ------------------- Clear out parameters and stores (there should not be any)
 
-        foreach (keys %metadatafields) {
-	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
-		delete $metadatafields{$_};
+        foreach my $field (keys(%metadatafields)) {
+	    if (($field=~/^parameter/) || ($field=~/^stores/)) {
+		delete $metadatafields{$field};
             }
         }
 
@@ -1182,23 +1208,21 @@ sub publish {
 
         $scrout.=&metaread($logfile,$source.'.meta');
 
-        foreach (keys %metadatafields) {
-	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
-                $oldparmstores{$_}=1;
-		delete $metadatafields{$_};
+        foreach my $field (keys(%metadatafields)) {
+	    if (($field=~/^parameter/) || ($field=~/^stores/)) {
+                $oldparmstores{$field}=1;
+		delete $metadatafields{$field};
             }
         }
 # ------------------------------------------------------------- Save some stuff
         my %savemeta=();
-        foreach ('title') {
-            if ($metadatafields{$_}) { $savemeta{$_}=$metadatafields{$_}; }
-	}
+        if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; }
 # ------------------------------------------ See if anything new in file itself
  
 	$allmeta=&parseformeta($source,$style);
 # ----------------------------------------------------------- Restore the stuff
-        foreach (keys %savemeta) {
-	    $metadatafields{$_}=$savemeta{$_};
+        foreach my $item (keys(%savemeta)) {
+	    $metadatafields{$item}=$savemeta{$item};
 	}
    }
 
@@ -1206,11 +1230,11 @@ sub publish {
 # ---------------- Find and document discrepancies in the parameters and stores
 
     my $chparms='';
-    foreach (sort keys %metadatafields) {
-	if (($_=~/^parameter/) || ($_=~/^stores/)) {
-	    unless ($_=~/\.\w+$/) { 
-		unless ($oldparmstores{$_}) {
-		    my $disp_key = $_;
+    foreach my $field (sort(keys(%metadatafields))) {
+	if (($field=~/^parameter/) || ($field=~/^stores/)) {
+	    unless ($field=~/\.\w+$/) {
+		unless ($oldparmstores{$field}) {
+		    my $disp_key = $field;
 		    $disp_key =~ tr/\0/_/;
 		    print $logfile ('New: '.$disp_key."\n");
 		    $chparms .= $disp_key.' ';
@@ -1224,11 +1248,11 @@ sub publish {
     }
 
     $chparms='';
-    foreach (sort keys %oldparmstores) {
-	if (($_=~/^parameter/) || ($_=~/^stores/)) {
-	    unless (($metadatafields{$_.'.name'}) ||
-		    ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
-		my $disp_key = $_;
+    foreach my $olditem (sort(keys(%oldparmstores))) {
+	if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) {
+	    unless (($metadatafields{$olditem.'.name'}) ||
+		    ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) {
+		my $disp_key = $olditem;
 		$disp_key =~ tr/\0/_/;
 		print $logfile ('Obsolete: '.$disp_key."\n");
 		$chparms.=$disp_key.' ';
@@ -1305,7 +1329,7 @@ sub publish {
 	&hiddenfield('phase','two').
 	&hiddenfield('filename',$env{'form.filename'}).
 	&hiddenfield('allmeta',&escape($allmeta)).
-	&hiddenfield('dependencies',join(',',keys %allow));
+	&hiddenfield('dependencies',join(',',keys(%allow)));
     unless ($env{'form.makeobsolete'}) {
        $intr_scrout.=
 	&textfield('Title','title',$metadatafields{'title'}).
@@ -1666,17 +1690,17 @@ sub phasetwo {
 		'</span>');
 	    return 0;
         }
-        foreach (sort keys %metadatafields) {
-            unless ($_=~/\./) {
-                my $unikey=$_;
+        foreach my $field (sort(keys(%metadatafields))) {
+            unless ($field=~/\./) {
+                my $unikey=$field;
                 $unikey=~/^([A-Za-z]+)/;
                 my $tag=$1;
                 $tag=~tr/A-Z/a-z/;
                 print $mfh "\n\<$tag";
-                foreach (split(/\,/,$metadatakeys{$unikey})) {
-                    my $value=$metadatafields{$unikey.'.'.$_};
+                foreach my $item (split(/\,/,$metadatakeys{$unikey})) {
+                    my $value=$metadatafields{$unikey.'.'.$item};
                     $value=~s/\"/\'\'/g;
-                    print $mfh ' '.$_.'="'.$value.'"';
+                    print $mfh ' '.$item.'="'.$value.'"';
                 }
                 print $mfh '>'.
                     &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
@@ -1882,9 +1906,9 @@ sub notify {
 # --------------------------------------------------- Notify subscribed courses
 	my %courses=&coursedependencies($target);
 	my $now=time;
-	foreach (keys %courses) {
-	    print $logfile "\nNotifying course ".$_.':';
-	    my ($cdom,$cname)=split(/\_/,$_);
+	foreach my $course (keys(%courses)) {
+	    print $logfile "\nNotifying course ".$course.':';
+	    my ($cdom,$cname)=split(/\_/,$course);
 	    my $reply=&Apache::lonnet::cput
 		('versionupdate',{$target => $now},$cdom,$cname);
 	    print $logfile $reply;