# The LearningOnline Network
# Documents
#
# $Id: londocs.pm,v 1.177 2005/06/05 07:10:32 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::imsexport;
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');
}
}
sub clean {
my ($title)=@_;
$title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
return $title;
}
# -------------------------------------------------------- Actually dump course
sub dumpcourse {
my $r=shift;
my $html=&Apache::lonxml::xmlbegin();
$r->print($html.'Dump DOCS'.
&Apache::loncommon::bodytag('Dump Course DOCS to Construction Space').
'');
}
}
# ------------------------------------------------------ Generate "export" button
sub exportbutton {
return '';
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 = &Apache::loncommon::get_env_multiple('form.archive');
my @discussions = &Apache::loncommon::get_env_multiple('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 %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';
my $cwd = &Cwd::getcwd();
my $imszip = '/home/httpd/'.$imszipfile;
chdir $tempexport;
open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
close(OUTPUT);
chdir $cwd;
$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. ';
}
}
my $html=&Apache::lonxml::xmlbegin();
$r->print($html.'Export Course'.
&Apache::loncommon::bodytag('Export course to IMS content package'));
$r->print($outcome);
$r->print('