--- loncom/interface/loncommon.pm 2010/12/30 19:35:28 1.991 +++ loncom/interface/loncommon.pm 2012/05/09 20:17:47 1.1075 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.991 2010/12/30 19:35:28 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075 2012/05/09 20:17:47 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); @@ -1893,19 +1981,112 @@ sub select_form { # For display filters sub display_filter { + my ($context) = @_; if (!$env{'form.show'}) { $env{'form.show'}=10; } if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; } - return ''.$link.''; + ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.''; } # ------------------------------------------------------------ Syllabus Wrapper @@ -3146,11 +3328,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 +3358,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 +3652,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 +3661,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 +3778,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 +3787,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 +3799,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 +4083,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 +4108,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 +4144,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 +4167,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 +4179,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 +4250,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 +4301,139 @@ sub blockcheck { # Retrieve blocking times and identity of locker for course # of specified user, unless user has 'evb' privilege. - my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum); + my ($start,$end,$trigger) = + &get_blocks($setters,$activity,$cdom,$cnum,$url); if (($start != 0) && (($startblock == 0) || ($startblock > $start))) { $startblock = $start; + if ($trigger ne '') { + $triggerblock = $trigger; + } } if (($end != 0) && (($endblock == 0) || ($endblock < $end))) { $endblock = $end; + if ($trigger ne '') { + $triggerblock = $trigger; + } } } - return ($startblock,$endblock); + return ($startblock,$endblock,$triggerblock); } sub get_blocks { - my ($setters,$activity,$cdom,$cnum) = @_; + my ($setters,$activity,$cdom,$cnum,$url) = @_; my $startblock = 0; my $endblock = 0; + my $triggerblock = ''; my $course = $cdom.'_'.$cnum; $setters->{$course} = {}; $setters->{$course}{'staff'} = []; $setters->{$course}{'times'} = []; - my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum); - foreach my $record (keys(%records)) { - my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/); - if ($start <= time && $end >= time) { - my ($staff_name,$staff_dom,$title,$blocks) = - &parse_block_record($records{$record}); - if ($blocks->{$activity} eq 'on') { - push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]); - push(@{$$setters{$course}{'times'}}, [$start,$end]); - if ( ($startblock == 0) || ($startblock > $start) ) { - $startblock = $start; + $setters->{$course}{'triggers'} = []; + my (@blockers,%triggered); + my $now = time; + my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); + if ($activity eq 'docs') { + @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks); + foreach my $block (@blockers) { + if ($block =~ /^firstaccess____(.+)$/) { + my $item = $1; + my $type = 'map'; + my $timersymb = $item; + if ($item eq 'course') { + $type = 'course'; + } elsif ($item =~ /___\d+___/) { + $type = 'resource'; + } else { + $timersymb = &Apache::lonnet::symbread($item); + } + my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb}; + my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; + $triggered{$block} = { + start => $start, + end => $end, + type => $type, + }; + } + } + } else { + foreach my $block (keys(%commblocks)) { + if ($block =~ m/^(\d+)____(\d+)$/) { + my ($start,$end) = ($1,$2); + if ($start <= time && $end >= time) { + if (ref($commblocks{$block}) eq 'HASH') { + if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { + if ($commblocks{$block}{'blocks'}{$activity} eq 'on') { + unless(grep(/^\Q$block\E$/,@blockers)) { + push(@blockers,$block); + } + } + } + } + } + } 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); } - if ( ($endblock == 0) || ($endblock < $end) ) { - $endblock = $end; + 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 +4457,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 +4511,7 @@ END_MYBLOCK END_BLOCK - return ($blocked, $output); + return ($blocked, $output); } ############################################### @@ -4272,8 +4621,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 +4630,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 +4713,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 +4771,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 +4799,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; } ############################################## @@ -4486,7 +4849,7 @@ Returns: HTML div with $content sub head_subbox { my ($content)=@_; my $output = - '
' + '
' .$content .'
' } @@ -4496,7 +4859,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 +4869,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 +4898,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 +5028,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 +5106,7 @@ sub bodytag { sub dc_courseid_toggle { my ($dc_info) = @_; return ' '. - '
'. + ''. &mt('(More ...)').''. '
'.$dc_info.'
'; } @@ -4838,7 +5211,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 +5251,6 @@ body { a:focus, a:focus img { color: red; - background: yellow; } form, .inline { @@ -4925,6 +5297,10 @@ form, .inline { text-decoration:none; } +.LC_setting { + text-decoration:underline; +} + .LC_error { color: red; font-size: larger; @@ -4969,35 +5345,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,14 +5466,16 @@ td.LC_table_cell_checkbox { overflow: hidden; margin: 0; padding: 0; + text-align: left; } -#LC_head_subbox { +.LC_head_subbox { clear:both; background: #F8F8F8; /* $sidebg; */ border: 1px solid $sidebg; margin: 0 0 10px 0; padding: 3px; + text-align: left; } .LC_fontsize_medium { @@ -5117,8 +5496,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 +5546,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 +5661,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 +5792,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 +6298,7 @@ div.LC_edit_problem_footer { font-weight: normal; font-size: medium; margin: 2px; + background-color: $sidebg; } div.LC_edit_problem_header, @@ -5953,6 +6315,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 +6353,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 +6426,7 @@ fieldset > legend { #LC_nav_bar { float: left; + background-color: $pgbg_or_bgcolor; margin: 0 0 2px 0; } @@ -6072,6 +6435,7 @@ fieldset > legend { padding: 0; font-weight: bold; text-align: center; + background-color: $pgbg_or_bgcolor; } #LC_nav_bar em { @@ -6082,6 +6446,7 @@ fieldset > legend { ol.LC_primary_menu { float: right; margin: 0; + background-color: $pgbg_or_bgcolor; } ol#LC_PathBreadcrumbs { @@ -6141,6 +6506,7 @@ ul#LC_secondary_menu { padding: 0; margin: 0; width: 100%; + text-align: left; } ul#LC_secondary_menu li { @@ -6157,7 +6523,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 +6546,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 +6586,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 +6646,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 +6696,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 +6841,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 +6909,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 +7008,8 @@ sub headtag { ''. &font_settings(); + my $inhibitprint = &print_suppression(); + if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); } @@ -6598,8 +7020,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 +7055,7 @@ ADDMETA if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } $result .= ' LON-CAPA '.$title.'' .'' + .$inhibitprint .$head_extra; return $result.''; } @@ -6642,6 +7081,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 +7239,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 +7310,6 @@ sub end_page { } $result .= &Apache::lonxml::xmlend($target,$parser); } - if ($args->{'frameset'}) { $result .= ''; } else { @@ -6834,6 +7328,287 @@ 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'; } + my $target_attr; + if (defined($target)) { + $target_attr = 'target="'.$target.'"'; + } + return <<"ENDLINK"; + + $linktext +ENDLINK +} + +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 +7616,7 @@ sub html_encode { return $result; } + sub js_ready { my ($result) = @_; @@ -6877,6 +7653,29 @@ sub validate_page { } } + +sub start_scrollbox { + my ($outerwidth,$width,$height,$id,$bgcolor)=@_; + unless ($outerwidth) { $outerwidth='520px'; } + unless ($width) { $width='500px'; } + unless ($height) { $height='200px'; } + my ($table_id,$div_id,$tdcol); + if ($id ne '') { + $table_id = " id='table_$id'"; + $div_id = " id='div_$id'"; + } + if ($bgcolor ne '') { + $tdcol = "background-color: $bgcolor;"; + } + return <<"END"; +
+END +} + +sub end_scrollbox { + return '
'; +} + sub simple_error_page { my ($r,$title,$msg) = @_; my $page = @@ -6904,10 +7703,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 +7837,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 +7895,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'; @@ -7676,7 +8478,7 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_; + my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_; my $currdom = $dom; my %curr_selected = ( srchin => 'dom', @@ -7767,10 +8569,15 @@ sub user_picker { $srchtypesel .= "\n \n"; my ($newuserscript,$new_user_create); - + my $context_dom = $env{'request.role.domain'}; + if ($context eq 'requestcrs') { + if ($env{'form.coursedom'} ne '') { + $context_dom = $env{'form.coursedom'}; + } + } if ($forcenewuser) { if (ref($srch) eq 'HASH') { - if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) { + if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) { if ($cancreate) { $new_user_create = '

&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" />

'; } else { @@ -7809,7 +8616,7 @@ function setSearch(createnew,callingForm } } for (var i=0; i{$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;} @@ -8186,9 +8998,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 @@ -8327,13 +9266,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'}) { @@ -8353,16 +9299,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(); @@ -8401,22 +9363,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; @@ -8427,22 +9411,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; } @@ -8452,15 +9468,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 ++; @@ -8497,15 +9583,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) { @@ -8533,13 +9641,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(). @@ -8548,14 +9656,14 @@ sub ask_for_embedded_content { ''. ''.&end_data_table_row(); } $numpathchg ++; $chgcount ++; } } - if ($num) { + if ($counter) { if ($numpathchg) { $output .= ''."\n"; @@ -8565,9 +9673,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); @@ -8575,15 +9684,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) = @_; @@ -8668,7 +9821,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; @@ -8712,12 +9864,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); } } @@ -8725,13 +9877,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]',''. @@ -8753,15 +9907,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 { @@ -8796,7 +9952,7 @@ sub modify_html_form { ''. &end_data_table_row(); - } + } } } else { $modifyform = $pathchgtable; @@ -8807,6 +9963,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". @@ -8835,24 +9994,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); @@ -8869,7 +10059,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; } @@ -8878,7 +10068,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 ++; } @@ -8886,13 +10076,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].', @@ -8919,7 +10110,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 { @@ -8947,14 +10142,14 @@ sub check_for_upload { &mt('Unable to upload [_1]. (size = [_2] bytes)', ''.$fname.'', $filesize).'
    '. - &mt('Either the file you uploaded 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; @@ -8962,48 +10157,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); + } } } } @@ -9073,6 +10270,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 @@ -11111,7 +13571,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) { @@ -11149,7 +13609,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 @@ -11205,7 +13666,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} = @@ -11221,12 +13685,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'}); } @@ -11262,7 +13732,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 (); } } 500 Internal Server Error

    Internal Server Error

    The server encountered an internal error or misconfiguration and was unable to complete your request.

    Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

    More information about this error may be available in the server error log.

    '.$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'} @@ -8469,24 +9495,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.'