--- loncom/interface/loncommon.pm 2011/01/05 18:39:38 1.994 +++ loncom/interface/loncommon.pm 2012/04/25 21:22:01 1.1073 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.994 2011/01/05 18:39:38 raeburn Exp $ +# $Id: loncommon.pm,v 1.1073 2012/04/25 21:22:01 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -154,6 +154,8 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %latex_language; # For choosing hyphenation in +my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; my %scprtag; my %fe; my %fd; my %fm; @@ -186,11 +188,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); + my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; } + if ($latex) { + $latex_language_bykey{$key} = $latex; + $latex_language{$two} = $latex; + } } close($fh); } @@ -409,7 +415,7 @@ sub studentbrowser_javascript { +ENDRESBRW +} + sub selectstudent_link { - my ($form,$unameele,$udomele,$courseadvonly)=@_; - my $callargs = "'".$form."','".$unameele."','".$udomele."'"; + my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_; + my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". + &Apache::lonhtmlcommon::entity_encode($unameele)."','". + &Apache::lonhtmlcommon::entity_encode($udomele)."'"; if ($env{'request.course.id'}) { if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'}) && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}. '/'.$env{'request.course.sec'})) { return ''; } + $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; if ($courseadvonly) { $callargs .= ",'',1,1"; } @@ -452,7 +481,7 @@ sub selectstudent_link { &mt('Select User').''; } if ($env{'request.role'}=~/^(au|dc|su)/) { - $callargs .= ",1"; + $callargs .= ",'',1"; return ''. ''. &mt('Select User').''; @@ -460,6 +489,19 @@ sub selectstudent_link { return ''; } +sub selectresource_link { + my ($form,$reslink,$arg)=@_; + + my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". + &Apache::lonhtmlcommon::entity_encode($reslink)."'"; + unless ($env{'request.course.id'}) { return $arg; } + return ''. + ''. + $arg.''; +} + + + sub authorbrowser_javascript { return <<"ENDAUTHORBRW"; + +ENDJS + +} + sub userbrowser_javascript { my $id_functions = &javascript_index_functions(); return <<"ENDUSERBRW"; @@ -766,6 +853,9 @@ sub selectcourse_link { } elsif ($selecttype eq 'Course/Community') { $linktext = &mt('Select Course/Community'); $type = ''; + } elsif ($selecttype eq 'Select') { + $linktext = &mt('Select'); + $type = ''; } return '' ." '; + $addOther = ''.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).' '; } $out = '' # Start cheatsheet .$addOther .'' - .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'), - undef,undef,600) + .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600) .' ' - .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'), - undef,undef,600) + .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600) .''; unless ($not_author) { $out .= ' ' - .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'), - undef,undef,600) + .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) .''; } $out .= ''; # End cheatsheet @@ -1287,7 +1374,7 @@ function helpMenu(target) { return; } function writeHelp(caller) { - caller.document.writeln('$start_page $end_page') + caller.document.writeln('$start_page\\n\\n\\n$end_page') caller.document.close() caller.focus() } @@ -1661,6 +1748,7 @@ Inputs: $workbook Returns: $format, a hash reference. + =cut ############################################################### @@ -1722,7 +1810,7 @@ sub create_workbook { return (undef); } # - $workbook->set_tempdir('/home/httpd/perl/tmp'); + $workbook->set_tempdir(LONCAPA::tempdir()); # my $format = &Apache::loncommon::define_excel_formats($workbook); return ($workbook,$filename,$format); @@ -2769,6 +2857,7 @@ database which holds them. Uses global $thesaurus_db_file. + =cut ############################################################### @@ -3040,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 @@ -3146,11 +3235,29 @@ sub languagedescription { ($supported_language{$code}?' ('.&mt('interface available').')':''); } +=pod + +=item * &plainlanguagedescription + +Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)') +and the language character encoding (e.g. ISO) separated by a ' - ' string. + +=cut + sub plainlanguagedescription { my $code=shift; return $language{$code}; } +=pod + +=item * &supportedlanguagecode + +Returns the supported language code (e.g. sptutf maps to pt) given a language +code. + +=cut + sub supportedlanguagecode { my $code=shift; return $supported_language{$code}; @@ -3158,6 +3265,35 @@ sub supportedlanguagecode { =pod +=item * &latexlanguage() + +Given a language key code returns the correspondnig language to use +to select the correct hyphenation on LaTeX printouts. This is undef if there +is no supported hyphenation for the language code. + +=cut + +sub latexlanguage { + my $code = shift; + return $latex_language{$code}; +} + +=pod + +=item * &latexhyphenation() + +Same as above but what's supplied is the language as it might be stored +in the metadata. + +=cut + +sub latexhyphenation { + my $key = shift; + return $latex_language_bykey{$key}; +} + +=pod + =item * ©rightids() returns list of all copyrights @@ -3423,6 +3559,7 @@ sub get_previous_attempt { my $data=$parts[-1]; next if ($data eq 'foilorder'); pop(@parts); + $prevattempts.=''.&mt('Part ').join('.',@parts).'
'.$data.' '; if ($data eq 'type') { unless ($showsurv) { my $id = join(',',@parts); @@ -3431,10 +3568,7 @@ sub get_previous_attempt { $lasthidden{$ign.'.'.$id} = 1; } } - delete($lasthash{$key}); - } else { - $prevattempts.=''.&mt('Part ').join('.',@parts).'
'.$data.' '; - } + } } else { if ($#parts == 0) { $prevattempts.=''.$parts[0].''; @@ -3551,7 +3685,7 @@ sub get_previous_attempt { sub format_previous_attempt_value { my ($key,$value) = @_; - if ($key =~ /timestamp/) { + if (($key =~ /timestamp/) || ($key=~/duedate/)) { $value = &Apache::lonlocal::locallocaltime($value); } elsif (ref($value) eq 'ARRAY') { $value = '('.join(', ', @{ $value }).')'; @@ -3560,8 +3694,8 @@ sub format_previous_attempt_value { my @anskeys = sort(keys(%answers)); if (@anskeys == 1) { my $answer = $answers{$anskeys[0]}; - if ($answer =~ m{\Q\0\E}) { - $answer =~ s{\Q\0\E}{, }g; + if ($answer =~ m{\0}) { + $answer =~ s{\0}{,}g; } my $tag_internal_answer_name = 'INTERNAL'; if ($anskeys[0] eq $tag_internal_answer_name) { @@ -3572,8 +3706,8 @@ sub format_previous_attempt_value { } else { foreach my $ans (@anskeys) { my $answer = $answers{$ans}; - if ($answer =~ m{\Q\0\E}) { - $answer =~ s{\Q\0\E}{, }g; + if ($answer =~ m{\0}) { + $answer =~ s{\0}{,}g; } $value .= $ans.'='.$answer.'
';; } @@ -3856,9 +3990,7 @@ sub findallcourses { $udom = $env{'user.domain'}; } if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { - my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1}); - my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef, - $extra); + my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname); if (!%roles) { %roles = ( cc => 1, @@ -3883,18 +4015,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)) { @@ -3912,11 +4051,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; } } } @@ -3927,7 +4074,7 @@ sub findallcourses { ############################################### sub blockcheck { - my ($setters,$activity,$uname,$udom) = @_; + my ($setters,$activity,$uname,$udom,$url) = @_; if (!defined($udom)) { $udom = $env{'user.domain'}; @@ -3939,13 +4086,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., @@ -4009,34 +4157,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 { @@ -4056,46 +4208,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 { @@ -4119,39 +4364,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 $blocked = $startblock && $endblock ? 1 : 0; + my ($activity,$uname,$udom,$url) = @_; + my %setters; - # 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";
@@ -4162,7 +4418,7 @@ END_MYBLOCK END_BLOCK - return ($blocked, $output); + return ($blocked, $output); } ############################################### @@ -4272,8 +4528,7 @@ sub get_domainconf { if (ref($domconfig{'login'}{$key}) eq 'HASH') { if ($key eq 'loginvia') { if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') { - my @ids = &Apache::lonnet::current_machine_ids(); - foreach my $hostname (@ids) { + foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) { if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') { if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; @@ -4282,7 +4537,7 @@ sub get_domainconf { $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; } else { - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; } if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) { $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}; @@ -4365,7 +4620,7 @@ sub get_legacy_domconf { close($fh); } } - if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { + if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') { $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; } return %legacyhash; @@ -4423,7 +4678,10 @@ sub designparm { return $env{'environment.color.'.$which}; } $domain=&determinedomain($domain); - my %domdesign = &get_domainconf($domain); + my %domdesign; + unless ($domain eq 'public') { + %domdesign = &get_domainconf($domain); + } my $output; if ($domdesign{$domain.'.'.$which} ne '') { $output = $domdesign{$domain.'.'.$which}; @@ -4448,27 +4706,39 @@ sub designparm { =item * &authorspace() -Inputs: ./. +Inputs: $url (usually will be undef). -Returns: Path to the Construction Space of the current user's - accessed author space - The author space will be that of the current user - when accessing the own author space - and that of the co-author/assistent co-author - when accessing the co-author's/assistent co-author's - space +Returns: Path to Construction Space containing the resource or + directory being viewed (or for which action is being taken). + If $url is provided, and begins /priv// + the path will be that portion of the $context argument. + Otherwise the path will be for the author space of the current + user when the current role is author, or for that of the + co-author/assistant co-author space when the current role + is co-author or assistant co-author. =cut sub authorspace { + my ($url) = @_; + if ($url ne '') { + if ($url =~ m{^(/priv/$match_domain/$match_username/)}) { + return $1; + } + } my $caname = ''; - if ($env{'request.role'} =~ /^ca|^aa/) { - (undef,$caname) = + my $cadom = ''; + if ($env{'request.role'} =~ /^(?:ca|aa)/) { + ($cadom,$caname) = ($env{'request.role'}=~/($match_domain)\/($match_username)$/); - } else { + } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) { $caname = $env{'user.name'}; + $cadom = $env{'user.domain'}; + } + if (($caname ne '') && ($cadom ne '')) { + return "/priv/$cadom/$caname/"; } - return '/priv/'.$caname.'/'; + return; } ############################################## @@ -4496,7 +4766,9 @@ sub head_subbox { =item * &CSTR_pageheader() -Inputs: ./. +Input: (optional) filename from which breadcrumb trail is built. + In most cases no input as needed, as $env{'request.filename'} + is appropriate for use in building the breadcrumb trail. Returns: HTML div with CSTR path and recent box To be included on Construction Space pages @@ -4504,12 +4776,19 @@ Returns: HTML div with CSTR path and rec =cut sub CSTR_pageheader { - # this is for resources; directories have customtitle, and crumbs - # and select recent are created in lonpubdir.pm - my ($uname,$thisdisfn)= - ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); - my $formaction='/priv/'.$uname.'/'.$thisdisfn; - $formaction=~s/\/+/\//g; + my ($trailfile) = @_; + if ($trailfile eq '') { + $trailfile = $env{'request.filename'}; + } + +# this is for resources; directories have customtitle, and crumbs +# and select recent are created in lonpubdir.pm + + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + my ($udom,$uname,$thisdisfn)= + ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$}); + my $formaction = "/priv/$udom/$uname/$thisdisfn"; + $formaction =~ s{/+}{/}g; my $parentpath = ''; my $lastitem = ''; @@ -4526,7 +4805,7 @@ sub CSTR_pageheader { .''.&mt('Construction Space:').' ' .'
' #FIXME lonpubdir: target="_parent" - .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef); + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef); if ($lastitem) { $output .= @@ -4656,7 +4935,8 @@ sub bodytag { if ($public) { undef($role); } else { - $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'}); + $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'}, + undef,'LC_menubuttons_link'); } my $titleinfo = '

