Return to imsexport.pm CVS log

Up to [LON-CAPA] / loncom / imspackages

- Bug 6708.

# The LearningOnline Network
#
# $Id: imsexport.pm,v 1.13 2016/06/20 16:39:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::imsexport;

use strict;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::loncourserespicker;
use Apache::londocs;
use Apache::lonlocal;
use Cwd;
use LONCAPA qw(:DEFAULT :match);

sub exportcourse {
    my $r=shift;
    my $crstype = &Apache::loncommon::course_type();
    my ($navmap,$errormsg) = 
        &Apache::loncourserespicker::get_navmap_object($crstype,'imsexport'); 
    unless (ref($navmap)) {
        $r->print($errormsg);
        return;
    }
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                            ['finishexport']);
    if ($env{'form.finishexport'}) {
        &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                            ['archive','discussion']);
        my $outcome; 
        my $format = $env{'form.format'};
        my @exportitems = &Apache::loncommon::get_env_multiple('form.archive');
        my @discussions = &Apache::loncommon::get_env_multiple('form.discussion');
        if (@exportitems == 0 && @discussions == 0) {
            $outcome =
                '<p class="LC_warning">'
               .&mt('As you did not select any content items or discussions'
                   .' for export, an IMS package has not been created.')
               .'</p>'
               .'<p>'
               .&mt('Please [_1]go back[_2] to select either content items'
                   .' or discussions for export.'
                       ,'<a href="javascript:history.go(-1)">'
                       ,'</a>')
               .'</p>';
        } else {
            my $now = time;
            my %symbs;
            my $manifestok = 0;
            my $imsresources;
            my $tempexport;
            my $copyresult;
            my $testbank;
            my $ims_manifest = &create_ims_store($now,\$manifestok,\$outcome,\$tempexport,$format,\$testbank);
            if ($manifestok) {
                &build_package($now,$navmap,\@exportitems,\@discussions,\$outcome,$tempexport,\$copyresult,$ims_manifest,$format,$testbank);
                close($ims_manifest);

#Create zip file in prtspool
                my $imszipfile = '/prtspool/'.
                $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
                   time.'_'.rand(1000000000).'.zip';
                my $cwd = &Cwd::getcwd();
                my $imszip = '/home/httpd/'.$imszipfile;
                chdir $tempexport;
                open(OUTPUT, "zip -r $imszip *  2> /dev/null |");
                close(OUTPUT);
                chdir $cwd;
                $outcome .= '<p>'
                           .&mt('[_1]Your IMS package[_2] is ready for download.'
                               ,'<a href="'.$imszipfile.'">','</a>')
                           .'</p>';
                if ($copyresult) {
                    $outcome .= '<p class="LC_error">'
                               .&mt('The following errors occurred during export - [_1]'
                                   ,$copyresult)
                               .'</p>';
                }
            } else {
                $outcome = '<p class="LC_error">'
                          .&mt('Unfortunately you will not be able to retrieve'
                              .' an IMS archive of your course at this time,'
                              .' because there was a problem creating a'
                              .' manifest file.')
                          .'</p>'
                          .'<p><a href="javascript:history.go(-1)">'
                          .&mt('Go Back')
                          .'</a></p>';
            }
        }
        $r->print(&Apache::loncommon::start_page('Export '.$crstype.' to IMS Package'));
        $r->print(&Apache::lonhtmlcommon::breadcrumbs('IMS Export'));
        $r->print(&Apache::londocs::startContentScreen('tools')); 
        $r->print($outcome);
        $r->print(&Apache::londocs::endContentScreen());
        $r->print(&Apache::loncommon::end_page());
    } else {
        $r->print(&Apache::loncourserespicker::create_picker($navmap,'imsexport',
                                                             'exportdoc',$crstype));
    }
    return;
}

