--- loncom/interface/loncommon.pm 2002/07/01 15:24:44 1.42 +++ loncom/interface/loncommon.pm 2006/04/20 02:24:08 1.344 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.42 2002/07/01 15:24:44 matthew Exp $ +# $Id: loncommon.pm,v 1.344 2006/04/20 02:24:08 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,170 +32,204 @@ # 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: - - 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(); + my $readit; +## +## Global Variables +## + # ----------------------------------------------- Filetypes/Languages/Copyright my %language; +my %supported_language; my %cprtag; +my %scprtag; my %fe; my %fd; 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; - -# ----------------------------------------------------------------------- BEGIN - -=pod +# ---------------------------------------------- Designs -=item BEGIN() +my %designhash; -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 (<$fh>) { + next if /^\#/; + chomp; + my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_)); + $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 (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + $cprtag{$key}=$val; + } + close($fh); + } } -# ------------------------------------------------------------- file categories +# ------------------------------------------------------------------ source copyrights { - 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 $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. + '/source_copyright.tab'; + if ( open (my $fh,"<$sourcecopyrightfile") ) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,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 (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\=/,$_)); + if ($val) { $designhash{$domain.'.'.$key}=$val; } + } + close($fh); } } + } -# ------------------------------------------------------------------ file types + closedir(DIR); + + +# ------------------------------------------------------------- file categories { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/filetypes.tab'); - if ($fh) { + my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. + '/filecategories.tab'; + if ( open (my $fh,"<$categoryfile") ) { while (<$fh>) { - next if (/^\#/); - chomp; - my ($ending,$emb,$descr)=split(/\s+/,$_,3); - if ($descr ne '') { - $fe{$ending}=lc($emb); - $fd{$ending}=$descr; - } - } - } + next if /^\#/; + chomp; + my ($extension,$category)=(split(/\s+/,$_,2)); + push @{$category_extensions{lc($category)}},$extension; + } + close($fh); + } + } -# -------------------------------------------------------------- Thesaurus data +# ------------------------------------------------------------------ file types { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/thesaurus.dat'); - if ($fh) { + my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. + '/filetypes.tab'; + if ( open (my $fh,"<$typesfile") ) { while (<$fh>) { - my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_); - $theindex{$tword}=$tindex; - $theword[$tindex]=$tword; - $thecount[$tindex]=$tcount; - $thetotalcount+=$tcount; - $therelated[$tindex]=$trelated; - } + next if (/^\#/); + chomp; + my ($ending,$emb,$descr)=split(/\s+/,$_,3); + if ($descr ne '') { + $fe{$ending}=lc($emb); + $fd{$ending}=$descr; + } + } + close($fh); } - $theavecount=$thetotalcount/$#thecount; } &Apache::lonnet::logthis( - "INFO: Read file types and thesaurus"); + "INFO: Read file types"); $readit=1; -} + } # end of unless($readit) } -# ============================================================= END BEGIN BLOCK + ############################################################### ## HTML and Javascript Helper Functions ## ############################################################### =pod -=item browser_and_searcher_javascript - -Returns scalar containing javascript to open a browser window -or a searcher window. Also creates +=head1 HTML and Javascript Functions =over 4 -=item openbrowser(formname,elementname,only,omit) [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] inputs: formname, elementname, only, omit @@ -211,56 +237,71 @@ formname and elementname indicate the na 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 seperated list. +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 seperated list. +with the given extension. Can be a comma separated list. -=item opensearcher(formname, elementname) [javascript] +=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. -=back - =cut -############################################################### sub browser_and_searcher_javascript { + my ($mode)=@_; + if (!defined($mode)) { $mode='edit'; } + my $resurl=&lastresurl(); return < 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)=@_; + return (< + var stdeditbrowser; + function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) { + 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; + } + 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 +} + +sub selectcourse_link { + my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_; + return "".&mt('Select Course').""; +} + +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(...) +=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; +} + +#------------------------------------------- + +=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 (@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"; } $selectdomain.=""; @@ -492,7 +1315,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 @@ -501,20 +1326,22 @@ given $domain. =cut #------------------------------------------- -sub get_home_servers { +sub get_library_servers { my $domain = shift; - my %home_servers; + my %library_servers; foreach (keys(%Apache::lonnet::libserv)) { if ($Apache::lonnet::hostdom{$_} eq $domain) { - $home_servers{$_} = $Apache::lonnet::hostname{$_}; + $library_servers{$_} = $Apache::lonnet::hostname{$_}; } } - 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