'.$title.'

'; @@ -4733,7 +5013,7 @@ sub bodytag { sub dc_courseid_toggle { my ($dc_info) = @_; return ' '. - '
'. + ''. &mt('(More ...)').''. '
'.$dc_info.'
'; } @@ -4838,7 +5118,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'; @@ -4878,7 +5158,6 @@ body { a:focus, a:focus img { color: red; - background: yellow; } form, .inline { @@ -4925,6 +5204,10 @@ form, .inline { text-decoration:none; } +.LC_setting { + text-decoration:underline; +} + .LC_error { color: red; font-size: larger; @@ -4969,35 +5252,36 @@ div.LC_confirm_box .LC_success img { } .LC_discussion { - background: $tabbg; + background: $data_table_dark; border: 1px solid black; margin: 2px; } -.LC_disc_action_links_bar { - background: $tabbg; - border: none; - margin: 4px; -} - .LC_disc_action_left { + background: $sidebg; text-align: left; + padding: 4px; + margin: 2px; } .LC_disc_action_right { + background: $sidebg; text-align: right; + padding: 4px; + margin: 2px; } .LC_disc_new_item { background: white; border: 2px solid red; - margin: 2px; + margin: 4px; + padding: 4px; } .LC_disc_old_item { background: white; - border: 1px solid black; - margin: 2px; + margin: 4px; + padding: 4px; } table.LC_pastsubmission { @@ -5089,6 +5373,7 @@ td.LC_table_cell_checkbox { overflow: hidden; margin: 0; padding: 0; + text-align: left; } .LC_head_subbox { @@ -5097,6 +5382,7 @@ td.LC_table_cell_checkbox { border: 1px solid $sidebg; margin: 0 0 10px 0; padding: 3px; + text-align: left; } .LC_fontsize_medium { @@ -5117,8 +5403,9 @@ td.LC_table_cell_checkbox { vertical-align: middle; } -li.LC_menubuttons_inline_text img,a { +li.LC_menubuttons_inline_text img { cursor:pointer; + text-decoration: none; } .LC_menubuttons_link { @@ -5166,14 +5453,6 @@ table.LC_nested { width: 100%; } -.ui-accordion, -.ui-accordion table.LC_data_table, -.ui-accordion table.LC_nested_outer{ - border: 0px; - border-spacing: 0px; - margin: 3px; -} - table.LC_data_table tr th, table.LC_calendar tr th, table.LC_prior_tries tr th, @@ -5289,22 +5568,6 @@ table.LC_nested tr td.LC_right_item { text-align: right; } -.ui-accordion table.LC_nested tr.LC_odd_row td.LC_left_item, -.ui-accordion table.LC_nested tr.LC_even_row td.LC_left_item { - text-align: right; - width: 40%; - padding-right:10px; - vertical-align: top; - padding: 5px; -} - -.ui-accordion table.LC_nested tr.LC_odd_row td.LC_right_item, -.ui-accordion table.LC_nested tr.LC_even_row td.LC_right_item { - text-align: left; - width: 60%; - padding: 2px 4px; -} - table.LC_nested tr.LC_odd_row td { background-color: #EEEEEE; } @@ -5436,6 +5699,11 @@ span.LC_current_location { background: $pgbg; } +span.LC_current_nav_location { + font-weight:bold; + background: $sidebg; +} + span.LC_parm_menu_item { font-size: larger; } @@ -5937,6 +6205,7 @@ div.LC_edit_problem_footer { font-weight: normal; font-size: medium; margin: 2px; + background-color: $sidebg; } div.LC_edit_problem_header, @@ -5953,6 +6222,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 { @@ -5990,7 +6260,6 @@ div.LC_createcourse { display:none; } -a:hover, ol.LC_primary_menu a:hover, ol#LC_MenuBreadcrumbs a:hover, ol#LC_PathBreadcrumbs a:hover, @@ -6064,6 +6333,7 @@ fieldset > legend { #LC_nav_bar { float: left; + background-color: $pgbg_or_bgcolor; margin: 0 0 2px 0; } @@ -6072,6 +6342,7 @@ fieldset > legend { padding: 0; font-weight: bold; text-align: center; + background-color: $pgbg_or_bgcolor; } #LC_nav_bar em { @@ -6082,6 +6353,7 @@ fieldset > legend { ol.LC_primary_menu { float: right; margin: 0; + background-color: $pgbg_or_bgcolor; } ol#LC_PathBreadcrumbs { @@ -6141,6 +6413,7 @@ ul#LC_secondary_menu { padding: 0; margin: 0; width: 100%; + text-align: left; } ul#LC_secondary_menu li { @@ -6157,7 +6430,7 @@ ul.LC_TabContent { background: $sidebg; border-bottom: solid 1px $lg_border_color; list-style:none; - margin: 0 -10px; + margin: -1px -10px 0 -10px; padding: 0; } @@ -6180,7 +6453,7 @@ ul.LC_TabContent li { padding: 0 16px 0 10px; background-color:$tabbg; border-bottom:solid 1px $lg_border_color; - border-right: solid 1px $font; + border-left: solid 1px $font; } ul.LC_TabContent .right { @@ -6220,6 +6493,12 @@ ul.LC_TabContent li.active a { background:#FFFFFF; outline: none; } + +ul.LC_TabContent li.goback { + float: left; + border-left: none; +} + #maincoursedoc { clear:both; } @@ -6274,17 +6553,15 @@ ul.LC_TabContentBigger li.active b { background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat; color:$font; border: 0; - cursor:default; } ul.LC_CourseBreadcrumbs { background: $sidebg; - line-height: 32px; + height: 2em; padding-left: 10px; - margin: 0 0 10px 0; + margin: 0; list-style-position: inside; - } ol#LC_MenuBreadcrumbs, @@ -6326,6 +6603,11 @@ ol#LC_PathBreadcrumbs li a { padding: 0 10px 10px 10px; } +.LC_DocsBox { + border: solid 1px $lg_border_color; + padding: 0 0 10px 10px; +} + .LC_AboutMe_Image { float:left; margin-right:10px; @@ -6466,6 +6748,10 @@ a#LC_content_toolbar_changefolder_toggle background-image:url(/res/adm/pages/open-all-folders.gif); } +a#LC_content_toolbar_edittoplevel { + background-image:url(/res/adm/pages/edittoplevel.gif); +} + ul#LC_toolbar li a:hover { background-position: bottom center; } @@ -6530,16 +6816,57 @@ ul.LC_funclist li { line-height: 150%; } -.ui-accordion .LC_advanced_toggle { - float: right; - font-size: 90%; - padding: 0px 4px -} - .LC_hidden { display: none; } +.LCmodal-overlay { + position:fixed; + top:0; + right:0; + bottom:0; + left:0; + height:100%; + width:100%; + margin:0; + padding:0; + background:#999; + opacity:.75; + filter: alpha(opacity=75); + -moz-opacity: 0.75; + z-index:101; +} + +* html .LCmodal-overlay { + position: absolute; + height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px'); +} + +.LCmodal-window { + position:fixed; + top:50%; + left:50%; + margin:0; + padding:0; + z-index:102; + } + +* html .LCmodal-window { + position:absolute; +} + +.LCclose-window { + position:absolute; + width:32px; + height:32px; + right:8px; + top:8px; + background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top; + text-indent:-99999px; + overflow:hidden; + cursor:pointer; +} + END } @@ -6588,6 +6915,8 @@ sub headtag { ''. &font_settings(); + my $inhibitprint = &print_suppression(); + if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); } @@ -6598,8 +6927,24 @@ sub headtag { && !$args->{'only_body'} && !$args->{'frameset'}) { $result .= &help_menu_js(); + $result.=&modal_window(); + $result.=&togglebox_script(); + $result.=&wishlist_window(); + $result.=&LCprogressbarUpdate_script(); + } else { + if ($args->{'add_modal'}) { + $result.=&modal_window(); + } + if ($args->{'add_wishlist'}) { + $result.=&wishlist_window(); + } + if ($args->{'add_togglebox'}) { + $result.=&togglebox_script(); + } + if ($args->{'add_progressbar'}) { + $result.=&LCprogressbarUpdate_script(); + } } - if (ref($args->{'redirect'})) { my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}}; $url = &Apache::lonenc::check_encrypt($url); @@ -6617,6 +6962,7 @@ ADDMETA if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } $result .= ' LON-CAPA '.$title.'' .'' + .$inhibitprint .$head_extra; return $result.''; } @@ -6642,6 +6988,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 @@ -6724,32 +7146,12 @@ $args - additional optional args support sub start_page { my ($title,$head_extra,$args) = @_; #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); -#SD -#I don't see why we copy certain elements of %$args to %head_args -#head args is passed to headtag() and this routine only reads those -#keys that are needed. There doesn't happen any writes or any processing -#of other keys. -#proposal: just pass $args to headtag instead of \%head_args and delete -#marked lines -#<- MARK - my %head_args; - foreach my $arg ('redirect','force_register','domain','function', - 'bgcolor','frameset','no_nav_bar','only_body', - 'no_auto_mt_title') { - if (defined($args->{$arg})) { - $head_args{$arg} = $args->{$arg}; - } - } -#MARK -> $env{'internal.start_page'}++; my $result; if (! exists($args->{'skip_phases'}{'head'}) ) { - $result .= - &xml_begin() . &headtag($title,$head_extra,\%head_args); -#replace prev line by -# &xml_begin() . &headtag($title, $head_extra, $args); + $result .= &xml_begin() . &headtag($title, $head_extra, $args); } if (! exists($args->{'skip_phases'}{'body'}) ) { @@ -6815,7 +7217,6 @@ sub end_page { } $result .= &Apache::lonxml::xmlend($target,$parser); } - if ($args->{'frameset'}) { $result .= ''; } else { @@ -6834,6 +7235,281 @@ sub end_page { return $result; } +sub wishlist_window { + return(<<'ENDWISHLIST'); + +ENDWISHLIST +} + +sub modal_window { + return(<<'ENDMODAL'); + +ENDMODAL +} + +sub modal_link { + my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_; + unless ($width) { $width=480; } + unless ($height) { $height=400; } + unless ($scrolling) { $scrolling='yes'; } + return ''. + $linktext.''; +} + +sub modal_adhoc_script { + my ($funcname,$width,$height,$content)=@_; + return (< +// + +ENDADHOC +} + +sub modal_adhoc_inner { + my ($funcname,$width,$height,$content)=@_; + my $innerwidth=$width-20; + $content=&js_ready( + &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). + &start_scrollbox($width.'px',$innerwidth.'px',$height.'px'). + $content. + &end_scrollbox(). + &end_page() + ); + return &modal_adhoc_script($funcname,$width,$height,$content); +} + +sub modal_adhoc_window { + my ($funcname,$width,$height,$content,$linktext)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content). + "".$linktext.""; +} + +sub modal_adhoc_launch { + my ($funcname,$width,$height,$content)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content).(< +// + +ENDLAUNCH +} + +sub modal_adhoc_close { + return (< +// + +ENDCLOSE +} + +sub togglebox_script { + return(< +// + +ENDTOGGLE +} + +sub start_togglebox { + my ($id,$heading,$headerbg,$hidetext,$showtext)=@_; + unless ($heading) { $heading=''; } else { $heading.=' '; } + unless ($showtext) { $showtext=&mt('show'); } + unless ($hidetext) { $hidetext=&mt('hide'); } + unless ($headerbg) { $headerbg='#FFFFFF'; } + return &start_data_table(). + &start_data_table_header_row(). + ''.$heading. + '['.$showtext.']'. + &end_data_table_header_row(). + ''; +} + +sub end_togglebox { + return ''.&end_data_table(); +} + +sub LCprogressbar_script { + my ($id)=@_; + return(< +// + +ENDPROGRESS +} + +sub LCprogressbarUpdate_script { + return(< +.ui-progressbar { position:relative; } +.pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } + + +ENDPROGRESSUPDATE +} + +my $LClastpercent; +my $LCidcnt; +my $LCcurrentid; + +sub LCprogressbar { + my ($r)=(@_); + $LClastpercent=0; + $LCidcnt++; + $LCcurrentid=$$.'_'.$LCidcnt; + my $starting=&mt('Starting'); + my $content=(< +
+ $starting +
+

+ENDPROGBAR + &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); +} + +sub LCprogressbarUpdate { + my ($r,$val,$text)=@_; + unless ($val) { + if ($LClastpercent) { + $val=$LClastpercent; + } else { + $val=0; + } + } + if ($val<0) { $val=0; } + if ($val>100) { $val=0; } + $LClastpercent=$val; + unless ($text) { $text=$val.'%'; } + $text=&js_ready($text); + &r_print($r,< +// + +ENDUPDATE +} + +sub LCprogressbarClose { + my ($r)=@_; + $LClastpercent=0; + &r_print($r,< +// + +ENDCLOSE +} + +sub r_print { + my ($r,$to_print)=@_; + if ($r) { + $r->print($to_print); + $r->rflush(); + } else { + print($to_print); + } +} + sub html_encode { my ($result) = @_; @@ -6841,6 +7517,7 @@ sub html_encode { return $result; } + sub js_ready { my ($result) = @_; @@ -6877,6 +7554,24 @@ sub validate_page { } } + +sub start_scrollbox { + my ($outerwidth,$width,$height,$id)=@_; + unless ($outerwidth) { $outerwidth='520px'; } + unless ($width) { $width='500px'; } + unless ($height) { $height='200px'; } + my ($table_id,$div_id); + if ($id ne '') { + $table_id = " id='table_$id'"; + $div_id = " id='div_$id'"; + } + return "
"; +} + +sub end_scrollbox { + return '
'; +} + sub simple_error_page { my ($r,$title,$msg) = @_; my $page = @@ -6904,10 +7599,14 @@ sub simple_error_page { } sub start_data_table { - my ($add_class) = @_; + my ($add_class,$id) = @_; my $css_class = (join(' ','LC_data_table',$add_class)); + my $table_id; + if (defined($id)) { + $table_id = ' id="'.$id.'"'; + } &start_data_table_count(); - return ''."\n"; + return '
'."\n"; } sub end_data_table { @@ -7034,7 +7733,7 @@ sub get_users_function { $function='admin'; } if (($env{'request.role'}=~/^(au|ca|aa)/) || - ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) { $function='author'; } return $function; @@ -7092,8 +7791,7 @@ role status: active, previous or future. sub check_user_status { my ($udom,$uname,$cdom,$crs,$role,$sec) = @_; - my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1}); - my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra); + my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname); my @uroles = keys %userinfo; my $srchstr; my $active_chk = 'none'; @@ -8149,7 +8847,8 @@ sub get_standard_codeitems { =item * sorted_slots() -Sorts an array of slot names in order of slot start time (earliest first). +Sorts an array of slot names in order of an optional sort key, +default sort is by slot start time (earliest first). Inputs: @@ -8159,15 +8858,16 @@ slotsarr - Reference to array of unsort slots - Reference to hash of hash, where outer hash keys are slot names. +sortkey - Name of key in inner hash to be sorted on (e.g., starttime). + =back Returns: =over 4 -sorted - An array of slot names sorted by the start time of the slot. - -=back +sorted - An array of slot names sorted by a specified sort key + (default sort key is start time of the slot). =back @@ -8175,13 +8875,16 @@ sorted - An array of slot names sorted sub sorted_slots { - my ($slotsarr,$slots) = @_; + my ($slotsarr,$slots,$sortkey) = @_; + if ($sortkey eq '') { + $sortkey = 'starttime'; + } my @sorted; if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) { @sorted = sort { if (ref($slots->{$a}) && ref($slots->{$b})) { - return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'} + return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey} } if (ref($slots->{$a})) { return -1;} if (ref($slots->{$b})) { return 1;} @@ -8191,9 +8894,136 @@ sub sorted_slots { return @sorted; } +=pod + +=item * get_future_slots() + +Inputs: + +=over 4 + +cnum - course number + +cdom - course domain + +now - current UNIX time + +symb - optional symb + +=back + +Returns: + +=over 4 + +sorted_reservable - ref to array of student_schedulable slots currently + reservable, ordered by end date of reservation period. + +reservable_now - ref to hash of student_schedulable slots currently + reservable. + + Keys in inner hash are: + (a) symb: either blank or symb to which slot use is restricted. + (b) endreserve: end date of reservation period. + +sorted_future - ref to array of student_schedulable slots reservable in + the future, ordered by start date of reservation period. + +future_reservable - ref to hash of student_schedulable slots reservable + in the future. + + Keys in inner hash are: + (a) symb: either blank or symb to which slot use is restricted. + (b) startreserve: start date of reservation period. + +=back + +=cut + +sub get_future_slots { + my ($cnum,$cdom,$now,$symb) = @_; + my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future); + my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom); + foreach my $slot (keys(%slots)) { + next unless($slots{$slot}->{'type'} eq 'schedulable_student'); + if ($symb) { + next if (($slots{$slot}->{'symb'} ne '') && + ($slots{$slot}->{'symb'} ne $symb)); + } + if (($slots{$slot}->{'starttime'} > $now) && + ($slots{$slot}->{'endtime'} > $now)) { + if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) { + my $userallowed = 0; + if ($slots{$slot}->{'allowedsections'}) { + my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'}); + if (!defined($env{'request.role.sec'}) + && grep(/^No section assigned$/,@allowed_sec)) { + $userallowed=1; + } else { + if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) { + $userallowed=1; + } + } + unless ($userallowed) { + if (defined($env{'request.course.groups'})) { + my @groups = split(/:/,$env{'request.course.groups'}); + foreach my $group (@groups) { + if (grep(/^\Q$group\E$/,@allowed_sec)) { + $userallowed=1; + last; + } + } + } + } + } + if ($slots{$slot}->{'allowedusers'}) { + my @allowed_users = split(',',$slots{$slot}->{'allowedusers'}); + my $user = $env{'user.name'}.':'.$env{'user.domain'}; + if (grep(/^\Q$user\E$/,@allowed_users)) { + $userallowed = 1; + } + } + next unless($userallowed); + } + my $startreserve = $slots{$slot}->{'startreserve'}; + my $endreserve = $slots{$slot}->{'endreserve'}; + my $symb = $slots{$slot}->{'symb'}; + if (($startreserve < $now) && + (!$endreserve || $endreserve > $now)) { + my $lastres = $endreserve; + if (!$lastres) { + $lastres = $slots{$slot}->{'starttime'}; + } + $reservable_now{$slot} = { + symb => $symb, + endreserve => $lastres + }; + } elsif (($startreserve > $now) && + (!$endreserve || $endreserve > $startreserve)) { + $future_reservable{$slot} = { + symb => $symb, + startreserve => $startreserve + }; + } + } + } + my @unsorted_reservable = keys(%reservable_now); + if (@unsorted_reservable > 0) { + @sorted_reservable = + &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve'); + } + my @unsorted_future = keys(%future_reservable); + if (@unsorted_future > 0) { + @sorted_future = + &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve'); + } + return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable); +} =pod +=back + =head1 HTTP Helpers =over 4 @@ -8332,13 +9162,20 @@ sub get_env_multiple { sub ask_for_embedded_content { my ($actionurl,$state,$allfiles,$codebase,$args)=@_; - my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges); - my $num = 0; + my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges, + %currsubfile,%unused); + my $counter = 0; + my $numnew = 0; my $numremref = 0; my $numinvalid = 0; my $numpathchg = 0; my $numexisting = 0; - my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath); + my $numunused = 0; + my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum, + $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path); + my $heading = &mt('Upload embedded files'); + my $buttontext = &mt('Upload'); + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { my $current_path='/'; if ($env{'form.currentpath'}) { @@ -8358,16 +9195,32 @@ sub ask_for_embedded_content { $getpropath = 1; } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || ($actionurl eq '/adm/imsimport')) { - ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$}); - $url = '/home/'.$uname.'/public_html/'; + my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$}); + $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/"; $toplevel = $url; if ($rest ne '') { $url .= $rest; } } elsif ($actionurl eq '/adm/coursedocs') { if (ref($args) eq 'HASH') { - $url = $args->{'docs_url'}; - $toplevel = $url; + $url = $args->{'docs_url'}; + $toplevel = $url; + } + } elsif ($actionurl eq '/adm/dependencies') { + if ($env{'request.course.id'} ne '') { + $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + if (ref($args) eq 'HASH') { + $url = $args->{'docs_url'}; + $title = $args->{'docs_title'}; + $toplevel = "/$url"; + ($path) = + ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); + $fileloc = &Apache::lonnet::filelocation('',$toplevel); + $fileloc =~ s{^/}{}; + ($filename) = ($fileloc =~ m{.+/([^/]+)$}); + $heading = &mt('Status of dependencies in [_1]',"$title ($filename)"); + } } } my $now = time(); @@ -8406,22 +9259,44 @@ sub ask_for_embedded_content { } } } + my $dirptr = 16384; foreach my $path (keys(%subdependencies)) { - my %currsubfile; + $currsubfile{$path} = {}; if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { - my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); - foreach my $line (@subdir_list) { - my ($file_name,$rest) = split(/\&/,$line,2); - $currsubfile{$file_name} = 1; + my ($sublistref,$listerror) = + &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); + if (ref($sublistref) eq 'ARRAY') { + foreach my $line (@{$sublistref}) { + my ($file_name,$rest) = split(/\&/,$line,2); + $currsubfile{$path}{$file_name} = 1; + } } } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { if (opendir(my $dir,$url.'/'.$path)) { my @subdir_list = grep(!/^\./,readdir($dir)); - map {$currsubfile{$_} = 1;} @subdir_list; + map {$currsubfile{$path}{$_} = 1;} @subdir_list; + } + } elsif ($actionurl eq '/adm/dependencies') { + if ($env{'request.course.id'} ne '') { + my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$}); + if ($dir ne '') { + my ($sublistref,$listerror) = + &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/'); + if (ref($sublistref) eq 'ARRAY') { + foreach my $line (@{$sublistref}) { + my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size, + undef,$mtime)=split(/\&/,$line,12); + unless (($testdir&$dirptr) || + ($file_name =~ /^\.\.?$/)) { + $currsubfile{$path}{$file_name} = [$size,$mtime]; + } + } + } + } } } foreach my $file (keys(%{$subdependencies{$path}})) { - if ($currsubfile{$file}) { + if (exists($currsubfile{$path}{$file})) { my $item = $path.'/'.$file; unless ($mapping{$item} eq $item) { $pathchanges{$item} = 1; @@ -8432,22 +9307,54 @@ sub ask_for_embedded_content { $newfiles{$path.'/'.$file} = 1; } } + if ($actionurl eq '/adm/dependencies') { + foreach my $path (keys(%currsubfile)) { + if (ref($currsubfile{$path}) eq 'HASH') { + foreach my $file (keys(%{$currsubfile{$path}})) { + unless ($subdependencies{$path}{$file}) { + $unused{$path.'/'.$file} = 1; + } + } + } + } + } } my %currfile; if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { - my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath); - foreach my $line (@dir_list) { - my ($file_name,$rest) = split(/\&/,$line,2); - $currfile{$file_name} = 1; + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath); + if (ref($dirlistref) eq 'ARRAY') { + foreach my $line (@{$dirlistref}) { + my ($file_name,$rest) = split(/\&/,$line,2); + $currfile{$file_name} = 1; + } } } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { if (opendir(my $dir,$url)) { my @dir_list = grep(!/^\./,readdir($dir)); map {$currfile{$_} = 1;} @dir_list; } + } elsif ($actionurl eq '/adm/dependencies') { + if ($env{'request.course.id'} ne '') { + my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$}); + if ($dir ne '') { + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/'); + if (ref($dirlistref) eq 'ARRAY') { + foreach my $line (@{$dirlistref}) { + my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef, + $size,undef,$mtime)=split(/\&/,$line,12); + unless (($testdir&$dirptr) || + ($file_name =~ /^\.\.?$/)) { + $currfile{$file_name} = [$size,$mtime]; + } + } + } + } + } } foreach my $file (keys(%dependencies)) { - if ($currfile{$file}) { + if (exists($currfile{$file})) { unless ($mapping{$file} eq $file) { $pathchanges{$file} = 1; } @@ -8457,15 +9364,25 @@ sub ask_for_embedded_content { $newfiles{$file} = 1; } } + foreach my $file (keys(%currfile)) { + unless (($file eq $filename) || + ($file eq $filename.'.bak') || + ($dependencies{$file})) { + $unused{$file} = 1; + } + } foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) { + if ($actionurl eq '/adm/dependencies') { + next if ($embed_file =~ m{^\w+://}); + } $upload_output .= &start_data_table_row(). - ''.&Apache::loncommon::end_data_table_row()."\n"; } foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) { - $upload_output .= &start_data_table_row(). - ''. - ''. - &Apache::loncommon::end_data_table_row()."\n"; + if ($actionurl eq '/adm/dependencies') { + my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file); + $modify_output .= &start_data_table_row(). + ''. + ''. + ''. + ''. + &end_data_table_row()."\n"; + $counter ++; + } else { + $upload_output .= &start_data_table_row(). + ''; + ''. + &Apache::loncommon::end_data_table_row()."\n"; + } + } + my $delidx = $counter; + foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) { + my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile); + $delete_output .= &start_data_table_row(). + ''. + ''. + ''. + ''. + &end_data_table_row()."\n"; + $numunused ++; + $delidx ++; } if ($upload_output) { $upload_output = &start_data_table(). $upload_output. &end_data_table()."\n"; } + if ($modify_output) { + $modify_output = &start_data_table(). + &start_data_table_header_row(). + ''. + ''. + ''. + ''. + &end_data_table_header_row(). + $modify_output. + &end_data_table()."\n"; + } + if ($delete_output) { + $delete_output = &start_data_table(). + &start_data_table_header_row(). + ''. + ''. + ''. + ''. + &end_data_table_header_row(). + $delete_output. + &end_data_table()."\n"; + } my $applies = 0; if ($numremref) { $applies ++; @@ -8502,15 +9479,37 @@ sub ask_for_embedded_content { if ($numexisting) { $applies ++; } - if ($num) { + if ($counter || $numunused) { $output = ''."\n". - $state. - '

'.&mt('Upload embedded files'). - ':

'.$upload_output.'
'."\n". - ''."\n"; - if ($actionurl eq '') { + $state.'

'.$heading.'

'; + if ($actionurl eq '/adm/dependencies') { + if ($numnew) { + $output .= '

'.&mt('Missing dependencies').'

'. + '

'.&mt('The following files need to be uploaded.').'

'."\n". + $upload_output.'
'."\n"; + } + if ($numexisting) { + $output .= '

'.&mt('Uploaded dependencies (in use)').'

'. + '

'.&mt('Upload a new file to replace the one currently in use.').'

'."\n". + $modify_output.'
'."\n"; + $buttontext = &mt('Save changes'); + } + if ($numunused) { + $output .= '

'.&mt('Unused files').'

'. + '

'.&mt('The following uploaded files are no longer used.').'

'."\n". + $delete_output.'
'."\n"; + $buttontext = &mt('Save changes'); + } + } else { + $output .= $upload_output.'
'."\n"; + } + $output .= ''."\n"; + if ($actionurl eq '/adm/dependencies') { + $output .= ''."\n"; + } elsif ($actionurl eq '') { $output .= ''; } } elsif ($applies) { @@ -8538,13 +9537,13 @@ sub ask_for_embedded_content { $output .= $upload_output.'
'; } my ($pathchange_output,$chgcount); - $chgcount = $num; + $chgcount = $counter; if (keys(%pathchanges) > 0) { foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) { - if ($num) { + if ($counter) { $output .= &embedded_file_element('pathchange',$chgcount, $embed_file,\%mapping, - $allfiles,$codebase); + $allfiles,$codebase,'change'); } else { $pathchange_output .= &start_data_table_row(). @@ -8553,14 +9552,14 @@ sub ask_for_embedded_content { ''. ''.&end_data_table_row(); } $numpathchg ++; $chgcount ++; } } - if ($num) { + if ($counter) { if ($numpathchg) { $output .= ''."\n"; @@ -8570,9 +9569,10 @@ sub ask_for_embedded_content { $output .= ''."\n"; } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') { $output .= ''; + } elsif ($actionurl eq '/adm/dependencies') { + $output .= ''; } - $output .= ''."\n". - &mt('(only files for which a location has been provided will be uploaded)').''."\n"; + $output .= ''."\n".''."\n"; } elsif ($numpathchg) { my %pathchange = (); $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output); @@ -8580,15 +9580,15 @@ sub ask_for_embedded_content { $output .= '

'.&mt('or').'

'; } } - return ($output,$num,$numpathchg); + return ($output,$counter,$numpathchg); } sub embedded_file_element { - my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_; + my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_; return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') && (ref($codebase) eq 'HASH')); my $output; - if ($context eq 'upload_embedded') { + if (($context eq 'upload_embedded') && ($type ne 'delete')) { $output = ''."\n"; } $output .= ' 0) { + $showmtime = &Apache::lonlocal::locallocaltime($mtime); + } + } + return ($showsize,$showmtime); +} + +sub ask_embedded_js { + return <<"END"; + + +END +} + sub upload_embedded { my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota, $current_disk_usage,$hiddenstate,$actionurl) = @_; @@ -8673,7 +9717,6 @@ sub upload_embedded { $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'
'; next; } - $env{'form.embedded_item_'.$i.'.filename'}=$fname; if ($context eq 'portfolio') { my $result; @@ -8717,12 +9760,12 @@ sub upload_embedded { my $fullpath = $dir_root.$dirpath.'/'.$path; my $dest = $fullpath.$fname; my $url = $url_root.$dirpath.'/'.$path.$fname; - my @parts=split(/\//,$fullpath); + my @parts=split(/\//,"$dirpath/$path"); my $count; my $filepath = $dir_root; - for ($count=4;$count<=$#parts;$count++) { - $filepath .= "/$parts[$count]"; - if ((-e $filepath)!=1) { + foreach my $subdir (@parts) { + $filepath .= "/$subdir"; + if (!-e $filepath) { mkdir($filepath,0770); } } @@ -8730,13 +9773,15 @@ sub upload_embedded { if (!open($fh,'>'.$dest)) { &Apache::lonnet::logthis('Failed to create '.$dest); $output .= ''. - &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). + &mt('An error occurred while trying to upload [_1] for embedded element [_2].', + $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). '
'; } else { if (!print $fh $env{'form.embedded_item_'.$i}) { &Apache::lonnet::logthis('Failed to write to '.$dest); $output .= ''. - &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). + &mt('An error occurred while writing the file [_1] for embedded element [_2].', + $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). '
'; } else { $output .= &mt('Uploaded [_1]',''. @@ -8758,15 +9803,17 @@ sub upload_embedded { } $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange); $returnflag = 'ok'; - if (keys(%pathchange) > 0) { + my $numpathchgs = scalar(keys(%pathchange)); + if ($numpathchgs > 0) { if ($context eq 'portfolio') { $output .= '

'.&mt('or').'

'; } elsif ($context eq 'testbank') { - $output .= '

'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','','').'

'; + $output .= '

'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).', + '','').'

