--- loncom/interface/loncommon.pm 2012/01/31 23:47:15 1.1055 +++ loncom/interface/loncommon.pm 2012/04/05 13:32:15 1.1065 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1055 2012/01/31 23:47:15 raeburn Exp $ +# $Id: loncommon.pm,v 1.1065 2012/04/05 13:32:15 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); + } + 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, + }; + } + } } } } } - 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); } ############################################### @@ -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,25 +9928,93 @@ 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.', + 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', yes => 'Yes', no => 'No', ); - my $output = '

'.$lt{'this'}.' '.$lt{'youm'}.'
'; + my $output = '

'.$lt{'this'}; + my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl); + my (%toplevel,@paths); + my $info = &list_archive_contents($fileloc,\@paths); + if (@paths) { + foreach my $path (@paths) { + $path =~ s{^/}{}; + if ($path =~ m{^([^/]+)/}) { + $toplevel{$1} = $path; + } else { + $toplevel{$path} = $path; + } + } + } + if ($info eq '') { + $output .= ' '.$lt{'youm'}.'

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

'."\n". + '
'.$info.'
'; + } + 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; + } + $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(). + '

'; + } if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) { - $output .= $lt{'camt'}; + $output .= '

'.$lt{'camt'}.'

'; } - $output .= '

'; $output .= <<"START"; -

-$lt{'this'} $lt{'youm'} -

