--- loncom/interface/loncommon.pm 2006/11/20 21:00:47 1.471 +++ loncom/interface/loncommon.pm 2007/04/16 22:50:44 1.523 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.471 2006/11/20 21:00:47 banghart Exp $ +# $Id: loncommon.pm,v 1.523 2007/04/16 22:50:44 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,16 +59,21 @@ use Apache::lonnet; use GDBM_File; use POSIX qw(strftime mktime); use Apache::lonmenu(); +use Apache::lonenc(); use Apache::lonlocal; use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); use Apache::lontexconvert(); use Apache::lonclonecourse(); -use LONCAPA; +use LONCAPA qw(:DEFAULT :match); + +# ---------------------------------------------- Designs +use vars qw(%defaultdesign); my $readit; + ## ## Global Variables ## @@ -81,10 +86,6 @@ my %scprtag; my %fe; my %fd; my %fm; my %category_extensions; -# ---------------------------------------------- Designs - -my %designhash; - # ---------------------------------------------- Thesaurus variables # # %Keywords: @@ -150,30 +151,18 @@ BEGIN { } } -# -------------------------------------------------------------- domain designs - - my $filename; +# -------------------------------------------------------------- default domain designs my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; - opendir(DIR,$designdir); - while ($filename=readdir(DIR)) { - if ($filename!~/\.tab$/) { next; } - my ($domain)=($filename=~/^(\w+)\./); - { - my $designfile = $designdir.'/'.$filename; - if ( open (my $fh,"<$designfile") ) { - while (my $line = <$fh>) { - next if ($line =~ /^\#/); - chomp($line); - my ($key,$val)=(split(/\=/,$line)); - if ($val) { $designhash{$domain.'.'.$key}=$val; } - } - close($fh); - } - } - + my $designfile = $designdir.'/default.tab'; + if ( open (my $fh,"<$designfile") ) { + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\=/,$line)); + if ($val) { $defaultdesign{$key}=$val; } + } + close($fh); } - closedir(DIR); - # ------------------------------------------------------------- file categories { @@ -515,8 +504,8 @@ function setSect(sectionlist) { sub selectcourse_link { my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_; - return "".&mt('Select [_1]',$selecttype).""; + return "".&mt('Select Course').""; } sub check_uncheck_jscript { @@ -1264,37 +1253,13 @@ sub create_text_file { ## Home server list generating code ## ############################################################### -=pod - -=head1 Home Server option list generating code - -=over 4 - -=item * get_domains() - -Returns an array containing each of the domains listed in the hosts.tab -file. - -=cut - -#------------------------------------------- -sub get_domains { - # The code below was stolen from "The Perl Cookbook", p 102, 1st ed. - my @domains; - my %seen; - foreach my $dom (sort(values(%Apache::lonnet::hostdom))) { - push(@domains,$dom) unless $seen{$dom}++; - } - return @domains; -} - # ------------------------------------------ sub domain_select { my ($name,$value,$multiple)=@_; my %domains=map { - $_ => $_.' '.$Apache::lonnet::domaindescription{$_} - } &get_domains; + $_ => $_.' '. &Apache::lonnet::domain($_,'description') + } &Apache::lonnet::all_domains(); if ($multiple) { $domains{''}=&mt('Any domain'); return &multiple_select_form($name,$value,4,\%domains); @@ -1307,6 +1272,12 @@ sub domain_select { =pod +=head1 Routines for form select boxes + +=over 4 + +=cut + =item * multiple_select_form($name,$value,$size,$hash,$order) Returns a string containing a element int multiple mode @@ -1314,11 +1285,11 @@ Returns a string containing a e Args: $name - name of the element - $value - sclara or array ref of values that should already be selected + $value - scalar or array ref of values that should already be selected $size - number of rows long the select element is $hash - the elements should be 'option' => 'shown text' (shown text should already have been &mt()) - $order - (optional) array ref of the order to show the elments in + $order - (optional) array ref of the order to show the elements in =cut @@ -1334,8 +1305,16 @@ sub multiple_select_form { } } $output.="\n"; - my @order = ref($order) ? @$order - : sort(keys(%$hash)); + my @order; + if (ref($order) eq 'ARRAY') { + @order = @{$order}; + } else { + @order = sort(keys(%$hash)); + } + if (exists($$hash{'select_form_order'})) { + @order = @{$$hash{'select_form_order'}}; + } + foreach my $key (@order) { $output.='&').'" '; $output.='selected="selected" ' if ($selected{$key}); @@ -1377,6 +1356,24 @@ sub select_form { return $selectform; } +# For display filters + +sub display_filter { + if (!$env{'form.show'}) { $env{'form.show'}=10; } + if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; } + return ''.&mt('Records [_1]', + &Apache::lonmeta::selectbox('show',$env{'form.show'},undef, + (&mt('all'),10,20,50,100,1000,10000))). + ' '. + &mt('Filter [_1]', + &select_form($env{'form.displayfilter'}, + 'displayfilter', + ('currentfolder' => 'Current folder/page', + 'containing' => 'Containing phrase', + 'none' => 'None'))). + ''; +} + sub gradeleveldescription { my $gradelevel=shift; my %gradelevels=(0 => 'Not specified', @@ -1432,7 +1429,7 @@ selected"); #------------------------------------------- sub select_dom_form { my ($defdom,$name,$includeempty) = @_; - my @domains = get_domains(); + my @domains = sort(&Apache::lonnet::all_domains()); if ($includeempty) { @domains=('',@domains); } my $selectdomain = "\n"; foreach my $dom (@domains) { @@ -1448,30 +1445,6 @@ sub select_dom_form { =pod -=item * get_library_servers($domain) - -Returns a hash which contains keys like '103l3' and values like -'kirk.lite.msu.edu'. All of the keys will be for machines in the -given $domain. - -=cut - -#------------------------------------------- -sub get_library_servers { - my $domain = shift; - my %library_servers; - foreach my $hostid (keys(%Apache::lonnet::libserv)) { - if ($Apache::lonnet::hostdom{$hostid} eq $domain) { - $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid}; - } - } - return %library_servers; -} - -#------------------------------------------- - -=pod - =item * home_server_option_list($domain) returns a string which contains an list to be used in a @@ -1482,7 +1455,7 @@ returns a string which contains an '; + } else { + return ''; + } +} + =pod =back @@ -2455,19 +2441,21 @@ sub preferred_languages { if ($browser) { @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser)); } - if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) { + if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) { @languages=(@languages, - $Apache::lonnet::domain_lang_def{$env{'user.domain'}}); + &Apache::lonnet::domain($env{'user.domain'}, + 'lang_def')); } - if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) { + if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) { @languages=(@languages, - $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}); + &Apache::lonnet::domain($env{'request.role.domain'}, + 'lang_def')); } - if ($Apache::lonnet::domain_lang_def{ - $Apache::lonnet::perlvar{'lonDefDomain'}}) { + if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, + 'lang_def')) { @languages=(@languages, - $Apache::lonnet::domain_lang_def{ - $Apache::lonnet::perlvar{'lonDefDomain'}}); + &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, + 'lang_def')); } # turn "en-ca" into "en-ca,en" my @genlanguages; @@ -2672,7 +2660,9 @@ sub get_student_answers { } $moreenv{'grade_target'}='answer'; %moreenv=(%form,%moreenv); - my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv); + $feedurl = &Apache::lonnet::clutter($feedurl); + &Apache::lonenc::check_encrypt(\$feedurl); + my $userview=&Apache::lonnet::ssi($feedurl,%moreenv); return $userview; } @@ -2786,31 +2776,376 @@ sub maketime { ######################################### sub findallcourses { - my ($roles) = @_; + my ($roles,$uname,$udom) = @_; my %roles; if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; } my %courses; my $now=time; - foreach my $key (keys(%env)) { - if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) { - my ($role,$domain,$id) = ($1,$2,$3); - next if ($role eq 'ca' || $role eq 'aa'); - next if (%roles && !exists($roles{$role})); - my ($starttime,$endtime)=split(/\./,$env{$key}); - my $active=1; - if ($starttime) { - if ($now<$starttime) { $active=0; } + if (!defined($uname)) { + $uname = $env{'user.name'}; + } + if (!defined($udom)) { + $udom = $env{'user.domain'}; + } + if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { + my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname); + if (!%roles) { + %roles = ( + cc => 1, + in => 1, + ep => 1, + ta => 1, + cr => 1, + st => 1, + ); + } + foreach my $entry (keys(%roleshash)) { + my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry}); + if ($trole =~ /^cr/) { + next if (!exists($roles{$trole}) && !exists($roles{'cr'})); + } else { + next if (!exists($roles{$trole})); + } + if ($tend) { + next if ($tend < $now); + } + if ($tstart) { + next if ($tstart > $now); } - if ($endtime) { - if ($now>$endtime) { $active=0; } + my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec); + (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry); + if ($secpart eq '') { + ($cnum,$role) = split(/_/,$cnumpart); + $sec = 'none'; + $realsec = ''; + } else { + $cnum = $cnumpart; + ($sec,$role) = split(/_/,$secpart); + $realsec = $sec; + } + $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec; + } + } else { + foreach my $key (keys(%env)) { + if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} || + $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) { + my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4); + next if ($role eq 'ca' || $role eq 'aa'); + next if (%roles && !exists($roles{$role})); + my ($starttime,$endtime)=split(/\./,$env{$key}); + my $active=1; + if ($starttime) { + if ($now<$starttime) { $active=0; } + } + if ($endtime) { + if ($now>$endtime) { $active=0; } + } + if ($active) { + if ($sec eq '') { + $sec = 'none'; + } + $courses{$cdom.'_'.$cnum}{$sec} = + $role.'/'.$cdom.'/'.$cnum.'/'.$sec; + } } - if ($active) { $courses{$domain.'_'.$id}=1; } } } - return keys(%courses); + return %courses; } ############################################### + +sub blockcheck { + my ($setters,$activity,$uname,$udom) = @_; + + if (!defined($udom)) { + $udom = $env{'user.domain'}; + } + if (!defined($uname)) { + $uname = $env{'user.name'}; + } + + # 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 = 0; + my $endblock = 0; + my %live_courses = &findallcourses(undef,$uname,$udom); + + # If uname is for a user, and activity is course-specific, i.e., + # boards, chat or groups, check for blocking in current course only. + + if (($activity eq 'boards' || $activity eq 'chat' || + $activity eq 'groups') && ($env{'request.course.id'})) { + foreach my $key (keys(%live_courses)) { + if ($key ne $env{'request.course.id'}) { + delete($live_courses{$key}); + } + } + } + + my $otheruser = 0; + my %own_courses; + if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) { + # Resource belongs to user other than current user. + $otheruser = 1; + # Gather courses for current user + %own_courses = + &findallcourses(undef,$env{'user.name'},$env{'user.domain'}); + } + + # Gather active course roles - course coordinator, instructor, + # exam proctor, ta, student, or custom role. + + foreach my $course (keys(%live_courses)) { + my ($cdom,$cnum); + if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) { + $cdom = $env{'course.'.$course.'.domain'}; + $cnum = $env{'course.'.$course.'.num'}; + } else { + ($cdom,$cnum) = split(/_/,$course); + } + my $no_ownblock = 0; + my $no_userblock = 0; + if ($otheruser) { + # Check if current user has 'evb' priv for this + if (defined($own_courses{$course})) { + foreach my $sec (keys(%{$own_courses{$course}})) { + my $checkrole = 'cm./'.$cdom.'/'.$cnum; + if ($sec ne 'none') { + $checkrole .= '/'.$sec; + } + if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) { + $no_ownblock = 1; + last; + } + } + } + # if they have 'evb' priv and are currently not playing student + next if (($no_ownblock) && + ($env{'request.role'} !~ m{^st\./$cdom/$cnum})); + } + foreach my $sec (keys(%{$live_courses{$course}})) { + my $checkrole = 'cm./'.$cdom.'/'.$cnum; + if ($sec ne 'none') { + $checkrole .= '/'.$sec; + } + 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; + } + } + } else { + # Resource belongs to current user + # Check for 'evb' priv via lonnet::allowed(). + if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) { + $no_ownblock = 1; + last; + } + } + } + # if they have the evb priv and are currently not playing student + next if (($no_ownblock) && + ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E})); + next if ($no_userblock); + + # Retrieve blocking times and identity of blocker for course + # of specified user, unless user has 'evb' privilege. + + my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum); + if (($start != 0) && + (($startblock == 0) || ($startblock > $start))) { + $startblock = $start; + } + if (($end != 0) && + (($endblock == 0) || ($endblock < $end))) { + $endblock = $end; + } + } + return ($startblock,$endblock); +} + +sub get_blocks { + my ($setters,$activity,$cdom,$cnum) = @_; + my $startblock = 0; + my $endblock = 0; + 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; + } + if ( ($endblock == 0) || ($endblock < $end) ) { + $endblock = $end; + } + } + } + } + return ($startblock,$endblock); +} + +sub parse_block_record { + my ($record) = @_; + my ($setuname,$setudom,$title,$blocks); + if (ref($record) eq 'HASH') { + ($setuname,$setudom) = split(/:/,$record->{'setter'}); + $title = &unescape($record->{'event'}); + $blocks = $record->{'blocks'}; + } else { + my @data = split(/:/,$record,3); + if (scalar(@data) eq 2) { + $title = $data[1]; + ($setuname,$setudom) = split(/@/,$data[0]); + } else { + ($setuname,$setudom,$title) = @data; + } + $blocks = { 'com' => 'on' }; + } + return ($setuname,$setudom,$title,$blocks); +} + +sub build_block_table { + my ($startblock,$endblock,$setters) = @_; + my %lt = &Apache::lonlocal::texthash( + 'cacb' => 'Currently active communication blocks', + 'cour' => 'Course', + 'dura' => 'Duration', + 'blse' => 'Block set by' + ); + my $output; + $output = ''.$lt{'cacb'}.':'; + $output .= &start_data_table(); + $output .= ' + + '.$lt{'cour'}.' + '.$lt{'dura'}.' + '.$lt{'blse'}.' + +'; + foreach my $course (keys(%{$setters})) { + my %courseinfo=&Apache::lonnet::coursedescription($course); + for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) { + my ($uname,$udom) = @{$$setters{$course}{staff}[$i]}; + my $fullname = &plainname($uname,$udom); + if (defined($env{'user.name'}) && defined($env{'user.domain'}) + && $env{'user.name'} ne 'public' + && $env{'user.domain'} ne 'public') { + $fullname = &aboutmewrapper($fullname,$uname,$udom); + } + my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]}; + $openblock = &Apache::lonlocal::locallocaltime($openblock); + $closeblock= &Apache::lonlocal::locallocaltime($closeblock); + $output .= &Apache::loncommon::start_data_table_row(). + ''.$courseinfo{'description'}.''. + ''.$openblock.' to '.$closeblock.''. + ''.$fullname.''. + &Apache::loncommon::end_data_table_row(); + } + } + $output .= &end_data_table(); +} + +sub blocking_status { + my ($activity,$uname,$udom) = @_; + my %setters; + my ($blocked,$output,$ownitem,$is_course); + my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom); + if ($startblock && $endblock) { + $blocked = 1; + if (wantarray) { + my $category; + if ($activity eq 'boards') { + $category = 'Discussion posts in this course'; + } elsif ($activity eq 'blogs') { + $category = 'Blogs'; + } elsif ($activity eq 'port') { + if (defined($uname) && defined($udom)) { + if ($uname eq $env{'user.name'} && + $udom eq $env{'user.domain'}) { + $ownitem = 1; + } + } + $is_course = &Apache::lonnet::is_course($udom,$uname); + if ($ownitem) { + $category = 'Your portfolio files'; + } elsif ($is_course) { + my $coursedesc; + foreach my $course (keys(%setters)) { + my %courseinfo = + &Apache::lonnet::coursedescription($course); + $coursedesc = $courseinfo{'description'}; + } + $category = "Group files in the course '$coursedesc'"; + } else { + $category = 'Portfolio files belonging to '; + if ($env{'user.name'} eq 'public' && + $env{'user.domain'} eq 'public') { + $category .= &plainname($uname,$udom); + } else { + $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom); + } + } + } elsif ($activity eq 'groups') { + $category = 'Groups in this course'; + } + my $showstart = &Apache::lonlocal::locallocaltime($startblock); + my $showend = &Apache::lonlocal::locallocaltime($endblock); + $output = ''.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).''; + if (!($activity eq 'port' && !($ownitem) && !($is_course))) { + $output .= &build_block_table($startblock,$endblock,\%setters); + } + } + } + if (wantarray) { + return ($blocked,$output); + } else { + return $blocked; + } +} + ############################################### =pod @@ -2841,6 +3176,60 @@ sub determinedomain { return $domain; } ############################################### + +sub devalidate_domconfig_cache { + my ($udom)=@_; + &Apache::lonnet::devalidate_cache_new('domainconfig',$udom); +} + +# ---------------------- Get domain configuration for a domain +sub get_domainconf { + my ($udom) = @_; + my $cachetime=1800; + my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom); + if (defined($cached)) { return %{$result}; } + + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['login','rolecolors'],$udom); + my %designhash; + if (keys(%domconfig) > 0) { + if (ref($domconfig{'login'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'login'}})) { + $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; + } + } + if (ref($domconfig{'rolecolors'}) eq 'HASH') { + foreach my $role (keys(%{$domconfig{'rolecolors'}})) { + if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') { + foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) { + $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item}; + } + } + } + } + } else { + my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; + my $designfile = $designdir.'/'.$udom.'.tab'; + if (-e $designfile) { + if ( open (my $fh,"<$designfile") ) { + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\=/,$line)); + if ($val) { $designhash{$udom.'.'.$key}=$val; } + } + close($fh); + } + } + if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { + $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; + } + } + &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash, + $cachetime); + return %designhash; +} + =pod =item * &domainlogo() @@ -2854,13 +3243,17 @@ If the domain logo does not exist, a des ############################################### sub domainlogo { - my $domain = &determinedomain(shift); - # See if there is a logo - if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { - my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif"); - return ''; - } elsif(exists($Apache::lonnet::domaindescription{$domain})) { - return $Apache::lonnet::domaindescription{$domain}; + my $domain = &determinedomain(shift); + my %designhash = &get_domainconf($domain); + # See if there is a logo + if ($designhash{$domain.'.login.domlogo'} ne '') { + my $imgsrc = $designhash{$domain.'.login.domlogo'}; + if ($imgsrc =~ /^\/(adm|res)/) { + $imgsrc = &lonhttpdurl($imgsrc); + } + return ''; + } elsif (defined(&Apache::lonnet::domain($domain,'description'))) { + return &Apache::lonnet::domain($domain,'description'); } else { return ''; } @@ -2896,11 +3289,20 @@ sub designparm { return $env{'environment.color.'.$which}; } $domain=&determinedomain($domain); - if (exists($designhash{$domain.'.'.$which})) { - return $designhash{$domain.'.'.$which}; + my %domdesign = &get_domainconf($domain); + my $output; + if ($domdesign{$domain.'.'.$which} ne '') { + $output = $domdesign{$domain.'.'.$which}; } else { - return $designhash{'default.'.$which}; + $output = $defaultdesign{$which}; + } + if (($which =~ /^(student|coordinator|author|admin)\.img$/) || + ($which =~ /login\.(img|logo|domlogo)/)) { + if ($output =~ /^\/(adm|res)\//) { + $output = &lonhttpdurl($output); + } } + return $output; } ############################################### @@ -2983,8 +3385,8 @@ sub bodytag { # role and realm my ($role,$realm) = split(/\./,$env{'request.role'},2); if ($role eq 'ca') { - my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-); - $realm = &plainname($rname,$rdom).':'.$rdom; + my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); + $realm = &plainname($rname,$rdom); } # realm if ($env{'request.course.id'}) { @@ -3119,8 +3521,11 @@ ENDROLE # Top frame rendering, Remote is up # - my $upperleft=''; + my $imgsrc = $img; + if ($img =~ /^\/adm/) { + $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img; + } + my $upperleft=''; # Explicit link to get inline menu my $menu= ($no_inline_link?'' @@ -3280,16 +3685,26 @@ sub standard_css { my $mail_other = '#99BBBB'; my $mail_other_hover = '#669999'; my $table_header = '#DDDDDD'; + my $feedback_link_bg = '#BBBBBB'; my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px' : '0px 3px 0px 4px'; + return < if true will start with a rather than + dicsussion -> if true will get discussion from + lonxml::xmlend + (you can pass the target and parser arguments + through optional 'target' and 'parser' args + to this routine) =cut @@ -4550,7 +5095,7 @@ sub get_course_users { $usec = 'none'; } if ($uname ne '' && $udom ne '') { - if ($end < $now) { + if ($end > 0 && $end < $now) { $status = 'previous'; } elsif ($start > $now) { $status = 'future'; @@ -4612,6 +5157,96 @@ sub get_user_info { return; } +############################################### + +=pod + +=item * &get_user_quota() + +Retrieves quota assigned for storage of portfolio files for a user + +Incoming parameters: +1. user's username +2. user's domain + +Returns: +1. Disk quota (in Mb) assigned to student. + +If a value has been stored in the user's environment, +it will return that, otherwise it returns the default +for users in the domain. + +=cut + +############################################### + + +sub get_user_quota { + my ($uname,$udom) = @_; + my $quota; + if (!defined($udom)) { + $udom = $env{'user.domain'}; + } + if (!defined($uname)) { + $uname = $env{'user.name'}; + } + if (($udom eq '' || $uname eq '') || + ($udom eq 'public') && ($uname eq 'public')) { + $quota = 0; + } else { + if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) { + $quota = $env{'environment.portfolioquota'}; + } else { + my %userenv = &Apache::lonnet::dump('environment',$udom,$uname); + my ($tmp) = keys(%userenv); + if ($tmp !~ /^(con_lost|error|no_such_host)/i) { + $quota = $userenv{'portfolioquota'}; + } else { + undef(%userenv); + } + } + if ($quota eq '') { + $quota = &default_quota($udom); + } + } + return $quota; +} + +############################################### + +=pod + +=item * &default_quota() + +Retrieves default quota assigned for storage of user portfolio files + +Incoming parameters: +1. domain + +Returns: +1. Default disk quota (in Mb) for user portfolios in the domain. + +If a value has been stored in the domain's configuration db, +it will return that, otherwise it returns 20 (for backwards +compatibility with domains which have not set up a configuration +db file; the original statically defined portfolio quota was 20 Mb). + +=cut + +############################################### + + +sub default_quota { + my ($udom) = @_; + my %defaults = &Apache::lonnet::get_dom('configuration', + ['portfolioquota'],$udom); + if ($defaults{'portfolioquota'} ne '') { + return $defaults{'portfolioquota'}; + } else { + return '20'; + } +} + sub get_secgrprole_info { my ($cdom,$cnum,$needroles,$type) = @_; my %sections_count = &get_sections($cdom,$cnum); @@ -4900,7 +5535,12 @@ sub record_sep { $i++; } } else { - my @allfields=split(/\,/,$record); + my @allfields; + if ($env{'form.upfiletype'} eq 'semisv') { + @allfields=split(/;/,$record,-1); + } else { + @allfields=split(/\,/,$record,-1); + } my $i=0; my $j; for ($j=0;$j<=$#allfields;$j++) { @@ -4938,6 +5578,7 @@ the file type. sub upfile_select_html { my %Types = ( csv => &mt('CSV (comma separated values, spreadsheet)'), + semisv => &mt('Semicolon separated values'), space => &mt('Space separated'), tab => &mt('Tabulator separated'), # xml => &mt('HTML/XML'), @@ -5592,16 +6233,19 @@ Returns: both routines return nothing ####################################################### ####################################################### sub store_course_settings { + return &store_settings($env{'request.course.id'},@_); +} + +sub store_settings { # save to the environment # appenv the same items, just to be safe - my $courseid = $env{'request.course.id'}; my $udom = $env{'user.domain'}; my $uname = $env{'user.name'}; - my ($prefix,$Settings) = @_; + my ($context,$prefix,$Settings) = @_; my %SaveHash; my %AppHash; while (my ($setting,$type) = each(%$Settings)) { - my $basename = join('.','internal',$courseid,$prefix,$setting); + my $basename = join('.','internal',$context,$prefix,$setting); my $envname = 'environment.'.$basename; if (exists($env{'form.'.$setting})) { # Save this value away @@ -5641,11 +6285,14 @@ sub store_course_settings { } sub restore_course_settings { - my $courseid = $env{'request.course.id'}; - my ($prefix,$Settings) = @_; + return &restore_settings($env{'request.course.id'},@_); +} + +sub restore_settings { + my ($context,$prefix,$Settings) = @_; while (my ($setting,$type) = each(%$Settings)) { next if (exists($env{'form.'.$setting})); - my $envname = 'environment.internal.'.$courseid.'.'.$prefix. + my $envname = 'environment.internal.'.$context.'.'.$prefix. '.'.$setting; if (exists($env{$envname})) { if ($type eq 'scalar') { @@ -5777,7 +6424,7 @@ sub construct_course { # # Check if created correctly # - ($$crsudom,$$crsunum)=($$courseid=~/^\/(\w+)\/(\w+)$/); + ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); $outcome .= &mt('Created on').': '.$crsuhome.''; # @@ -5786,7 +6433,7 @@ sub construct_course { my $cloneid=''; if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; - my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/); + my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); if ($clonehome eq 'no_host') { $outcome .= @@ -5959,9 +6606,11 @@ sub construct_course { # if specified, key authority is not course, but user # only active if keyaccess is yes if ($args->{'keyauth'}) { - $args->{'keyauth'}=~s/[^\w\@]//g; - if ($args->{'keyauth'}) { - $cenv{'keyauth'}=$args->{'keyauth'}; + my ($user,$domain) = split(':',$args->{'keyauth'}); + $user = &LONCAPA::clean_username($user); + $domain = &LONCAPA::clean_username($domain); + if ($user ne '' && $domain ne '') { + $cenv{'keyauth'}=$user.':'.$domain; } } @@ -6058,7 +6707,7 @@ sub group_term { sub icon { my ($file)=@_; - my $curfext = (split(/\./,$file))[-1]; + my $curfext = lc((split(/\./,$file))[-1]); my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif'; my $embstyle = &Apache::loncommon::fileembstyle($curfext); if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {