--- loncom/interface/londocs.pm 2004/09/18 17:03:25 1.144
+++ loncom/interface/londocs.pm 2009/01/28 11:51:22 1.326
@@ -1,2228 +1,3679 @@
-# The LearningOnline Network
-# Documents
-#
-# $Id: londocs.pm,v 1.144 2004/09/18 17:03:25 albertel 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::londocs;
-
-use strict;
-use Apache::Constants qw(:common :http);
-use Apache::lonnet;
-use Apache::loncommon;
-use Apache::lonratedt;
-use Apache::lonratsrv;
-use Apache::lonxml;
-use Apache::loncreatecourse;
-use Apache::lonnavmaps;
-use HTML::Entities;
-use GDBM_File;
-use Apache::lonlocal;
-use Cwd;
-
-my $iconpath;
-
-my %hash;
-
-my $hashtied;
-my %alreadyseen=();
-
-my $hadchanges;
-
-# Available help topics
-
-my %help=();
-
-# Mapread read maps into lonratedt::global arrays
-# @order and @resources, determines status
-# sets @order - pointer to resources in right order
-# sets @resources - array with the resources with correct idx
-#
-
-sub mapread {
- my ($coursenum,$coursedom,$map)=@_;
- return
- &Apache::lonratedt::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
- $map);
-}
-
-sub storemap {
- my ($coursenum,$coursedom,$map)=@_;
- my ($outtext,$errtext)=
- &Apache::lonratedt::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
- $map,1);
- if ($errtext) { return ($errtext,2); }
-
- $hadchanges=1;
- return ($errtext,0);
-}
-
-# ----------------------------------------- Return hash with valid author names
-
-sub authorhosts {
- my %outhash=();
- my $home=0;
- my $other=0;
- foreach (keys %ENV) {
- if ($_=~/^user\.role\.(au|ca)\.(.+)$/) {
- my $role=$1;
- my $realm=$2;
- my ($start,$end)=split(/\./,$ENV{$_});
- if (($start) && ($start>time)) { next; }
- if (($end) && (time>$end)) { next; }
- my $ca; my $cd;
- if ($1 eq 'au') {
- $ca=$ENV{'user.name'};
- $cd=$ENV{'user.domain'};
- } else {
- ($cd,$ca)=($realm=~/^\/(\w+)\/(\w+)$/);
- }
- my $allowed=0;
- my $myhome=&Apache::lonnet::homeserver($ca,$cd);
- my @ids=&Apache::lonnet::current_machine_ids();
- foreach my $id (@ids) { if ($id eq $myhome) { $allowed=1; } }
- if ($allowed) {
- $home++;
- $outhash{'home_'.$ca.'@'.$cd}=1;
- } else {
- $outhash{'otherhome_'.$ca.'@'.$cd}=$myhome;
- $other++;
- }
- }
- }
- return ($home,$other,%outhash);
-}
-# ------------------------------------------------------ Generate "dump" button
-
-sub dumpbutton {
- my ($home,$other,%outhash)=&authorhosts();
- if ($home+$other==0) { return ''; }
- my $output='
'.
- &mt('Dump Course DOCS to Construction Space: available on other servers');
- }
-}
-
-# -------------------------------------------------------- Actually dump course
-
-sub dumpcourse {
- my $r=shift;
- $r->print('Dump DOCS'.
- &Apache::loncommon::bodytag('Dump Course DOCS to Construction Space').
- '');
- }
-}
-
-# ------------------------------------------------------ Generate "export" button
-
-sub exportbutton {
- return '
'.
- ''.
- &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs');
-}
-
-sub exportcourse {
- my $r=shift;
- my %discussiontime = &Apache::lonnet::dump('discussiontimes',
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
- my $numdisc = keys %discussiontime;
- my $navmap = Apache::lonnavmaps::navmap->new();
- my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);
- my $curRes;
- my $outcome;
-
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['finishexport']);
- if ($ENV{'form.finishexport'}) {
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['archive','discussion']);
-
- my @exportitems = ();
- if (defined($ENV{'form.archive'})) {
- if (ref($ENV{'form.archive'}) eq 'ARRAY') {
- @exportitems = @{$ENV{'form.archive'}};
- } else {
- $exportitems[0] = $ENV{'form.archive'};
- }
- }
- my @discussions = ();
- if (defined($ENV{'form.discussion'})) {
- if (ref($ENV{'form.discussion'}) eq 'ARRAY') {
- @discussions = $ENV{'form.discussion'};
- } else {
- $discussions[0] = $ENV{'form.discussion'};
- }
- }
- if (@exportitems == 0 && @discussions == 0) {
- $outcome = ' As you did not select any content items or discussions for export, an IMS package has not been created. Please go back to select either content items or discussions for export';
- } else {
- my $now = time;
- my $count = 0;
- my %symbs;
- my $manifestok = 0;
- my $imsresources;
- my $tempexport;
- my $copyresult;
- my $ims_manifest = &create_ims_store($now,\$manifestok,\$outcome,\$tempexport);
- if ($manifestok) {
- &build_package($now,$navmap,\@exportitems,\@discussions,\$outcome,\$tempexport,\$copyresult,$ims_manifest);
- close($ims_manifest);
-
-#Create zip file in prtspool
- my $imszipfile = '/prtspool/'.
- $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
- time.'_'.rand(1000000000).'.zip';
-# zip 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);
- my $cwd = &Cwd::getcwd();
- my $imszip = '/home/httpd/'.$imszipfile;
- chdir $tempexport;
- open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
- close(OUTPUT);
- chdir $cwd;
- %ENV=%oldENV;
- undef(%oldENV);
- $outcome .= 'Download the zip file from IMS course archive ';
- if ($copyresult) {
- $outcome .= 'The following errors occurred during export - '.$copyresult;
- }
- } else {
- $outcome = ' Unfortunately you will not be able to retrieve an IMS archive of this posts at this time, because there was a problem creating a manifest file. ';
- }
- }
-
- $r->print('Export Course'.
- &Apache::loncommon::bodytag('Export course to IMS or SCORM content package'));
- $r->print($outcome);
- $r->print('');
- } else {
- my $display;
- $display = '