--- loncom/interface/loncommon.pm 2007/10/26 00:22:36 1.595 +++ loncom/interface/loncommon.pm 2008/05/19 17:00:22 1.653 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.595 2007/10/26 00:22:36 albertel Exp $ +# $Id: loncommon.pm,v 1.653 2008/05/19 17:00:22 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -78,6 +78,76 @@ my $readit; ## Global Variables ## + +# ----------------------------------------------- SSI with retries: +# + +=pod + +=head1 Server Side include with retries: + +=over 4 + +=item * &ssi_with_retries(resource,retries form) + +Performs an ssi with some number of retries. Retries continue either +until the result is ok or until the retry count supplied by the +caller is exhausted. + +Inputs: + +=over 4 + +resource - Identifies the resource to insert. + +retries - Count of the number of retries allowed. + +form - Hash that identifies the rendering options. + +=back + +Returns: + +=over 4 + +content - The content of the response. If retries were exhausted this is empty. + +response - The response from the last attempt (which may or may not have been successful. + +=back + +=back + +=cut + +sub ssi_with_retries { + my ($resource, $retries, %form) = @_; + + + my $ok = 0; # True if we got a good response. + my $content; + my $response; + + # Try to get the ssi done. within the retries count: + + do { + ($content, $response) = &Apache::lonnet::ssi($resource, %form); + $ok = $response->is_success; + if (!$ok) { + &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message); + } + $retries--; + } while (!$ok && ($retries > 0)); + + if (!$ok) { + $content = ''; # On error return an empty content. + } + return ($content, $response); + +} + + + # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; @@ -214,14 +284,14 @@ BEGIN { =over 4 -=item * browser_and_searcher_javascript () +=item * &browser_and_searcher_javascript() XXReturns a string containing javascript with two functions, C and C. Returned string does not contain EscriptE tags. -=item * openbrowser(formname,elementname,only,omit) [javascript] +=item * &openbrowser(formname,elementname,only,omit) [javascript] inputs: formname, elementname, only, omit @@ -234,7 +304,7 @@ with the given extension. Can be a comm Specifying 'omit' will restrict the browser to NOT displaying files with the given extension. Can be a comma separated list. -=item * opensearcher(formname, elementname) [javascript] +=item * &opensearcher(formname,elementname) [javascript] Inputs: formname, elementname @@ -257,6 +327,7 @@ sub browser_and_searcher_javascript { } url += 'catalogmode=interactive&'; url += 'mode=$mode&'; + url += 'inhibitmenu=yes&'; url += 'form=' + formname + '&'; if (only != null) { url += 'only=' + only + '&'; @@ -318,7 +389,7 @@ sub storeresurl { unless ($resurl=~/^\/res/) { return 0; } $resurl=~s/\/$//; &Apache::lonnet::put('environment',{'lastresurl' => $resurl}); - &Apache::lonnet::appenv('environment.lastresurl' => $resurl); + &Apache::lonnet::appenv({'environment.lastresurl' => $resurl}); return 1; } @@ -367,7 +438,7 @@ sub selectstudent_link { return ''; } return "".&mt('Select User').""; + '","'.$udomele.'");'."'>".&mt('Select User').""; } if ($env{'request.role'}=~/^(au|dc|su)/) { return " +var stdeditbrowser; + +function openauthorbrowser(formname,udom) { + var url = '/adm/pickauthor?'; + url += 'form='+formname+'&roledom='+udom; + var title = 'Author_Browser'; + var options = 'scrollbars=1,resizable=1,menubar=0'; + options += ',width=700,height=600'; + stdeditbrowser = open(url,title,options,'1'); + stdeditbrowser.focus(); +} + + +ENDAUTHORBRW +} + sub coursebrowser_javascript { my ($domainfilter,$sec_element,$formname)=@_; my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); @@ -471,7 +561,10 @@ sub setsec_javascript { my ($sec_element,$formname) = @_; my $setsections = qq| function setSect(sectionlist) { - var sectionsArray = sectionlist.split(","); + var sectionsArray = new Array(); + if ((sectionlist != '') && (typeof sectionlist != "undefined")) { + sectionsArray = sectionlist.split(","); + } var numSections = sectionsArray.length; document.$formname.$sec_element.length = 0; if (numSections == 0) { @@ -510,6 +603,12 @@ sub selectcourse_link { '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course').""; } +sub selectauthor_link { + my ($form,$udom)=@_; + return ''. + &mt('Select Author').''; +} + sub check_uncheck_jscript { my $jscript = <<"ENDSCRT"; function checkAll(field) { @@ -538,13 +637,13 @@ ENDSCRT =pod -=item * linked_select_forms(...) +=item * &linked_select_forms(...) linked_select_forms returns a string containing a block and html for two \n"; - foreach my $value (sort(keys(%$hashref))) { + my @order = sort(keys(%{$hashref})); + if (ref($menuorder) eq 'ARRAY') { + @order = @{$menuorder}; + } + foreach my $value (@order) { $result.=" \n"; @@ -673,7 +785,12 @@ END $result .= $middletext; $result .= " element int multiple mode @@ -1457,7 +1573,7 @@ sub multiple_select_form { =pod -=item * select_form($defdom,$name,%hash) +=item * &select_form($defdom,$name,%hash) Returns a string containing a form to allow a user to select the domain to preform an operation in. @@ -1584,7 +1700,7 @@ sub select_dom_form { =pod -=item * home_server_form_item($domain,$name,$defaultflag) +=item * &home_server_form_item($domain,$name,$defaultflag) input: 4 arguments (two required, two optional) - $domain - domain of new user @@ -1744,14 +1860,12 @@ sub decode_user_agent { =over 4 -=item * authform_xxxxxx +=item * &authform_xxxxxx() The authform_xxxxxx subroutines provide javascript and html forms which handle some of the conveniences required for authentication forms. This is not an optimal method, but it works. -See loncreateuser.pm for invocation and use examples. - =over 4 =item * authform_header @@ -1768,7 +1882,7 @@ See loncreateuser.pm for invocation and =back -=back +See loncreateuser.pm for invocation and use examples. =cut @@ -1923,6 +2037,11 @@ sub authform_kerberos { if (defined($in{'curr_authtype'})) { if ($in{'curr_authtype'} eq 'krb') { $krbcheck = ' checked="on"'; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $krbcheck = ''; + } + } if (defined($in{'curr_kerb_ver'})) { if ($in{'curr_krb_ver'} eq '5') { $check5 = ' checked="on"'; @@ -2020,6 +2139,11 @@ sub authform_internal{ if ($in{'curr_authtype'} eq 'int') { if ($can_assign{'int'}) { $intcheck = 'checked="on" '; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $intcheck = ''; + } + } if (defined($in{'curr_autharg'})) { $intarg = $in{'curr_autharg'}; } @@ -2049,11 +2173,12 @@ sub authform_internal{ $authtype = ''; } - $autharg = ''; $result = &mt ('[_1] Internally authenticated (with initial password [_2])', ''.$autharg); + $result.="'; return $result; } @@ -2069,6 +2194,11 @@ sub authform_local{ if ($in{'curr_authtype'} eq 'loc') { if ($can_assign{'loc'}) { $loccheck = 'checked="on" '; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $loccheck = ''; + } + } if (defined($in{'curr_autharg'})) { $locarg = $in{'curr_autharg'}; } @@ -2118,6 +2248,11 @@ sub authform_filesystem{ if ($in{'curr_authtype'} eq 'fsys') { if ($can_assign{'fsys'}) { $fsyscheck = 'checked="on" '; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $fsyscheck = ''; + } + } } else { $result = &mt('Currently Filesystem Authenticated.'); return $result; @@ -2151,7 +2286,7 @@ sub authform_filesystem{ ('[_1] Filesystem Authenticated (with initial password [_2])', ''); return $result; } @@ -2199,42 +2334,6 @@ sub get_assignable_auth { } ############################################################### -## Get Authentication Defaults for Domain ## -############################################################### - -=pod - -=head1 Domains and Authentication - -Returns default authentication type and an associated argument as -listed in file 'domain.tab'. - -=over 4 - -=item * get_auth_defaults - -get_auth_defaults($target_domain) returns the default authentication -type and an associated argument (initial password or a kerberos domain). -These values are stored in lonTabs/domain.tab - -($def_auth, $def_arg) = &get_auth_defaults($target_domain); - -If target_domain is not found in domain.tab, returns nothing (''). - -=cut - -#------------------------------------------- -sub get_auth_defaults { - my $domain=shift; - return (&Apache::lonnet::domain($domain,'auth_def'), - &Apache::lonnet::domain($domain,'auth_arg_def')); - -} -############################################################### -## End Get Authentication Defaults for Domain ## -############################################################### - -############################################################### ## Get Kerberos Defaults for Domain ## ############################################################### ## @@ -2246,22 +2345,31 @@ sub get_auth_defaults { =pod -=item * get_kerberos_defaults +=item * &get_kerberos_defaults() get_kerberos_defaults($target_domain) returns the default kerberos -version and domain. If not found in domain.tabs, it defaults to -version 4 and the domain of the server. +version and domain. If not found, it defaults to version 4 and the +domain of the server. + +=over 4 ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); +=back + +=back + =cut #------------------------------------------- sub get_kerberos_defaults { my $domain=shift; - my ($krbdef,$krbdefdom) = - &Apache::loncommon::get_auth_defaults($domain); - unless ($krbdef =~/^krb/ && $krbdefdom) { + my ($krbdef,$krbdefdom); + my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); + if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) { + $krbdef = $domdefaults{'auth_def'}; + $krbdefdom = $domdefaults{'auth_arg_def'}; + } else { $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; my $krbdefdom=$1; $krbdefdom=~tr/a-z/A-Z/; @@ -2270,11 +2378,6 @@ sub get_kerberos_defaults { return ($krbdef,$krbdefdom); } -=pod - -=back - -=cut ############################################################### ## Thesaurus Functions ## @@ -2286,7 +2389,7 @@ sub get_kerberos_defaults { =over 4 -=item * initialize_keywords +=item * &initialize_keywords() Initializes the package variable %Keywords if it is empty. Uses the package variable $thesaurus_db_file. @@ -2331,7 +2434,7 @@ sub initialize_keywords { =pod -=item * keyword($word) +=item * &keyword($word) Returns true if $word is a keyword. A keyword is a word that appears more than the average number of times in the thesaurus database. Calls @@ -2352,7 +2455,7 @@ sub keyword { =pod -=item * get_related_words +=item * &get_related_words() Look up a word in the thesaurus. Takes a scalar argument and returns an array of words. If the keyword is not in the thesaurus, an empty array @@ -2410,7 +2513,7 @@ sub get_related_words { =over 4 -=item * plainname($uname,$udom,$first) +=item * &plainname($uname,$udom,$first) Takes a users logon name and returns it as a string in "first middle last generation" form @@ -2439,7 +2542,7 @@ sub plainname { # -------------------------------------------------------------------- Nickname =pod -=item * nickname($uname,$udom) +=item * &nickname($uname,$udom) Gets a users name and returns it as a string as @@ -2489,18 +2592,21 @@ sub getnames { } # -------------------------------------------------------------------- getemails + =pod -=item * getemails($uname,$udom) +=item * &getemails($uname,$udom) Gets a user's email information and returns it as a hash with keys: notification, critnotification, permanentemail For notification and critnotification, values are comma-separated lists -of e-mail address(es); for permanentemail, value is a single e-mail address. +of e-mail addresses; for permanentemail, value is a single e-mail address. + =cut + sub getemails { my ($uname,$udom)=@_; if ($udom eq 'public' && $uname eq 'public') { @@ -2535,7 +2641,7 @@ sub flush_email_cache { =pod -=item * screenname($uname,$udom) +=item * &screenname($uname,$udom) Gets a users screenname and returns it as a string @@ -2631,7 +2737,7 @@ sub student_image_tag { =over 4 -=item * languageids() +=item * &languageids() returns list of all language ids @@ -2643,7 +2749,7 @@ sub languageids { =pod -=item * languagedescription() +=item * &languagedescription() returns description of a specified language id @@ -2668,7 +2774,7 @@ sub supportedlanguagecode { =pod -=item * copyrightids() +=item * ©rightids() returns list of all copyrights @@ -2680,7 +2786,7 @@ sub copyrightids { =pod -=item * copyrightdescription() +=item * ©rightdescription() returns description of a specified copyright id @@ -2692,7 +2798,7 @@ sub copyrightdescription { =pod -=item * source_copyrightids() +=item * &source_copyrightids() returns list of all source copyrights @@ -2704,7 +2810,7 @@ sub source_copyrightids { =pod -=item * source_copyrightdescription() +=item * &source_copyrightdescription() returns description of a specified source copyright id @@ -2716,7 +2822,7 @@ sub source_copyrightdescription { =pod -=item * filecategories() +=item * &filecategories() returns list of all file categories @@ -2728,7 +2834,7 @@ sub filecategories { =pod -=item * filecategorytypes() +=item * &filecategorytypes() returns list of file types belonging to a given file category @@ -2742,7 +2848,7 @@ sub filecategorytypes { =pod -=item * fileembstyle() +=item * &fileembstyle() returns embedding style for a specified file type @@ -2766,7 +2872,7 @@ sub filecategoryselect { =pod -=item * filedescription() +=item * &filedescription() returns description for a specified file type @@ -2780,7 +2886,7 @@ sub filedescription { =pod -=item * filedescriptionex() +=item * &filedescriptionex() returns description for a specified file type with extra formatting @@ -2840,21 +2946,15 @@ sub preferred_languages { map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); push(@languages,@browser); } - if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) { - @languages=(@languages, - &Apache::lonnet::domain($env{'user.domain'}, - 'lang_def')); - } - if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) { - @languages=(@languages, - &Apache::lonnet::domain($env{'request.role.domain'}, - 'lang_def')); - } - if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, - 'lang_def')) { - @languages=(@languages, - &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, - 'lang_def')); + + foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'}, + $Apache::lonnet::perlvar{'lonDefDomain'}) { + if ($domtype ne '') { + my %domdefs = &Apache::lonnet::get_domain_defaults($domtype); + if ($domdefs{'lang_def'} ne '') { + push(@languages,$domdefs{'lang_def'}); + } + } } # turn "en-ca" into "en-ca,en" my @genlanguages; @@ -2904,7 +3004,7 @@ sub languages { =over 4 -=item * get_previous_attempt($symb, $username, $domain, $course, +=item * &get_previous_attempt($symb, $username, $domain, $course, $getattempt, $regexp, $gradesub) Return string with previous attempt on problem. Arguments: @@ -2948,14 +3048,14 @@ sub get_previous_attempt { $lasthash{$key}=$returnhash{$version.':'.$key}; } } - $prevattempts='
'; - $prevattempts.=''; + $prevattempts=&start_data_table().&start_data_table_header_row(); + $prevattempts.=''; foreach my $key (sort(keys(%lasthash))) { my ($ign,@parts) = split(/\./,$key); if ($#parts > 0) { my $data=$parts[-1]; pop(@parts); - $prevattempts.=''; + $prevattempts.=''; } else { if ($#parts == 0) { $prevattempts.=''; @@ -2964,28 +3064,37 @@ sub get_previous_attempt { } } } + $prevattempts.=&end_data_table_header_row(); if ($getattempt eq '') { for ($version=1;$version<=$returnhash{'version'};$version++) { - $prevattempts.=''; + $prevattempts.=&start_data_table_row(). + ''; foreach my $key (sort(keys(%lasthash))) { my $value = &format_previous_attempt_value($key, $returnhash{$version.':'.$key}); $prevattempts.=''; } + $prevattempts.=&end_data_table_row(); } } - $prevattempts.=''; + $prevattempts.=&start_data_table_row().''; foreach my $key (sort(keys(%lasthash))) { my $value = &format_previous_attempt_value($key,$lasthash{$key}); if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} $prevattempts.=''; } - $prevattempts.='
History'.&mt('History').'Part '.join('.',@parts).'
'.$data.' 
'.&mt('Part ').join('.',@parts).'
'.$data.' 
'.$parts[0].'
Transaction '.$version.''.&mt('Transaction [_1]',$version).''.$value.' 
Current'.&mt('Current').''.$value.' 
'; + $prevattempts.= &end_data_table_row().&end_data_table(); } else { - $prevattempts='Nothing submitted - no attempts.'; + $prevattempts= + &start_data_table().&start_data_table_row(). + ''.&mt('Nothing submitted - no attempts.').''. + &end_data_table_row().&end_data_table(); } } else { - $prevattempts='No data.'; + $prevattempts= + &start_data_table().&start_data_table_row(). + ''.&mt('No data.').''. + &end_data_table_row().&end_data_table(); } } @@ -3039,7 +3148,7 @@ sub relative_to_absolute { =pod -=item * get_student_view +=item * &get_student_view() show a snapshot of what student was looking at @@ -3058,7 +3167,7 @@ sub get_student_view { } if (defined($target)) { $form{'grade_target'} = $target; } $feedurl=&Apache::lonnet::clutter($feedurl); - my $userview=&Apache::lonnet::ssi_body($feedurl,%form); + my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form); $userview=~s/\]*\>//gi; $userview=~s/\<\/body\>//gi; $userview=~s/\//gi; @@ -3067,12 +3176,44 @@ sub get_student_view { $userview=~s/\<\/head\>//gi; $userview=~s/action\s*\=/would_be_action\=/gi; $userview=&relative_to_absolute($feedurl,$userview); - return $userview; + if (wantarray) { + return ($userview,$response); + } else { + return $userview; + } +} + +sub get_student_view_with_retries { + my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_; + + my $ok = 0; # True if we got a good response. + my $content; + my $response; + + # Try to get the student_view done. within the retries count: + + do { + ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv); + $ok = $response->is_success; + if (!$ok) { + &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message); + } + $retries--; + } while (!$ok && ($retries > 0)); + + if (!$ok) { + $content = ''; # On error return an empty content. + } + if (wantarray) { + return ($content, $response); + } else { + return $content; + } } =pod -=item * get_student_answers() +=item * &get_student_answers() show a snapshot of how student was answering problem @@ -3618,45 +3759,78 @@ sub get_domainconf { my %domconfig = &Apache::lonnet::get_dom('configuration', ['login','rolecolors'],$udom); - my %designhash; + my (%designhash,%legacy); if (keys(%domconfig) > 0) { if (ref($domconfig{'login'}) eq 'HASH') { - foreach my $key (keys(%{$domconfig{'login'}})) { - $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; + if (keys(%{$domconfig{'login'}})) { + foreach my $key (keys(%{$domconfig{'login'}})) { + $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; + } + } else { + $legacy{'login'} = 1; } + } else { + $legacy{'login'} = 1; } 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}; + if (keys(%{$domconfig{'rolecolors'}})) { + 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 { + $legacy{'rolecolors'} = 1; } + } else { + $legacy{'rolecolors'} = 1; } - } 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; } + if (keys(%legacy) > 0) { + my %legacyhash = &get_legacy_domconf($udom); + foreach my $item (keys(%legacyhash)) { + if ($item =~ /^\Q$udom\E\.login/) { + if ($legacy{'login'}) { + $designhash{$item} = $legacyhash{$item}; + } + } else { + if ($legacy{'rolecolors'}) { + $designhash{$item} = $legacyhash{$item}; + } } - close($fh); } } - if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { - $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; - } + } else { + %designhash = &get_legacy_domconf($udom); } &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash, $cachetime); return %designhash; } +sub get_legacy_domconf { + my ($udom) = @_; + my %legacyhash; + 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) { $legacyhash{$udom.'.'.$key}=$val; } + } + close($fh); + } + } + if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { + $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; + } + return %legacyhash; +} + =pod =item * &domainlogo() @@ -3706,10 +3880,10 @@ Returns: value of designparamter $which sub designparm { my ($which,$domain)=@_; if ($env{'browser.blackwhite'} eq 'on') { - if ($which=~/\.(font|alink|vlink|link)$/) { + if ($which=~/\.(font|alink|vlink|link|textcol)$/) { return '#000000'; } - if ($which=~/\.(pgbg|sidebg)$/) { + if ($which=~/\.(pgbg|sidebg|bgcol)$/) { return '#FFFFFF'; } if ($which=~/\.tabbg$/) { @@ -3728,7 +3902,7 @@ sub designparm { $output = $defaultdesign{$which}; } if (($which =~ /^(student|coordinator|author|admin)\.img$/) || - ($which =~ /login\.(img|logo|domlogo)/)) { + ($which =~ /login\.(img|logo|domlogo|login)/)) { if ($output =~ m{^/(adm|res)/}) { if ($output =~ m{^/res/}) { my $local_name = &Apache::lonnet::filelocation('',$output); @@ -3896,7 +4070,7 @@ ENDROLE $dc_info = '('.$dc_info.')'; } - if ($env{'environment.remote'} eq 'off') { + if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) { # No Remote if ($env{'request.state'} eq 'construct') { $forcereg=1; @@ -3919,9 +4093,9 @@ ENDROLE $lastitem = $thisdisfn; } $titleinfo = - &Apache::loncommon::help_open_menu('','',3,'Authoring'). - 'Construction Space: '. - '
' .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') @@ -4045,18 +4219,25 @@ sub make_attr_string { Returns a uniform footer for LON-CAPA web pages. -Inputs: none +Inputs: 1 - optional reference to an args hash +If in the hash, key for noredirectlink has a value which evaluates to true, +a 'Continue' link is not displayed if the page contains an +internal redirect in the section, +i.e., $env{'internal.head.redirect'} exists =cut sub endbodytag { + my ($args) = @_; my $endbodytag=''; $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; if ( exists( $env{'internal.head.redirect'} ) ) { - $endbodytag= - "
". - &mt('Continue').''. - $endbodytag; + if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { + $endbodytag= + "
". + &mt('Continue').''. + $endbodytag; + } } return $endbodytag; } @@ -4090,7 +4271,7 @@ sub standard_css { my $vlink = &designparm($function.'.vlink', $domain); my $link = &designparm($function.'.link', $domain); - my $sans = 'Arial,Helvetica,sans-serif'; + my $sans = 'Verdana,Arial,Helvetica,sans-serif'; my $mono = 'monospace'; my $data_table_head = $tabbg; my $data_table_light = '#EEEEEE'; @@ -4108,8 +4289,9 @@ sub standard_css { my $table_header = '#DDDDDD'; my $feedback_link_bg = '#BBBBBB'; - my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px' - : '0px 3px 0px 4px'; + my $border = ($env{'browser.type'} eq 'explorer' || + $env{'browser.type'} eq 'safari' ) ? '0px 2px 0px 2px' + : '0px 3px 0px 4px'; return < td, table.LC_aboutme_port tr td { background-color: $data_table_light; padding: 2px; } -table.LC_data_table tr.LC_even_row td, +table.LC_data_table tr.LC_even_row > td, table.LC_aboutme_port tr.LC_even_row td { background-color: $data_table_dark; } table.LC_data_table tr.LC_data_table_highlight td { background-color: $data_table_darker; } +table.LC_data_table tr td.LC_leftcol_header { + background-color: $data_table_head; + font-weight: bold; +} table.LC_data_table tr.LC_empty_row td, table.LC_nested tr.LC_empty_row td { background-color: #FFFFFF; @@ -4678,6 +4866,14 @@ table.LC_pick_box td.LC_pick_box_title { width: 184px; padding: 8px; } +table.LC_pick_box td.LC_selfenroll_pick_box_title { + background: $tabbg; + font-weight: bold; + text-align: right; + width: 350px; + padding: 8px; +} + table.LC_pick_box td.LC_pick_box_value { text-align: left; padding: 8px; @@ -4803,12 +4999,20 @@ table.LC_descriptive_input td.LC_descrip text-align: right; font-weight: bold; } -table.LC_feedback_link { - background: $feedback_link_bg; +div.LC_feedback_link { + clear: both; + background: white; + width: 100%; } span.LC_feedback_link { - background: $feedback_link_bg; - font-size: larger; + background: $feedback_link_bg; + font-size: larger; +} +span.LC_message_link { + background: $feedback_link_bg; + font-size: larger; + position: absolute; + right: 1em; } table.LC_prior_tries { @@ -4884,6 +5088,11 @@ span.LC_cusr_emph { font-style: italic; } +span.LC_cusr_subheading { + font-weight: normal; + font-size: 85%; +} + table.LC_docs_documents { background: #BBBBBB; border-width: 0px; @@ -4986,18 +5195,136 @@ span.LC_role_level { div.LC_left_float { float: left; padding-right: 5%; - padding:bottom: 4px; + padding-bottom: 4px; } div.LC_clear_float_header { - padding:bottom: 2px; + padding-bottom: 2px; } div.LC_clear_float_footer { - padding:top: 10px; + padding-top: 10px; clear: both; } + +div.LC_grade_select_mode { + font-family: $sans; +} +div.LC_grade_select_mode div div { + margin: 5px; +} +div.LC_grade_select_mode_selector { + margin: 5px; + float: left; +} +div.LC_grade_select_mode_selector_header { + font: bold medium $sans; +} +div.LC_grade_select_mode_type { + clear: left; +} + +div.LC_grade_show_user { + margin-top: 20px; + border: 1px solid black; +} +div.LC_grade_user_name { + background: #DDDDEE; + border-bottom: 1px solid black; + font: bold large $sans; +} +div.LC_grade_show_user_odd_row div.LC_grade_user_name { + background: #DDEEDD; +} + +div.LC_grade_show_problem, +div.LC_grade_submissions, +div.LC_grade_message_center, +div.LC_grade_info_links, +div.LC_grade_assign { + margin: 5px; + width: 99%; + background: #FFFFFF; +} +div.LC_grade_show_problem_header, +div.LC_grade_submissions_header, +div.LC_grade_message_center_header, +div.LC_grade_assign_header { + font: bold large $sans; +} +div.LC_grade_show_problem_problem, +div.LC_grade_submissions_body, +div.LC_grade_message_center_body, +div.LC_grade_assign_body { + border: 1px solid black; + width: 99%; + background: #FFFFFF; +} +span.LC_grade_check_note { + font: normal medium $sans; + display: inline; + position: absolute; + right: 1em; +} + +table.LC_scantron_action { + width: 100%; +} +table.LC_scantron_action tr th { + font: normal bold $sans; +} + +div.LC_edit_problem_header, +div.LC_edit_problem_footer { + font: normal medium $sans; + margin: 2px; +} +div.LC_edit_problem_header, +div.LC_edit_problem_header div, +div.LC_edit_problem_footer, +div.LC_edit_problem_footer div, +div.LC_edit_problem_editxml_header, +div.LC_edit_problem_editxml_header div { + margin-top: 5px; +} +div.LC_edit_problem_header_edit_row { + background: $tabbg; + padding: 3px; + margin-bottom: 5px; +} +div.LC_edit_problem_header_title { + font: larger bold $sans; + background: $tabbg; + padding: 3px; +} +table.LC_edit_problem_header_title { + font: larger bold $sans; + width: 100%; + border-color: $pgbg; + border-style: solid; + border-width: $border; + + background: $tabbg; + border-collapse: collapse; + padding: 0px +} + +div.LC_edit_problem_discards { + float: left; + padding-bottom: 5px; +} +div.LC_edit_problem_saves { + float: right; + padding-bottom: 5px; +} +hr.LC_edit_problem_divide { + clear: both; + color: $tabbg; + background-color: $tabbg; + height: 3px; + border: 0px; +} END } @@ -5091,10 +5418,7 @@ Inputs: none sub font_settings { my $headerstring=''; - if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) { - $headerstring.= - ''; - } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) { + if (!$env{'browser.mathml'} && $env{'browser.unicode'}) { $headerstring.= ''; } @@ -5153,8 +5477,15 @@ sub endheadtag { Returns a uniform complete .. section for LON-CAPA web pages. -Inputs: $title - optional title for the page - $head_extra - optional extra HTML to put inside the +Inputs: + +=over 4 + +$title - optional title for the page + +$head_extra - optional extra HTML to put inside the + +=back =cut @@ -5169,44 +5500,54 @@ sub head { Returns a complete .. section for LON-CAPA web pages. -Inputs: $title - optional title for the page - $head_extra - optional extra HTML to incude inside the - $args - additional optional args supported are: - only_body -> is true will set &bodytag() onlybodytag +Inputs: + +=over 4 + +$title - optional title for the page + +$head_extra - optional extra HTML to incude inside the + +$args - additional optional args supported are: + +=over 8 + + only_body -> is true will set &bodytag() onlybodytag arg on - no_nav_bar -> is true will set &bodytag() notopbar arg on - add_entries -> additional attributes to add to the - domain -> force to color decorate a page for a + no_nav_bar -> is true will set &bodytag() notopbar arg on + add_entries -> additional attributes to add to the + domain -> force to color decorate a page for a specific domain - function -> force usage of a specific rolish color + function -> force usage of a specific rolish color scheme - redirect -> see &headtag() - bgcolor -> override the default page bg color - js_ready -> return a string ready for being used in + redirect -> see &headtag() + bgcolor -> override the default page bg color + js_ready -> return a string ready for being used in a javascript writeln - html_encode -> return a string ready for being used in + html_encode -> return a string ready for being used in a html attribute - force_register -> if is true will turn on the &bodytag() + force_register -> if is true will turn on the &bodytag() $forcereg arg - body_title -> alternate text to use instead of $title + body_title -> alternate text to use instead of $title in the title box that appears, this text is not auto translated like the $title is - frameset -> if true will start with a + frameset -> if true will start with a rather than - no_title -> if true the title bar won't be shown - skip_phases -> hash ref of + no_title -> if true the title bar won't be shown + skip_phases -> hash ref of head -> skip the generation body -> skip all generation - - no_inline_link -> if true and in remote mode, don't show the + no_inline_link -> if true and in remote mode, don't show the 'Switch To Inline Menu' link - - no_auto_mt_title -> prevent &mt()ing the title arg - - inherit_jsmath -> when creating popup window in a page, + no_auto_mt_title -> prevent &mt()ing the title arg + inherit_jsmath -> when creating popup window in a page, should it have jsmath forced on by the current page +=back + +=back + =cut sub start_page { @@ -5293,7 +5634,7 @@ sub end_page { if ($args->{'frameset'}) { $result .= ''; } else { - $result .= &endbodytag(); + $result .= &endbodytag($args); } $result .= "\n"; @@ -5365,30 +5706,30 @@ sub simple_error_page { } { - my $row_count; + my @row_count; sub start_data_table { my ($add_class) = @_; my $css_class = (join(' ','LC_data_table',$add_class)); - undef($row_count); + unshift(@row_count,0); return ''."\n"; } sub end_data_table { - undef($row_count); + shift(@row_count); return '
'."\n";; } sub start_data_table_row { my ($add_class) = @_; - $row_count++; - my $css_class = ($row_count % 2)?'':'LC_even_row'; + $row_count[0]++; + my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row'; $css_class = (join(' ',$css_class,$add_class)); return ''."\n";; } sub continue_data_table_row { my ($add_class) = @_; - my $css_class = ($row_count % 2)?'':'LC_even_row'; + my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row'; $css_class = (join(' ',$css_class,$add_class)); return ''."\n";; } @@ -5398,7 +5739,7 @@ sub simple_error_page { } sub start_data_table_empty_row { - $row_count++; + $row_count[0]++; return ''."\n";; } @@ -5670,12 +6011,17 @@ previous, future, or all. 5. reference to array of section restrictions (optional) 6. reference to results object (hash of hashes). 7. reference to optional userdata hash -Keys of top level hash are roles. +8. reference to optional statushash +9. flag if privileged users (except those set to unhide in + course settings) should be excluded +Keys of top level results hash are roles. Keys of inner hashes are username:domain, with values set to access type. Optional userdata hash returns an array with arguments in the same order as loncoursedata::get_classlist() for student data. +Optional statushash returns + Entries for end, start, section and status are blank because of the possibility of multiple values for non-student roles. @@ -5684,7 +6030,7 @@ of the possibility of multiple values fo ############################################### sub get_course_users { - my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_; + my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_; my %idx = (); my %seclists; @@ -5704,6 +6050,7 @@ sub get_course_users { my $match = 0; my $secmatch = 0; my $section = $$classlist{$student}[$idx{section}]; + my $status = $$classlist{$student}[$idx{status}]; if ($section eq '') { $section = 'none'; } @@ -5723,7 +6070,6 @@ sub get_course_users { next; } } - push(@{$seclists{$student}},$section); if (defined($$types{'active'})) { if ($$classlist{$student}[$idx{status}] eq 'Active') { push(@{$$users{st}{$student}},'active'); @@ -5731,25 +6077,46 @@ sub get_course_users { } } if (defined($$types{'previous'})) { - if ($$classlist{$student}[$idx{end}] <= $now) { + if ($$classlist{$student}[$idx{status}] eq 'Expired') { push(@{$$users{st}{$student}},'previous'); $match = 1; } } if (defined($$types{'future'})) { - if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) { + if ($$classlist{$student}[$idx{status}] eq 'Future') { push(@{$$users{st}{$student}},'future'); $match = 1; } } - if ($match && ref($userdata) eq 'HASH') { - $$userdata{$student} = $$classlist{$student}; + if ($match) { + push(@{$seclists{$student}},$section); + if (ref($userdata) eq 'HASH') { + $$userdata{$student} = $$classlist{$student}; + } + if (ref($statushash) eq 'HASH') { + $statushash->{$student}{'st'}{$section} = $status; + } } } } if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) { my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); my $now = time; + my %displaystatus = ( previous => 'Expired', + active => 'Active', + future => 'Future', + ); + my %nothide; + if ($hidepriv) { + my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum); + foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { + if ($user !~ /:/) { + $nothide{join(':',split(/[\@]/,$user))}=1; + } else { + $nothide{$user} = 1; + } + } + } foreach my $person (sort(keys(%coursepersonnel))) { my $match = 0; my $secmatch = 0; @@ -5783,6 +6150,12 @@ sub get_course_users { $usec = 'none'; } if ($uname ne '' && $udom ne '') { + if ($hidepriv) { + if ((&Apache::lonnet::privileged($uname,$udom)) && + (!$nothide{$uname.':'.$udom})) { + next; + } + } if ($end > 0 && $end < $now) { $status = 'previous'; } elsif ($start > $now) { @@ -5805,6 +6178,9 @@ sub get_course_users { if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) { push(@{$seclists{$uname.':'.$udom}},$usec); } + if (ref($statushash) eq 'HASH') { + $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status}; + } } } } @@ -5814,15 +6190,25 @@ sub get_course_users { my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum); if ( defined($csettings{'internal.courseowner'}) ) { my $owner = $csettings{'internal.courseowner'}; - if ($owner !~ /^[^:]+:[^:]+$/) { - $owner = $owner.':'.$cdom; + next if ($owner eq ''); + my ($ownername,$ownerdom); + if ($owner =~ /^([^:]+):([^:]+)$/) { + $ownername = $1; + $ownerdom = $2; + } else { + $ownername = $owner; + $ownerdom = $cdom; + $owner = $ownername.':'.$ownerdom; } @{$$users{'ow'}{$owner}} = 'any'; if (defined($userdata) && - !exists($$userdata{$owner.':'.$cdom})) { - &get_user_info($cdom,$owner,\%idx,$userdata); - if (!grep(/^none$/,@{$seclists{$owner.':'.$cdom}})) { - push(@{$seclists{$owner.':'.$cdom}},'none'); + !exists($$userdata{$owner})) { + &get_user_info($ownerdom,$ownername,\%idx,$userdata); + if (!grep(/^none$/,@{$seclists{$owner}})) { + push(@{$seclists{$owner}},'none'); + } + if (ref($statushash) eq 'HASH') { + $statushash->{$owner}{'ow'}{'none'} = 'Any'; } } } @@ -5842,6 +6228,8 @@ sub get_user_info { &plainname($uname,$udom,'lastname'); $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; + my %idhash = &Apache::lonnet::idrget($udom,($uname)); + $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; return; } @@ -5962,24 +6350,24 @@ sub default_quota { my ($udom,$inststatus) = @_; my ($defquota,$settingstatus); my %quotahash = &Apache::lonnet::get_dom('configuration', - ['quota'],$udom); - if (ref($quotahash{'quota'}) eq 'HASH') { + ['quotas'],$udom); + if (ref($quotahash{'quotas'}) eq 'HASH') { if ($inststatus ne '') { my @statuses = split(/:/,$inststatus); foreach my $item (@statuses) { - if ($quotahash{'quota'}{$item} ne '') { + if ($quotahash{'quotas'}{$item} ne '') { if ($defquota eq '') { - $defquota = $quotahash{'quota'}{$item}; + $defquota = $quotahash{'quotas'}{$item}; $settingstatus = $item; - } elsif ($quotahash{'quota'}{$item} > $defquota) { - $defquota = $quotahash{'quota'}{$item}; + } elsif ($quotahash{'quotas'}{$item} > $defquota) { + $defquota = $quotahash{'quotas'}{$item}; $settingstatus = $item; } } } } if ($defquota eq '') { - $defquota = $quotahash{'quota'}{'default'}; + $defquota = $quotahash{'quotas'}{'default'}; $settingstatus = 'default'; } } else { @@ -6031,14 +6419,14 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser,$caller) = @_; + my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_; my $currdom = $dom; my %curr_selected = ( srchin => 'dom', srchby => 'lastname', ); my $srchterm; - if (ref($srch) eq 'HASH') { + if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) { if ($srch->{'srchby'} ne '') { $curr_selected{'srchby'} = $srch->{'srchby'}; } @@ -6125,7 +6513,16 @@ sub user_picker { 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'}) { - $new_user_create = '

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

'; + if ($cancreate) { + $new_user_create = '

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

'; + } else { + my $helplink = ' href="javascript:helpMenu('."'display'".')"'; + my %usertypetext = ( + official => 'institutional', + unofficial => 'non-institutional', + ); + $new_user_create = '
'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the helpdesk for assistance.',$helplink).'

'; + } } } @@ -6254,57 +6651,222 @@ END_BLOCK return $output; } -sub username_rule_check { - my ($srch,$caller) = @_; - my ($response,@curr_rules,%inst_results,$rulematch); - my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'}); - if (ref($srch) eq 'HASH') { - (my $inst_response,%inst_results) = - &Apache::lonnet::get_instuser($srch->{'srchdomain'}, - $srch->{'srchterm'}); - my %domconfig = &Apache::lonnet::get_dom('configuration', - ['usercreation'],$srch->{'srchdomain'}); - if (ref($domconfig{'usercreation'}) eq 'HASH') { - if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') { - @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}}; - } - } - if (@curr_rules > 0) { - my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description'); - my $instuser_reqd; - my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules); - foreach my $rule (@curr_rules) { - if ($rule_check{$rule}) { - $rulematch = $rule; - if ($inst_response eq 'ok') { - if (keys(%inst_results) == 0) { - if ($caller eq 'new') { - $response = &mt('The username you chose matches the format of usernames defined for [_1], but the user does not exist in the institutional directory.',$domdesc).'
'.&mt("You must choose a username with a different format -- one that will not conflict with 'official' institutional usernames."); - } +sub user_rule_check { + my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_; + my $response; + if (ref($usershash) eq 'HASH') { + foreach my $user (keys(%{$usershash})) { + my ($uname,$udom) = split(/:/,$user); + next if ($udom eq '' || $uname eq ''); + my ($id,$newuser); + if (ref($usershash->{$user}) eq 'HASH') { + $newuser = $usershash->{$user}->{'newuser'}; + $id = $usershash->{$user}->{'id'}; + } + my $inst_response; + if (ref($checks) eq 'HASH') { + if (defined($checks->{'username'})) { + ($inst_response,%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + } elsif (defined($checks->{'id'})) { + ($inst_response,%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,undef,$id); + } + } else { + ($inst_response,%{$inst_results->{$user}}) = + &Apache::lonnet::get_instuser($udom,$uname); + return; + } + if (!$got_rules->{$udom}) { + my %domconfig = &Apache::lonnet::get_dom('configuration', + ['usercreation'],$udom); + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $item ('username','id') { + if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') { + $$curr_rules{$udom}{$item} = + $domconfig{'usercreation'}{$item.'_rule'}; } } - last; } + $got_rules->{$udom} = 1; } - if ($response) { - if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) { - if (@{$ruleorder} > 0) { - $response .= '
'.&mt('Usernames with the following format(s) may only be used for verified users at [_1]:',$domdesc).'
    '; - foreach my $rule (@{$ruleorder}) { - if (grep(/^\Q$rule\E$/,@curr_rules)) { - if (ref($rules->{$rule}) eq 'HASH') { - $response .= '
  • '.$rules->{$rule}{'name'}.': '. - $rules->{$rule}{'desc'}.'
  • '; + foreach my $item (keys(%{$checks})) { + if (ref($$curr_rules{$udom}) eq 'HASH') { + if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') { + if (@{$$curr_rules{$udom}{$item}} > 0) { + my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item}); + foreach my $rule (@{$$curr_rules{$udom}{$item}}) { + if ($rule_check{$rule}) { + $$rulematch{$user}{$item} = $rule; + if ($inst_response eq 'ok') { + if (ref($inst_results) eq 'HASH') { + if (ref($inst_results->{$user}) eq 'HASH') { + if (keys(%{$inst_results->{$user}}) == 0) { + $$alerts{$item}{$udom}{$uname} = 1; + } + } + } + } + last; } } } } - $response .= '
