--- loncom/interface/loncommon.pm 2002/04/15 23:37:37 1.31
+++ loncom/interface/loncommon.pm 2003/06/24 22:16:32 1.107
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.31 2002/04/15 23:37:37 albertel Exp $
+# $Id: loncommon.pm,v 1.107 2003/06/24 22:16:32 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,46 +27,121 @@
#
# 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
# Reads in non-network-related .tab files
+# 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);
+
+=head1 INTRODUCTION
+
+Common collection of used subroutines. 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 GDBM_File;
+use POSIX qw(strftime mktime);
+use Apache::Constants qw(:common :http :methods);
use Apache::lonmsg();
-
+use Apache::lonmenu();
my $readit;
+=pod
+
+=item Global Variables
+
+=over 4
+
+=cut
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %cprtag;
my %fe; my %fd;
-my %fc;
+my %category_extensions;
+
+# ---------------------------------------------- Designs
+
+my %designhash;
+
+# ---------------------------------------------- Thesaurus variables
+
+=pod
+
+=item %Keywords
+
+A hash used by &keyword to determine if a word is considered a keyword.
+
+=item $thesaurus_db_file
+
+Scalar containing the full path to the thesaurus database.
+
+=cut
+
+my %Keywords;
+my $thesaurus_db_file;
+
+
+=pod
+
+=back
-# -------------------------------------------------------------- Thesaurus data
-my @therelated;
-my @theword;
-my @thecount;
-my %theindex;
-my $thetotalcount;
-my $thefuzzy=2;
-my $thethreshold=0.1/$thefuzzy;
-my $theavecount;
+=cut
# ----------------------------------------------------------------------- BEGIN
-BEGIN {
+=pod
+
+=item BEGIN()
+
+Initialize values from language.tab, copyright.tab, filetypes.tab,
+thesaurus.tab, and filecategories.tab.
+
+=cut
+
+# ----------------------------------------------------------------------- BEGIN
+
+BEGIN {
+ # Variable initialization
+ $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
+ #
unless ($readit) {
# ------------------------------------------------------------------- languages
{
@@ -76,8 +151,8 @@ BEGIN {
while (<$fh>) {
next if /^\#/;
chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- $language{$key}=$val;
+ my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_));
+ $language{$key}=$val.' - '.$enc;
}
}
}
@@ -94,6 +169,30 @@ BEGIN {
}
}
}
+
+# -------------------------------------------------------------- domain designs
+
+ my $filename;
+ my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+ opendir(DIR,$designdir);
+ while ($filename=readdir(DIR)) {
+ my ($domain)=($filename=~/^(\w+)\./);
+ {
+ my $fh=Apache::File->new($designdir.'/'.$filename);
+ if ($fh) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\=/,$_));
+ if ($val) { $designhash{$domain.'.'.$key}=$val; }
+ }
+ }
+ }
+
+ }
+ closedir(DIR);
+
+
# ------------------------------------------------------------- file categories
{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
@@ -102,8 +201,8 @@ BEGIN {
while (<$fh>) {
next if /^\#/;
chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- push @{$fc{$key}},$val;
+ my ($extension,$category)=(split(/\s+/,$_,2));
+ push @{$category_extensions{lc($category)}},$extension;
}
}
}
@@ -123,87 +222,1139 @@ BEGIN {
}
}
}
-# -------------------------------------------------------------- Thesaurus data
- {
- my $fh=Apache::File->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;
+ &Apache::lonnet::logthis(
+ "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
+
+=over 4
+
+=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 seperated list.
+
+Specifying 'omit' will restrict the browser to NOT displaying files
+with the given extension. Can be a comma seperated 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.
+
+=back
+
+=cut
+
+###############################################################
+sub browser_and_searcher_javascript {
+ return <
+ var stdeditbrowser;
+ function openstdbrowser(formname,uname,udom) {
+ var url = '/adm/pickstudent?';
+ var filter;
+ eval('filter=document.'+formname+'.'+uname+'.value;');
+ if (filter != null) {
+ if (filter != '') {
+ url += 'filter='+filter+'&';
}
}
- $theavecount=$thetotalcount/$#thecount;
+ url += 'form=' + formname + '&unameelement='+uname+
+ '&udomelement='+udom;
+ var title = 'Student_Browser';
+ var options = 'scrollbars=1,resizable=1,menubar=0';
+ options += ',width=700,height=600';
+ stdeditbrowser = open(url,title,options,'1');
+ stdeditbrowser.focus();
}
- &Apache::lonnet::logthis(
- "INFO: Read file types and thesaurus");
- $readit=1;
+
+ENDSTDBRW
+}
+
+sub selectstudent_link {
+ my ($form,$unameele,$udomele)=@_;
+ unless ($ENV{'request.course.id'}) { return ''; }
+ unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
+ return '';
+ }
+ return "Select User";
+}
+
+sub coursebrowser_javascript {
+ return (<<'ENDSTDBRW');
+
+ENDSTDBRW
}
+sub selectcourse_link {
+ my ($form,$unameele,$udomele)=@_;
+ return "Select Course";
}
-# ============================================================= END BEGIN BLOCK
+###############################################################
-# ---------------------------------------------------------- Is this a keyword?
+=pod
-sub keyword {
- my $newword=shift;
- $newword=~s/\W//g;
- $newword=~tr/A-Z/a-z/;
- my $tindex=$theindex{$newword};
- if ($tindex) {
- if ($thecount[$tindex]>$theavecount) {
- return 1;
- }
- }
- return 0;
-}
-# -------------------------------------------------------- Return related words
-
-sub related {
- my $newword=shift;
- $newword=~s/\W//g;
- $newword=~tr/A-Z/a-z/;
- my $tindex=$theindex{$newword};
- if ($tindex) {
- my %found=();
- foreach (split(/\,/,$therelated[$tindex])) {
-# - Related word found
- my ($ridx,$rcount)=split(/\:/,$_);
-# - Direct relation index
- my $directrel=$rcount/$thecount[$tindex];
- if ($directrel>$thethreshold) {
- foreach (split(/\,/,$therelated[$ridx])) {
- my ($rridx,$rrcount)=split(/\:/,$_);
- if ($rridx==$tindex) {
-# - Determine reverse relation index
- my $revrel=$rrcount/$thecount[$ridx];
-# - Calculate full index
- $found{$ridx}=$directrel*$revrel;
- if ($found{$ridx}>$thethreshold) {
- foreach (split(/\,/,$therelated[$ridx])) {
- my ($rrridx,$rrrcount)=split(/\:/,$_);
- unless ($found{$rrridx}) {
- my $revrevrel=$rrrcount/$thecount[$ridx];
- if (
- $directrel*$revrel*$revrevrel>$thethreshold
- ) {
- $found{$rrridx}=
- $directrel*$revrel*$revrevrel;
- }
- }
- }
- }
+=item linked_select_forms(...)
+
+linked_select_forms returns a string containing a block
+and html for two