--- loncom/interface/loncommon.pm 2012/03/24 23:35:25 1.1061
+++ loncom/interface/loncommon.pm 2012/04/11 15:53:22 1.1070
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1061 2012/03/24 23:35:25 raeburn Exp $
+# $Id: loncommon.pm,v 1.1070 2012/04/11 15:53:22 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3129,12 +3129,12 @@ sub noteswrapper {
# ------------------------------------------------------------- Aboutme Wrapper
sub aboutmewrapper {
- my ($link,$username,$domain,$target)=@_;
+ my ($link,$username,$domain,$target,$class)=@_;
if (!defined($username) && !defined($domain)) {
return;
}
return ''.$link.' ';
+ ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'';
}
# ------------------------------------------------------------ Syllabus Wrapper
@@ -4076,7 +4076,7 @@ sub findallcourses {
###############################################
sub blockcheck {
- my ($setters,$activity,$uname,$udom) = @_;
+ my ($setters,$activity,$uname,$udom,$url) = @_;
if (!defined($udom)) {
$udom = $env{'user.domain'};
@@ -4088,13 +4088,14 @@ sub blockcheck {
# If uname and udom are for a course, check for blocks in the course.
if (&Apache::lonnet::is_course($udom,$uname)) {
- my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
- my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
- return ($startblock,$endblock);
+ my ($startblock,$endblock,$triggerblock) =
+ &get_blocks($setters,$activity,$udom,$uname,$url);
+ return ($startblock,$endblock,$triggerblock);
}
my $startblock = 0;
my $endblock = 0;
+ my $triggerblock = '';
my %live_courses = &findallcourses(undef,$uname,$udom);
# If uname is for a user, and activity is course-specific, i.e.,
@@ -4209,46 +4210,139 @@ sub blockcheck {
# Retrieve blocking times and identity of locker for course
# of specified user, unless user has 'evb' privilege.
- my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
+ my ($start,$end,$trigger) =
+ &get_blocks($setters,$activity,$cdom,$cnum,$url);
if (($start != 0) &&
(($startblock == 0) || ($startblock > $start))) {
$startblock = $start;
+ if ($trigger ne '') {
+ $triggerblock = $trigger;
+ }
}
if (($end != 0) &&
(($endblock == 0) || ($endblock < $end))) {
$endblock = $end;
+ if ($trigger ne '') {
+ $triggerblock = $trigger;
+ }
}
}
- return ($startblock,$endblock);
+ return ($startblock,$endblock,$triggerblock);
}
sub get_blocks {
- my ($setters,$activity,$cdom,$cnum) = @_;
+ my ($setters,$activity,$cdom,$cnum,$url) = @_;
my $startblock = 0;
my $endblock = 0;
+ my $triggerblock = '';
my $course = $cdom.'_'.$cnum;
$setters->{$course} = {};
$setters->{$course}{'staff'} = [];
$setters->{$course}{'times'} = [];
- my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
- foreach my $record (keys(%records)) {
- my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
- if ($start <= time && $end >= time) {
- my ($staff_name,$staff_dom,$title,$blocks) =
- &parse_block_record($records{$record});
- if ($blocks->{$activity} eq 'on') {
- push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
- push(@{$$setters{$course}{'times'}}, [$start,$end]);
- if ( ($startblock == 0) || ($startblock > $start) ) {
- $startblock = $start;
+ $setters->{$course}{'triggers'} = [];
+ my (@blockers,%triggered);
+ my $now = time;
+ my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
+ if ($activity eq 'docs') {
+ @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
+ foreach my $block (@blockers) {
+ if ($block =~ /^firstaccess____(.+)$/) {
+ my $item = $1;
+ my $type = 'map';
+ my $timersymb = $item;
+ if ($item eq 'course') {
+ $type = 'course';
+ } elsif ($item =~ /___\d+___/) {
+ $type = 'resource';
+ } else {
+ $timersymb = &Apache::lonnet::symbread($item);
+ }
+ my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
+ my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
+ $triggered{$block} = {
+ start => $start,
+ end => $end,
+ type => $type,
+ };
+ }
+ }
+ } else {
+ foreach my $block (keys(%commblocks)) {
+ if ($block =~ m/^(\d+)____(\d+)$/) {
+ my ($start,$end) = ($1,$2);
+ if ($start <= time && $end >= time) {
+ if (ref($commblocks{$block}) eq 'HASH') {
+ if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
+ if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
+ unless(grep(/^\Q$block\E$/,@blockers)) {
+ push(@blockers,$block);
+ }
+ }
+ }
+ }
}
- if ( ($endblock == 0) || ($endblock < $end) ) {
- $endblock = $end;
+ } elsif ($block =~ /^firstaccess____(.+)$/) {
+ my $item = $1;
+ my $timersymb = $item;
+ my $type = 'map';
+ if ($item eq 'course') {
+ $type = 'course';
+ } elsif ($item =~ /___\d+___/) {
+ $type = 'resource';
+ } else {
+ $timersymb = &Apache::lonnet::symbread($item);
}
+ my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
+ my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
+ if ($start && $end) {
+ if (($start <= time) && ($end >= time)) {
+ unless (grep(/^\Q$block\E$/,@blockers)) {
+ push(@blockers,$block);
+ $triggered{$block} = {
+ start => $start,
+ end => $end,
+ type => $type,
+ };
+ }
+ }
+ }
+ }
+ }
+ }
+ foreach my $blocker (@blockers) {
+ my ($staff_name,$staff_dom,$title,$blocks) =
+ &parse_block_record($commblocks{$blocker});
+ push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
+ my ($start,$end,$triggertype);
+ if ($blocker =~ m/^(\d+)____(\d+)$/) {
+ ($start,$end) = ($1,$2);
+ } elsif (ref($triggered{$blocker}) eq 'HASH') {
+ $start = $triggered{$blocker}{'start'};
+ $end = $triggered{$blocker}{'end'};
+ $triggertype = $triggered{$blocker}{'type'};
+ }
+ if ($start) {
+ push(@{$$setters{$course}{'times'}}, [$start,$end]);
+ if ($triggertype) {
+ push(@{$$setters{$course}{'triggers'}},$triggertype);
+ } else {
+ push(@{$$setters{$course}{'triggers'}},0);
+ }
+ if ( ($startblock == 0) || ($startblock > $start) ) {
+ $startblock = $start;
+ if ($triggertype) {
+ $triggerblock = $blocker;
+ }
+ }
+ if ( ($endblock == 0) || ($endblock < $end) ) {
+ $endblock = $end;
+ if ($triggertype) {
+ $triggerblock = $blocker;
+ }
}
}
}
- return ($startblock,$endblock);
+ return ($startblock,$endblock,$triggerblock);
}
sub parse_block_record {
@@ -4272,13 +4366,16 @@ sub parse_block_record {
}
sub blocking_status {
- my ($activity,$uname,$udom) = @_;
+ my ($activity,$uname,$udom,$url) = @_;
my %setters;
# check for active blocking
- my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
-
- my $blocked = $startblock && $endblock ? 1 : 0;
+ my ($startblock,$endblock,$triggerblock) =
+ &blockcheck(\%setters,$activity,$uname,$udom,$url);
+ my $blocked = 0;
+ if ($startblock && $endblock) {
+ $blocked = 1;
+ }
# caller just wants to know whether a block is active
if (!wantarray) { return $blocked; }
@@ -4286,8 +4383,12 @@ sub blocking_status {
# build a link to a popup window containing the details
my $querystring = "?activity=$activity";
# $uname and $udom decide whose portfolio the user is trying to look at
- $querystring .= "&udom=$udom" if $udom;
- $querystring .= "&uname=$uname" if $uname;
+ if ($activity eq 'port') {
+ $querystring .= "&udom=$udom" if $udom;
+ $querystring .= "&uname=$uname" if $uname;
+ } elsif ($activity eq 'docs') {
+ $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
+ }
my $output .= <<'END_MYBLOCK';
function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
@@ -4302,8 +4403,12 @@ END_MYBLOCK
$output = Apache::lonhtmlcommon::scripttag($output);
my $popupUrl = "/adm/blockingstatus/$querystring";
- my $text = mt('Communication Blocked');
-
+ my $text = &mt('Communication Blocked');
+ if ($activity eq 'docs') {
+ $text = &mt('Content Access Blocked');
+ } elsif ($activity eq 'printout') {
+ $text = &mt('Printing Blocked');
+ }
$output .= <<"END_BLOCK";
'.$title.'';
@@ -4909,7 +5015,7 @@ sub bodytag {
sub dc_courseid_toggle {
my ($dc_info) = @_;
return ' '.
- ''.
+ ' '.
''.$dc_info.'
';
}
@@ -6811,6 +6917,8 @@ sub headtag {
''.
&font_settings();
+ my $inhibitprint = &print_suppression();
+
if (!$args->{'frameset'}) {
$result .= &Apache::lonhtmlcommon::htmlareaheaders();
}
@@ -6856,6 +6964,7 @@ ADDMETA
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
$result .= ' LON-CAPA '.$title.' '
.' '
+ .$inhibitprint
.$head_extra;
return $result.'';
}
@@ -6881,6 +6990,82 @@ sub font_settings {
=pod
+=item * &print_suppression()
+
+In course context returns css which causes the body to be blank when media="print",
+if printout generation is unavailable for the current resource.
+
+This could be because:
+
+(a) printstartdate is in the future
+
+(b) printenddate is in the past
+
+(c) there is an active exam block with "printout"
+functionality blocked
+
+Users with pav, pfo or evb privileges are exempt.
+
+Inputs: none
+
+=cut
+
+
+sub print_suppression {
+ my $noprint;
+ if ($env{'request.course.id'}) {
+ my $scope = $env{'request.course.id'};
+ if ((&Apache::lonnet::allowed('pav',$scope)) ||
+ (&Apache::lonnet::allowed('pfo',$scope))) {
+ return;
+ }
+ if ($env{'request.course.sec'} ne '') {
+ $scope .= "/$env{'request.course.sec'}";
+ if ((&Apache::lonnet::allowed('pav',$scope)) ||
+ (&Apache::lonnet::allowed('pfo',$scope))) {
+ return;
+ }
+ }
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $blocked = &blocking_status('printout',$cnum,$cdom);
+ if ($blocked) {
+ my $checkrole = "cm./$cdom/$cnum";
+ if ($env{'request.course.sec'} ne '') {
+ $checkrole .= "/$env{'request.course.sec'}";
+ }
+ unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+ ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
+ $noprint = 1;
+ }
+ }
+ unless ($noprint) {
+ my $symb = &Apache::lonnet::symbread();
+ if ($symb ne '') {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ my $res = $navmap->getBySymb($symb);
+ if (ref($res)) {
+ if (!$res->resprintable()) {
+ $noprint = 1;
+ }
+ }
+ }
+ }
+ }
+ if ($noprint) {
+ return <<"ENDSTYLE";
+
+ENDSTYLE
+ }
+ }
+ return;
+}
+
+=pod
+
=item * &xml_begin()
Returns the needed doctype and
@@ -9744,43 +9929,226 @@ sub is_archive_file {
}
sub decompress_form {
- my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements) = @_;
+ my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
my %lt = &Apache::lonlocal::texthash (
this => 'This file is an archive file.',
+ camt => 'This file is a Camtasia archive file.',
+ itsc => 'Its contents are as follows:',
youm => 'You may wish to extract its contents.',
- camt => 'Extraction of contents is recommended for Camtasia zip files.',
- perm => 'Permanently remove archive file after extraction of contents?',
extr => 'Extract contents',
+ auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
+ proa => 'Process automatically?',
yes => 'Yes',
no => 'No',
+ fold => 'Title for folder containing movie',
+ movi => 'Title for page containing embedded movie',
);
- my $output = ''.$lt{'this'}.' '.$lt{'youm'}.' ';
+ my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
+ my ($is_camtasia,$topdir,%toplevel,@paths);
+ my $info = &list_archive_contents($fileloc,\@paths);
+ if (@paths) {
+ foreach my $path (@paths) {
+ $path =~ s{^/}{};
+ if ($path =~ m{^([^/]+)/$}) {
+ $topdir = $1;
+ }
+ if ($path =~ m{^([^/]+)/}) {
+ $toplevel{$1} = $path;
+ } else {
+ $toplevel{$path} = $path;
+ }
+ }
+ }
if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
- $output .= $lt{'camt'};
+ my @camtasia = ("$topdir/","$topdir/index.html",
+ "$topdir/media/",
+ "$topdir/media/$topdir.mp4",
+ "$topdir/media/FirstFrame.png",
+ "$topdir/media/player.swf",
+ "$topdir/media/swfobject.js",
+ "$topdir/media/expressInstall.swf");
+ my @diffs = &compare_arrays(\@paths,\@camtasia);
+ if (@diffs == 0) {
+ $is_camtasia = 1;
+ }
}
- $output .= '
';
- $output .= <<"START";
-
END
return $output;
}
+sub decompression_utility {
+ my ($program) = @_;
+ my @utilities = ('tar','gunzip','bunzip2','unzip');
+ my $location;
+ if (grep(/^\Q$program\E$/,@utilities)) {
+ foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
+ '/usr/sbin/') {
+ if (-x $dir.$program) {
+ $location = $dir.$program;
+ last;
+ }
+ }
+ }
+ return $location;
+}
+
+sub list_archive_contents {
+ my ($file,$pathsref) = @_;
+ my (@cmd,$output);
+ my $needsregexp;
+ if ($file =~ /\.zip$/) {
+ @cmd = (&decompression_utility('unzip'),"-l");
+ $needsregexp = 1;
+ } elsif (($file =~ m/\.tar\.gz$/) ||
+ ($file =~ /\.tgz$/)) {
+ @cmd = (&decompression_utility('tar'),"-ztf");
+ } elsif ($file =~ /\.tar\.bz2$/) {
+ @cmd = (&decompression_utility('tar'),"-jtf");
+ } elsif ($file =~ m|\.tar$|) {
+ @cmd = (&decompression_utility('tar'),"-tf");
+ }
+ if (@cmd) {
+ undef($!);
+ undef($@);
+ if (open(my $fh,"-|", @cmd, $file)) {
+ while (my $line = <$fh>) {
+ $output .= $line;
+ chomp($line);
+ my $item;
+ if ($needsregexp) {
+ ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
+ } else {
+ $item = $line;
+ }
+ if ($item ne '') {
+ unless (grep(/^\Q$item\E$/,@{$pathsref})) {
+ push(@{$pathsref},$item);
+ }
+ }
+ }
+ close($fh);
+ }
+ }
+ return $output;
+}
+
sub decompress_uploaded_file {
my ($file,$dir) = @_;
&Apache::lonnet::appenv({'cgi.file' => $file});
@@ -9810,8 +10178,6 @@ sub process_decompression {
} else {
my @ids=&Apache::lonnet::current_machine_ids();
my $currdir = "$dir_root/$destination";
- my ($currdirlistref,$currlisterror) =
- &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
if (grep(/^\Q$docuhome\E$/,@ids)) {
$dir = &LONCAPA::propath($docudom,$docuname).
"$dir_root/$destination";
@@ -9822,47 +10188,61 @@ sub process_decompression {
$error = &mt('Archive file not found.');
}
}
- if ($dir eq '') {
+ my (@to_overwrite,@to_skip);
+ if ($env{'form.archive_overwrite_total'} > 0) {
+ my $total = $env{'form.archive_overwrite_total'};
+ for (my $i=0; $i<$total; $i++) {
+ if ($env{'form.archive_overwrite_'.$i} == 1) {
+ push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
+ } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
+ push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
+ }
+ }
+ }
+ my $numskip = scalar(@to_skip);
+ if (($numskip > 0) &&
+ ($numskip == $env{'form.archive_itemcount'})) {
+ $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
+ } elsif ($dir eq '') {
$error = &mt('Directory containing archive file unavailable.');
} elsif (!$error) {
- my ($decompressed,$display) = &decompress_uploaded_file($file,$dir);
+ my ($decompressed,$display);
+ if ($numskip > 0) {
+ my $tempdir = time.'_'.$$.int(rand(10000));
+ mkdir("$dir/$tempdir",0755);
+ system("mv $dir/$file $dir/$tempdir/$file");
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,"$dir/$tempdir");
+ foreach my $item (@to_skip) {
+ if (($item ne '') && ($item !~ /\.\./)) {
+ if (-f "$dir/$tempdir/$item") {
+ unlink("$dir/$tempdir/$item");
+ } elsif (-d "$dir/$tempdir/$item") {
+ system("rm -rf $dir/$tempdir/$item");
+ }
+ }
+ }
+ system("mv $dir/$tempdir/* $dir");
+ rmdir("$dir/$tempdir");
+ } else {
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,$dir);
+ }
if ($decompressed eq 'ok') {
- $output = &mt('Files extracted successfully from archive.').' ';
+ $output = ''.
+ &mt('Files extracted successfully from archive.').
+ '
'."\n";
my ($warning,$result,@contents);
my ($newdirlistref,$newlisterror) =
&Apache::lonnet::dirlist($currdir,$docudom,
$docuname,1);
my (%is_dir,%changes,@newitems);
my $dirptr = 16384;
- if (ref($currdirlistref) eq 'ARRAY') {
- my @curritems;
- foreach my $dir_line (@{$currdirlistref}) {
- my ($item,$rest)=split(/\&/,$dir_line,2);
- unless ($item =~ /\.+$/) {
- push(@curritems,$item);
- }
- }
- if (ref($newdirlistref) eq 'ARRAY') {
- foreach my $dir_line (@{$newdirlistref}) {
- my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,4);
- unless ($item =~ /^\.+$/) {
- if ($dirptr&$testdir) {
- $is_dir{$item} = 1;
- }
- push(@newitems,$item);
- }
- }
- my @diffs = &compare_arrays(\@curritems,\@newitems);
- if (@diffs > 0) {
- foreach my $item (@diffs) {
- $changes{$item} = 1;
- }
- }
- }
- } elsif (ref($newdirlistref) eq 'ARRAY') {
+ if (ref($newdirlistref) eq 'ARRAY') {
foreach my $dir_line (@{$newdirlistref}) {
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
- unless ($item =~ /\.+$/) {
+ unless (($item =~ /^\.+$/) || ($item eq $file) ||
+ ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
push(@newitems,$item);
if ($dirptr&$testdir) {
$is_dir{$item} = 1;
@@ -9879,8 +10259,11 @@ sub process_decompression {
}
}
if (@contents > 0) {
+ my $wantform;
+ unless ($env{'form.autoextract_camtasia'}) {
+ $wantform = 1;
+ }
my (%children,%parent,%dirorder,%titles);
- my $wantform = 1;
my ($count,$datatable) = &get_extracted($docudom,$docuname,
$currdir,\%is_dir,
\%children,\%parent,
@@ -9889,10 +10272,54 @@ sub process_decompression {
if ($datatable ne '') {
$output .= &archive_options_form('decompressed',$datatable,
$count,$hiddenelem);
- my $startcount = 4;
+ my $startcount = 6;
$output .= &archive_javascript($startcount,$count,
\%titles,\%children);
}
+ if ($env{'form.autoextract_camtasia'}) {
+ my %displayed;
+ my $total = 1;
+ $env{'form.archive_directory'} = [];
+ foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
+ my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
+ $path =~ s{/$}{};
+ my $item;
+ if ($path ne '') {
+ $item = "$path/$titles{$i}";
+ } else {
+ $item = $titles{$i};
+ }
+ $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
+ if ($item eq $contents[0]) {
+ push(@{$env{'form.archive_directory'}},$i);
+ $env{'form.archive_'.$i} = 'display';
+ $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
+ $displayed{'folder'} = $i;
+ } elsif ($item eq "$contents[0]/index.html") {
+ $env{'form.archive_'.$i} = 'display';
+ $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
+ $displayed{'web'} = $i;
+ } else {
+ if ($item eq "$contents[0]/media") {
+ push(@{$env{'form.archive_directory'}},$i);
+ }
+ $env{'form.archive_'.$i} = 'dependency';
+ }
+ $total ++;
+ }
+ for (my $i=1; $i<$total; $i++) {
+ next if ($i == $displayed{'web'});
+ next if ($i == $displayed{'folder'});
+ $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
+ }
+ $env{'form.phase'} = 'decompress_cleanup';
+ $env{'form.archivedelete'} = 1;
+ $env{'form.archive_count'} = $total-1;
+ $output .=
+ &process_extracted_files('coursedocs',$docudom,
+ $docuname,$destination,
+ $dir_root,$hiddenelem);
+ }
} else {
$warning = &mt('No new items extracted from archive file.');
}
@@ -10018,6 +10445,9 @@ sub archive_row {
my $offset = 0;
foreach my $action ('display','dependency','discard') {
$offset ++;
+ if ($action ne 'display') {
+ $offset ++;
+ }
$output .= ' '.
' '."\n".
- ' '."\n".
- ''.
- &mt('How should each item be incorporated in the course?').
- '
'.
- '
'.
- ''.&mt('Content actions for all').' '.
- ' '.
- ' '.
- ' '.
- ' '.
+ my ($form,$display,$count,$hiddenelem) = @_;
+ my %lt = &Apache::lonlocal::texthash(
+ perm => 'Permanently remove archive file?',
+ hows => 'How should each extracted item be incorporated in the course?',
+ cont => 'Content actions for all',
+ addf => 'Add as folder/file',
+ incd => 'Include as dependency for a displayed file',
+ disc => 'Discard',
+ no => 'No',
+ yes => 'Yes',
+ save => 'Save',
+ );
+ my $output = <<"END";
+';
}
@@ -10204,7 +10654,7 @@ function dependencyCheck(form,count,offs
function propagateSelect(form,count,offset) {
if (count > 0) {
- var item = (2+offset+$startcount)+7*(count-1);
+ var item = (1+offset+$startcount)+7*(count-1);
var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
if (parents[count].length > 0) {
@@ -10218,7 +10668,7 @@ function propagateSelect(form,count,offs
function containerSelect(form,count,offset,picked) {
if (count > 0) {
- var item = (1+offset+$startcount)+7*(count-1);
+ var item = (offset+$startcount)+7*(count-1);
if (form.elements[item].type == 'radio') {
if (form.elements[item].value == 'dependency') {
if (form.elements[item+1].type == 'select-one') {
@@ -10273,7 +10723,7 @@ sub process_extracted_files {
return unless ($numitems);
my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
- %folders,%containers,%mapinner);
+ %folders,%containers,%mapinner,%prompttofetch);
my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
if (grep(/^\Q$docuhome\E$/,@ids)) {
$prefix = &LONCAPA::propath($docudom,$docuname);
@@ -10309,13 +10759,13 @@ sub process_extracted_files {
}
}
}
- my ($output,%children,%parent,%titles,%dirorder);
+ my ($output,%children,%parent,%titles,%dirorder,$result);
if (keys(%toplevelitems) > 0) {
my @contents = sort(keys(%toplevelitems));
(my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
\%parent,\@contents,\%dirorder,\%titles);
}
- my (%referrer,%orphaned,%todelete,%newdest,%newseqid);
+ my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
if ($numitems) {
for (my $i=1; $i<=$numitems; $i++) {
my $path = $env{'form.archive_content_'.$i};
@@ -10323,7 +10773,12 @@ sub process_extracted_files {
if ($env{'form.archive_'.$i} eq 'discard') {
if ($prefix ne '' && $path ne '') {
if (-e $prefix.$path) {
- $todelete{$prefix.$path} = 1;
+ if ((@archdirs > 0) &&
+ (grep(/^\Q$i\E$/,@archdirs))) {
+ $todeletedir{$prefix.$path} = 1;
+ } else {
+ $todelete{$prefix.$path} = 1;
+ }
}
}
} elsif ($env{'form.archive_'.$i} eq 'display') {
@@ -10365,6 +10820,9 @@ sub process_extracted_files {
$docuname.'/'.$folders{$outer}.
'.'.$containers{$outer},1);
$newseqid{$i} = $newidx;
+ unless ($errtext) {
+ $result .= ''.&mt('Folder: [_1] added to course',$docstitle).' '."\n";
+ }
}
} else {
if ($context eq 'coursedocs') {
@@ -10381,6 +10839,11 @@ sub process_extracted_files {
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
+ unless ($ishome) {
+ my $fetch = "$newdest{$i}/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
$LONCAPA::map::resources[$newidx]=
$docstitle.':'.$url.':false:normal:res';
@@ -10389,6 +10852,11 @@ sub process_extracted_files {
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
$docuname.'/'.$folders{$outer}.
'.'.$containers{$outer},1);
+ unless ($errtext) {
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
+ $result .= ''.&mt('File: [_1] added to course',$docstitle).' '."\n";
+ }
+ }
}
}
} elsif ($env{'form.archive_'.$i} eq 'dependency') {
@@ -10396,7 +10864,7 @@ sub process_extracted_files {
$referrer{$i} = $env{'form.archive_dependent_on_'.$i};
if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
if (ref($dirorder{$i}) eq 'ARRAY') {
- my ($itemidx,$fullpath);
+ my ($itemidx,$fullpath,$relpath);
for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
my $container = $dirorder{$referrer{$i}}->[-1];
@@ -10415,6 +10883,7 @@ sub process_extracted_files {
if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
unless (defined($newseqid{$dirorder{$i}->[$j]})) {
$fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
if (!-e $fullpath) {
mkdir($fullpath,0755);
}
@@ -10433,6 +10902,7 @@ sub process_extracted_files {
} elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
unless (defined($newseqid{$dirorder{$i}->[$j]})) {
$fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
if (!-e $fullpath) {
mkdir($fullpath,0755);
}
@@ -10443,7 +10913,23 @@ sub process_extracted_files {
}
}
if ($fullpath ne '') {
- system("mv $prefix$path $fullpath/$title");
+ if (-e "$prefix$path") {
+ system("mv $prefix$path $fullpath/$title");
+ }
+ if (-e "$fullpath/$title") {
+ my $showpath;
+ if ($relpath ne '') {
+ $showpath = "$relpath/$title";
+ } else {
+ $showpath = "/$title";
+ }
+ $result .= ''.&mt('[_1] included as a dependency',$showpath).' '."\n";
+ }
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
}
}
@@ -10459,9 +10945,36 @@ sub process_extracted_files {
if (keys(%todelete)) {
foreach my $key (keys(%todelete)) {
unlink($key);
- unless ($ishome) {
- #FIXME Need to notify homeserver to delete files.
- }
+ }
+ }
+ if (keys(%todeletedir)) {
+ foreach my $key (keys(%todeletedir)) {
+ rmdir($key);
+ }
+ }
+ foreach my $dir (sort(keys(%is_dir))) {
+ if (($pathtocheck ne '') && ($dir ne '')) {
+ &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
+ }
+ }
+ if ($result ne '') {
+ $output .= ''."\n".
+ $result."\n".
+ ' ';
+ }
+ unless ($ishome) {
+ my $replicationfail;
+ foreach my $item (keys(%prompttofetch)) {
+ my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
+ unless ($fetchresult eq 'ok') {
+ $replicationfail .= ''.$item.' '."\n";
+ }
+ }
+ if ($replicationfail) {
+ $output .= ''.
+ &mt('Course home server failed to retrieve:').'
'.
+ $replicationfail.
+ ' ';
}
}
} else {
@@ -10477,6 +10990,90 @@ sub process_extracted_files {
return $output;
}
+sub cleanup_empty_dirs {
+ my ($path) = @_;
+ if (($path ne '') && (-d $path)) {
+ if (opendir(my $dirh,$path)) {
+ my @dircontents = grep(!/^\./,readdir($dirh));
+ my $numitems = 0;
+ foreach my $item (@dircontents) {
+ if (-d "$path/$item") {
+ &recurse_dirs("$path/$item");
+ if (-e "$path/$item") {
+ $numitems ++;
+ }
+ } else {
+ $numitems ++;
+ }
+ }
+ if ($numitems == 0) {
+ rmdir($path);
+ }
+ closedir($dirh);
+ }
+ }
+ return;
+}
+
+=pod
+
+=item &get_folder_hierarchy()
+
+Provides hierarchy of names of folders/sub-folders containing the current
+item,
+
+Inputs: 3
+ - $navmap - navmaps object
+
+ - $map - url for map (either the trigger itself, or map containing
+ the resource, which is the trigger).
+
+ - $showitem - 1 => show title for map itself; 0 => do not show.
+
+Outputs: 1 @pathitems - array of folder/subfolder names.
+
+=cut
+
+sub get_folder_hierarchy {
+ my ($navmap,$map,$showitem) = @_;
+ my @pathitems;
+ if (ref($navmap)) {
+ my $mapres = $navmap->getResourceByUrl($map);
+ if (ref($mapres)) {
+ my $pcslist = $mapres->map_hierarchy();
+ if ($pcslist ne '') {
+ my @pcs = split(/,/,$pcslist);
+ foreach my $pc (@pcs) {
+ if ($pc == 1) {
+ push(@pathitems,&mt('Main Course Documents'));
+ } else {
+ my $res = $navmap->getByMapPc($pc);
+ if (ref($res)) {
+ my $title = $res->compTitle();
+ $title =~ s/\W+/_/g;
+ if ($title ne '') {
+ push(@pathitems,$title);
+ }
+ }
+ }
+ }
+ }
+ }
+ if ($showitem) {
+ if ($mapres->{ID} eq '0.0') {
+ push(@pathitems,&mt('Main Course Documents'));
+ } else {
+ my $maptitle = $mapres->compTitle();
+ $maptitle =~ s/\W+/_/g;
+ if ($maptitle ne '') {
+ push(@pathitems,$maptitle);
+ }
+ }
+ }
+ }
+ return @pathitems;
+}
+
=pod
=item * &get_turnedin_filepath()
@@ -12622,7 +13219,7 @@ sub init_user_environment {
# See if old ID present, if so, remove
- my ($filename,$cookie,$userroles);
+ my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
my $now=time;
if ($public) {
@@ -12660,7 +13257,8 @@ sub init_user_environment {
# Initialize roles
- $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ ($userroles,$firstaccenv,$timerintenv) =
+ &Apache::lonnet::rolesinit($domain,$username,$authhost);
}
# ------------------------------------ Check browser type and MathML capability
@@ -12735,12 +13333,18 @@ sub init_user_environment {
}
$env{'user.environment'} = "$lonids/$cookie.id";
-
+
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
&GDBM_WRCREAT(),0640)) {
&_add_to_env(\%disk_env,\%initial_env);
&_add_to_env(\%disk_env,\%userenv,'environment.');
&_add_to_env(\%disk_env,$userroles);
+ if (ref($firstaccenv) eq 'HASH') {
+ &_add_to_env(\%disk_env,$firstaccenv);
+ }
+ if (ref($timerintenv) eq 'HASH') {
+ &_add_to_env(\%disk_env,$timerintenv);
+ }
if (ref($args->{'extra_env'})) {
&_add_to_env(\%disk_env,$args->{'extra_env'});
}