--- loncom/interface/loncommon.pm 2002/06/25 16:31:51 1.40 +++ loncom/interface/loncommon.pm 2023/01/23 22:50:32 1.1075.2.161.2.15 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.40 2002/06/25 16:31:51 ng Exp $ +# $Id: loncommon.pm,v 1.1075.2.161.2.15 2023/01/23 22:50:32 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,14 +25,6 @@ # # http://www.lon-capa.org/ # -# YEAR=2001 -# 2/13-12/7 Guy Albertelli -# 12/11,12/12,12/17 Scott Harrison -# 12/21 Gerd Kortemeyer -# 12/21 Scott Harrison -# 12/25,12/28 Gerd Kortemeyer -# YEAR=2002 -# 1/4 Gerd Kortemeyer # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id @@ -40,236 +32,1111 @@ # POD header: +=pod + =head1 NAME Apache::loncommon - pile of common routines =head1 SYNOPSIS -Referenced by other mod_perl Apache modules. - -Invocation: - &Apache::loncommon::SUBROUTINENAME(ARGUMENTS); +Common routines for manipulating connections, student answers, + domains, common Javascript fragments, etc. -=head1 INTRODUCTION +=head1 OVERVIEW -Common collection of used subroutines. This collection helps remove +A collection of commonly used subroutines that don't have a natural +home anywhere else. This collection helps remove redundancy from other modules and increase efficiency of memory usage. -Current things done: +=cut + +# End of POD header +package Apache::loncommon; + +use strict; +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 Apache::lonclonecourse(); +use Apache::lonuserutils(); +use Apache::lonuserstate(); +use Apache::courseclassifier(); +use LONCAPA qw(:DEFAULT :match); +use LONCAPA::map(); +use HTTP::Request; +use DateTime::TimeZone; +use DateTime::Locale; +use Encode(); +use Authen::Captcha; +use Captcha::reCAPTCHA; +use JSON::DWIW; +use LWP::UserAgent; +use Crypt::DES; +use DynaLoader; # for Crypt::DES version +use File::Copy(); +use File::Path(); +use String::CRC32(); +use Short::URL(); - Makes a table out of the previous homework attempts - Inputs result_from_symbread, user, domain, course_id - Reads in non-network-related .tab files +# ---------------------------------------------- Designs +use vars qw(%defaultdesign); -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. +my $readit; -=head2 Subroutines + +## +## Global Variables +## + + +# ----------------------------------------------- SSI with retries: +# + +=pod + +=head1 Server Side include with retries: =over 4 -=cut +=item * &ssi_with_retries(resource,retries form) -# End of POD header -package Apache::loncommon; +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. -use strict; -use Apache::lonnet(); -use POSIX qw(strftime); -use Apache::Constants qw(:common); -use Apache::lonmsg(); +Inputs: -my $readit; +=over 4 -# ----------------------------------------------- Filetypes/Languages/Copyright -my %language; -my %cprtag; -my %fe; my %fd; -my %fc; +resource - Identifies the resource to insert. -# -------------------------------------------------------------- Thesaurus data -my @therelated; -my @theword; -my @thecount; -my %theindex; -my $thetotalcount; -my $thefuzzy=2; -my $thethreshold=0.1/$thefuzzy; -my $theavecount; +retries - Count of the number of retries allowed. -# ----------------------------------------------------------------------- BEGIN -=item BEGIN() +form - Hash that identifies the rendering options. -Initialize values from language.tab, copyright.tab, filetypes.tab, -and filecategories.tab. +=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 -# ----------------------------------------------------------------------- BEGIN -BEGIN { +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 %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; + +# ---------------------------------------------- Thesaurus variables +# +# %Keywords: +# A hash used by &keyword to determine if a word is considered a keyword. +# $thesaurus_db_file +# Scalar containing the full path to the thesaurus database. + +my %Keywords; +my $thesaurus_db_file; + +# +# Initialize values from language.tab, copyright.tab, filetypes.tab, +# thesaurus.tab, and filecategories.tab. +# +BEGIN { + # Variable initialization + $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; + # unless ($readit) { # ------------------------------------------------------------------- languages { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/language.tab'); - if ($fh) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - $language{$key}=$val; - } - } + my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. + '/language.tab'; + if ( open(my $fh,'<',$langtabfile) ) { + while (my $line = <$fh>) { + next if ($line=~/^\#/); + chomp($line); + my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); + $language{$key}=$val.' - '.$enc; + if ($sup) { + $supported_language{$key}=$sup; + } + if ($latex) { + $latex_language_bykey{$key} = $latex; + $latex_language{$two} = $latex; + } + } + close($fh); + } } # ------------------------------------------------------------------ copyrights { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}. - '/copyright.tab'); - if ($fh) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - $cprtag{$key}=$val; - } - } + my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. + '/copyright.tab'; + if ( open (my $fh,'<',$copyrightfile) ) { + while (my $line = <$fh>) { + next if ($line=~/^\#/); + chomp($line); + my ($key,$val)=(split(/\s+/,$line,2)); + $cprtag{$key}=$val; + } + close($fh); + } } +# ----------------------------------------------------------- source copyrights + { + my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. + '/source_copyright.tab'; + if ( open (my $fh,'<',$sourcecopyrightfile) ) { + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\s+/,$line,2)); + $scprtag{$key}=$val; + } + close($fh); + } + } + +# -------------------------------------------------------------- default domain designs + my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; + 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); + } + # ------------------------------------------------------------- file categories { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/filecategories.tab'); - if ($fh) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - push @{$fc{$key}},$val; - } - } + my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. + '/filecategories.tab'; + 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); + } + close($fh); + } + } # ------------------------------------------------------------------ file types { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/filetypes.tab'); - if ($fh) { - while (<$fh>) { - next if (/^\#/); - chomp; - my ($ending,$emb,$descr)=split(/\s+/,$_,3); - if ($descr ne '') { - $fe{$ending}=lc($emb); - $fd{$ending}=$descr; - } - } + my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. + '/filetypes.tab'; + if ( open (my $fh,'<',$typesfile) ) { + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4); + if ($descr ne '') { + $fe{$ending}=lc($emb); + $fd{$ending}=$descr; + if ($mime ne 'unk') { $fm{$ending}=$mime; } + } + } + close($fh); + } + } + &Apache::lonnet::logthis( + "INFO: Read file types"); + $readit=1; + } # end of unless($readit) + +} + +############################################################### +## HTML and Javascript Helper Functions ## +############################################################### + +=pod + +=head1 HTML and Javascript Functions + +=over 4 + +=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] + +inputs: formname, elementname, only, omit + +formname and elementname indicate the name of the html form and name of +the element that the results of the browsing selection are to be placed in. + +Specifying 'only' will restrict the browser to displaying only files +with the given extension. Can be a comma separated list. + +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] + +Inputs: formname, elementname + +formname and elementname specify the name of the html form and the name +of the element the selection from the search results will be placed in. + +=cut + +sub browser_and_searcher_javascript { + my ($mode)=@_; + if (!defined($mode)) { $mode='edit'; } + my $resurl=&escape_single(&lastresurl()); + return <new($Apache::lonnet::perlvar{'lonTabDir'}. - '/thesaurus.dat'); - if ($fh) { - while (<$fh>) { - my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_); - $theindex{$tword}=$tindex; - $theword[$tindex]=$tword; - $thecount[$tindex]=$tcount; - $thetotalcount+=$tcount; - $therelated[$tindex]=$trelated; + var editsearcher; + function opensearcher(formname,elementname,titleelement) { + var url = '/adm/searchcat?'; + if (editsearcher == null) { + url += 'launch=1&'; + } + url += 'catalogmode=interactive&'; + url += 'mode=$mode&'; + url += 'form=' + formname + '&'; + if (titleelement != null) { + url += 'titleelement=' + titleelement + '&'; + } else { + url += 'titleelement=&'; + } + url += 'element=' + elementname + ''; + var title = 'Search'; + var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1'; + options += ',width=700,height=600'; + editsearcher = open(url,title,options,'1'); + editsearcher.focus(); + } +// END LON-CAPA Internal --> +END +} + +sub lastresurl { + if ($env{'environment.lastresurl'}) { + return $env{'environment.lastresurl'} + } else { + return '/res'; + } +} + +sub storeresurl { + my $resurl=&Apache::lonnet::clutter(shift); + unless ($resurl=~/^\/res/) { return 0; } + $resurl=~s/\/$//; + &Apache::lonnet::put('environment',{'lastresurl' => $resurl}); + &Apache::lonnet::appenv({'environment.lastresurl' => $resurl}); + return 1; +} + +sub studentbrowser_javascript { + unless ( + (($env{'request.course.id'}) && + (&Apache::lonnet::allowed('srm',$env{'request.course.id'}) + || &Apache::lonnet::allowed('srm',$env{'request.course.id'}. + '/'.$env{'request.course.sec'}) + )) + || ($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,$courseadv,$clickerid)=@_; + my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". + &Apache::lonhtmlcommon::entity_encode($unameele)."','". + &Apache::lonhtmlcommon::entity_encode($udomele)."'"; + if ($env{'request.course.id'}) { + if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'}) + && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}. + '/'.$env{'request.course.sec'})) { + return ''; + } + $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; + if ($courseadv eq 'only') { + $callargs .= ",'',1,'$courseadv'"; + } elsif ($courseadv eq 'none') { + $callargs .= ",'','','$courseadv'"; + } elsif ($courseadv eq 'condition') { + $callargs .= ",'','','$courseadv'"; + } + return ''. + ''. + &mt('Select User').''; + } + if ($env{'request.role'}=~/^(au|dc|su)/) { + $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.''; } -# ============================================================= END BEGIN BLOCK -=item linked_select_forms(...) + + +sub authorbrowser_javascript { + return <<"ENDAUTHORBRW"; + +ENDAUTHORBRW +} + +sub coursebrowser_javascript { + 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 = ' +'; + 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's 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' + ."".$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 { + my $jscript = <<"ENDSCRT"; +function checkAll(field) { + if (field.length > 0) { + for (i = 0; i < field.length; i++) { + if (!field[i].disabled) { + field[i].checked = true; + } + } + } else { + if (!field.disabled) { + field.checked = true; + } + } +} + +function uncheckAll(field) { + if (field.length > 0) { + for (i = 0; i < field.length; i++) { + field[i].checked = false ; + } + } else { + field.checked = false ; + } +} +ENDSCRT + return $jscript; +} + +sub select_timezone { + my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_; + 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: =over 4 -=item $formname, the name of the
tag +=item * $formname, the name of the tag -=item $middletext, the text which appears between the tags -=item $firstdefault, the default value for the first menu +=item * $firstdefault, the default value for the first menu -=item $firstselectname, the name of the first tag -=item $secondselectname, the name of the second tag -=item $hashref, a reference to a hash containing the data for the menus. +=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 + +=back Below is an example of such a hash. Only the 'text', 'default', and 'select2' keys must appear as stated. keys(%menu) are the possible values for the first select menu. The text that coincides with the -first menu values is given in $menu{$choice1}->{'text'}. The values +first menu value is given in $menu{$choice1}->{'text'}. The values and text for the second menu are given in the hash pointed to by $menu{$choice1}->{'select2'}. my %menu = ( A1 => { text =>"Choice A1" , - default => "B3", - select2 => { - B1 => "Choice B1", - B2 => "Choice B2", - B3 => "Choice B3", - B4 => "Choice B4" - } - }, - A2 => { text =>"Choice A2" , - default => "C2", - select2 => { - C1 => "Choice C1", - C2 => "Choice C2", - C3 => "Choice C3" - } - }, - A3 => { text =>"Choice A3" , - default => "D6", - select2 => { - D1 => "Choice D1", - D2 => "Choice D2", - D3 => "Choice D3", - D4 => "Choice D4", - D5 => "Choice D5", - D6 => "Choice D6", - D7 => "Choice D7" - } - } - ); - -=back + default => "B3", + select2 => { + B1 => "Choice B1", + B2 => "Choice B2", + B3 => "Choice B3", + B4 => "Choice B4" + }, + order => ['B4','B3','B1','B2'], + }, + A2 => { text =>"Choice A2" , + default => "C2", + select2 => { + C1 => "Choice C1", + C2 => "Choice C2", + C3 => "Choice C3" + }, + order => ['C2','C1','C3'], + }, + A3 => { text =>"Choice A3" , + default => "D6", + select2 => { + D1 => "Choice D1", + D2 => "Choice D2", + D3 => "Choice D3", + D4 => "Choice D4", + D5 => "Choice D5", + D6 => "Choice D6", + D7 => "Choice D7" + }, + order => ['D4','D3','D2','D1','D7','D6','D5'], + } + ); =cut -# ------------------------------------------------ - sub linked_select_forms { my ($formname, $middletext, $firstdefault, $firstselectname, $secondselectname, - $hashref + $hashref, + $menuorder, + $onchangefirst, + $onchangesecond ) = @_; 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.="