sub create_ims_store {
    my ($now,$manifestok,$outcome,$tempexport,$format,$testbank) = @_;
    $$tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports';
    my $ims_manifest;
    if (!-e $$tempexport) {
        mkdir($$tempexport,0700);
    }
    $$tempexport .= '/'.$now;
    if (!-e $$tempexport) {
        mkdir($$tempexport,0700);
    }
    $$tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'};
    if (!-e $$tempexport) {
        mkdir($$tempexport,0700);
    }
    if (!-e "$$tempexport/resources") {
        mkdir("$$tempexport/resources",0700);
    }
# open manifest file
    my $manifest = '/imsmanifest.xml';
    my $manifestfilename = $$tempexport.$manifest;
    if ($ims_manifest = Apache::File->new('>'.$manifestfilename)) {
        $$manifestok=1;
        print $ims_manifest
'<?xml version="1.0" encoding="UTF-8"?>'."\n".
'<manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1"'.
' xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2"'.
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'.
' identifier="MANIFEST-'.$env{'request.course.id'}.'-'.$now.'"'.
'  xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1imscp_v1p1.xsd'.
'  http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd">'."\n".
'  <metadata>
    <schema></schema>
    <imsmd:lom>
      <imsmd:general>
        <imsmd:identifier>'.$env{'request.course.id'}.'</imsmd:identifier>
        <imsmd:title>
          <imsmd:langstring xml:lang="en">'.$env{'course.'.$env{'request.course.id'}.'.description'}.'</imsmd:langstring>
        </imsmd:title>
      </imsmd:general>
    </imsmd:lom>
  </metadata>'."\n".
'  <organizations default="ORG-'.$env{'request.course.id'}.'-'.$now.'">'."\n".
'    <organization identifier="ORG-'.$env{'request.course.id'}.'-'.$now.'"'.
' structure="hierarchical">'."\n".
'      <title>'.$env{'course.'.$env{'request.course.id'}.'.description'}.'</title>';
        if ($format eq 'plaintext') {
            my $testbankfilename = $$tempexport.'/testbank.txt';
            $$testbank = Apache::File->new('>'.$testbankfilename);
        }
    } else {
        $$outcome .= 'An error occurred opening the IMS manifest file.<br />'
;
    }
    return $ims_manifest;
}

