--- loncom/imspackages/imsprocessor.pm	2005/03/23 20:55:33	1.18
+++ loncom/imspackages/imsprocessor.pm	2005/05/03 18:38:37	1.20
@@ -24,6 +24,8 @@
 package Apache::imsprocessor;
 
 use Apache::lonnet;
+use LWP::UserAgent;
+use HTTP::Request::Common;
 use LONCAPA::Configuration;
 use strict;
 
@@ -95,7 +97,7 @@ sub uploadzip {
     my ($context,$tempdir,$source) = @_;
     my $fname;
     if ($context eq 'DOCS') {
-        $fname=$ENV{'form.uploadname.filename'};
+        $fname=$env{'form.uploadname.filename'};
 # Replace Windows backslashes by forward slashes
         $fname=~s/\\/\//g;
 # Get rid of everything but the actual filename
@@ -107,9 +109,9 @@ sub uploadzip {
 # See if there is anything left
         unless ($fname) { return 'error: no uploaded file'; }
 # Save the file
-        chomp($ENV{'form.uploadname'});
+        chomp($env{'form.uploadname'});
         open(my $fh,'>'.$tempdir.'/'.$fname);
-        print $fh $ENV{'form.uploadname'};
+        print $fh $env{'form.uploadname'};
         close($fh);
     } elsif ($context eq 'CSTR') {
         if ($source =~ m/\/([^\/]+)$/) {
@@ -128,14 +130,8 @@ sub expand_zip {
         return 'no zip';
     }
     if ($filename =~ m|\.zip$|i) {
-    # unzip can cause an sh launch which can pass along all of %ENV
-    # which can be too large for /bin/sh to handle
-        my %oldENV=%ENV;
-        undef(%ENV);
         open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");
         close(OUTPUT);
-        %ENV=%oldENV;
-        undef(%oldENV);
     } else {
         return 'nozip';
     }
@@ -1730,7 +1726,7 @@ sub parse_bb5_assessment {
             $id = $attr->{id};
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
             if ($state[4] eq "ISHTML") {
-                $$settings{$id}{html} = $attr->{value};
+                $$settings{$id}{ishtml} = $attr->{value};
             } elsif ($state[4] eq "ISNEWLINELITERAL") {
                 $$settings{$id}{newline} = $attr->{value};
             }
@@ -2290,7 +2286,7 @@ sub process_assessment {
     my $randompickflag = 0;
     my ($cid,$cdom,$cnum);
     if ($context eq 'DOCS') {
-        $cid = $ENV{'request.course.id'};
+        $cid = $env{'request.course.id'};
         ($cdom,$cnum) = split/_/,$cid;
     }
     my $destresdir = $destdir;
@@ -2348,7 +2344,7 @@ sub process_assessment {
                 if (!-e "$destdir/problems/$seqname") {
                     mkdir("$destdir/problems/$seqname",0755);
                 }
-                my $newdir = "$destdir/problems/$seqname";
+                $newdir = "$destdir/problems/$seqname";
                 my $dbcontainerdir;
                 &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
             }
@@ -2376,14 +2372,18 @@ sub process_assessment {
         if (!-e "$destdir/problems/$dirtitle") {
             mkdir("$destdir/problems/$dirtitle",0755);
         }
-        my $newdir = "$destdir/problems/$dirtitle";
+        $newdir = "$destdir/problems/$dirtitle";
     }
 
-    &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+    if ($cms eq 'webct4') {
+        &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+    } else {
+        &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$settings);
+    }
     if ($cms eq 'bb5') {
-        &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+        &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
     } elsif ($cms eq 'bb6') {
-        &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+        &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
     }
 }
 
@@ -2417,7 +2417,11 @@ sub build_problem_container {
     my $probsrc = "/res/lib/templates/simpleproblem.problem";
     if ($context eq 'CSTR') {
         foreach my $id (@{$allids}) {
-            $probtitle{$id} = $$settings{$id}{title};
+            if ($cms eq 'webct4') {
+                $probtitle{$id} = $$settings{$id}{title};
+            } else {
+                $probtitle{$id} = $$settings{title};
+            }
             $probtitle{$id} =~ s/\s/_/g;
             $probtitle{$id} =~ s/\W//g;
             $probtitle{$id} .= '_'.$id;
@@ -2429,7 +2433,7 @@ sub build_problem_container {
             $probdir =~ s/\W//g;
             $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
         } else {
-            $probsrc="$dirname/problems/$dirtitle/$$allids[0].problem";
+            $probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
         }
     }
     print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
@@ -2453,7 +2457,7 @@ sub build_problem_container {
                     $probdir =~ s/\W//g;
                     $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
                 } else {
-                    $probsrc = "$dirname/problems/$dirtitle/$$allids[$j].problem";
+                    $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
                 }
             }
             print $fh qq|
@@ -2471,9 +2475,19 @@ sub build_problem_container {
 }
 
 sub write_bb5_questions {
-    my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum) = @_;
+    my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
     my $qnum = 0;
     foreach my $id (@{$allids}) {
+        if ($$settings{$id}{ishtml} eq 'true') {
+            $$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
+        }
+        if ($$settings{$id}{text} =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
+            if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
+                $$settings{$id}{text} =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1../../resfiles/$res/webimages/$3$4#g;
+            }
+        }
+        $$settings{$id}{text} =~ s#(<img src=[^>]+)/*>#$1 />#gi;
+        $$settings{$id}{text} =~ s#<br>#<br />#g;
         $qnum ++;
         my $output;
         my $permcontainer = $containerdir;
@@ -2817,7 +2831,11 @@ sub write_bb5_questions {
         if ($context eq 'CSTR') {
             $output .= qq|</problem>
 |;
-            open(PROB,">$newdir/problems/$id.problem");
+            my $title = $$settings{title};
+            $title =~ s/\s/_/g;
+            $title =~ s/\W//g;
+            $title .= '_'.$id;
+            open(PROB,">:utf8", "$newdir/$title.problem");
             print PROB $output;
             close PROB;
         } else {
@@ -2847,13 +2865,13 @@ sub write_webct4_questions {
         if ($$settings{$id}{texttype} eq 'text/html') {
             $$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
             $$settings{$id}{text} = &Apache::lonxml::htmlclean($$settings{$id}{text});
-            $$settings{$id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
-            $$settings{$id}{text} =~ s#<hr>#<hr />#g;
+            $$settings{$id}{text} =~ s#(<img src=["']?)([^>]+)(/?>)#$1../../resfiles/$2 />#gi;
+            $$settings{$id}{text} =~ s#<([bh])r>#<$1r />#g;
 #            $$settings{$id}{text} =~ s#<p>#</p><p>#g;
 #            $$settings{$id}{text} =~ s#</p></p>#</p>#;
 #            $$settings{$id}{text} =~ s#<p></p>##g;
             $$settings{$id}{text} =~ s#<p>#<br /><br />#g;
-            $$settings{$id}{text} =~ s#<\\p>##g;
+            $$settings{$id}{text} =~ s#</p>##g;
         }
         if ($$settings{$id}{class} eq 'numerical') {
             foreach my $numid (@{$$settings{$id}{numids}}) {
@@ -3338,7 +3356,49 @@ sub test_for_html {
 } 
 
 sub write_bb6_questions {
-    my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;
+    my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices) = @_;
+}
+
+sub retrieve_image {
+    my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
+    my $contents;
+    my $url = $urlpath.$filename;
+    my $ua=new LWP::UserAgent;
+    my $request=new HTTP::Request('GET',$url);
+    my $response=$ua->request($request);
+    if ($response->is_success) { 
+        $contents = $response->content;
+        if (!-e "$docroot/$res") {
+            mkdir("$docroot/$res",0755);
+        }
+        if (!-e "$docroot/$res/webimages") {
+            mkdir("$docroot/$res/webimages",0755);
+        }
+        open(my $fh,">$docroot/$res/webimages/$filename");
+        print $fh $contents;
+        close($fh);
+        if ($context eq 'DOCS') {
+            my $chome = &Apache::lonnet::homeserver($cname,$cdom);
+            my $copyfile = $dirname.'/'.$filename;
+            my $source = "$docroot/$res/webimages/$filename";
+            my $fileresult;
+            if (-e $source) {
+                $fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$chome,$copyfile,$source);
+            }
+            return $fileresult;
+        } elsif ($context eq 'CSTR') {
+            if (!-e "$destdir/resfiles/$res") {
+                mkdir("$destdir/resfiles/$res",0755);
+            }
+            if (!-e "$destdir/resfiles/$res/webimages") {
+                mkdir("$destdir/resfiles/$res/webimages",0755);
+            }
+            rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
+            return 'ok';
+        }
+    } else {
+        return -1;
+    }
 }
 
 # ---------------------------------------------------------------- Process Blackboard Announcements