@@ -9748,9 +10025,6 @@ START } } $output .= <<"END"; -$lt{'perm'}  -   -
$noextract @@ -9759,6 +10033,62 @@ 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}); @@ -9788,8 +10118,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"; @@ -9800,47 +10128,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; @@ -9857,18 +10199,19 @@ sub process_decompression { } } if (@contents > 0) { - my (%children,%parent); + my (%children,%parent,%dirorder,%titles); my $wantform = 1; my ($count,$datatable) = &get_extracted($docudom,$docuname, $currdir,\%is_dir, \%children,\%parent, - \@contents,$wantform); + \@contents,\%dirorder, + \%titles,$wantform); if ($datatable ne '') { $output .= &archive_options_form('decompressed',$datatable, $count,$hiddenelem); - my $startcount = 3; + my $startcount = 6; $output .= &archive_javascript($startcount,$count, - %children); + \%titles,\%children); } } else { $warning = &mt('No new items extracted from archive file.'); @@ -9891,15 +10234,19 @@ sub process_decompression { } sub get_extracted { - my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$wantform) = @_; + my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder, + $titles,$wantform) = @_; my $count = 0; - my $lastcontainer = 0; my $depth = 0; my $datatable; + my @hierarchy; return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') && - (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY')); + (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') && + (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH')); foreach my $item (@{$contents}) { $count ++; + @{$dirorder->{$count}} = @hierarchy; + $titles->{$count} = $item; &archive_hierarchy($depth,$count,$parent,$children); if ($wantform) { $datatable .= &archive_row($is_dir->{$item},$item, @@ -9907,25 +10254,26 @@ sub get_extracted { } if ($is_dir->{$item}) { $depth ++; - $lastcontainer = $count; - $parent->{$depth} = $lastcontainer; + push(@hierarchy,$count); + $parent->{$depth} = $count; $datatable .= &recurse_extracted_archive("$currdir/$item",$docudom,$docuname, - \$depth,\$count,\$lastcontainer, - $children,$parent,$wantform); + \$depth,\$count,\@hierarchy,$dirorder, + $children,$parent,$titles,$wantform); $depth --; - $lastcontainer = $parent->{$depth}; + pop(@hierarchy); } } return ($count,$datatable); } sub recurse_extracted_archive { - my ($currdir,$docudom,$docuname,$depth,$count,$lastcontainer, - $children,$parent,$wantform) = @_; + my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder, + $children,$parent,$titles,$wantform) = @_; my $result=''; - unless ((ref($depth)) && (ref($count)) && (ref($lastcontainer)) && - (ref($children) eq 'HASH') && (ref($parent) eq 'HASH')) { + unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') && + (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') && + (ref($dirorder) eq 'HASH')) { return $result; } my $dirptr = 16384; @@ -9936,7 +10284,10 @@ sub recurse_extracted_archive { my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); unless ($item =~ /^\.+$/) { $$count ++; + @{$dirorder->{$$count}} = @{$hierarchy}; + $titles->{$$count} = $item; &archive_hierarchy($$depth,$$count,$parent,$children); + my $is_dir; if ($dirptr&$testdir) { $is_dir = 1; @@ -9946,15 +10297,15 @@ sub recurse_extracted_archive { } if ($is_dir) { $$depth ++; - $$lastcontainer = $$count; - $parent->{$$depth} = $$lastcontainer; + push(@{$hierarchy},$$count); + $parent->{$$depth} = $$count; $result .= &recurse_extracted_archive("$currdir/$item",$docudom, $docuname,$depth,$count, - $lastcontainer,$children, - $parent,$wantform); + $hierarchy,$dirorder,$children, + $parent,$titles,$wantform); $$depth --; - $$lastcontainer = $parent->{$$depth}; + pop(@{$hierarchy}); } } } @@ -9976,15 +10327,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()."\n"; + my $output = &start_data_table_row().''.$count.''."\n"; + my $offset = 0; foreach my $action ('display','dependency','discard') { + $offset ++; + if ($action ne 'display') { + $offset ++; + } $output .= ''. ''; + $output .= ' /> '.$choices{$action}.''; + if ($action eq 'dependency') { + $output .= ''; + } elsif ($action eq 'display') { + $output .= ''; + } + $output .= ''; } $output .= '&').'" />'.(' ' x 2); @@ -10014,32 +10386,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,%children) = @_; + 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) * 5; - for (var j=1; j<4; j++) { - var item = startelement + j; - if (form.elements[item].type == 'radio') { - if (form.elements[item].checked) { - containerCheck(form,count,j); - break; + 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) { + containerCheck(form,count,j); + break; + } } } } @@ -10074,35 +10474,136 @@ function propagateCheck(form,count) { } numitems = $numitems -var parents = new Array(numitems) +var titles = new Array(numitems); +var parents = new Array(numitems); for (var i=0; i $b } (keys(%children))) { - my @contents = split(/:/,$children{$container}); + foreach my $container (sort { $a <=> $b } (keys(%{$children}))) { + my @contents = split(/:/,$children->{$container}); for (my $i=0; $i<@contents; $i ++) { $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n"; } } + foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) { + $scripttag .= "titles[$key] = '".$titles->{$key}."';\n"; + } + $scripttag .= < 0) { - var item = $startcount + ((count-1) * 5) + offset; + dependencyCheck(form,count,offset); + 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) { for (var j=0; j 0) { + 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)+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) { + for (var j=0; j 0) { + 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') { + for (var i=0; i 0) { + for (var j=0; j 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 @@ -10110,7 +10611,7 @@ END } sub process_extracted_files { - my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; + my ($context,$docudom,$docuname,$url,$destination,$dir_root,$hiddenelem) = @_; my $numitems = $env{'form.archive_count'}; return unless ($numitems); my @ids=&Apache::lonnet::current_machine_ids(); @@ -10151,19 +10652,13 @@ sub process_extracted_files { } } } - my ($output,%children,%parent); + my ($output,%children,%parent,%titles,%dirorder); if (keys(%toplevelitems) > 0) { my @contents = sort(keys(%toplevelitems)); - my ($count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir, - \%children,\%parent,\@contents); - } - my (@above,%hierarchy,%referrer,%orphaned,%todelete); - foreach my $depth (sort { $a <=> $b } keys(%parent)) { - push(@above,$parent{$depth}); - foreach my $item (split(/:/,$children{$parent{$depth}})) { - $hierarchy{$item} = \@above; - } + (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children, + \%parent,\@contents,\%dirorder,\%titles); } + my (%referrer,%orphaned,%todelete,%newdest,%newseqid); if ($numitems) { for (my $i=1; $i<=$numitems; $i++) { my $path = $env{'form.archive_content_'.$i}; @@ -10175,12 +10670,16 @@ sub process_extracted_files { } } } 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($hierarchy{$i}) eq 'ARRAY') { - if (@{$hierarchy{$i}} > 0) { - foreach my $item (reverse(@{$hierarchy{$i}})) { + if (ref($dirorder{$i}) eq 'ARRAY') { + if (@{$dirorder{$i}} > 0) { + foreach my $item (reverse(@{$dirorder{$i}})) { if ($env{'form.archive_'.$item} eq 'display') { $outer = $item; last; @@ -10195,19 +10694,20 @@ sub process_extracted_files { next if ($fatal); if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) { if ($context eq 'coursedocs') { - $mapinner{$i} = time; + $mapinner{$i} = time; $folders{$i} = 'default_'.$mapinner{$i}; $containers{$i} = 'sequence'; my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. $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; } } else { if ($context eq 'coursedocs') { @@ -10223,9 +10723,10 @@ 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"; } $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.'/'. @@ -10234,19 +10735,64 @@ sub process_extracted_files { } } } elsif ($env{'form.archive_'.$i} eq 'dependency') { - if (ref($hierarchy{$i}) eq 'ARRAY') { - foreach my $item (reverse(@{$hierarchy{$i}})) { - if ($env{'form.archive_'.$item} eq 'display') { - $referrer{$i} = $item; - last; - #FIXME identify as dependency in db file - #FIXME need to move item to referrer location - #FIXME need to setup httprefs so access allowed - } elsif ($env{'form.archive_'.$item} eq 'discard') { - $orphaned{$i} = $item; - last; + my ($title) = ($path =~ m{/([^/]+)$}); + $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); + for (my $j=0; $j<@{$dirorder{$i}}; $j++) { + if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') { + my $container = $dirorder{$referrer{$i}}->[-1]; + for (my $j=0; $j<@{$dirorder{$i}}; $j++) { + if ($dirorder{$i}->[$j] eq $container) { + $itemidx = $j; + } + } + } + } + if ($itemidx ne '') { + if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { + if ($mapinner{$referrer{$i}}) { + $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; + for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { + if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { + unless (defined($newseqid{$dirorder{$i}->[$j]})) { + $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); + } + } + } else { + last; + } + } + } + } elsif ($newdest{$referrer{$i}}) { + $fullpath = $newdest{$referrer{$i}}; + for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { + if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') { + $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]}; + last; + } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { + unless (defined($newseqid{$dirorder{$i}->[$j]})) { + $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); + } + } + } else { + last; + } + } + } + if ($fullpath ne '') { + system("mv $prefix$path $fullpath/$title"); + } } } + } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { + $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', + $path,$env{'form.archive_content_'.$referrer{$i}}).'
'; } } } else { @@ -12419,7 +12965,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) { @@ -12457,7 +13003,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 @@ -12532,12 +13079,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'}); }