sub build_package {
    my ($now,$navmap,$exportitems,$discussions,$outcome,$tempexport,$copyresult,
        $ims_manifest,$format,$testbank) = @_;
# first iterator to look for dependencies
    my $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
    my $curRes;
    my $count = 0;
    my $depth = 0;
    my $lastcontainer = 0;
    my %parent = ();
    my @dependencies = ();
    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
    while ($curRes = $it->next()) {
        if (ref($curRes)) {
            $count ++;
        }
        if ($curRes == $it->BEGIN_MAP()) {
            $depth++;
            $parent{$depth} = $lastcontainer;
        }
        if ($curRes == $it->END_MAP()) {
            $depth--;
            $lastcontainer = $parent{$depth};
        }
        if (ref($curRes)) {
            if ($curRes->is_sequence() || $curRes->is_page()) {
                $lastcontainer = $count;
            }
            if (grep(/^$count$/,@$exportitems)) {
                &get_dependencies($exportitems,\%parent,$depth,\@dependencies);
            }
        }
    }
# second iterator to build manifest and store resources
    $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
    $depth = 0;
    my $prevdepth;
    $count = 0;
    my $imsresources;
    my $pkgdepth;
    my $currdirpath = 'Top';
    while ($curRes = $it->next()) {
        if ($curRes == $it->BEGIN_MAP()) {
            $prevdepth = $depth;
            $depth++;
        }
        if ($curRes == $it->END_MAP()) {
            $prevdepth = $depth;
            $depth--;
        }

        if (ref($curRes)) {
            $count ++;
            if ((grep(/^$count$/,@$exportitems)) || (grep(/^$count$/,@dependencies))) {
                my $symb = $curRes->symb();
                my $isvisible = 'true';
                my $resourceref;
                if ($curRes->randomout()) {
                    $isvisible = 'false';
                }
                unless ($curRes->is_sequence()) {
                    $resourceref = 'identifierref="RES-'.$env{'request.course.id'}.'-'.$count.'"';
                }
                my $step = $prevdepth - $depth;
                if (($step >= 0) && ($count > 1)) {
                    while ($step >= 0) {
                        print $ims_manifest "\n".'  </item>'."\n";
                        $step --;
                    }
                }
                $prevdepth = $depth;

                my $itementry =
              '<item identifier="ITEM-'.$env{'request.course.id'}.'-'.$count.
              '" isvisible="'.$isvisible.'" '.$resourceref.'>'.
              '<title>'.$curRes->title().'</title>';
                print $ims_manifest "\n".$itementry;

                if ($curRes->is_sequence()) {
                    $currdirpath = 'Top';
                    my $pcslist = $curRes->map_hierarchy();
                    if ($pcslist ne '') {
                        foreach my $pc (split(/,/,$pcslist),$curRes->map_pc()) {
                            next if ($pc <= 1);
                            my $res = $navmap->getByMapPc($pc);
                            if (ref($res)) {
                                my $encloser = $res->title();
                                if ($encloser) {
                                    if ($currdirpath) {
                                        $currdirpath .= ' -> ';
                                    }
                                    $currdirpath .= $encloser;
                                }
                            }
                        }
                    }
                } else {
                    my $content_file;
                    my @hrefs = ();
                    &process_content($count,$curRes,$cdom,$cnum,$symb,\$content_file,\@hrefs,$copyresult,$tempexport,$format,$currdirpath,$testbank);
                    if ($content_file) {
                        $imsresources .= "\n".
                     '   <resource identifier="RES-'.$env{'request.course.id'}.'-'.$count.
                     '" type="webcontent" href="'.$content_file.'">'."\n".
                     '       <file href="'.$content_file.'" />'."\n";
                        foreach my $item (@hrefs) {
                            $imsresources .=
                     '        <file href="'.$item.'" />'."\n";
                        }
                        if (grep(/^$count$/,@$discussions)) {
                            my $ressymb = $symb;
                            my $mode;
                            if ($ressymb =~ m|adm/($match_domain)/($match_username)/(\d+)/bulletinboard$|) {
                                unless ($ressymb =~ m|adm/wrapper/adm|) {
                                    $ressymb = 'bulletin___'.$3.'___adm/wrapper/adm/'.$1.'/'.$2.'/'.$3.'/bulletinboard';
                                }
                                $mode = 'board';
                            }
                            my %extras = (
                                          caller => 'imsexport',
                                          tempexport => $tempexport.'/resources',
                                          count => $count
                                         );
                            my $discresult = &Apache::lonfeedback::list_discussion($mode,undef,$ressymb,\%extras);
                        }
                        $imsresources .= '    </resource>'."\n";
                    }
                }
                $pkgdepth = $depth;
            }
        }
    }
    while ($pkgdepth > 0) {
        print $ims_manifest "    </item>\n";
        $pkgdepth --;
    }
    my $resource_text = qq|
    </organization>
  </organizations>
  <resources>
    $imsresources
  </resources>
</manifest>
    |;
    print $ims_manifest $resource_text;
}

sub get_dependencies {
    my ($exportitems,$parent,$depth,$dependencies) = @_;
    if ($depth > 1) {
        if ((!grep(/^$$parent{$depth}$/,@$exportitems)) && (!grep(/^$$parent{$depth}$/,@$dependencies))) {
            push(@{$dependencies},$$parent{$depth});
            if ($depth > 2) {
                &get_dependencies($exportitems,$parent,$depth-1,$dependencies);
            }
        }
    }
}