'; } } } } - return ($response,$rulematch,$rules,%inst_results); + return; +} + +sub user_rule_formats { + my ($domain,$domdesc,$curr_rules,$check) = @_; + my %text = ( + 'username' => 'Usernames', + 'id' => 'IDs', + ); + my $output; + my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check); + if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) { + if (@{$ruleorder} > 0) { + $output = '
'.&mt("$text{$check} with the following format(s) may only be used for verified users at [_1]:",$domdesc).'
    '; + foreach my $rule (@{$ruleorder}) { + if (ref($curr_rules) eq 'ARRAY') { + if (grep(/^\Q$rule\E$/,@{$curr_rules})) { + if (ref($rules->{$rule}) eq 'HASH') { + $output .= '
  • '.$rules->{$rule}{'name'}.': '. + $rules->{$rule}{'desc'}.'
  • '; + } + } + } + } + $output .= '
'; + } + } + return $output; +} + +sub instrule_disallow_msg { + my ($checkitem,$domdesc,$count,$mode) = @_; + my $response; + my %text = ( + item => 'username', + items => 'usernames', + match => 'matches', + do => 'does', + action => 'a username', + one => 'one', + ); + if ($count > 1) { + $text{'item'} = 'usernames'; + $text{'match'} ='match'; + $text{'do'} = 'do'; + $text{'action'} = 'usernames', + $text{'one'} = 'ones'; + } + if ($checkitem eq 'id') { + $text{'items'} = 'IDs'; + $text{'item'} = 'ID'; + $text{'action'} = 'an ID'; + if ($count > 1) { + $text{'item'} = 'IDs'; + $text{'action'} = 'IDs'; + } + } + $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'
'; + if ($mode eq 'upload') { + if ($checkitem eq 'username') { + $response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}."); + } elsif ($checkitem eq 'id') { + $response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the ID/Student Number field."); + } + } else { + if ($checkitem eq 'username') { + $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}."); + } elsif ($checkitem eq 'id') { + $response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank."); + } + } + return $response; +} + +sub personal_data_fieldtitles { + my %fieldtitles = &Apache::lonlocal::texthash ( + id => 'Student/Employee ID', + permanentemail => 'E-mail address', + lastname => 'Last Name', + firstname => 'First Name', + middlename => 'Middle Name', + generation => 'Generation', + gen => 'Generation', + ); + return %fieldtitles; +} + +sub sorted_inst_types { + my ($dom) = @_; + my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); + my $othertitle = &mt('All users'); + if ($env{'request.course.id'}) { + $othertitle = 'any'; + } + my @types; + if (ref($order) eq 'ARRAY') { + @types = @{$order}; + } + if (@types == 0) { + if (ref($usertypes) eq 'HASH') { + @types = sort(keys(%{$usertypes})); + } + } + if (keys(%{$usertypes}) > 0) { + $othertitle = &mt('Other users'); + if ($env{'request.course.id'}) { + $othertitle = 'other'; + } + } + return ($othertitle,$usertypes,\@types); +} + +sub get_institutional_codes { + my ($settings,$allcourses,$LC_code) = @_; +# Get complete list of course sections to update + my @currsections = (); + my @currxlists = (); + my $coursecode = $$settings{'internal.coursecode'}; + + if ($$settings{'internal.sectionnums'} ne '') { + @currsections = split(/,/,$$settings{'internal.sectionnums'}); + } + + if ($$settings{'internal.crosslistings'} ne '') { + @currxlists = split(/,/,$$settings{'internal.crosslistings'}); + } + + if (@currxlists > 0) { + foreach (@currxlists) { + if (m/^([^:]+):(\w*)$/) { + unless (grep/^$1$/,@{$allcourses}) { + push @{$allcourses},$1; + $$LC_code{$1} = $2; + } + } + } + } + + if (@currsections > 0) { + foreach (@currsections) { + if (m/^(\w+):(\w*)$/) { + my $sec = $coursecode.$1; + my $lc_sec = $2; + unless (grep/^$sec$/,@{$allcourses}) { + push @{$allcourses},$sec; + $$LC_code{$sec} = $lc_sec; + } + } + } + } + return; } =pod @@ -6315,7 +6877,7 @@ sub username_rule_check { =over 4 -=item * get_unprocessed_cgi($query,$possible_names) +=item * &get_unprocessed_cgi($query,$possible_names) Modify the %env hash to contain unprocessed CGI form parameters held in $query. The parameters listed in $possible_names (an array reference), @@ -6344,7 +6906,7 @@ sub get_unprocessed_cgi { =pod -=item * cacheheader() +=item * &cacheheader() returns cache-controlling header code @@ -6361,7 +6923,7 @@ sub cacheheader { =pod -=item * no_cache($r) +=item * &no_cache($r) specifies header code to not have cache @@ -6397,7 +6959,7 @@ sub content_type { =pod -=item * add_to_env($name,$value) +=item * &add_to_env($name,$value) adds $name to the %env hash with value $value, if $name already exists, the entry is converted to an array @@ -6424,7 +6986,7 @@ sub add_to_env { =pod -=item * get_env_multiple($name) +=item * &get_env_multiple($name) gets $name from the %env hash, it seemlessly handles the cases where multiple values may be defined and end up as an array ref. @@ -6456,7 +7018,7 @@ sub get_env_multiple { =over 4 -=item * upfile_store($r) +=item * &upfile_store($r) Store uploaded file, $r should be the HTTP Request object, needs $env{'form.upfile'} @@ -6486,7 +7048,7 @@ sub upfile_store { =pod -=item * load_tmp_file($r) +=item * &load_tmp_file($r) Load uploaded file from tmp, $r should be the HTTP Request object, needs $env{'form.datatoken'}, @@ -6510,7 +7072,7 @@ sub load_tmp_file { =pod -=item * upfile_record_sep() +=item * &upfile_record_sep() Separate uploaded file into records returns array of records, @@ -6532,7 +7094,7 @@ sub upfile_record_sep { =pod -=item * record_sep($record) +=item * &record_sep($record) Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'} @@ -6617,7 +7179,7 @@ sub record_sep { =pod -=item * upfile_select_html() +=item * &upfile_select_html() Return HTML code to select a file from the users machine and specify the file type. @@ -6664,7 +7226,7 @@ sub get_samples { =pod -=item * csv_print_samples($r,$records) +=item * &csv_print_samples($r,$records) Prints a table of sample values from each column uploaded $r is an Apache Request ref, $records is an arrayref from @@ -6700,7 +7262,7 @@ sub csv_print_samples { =pod -=item * csv_print_select_table($r,$records,$d) +=item * &csv_print_select_table($r,$records,$d) Prints a table to create associations between values and table columns. @@ -6746,7 +7308,7 @@ sub csv_print_select_table { =pod -=item * csv_samples_select_table($r,$records,$d) +=item * &csv_samples_select_table($r,$records,$d) Prints a table of sample values from the upload and can make associate samples to internal names. @@ -6796,7 +7358,7 @@ sub csv_samples_select_table { =pod -=item clean_excel_name($name) +=item * &clean_excel_name($name) Returns a replacement for $name which does not contain any illegal characters. @@ -6815,7 +7377,7 @@ sub clean_excel_name { =pod -=item * check_if_partid_hidden($id,$symb,$udom,$uname) +=item * &check_if_partid_hidden($id,$symb,$udom,$uname) Returns either 1 or undef @@ -6856,7 +7418,7 @@ sub check_if_partid_hidden { =over 4 -=item get_cgi_id +=item * &get_cgi_id() Inputs: none @@ -6880,7 +7442,7 @@ sub get_cgi_id { =pod -=item DrawBarGraph +=item * &DrawBarGraph() Facilitates the plotting of data in a (stacked) bar graph. Puts plot definition data into the users environment in order for @@ -7015,7 +7577,7 @@ sub DrawBarGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7024,7 +7586,7 @@ sub DrawBarGraph { =pod -=item DrawXYGraph +=item * &DrawXYGraph() Facilitates the plotting of data in an XY graph. Puts plot definition data into the users environment in order for @@ -7105,7 +7667,7 @@ sub DrawXYGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7114,7 +7676,7 @@ sub DrawXYGraph { =pod -=item DrawXYYGraph +=item * &DrawXYYGraph() Facilitates the plotting of data in an XY graph with two Y axes. Puts plot definition data into the users environment in order for @@ -7207,7 +7769,7 @@ sub DrawXYYGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7224,7 +7786,7 @@ Bad place for them but what the hell. =over 4 -=item &chartlink +=item * &chartlink() Returns a link to the chart for a specific student. @@ -7263,9 +7825,9 @@ sub chartlink { =over 4 -=item &restore_course_settings +=item * &restore_course_settings() -=item &store_course_settings +=item * &store_course_settings() Restores/Store indicated form parameters from the course environment. Will not overwrite existing values of the form parameters. @@ -7285,6 +7847,8 @@ a hash ref describing the data to be sto Returns: both routines return nothing +=back + =cut ####################################################### @@ -7337,7 +7901,7 @@ sub store_settings { 'got error:'.$put_result); } # Make sure these settings stick around in this session, too - &Apache::lonnet::appenv(%AppHash); + &Apache::lonnet::appenv(\%AppHash); return; } @@ -7365,12 +7929,82 @@ sub restore_settings { } } +####################################################### +####################################################### + +=pod + +=head1 Domain E-mail Routines + +=over 4 + +=item * &build_recipient_list() + +Build recipient lists for three types of e-mail: +(a) Error Reports, (b) Package Updates, (c) Help requests, generated by +lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively. + +Inputs: +defmail (scalar - email address of default recipient), +mailing type (scalar - errormail, packagesmail, or helpdeskmail), +defdom (domain for which to retrieve configuration settings), +origmail (scalar - email address of recipient from loncapa.conf, +i.e., predates configuration by DC via domainprefs.pm + +Returns: comma separated list of addresses to which to send e-mail. + +=cut + +############################################################ +############################################################ +sub build_recipient_list { + my ($defmail,$mailing,$defdom,$origmail) = @_; + my @recipients; + my $otheremails; + my %domconfig = + &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); + if (ref($domconfig{'contacts'}) eq 'HASH') { + if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{$mailing}{$item}) { + my $addr = $domconfig{'contacts'}{$item}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; + } + } + } elsif ($origmail ne '') { + push(@recipients,$origmail); + } + if ($defmail ne '') { + push(@recipients,$defmail); + } + if ($otheremails) { + my @others; + if ($otheremails =~ /,/) { + @others = split(/,/,$otheremails); + } else { + push(@others,$otheremails); + } + foreach my $addr (@others) { + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + my $recipientlist = join(',',@recipients); + return $recipientlist; +} + ############################################################ ############################################################ sub commit_customrole { my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; - my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url. + my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). ($end?', ending '.localtime($end):'').': '. &Apache::lonnet::assigncustomrole( @@ -7391,8 +8025,8 @@ sub commit_standardrole { my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, $one,$two,$sec,$context); if (($result =~ /^error/) || ($result eq 'not_in_class') || - ($result eq 'unknown_course')) { - $output = "Error: $result\n"; + ($result eq 'unknown_course') || ($result eq 'refused')) { + $output = $logmsg.' '.&mt('Error: ').$result."\n"; } else { $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). @@ -7409,7 +8043,7 @@ sub commit_standardrole { $output = &mt('Assigning').' '.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). ($end?', '.&mt('ending').' '.localtime($end):'').': '; - my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start); + my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context); if ($context eq 'auto') { $output .= $result.$linefeed; } else { @@ -7421,7 +8055,7 @@ sub commit_standardrole { sub commit_studentrole { my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_; - my ($result,$linefeed); + my ($result,$linefeed,$oldsecurl,$newsecurl); if ($context eq 'auto') { $linefeed = "\n"; } else { @@ -7433,37 +8067,92 @@ sub commit_studentrole { my $secchange = 0; my $expire_role_result; my $modify_section_result; - unless ($oldsec eq '-1') { - unless ($sec eq $oldsec) { + if ($oldsec ne '-1') { + if ($oldsec ne $sec) { $secchange = 1; + my $now = time; my $uurl='/'.$cid; $uurl=~s/\_/\//g; if ($oldsec) { $uurl.='/'.$oldsec; } - $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time); + $oldsecurl = $uurl; + $expire_role_result = + &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context); + if ($env{'request.course.sec'} ne '') { + if ($expire_role_result eq 'refused') { + my @roles = ('st'); + my @statuses = ('previous'); + my @roledoms = ($one); + my $withsec = 1; + my %roleshash = + &Apache::lonnet::get_my_roles($uname,$udom,'userroles', + \@statuses,\@roles,\@roledoms,$withsec); + if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) { + my ($oldstart,$oldend) = + split(':',$roleshash{$two.':'.$one.':st:'.$oldsec}); + if ($oldend > 0 && $oldend <= $now) { + $expire_role_result = 'ok'; + } + } + } + } $result = $expire_role_result; } } if (($expire_role_result eq 'ok') || ($secchange == 0)) { - $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid); + $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context); if ($modify_section_result =~ /^ok/) { if ($secchange == 1) { - $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed; + if ($sec eq '') { + $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed; + } else { + $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed; + } } elsif ($oldsec eq '-1') { - $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed; + if ($sec eq '') { + $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed; + } else { + $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed; + } } else { - $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed; + if ($sec eq '') { + $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed; + } else { + $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed; + } } } else { - $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed; + if ($secchange) { + $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed; + } else { + $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed; + } } $result = $modify_section_result; } elsif ($secchange == 1) { - $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed; + if ($oldsec eq '') { + $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed; + } else { + $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed; + } + if ($expire_role_result eq 'refused') { + my $newsecurl = '/'.$cid; + $newsecurl =~ s/\_/\//g; + if ($sec ne '') { + $newsecurl.='/'.$sec; + } + if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) { + if ($sec eq '') { + $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed; + } else { + $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed; + } + } + } } } else { - $$logmsg .= "Incomplete course id defined. Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed"; + $$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed; $result = "error: incomplete course id\n"; } return $result; @@ -7575,19 +8264,26 @@ sub construct_course { $outcome .= $clonemsg.$linefeed; my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid); + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); # Restore URL $cenv{'url'}=$oldcenv{'url'}; # Restore title $cenv{'description'}=$oldcenv{'description'}; -# restore grading mode - if (defined($oldcenv{'grading'})) { - $cenv{'grading'}=$oldcenv{'grading'}; - } # Mark as cloned $cenv{'clonedfrom'}=$cloneid; - delete($cenv{'default_enrollment_start_date'}); - delete($cenv{'default_enrollment_end_date'}); +# Need to clone grading mode + my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum); + $cenv{'grading'}=$newenv{'grading'}; +# Do not clone these environment entries + &Apache::lonnet::del('environment', + ['default_enrollment_start_date', + 'default_enrollment_end_date', + 'question.email', + 'policy.email', + 'comment.email', + 'pch.users.denied', + 'plc.users.denied'], + $$crsudom,$$crsunum); } # @@ -7615,7 +8311,6 @@ sub construct_course { } else { $cenv{'internal.courseowner'} = $args->{'curruser'}; } - my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. if ($args->{'crssections'}) { $cenv{'internal.sectionnums'} = ''; @@ -7675,7 +8370,7 @@ sub construct_course { } if ($args->{'notify_dc'}) { if ($uname ne '') { - push(@notified,$uname.'@'.$udom); + push(@notified,$uname.':'.$udom); } } if (@notified > 0) {