--- loncom/interface/loncommon.pm 2002/06/25 17:09:38 1.41 +++ loncom/interface/loncommon.pm 2006/08/11 22:00:07 1.444 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.41 2002/06/25 17:09:38 ng Exp $ +# $Id: loncommon.pm,v 1.444 2006/08/11 22:00:07 albertel 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,158 +32,447 @@ # POD header: +=pod + =head1 NAME Apache::loncommon - pile of common routines =head1 SYNOPSIS -Referenced by other mod_perl Apache modules. +Common routines for manipulating connections, student answers, + domains, common Javascript fragments, etc. -Invocation: - &Apache::loncommon::SUBROUTINENAME(ARGUMENTS); +=head1 OVERVIEW -=head1 INTRODUCTION - -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: - - Makes a table out of the previous homework attempts - Inputs result_from_symbread, user, domain, course_id - Reads in non-network-related .tab files - -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. - -=head2 General Subroutines - -=over 4 - =cut # End of POD header package Apache::loncommon; use strict; -use Apache::lonnet(); -use POSIX qw(strftime); -use Apache::Constants qw(:common); -use Apache::lonmsg(); +use Apache::lonnet; +use GDBM_File; +use POSIX qw(strftime mktime); +use Apache::lonmenu(); +use Apache::lonlocal; +use HTML::Entities; +use Apache::lonhtmlcommon(); +use Apache::loncoursedata(); +use Apache::lontexconvert(); +use Apache::lonclonecourse(); +use LONCAPA; + my $readit; +## +## Global Variables +## + # ----------------------------------------------- Filetypes/Languages/Copyright my %language; +my %supported_language; my %cprtag; -my %fe; my %fd; +my %scprtag; +my %fe; my %fd; my %fm; my %category_extensions; -# -------------------------------------------------------------- Thesaurus data -my @therelated; -my @theword; -my @thecount; -my %theindex; -my $thetotalcount; -my $thefuzzy=2; -my $thethreshold=0.1/$thefuzzy; -my $theavecount; +# ---------------------------------------------- Designs -# ----------------------------------------------------------------------- BEGIN +my %designhash; -=pod - -=item BEGIN() - -Initialize values from language.tab, copyright.tab, filetypes.tab, -and filecategories.tab. +# ---------------------------------------------- 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. -=cut -# ----------------------------------------------------------------------- BEGIN +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)=(split(/\t/,$line)); + $language{$key}=$val.' - '.$enc; + if ($sup) { + $supported_language{$key}=$sup; + } + } + 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); + } + } + +# -------------------------------------------------------------- domain designs + + my $filename; + 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); } } + } + closedir(DIR); + + # ------------------------------------------------------------- file categories { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/filecategories.tab'); - if ($fh) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($extension,$category)=(split(/\s+/,$_,2)); - push @{$category_extensions{lc($category)}},$extension; - } - } + 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=&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 selectstudent_link { + my ($form,$unameele,$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').""; + } + if ($env{'request.role'}=~/^(au|dc|su)/) { + return "".&mt('Select User').""; + } + return ''; +} + +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) { + var url = '/adm/pickcourse?'; + var filter; + if (filter != null) { + if (filter != '') { + url += 'filter='+filter+'&'; + } + } + var domainfilter='$domainfilter'; + if (domainfilter != null) { + if (domainfilter != '') { + url += 'domainfilter='+domainfilter+'&'; + } + } + url += 'form=' + formname + '&cnumelement='+uname+ + '&cdomelement='+udom+ + '&cnameelement='+desc; + if (extra_element !=null && extra_element != '' && formname == 'rolechoice') { + url += '&roleelement='+extra_element; + if (domainfilter == null || domainfilter == '') { + url += '&domainfilter='+extra_element; + } + } + if (multflag !=null && multflag != '') { + url += '&multiple='+multflag; + } + if (crstype == 'Course/Group') { + if (formname == 'cu') { + crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; + if (crstype == "") { + alert("$crs_or_grp_alert"); + return; + } + } + } + if (crstype !=null && crstype != '') { + url += '&type='+crstype; + } + var title = 'Course_Browser'; + var options = 'scrollbars=1,resizable=1,menubar=0'; + options += ',width=700,height=600'; + stdeditbrowser = open(url,title,options,'1'); + stdeditbrowser.focus(); + } + +ENDSTDBRW } -# ============================================================= END BEGIN BLOCK -=item linked_select_forms(...) +sub selectcourse_link { + my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_; + return "".&mt('Select [_1]',$selecttype).""; +} + +sub check_uncheck_jscript { + my $jscript = <<"ENDSCRT"; +function checkAll(field) { + if (field.length > 0) { + for (i = 0; i < field.length; i++) { + field[i].checked = true ; + } + } else { + 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; +} + + +=pod + +=item * linked_select_forms(...) linked_select_forms returns a string containing a block and html for two tags +=item * $middletext, the text which appears between the tag +=item * $firstselectname, the name of the first tag +=item * $secondselectname, the name of the second element int multiple mode + + +Args: + $name - name of the "; + my @order = ref($order) ? @$order + : sort(keys(%$hash)); + foreach my $key (@order) { + $output.='\n"; + } + $output.="\n"; + return $output; +} + #------------------------------------------- -=item select_dom_form($defdom,$name) +=pod + +=item * select_form($defdom,$name,%hash) + +Returns a string containing a \n"; + my @keys; + if (exists($hash{'select_form_order'})) { + @keys=@{$hash{'select_form_order'}}; + } else { + @keys=sort(keys(%hash)); + } + foreach my $key (@keys) { + $selectform.= + '\n"; + } + $selectform.=""; + return $selectform; +} + +sub gradeleveldescription { + my $gradelevel=shift; + my %gradelevels=(0 => 'Not specified', + 1 => 'Grade 1', + 2 => 'Grade 2', + 3 => 'Grade 3', + 4 => 'Grade 4', + 5 => 'Grade 5', + 6 => 'Grade 6', + 7 => 'Grade 7', + 8 => 'Grade 8', + 9 => 'Grade 9', + 10 => 'Grade 10', + 11 => 'Grade 11', + 12 => 'Grade 12', + 13 => 'Grade 13', + 14 => '100 Level', + 15 => '200 Level', + 16 => '300 Level', + 17 => '400 Level', + 18 => 'Graduate Level'); + return &mt($gradelevels{$gradelevel}); +} + +sub select_level_form { + my ($deflevel,$name)=@_; + unless ($deflevel) { $deflevel=0; } + my $selectform = ""; + return $selectform; +} + +#------------------------------------------- + +=pod + +=item * select_dom_form($defdom,$name,$includeempty) Returns a string containing a \n"; - foreach (@domains) { - $selectdomain.="\n"; + foreach my $dom (@domains) { + $selectdomain.="\n"; } $selectdomain.=""; return $selectdomain; @@ -406,7 +1374,9 @@ sub select_dom_form { #------------------------------------------- -=item get_home_servers($domain) +=pod + +=item * get_library_servers($domain) Returns a hash which contains keys like '103l3' and values like 'kirk.lite.msu.edu'. All of the keys will be for machines in the @@ -415,20 +1385,22 @@ given $domain. =cut #------------------------------------------- -sub get_home_servers { +sub get_library_servers { my $domain = shift; - my %home_servers; - foreach (keys(%Apache::lonnet::libserv)) { - if ($Apache::lonnet::hostdom{$_} eq $domain) { - $home_servers{$_} = $Apache::lonnet::hostname{$_}; + 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 %home_servers; + return %library_servers; } #------------------------------------------- -=item home_server_option_list($domain) +=pod + +=item * home_server_option_list($domain) returns a string which contains an