sub process_content {
    my ($count,$curRes,$cdom,$cnum,$symb,$content_file,$href,$copyresult,$tempexport,$format,$currdirpath,$testbank) = @_;
    my $content_type;
    my $message;
    my @uploads = ();
    if ($curRes->is_sequence()) {
        $content_type = 'sequence';
    } elsif ($curRes->is_page()) {
        $content_type = 'page'; # need to handle individual items in pages.
    } elsif ($symb =~ m-public/$cdom/$cnum/syllabus$-) {
        $content_type = 'syllabus';
        my $contents = &templatedpage($content_type);
        if ($contents) {
            $$content_file = &store_template($contents,$tempexport,$count,$content_type);
        }
    } elsif ($symb =~ m-\.sequence___\d+___ext-) {
        $content_type = 'external';
        my $title = $curRes->title;
        my $contents =  &external($symb,$title);
        if ($contents) {
            $$content_file = &store_template($contents,$tempexport,$count,$content_type);
        }
    } elsif ($symb =~ m-adm/navmaps$-) {
        $content_type =  'navmap';
    } elsif ($symb =~ m-adm/[^/]+/[^/]+/(\d+)/smppg$-) {
        $content_type = 'simplepage';
        my $contents = &templatedpage($content_type,$1,$count,\@uploads);
        if ($contents) {
            $$content_file = &store_template($contents,$tempexport,$count,$content_type);
        }
    } elsif ($symb =~ m-lib/templates/simpleproblem\.problem$-) {
        $content_type = 'simpleproblem';
        my $contents =  &simpleproblem($symb);
        if ($contents) {
            $$content_file = &store_template($contents,$tempexport,$count,$content_type);
        }
    } elsif ($symb =~ m-lib/templates/examupload\.problem$-) {
        $content_type = 'examupload';
    } elsif ($symb =~ m-adm/($match_domain)/($match_username)/(\d+)/bulletinboard$-) {
        $content_type = 'bulletinboard';
        my $contents =  &templatedpage($content_type,$3,$count,\@uploads,$1,$2);
        if ($contents) {
            $$content_file = &store_template($contents,$tempexport,$count,$content_type);
        }
    } elsif ($symb =~ m-adm/([^/]+)/([^/]+)/aboutme$-) {
        $content_type = 'aboutme';
        my $contents =  &templatedpage($content_type,undef,$count,\@uploads,$1,$2);
        if ($contents) {
            $$content_file = &store_template($contents,$tempexport,$count,$content_type);
        }
    } elsif ($symb =~ m-\.(sequence|page)___\d+___uploaded/$cdom/$cnum/-) {
        $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded');
    } elsif ($symb =~ m-\.(?:sequence|page)___\d+___($match_domain/$match_name/.+)$-) {
        my $url = &Apache::lonnet::clutter($1);
        $url =~ s{^/res/}{/priv/};
        if (($format eq 'html') || ($format eq 'plaintext')) {
            my $title = $curRes->title;
            $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,$format,$currdirpath,$title,$testbank);
        } elsif ($format eq 'xml') {
# only include problem code where current user is author or co-author,
# or this is a course "author" resource.
            my ($ownername,$ownerdom,$ownerhome) = &Apache::lonnet::constructaccess($url);
            if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
                $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'resource');
            } else {
                $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'noedit');
            }
        }
    } elsif ($symb =~ m-uploaded/$cdom/$cnum-) {
        $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded');
    }
    if (@uploads > 0) {
        foreach my $item (@uploads) {
            my $uploadmsg = '';
            &replicate_content($cdom,$cnum,$tempexport,$item,$count,\$uploadmsg,$href,'templateupload');
            if ($uploadmsg) {
                $$copyresult .= $uploadmsg."\n";
            }
        }
    }
    if ($message) {
        $$copyresult .= $message."\n";
    }
}

sub replicate_content {
    my ($cdom,$cnum,$tempexport,$symb,$count,$message,$href,$caller,$currdirpath,
        $title,$testbank) = @_;
    my ($map,$ind,$url);
    if ($caller eq 'templateupload') {
        $url = $symb;
        $url =~ s#//#/#g;
    } else {
        ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
    }
    my $content;
    my $filename;
    my $repstatus;
    my $content_name;
    if ($url =~ m-/([^/]+)$-) {
        $filename = $1;
        if (!-e $tempexport.'/resources') {
            mkdir($tempexport.'/resources',0700);
        }
        if (!-e $tempexport.'/resources/'.$count) {
            mkdir($tempexport.'/resources/'.$count,0700);
        }
        my $destination = $tempexport.'/resources/'.$count.'/'.$filename;
        my $copiedfile;
        if ($copiedfile = Apache::File->new('>'.$destination)) {
            my $content;
            if ($caller eq 'resource') {
                my $respath =  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
                my $filepath = &Apache::lonnet::filelocation($respath,$url);
                $content = &Apache::lonnet::getfile($filepath);
                if ($content eq -1) {
                    $$message = 'Could not copy file '.$filename;
                } else {
                    &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'resource');
                    $repstatus = 'ok';
                }
            } elsif ($caller eq 'uploaded' || $caller eq 'templateupload') {
                my $rtncode;
                $repstatus = &Apache::lonnet::getuploaded('GET',$url,$cdom,$cnum,\$content,$rtncode);
                if ($repstatus eq 'ok') {
                    if ($url =~ /\.html?$/i) {
                        &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'uploaded');
                    }
                } else {
                    $$message = 'Could not render '.$url.' server message - '.$rtncode."<br />\n";
                }
            } elsif (($caller eq 'noedit') || ($caller eq 'html') ||
                     ($caller eq 'plaintext')) {
# Need to render the resource without the LON-CAPA Internal header and the Post discussion footer, and then set $content equal to this.
                my %form = (
                             grade_symb     => $symb,
                             grade_courseid => $cdom.'_'.$cnum,
                             grade_domain   => $env{'user.domain'},
                             grade_username => $env{'user.name'},
                             grade_imsexport => 1,
                             instructor_comments => 'hide',
                           );
                my $feedurl=&Apache::lonnet::clutter($url);
                my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
                if (ref($response)) {
                    if ($response->is_success) {
                        $content = $userview;
                        $content =~ s/\Qonchange="javascript:setSubmittedPart('\E[^\']+\Q');"\E//g;
                        $content =~ s/^\s*[\n\r]+$//;
                        if ($caller eq 'plaintext') {
                            my @lines = split(/[\n\r]+/,$content);
                            my @tosave;
                            my $foilcounter = 0;
                            my @alphabet = ('a'..'z');
                            my $mc_answer;
                            foreach my $line (@lines) {
                                next if ($line =~ /^\s*$/);
                                if ($line =~ m{(|\Q<\label>\E)\Q<br />Incorrect:<label>\E}) {
                                    $foilcounter ++;
                                } elsif ($line =~ m{(|\Q</label>\E)\Q<br />Correct:<b><label>\E}) {
                                    $foilcounter ++;
                                    $mc_answer = $alphabet[$foilcounter-1];
                                } elsif ($line !~ m{\Q</label>\E(|\Q</b>\E)\Q<br />\E}) {
                                    $line =~ s/^(\s+|\s+)$//g;
                                    $line =~ s{^\Q<b>\E([^<]+)\Q</b>\E$}{1};
                                    $tosave[$foilcounter] .= $line.' ';
                                }
                                $content = join("\t",@tosave);
                                if ($mc_answer) {
                                    $content .= "\t".$mc_answer."\n";
                                }
                            }
                            if (@tosave) {
                                my $qtype;
                                if ($mc_answer) {
                                    $qtype = 'MC';
                                }
                                $content = $currdirpath."\t".$title."\t$qtype\t".join("\t",@tosave);
                                if ($mc_answer) {
                                    $content .= "\t".$mc_answer;
                                }
                                $content .= "\n";
                            }
                        } else {
                            $content = '<html><body>'.$content.'</body></html>';
                        }
                        if (($caller eq 'plaintext') && ($testbank)) {
                            print $testbank $content;
                        }
                    } else {
                        $content = 'Not the owner of this resource';
                    }
                } else {
                    $content = 'Not the owner of this resource';
                }
                $repstatus = 'ok';
            }
            if ($repstatus eq 'ok') {
                print $copiedfile $content;
            }
            close($copiedfile);
        } else {
            $$message = 'Could not open destination file for '.$filename."<br />\n";
        }
    } else {
        $$message = 'Could not determine name of file for '.$symb."<br />\n";
    }
    if ($repstatus eq 'ok') {
        $content_name = 'resources/'.$count.'/'.$filename;
    }
    return $content_name;
}