'; $returnflag = 'modify_orightml'; } } - return ($output.$footer,$returnflag); + return ($output.$footer,$returnflag,$numpathchgs); } sub modify_html_form { @@ -8801,7 +9848,7 @@ sub modify_html_form { ''. &end_data_table_row(); - } + } } } else { $modifyform = $pathchgtable; @@ -8812,6 +9859,9 @@ sub modify_html_form { } } if ($modifyform) { + if ($actionurl eq '/adm/dependencies') { + $hiddenstate .= ''; + } return '

'.&mt('Changes in content of HTML file required').'

'."\n". '

'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'

    '."\n". '
  1. '.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'
  2. '."\n". @@ -8840,24 +9890,55 @@ sub modify_html_refs { $container = $env{'form.container'}; } elsif ($context eq 'coursedoc') { $container = $env{'form.primaryurl'}; + } elsif ($context eq 'manage_dependencies') { + (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'}); + $container = "/$container"; } else { - $container = $env{'form.filename'}; - $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2}; + $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'}; } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); - return unless (@changes > 0); - if (($context eq 'portfolio') || ($context eq 'coursedoc')) { - return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}); + unless (@changes > 0) { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } + if (($context eq 'portfolio') || ($context eq 'coursedoc') || + ($context eq 'manage_dependencies')) { + unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } $content = &Apache::lonnet::getfile($container); - return if ($content eq '-1'); + if ($content eq '-1') { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } } else { - return unless ($container =~ /^\Q$dir_root\E/); + unless ($container =~ /^\Q$dir_root\E/) { + if (wantarray) { + return ('',0,0); + } else { + return; + } + } if (open(my $fh,"<$container")) { $content = join('', <$fh>); close($fh); } else { - return; + if (wantarray) { + return ('',0,0); + } else { + return; + } } } my ($count,$codebasecount) = (0,0); @@ -8874,7 +9955,7 @@ sub modify_html_refs { if ($allfiles{$ref}) { my $newname = $orig; my ($attrib_regexp,$codebase); - my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i}); + $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i}); if ($attrib_regexp =~ /:/) { $attrib_regexp =~ s/\:/|/g; } @@ -8883,7 +9964,7 @@ sub modify_html_refs { $count += $numchg; } if ($env{'form.embedded_codebase_'.$i} ne '') { - my $codebase = &unescape($env{'form.embedded_codebase_'.$i}); + $codebase = &unescape($env{'form.embedded_codebase_'.$i}); my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs $codebasecount ++; } @@ -8891,13 +9972,14 @@ sub modify_html_refs { } if ($count || $codebasecount) { my $saveresult; - if ($context eq 'portfolio' || $context eq 'coursedoc') { + if (($context eq 'portfolio') || ($context eq 'coursedoc') || + ($context eq 'manage_dependencies')) { my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); if ($url eq $container) { my ($fname) = ($container =~ m{/([^/]+)$}); $output = '

    '.&mt('Updated [quant,_1,reference] in [_2].', $count,''. - $fname.'').'

    '; + $fname.'').'

    '; } else { $output = '

    '. &mt('Error: update failed for: [_1].', @@ -8924,7 +10006,11 @@ sub modify_html_refs { ' to modify references: '.$parse_result); } } - return $output; + if (wantarray) { + return ($output,$count,$codebasecount); + } else { + return $output; + } } sub check_for_existing { @@ -8952,14 +10038,14 @@ sub check_for_upload { &mt('Unable to upload [_1]. (size = [_2] bytes)', ''.$fname.'', $filesize).'
    '. - &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'
    '; + &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'
    '. ''; return ('zero_bytes',$msg); } $filesize = $filesize/1000; #express in k (1024?) my $getpropath = 1; - my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, - $getpropath); + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath); my $found_file = 0; my $locked_file = 0; my @lockers; @@ -8967,48 +10053,50 @@ sub check_for_upload { if ($env{'request.course.id'}) { $navmap = Apache::lonnavmaps::navmap->new(); } - foreach my $line (@dir_list) { - my ($file_name,$rest)=split(/\&/,$line,2); - if ($file_name eq $fname){ - $file_name = $path.$file_name; - if ($group ne '') { - $file_name = $group.$file_name; - } - $found_file = 1; - if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') { - foreach my $lock (@lockers) { - if (ref($lock) eq 'ARRAY') { - my ($symb,$crsid) = @{$lock}; - if ($crsid eq $env{'request.course.id'}) { - if (ref($navmap)) { - my $res = $navmap->getBySymb($symb); - foreach my $part (@{$res->parts()}) { - my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); - unless (($slot_status == $res->RESERVED) || - ($slot_status == $res->RESERVED_LOCATION)) { - $locked_file = 1; + if (ref($dirlistref) eq 'ARRAY') { + foreach my $line (@{$dirlistref}) { + my ($file_name,$rest)=split(/\&/,$line,2); + if ($file_name eq $fname){ + $file_name = $path.$file_name; + if ($group ne '') { + $file_name = $group.$file_name; + } + $found_file = 1; + if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') { + foreach my $lock (@lockers) { + if (ref($lock) eq 'ARRAY') { + my ($symb,$crsid) = @{$lock}; + if ($crsid eq $env{'request.course.id'}) { + if (ref($navmap)) { + my $res = $navmap->getBySymb($symb); + foreach my $part (@{$res->parts()}) { + my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); + unless (($slot_status == $res->RESERVED) || + ($slot_status == $res->RESERVED_LOCATION)) { + $locked_file = 1; + } } + } else { + $locked_file = 1; } } else { $locked_file = 1; } - } else { - $locked_file = 1; } - } - } - } else { - my @info = split(/\&/,$rest); - my $currsize = $info[6]/1000; - if ($currsize < $filesize) { - my $extra = $filesize - $currsize; - if (($current_disk_usage + $extra) > $disk_quota) { - my $msg = ''. - &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', - ''.$fname.'',$filesize,$currsize).''. - '
    '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', - $disk_quota,$current_disk_usage); - return ('will_exceed_quota',$msg); + } + } else { + my @info = split(/\&/,$rest); + my $currsize = $info[6]/1000; + if ($currsize < $filesize) { + my $extra = $filesize - $currsize; + if (($current_disk_usage + $extra) > $disk_quota) { + my $msg = ''. + &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', + ''.$fname.'',$filesize,$currsize).''. + '
    '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', + $disk_quota,$current_disk_usage); + return ('will_exceed_quota',$msg); + } } } } @@ -9078,6 +10166,1269 @@ sub check_for_traversal { return $cleanpath; } +sub is_archive_file { + my ($mimetype) = @_; + if (($mimetype eq 'application/octet-stream') || + ($mimetype eq 'application/x-stuffit') || + ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) { + return 1; + } + return; +} + +sub decompress_form { + 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.', + 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 $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)}) { + 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; + } + } + 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". + ''; + if ($item->[2]) { + $duplicates .= ''; + } else { + $duplicates .= ''; + } + $duplicates .= ''. + ''. + &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(). + '

'. + ''. + ''. + ''. + ''. + &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"; +
+ + +$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}); + &Apache::lonnet::appenv({'cgi.dir' => $dir}); + my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl'); + my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$}); + my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'}; + &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1); + my $decompressed = $env{'cgi.decompressed'}; + &Apache::lonnet::delenv('cgi.file'); + &Apache::lonnet::delenv('cgi.dir'); + &Apache::lonnet::delenv('cgi.decompressed'); + return ($decompressed,$result); +} + +sub process_decompression { + my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; + my ($dir,$error,$warning,$output); + if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) { + $error = &mt('File name not a supported archive file type.'). + '
'.&mt('File name should end with one of: [_1].', + '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); + } else { + my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); + if ($docuhome eq 'no_host') { + $error = &mt('Could not determine home server for course.'); + } else { + my @ids=&Apache::lonnet::current_machine_ids(); + my $currdir = "$dir_root/$destination"; + if (grep(/^\Q$docuhome\E$/,@ids)) { + $dir = &LONCAPA::propath($docudom,$docuname). + "$dir_root/$destination"; + } else { + $dir = $Apache::lonnet::perlvar{'lonDocRoot'}. + "$dir_root/$docudom/$docuname/$destination"; + unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') { + $error = &mt('Archive file not found.'); + } + } + 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); + 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.'). + '

'."\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($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless (($item =~ /^\.+$/) || ($item eq $file) || + ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { + push(@newitems,$item); + if ($dirptr&$testdir) { + $is_dir{$item} = 1; + } + $changes{$item} = 1; + } + } + } + if (keys(%changes) > 0) { + foreach my $item (sort(@newitems)) { + if ($changes{$item}) { + push(@contents,$item); + } + } + } + if (@contents > 0) { + my $wantform; + unless ($env{'form.autoextract_camtasia'}) { + $wantform = 1; + } + my (%children,%parent,%dirorder,%titles); + my ($count,$datatable) = &get_extracted($docudom,$docuname, + $currdir,\%is_dir, + \%children,\%parent, + \@contents,\%dirorder, + \%titles,$wantform); + if ($datatable ne '') { + $output .= &archive_options_form('decompressed',$datatable, + $count,$hiddenelem); + 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.'); + } + } else { + $output = $display; + $error = &mt('An error occurred during extraction from the archive file.'); + } + } + } + } + if ($error) { + $output .= '

'.&mt('Not extracted.').'
'. + $error.'

'."\n"; + } + if ($warning) { + $output .= '

'.$warning.'

'."\n"; + } + return $output; +} + +sub get_extracted { + my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder, + $titles,$wantform) = @_; + my $count = 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($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, + $currdir,$depth,$count); + } + if ($is_dir->{$item}) { + $depth ++; + push(@hierarchy,$count); + $parent->{$depth} = $count; + $datatable .= + &recurse_extracted_archive("$currdir/$item",$docudom,$docuname, + \$depth,\$count,\@hierarchy,$dirorder, + $children,$parent,$titles,$wantform); + $depth --; + pop(@hierarchy); + } + } + return ($count,$datatable); +} + +sub recurse_extracted_archive { + my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder, + $children,$parent,$titles,$wantform) = @_; + my $result=''; + 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; + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1); + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + 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; + } + if ($wantform) { + $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count); + } + if ($is_dir) { + $$depth ++; + push(@{$hierarchy},$$count); + $parent->{$$depth} = $$count; + $result .= + &recurse_extracted_archive("$currdir/$item",$docudom, + $docuname,$depth,$count, + $hierarchy,$dirorder,$children, + $parent,$titles,$wantform); + $$depth --; + pop(@{$hierarchy}); + } + } + } + } + return $result; +} + +sub archive_hierarchy { + my ($depth,$count,$parent,$children) =@_; + if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) { + if (exists($parent->{$depth})) { + $children->{$parent->{$depth}} .= $count.':'; + } + } + return; +} + +sub archive_row { + my ($is_dir,$item,$currdir,$depth,$count) = @_; + my ($name) = ($item =~ m{([^/]+)$}); + my %choices = &Apache::lonlocal::texthash ( + 'display' => 'Add as file', + 'dependency' => 'Include as dependency', + 'discard' => 'Discard', + ); + if ($is_dir) { + $choices{'display'} = &mt('Add as folder'); + } + my $output = &start_data_table_row().''."\n"; + my $offset = 0; + foreach my $action ('display','dependency','discard') { + $offset ++; + if ($action ne 'display') { + $offset ++; + } + $output .= ''; + } + $output .= ''."\n". + &end_data_table_row(); + return $output; +} + +sub archive_options_form { + 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". + $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) * 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; + } + } + } + } + } +} + +numitems = $numitems +var titles = new Array(numitems); +var parents = new Array(numitems); +for (var i=0; i $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) { + 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 + return $scripttag; +} + +sub process_extracted_files { + my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; + my $numitems = $env{'form.archive_count'}; + return unless ($numitems); + my @ids=&Apache::lonnet::current_machine_ids(); + my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, + %folders,%containers,%mapinner,%prompttofetch); + my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); + if (grep(/^\Q$docuhome\E$/,@ids)) { + $prefix = &LONCAPA::propath($docudom,$docuname); + $pathtocheck = "$dir_root/$destination"; + $dir = $dir_root; + $ishome = 1; + } else { + $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; + $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; + $dir = "$dir_root/$docudom/$docuname"; + } + my $currdir = "$dir_root/$destination"; + (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); + if ($env{'form.folderpath'}) { + my @items = split('&',$env{'form.folderpath'}); + $folders{'0'} = $items[-2]; + $containers{'0'}='sequence'; + } elsif ($env{'form.pagepath'}) { + my @items = split('&',$env{'form.pagepath'}); + $folders{'0'} = $items[-2]; + $containers{'0'}='page'; + } + my @archdirs = &get_env_multiple('form.archive_directory'); + if ($numitems) { + for (my $i=1; $i<=$numitems; $i++) { + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) { + my $item = $1; + $toplevelitems{$item} = $i; + if (grep(/^\Q$i\E$/,@archdirs)) { + $is_dir{$item} = 1; + } + } + } + } + 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,%todeletedir,%newdest,%newseqid); + if ($numitems) { + for (my $i=1; $i<=$numitems; $i++) { + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ /^\Q$pathtocheck\E/) { + if ($env{'form.archive_'.$i} eq 'discard') { + if ($prefix ne '' && $path ne '') { + if (-e $prefix.$path) { + 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 ($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) { + foreach my $item (reverse(@{$dirorder{$i}})) { + if ($env{'form.archive_'.$item} eq 'display') { + $outer = $item; + last; + } + } + } + } + my ($errtext,$fatal) = + &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname. + '/'.$folders{$outer}.'.'. + $containers{$outer}); + next if ($fatal); + if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) { + if ($context eq 'coursedocs') { + $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]= + $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') { + my $newidx=&LONCAPA::map::getresidx(); + my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. + $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. + $title; + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); + } + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); + } + 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'; + 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') { + 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,$relpath); + 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]}; + $relpath .= '/'.$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]}; + $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); + } + } + } else { + last; + } + } + } + if ($fullpath ne '') { + 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; + } + } + } + } + } 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 { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + } + } + if (keys(%todelete)) { + foreach my $key (keys(%todelete)) { + unlink($key); + } + } + 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 { + $warning = &mt('No items found in archive.'); + } + if ($error) { + $output .= '

    '.&mt('Not extracted.').'
    '. + $error.'

    '."\n"; + } + if ($warning) { + $output .= '

    '.$warning.'

    '."\n"; + } + 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() + +Determines path in a user's portfolio file for storage of files uploaded +to a specific essayresponse or dropbox item. + +Inputs: 3 required + 1 optional. +$symb is symb for resource, $uname and $udom are for current user (required). +$caller is optional (can be "submission", if routine is called when storing +an upoaded file when "Submit Answer" button was pressed). + +Returns array containing $path and $multiresp. +$path is path in portfolio. $multiresp is 1 if this resource contains more +than one file upload item. Callers of routine should append partid as a +subdirectory to $path in cases where $multiresp is 1. + +Called by: homework/essayresponse.pm and homework/structuretags.pm + +=cut + +sub get_turnedin_filepath { + my ($symb,$uname,$udom,$caller) = @_; + my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb); + my $turnindir; + my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir'); + $turnindir = $userhash{'turnindir'}; + my ($path,$multiresp); + if ($turnindir eq '') { + if ($caller eq 'submission') { + $turnindir = &mt('turned in'); + $turnindir =~ s/\W+/_/g; + my %newhash = ( + 'turnindir' => $turnindir, + ); + &Apache::lonnet::put('environment',\%newhash,$udom,$uname); + } + } + if ($turnindir ne '') { + $path = '/'.$turnindir.'/'; + my ($multipart,$turnin,@pathitems); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (defined($navmap)) { + my $mapres = $navmap->getResourceByUrl($map); + if (ref($mapres)) { + my $pcslist = $mapres->map_hierarchy(); + if ($pcslist ne '') { + foreach my $pc (split(/,/,$pcslist)) { + my $res = $navmap->getByMapPc($pc); + if (ref($res)) { + my $title = $res->compTitle(); + $title =~ s/\W+/_/g; + if ($title ne '') { + push(@pathitems,$title); + } + } + } + } + my $maptitle = $mapres->compTitle(); + $maptitle =~ s/\W+/_/g; + if ($maptitle ne '') { + push(@pathitems,$maptitle); + } + unless ($env{'request.state'} eq 'construct') { + my $res = $navmap->getBySymb($symb); + if (ref($res)) { + my $partlist = $res->parts(); + my $totaluploads = 0; + if (ref($partlist) eq 'ARRAY') { + foreach my $part (@{$partlist}) { + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + if ($types[$i] eq 'essay') { + my $partid = $part.'_'.$ids[$i]; + if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') { + $totaluploads ++; + } + } + } + } + if ($totaluploads > 1) { + $multiresp = 1; + } + } + } + } + } else { + return; + } + } else { + return; + } + my $restitle=&Apache::lonnet::gettitle($symb); + $restitle =~ s/\W+/_/g; + if ($restitle eq '') { + $restitle = ($resurl =~ m{/[^/]+$}); + if ($restitle eq '') { + $restitle = time; + } + } + push(@pathitems,$restitle); + $path .= join('/',@pathitems); + } + return ($path,$multiresp); +} + =pod =back @@ -11116,7 +13467,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) { @@ -11154,7 +13505,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 @@ -11210,7 +13562,10 @@ sub init_user_environment { } my %is_adv = ( is_adv => $env{'user.adv'} ); - my %domdef = &Apache::lonnet::get_domain_defaults($domain); + my %domdef; + unless ($domain eq 'public') { + %domdef = &Apache::lonnet::get_domain_defaults($domain); + } foreach my $tool ('aboutme','blog','portfolio') { $userenv{'availabletools.'.$tool} = @@ -11226,12 +13581,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'}); } @@ -11267,7 +13628,9 @@ sub get_symb { my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); if ($symb eq '') { if (!$silent) { - $request->print("Unable to handle ambiguous references:$url:."); + if (ref($request)) { + $request->print("Unable to handle ambiguous references:$url:."); + } return (); } }
    '.$embed_file.''; + ' '. + ''.$embed_file.''; unless ($mapping{$embed_file} eq $embed_file) { $upload_output .= '
    '.&mt('changed from: [_1]',$mapping{$embed_file}).''; } $upload_output .= '
    '; - if ($args->{'ignore_remote_references'} - && $embed_file =~ m{^\w+://}) { + if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { $upload_output.=''.&mt("URL points to other server.").''; $numremref++; } elsif ($args->{'error_on_invalid_names'} @@ -8474,24 +9391,84 @@ sub ask_for_embedded_content { $upload_output.=''.&mt('Invalid characters').''; $numinvalid++; } else { - $upload_output .= &embedded_file_element('upload_embedded',$num, + $upload_output .= &embedded_file_element('upload_embedded',$counter, $embed_file,\%mapping, - $allfiles,$codebase); - $num++; + $allfiles,$codebase,'upload'); + $counter ++; + $numnew ++; } $upload_output .= ''.$embed_file.''.&mt('Already exists').''. + ''. + ' '.$embed_file.''.$size.''.$mtime.''. + ''.$embed_file.''.&mt('Already exists').''. + ' '.$oldfile.''.$size.''.$mtime.''. + &embedded_file_element('upload_embedded',$delidx, + $oldfile,\%mapping,$allfiles, + $codebase,'delete').''.&mt('File').''.&mt('Size (KB)').''.&mt('Modified').''.&mt('Upload replacement?').''.&mt('File').''.&mt('Size (KB)').''.&mt('Modified').''.&mt('Delete?').''.$mapping{$embed_file}.''.$embed_file. &embedded_file_element('pathchange',$numpathchg,$embed_file, - \%mapping,$allfiles,$codebase). + \%mapping,$allfiles,$codebase,'change'). ''. + ' '. + ''.$item->[0].''.&mt('Directory').''.&mt('File').''.$item->[3].''. + &Apache::lonlocal::locallocaltime($item->[4]). + ''.&mt('Overwrite?').''.&mt('Name').''.&mt('Type').''.&mt('Size').''.&mt('Last modified').''.$count.''. + ''; + if ($action eq 'dependency') { + $output .= ''; + } elsif ($action eq 'display') { + $output .= ''; + } + $output .= '&').'" />'.(' ' x 2); + for (my $i=0; $i<$depth; $i++) { + $output .= ('' x2)."\n"; + } + if ($is_dir) { + $output .= ' '."\n". + ''."\n"; + } else { + $output .= ''."\n"; + } + $output .= ' '.$name.'