--- loncom/imspackages/imsprocessor.pm	2011/10/24 23:41:52	1.49
+++ loncom/imspackages/imsprocessor.pm	2013/08/02 12:56:26	1.53
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Processor for IMS Packages
 #
-# $Id: imsprocessor.pm,v 1.49 2011/10/24 23:41:52 www Exp $
+# $Id: imsprocessor.pm,v 1.53 2013/08/02 12:56:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -203,13 +203,14 @@ sub process_manifest {
 
 sub parse_manifest {
     my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
-        $resources,$resinfo,$hrefs,$seq) = @_;
+        $resources,$resinfo,$hrefs,$seq,$requirer) = @_;
     my @state = ();
     my $itm = '';
     my %contents = ();
     my $identifier = '';
     my @allidentifiers = ();
     my $lastitem;
+    my $neededby;
     my $p = HTML::Parser->new
     (
        xml_mode => 1,
@@ -235,7 +236,7 @@ sub parse_manifest {
                                     $$items{$itm}{resnum} = $1;
                                 }
                             }
-                            unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
+                            unless (%{$$resources{$$items{$itm}{resnum}}}) {
                                 %{$$resources{$$items{$itm}{resnum}}} = ();
                             }
                             $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
@@ -308,12 +309,8 @@ sub parse_manifest {
                     }
                 } elsif ("@state" eq "manifest resources resource file") {
                     if ($$includedres{$identifier} || $phase ne 'build') {
-                        if ($cms eq 'webctvista4') {
-                            $$resources{$identifier}{file} = $attr->{href};
-                        }
                         if ($cms eq 'bb5' || $cms eq 'bb6' || 
                             $cms eq 'webctce4' || $cms eq 'webctvista4') {
-                            push @{$$hrefs{$identifier}},$attr->{href};
                             if ($$resources{$identifier}{type} eq 
                                 'webct.manifest') {
                                 my $manifestfile = $tempdir.'/'.$attr->{href};
@@ -325,7 +322,19 @@ sub parse_manifest {
                                 &parse_manifest($cms,$phase,$tempdir,$manifestfile,
                                                 $toc,$includedres,$includeditems,
                                                 $items,$resources,$resinfo,
-                                                $hrefs,$currseqref);
+                                                $hrefs,$currseqref,$neededby);
+                            } else {
+                                if ($cms eq 'webctvista4') {
+                                    if ($$resources{$identifier}{type} eq 'ims_qtiasiv1p2') {
+                                        $neededby = $identifier;
+                                    } elsif ($$resources{$identifier}{type} eq 'webcontent') {
+                                        $$resources{$identifier}{usedby} = $requirer;
+                                        push(@{$$hrefs{$identifier}},$attr->{href});
+                                    }
+                                    $$resources{$identifier}{file} = $attr->{href};
+                                } else {
+                                    push(@{$$hrefs{$identifier}},$attr->{href});
+                                }
                             }
                         } elsif ($cms eq 'angel5') {
                             if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
@@ -333,7 +342,7 @@ sub parse_manifest {
                             } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
                                 $$resources{$identifier}{type} = $1;
                             }
-                        } 
+                        }
                     }
                 } elsif ("@state" eq "manifest webct:ContentObject") {
                     foreach my $ident (@allidentifiers) {
@@ -360,6 +369,15 @@ sub parse_manifest {
                         }
                     }
                 }