sub extract_media {
    my ($url,$cdom,$cnum,$content,$count,$tempexport,$href,$message,$caller) = @_;
    my ($dirpath,$container);
    my %allfiles = ();
    my %codebase = ();
    if ($url =~ m-(.*/)([^/]+)$-) {
        $dirpath = $1;
        $container = $2;
    } else {
        $dirpath = $url;
        $container = '';
    }
    &Apache::lonnet::extract_embedded_items(undef,\%allfiles,\%codebase,$content);
    foreach my $embed_file (keys(%allfiles)) {
        my $filename;
        if ($embed_file =~ m#([^/]+)$#) {
            $filename = $1;
        } else {
            $filename = $embed_file;
        }
        my $newname = 'res/'.$filename;
        my ($rtncode,$embed_content,$repstatus);
        my $embed_url;
        if ($embed_file =~ m-^/-) {
            $embed_url = $embed_file;           # points to absolute path
        } else {
            if ($embed_file =~ m-https?://-) {
                next;                           # points to url
            } else {
                $embed_url = $dirpath.$embed_file;  # points to relative path
            }
        }
        if ($caller eq 'resource') {
            my $respath =  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
            my $embed_path = &Apache::lonnet::filelocation($respath,$embed_url);
            $embed_content = &Apache::lonnet::getfile($embed_path);
            unless ($embed_content eq -1) {
                $repstatus = 'ok';
            }
        } elsif ($caller eq 'uploaded') {
            $repstatus = &Apache::lonnet::getuploaded('GET',$embed_url,$cdom,$cnum,\$embed_content,$rtncode);
        }
        if ($repstatus eq 'ok') {
            my $destination = $tempexport.'/resources/'.$count.'/res';
            if (!-e "$destination") {
                mkdir($destination,0755);
            }
            $destination .= '/'.$filename;
            my $copiedfile;
            if ($copiedfile = Apache::File->new('>'.$destination)) {
                print $copiedfile $embed_content;
                push(@{$href},'resources/'.$count.'/res/'.$filename);
                my $attrib_regexp = '';
                if (@{$allfiles{$embed_file}} > 1) {
                    $attrib_regexp = join('|',@{$allfiles{$embed_file}});
                } else {
                    $attrib_regexp = $allfiles{$embed_file}[0];
                }
                $$content =~ s#($attrib_regexp\s*=\s*['"]?)\Q$embed_file\E(['"]?)#$1$newname$2#gi;
                if ($caller eq 'resource' && $container =~ /\.(problem|library)$/) {
                    $$content =~ s#\Q$embed_file\E#$newname#gi;
                }
            }
        } else {
            $$message .= 'replication of embedded file - '.$embed_file.' in '.$url.' failed, reason -'.$rtncode."<br />\n";
        }
    }
    return;
}

sub store_template {
    my ($contents,$tempexport,$count,$content_type) = @_;
    if ($contents) {
        if ($tempexport) {
            if (!-e $tempexport.'/resources') {
                mkdir($tempexport.'/resources',0700);
            }
            if (!-e $tempexport.'/resources/'.$count) {
                mkdir($tempexport.'/resources/'.$count,0700);
            }
            my $destination = $tempexport.'/resources/'.$count.'/'.$content_type.'.xml';
            my $storetemplate;
            if ($storetemplate = Apache::File->new('>'.$destination)) {
                print $storetemplate $contents;
                close($storetemplate);
            }
            if ($content_type eq 'external') {
                return 'resources/'.$count.'/'.$content_type.'.html';
            } else {
                return 'resources/'.$count.'/'.$content_type.'.xml';
            }
        }
    }
}

