[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.44 and 1.46

version 1.44, 2002/07/05 16:12:31 version 1.46, 2002/07/12 14:36:16
Line 41 Line 41
   
 # POD header:  # POD header:
   
   =pod
   
 =head1 NAME  =head1 NAME
   
 Apache::loncommon - pile of common routines  Apache::loncommon - pile of common routines
Line 77  package Apache::loncommon; Line 79  package Apache::loncommon;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet();
   use GDBM_File;
 use POSIX qw(strftime);  use POSIX qw(strftime);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonmsg();  use Apache::lonmsg();
 my $readit;  my $readit;
   
   =pod 
   
   =item Global Variables
   
   =over 4
   
   =cut
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %cprtag;  my %cprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %category_extensions;  my %category_extensions;
   
 # -------------------------------------------------------------- Thesaurus data  # ---------------------------------------------- Thesaurus variables
 my @therelated;  
 my @theword;  =pod
 my @thecount;  
 my %theindex;  =item %Keywords  
 my $thetotalcount;  
 my $thefuzzy=2;  A hash used by &keyword to determine if a word is considered a keyword.
 my $thethreshold=0.1/$thefuzzy;  
 my $theavecount;  =item $thesaurus_db_file
   
   Scalar containing the full path to the thesaurus database.                 
   
   =cut
   
   my %Keywords;
   my $thesaurus_db_file;
   
   
   =pod
   
   =back
   
   =cut
   
 # ----------------------------------------------------------------------- BEGIN  # ----------------------------------------------------------------------- BEGIN
   
Line 105  my $theavecount; Line 129  my $theavecount;
 =item BEGIN()   =item BEGIN() 
   
 Initialize values from language.tab, copyright.tab, filetypes.tab,  Initialize values from language.tab, copyright.tab, filetypes.tab,
 and filecategories.tab.  thesaurus.tab, and filecategories.tab.
   
 =cut  =cut
   
 # ----------------------------------------------------------------------- BEGIN  # ----------------------------------------------------------------------- BEGIN
   
 BEGIN {  BEGIN {
       # Variable initialization
       $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
       #
     unless ($readit) {      unless ($readit) {
 # ------------------------------------------------------------------- languages  # ------------------------------------------------------------------- languages
     {      {
Line 168  BEGIN { Line 195  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;  
    }  
         }  
         $theavecount=$thetotalcount/$#thecount;  
     }  
     &Apache::lonnet::logthis(      &Apache::lonnet::logthis(
               "<font color=yellow>INFO: Read file types and thesaurus</font>");                "<font color=yellow>INFO: Read file types</font>");
     $readit=1;      $readit=1;
 }      }  # end of unless($readit) 
           
 }  }
 # ============================================================= END BEGIN BLOCK  # ============================================================= END BEGIN BLOCK
Line 342  my %menu = ( A1 => { text =>"Choice A1" Line 353  my %menu = ( A1 => { text =>"Choice A1"
                   }                    }
               );                );
   
 =back  
   
 =cut  =cut
   
 # ------------------------------------------------  # ------------------------------------------------
Line 428  END Line 437  END
   
 ###############################################################  ###############################################################
   
   =pod
   
 =item help_open_topic($topic, $stayOnPage, $width, $height)  =item help_open_topic($topic, $stayOnPage, $width, $height)
   
Line 471  ENDTEMPLATE Line 481  ENDTEMPLATE
   
 }  }
   
   =pod
   
 =item csv_translate($text)   =item csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma seperated values'   Translate $text to allow it to be output as a 'comma seperated values' 
Line 486  sub csv_translate { Line 498  sub csv_translate {
 }  }
   
 ###############################################################  ###############################################################
   
 ###############################################################  
 ##        Home server <option> list generating code          ##  ##        Home server <option> list generating code          ##
 ###############################################################  ###############################################################
 #-------------------------------------------  #-------------------------------------------
   
   =pod
   
 =item get_domains()  =item get_domains()
   
 Returns an array containing each of the domains listed in the hosts.tab  Returns an array containing each of the domains listed in the hosts.tab
