--- loncom/interface/loncommon.pm 2006/06/26 22:31:56 1.401 +++ loncom/interface/loncommon.pm 2025/03/22 21:18:30 1.1474 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.401 2006/06/26 22:31:56 albertel Exp $ +# $Id: loncommon.pm,v 1.1474 2025/03/22 21:18:30 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,31 +59,129 @@ use Apache::lonnet; use GDBM_File; use POSIX qw(strftime mktime); use Apache::lonmenu(); +use Apache::lonenc(); use Apache::lonlocal; +use Apache::lonnavmaps(); use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); use Apache::lontexconvert(); -use LONCAPA; +use Apache::lonclonecourse(); +use Apache::lonuserutils(); +use Apache::lonuserstate(); +use Apache::courseclassifier(); +use LONCAPA qw(:DEFAULT :match); +use LONCAPA::ltiutils; +use LONCAPA::LWPReq; +use LONCAPA::map(); +use HTTP::Request; +use DateTime::TimeZone; +use DateTime::Locale; +use Encode(); +use Text::Aspell; +use Authen::Captcha; +use Captcha::reCAPTCHA; +use JSON::DWIW; +use Crypt::DES; +use DynaLoader; # for Crypt::DES version +use MIME::Lite; +use MIME::Types; +use File::Copy(); +use File::Path(); +use String::CRC32(); +use Short::URL(); + +# ---------------------------------------------- Designs +use vars qw(%defaultdesign); 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; +my %supported_codes; +my %latex_language; # For choosing hyphenation in +my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; my %scprtag; my %fe; my %fd; my %fm; my %category_extensions; -# ---------------------------------------------- Designs - -my %designhash; - # ---------------------------------------------- Thesaurus variables # # %Keywords: @@ -107,15 +205,20 @@ BEGIN { { my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/language.tab'; - if ( open(my $fh,"<$langtabfile") ) { + if ( open(my $fh,'<',$langtabfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); + my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; + $supported_codes{$key} = $code; } + if ($latex) { + $latex_language_bykey{$key} = $latex; + $latex_language{$code} = $latex; + } } close($fh); } @@ -124,7 +227,7 @@ BEGIN { { my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/copyright.tab'; - if ( open (my $fh,"<$copyrightfile") ) { + if ( open (my $fh,'<',$copyrightfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); @@ -138,7 +241,7 @@ BEGIN { { my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/source_copyright.tab'; - if ( open (my $fh,"<$sourcecopyrightfile") ) { + if ( open (my $fh,'<',$sourcecopyrightfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -149,41 +252,29 @@ 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 { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; - if ( open (my $fh,"<$categoryfile") ) { + if ( open (my $fh,'<',$categoryfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); my ($extension,$category)=(split(/\s+/,$line,2)); - push @{$category_extensions{lc($category)}},$extension; + push(@{$category_extensions{lc($category)}},$extension); } close($fh); } @@ -193,7 +284,7 @@ BEGIN { { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; - if ( open (my $fh,"<$typesfile") ) { + if ( open (my $fh,'<',$typesfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -208,7 +299,7 @@ BEGIN { } } &Apache::lonnet::logthis( - "INFO: Read file types"); + "INFO: Read file types"); $readit=1; } # end of unless($readit) @@ -224,14 +315,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 @@ -244,7 +335,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 @@ -256,7 +347,7 @@ of the element the selection from the se sub browser_and_searcher_javascript { my ($mode)=@_; if (!defined($mode)) { $mode='edit'; } - my $resurl=&lastresurl(); + my $resurl=&escape_single(&lastresurl()); return < $resurl}); - &Apache::lonnet::appenv('environment.lastresurl' => $resurl); + &Apache::lonnet::appenv({'environment.lastresurl' => $resurl}); return 1; } @@ -342,63 +434,150 @@ sub studentbrowser_javascript { || ($env{'request.role'}=~/^(au|dc|su)/) ) { return ''; } return (<<'ENDSTDBRW'); - ENDSTDBRW } +sub resourcebrowser_javascript { + unless ($env{'request.course.id'}) { return ''; } + return (<<'ENDRESBRW'); + +ENDRESBRW +} + sub selectstudent_link { - my ($form,$unameele,$udomele)=@_; + my ($form,$unameele,$udomele,$courseadv,$clickerid,$identelem)=@_; + my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". + &Apache::lonhtmlcommon::entity_encode($unameele)."','". + &Apache::lonhtmlcommon::entity_encode($udomele)."'"; if ($env{'request.course.id'}) { if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'}) && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}. '/'.$env{'request.course.sec'})) { return ''; } - return "".&mt('Select User').""; + $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; + if ($courseadv eq 'only') { + $callargs .= ",'',1,'$courseadv'"; + } elsif ($courseadv eq 'none') { + $callargs .= ",'','','$courseadv'"; + } elsif ($courseadv eq 'condition') { + $callargs .= ",'','','$courseadv'"; + } elsif ($identelem ne '') { + $callargs .= ",'','',''"; + } + if ($identelem ne '') { + $callargs .= ",'".&Apache::lonhtmlcommon::entity_encode($identelem)."'"; + } + return ''. + ''. + &mt('Select User').''; } if ($env{'request.role'}=~/^(au|dc|su)/) { - return "".&mt('Select User').""; + $callargs .= ",'',1"; + return ''. + ''. + &mt('Select User').''; } return ''; } +sub selectresource_link { + my ($form,$reslink,$arg)=@_; + + my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". + &Apache::lonhtmlcommon::entity_encode($reslink)."'"; + unless ($env{'request.course.id'}) { return $arg; } + return ''. + ''. + $arg.''; +} + + + +sub authorbrowser_javascript { + return <<"ENDAUTHORBRW"; + +ENDAUTHORBRW +} + sub coursebrowser_javascript { - my ($domainfilter)=@_; - 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'); - return (< - var stdeditbrowser; - function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) { + my ($domainfilter,$sec_element,$formname,$role_element,$crstype, + $credits_element,$instcode) = @_; + my $wintitle = 'Course_Browser'; + if ($crstype eq 'Community') { + $wintitle = 'Community_Browser'; + } + my $id_functions = &javascript_index_functions(); + my $output = ' + +$id_functions ENDSTDBRW + if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) { + $output .= &setsec_javascript($sec_element,$formname,$role_element, + $credits_element); + } + $output .= ' +// ]]> +'; + return $output; +} + +sub javascript_index_functions { + return <<"ENDJS"; + +function getFormIdByName(formname) { + for (var i=0;i -1) { + var domid = getIndexByName(formid,udom); + if (domid > -1) { + if (document.forms[formid].elements[domid].type == 'select-one') { + userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value; + } + if (document.forms[formid].elements[domid].type == 'hidden') { + userdom=document.forms[formid].elements[domid].value; + } + } + } + return userdom; +} + +ENDJS + +} + +sub javascript_array_indexof { + return < +// >> 0; + if (len === 0) { + return -1; + } + var n = 0; + if (arguments.length > 0) { + n = Number(arguments[1]); + if (n !== n) { // shortcut for verifying if it is NaN + n = 0; + } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { + n = (n > 0 || -1) * Math.floor(Math.abs(n)); + } + } + if (n >= len) { + return -1; + } + var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0); + for (; k < len; k++) { + if (k in t && t[k] === searchElement) { + return k; + } + } + return -1; + } +} + +// ]]> + + +ENDJS + +} + +sub userbrowser_javascript { + my $id_functions = &javascript_index_functions(); + return <<"ENDUSERBRW"; + +function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) { + var url = '/adm/pickuser?'; + var userdom = getDomainFromSelectbox(formname,udom); + if (userdom != null) { + if (userdom != '') { + url += 'srchdom='+userdom+'&'; + } + } + url += 'form=' + formname + '&unameelement='+uname+ + '&udomelement='+udom+ + '&ulastelement='+ulast+ + '&ufirstelement='+ufirst+ + '&uemailelement='+uemail+ + '&hideudomelement='+hideudom+ + '&coursedom='+crsdom; + if ((caller != null) && (caller != undefined)) { + url += '&caller='+caller; + } + var title = 'User_Browser'; + var options = 'scrollbars=1,resizable=1,menubar=0'; + options += ',width=700,height=600'; + var stdeditbrowser = open(url,title,options,'1'); + stdeditbrowser.focus(); +} + +function fix_domain (formname,udom,origdom,uname) { + var formid = getFormIdByName(formname); + if (formid > -1) { + var unameid = getIndexByName(formid,uname); + var domid = getIndexByName(formid,udom); + var hidedomid = getIndexByName(formid,origdom); + if (hidedomid > -1) { + var fixeddom = document.forms[formid].elements[hidedomid].value; + var unameval = document.forms[formid].elements[unameid].value; + if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) { + if (domid > -1) { + var slct = document.forms[formid].elements[domid]; + if (slct.type == 'select-one') { + var i; + for (i=0;i".&mt('Select [_1]',$selecttype).""; + my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype, + $typeelement) = @_; + my $type = $selecttype; + my $linktext = &mt('Select Course'); + if ($selecttype eq 'Community') { + $linktext = &mt('Select Community'); + } elsif ($selecttype eq 'Placement') { + $linktext = &mt('Select Placement Test'); + } elsif ($selecttype eq 'Course/Community') { + $linktext = &mt('Select Course/Community'); + $type = ''; + } elsif ($selecttype eq 'Select') { + $linktext = &mt('Select'); + $type = ''; + } + return '' + ."".$linktext.'' + .''; +} + +sub selectauthor_link { + my ($form,$udom)=@_; + return ''. + &mt('Select Author').''; +} + +sub selectuser_link { + my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem, + $coursedom,$linktext,$caller) = @_; + return ''.$linktext.''; } sub check_uncheck_jscript { @@ -449,10 +940,14 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - field[i].checked = true ; + if (!field[i].disabled) { + field[i].checked = true; + } } } else { - field.checked = true + if (!field.disabled) { + field.checked = true; + } } } @@ -460,7 +955,8 @@ function uncheckAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { field[i].checked = false ; - } } else { + } + } else { field.checked = false ; } } @@ -468,16 +964,135 @@ ENDSCRT return $jscript; } +sub select_timezone { + my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_; + my $labeltext = &HTML::Entities::encode(&mt('Select Time Zone')); + my $output=' menus. The select menus will be linked in that changing the value of the first menu will result in new values being placed in the second menu. The values in the select menu will appear in alphabetical -order. +order unless a defined order is provided. linked_select_forms takes the following ordered inputs: @@ -495,6 +1110,17 @@ linked_select_forms takes the following =item * $hashref, a reference to a hash containing the data for the menus. +=item * $menuorder, the order of values in the first menu + +=item * $onchangefirst, additional javascript call to execute for an onchange + event for the first tag + +=item * $suffix, to differentiate separate uses of select2data javascript + objects in a page. + =back Below is an example of such a hash. Only the 'text', 'default', and @@ -511,7 +1137,8 @@ $menu{$choice1}->{'select2'}. B2 => "Choice B2", B3 => "Choice B3", B4 => "Choice B4" - } + }, + order => ['B4','B3','B1','B2'], }, A2 => { text =>"Choice A2" , default => "C2", @@ -519,7 +1146,8 @@ $menu{$choice1}->{'select2'}. C1 => "Choice C1", C2 => "Choice C2", C3 => "Choice C3" - } + }, + order => ['C2','C1','C3'], }, A3 => { text =>"Choice A3" , default => "D6", @@ -531,7 +1159,8 @@ $menu{$choice1}->{'select2'}. D5 => "Choice D5", D6 => "Choice D6", D7 => "Choice D7" - } + }, + order => ['D4','D3','D2','D1','D7','D6','D5'], } ); @@ -543,46 +1172,53 @@ sub linked_select_forms { $firstdefault, $firstselectname, $secondselectname, - $hashref + $hashref, + $menuorder, + $onchangefirst, + $onchangesecond, + $suffix, + $haslabel ) = @_; my $second = "document.$formname.$secondselectname"; my $first = "document.$formname.$firstselectname"; # output the javascript to do the changing my $result = ''; - $result.=" END # output the initial values for the selection lists - $result .= "\n"; + my @order = sort(keys(%{$hashref})); + if (ref($menuorder) eq 'ARRAY') { + @order = @{$menuorder}; + } + foreach my $value (@order) { $result.=" \n"; } $result .= "\n"; - my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; - $result .= $middletext; - $result .= "{$firstdefault}->{'default'}; - foreach my $value (sort(keys(%select2))) { + + my @secondorder = sort(keys(%select2)); + if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') { + @secondorder = @{$hashref->{$firstdefault}->{'order'}}; + } + foreach my $value (@secondorder) { $result.=" \n"; } $selectform.=""; return $selectform; } +# For display filters + +sub display_filter { + my ($context) = @_; + if (!$env{'form.show'}) { $env{'form.show'}=10; } + if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; } + my $phraseinput = 'hidden'; + my $includeinput = 'hidden'; + my ($checked,$includetypestext); + if ($env{'form.displayfilter'} eq 'containing') { + $phraseinput = 'text'; + if ($context eq 'parmslog') { + $includeinput = 'checkbox'; + if ($env{'form.includetypes'}) { + $checked = ' checked="checked"'; + } + $includetypestext = &mt('Include parameter types'); + } + } else { + $includetypestext = ' '; + } + my ($additional,$secondid,$thirdid); + if ($context eq 'parmslog') { + $additional = + ''; + $secondid = 'includetypes'; + $thirdid = 'includetypestext'; + } + my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context', + '$secondid','$thirdid')"; + return ' '. + &mt('Filter: [_1]', + &select_form($env{'form.displayfilter'}, + 'displayfilter', + {'currentfolder' => 'Current folder/page', + 'containing' => 'Containing phrase', + 'none' => 'None'},$onchange)).' '. + ''.$additional; +} + +sub display_filter_js { + my $includetext = &mt('Include parameter types'); + return <<"ENDJS"; + +function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) { + var firstType = 'hidden'; + if (setter.options[setter.selectedIndex].value == 'containing') { + firstType = 'text'; + } + firstObject = document.getElementById(firstid); + if (typeof(firstObject) == 'object') { + if (firstObject.type != firstType) { + changeInputType(firstObject,firstType); + } + } + if (context == 'parmslog') { + var secondType = 'hidden'; + if (firstType == 'text') { + secondType = 'checkbox'; + } + secondObject = document.getElementById(secondid); + if (typeof(secondObject) == 'object') { + if (secondObject.type != secondType) { + changeInputType(secondObject,secondType); + } + } + var textItem = document.getElementById(thirdid); + var currtext = textItem.innerHTML; + var newtext; + if (firstType == 'text') { + newtext = '$includetext'; + } else { + newtext = ' '; + } + if (currtext != newtext) { + textItem.innerHTML = newtext; + } + } + return; +} + +function changeInputType(oldObject,newType) { + var newObject = document.createElement('input'); + newObject.type = newType; + if (oldObject.size) { + newObject.size = oldObject.size; + } + if (oldObject.value) { + newObject.value = oldObject.value; + } + if (oldObject.name) { + newObject.name = oldObject.name; + } + if (oldObject.id) { + newObject.id = oldObject.id; + } + oldObject.parentNode.replaceChild(newObject,oldObject); + return; +} + +ENDJS +} + sub gradeleveldescription { my $gradelevel=shift; my %gradelevels=(0 => 'Not specified', @@ -1287,9 +3077,12 @@ sub gradeleveldescription { } sub select_level_form { - my ($deflevel,$name)=@_; + my ($deflevel,$name,$id)=@_; + if ($id ne '') { + $id = ' id="'.$id.'"'; + } unless ($deflevel) { $deflevel=0; } - my $selectform = "\n"; for (my $i=0; $i<=18; $i++) { $selectform.="\n"; + ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom; + if ($showdomdesc) { + if ($dom ne '') { + my $domdesc = &Apache::lonnet::domain($dom,'description'); + if ($domdesc ne '') { + $selectdomain .= ' ('.$domdesc.')'; + } + } + } + $selectdomain .= "\n"; } $selectdomain.=""; return $selectdomain; @@ -1333,53 +3164,73 @@ sub select_dom_form { =pod -=item * get_library_servers($domain) +=item * &home_server_form_item($domain,$name,$defaultflag) -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. +input: 4 arguments (two required, two optional) - + $domain - domain of new user + $name - name of form element + $default - Value of 'default' causes a default item to be first + option, and selected by default. + $hide - Value of 'hide' causes hiding of the name of the server, + if 1 server found, or default, if 0 found. +output: returns 2 items: +(a) form element which contains either: + (i) + form item if there are multiple library servers in $domain, or + (ii) an form item + if there is only one library server in $domain. -=cut +(b) number of library servers found. -#------------------------------------------- -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 '."\n"; + } + foreach my $hostid (sort(keys(%servers))) { + $result.= '\n"; + } + $result .= ''."\n"; + } elsif ($numlib == 1) { + my $hostid; + foreach my $item (keys(%servers)) { + $hostid = $item; + } + $result .= ''; + if (!$hide) { + $result .= $hostid.' '.$servers{$hostid}; + } + $result .= "\n"; + } elsif ($default) { + $result .= ''; + if (!$hide) { + $result .= &mt('default'); + } + $result .= "\n"; } - return $result; + return ($result,$numlib); } =pod -=back +=back =cut @@ -1413,6 +3264,12 @@ Outputs: =item * $clientos +=item * $clientmobile + +=item * $clientinfo + +=item * $clientosversion + =back =back @@ -1431,8 +3288,10 @@ sub decode_user_agent { my $clientversion='0'; my $clientmathml=''; my $clientunicode='0'; + my $clientmobile=0; + my $clientosversion=''; for (my $i=0;$i<=$#browsertype;$i++) { - my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]); + my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]); if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) { $clientbrowser=$bname; $httpbrowser=~/$vreg/i; @@ -1442,6 +3301,7 @@ sub decode_user_agent { } } my $clientos='unknown'; + my $clientinfo; if (($httpbrowser=~/linux/i) || ($httpbrowser=~/unix/i) || ($httpbrowser=~/ux/i) || @@ -1451,10 +3311,24 @@ sub decode_user_agent { if ($httpbrowser=~/next/i) { $clientos='next'; } if (($httpbrowser=~/mac/i) || ($httpbrowser=~/powerpc/i)) { $clientos='mac'; } - if ($httpbrowser=~/win/i) { $clientos='win'; } + if ($httpbrowser=~/win/i) { + $clientos='win'; + if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) { + $clientosversion = $1; + } + } if ($httpbrowser=~/embed/i) { $clientos='pda'; } + if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) { + $clientmobile=lc($1); + } + if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) { + $clientinfo = 'firefox-'.$1; + } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) { + $clientinfo = 'chromeframe-'.$1; + } return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,); + $clientunicode,$clientos,$clientmobile,$clientinfo, + $clientosversion); } ############################################################### @@ -1473,14 +3347,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 @@ -1495,9 +3367,11 @@ See loncreateuser.pm for invocation and =item * authform_filesystem +=item * authform_lti + =back -=back +See loncreateuser.pm for invocation and use examples. =cut @@ -1527,19 +3401,16 @@ END } my $radioval = "'nochange'"; - if (exists($in{'curr_authtype'}) && - defined($in{'curr_authtype'}) && - $in{'curr_authtype'} ne '') { - $radioval = "'$in{'curr_authtype'}arg'"; + if (defined($in{'curr_authtype'})) { + if ($in{'curr_authtype'} ne '') { + $radioval = "'".$in{'curr_authtype'}."arg'"; + } } my $argfield = 'null'; - if ( grep/^mode$/,(keys %in) ) { + if (defined($in{'mode'})) { if ($in{'mode'} eq 'modifycourse') { - if ( grep/^curr_authtype$/,(keys %in) ) { - $radioval = "'$in{'curr_authtype'}'"; - } - if ( grep/^curr_autharg$/,(keys %in) ) { - unless ($in{'curr_autharg'} eq '') { + if (defined($in{'curr_autharg'})) { + if ($in{'curr_autharg'} ne '') { $argfield = "'$in{'curr_autharg'}'"; } } @@ -1591,12 +3462,16 @@ function changed_text(choice,currentform } function set_auth_radio_buttons(newvalue,currentform) { + var numauthchoices = currentform.login.length; + if (typeof numauthchoices == "undefined") { + return; + } var i=0; - while (i < currentform.login.length) { + while (i < numauthchoices) { if (currentform.login[i].value == newvalue) { break; } i++; } - if (i == currentform.login.length) { + if (i == numauthchoices) { return; } current.radiovalue = newvalue; @@ -1607,7 +3482,7 @@ END return $result; } -sub authform_authorwarning{ +sub authform_authorwarning { my $result=''; $result=''. &mt('As a general rule, only authors or co-authors should be '. @@ -1616,164 +3491,645 @@ sub authform_authorwarning{ return $result; } -sub authform_nochange{ +sub authform_nochange { my %in = ( formname => 'document.cu', kerb_def_dom => 'MSU.EDU', @_, ); - my $result = ''; + } return $result; } -sub authform_kerberos{ +sub authform_kerberos { my %in = ( formname => 'document.cu', kerb_def_dom => 'MSU.EDU', kerb_def_auth => 'krb4', @_, ); - my ($check4,$check5,$krbarg); + my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype, + $autharg,$jscall,$disabled); + my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); if ($in{'kerb_def_auth'} eq 'krb5') { - $check5 = " checked=\"on\""; + $check5 = ' checked="checked"'; } else { - $check4 = " checked=\"on\""; + $check4 = ' checked="checked"'; + } + if ($in{'readonly'}) { + $disabled = ' disabled="disabled"'; } $krbarg = $in{'kerb_def_dom'}; - - my $krbcheck = ""; - if ( grep/^curr_authtype$/,(keys %in) ) { - if ($in{'curr_authtype'} =~ m/^krb/) { - $krbcheck = " checked=\"on\""; - if ( grep/^curr_autharg$/,(keys %in) ) { + if (defined($in{'curr_authtype'})) { + if ($in{'curr_authtype'} eq 'krb') { + $krbcheck = ' checked="checked"'; + 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="checked"'; + $check4 = ''; + } else { + $check4 = ' checked="checked"'; + $check5 = ''; + } + } + if (defined($in{'curr_autharg'})) { $krbarg = $in{'curr_autharg'}; } + if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) { + if (defined($in{'curr_autharg'})) { + $result = + &mt('Currently Kerberos authenticated with domain [_1] Version [_2].', + $in{'curr_autharg'},$krbver); + } else { + $result = + &mt('Currently Kerberos authenticated, Version [_1].',$krbver); + } + return $result; + } + } + } else { + if ($authnum == 1) { + $authtype = ''; + } + } + if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) { + return; + } elsif ($authtype eq '') { + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifycourse') { + if ($authnum == 1) { + $authtype = ''; + } + } } } - - my $jscall = "javascript:changed_radio('krb',$in{'formname'});"; - my $result .= &mt + $jscall = "javascript:changed_radio('krb',$in{'formname'});"; + if ($authtype eq '') { + $authtype = ''; + } + if (($can_assign{'krb4'} && $can_assign{'krb5'}) || + ($can_assign{'krb4'} && !$can_assign{'krb5'} && + $in{'curr_authtype'} eq 'krb5') || + (!$can_assign{'krb4'} && $can_assign{'krb5'} && + $in{'curr_authtype'} eq 'krb4')) { + $result .= &mt ('[_1] Kerberos authenticated with domain [_2] '. '[_3] Version 4 [_4] Version 5 [_5]', - '