--- loncom/interface/loncommon.pm 2012/02/28 02:02:16 1.1056 +++ loncom/interface/loncommon.pm 2012/04/11 15:21:43 1.1069 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1056 2012/02/28 02:02:16 raeburn Exp $ +# $Id: loncommon.pm,v 1.1069 2012/04/11 15:21:43 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1748,6 +1748,7 @@ Inputs: $workbook Returns: $format, a hash reference. + =cut ############################################################### @@ -2856,6 +2857,7 @@ database which holds them. Uses global $thesaurus_db_file. + =cut ############################################################### @@ -4015,18 +4017,25 @@ sub findallcourses { if ($tstart) { next if ($tstart > $now); } - my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec); + my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role); (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry); + my $value = $trole.'/'.$cdom.'/'; if ($secpart eq '') { ($cnum,$role) = split(/_/,$cnumpart); $sec = 'none'; - $realsec = ''; + $value .= $cnum.'/'; } else { $cnum = $cnumpart; ($sec,$role) = split(/_/,$secpart); - $realsec = $sec; + $value .= $cnum.'/'.$sec; + } + if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') { + unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) { + push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value); + } + } else { + @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value); } - $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec; } } else { foreach my $key (keys(%env)) { @@ -4044,11 +4053,19 @@ sub findallcourses { if ($now>$endtime) { $active=0; } } if ($active) { + my $value = $role.'/'.$cdom.'/'.$cnum.'/'; if ($sec eq '') { $sec = 'none'; + } else { + $value .= $sec; + } + if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') { + unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) { + push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value); + } + } else { + @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value); } - $courses{$cdom.'_'.$cnum}{$sec} = - $role.'/'.$cdom.'/'.$cnum.'/'.$sec; } } } @@ -4059,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'}; @@ -4071,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., @@ -4141,34 +4159,38 @@ sub blockcheck { if ($otheruser) { # Resource belongs to user other than current user. # Assemble privs for that user, and check for 'evb' priv. - my ($trole,$tdom,$tnum,$tsec); - my $entry = $live_courses{$course}{$sec}; - if ($entry =~ /^cr/) { - ($trole,$tdom,$tnum,$tsec) = - ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|); - } else { - ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry); - } - my ($spec,$area,$trest,%allroles,%userroles); - $area = '/'.$tdom.'/'.$tnum; - $trest = $tnum; - if ($tsec ne '') { - $area .= '/'.$tsec; - $trest .= '/'.$tsec; - } - $spec = $trole.'.'.$area; - if ($trole =~ /^cr/) { - &Apache::lonnet::custom_roleprivs(\%allroles,$trole, - $tdom,$spec,$trest,$area); - } else { - &Apache::lonnet::standard_roleprivs(\%allroles,$trole, - $tdom,$spec,$trest,$area); - } - my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles); - if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) { - if ($1) { - $no_userblock = 1; - last; + my (%allroles,%userroles); + if (ref($live_courses{$course}{$sec}) eq 'ARRAY') { + foreach my $entry (@{$live_courses{$course}{$sec}}) { + my ($trole,$tdom,$tnum,$tsec); + if ($entry =~ /^cr/) { + ($trole,$tdom,$tnum,$tsec) = + ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|); + } else { + ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry); + } + my ($spec,$area,$trest); + $area = '/'.$tdom.'/'.$tnum; + $trest = $tnum; + if ($tsec ne '') { + $area .= '/'.$tsec; + $trest .= '/'.$tsec; + } + $spec = $trole.'.'.$area; + if ($trole =~ /^cr/) { + &Apache::lonnet::custom_roleprivs(\%allroles,$trole, + $tdom,$spec,$trest,$area); + } else { + &Apache::lonnet::standard_roleprivs(\%allroles,$trole, + $tdom,$spec,$trest,$area); + } + } + my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles); + if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) { + if ($1) { + $no_userblock = 1; + last; + } } } } else { @@ -4188,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); } - if ( ($endblock == 0) || ($endblock < $end) ) { - $endblock = $end; + 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); + } + } + } + } + } + } 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, + }; + } + } } } } } - return ($startblock,$endblock); + 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,$triggerblock); } sub parse_block_record { @@ -4251,39 +4366,50 @@ sub parse_block_record { } sub blocking_status { - my ($activity,$uname,$udom) = @_; - my %setters; - - # check for active blocking - my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom); + my ($activity,$uname,$udom,$url) = @_; + my %setters; - my $blocked = $startblock && $endblock ? 1 : 0; - - # caller just wants to know whether a block is active - if (!wantarray) { return $blocked; } - - # 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; - - my $output .= <<'END_MYBLOCK'; - function openWindow(url, wdwName, w, h, toolbar,scrollbar) { - var options = "width=" + w + ",height=" + h + ","; - options += "resizable=yes,scrollbars="+scrollbar+",status=no,"; - options += "menubar=no,toolbar="+toolbar+",location=no,directories=no"; - var newWin = window.open(url, wdwName, options); - newWin.focus(); - } +# check for active blocking + 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; } + +# 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 + 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) { + var options = "width=" + w + ",height=" + h + ","; + options += "resizable=yes,scrollbars="+scrollbar+",status=no,"; + options += "menubar=no,toolbar="+toolbar+",location=no,directories=no"; + var newWin = window.open(url, wdwName, options); + newWin.focus(); +} END_MYBLOCK - $output = Apache::lonhtmlcommon::scripttag($output); + $output = Apache::lonhtmlcommon::scripttag($output); - my $popupUrl = "/adm/blockingstatus/$querystring"; - my $text = mt('Communication Blocked'); - - $output .= <<"END_BLOCK"; + my $popupUrl = "/adm/blockingstatus/$querystring"; + 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";
@@ -4294,7 +4420,7 @@ END_MYBLOCK END_BLOCK - return ($blocked, $output); + return ($blocked, $output); } ############################################### @@ -4888,7 +5014,7 @@ sub bodytag { sub dc_courseid_toggle { my ($dc_info) = @_; return ' '. - ''. + ''. &mt('(More ...)').''. '
'.$dc_info.'
'; } @@ -4993,7 +5119,7 @@ sub standard_css { my $mono = 'monospace'; my $data_table_head = $sidebg; my $data_table_light = '#FAFAFA'; - my $data_table_dark = '#F0F0F0'; + my $data_table_dark = '#E0E0E0'; my $data_table_darker = '#CCCCCC'; my $data_table_highlight = '#FFFF00'; my $mail_new = '#FFBB77'; @@ -6080,6 +6206,7 @@ div.LC_edit_problem_footer { font-weight: normal; font-size: medium; margin: 2px; + background-color: $sidebg; } div.LC_edit_problem_header, @@ -6096,6 +6223,7 @@ div.LC_edit_problem_header_title { font-size: larger; background: $tabbg; padding: 3px; + margin: 0 0 5px 0; } table.LC_edit_problem_header_title { @@ -6788,6 +6916,8 @@ sub headtag { ''. &font_settings(); + my $inhibitprint = &print_suppression(); + if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); } @@ -6833,6 +6963,7 @@ ADDMETA if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } $result .= ' LON-CAPA '.$title.'' .'' + .$inhibitprint .$head_extra; return $result.''; } @@ -6858,6 +6989,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 @@ -8817,6 +9024,8 @@ sub get_future_slots { =pod +=back + =head1 HTTP Helpers =over 4 @@ -9719,43 +9928,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"; -
-
- -START + my $output; + if ($is_camtasia) { + $output = <<"ENDCAM"; + +

$lt{'camt'}

+ENDCAM + } else { + $output = '

'.$lt{'this'}; + if ($info eq '') { + $output .= ' '.$lt{'youm'}.'

'."\n"; + } else { + $output .= ' '.$lt{'itsc'}.'

'."\n". + '
'.$info.'
'; + } + } + $output .= ''."\n"; + my $duplicates; + my $num = 0; + if (ref($dirlist) eq 'ARRAY') { + foreach my $item (@{$dirlist}) { + if (ref($item) eq 'ARRAY') { + if (exists($toplevel{$item->[0]})) { + $duplicates .= + &start_data_table_row(). + ''. + ' '. + ''."\n". + ''.$item->[0].''; + if ($item->[2]) { + $duplicates .= ''.&mt('Directory').''; + } else { + $duplicates .= ''.&mt('File').''; + } + $duplicates .= ''.$item->[3].''. + ''. + &Apache::lonlocal::locallocaltime($item->[4]). + ''. + &end_data_table_row(); + $num ++; + } + } + } + } + my $itemcount; + if (@paths > 0) { + $itemcount = scalar(@paths); + } else { + $itemcount = 1; + } + if ($is_camtasia) { + $output .= $lt{'auto'}.'
'. + ''.$lt{'proa'}.' 
'. + '
'. + &Apache::lonhtmlcommon::start_pick_box(). + &Apache::lonhtmlcommon::row_title($lt{'fold'}). + ''."\n". + &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_title($lt{'movi'}). + ''."\n". + &Apache::lonhtmlcommon::row_closure(1). + &Apache::lonhtmlcommon::end_pick_box(). + '
'; + } + $output .= + ''. + ''. + "\n"; + if ($duplicates ne '') { + $output .= '

'. + &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'
'. + &start_data_table(). + &start_data_table_header_row(). + ''.&mt('Overwrite?').''. + ''.&mt('Name').''. + ''.&mt('Type').''. + ''.&mt('Size').''. + ''.&mt('Last modified').''. + &end_data_table_header_row(). + $duplicates. + &end_data_table(). + '

'; + } + $output .= ''."\n"; if (ref($hiddenelements) eq 'HASH') { foreach my $hidden (sort(keys(%{$hiddenelements}))) { $output .= ''."\n"; } } $output .= <<"END"; -$lt{'perm'}  -   -
+
$noextract -
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}); @@ -9785,8 +10177,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"; @@ -9797,47 +10187,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; @@ -9854,8 +10258,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, @@ -9864,10 +10271,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.'); } @@ -9982,17 +10433,20 @@ sub archive_row { my ($is_dir,$item,$currdir,$depth,$count) = @_; my ($name) = ($item =~ m{([^/]+)$}); my %choices = &Apache::lonlocal::texthash ( - 'display' => 'Add as File', + 'display' => 'Add as file', 'dependency' => 'Include as dependency', 'discard' => 'Discard', ); if ($is_dir) { - $choices{'display'} = &mt('Add as Folder'); + $choices{'display'} = &mt('Add as folder'); } my $output = &start_data_table_row().''.$count.''."\n"; my $offset = 0; foreach my $action ('display','dependency','discard') { $offset ++; + if ($action ne 'display') { + $offset ++; + } $output .= ''. '
'; + } elsif ($action eq 'display') { + $output .= ''; } $output .= ''; } @@ -10034,33 +10492,54 @@ sub archive_row { } sub archive_options_form { - my ($form,$output,$count,$hiddenelem) = @_; - return '
'."\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"; + +

