--- loncom/interface/loncommon.pm 2002/07/22 14:25:40 1.47 +++ loncom/interface/loncommon.pm 2006/05/01 20:48:55 1.359 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.47 2002/07/22 14:25:40 bowersj2 Exp $ +# $Id: loncommon.pm,v 1.359 2006/05/01 20:48:55 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,15 +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 -# 6/24,7/2 H. K. Ng # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id @@ -49,92 +40,63 @@ Apache::loncommon - pile of common routi =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 Apache::lonnet; use GDBM_File; -use POSIX qw(strftime); -use Apache::Constants qw(:common); -use Apache::lonmsg(); -my $readit; - -=pod +use POSIX qw(strftime mktime); +use Apache::lonmenu(); +use Apache::lonlocal; +use HTML::Entities; +use Apache::lonhtmlcommon(); +use Apache::loncoursedata(); +use Apache::lontexconvert(); -=item Global Variables +my $readit; -=over 4 +## +## Global Variables +## -=cut # ----------------------------------------------- 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 variables - -=pod - -=item %Keywords - -A hash used by &keyword to determine if a word is considered a keyword. - -=item $thesaurus_db_file +# ---------------------------------------------- Designs -Scalar containing the full path to the thesaurus database. +my %designhash; -=cut +# ---------------------------------------------- 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; - -=pod - -=back - -=cut - -# ----------------------------------------------------------------------- BEGIN - -=pod - -=item BEGIN() - -Initialize values from language.tab, copyright.tab, filetypes.tab, -thesaurus.tab, and filecategories.tab. - -=cut - -# ----------------------------------------------------------------------- BEGIN - +# +# 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"; @@ -142,58 +104,107 @@ BEGIN { 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"); @@ -201,21 +212,25 @@ BEGIN { } # 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 @@ -223,56 +238,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 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; @@ -552,7 +1320,7 @@ sub select_dom_form { =pod -=item get_home_servers($domain) +=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 @@ -561,22 +1329,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; } #------------------------------------------- =pod -=item home_server_option_list($domain) +=item * home_server_option_list($domain) returns a string which contains an