# The LearningOnline Network
# Documents
#
# $Id: londocs.pm,v 1.521 2012/12/05 13:50:32 bisitz 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::lonhtmlcommon;
use LONCAPA::map();
use Apache::lonratedt();
use Apache::lonxml;
use Apache::lonclonecourse;
use Apache::lonnavmaps;
use Apache::lonnavdisplay();
use Apache::lonuserstate();
use Apache::lonextresedit();
use HTML::Entities;
use HTML::TokeParser;
use GDBM_File;
use Apache::lonlocal;
use Cwd;
use LONCAPA qw(:DEFAULT :match);
my $iconpath;
my %hash;
my $hashtied;
my %alreadyseen=();
my $hadchanges;
my %help=();
sub mapread {
my ($coursenum,$coursedom,$map)=@_;
return
&LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
$map);
}
sub storemap {
my ($coursenum,$coursedom,$map,$contentchg)=@_;
my $report;
if (($contentchg) && ($map =~ /^default/)) {
$report = 1;
}
my ($outtext,$errtext)=
&LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
$map,1,$report);
if ($errtext) { return ($errtext,2); }
$hadchanges=1;
return ($errtext,0);
}
sub authorhosts {
my %outhash=();
my $home=0;
my $other=0;
foreach my $key (keys(%env)) {
if ($key=~/^user\.role\.(au|ca)\.(.+)$/) {
my $role=$1;
my $realm=$2;
my ($start,$end)=split(/\./,$env{$key});
if (($start) && ($start>time)) { next; }
if (($end) && (time>$end)) { next; }
my ($ca,$cd);
if ($1 eq 'au') {
$ca=$env{'user.name'};
$cd=$env{'user.domain'};
} else {
($cd,$ca)=($realm=~/^\/($match_domain)\/($match_username)$/);
}
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;
last;
}
}
if ($allowed) {
$home++;
$outhash{'home_'.$ca.':'.$cd}=1;
} else {
$outhash{'otherhome_'.$ca.':'.$cd}=$myhome;
$other++;
}
}
}
return ($home,$other,%outhash);
}
sub clean {
my ($title)=@_;
$title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
return $title;
}
sub dumpcourse {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
$r->print(&Apache::loncommon::start_page('Dump '.$crstype.' Content to Authoring Space')."\n".
&Apache::lonhtmlcommon::breadcrumbs('Dump '.$crstype.' Content to Authoring Space')."\n");
$r->print(&startContentScreen('tools'));
my ($home,$other,%outhash)=&authorhosts();
unless ($home) {
$r->print(&endContentScreen());
return '';
}
my $origcrsid=$env{'request.course.id'};
my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
# Do the dumping
unless ($outhash{'home_'.$env{'form.authorspace'}}) {
$r->print(&endContentScreen());
return '';
}
my ($ca,$cd)=split(/\@/,$env{'form.authorspace'});
$r->print('
'.&mt('Copying Files').'
');
my $title=$env{'form.authorfolder'};
$title=&clean($title);
my %replacehash=();
foreach my $key (keys(%env)) {
if ($key=~/^form\.namefor\_(.+)/) {
$replacehash{$1}=$env{$key};
}
}
my $crs='/uploaded/'.$env{'request.course.id'}.'/';
$crs=~s/\_/\//g;
foreach my $item (keys(%replacehash)) {
my $newfilename=$title.'/'.$replacehash{$item};
$newfilename=~s/\.(\w+)$//;
my $ext=$1;
$newfilename=&clean($newfilename);
$newfilename.='.'.$ext;
my @dirs=split(/\//,$newfilename);
my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca";
my $makepath=$path;
my $fail=0;
for (my $i=0;$i<$#dirs;$i++) {
$makepath.='/'.$dirs[$i];
unless (-e $makepath) {
unless(mkdir($makepath,0777)) { $fail=1; }
}
}
$r->print(' '.$item.' => '.$newfilename.': ');
if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) {
if ($item=~/\.(sequence|page|html|htm|xml|xhtml)$/) {
print $fh &Apache::lonclonecourse::rewritefile(
&Apache::lonclonecourse::readfile($env{'request.course.id'},$item),
(%replacehash,$crs => '')
);
} else {
print $fh
&Apache::lonclonecourse::readfile($env{'request.course.id'},$item);
}
$fh->close();
} else {
$fail=1;
}
if ($fail) {
$r->print(''.&mt('fail').'');
} else {
$r->print(''.&mt('ok').'');
}
}
} else {
$r->print(&mt('Searching ...').' ');
$r->rflush();
# Input form
$r->print('');
}
$r->print(&endContentScreen());
}
sub group_import {
my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;
while (@files) {
my ($name, $url, $residx) = @{ shift(@files) };
if (($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$})
&& ($caller eq 'londocs')
&& (!&Apache::lonnet::stat_file($url))) {
my $errtext = '';
my $fatal = 0;
my $newmapstr = '';
$env{'form.output'}=$newmapstr;
my $result=&Apache::lonnet::finishuserfileupload($coursenum,$coursedom,
'output',$1.$2);
if ($result != m|^/uploaded/|) {
$errtext.='Map not saved: A network error occurred when trying to save the new map. ';
$fatal = 2;
}
if ($fatal) {
return ($errtext,$fatal);
}
}
if ($url) {
if (!$residx
|| defined($LONCAPA::map::zombies[$residx])) {
$residx = &LONCAPA::map::getresidx($url,$residx);
push(@LONCAPA::map::order, $residx);
}
my $ext = 'false';
if ($url=~m{^http://} || $url=~m{^https://}) { $ext = 'true'; }
$url = &LONCAPA::map::qtunescape($url);
$name = &LONCAPA::map::qtunescape($name);
$LONCAPA::map::resources[$residx] =
join(':', ($name, $url, $ext, 'normal', 'res'));
}
}
return &storemap($coursenum, $coursedom, $folder.'.'.$container,1);
}
sub log_docs {
return &Apache::lonnet::write_log('course','docslog',@_);
}
{
my @oldresources=();
my @oldorder=();
my $parmidx;
my %parmaction=();
my %parmvalue=();
my $changedflag;
sub snapshotbefore {
@oldresources=@LONCAPA::map::resources;
@oldorder=@LONCAPA::map::order;
$parmidx=undef;
%parmaction=();
%parmvalue=();
$changedflag=0;
}
sub remember_parms {
my ($idx,$parameter,$action,$value)=@_;
$parmidx=$idx;
$parmaction{$parameter}=$action;
$parmvalue{$parameter}=$value;
$changedflag=1;
}
sub log_differences {
my ($plain)=@_;
my %storehash=('folder' => $plain,
'currentfolder' => $env{'form.folder'});
if ($parmidx) {
$storehash{'parameter_res'}=$oldresources[$parmidx];
foreach my $parm (keys(%parmaction)) {
$storehash{'parameter_action_'.$parm}=$parmaction{$parm};
$storehash{'parameter_value_'.$parm}=$parmvalue{$parm};
}
}
my $maxidx=$#oldresources;
if ($#LONCAPA::map::resources>$#oldresources) {
$maxidx=$#LONCAPA::map::resources;
}
for (my $idx=0; $idx<=$maxidx; $idx++) {
if ($LONCAPA::map::resources[$idx] ne $oldresources[$idx]) {
$storehash{'before_resources_'.$idx}=$oldresources[$idx];
$storehash{'after_resources_'.$idx}=$LONCAPA::map::resources[$idx];
$changedflag=1;
}
if ($LONCAPA::map::order[$idx] ne $oldorder[$idx]) {
$storehash{'before_order_res_'.$idx}=$oldresources[$oldorder[$idx]];
$storehash{'after_order_res_'.$idx}=$LONCAPA::map::resources[$LONCAPA::map::order[$idx]];
$changedflag=1;
}
}
$storehash{'maxidx'}=$maxidx;
if ($changedflag) { &log_docs(\%storehash); }
}
}
sub docs_change_log {
my ($r,$coursenum,$coursedom,$folder,$allowed,$crstype,$iconpath)=@_;
my $supplementalflag=($env{'form.folderpath'}=~/^supplemental/);
my $js = ''."\n";
$r->print(&Apache::loncommon::start_page('Content Change Log',$js));
$r->print(&Apache::lonhtmlcommon::breadcrumbs('Content Change Log'));
$r->print(&startContentScreen(($supplementalflag?'suppdocs':'docs')));
my %orderhash;
my $container='sequence';
my $pathitem;
if ($env{'form.folderpath'} =~ /\:1$/) {
$container='page';
}
my $folderpath=$env{'form.folderpath'};
if ($folderpath eq '') {
$folderpath = 'default&'.&escape(&mt('Main '.$crstype.' Documents').':::::');
}
$pathitem = '';
my $readfile="/uploaded/$coursedom/$coursenum/$folder.$container";
my $jumpto = $readfile;
$jumpto =~ s{^/}{};
my $tid = 1;
if ($supplementalflag) {
$tid = 2;
}
my ($breadcrumbtrail) =
&Apache::lonhtmlcommon::docs_breadcrumbs($allowed,$crstype,1);
$r->print($breadcrumbtrail.
&generate_edit_table($tid,\%orderhash,undef,$iconpath,$jumpto,
$readfile));
my %docslog=&Apache::lonnet::dump('nohist_docslog',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
if ((keys(%docslog))[0]=~/^error\:/) { undef(%docslog); }
my %saveable_parameters = ('show' => 'scalar',);
&Apache::loncommon::store_course_settings('docs_log',
\%saveable_parameters);
&Apache::loncommon::restore_course_settings('docs_log',
\%saveable_parameters);
if (!$env{'form.show'}) { $env{'form.show'}=10; }
# FIXME: internationalization seems wrong here
my %lt=('hiddenresource' => 'Resources hidden',
'encrypturl' => 'URL hidden',
'randompick' => 'Randomly pick',
'randomorder' => 'Randomly ordered',
'set' => 'set to',
'del' => 'deleted');
my $filter = &Apache::loncommon::display_filter('docslog')."\n".
$pathitem."\n".
''.
(' 'x2).'';
$r->print('
'.
&Apache::loncommon::end_data_table_header_row());
my $shown=0;
foreach my $id (sort { $docslog{$b}{'exe_time'}<=>$docslog{$a}{'exe_time'} } (keys(%docslog))) {
if ($env{'form.displayfilter'} eq 'currentfolder') {
if ($docslog{$id}{'logentry'}{'currentfolder'} ne $folder) { next; }
}
my @changes=keys(%{$docslog{$id}{'logentry'}});
if ($env{'form.displayfilter'} eq 'containing') {
my $wholeentry=$docslog{$id}{'exe_uname'}.':'.$docslog{$id}{'exe_udom'}.':'.
&Apache::loncommon::plainname($docslog{$id}{'exe_uname'},$docslog{$id}{'exe_udom'});
foreach my $key (@changes) {
$wholeentry.=':'.$docslog{$id}{'logentry'}{$key};
}
if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
}
my $count = 0;
my $time =
&Apache::lonlocal::locallocaltime($docslog{$id}{'exe_time'});
my $plainname =
&Apache::loncommon::plainname($docslog{$id}{'exe_uname'},
$docslog{$id}{'exe_udom'});
my $about_me_link =
&Apache::loncommon::aboutmewrapper($plainname,
$docslog{$id}{'exe_uname'},
$docslog{$id}{'exe_udom'});
my $send_msg_link='';
if ((($docslog{$id}{'exe_uname'} ne $env{'user.name'})
|| ($docslog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
$send_msg_link =' '.
&Apache::loncommon::messagewrapper(&mt('Send message'),
$docslog{$id}{'exe_uname'},
$docslog{$id}{'exe_udom'});
}
$r->print(&Apache::loncommon::start_data_table_row());
$r->print('
');
my $is_supp = 0;
if ($docslog{$id}{'logentry'}{'currentfolder'} =~ /^supplemental/) {
$is_supp = 1;
}
# Before
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
my $oldname=(split(/\:/,$docslog{$id}{'logentry'}{'before_resources_'.$idx}))[0];
my $newname=(split(/\:/,$docslog{$id}{'logentry'}{'after_resources_'.$idx}))[0];
if ($oldname ne $newname) {
my $shown = &LONCAPA::map::qtescape($oldname);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title($shown);
}
$r->print($shown);
}
}
$r->print('
');
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
if ($docslog{$id}{'logentry'}{'before_order_res_'.$idx}) {
my $shown = &LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'before_order_res_'.$idx}))[0]);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title($shown);
}
$r->print('
'.$shown.'
');
}
}
$r->print('
');
# After
$r->print('
');
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
my $oldname=(split(/\:/,$docslog{$id}{'logentry'}{'before_resources_'.$idx}))[0];
my $newname=(split(/\:/,$docslog{$id}{'logentry'}{'after_resources_'.$idx}))[0];
if ($oldname ne '' && $oldname ne $newname) {
my $shown = &LONCAPA::map::qtescape($newname);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title(&LONCAPA::map::qtescape($newname));
}
$r->print($shown);
}
}
$r->print('
');
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
if ($docslog{$id}{'logentry'}{'after_order_res_'.$idx}) {
my $shown = &LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'after_order_res_'.$idx}))[0]);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title($shown);
}
$r->print('
'.$shown.'
');
}
}
$r->print('
');
if ($docslog{$id}{'logentry'}{'parameter_res'}) {
$r->print(&LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'parameter_res'}))[0]).':
');
foreach my $parameter ('randompick','hiddenresource','encrypturl','randomorder') {
if ($docslog{$id}{'logentry'}{'parameter_action_'.$parameter}) {
# FIXME: internationalization seems wrong here
$r->print('
'."\n".
&mt('The following files are either dependencies of a web page or references within a folder and/or composite page which could not be copied during the paste operation:')."\n".
'
'."\n");
foreach my $key (sort(keys(%paste_errors))) {
$r->print('
'.$key.'
'."\n");
}
$r->print('
'."\n");
}
}
$r->print($upload_output);
if (&handle_edit_cmd()) {
my $contentchg;
if ($env{'form.cmd'} =~ /^(del|cut)_/) {
$contentchg = 1;
}
($errtext,$fatal)=&storemap($coursenum,$coursedom,$folder.'.'.$container,$contentchg);
return $errtext if ($fatal);
}
# Group import/search
if ($env{'form.importdetail'}) {
my @imports;
foreach my $item (split(/\&/,$env{'form.importdetail'})) {
if (defined($item)) {
my ($name,$url,$residx)=
map {&unescape($_)} split(/\=/,$item);
if ($url=~ m{^\Q/uploaded/$coursedom/$coursenum/\E(default|supplemental)_new\.(sequence|page)$}) {
my ($suffix,$errortxt,$locknotfreed) =
&newmap_suffix($1,$2,$coursedom,$coursenum);
if ($locknotfreed) {
$r->print($locknotfreed);
}
if ($suffix) {
$url =~ s/_new\./_$suffix./;
} else {
return $errortxt;
}
}
push(@imports, [$name, $url, $residx]);
}
}
($errtext,$fatal)=&group_import($coursenum, $coursedom, $folder,
$container,'londocs',@imports);
return $errtext if ($fatal);
}
# Loading a complete map
if ($env{'form.loadmap'}) {
if ($env{'form.importmap'}=~/\w/) {
foreach my $res (&Apache::lonsequence::attemptread(&Apache::lonnet::filelocation('',$env{'form.importmap'}))) {
my ($title,$url,$ext,$type)=split(/\:/,$res);
my $idx=&LONCAPA::map::getresidx($url);
$LONCAPA::map::resources[$idx]=$res;
$LONCAPA::map::order[$#LONCAPA::map::order+1]=$idx;
}
($errtext,$fatal)=&storemap($coursenum,$coursedom,
$folder.'.'.$container,1);
return $errtext if ($fatal);
} else {
$r->print('
'.&mt('No map selected.').'
');
}
}
&log_differences($plain);
}
# ---------------------------------------------------------------- End commands
# ---------------------------------------------------------------- Print screen
my $idx=0;
my $shown=0;
if (($ishidden) || ($isencrypted) || ($randompick>=0) || ($is_random_order)) {
$r->print('
'
.&mt('Caution: this folder is set to randomly pick a subset'
.' of resources. Adding or removing resources from this'
.' folder will change the set of resources that the'
.' students see, resulting in spurious or missing credit'
.' for completed problems, not limited to ones you'
.' modify. Do not modify the contents of this folder if'
.' it is in active student use.')
.'
'
);
}
if ($is_random_order) {
$r->print('
'
.&mt('Caution: this folder is set to randomly order its'
.' contents. Adding or removing resources from this folder'
.' will change the order of resources shown.')
.'
'
);
}
$r->print('
');
}
my ($to_show,$output);
&Apache::loncommon::start_data_table_count(); #setup a row counter
foreach my $res (@LONCAPA::map::order) {
my ($name,$url)=split(/\:/,$LONCAPA::map::resources[$res]);
$name=&LONCAPA::map::qtescape($name);
$url=&LONCAPA::map::qtescape($url);
unless ($name) { $name=(split(/\//,$url))[-1]; }
unless ($name) { $idx++; next; }
$output .= &entryline($idx,$name,$url,$folder,$allowed,$res,
$coursenum,$coursedom,$crstype,
$pathitem,$supplementalflag,$container);
$idx++;
$shown++;
}
&Apache::loncommon::end_data_table_count();
if (($allowed) || ($supplementalflag && $folder eq 'supplemental')) {
my $toolslink = '
'
}
}
my $tid = 1;
if ($supplementalflag) {
$tid = 2;
}
if ($allowed) {
my $readfile="/uploaded/$coursedom/$coursenum/$folder.$container";
$r->print(&generate_edit_table($tid,$orderhash,$to_show,$iconpath,$jumpto,
$readfile));
&print_paste_buffer($r,$container,$folder,$coursedom,$coursenum);
} else {
$r->print($to_show);
}
return;
}
sub process_file_upload {
my ($upload_output,$coursenum,$coursedom,$allfiles,$codebase,$uploadcmd) = @_;
# upload a file, if present
my ($parseaction,$showupload,$nextphase,$mimetype);
if ($env{'form.parserflag'}) {
$parseaction = 'parse';
}
my $folder=$env{'form.folder'};
if ($folder eq '') {
$folder='default';
}
if ( ($folder=~/^$uploadcmd/) || ($uploadcmd eq 'default') ) {
my $errtext='';
my $fatal=0;
my $container='sequence';
if ($env{'form.folderpath'} =~ /:1$/) {
$container='page';
}
($errtext,$fatal)=
&mapread($coursenum,$coursedom,$folder.'.'.$container);
if ($#LONCAPA::map::order<1) {
$LONCAPA::map::order[0]=1;
$LONCAPA::map::resources[1]='';
}
if ($fatal) {
$$upload_output = '
'.&mt('The uploaded file has not been stored as an error occurred reading the contents of the current folder.').'
';
return;
}
my $destination = 'docs/';
if ($folder =~ /^supplemental/) {
$destination = 'supplemental/';
}
if (($folder eq 'default') || ($folder eq 'supplemental')) {
$destination .= 'default/';
} elsif ($folder =~ /^(default|supplemental)_(\d+)$/) {
$destination .= $2.'/';
}
# this is for a course, not a user, so set context to coursedoc.
my $newidx=&LONCAPA::map::getresidx();
$destination .= $newidx;
my $url=&Apache::lonnet::userfileupload('uploaddoc','coursedoc',$destination,
$parseaction,$allfiles,
$codebase,undef,undef,undef,undef,
undef,undef,\$mimetype);
if ($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E.*/([^/]+)$}) {
my $stored = $1;
$showupload = '
";
$rand_pick_text = ' ' if ($rand_pick_text eq '');
$rand_order_text = ' ' if ($rand_order_text eq '');
if (($allowed) && ($folder!~/^supplemental/)) {
my %lt=&Apache::lonlocal::texthash(
'hd' => 'Hidden',
'ec' => 'URL hidden');
my $enctext=
((&LONCAPA::map::getparameter($orderidx,'parameter_encrypturl'))[0]=~/^yes$/i?' checked="checked"':'');
my $hidtext=
((&LONCAPA::map::getparameter($orderidx,'parameter_hiddenresource'))[0]=~/^yes$/i?' checked="checked"':'');
$line.=(<
$form_start
$form_common
$form_end
$form_start
$form_common
$form_end
$rand_pick_text
$rand_order_text
ENDPARMS
}
$line.=&Apache::loncommon::end_data_table_row();
return $line;
}
sub newmap_suffix {
my ($area,$container,$coursedom,$coursenum) = @_;
my ($prefix,$idtype,$errtext,$locknotfreed);
$prefix = 'docs';
if ($area eq 'supplemental') {
$prefix = 'supp';
}
$prefix .= $container;
$idtype = 'concat';
my ($suffix,$freedlock,$error) =
&Apache::lonnet::get_timebased_id($prefix,'num','uploadedmaps',
$coursedom,$coursenum);
if (!$suffix) {
$errtext = &mt('Failed to acquire a unique timestamp-based suffix for the new folder/page.');
if ($error) {
$errtext .= ' '.$error;
}
}
if ($freedlock ne 'ok') {
$locknotfreed = '
'.&mt('There was a problem removing a lockfile. This will prevent creation of additional folders or composite pages in this course. Please contact the domain coordinator for your LON-CAPA domain.').'
';
}
return ($suffix,$errtext,$locknotfreed);
}
=pod
=item tiehash()
tie the hash
=cut
sub tiehash {
my ($mode)=@_;
$hashtied=0;
if ($env{'request.course.fn'}) {
if ($mode eq 'write') {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.".db",
&GDBM_WRCREAT(),0640)) {
$hashtied=2;
}
} else {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.".db",
&GDBM_READER(),0640)) {
$hashtied=1;
}
}
}
}
sub untiehash {
if ($hashtied) { untie %hash; }
$hashtied=0;
return OK;
}
sub checkonthis {
my ($r,$url,$level,$title)=@_;
$url=&unescape($url);
$alreadyseen{$url}=1;
$r->rflush();
if (($url) && ($url!~/^\/uploaded\//) && ($url!~/\*$/)) {
$r->print("\n ");
if ($level==0) {
$r->print(" ");
}
for (my $i=0;$i<=$level*5;$i++) {
$r->print(' ');
}
$r->print(''.
($title?$title:$url).' ');
if ($url=~/^\/res\//) {
my $result=&Apache::lonnet::repcopy(
&Apache::lonnet::filelocation('',$url));
if ($result eq 'ok') {
$r->print(''.&mt('ok').'');
$r->rflush();
&Apache::lonnet::countacc($url);
$url=~/\.(\w+)$/;
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
$r->print(' ');
$r->rflush();
for (my $i=0;$i<=$level*5;$i++) {
$r->print(' ');
}
$r->print('- '.&mt('Rendering:').' ');
my ($errorcount,$warningcount)=split(/:/,
&Apache::lonnet::ssi_body($url,
('grade_target'=>'web',
'return_only_error_and_warning_counts' => 1)));
if (($errorcount) ||
($warningcount)) {
if ($errorcount) {
$r->print(''.
&mt('[quant,_1,error]',$errorcount).'');
}
if ($warningcount) {
$r->print(''.
&mt('[quant,_1,warning]',$warningcount).'');
}
} else {
$r->print(''.&mt('ok').'');
}
$r->rflush();
}
my $dependencies=
&Apache::lonnet::metadata($url,'dependencies');
foreach my $dep (split(/\,/,$dependencies)) {
if (($dep=~/^\/res\//) && (!$alreadyseen{$dep})) {
&checkonthis($r,$dep,$level+1);
}
}
} elsif ($result eq 'unavailable') {
$r->print(''.&mt('connection down').'');
} elsif ($result eq 'not_found') {
unless ($url=~/\$/) {
$r->print(''.&mt('not found').'');
} else {
$r->print(''.&mt('unable to verify variable URL').'');
}
} else {
$r->print(''.&mt('access denied').'');
}
}
}
}
=pod
=item list_symbs()
List Content Identifiers
=cut
sub list_symbs {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
$r->print(&Apache::loncommon::start_page('List of Content Identifiers'));
$r->print(&Apache::lonhtmlcommon::breadcrumbs('Content Identifiers'));
$r->print(&startContentScreen('tools'));
my $navmap = Apache::lonnavmaps::navmap->new();
if (!defined($navmap)) {
$r->print('
'.&mt('Retrieval of List Failed').'
'.
'
'.
&mt('Unable to retrieve information about course contents').
'
');
&Apache::lonnet::logthis('Symb list failed - could not create navmap object in '.lc($crstype).':'.$env{'request.course.id'});
} else {
$r->print('
'.
&Apache::loncommon::end_data_table_header_row()."\n");
my $count;
foreach my $res ($navmap->retrieveResources()) {
$r->print(&Apache::loncommon::start_data_table_row().
'
'.$res->compTitle().'
'.
'
'.$res->symb().'
'.
&Apache::loncommon::end_data_table_row());
$count ++;
}
if (!$count) {
$r->print(&Apache::loncommon::start_data_table_row().
'
'.&mt("$crstype is empty").'
'.
&Apache::loncommon::end_data_table_row());
}
$r->print(&Apache::loncommon::end_data_table());
}
$r->print(&endContentScreen());
}
sub verifycontent {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
$r->print(&Apache::loncommon::start_page('Verify '.$crstype.' Documents'));
$r->print(&Apache::lonhtmlcommon::breadcrumbs('Verify '.$crstype.' Documents'));
$r->print(&startContentScreen('tools'));
$r->print('
'.&mt($crstype.' content verification').'
');
$hashtied=0;
undef %alreadyseen;
%alreadyseen=();
&tiehash();
foreach my $key (keys(%hash)) {
if ($hash{$key}=~/\.(page|sequence)$/) {
if (($key=~/^src_/) && ($alreadyseen{&unescape($hash{$key})})) {
$r->print(''.
&mt('The following sequence or page is included more than once in your '.$crstype.':').' '.
&unescape($hash{$key}).' '.
&mt('Note that grading records for problems included in this sequence or folder will overlap.').'');
}
}
if (($key=~/^src\_(.+)$/) && (!$alreadyseen{&unescape($hash{$key})})) {
&checkonthis($r,$hash{$key},0,$hash{'title_'.$1});
}
}
&untiehash();
$r->print('
'.&mt('Done').'
');
$r->print(&endContentScreen());
}
sub devalidateversioncache {
my $src=shift;
&Apache::lonnet::devalidate_cache_new('courseresversion',$env{'request.course.id'}.'_'.
&Apache::lonnet::clutter($src));
}
sub checkversions {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
$r->print(&Apache::loncommon::start_page("Check $crstype Document Versions"));
$r->print(&Apache::lonhtmlcommon::breadcrumbs("Check $crstype Document Versions"));
$r->print(&startContentScreen('tools'));
my $header='';
my $startsel='';
my $monthsel='';
my $weeksel='';
my $daysel='';
my $allsel='';
my %changes=();
my $starttime=0;
my $haschanged=0;
my %setversions=&Apache::lonnet::dump('resourceversions',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
$hashtied=0;
&tiehash();
my %newsetversions=();
if ($env{'form.setmostrecent'}) {
$haschanged=1;
foreach my $key (keys(%hash)) {
if ($key=~/^ids\_(\/res\/.+)$/) {
$newsetversions{$1}='mostrecent';
&devalidateversioncache($1);
}
}
} elsif ($env{'form.setcurrent'}) {
$haschanged=1;
foreach my $key (keys(%hash)) {
if ($key=~/^ids\_(\/res\/.+)$/) {
my $getvers=&Apache::lonnet::getversion($1);
if ($getvers>0) {
$newsetversions{$1}=$getvers;
&devalidateversioncache($1);
}
}
}
} elsif ($env{'form.setversions'}) {
$haschanged=1;
foreach my $key (keys(%env)) {
if ($key=~/^form\.set_version_(.+)$/) {
my $src=$1;
if (($env{$key}) && ($env{$key} ne $setversions{$src})) {
$newsetversions{$src}=$env{$key};
&devalidateversioncache($src);
}
}
}
}
if ($haschanged) {
if (&Apache::lonnet::put('resourceversions',\%newsetversions,
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'}) eq 'ok') {
$r->print(&Apache::loncommon::confirmwrapper(
&Apache::lonhtmlcommon::confirm_success(&mt('Your Version Settings have been Saved'))));
} else {
$r->print(&Apache::loncommon::confirmwrapper(
&Apache::lonhtmlcommon::confirm_success(&mt('An Error Occured while Attempting to Save your Version Settings'),1)));
}
&mark_hash_old();
}
&changewarning($r,'');
if ($env{'form.timerange'} eq 'all') {
# show all documents
$header=&mt('All Documents in '.$crstype);
$allsel=' selected="selected"';
foreach my $key (keys(%hash)) {
if ($key=~/^ids\_(\/res\/.+)$/) {
my $src=$1;
$changes{$src}=1;
}
}
} else {
# show documents which changed
%changes=&Apache::lonnet::dump
('versionupdate',$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
my $firstkey=(keys(%changes))[0];
unless ($firstkey=~/^error\:/) {
unless ($env{'form.timerange'}) {
$env{'form.timerange'}=604800;
}
my $seltext=&mt('during the last').' '.$env{'form.timerange'}.' '
.&mt('seconds');
if ($env{'form.timerange'}==-1) {
$seltext='since start of course';
$startsel=' selected="selected"';
$env{'form.timerange'}=time;
}
$starttime=time-$env{'form.timerange'};
if ($env{'form.timerange'}==2592000) {
$seltext=&mt('during the last month').' ('.&Apache::lonlocal::locallocaltime($starttime).')';
$monthsel=' selected="selected"';
} elsif ($env{'form.timerange'}==604800) {
$seltext=&mt('during the last week').' ('.&Apache::lonlocal::locallocaltime($starttime).')';
$weeksel=' selected="selected"';
} elsif ($env{'form.timerange'}==86400) {
$seltext=&mt('since yesterday').' ('.&Apache::lonlocal::locallocaltime($starttime).')';
$daysel=' selected="selected"';
}
$header=&mt('Content changed').' '.$seltext;
} else {
$header=&mt('No content modifications yet.');
}
}
%setversions=&Apache::lonnet::dump('resourceversions',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
my %lt=&Apache::lonlocal::texthash
('st' => 'Version changes since start of '.$crstype,
'lm' => 'Version changes since last Month',
'lw' => 'Version changes since last Week',
'sy' => 'Version changes since Yesterday',
'al' => 'All Resources (possibly large output)',
'cd' => 'Change display',
'sd' => 'Display',
'fi' => 'File',
'md' => 'Modification Date',
'mr' => 'Most recently published Version',
've' => 'Version used in '.$crstype,
'vu' => 'Set Version to be used in '.$crstype,
'sv' => 'Set Versions to be used in '.$crstype.' according to Selections below',
'sm' => 'Keep all Resources up-to-date with most recent Versions (default)',
'sc' => 'Set all Resource Versions to current Version (Fix Versions)',
'di' => 'Differences',
'save' => 'Save changes',
'vers' => 'Version choice(s) for specific resources',
'act' => 'Actions');
$r->print(<$header
'
);
&untiehash();
$r->print(&endContentScreen());
}
sub mark_hash_old {
my $retie_hash=0;
if ($hashtied) {
$retie_hash=1;
&untiehash();
}
&tiehash('write');
$hash{'old'}=1;
&untiehash();
if ($retie_hash) { &tiehash(); }
}
sub is_hash_old {
my $untie_hash=0;
if (!$hashtied) {
$untie_hash=1;
&tiehash();
}
my $return=$hash{'old'};
if ($untie_hash) { &untiehash(); }
return $return;
}
sub changewarning {
my ($r,$postexec,$message,$url)=@_;
if (!&is_hash_old()) { return; }
my $pathvar='folderpath';
my $path=&escape($env{'form.folderpath'});
if (!defined($url)) {
$url='/adm/coursedocs?'.$pathvar.'='.$path;
}
my $course_type = &Apache::loncommon::course_type();
if (!defined($message)) {
$message='Changes will become active for your current session after [_1], or the next time you log in.';
}
$r->print("\n\n".
''."\n".
''."\n\n");
}
sub init_breadcrumbs {
my ($form,$text)=@_;
&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/coursedocs?tools=1",
text=>&Apache::loncommon::course_type().' Editor',
faq=>273,
bug=>'Instructor Interface',
help => 'Docs_Adding_Course_Doc'});
&Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/coursedocs?".$form.'=1',
text=>$text,
faq=>273,
bug=>'Instructor Interface'});
}
# subroutine to list form elements
sub create_list_elements {
my @formarr = @_;
my $list = '';
foreach my $button (@formarr){
foreach my $picture (keys(%{$button})) {
$list .= &Apache::lonhtmlcommon::htmltag('li', $picture.' '.$button->{$picture}, {class => 'LC_menubuttons_inline_text', id => ''});
}
}
return $list;
}
# subroutine to create ul from list elements
sub create_form_ul {
my $list = shift;
my $ul = &Apache::lonhtmlcommon::htmltag('ul',$list, {class => 'LC_ListStyleNormal'});
return $ul;
}
#
# Start tabs
#
sub startContentScreen {
my ($mode) = @_;
my $output = '
'.
&mt('It is recommended that you use an up-to-date virus scanner before handling this file.')."
".
&entryline(0,&mt("Click to download or use your browser's Save Link function"),$showdoc).'
');
}
}
$r->print(&Apache::loncommon::end_page());
return OK;
}
sub embedded_form_elems {
my ($phase,$primaryurl,$newidx) = @_;
my $folderpath = &HTML::Entities::encode($env{'form.folderpath'},'<>&"');
return <
STATE
}
sub embedded_destination {
my $folder=$env{'form.folder'};
my $destination = 'docs/';
if ($folder =~ /^supplemental/) {
$destination = 'supplemental/';
}
if (($folder eq 'default') || ($folder eq 'supplemental')) {
$destination .= 'default/';
} elsif ($folder =~ /^(default|supplemental)_(\d+)$/) {
$destination .= $2.'/';
}
$destination .= $env{'form.newidx'};
my $dir_root = '/userfiles';
return ($destination,$dir_root);
}
sub return_to_editor {
my $actionurl = '/adm/coursedocs';
return ''."\n".
''."\n".
''.&mt('Return to Editor').
'';
}
sub decompression_info {
my ($destination,$dir_root) = &embedded_destination();
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $container='sequence';
my ($pathitem,$hiddenelem);
my @hiddens = ('newidx','comment','position','folderpath');
if ($env{'form.folderpath'} =~ /\:1$/) {
$container='page';
}
unshift(@hiddens,$pathitem);
foreach my $item (@hiddens) {
if ($env{'form.'.$item}) {
$hiddenelem .= ''."\n";
}
}
return ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,
$hiddenelem);
}
sub decompression_phase_one {
my ($dir,$file,$warning,$error,$output);
my ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,$hiddenelem)=
&decompression_info();
if ($env{'form.archiveurl'} !~ m{^/uploaded/\Q$docudom/$docuname/\E(?:docs|supplemental)/(?:default|\d+).*/([^/]+)$}) {
$error = &mt('Archive file "[_1]" not in the expected location.',$env{'form.archiveurl'});
} else {
my $file = $1;
$output =
&Apache::loncommon::process_decompression($docudom,$docuname,$file,
$destination,$dir_root,
$hiddenelem);
if ($env{'form.autoextract_camtasia'}) {
$output .= &remove_archive($docudom,$docuname,$container);
}
}
if ($error) {
$output .= '
'.&mt('Not extracted.').' '.
$error.'
'."\n";
}
if ($warning) {
$output .= '
'.$warning.'
'."\n";
}
return $output;
}
sub decompression_phase_two {
my ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,$hiddenelem)=
&decompression_info();
my $output;
if ($env{'form.archivedelete'}) {
$output = &remove_archive($docudom,$docuname,$container);
}
$output .=
&Apache::loncommon::process_extracted_files('coursedocs',$docudom,$docuname,
$destination,$dir_root,$hiddenelem);
return $output;
}
sub remove_archive {
my ($docudom,$docuname,$container) = @_;
my $map = $env{'form.folder'}.'.'.$container;
my ($output,$delwarning,$delresult,$url);
my ($errtext,$fatal) = &mapread($docuname,$docudom,$map);
if ($fatal) {
if ($container eq 'page') {
$delwarning = &mt('An error occurred retrieving the contents of the current page.');
} else {
$delwarning = &mt('An error occurred retrieving the contents of the current folder.');
}
$delwarning .= &mt('As a result the archive file has not been removed.');
} else {
my $currcmd = $env{'form.cmd'};
my $position = $env{'form.position'};
if ($position > 0) {
$env{'form.cmd'} = 'del_'.$position;
my ($title,$url,@rrest) =
split(/:/,$LONCAPA::map::resources[$LONCAPA::map::order[$position]]);
if (&handle_edit_cmd($docuname,$docudom)) {
($errtext,$fatal) = &storemap($docuname,$docudom,$map,1);
if ($fatal) {
if ($container eq 'page') {
$delwarning = &mt('An error occurred updating the contents of the current page.');
} else {
$delwarning = &mt('An error occurred updating the contents of the current folder.');
}
} else {
$delresult = &mt('Archive file removed.');
}
}
}
$env{'form.cmd'} = $currcmd;
}
if ($delwarning) {
$output = '
'.
$delwarning.
'
';
}
if ($delresult) {
$output .= '
'.
$delresult.
'
';
}
return $output;
}
sub generate_admin_menu {
my ($crstype) = @_;
my $lc_crstype = lc($crstype);
my ($home,$other,%outhash)=&authorhosts();
my %lt=&Apache::lonlocal::texthash (
'vc' => 'Verify Content',
'cv' => 'Check/Set Resource Versions',
'ls' => 'List Resource Identifiers',
'imse' => 'Export contents to IMS Archive',
'dcd' => "Dump $crstype Content to Authoring Space",
);
my ($candump,$dumpurl);
if ($home + $other > 0) {
$candump = 'F';
if ($home) {
$dumpurl = "javascript:injectData(document.courseverify,'dummy','dumpcourse','$lt{'dcd'}')";
} else {
my @hosts;
foreach my $aurole (keys(%outhash)) {
unless(grep(/^\Q$outhash{$aurole}\E/,@hosts)) {
push(@hosts,$outhash{$aurole});
}
}
if (@hosts == 1) {
my $switchto = '/adm/switchserver?otherserver='.$hosts[0].
'&role='.
&HTML::Entities::encode($env{'request.role'},'"<>&').'&origurl='.
&HTML::Entities::encode('/adm/coursedocs?dumpcourse=1','"<>&');
$dumpurl = "javascript:dump_needs_switchserver('$switchto')";
} else {
$dumpurl = "javascript:choose_switchserver_window()";
}
}
}
my @menu=
({ categorytitle=>'Administration',
items =>[
{ linktext => $lt{'vc'},
url => "javascript:injectData(document.courseverify,'dummy','verify','$lt{'vc'}')",
permission => 'F',
help => 'Verify_Content',
icon => 'verify.png',
linktitle => 'Verify contents can be retrieved/rendered',
},
{ linktext => $lt{'cv'},
url => "javascript:injectData(document.courseverify,'dummy','versions','$lt{'cv'}')",
permission => 'F',
help => 'Check_Resource_Versions',
icon => 'resversion.png',
linktitle => "View version information for resources in your $lc_crstype, and fix/unfix use of specific versions",
},
{ linktext => $lt{'ls'},
url => "javascript:injectData(document.courseverify,'dummy','listsymbs','$lt{'ls'}')",
permission => 'F',
#help => '',
icon => 'symbs.png',
linktitle => "List the unique identifier used for each resource instance in your $lc_crstype"
},
]
},
{ categorytitle=>'Export',
items =>[
{ linktext => $lt{'imse'},
url => "javascript:injectData(document.courseverify,'dummy','exportcourse','$lt{'imse'}')",
permission => 'F',
help => 'Docs_Export_Course_Docs',
icon => 'imsexport.png',
linktitle => $lt{'imse'},
},
{ linktext => $lt{'dcd'},
url => $dumpurl,
permission => $candump,
#help => '',
icon => 'dump.png',
linktitle => $lt{'dcd'},
},
]
});
return '';
}
sub generate_edit_table {
my ($tid,$orderhash_ref,$to_show,$iconpath,$jumpto,$readfile) = @_;
return unless(ref($orderhash_ref) eq 'HASH');
my %orderhash = %{$orderhash_ref};
my $form;
my $activetab;
my $active;
if($env{'form.active'} ne ''){
$activetab = $env{'form.active'};
}
my $backicon = $iconpath.'clickhere.gif';
my $backtext = &mt('Exit');
$form = '