Line 512  sub get_domains { Line 524  sub get_domains {
   
 #-------------------------------------------  #-------------------------------------------
   
   =pod
   
 =item select_dom_form($defdom,$name)  =item select_dom_form($defdom,$name)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
Line 536  sub select_dom_form { Line 550  sub select_dom_form {
   
 #-------------------------------------------  #-------------------------------------------
   
   =pod
   
 =item get_home_servers($domain)  =item get_home_servers($domain)
   
 Returns a hash which contains keys like '103l3' and values like   Returns a hash which contains keys like '103l3' and values like 
Line 558  sub get_home_servers { Line 574  sub get_home_servers {
   
 #-------------------------------------------  #-------------------------------------------
   
   =pod
   
 =item home_server_option_list($domain)  =item home_server_option_list($domain)
   
 returns a string which contains an <option> list to be used in a   returns a string which contains an <option> list to be used in a 
Line 590  sub home_server_option_list { Line 608  sub home_server_option_list {
 ##    formname = the name given in the <form> tag.  ##    formname = the name given in the <form> tag.
 #-------------------------------------------  #-------------------------------------------
   
   =pod
   
 =item authform_xxxxxx  =item authform_xxxxxx
   
 The authform_xxxxxx subroutines provide javascript and html forms which   The authform_xxxxxx subroutines provide javascript and html forms which 
Line 791  END Line 811  END
 ##   End Authentication changing form generation functions   ##  ##   End Authentication changing form generation functions   ##
 ###############################################################  ###############################################################
   
   ###############################################################
   ##                Thesaurus Functions                        ##
   ###############################################################
   
   =pod
   
 # ---------------------------------------------------------- Is this a keyword?  =item initialize_keywords
   
 sub keyword {  Initializes the package variable %Keywords if it is empty.  Uses the
     my $newword=shift;  package variable $thesaurus_db_file.
     $newword=~s/\W//g;  
     $newword=~tr/A-Z/a-z/;  =cut
     my $tindex=$theindex{$newword};  
     if ($tindex) {  ###################################################
         if ($thecount[$tindex]>$theavecount) {  
            return 1;  sub initialize_keywords {
         }      return 1 if (scalar keys(%Keywords));
       # If we are here, %Keywords is empty, so fill it up
       #   Make sure the file we need exists...
       if (! -e $thesaurus_db_file) {
           &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                                    " failed because it does not exist");
           return 0;
       }
       #   Set up the hash as a database
       my %thesaurus_db;
       if (! tie(%thesaurus_db,'GDBM_File',
                 $thesaurus_db_file,&GDBM_READER,0640)){
           &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                                    $thesaurus_db_file);
           return 0;
       } 
       #  Get the average number of appearances of a word.
       my $avecount = $thesaurus_db{'average.count'};
       #  Put keywords (those that appear > average) into %Keywords
       while (my ($word,$data)=each (%thesaurus_db)) {
           my ($count,undef) = split /:/,$data;
           $Keywords{$word}++ if ($count > $avecount);
       }
       untie %thesaurus_db;
       # Remove special values from %Keywords.
       foreach ('total.count','average.count') {
           delete($Keywords{$_}) if (exists($Keywords{$_}));
     }      }
     return 0;      return 1;
   }
   
   ###################################################
   
   =pod
   
   =item keyword($word)
   
   Returns true if $word is a keyword.  A keyword is a word that appears more 
   than the average number of times in the thesaurus database.  Calls 
   &initialize_keywords
   
   =cut
   
   ###################################################
   
   sub keyword {
       return if (!&initialize_keywords());
       my $word=lc(shift());
       $word=~s/\W//g;
       return exists($Keywords{$word});
 }  }
   
   ###################################################
   #         Old code, to be removed soon            #
   ###################################################
 # -------------------------------------------------------- Return related words  # -------------------------------------------------------- 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;
   #                               }
   #                            }
   #                        }
   #                     }
   #                  }
   #               }
   #            }
   #        }
   #    }
   #    return ();
   #}
   
 sub related {  ###############################################################
     my $newword=shift;  
     $newword=~s/\W//g;  =pod 
     $newword=~tr/A-Z/a-z/;  
     my $tindex=$theindex{$newword};  =item get_related_words
     if ($tindex) {  
         my %found=();  Look up a word in the thesaurus.  Takes a scalar arguement and returns
         foreach (split(/\,/,$therelated[$tindex])) {  an array of words.  If the keyword is not in the thesaurus, an empty array
 # - Related word found  will be returned.  The order of the words returned is determined by the
             my ($ridx,$rcount)=split(/\:/,$_);  database which holds them.
 # - Direct relation index  
             my $directrel=$rcount/$thecount[$tindex];  Uses global $thesaurus_db_file.
             if ($directrel>$thethreshold) {  
                foreach (split(/\,/,$therelated[$ridx])) {  =cut
                   my ($rridx,$rrcount)=split(/\:/,$_);  
                   if ($rridx==$tindex) {  ###############################################################
 # - Determine reverse relation index  
                      my $revrel=$rrcount/$thecount[$ridx];  sub get_related_words {
 # - Calculate full index      my $keyword = shift;
                      $found{$ridx}=$directrel*$revrel;      my %thesaurus_db;
                      if ($found{$ridx}>$thethreshold) {      if (! -e $thesaurus_db_file) {
                         foreach (split(/\,/,$therelated[$ridx])) {          &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                             my ($rrridx,$rrrcount)=split(/\:/,$_);                                   "failed because the file does not exist");
                             unless ($found{$rrridx}) {          return ();
                                my $revrevrel=$rrrcount/$thecount[$ridx];      }
                                if (      if (! tie(%thesaurus_db,'GDBM_File',
                           $directrel*$revrel*$revrevrel>$thethreshold                $thesaurus_db_file,&GDBM_READER,0640)){
                                ) {          return ();
                                   $found{$rrridx}=      } 
                                        $directrel*$revrel*$revrevrel;      my @Words=();
                                }      if (exists($thesaurus_db{$keyword})) {
                             }          $_ = $thesaurus_db{$keyword};
                         }          (undef,@Words) = split/:/;  # The first element is the number of times
                      }                                      # the word appears.  We do not need it now.
                   }          for (my $i=0;$i<=$#Words;$i++) {
                }              ($Words[$i],undef)= split/\,/,$Words[$i];
             }  
         }          }
     }      }
     return ();      untie %thesaurus_db;
       return @Words;
 }  }
   
   ###############################################################
   ##              End Thesaurus Functions                      ##
   ###############################################################
   
 # ---------------------------------------------------------------- Language IDs  # ---------------------------------------------------------------- Language IDs
 sub languageids {  sub languageids {
     return sort(keys(%language));      return sort(keys(%language));
Line 1079  sub add_to_env { Line 1199  sub add_to_env {
   
 =pod  =pod
   
   =back 
   
 =head2 CSV Upload/Handling functions  =head2 CSV Upload/Handling functions
   
 =over 4  =over 4
Removed from v.1.44  
changed lines
  Added in v.1.46

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>