+                if ("@state" eq "manifest webct:ContentObject webct:Name") {
+                    if ($cms eq 'webctvista4') {
+                        if ($text =~ /,/) {
+                            $$resources{$identifier}{title} = (split(/,/,$text))[-1];
+                        } else {
+                            $$resources{$identifier}{title} = $text;
+                        }
+                    }
+                }
               }, "dtext"],
         end_h =>
               [sub {
@@ -405,16 +423,20 @@ sub get_parents {
 
 sub target_resources {
     my ($resources,$oktypes,$targets) = @_;
-    foreach my $key (keys %{$resources}) {
+    foreach my $key (sort(keys(%{$resources}))) {
         if ( defined($$oktypes{$$resources{$key}{type}}) ) {
-            push @{$targets}, $key;
+            push(@{$targets},$key);
+        } elsif (defined($$resources{$key}{usedby})) {
+            if (defined($$oktypes{$$resources{$$resources{$key}{usedby}}{type}})) {
+                push(@{$targets},$key);
+            }
         }
     }
     return;
 }
 
 sub copy_resources {
-    my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
+    my ($context,$cms,$hrefs,$resources,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
     if ($context eq 'DOCS') {
         foreach my $key (sort keys %{$hrefs}) {
             if (grep/^$key$/,@{$targets}) {
@@ -438,6 +460,16 @@ sub copy_resources {
                             $copyfile = $1;
                         }
                     }
+                    if ($cms eq 'webctvista4') {
+                        if ($file =~ m{/\QX-WEBCT-VISTA-V0\E/.+([^.]+)$}) {
+                            $copyfile = $1;
+                        }
+                        if ($$resources{$key}{usedby}) {
+                            if ($$resources{$$resources{$key}{usedby}}{image} =~ /^\Q$copyfile\E/) {
+                                $copyfile = $$resources{$$resources{$key}{usedby}}{image};
+                            }
+                        }
+                    }
                     unless ((($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) || (($cms eq 'webctvista4') && (grep/^$key$/,@{$assessmentfiles}) && $file =~ /\.xml$/))    {
                         $copyfile = $fpath.$copyfile;
                         my $fileresult;
@@ -452,7 +484,7 @@ sub copy_resources {
         if (!-e "$destdir/resfiles") {
             mkdir("$destdir/resfiles",0770);
         }
-        foreach my $key (sort keys %{$hrefs}) {
+        foreach my $key (sort(keys(%{$hrefs}))) {
             if (grep/^$key$/,@{$targets}) {
                 foreach my $file (@{$$hrefs{$key}}) {
                     $file =~ s-\\-/-g;
@@ -511,6 +543,52 @@ sub copy_resources {
                         } elsif ($file !~ m-/data/(.+)$-) {
                             &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
                         }
+                    } elsif ($cms eq 'webctvista4') {
+                        if ($file =~ m{^\QX-WEBCT-VISTA-V0\E/(.+)$}) {
+                            my $copyfile = $1;
+                            if ($copyfile =~ m{^[^/]+/[^/]+}) {
+                                my @dirs = split/\//,$copyfile;
+                                my $path = "$destdir/resfiles";
+                                while (@dirs > 1) {
+                                    $path .= '/'.$dirs[0];
+                                    if (!-e "$path") {
+                                        mkdir("$path",0755);
+                                    }
+                                    shift @dirs;
+                                }
+                            } else {
+                                $copyfile =~ s/^[^.]+\.(\d+)_R/$1/;
+                                my ($filestem,$extension) = ($copyfile =~ /^(.+)\.(\w+)$/); 
+                                if ($$resources{$key}{usedby}) {
+                                    if (ref($$resources{$$resources{$key}{usedby}}{image}) eq 'ARRAY') {
+                                        for (my $i=0; $i<@{$$resources{$$resources{$key}{usedby}}{image}}; $i++) {
+                                            my ($img,$imgtitle);
+                                            $img = $$resources{$$resources{$key}{usedby}}{image}[$i];
+                                            if (ref($$resources{$$resources{$key}{usedby}}{imagetitle}) eq 'ARRAY') {
+                                                $imgtitle = $$resources{$$resources{$key}{usedby}}{imagetitle}[$i]; 
+                                            }
+                                            if ($imgtitle =~ /\Q$extension\E/i) {
+                                                $copyfile = $imgtitle;
+                                                last;
+                                            } elsif ($img =~ /^\Q$filestem\E/i) {
+                                                $copyfile = $img.'.'.$extension;
+                                                last;
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                            if (-e "$tempdir/$file") {
+                                my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
+                                if ($renameres) {
+                                    if (ref($total) eq 'HASH') {
+                                        $$total{'file'} ++;
+                                    }
+                                } else {
+                                    &Apache::lonnet::logthis("IMS import error: WebCTVista - renaming failed for file $file");
+                                }
+                            }
+                        }
                     }
                 }
             }
@@ -679,10 +757,11 @@ sub process_resinfo {
                 $cid = $env{'request.course.id'};
             }
             my $destresdir = $destdir;
+            my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
             if ($context eq 'CSTR') {
-                $destresdir =~ s|/home/httpd/html/priv/|/res/|;
+                $destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
             } elsif ($context eq 'DOCS') {
-                $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+                $destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
             }
             foreach my $res (sort(keys(%allquestions))) {
                 my $parent = $allquestions{$res};
@@ -2333,6 +2412,7 @@ sub parse_webctvista4_question {
             @{$$settings{$id}{numids}} = ();
             %{$$allanswers{$id}} = ();
             $$settings{$id}{title} = $attr->{title};
+            $$settings{$id}{title} =~ s/\%/pct_/g;
         }
         if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
             $currvar = $attr->{'webct:name'};
@@ -2357,7 +2437,12 @@ sub parse_webctvista4_question {
             $$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
         }
         if ("@state" eq "questestinterop item presentation flow material matimage") {
-            $$settings{$id}{image} = $attr->{uri};
+            if ($attr->{uri} =~ /\QRelativeResourceManager?contentID=\E(\d+)$/) {
+                $$settings{$id}{image} = $1;
+                push(@{$$resources{$res}{image}},$$settings{$id}{image});
+            } else {
+                $$settings{$id}{image} = $attr->{uri};
+            }
         }
 
         if ("@state" eq "questestinterop item presentation flow material mattext")  {
@@ -2562,9 +2647,20 @@ sub parse_webctvista4_question {
      text_h =>
      [sub {
         my ($text) = @_;
+        $text =~ s/\s*\&\s*/_and_/g;
         if ($currtexttype eq '/text/html') {
             $text =~ s#(&lt;img\ssrc=")([^"]+)"&gt;#$1../resfiles/$2#g;
         }
+        if ("@state" eq "questestinterop item presentation flow material matimage") {
+            my $imagetitle;
+            if ($text =~ /,/) {
+                $imagetitle = (split(/,/,$text))[-1];
+            } else {
+                $imagetitle = $text;
+            }
+            $$settings{$id}{imagetitle} = $imagetitle;
+            push(@{$$resources{$res}{imagetitle}},$imagetitle);
+        }
         if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
             $fieldlabel = $text;
         }
@@ -3217,10 +3313,11 @@ sub process_assessment {
         ($cdom,$cnum) = split/_/,$cid;
     }
     my $destresdir = $destdir;
+    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     if ($context eq 'CSTR') {
-        $destresdir =~ s|/home/httpd/html/priv/|/res/|;
+        $destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
     } elsif ($context eq 'DOCS') {
-        $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+        $destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
     }
     if ($cms eq 'bb5') {
         &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
@@ -3367,8 +3464,8 @@ sub build_problem_container {
         push @{$sequencesfiles},$mapname.'.sequence';
     } else {
         $$containerdir = $pagedir.'/'.$mapname.'.page';
-        if (!-e "$destdir/pages") {
-            mkdir("$destdir/pages",0770);
+        if (!-e "$pagedir") {
+            mkdir("$pagedir",0770);
         }
         open($fh,">$$containerdir");
         $$total{page} ++;
@@ -3388,7 +3485,9 @@ sub build_problem_container {
             $probtitle{$id} =~ s/\s+/_/g;
             $probtitle{$id} =~ s/:/_/g;
             $probtitle{$id} =~ s/\//_/g;
-            $probtitle{$id} .= '_'.$id;
+            if ($cms eq 'webctce4') {
+                $probtitle{$id} .= '_'.$id;
+            }
         }
         if (($cms eq 'webctce4' && $container ne 'database') ||
             ($cms eq 'webctvista4'))   {
@@ -3462,6 +3561,7 @@ sub write_bb5_questions {
     my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
     my $qnum = 0;
     my $pathstart;
+    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     if ($context eq 'CSTR') {
         $pathstart = '../..';
     } else {
@@ -3481,7 +3581,7 @@ sub write_bb5_questions {
         $qnum ++;
         my $output;
         my $permcontainer = $containerdir;
-        $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+        $permcontainer =~ s{^\Q$londocroot/userfiles\E}{uploaded};
         my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
         my %resourcedata = ();
         for (my $i=0; $i<10; $i++) {
@@ -3838,6 +3938,7 @@ sub write_bb5_questions {
 
 sub write_webct4_questions {
     my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle) = @_;
+    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my $qnum = 0;
     foreach my $id (@{$alldbquestids}) {
         $qnum ++;
@@ -3870,7 +3971,7 @@ sub write_webct4_questions {
                 }
             }
         }
-        $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+        $permcontainer =~ s{\Q$londocroot/userfiles\E}{uploaded};
         my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
         my %resourcedata = ();
         for (my $i=0; $i<10; $i++) {
@@ -3905,6 +4006,13 @@ sub write_webct4_questions {
                 }
             }
         }
+        if (($cms eq 'webctvista4') && (defined($$settings{$id}{image}))) {
+            my $imgsrc = '../../resfiles/'.$$settings{$id}{image};
+            if (defined($$settings{$id}{imagetitle})) {
+                $imgsrc = '../../resfiles/'.$$settings{$id}{imagetitle};
+            }
+            $questionimage = qq|<p><img src="$imgsrc" /></p>|;
+        }
         if ($$settings{$id}{class} eq "paragraph") {
             my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
             if ($context eq 'CSTR') {
@@ -4435,7 +4543,6 @@ $$settings{$id}{$list}{jumbledtext}[$k]
             $title =~ s/\s/_/g;
             $title =~ s/:/_/g;
             $title =~ s/\//_/g;
-            $title .= '_'.$id;
             open(PROB,">$destdir/problems/$probdir/$title.problem");
             print PROB $output;
             close PROB;
@@ -4477,6 +4584,7 @@ sub test_for_html {
 
 sub write_bb6_questions {
     my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
+    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my $qnum = 0;
     foreach my $id (@{$allids}) {
         my $questiontext = $$settings{$id}{question}{text};
@@ -4485,7 +4593,7 @@ sub write_bb6_questions {
         $qnum ++;
         my $output;
         my $permcontainer = $containerdir;
-        $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+        $permcontainer =~ s{\Q$londocroot/userfiles\E}{uploaded};
         my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
         my %resourcedata = ();
         for (my $i=0; $i<10; $i++) {
@@ -4979,10 +5087,11 @@ sub process_content {
     my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;
     my $xmlfile = $docroot.'/'.$res.".dat";
     my $destresdir = $destdir;
+    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     if ($context eq 'CSTR') {
-        $destresdir =~ s|/home/httpd/html/priv/|/res/|;
+        $destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
     } elsif ($context eq 'DOCS') {
-        $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+        $destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
     }
     my $filetag = '';
     if ($cms eq 'bb5') {