sub simpleproblem  {
    my ($symb) = @_;
    my $output;
    my %qparms = &Apache::lonnet::dump('resourcedata',
                  $env{'course.'.$env{'request.course.id'}.'.domain'},
                  $env{'course.'.$env{'request.course.id'}.'.num'},
                  $env{'request.course.id'}.'.'.$symb);
    if ($symb) {
        my $prefix=$env{'request.course.id'}.'.'.$symb.'.0.';
        my $qtype=$qparms{$prefix.'questiontype'};
        my $qtext=$qparms{$prefix.'questiontext'};
        my $hint=$qparms{$prefix.'hinttext'};
        my %values = ();
        my %foils = ();
        if (($qtype eq 'radio') || ($qtype eq 'option')) {
            my $maxfoils=$qparms{$prefix.'maxfoils'};
            my $randomize=$qparms{$prefix.'randomize'};
            if ($qtype eq 'option') {
                my $options=$qparms{$prefix.'options'};
                %values = &evaloptionhash($options);
                $output .= qq|
<problem>
  <startouttext />$qtext<endouttext />
  <optionresponse max="$maxfoils" randomize="$randomize">
    <foilgroup options="$options">
|;
                for (my $k=0; $k<10; $k++) {
                    my $iter = $k+1;
                    $output .= '   <foil name="foil'.$k.'" value="'.$qparms{$prefix.'value'.$iter}.'"';
                    $output .= ' location="'.$qparms{$prefix.'position'.$iter}.'" ';
                    $output .= '><startouttext />'.$qparms{$prefix.'text'.$iter}.'<endouttext /></foil>'."\n";
                }
                chomp($output);
                $output .= qq|
    </foilgroup>
|;
                if ($hint) {
                    $output .= '
    <hintgroup>
     <hintpart on="default">
      <startouttext />'.$hint.'<endouttext/>
     </hintpart>
    </hintgroup>';
                }
                $output .= qq|
  </optionresponse>
</problem>
|;
            } else {
                $output .= qq|
<problem>
  <startouttext />$qtext<endouttext />
  <radiobuttonresponse max="$maxfoils" randomize="$randomize">
  <foilgroup>
|;
                for (my $k=0; $k<10; $k++) {
                    my $iter = $k+1;
                    $output .= '   <foil name="foil'.$k.'" value="'.$qparms{$prefix.'value'.$iter}.'"';
                    $output .= ' location="'.$qparms{$prefix.'position'.$iter}.'" ';
                    $output .= '><startouttext />'.$qparms{$prefix.'text'.$iter}.'<endouttext /></foil>'."\n";
                }
                chomp($output);
                $output .= qq|
   </foilgroup>
|;
                if ($hint) {
                    $output .= '
   <hintgroup>
    <hintpart on="default">
     <startouttext />'.$hint.'<endouttext/>
    </hintpart>
   </hintgroup>';
                }
                $output .= qq|
  </radiobuttonresponse>
</problem>
|;
            }
        } elsif ($qtype eq 'string') {
            my $stringanswer = $qparms{$prefix.'stringanswer'};
            my $stringtype=$qparms{$prefix.'stringtype'};
            $output .= qq|
<problem>
  <stringresponse answer="$stringanswer" type="$stringtype">
  <startouttext />$qtext<endouttext />
    <textline />
            |;
            if ($hint) {
                $output .= '
   <hintgroup>
    <hintpart on="default">
     <startouttext />'.$hint.'<endouttext/>
    </hintpart>
   </hintgroup>';
            }
            $output .= qq|
  </stringresponse>
</problem>
|;
        } elsif ($qtype eq 'numerical') {
            my $sigfigs = $qparms{$prefix.'numericalsigfigs'};
            my $unit = $qparms{$prefix.'numericalunit'};
            my $answer = $qparms{$prefix.'numericalanswer'};
            my $tolerance = $qparms{$prefix.'numericaltolerance'};
            my $format = $qparms{$prefix.'numericalformat'};
            my $scriptblock = $qparms{$prefix.'numericalscript'};
            $output .= qq|
<problem>
|;
            if ($scriptblock) {
                $output .= qq|
<script type="loncapa/perl">
$scriptblock
</script>|;
             }
             $output .= qq|
<startouttext />$qtext<endouttext />
<numericalresponse answer="$answer" |;
             if ($unit ne '') {
                 $output .= qq|unit="$unit" |;
             }
             if ($format ne '') {
                 $output .= qq|format="$format" |;
             }
             $output =~ s{ $}{};
             $output .= '>';
             if ($tolerance ne '') {
                 $output .= qq|
  <responseparam name="tol" type="tolerance" default="$tolerance" description="Numerical Tolerance" />|;
             }
             if ($sigfigs) {
                 $output .= qq|
  <responseparam name="sig" type="int_range" default="$sigfigs" description="Significant Digits" />|;
             }
             $output .= qq|
  <textline />|;
            if ($hint) {
                $output .= qq|
  <hintgroup>
    <hintpart on="default">
      <startouttext />'.$hint.'<endouttext/>
    </hintpart>
  </hintgroup>|;
            }
            $output .= qq|
</numericalresponse>
</problem>
|;
        } else {
            $output .= qq|
<problem>
  <startouttext />$qtext<endouttext />
  <essayresponse>
  <textfield></textfield>
  </essayresponse>
</problem>
|;
        }
    }
    return $output;
}