$lt{'perm'}  + +  + + +

+ +
$lt{'hows'} +
+
+ $lt{'cont'} + +    +    +
+
+END + return $output. &start_data_table()."\n". - $output."\n". + $display."\n". &end_data_table()."\n". ''. $hiddenelem. - '
'. + '
'. '
'; } sub archive_javascript { my ($startcount,$numitems,$titles,$children) = @_; return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH')); + my $maintitle = $env{'form.comment'}; my $scripttag = < // 0) { - var startelement = $startcount + ((count-1) * 6); - for (var j=1; j<5; j++) { - if (j != 3) { + var startelement = $startcount + ((count-1) * 7); + for (var j=1; j<6; j++) { + if ((j != 2) && (j != 4)) { var item = startelement + j; if (form.elements[item].type == 'radio') { if (form.elements[item].checked) { @@ -10106,6 +10585,7 @@ var parents = new Array(numitems); for (var i=0; i 0) { dependencyCheck(form,count,offset); - var item = (offset+$startcount)+6*(count-1); + var item = (offset+$startcount)+7*(count-1); form.elements[item].checked = true; if(Object.prototype.toString.call(parents[count]) === '[object Array]') { if (parents[count].length > 0) { @@ -10139,17 +10619,17 @@ function containerCheck(form,count,offse function dependencyCheck(form,count,offset) { if (count > 0) { - var chosen = (offset+$startcount)+6*(count-1); - var depitem = $startcount + ((count-1) * 6) + 3; + var chosen = (offset+$startcount)+7*(count-1); + var depitem = $startcount + ((count-1) * 7) + 4; var currtype = form.elements[depitem].type; if (form.elements[chosen].value == 'dependency') { document.getElementById('arc_depon_'+count).style.display='block'; form.elements[depitem].options.length = 0; form.elements[depitem].options[0] = new Option('Select','',true,true); for (var i=1; i 0) { - var item = (1+offset+$startcount)+6*(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) { @@ -10186,7 +10667,7 @@ function propagateSelect(form,count,offs function containerSelect(form,count,offset,picked) { if (count > 0) { - var item = (offset+$startcount)+6*(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') { @@ -10209,6 +10690,26 @@ function containerSelect(form,count,offs } } +function titleCheck(form,count,offset) { + if (count > 0) { + var chosen = (offset+$startcount)+7*(count-1); + var depitem = $startcount + ((count-1) * 7) + 2; + var currtype = form.elements[depitem].type; + if (form.elements[chosen].value == 'display') { + document.getElementById('arc_title_'+count).style.display='block'; + if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) { + document.getElementById('archive_title_'+count).value=maintitle; + } + } else { + document.getElementById('arc_title_'+count).style.display='none'; + if (currtype == 'text') { + document.getElementById('archive_title_'+count).value=''; + } + } + } + return; +} + // ]]> END @@ -10221,7 +10722,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); @@ -10257,13 +10758,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}; @@ -10271,12 +10772,21 @@ 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') { - my ($title,$url,$outer); + my ($docstitle,$title,$url,$outer); ($title) = ($path =~ m{/([^/]+)$}); + $docstitle = $env{'form.archive_title_'.$i}; + if ($docstitle eq '') { + $docstitle = $title; + } $outer = 0; if (ref($dirorder{$i}) eq 'ARRAY') { if (@{$dirorder{$i}} > 0) { @@ -10302,13 +10812,16 @@ sub process_extracted_files { $folders{$i}.'.'.$containers{$i}; my $newidx = &LONCAPA::map::getresidx(); $LONCAPA::map::resources[$newidx]= - $title.':'.$url.':false:normal:res'; + $docstitle.':'.$url.':false:normal:res'; push(@LONCAPA::map::order,$newidx); my ($outtext,$errtext) = &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. $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') { @@ -10325,14 +10838,24 @@ 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]= - $title.':'.$url.':false:normal:res'; + $docstitle.':'.$url.':false:normal:res'; push(@LONCAPA::map::order, $newidx); my ($outtext,$errtext)= &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') { @@ -10340,7 +10863,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]; @@ -10359,6 +10882,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); } @@ -10377,6 +10901,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); } @@ -10387,7 +10912,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; + } } } } @@ -10403,9 +10944,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 { @@ -10421,6 +10989,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() @@ -12566,7 +13218,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) { @@ -12604,7 +13256,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 @@ -12679,12 +13332,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'}); }