sub evaloptionhash {
    my $options=shift;
    $options=~s/^\(\'//;
    $options=~s/\'\)$//;
    my %returnhash=();
    foreach (split(/\'\,\'/,$options)) {
        $returnhash{$_}=$_;
    }
    return %returnhash;
}

sub external {
    my ($symb,$title) = @_;
    my $output;
    if ($symb =~  m-\.sequence___\d+___ext(.+)$-) {
        my $exturl = &unescape($1);
        $output = qq|
<html>
<head><title>$title</title>
</head>
<frameset rows="0,*" border="0">
<frame src='' />
<frame src="http://$exturl" name="external" />
</frameset>
</html>
        |;
    }
    return $output;
}

sub templatedpage {
    my ($content_type,$timestamp,$count,$uploads,$udom,$uname) = @_;
    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
    my $output = '
<'.$content_type.'>';
    my %syllabusdata=();
    my %syllabusfields=();
    if ($content_type eq 'syllabus') {
        %syllabusfields=&Apache::lonlocal::texthash(
           'aaa_instructorinfo' => 'Instructor Information',
           'bbb_description'    => 'Course Description',
           'ccc_prereq'         => 'Prerequisites',
           'cdc_classhours'     => 'Class Hours',
           'ddd_officehours'    => 'Office Hours',
           'eee_helproom'       => 'Helproom Hours',
           'efe_projectinfo'    => 'Project Information',
           'fff_examinfo'       => 'Exam Information',
           'fgf_deadlines'      => 'Deadlines',
           'ggg_grading'        => 'Grading Information',
           'hhh_readings'       => 'Readings',
           'iii_coursepack'     => 'Coursepack',
           'jjj_weblinks'       => 'Web Links',
           'kkk_textbook'       => 'Textbook',
           'lll_includeurl'     => 'URLs To Include in Syllabus'
        );
        %syllabusdata = &Apache::lonnet::dump('syllabus',$cdom,$cnum);

    } elsif ($content_type eq 'simplepage') {
        %syllabusfields=&Apache::lonlocal::texthash(
           'aaa_title'         => 'Page Title',
           'bbb_content'       => 'Content',
           'ccc_webreferences' => 'Web References'
        );
        %syllabusdata = &Apache::lonnet::dump('smppage_'.$timestamp,$cdom,$cnum);
    } elsif ($content_type eq 'bulletinboard') {
        %syllabusfields=&Apache::lonlocal::texthash(
           'aaa_title'         => 'Topic',
           'bbb_content'       => 'Task',
           'ccc_webreferences' => 'Web References'
        );
        %syllabusdata = &Apache::lonnet::dump('bulletinpage_'.$timestamp,$cdom,$cnum);
    } elsif ($content_type eq 'aboutme') {
        %syllabusdata=&Apache::lonnet::dump('aboutme',$udom,$uname);
        %syllabusfields=&Apache::lonlocal::texthash(
           'aaa_contactinfo'   => 'Contact Information',
           'bbb_aboutme'       => 'Personal Information',
           'ccc_webreferences' => 'Web References'
        );
        $output .= qq|
  <username>$uname</username>
  <domain>$udom</domain>
|;
    }
    foreach (sort(keys(%syllabusfields))) {
        $output .= qq|
<$_>
 <name>$syllabusfields{$_}</name>
 <value>$syllabusdata{$_}</value>
</$_>|;
    }
    if (defined($syllabusdata{'uploaded.photourl'})) {
        if ($syllabusdata{'uploaded.photourl'} =~  m-/([^/]+)$-) {
            push @$uploads, $syllabusdata{'uploaded.photourl'};
        }
        $output .= '
<photo>
 <filename>'.$count.'/'.$1.'</filename>
</photo>';
    }
    $output .= '
</'.$content_type.'>';
    return $output;
}

1;

__END__

=head1 NAME

Apache::imsexport.pm

=head1 SYNOPSIS

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.

=head1 SUBROUTINES

=over

=item exportcourse()

=item create_ims_store()

=item build_package()

=item get_dependencies()

=item process_content()

=item replicate_content()

=item extract_media()

=item store_template()

=item simpleproblem()

=item evaloptionhash()

=item external()

=item templatedpage()

=back

=cut