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

Diff for /loncom/interface/loncommon.pm between versions 1.54 and 1.56

version 1.54, 2002/08/20 21:29:34 version 1.56, 2002/08/22 13:39:42
Line 885  sub keyword { Line 885  sub keyword {
     return exists($Keywords{$word});      return exists($Keywords{$word});
 }  }
   
 ###################################################  
 #         Old code, to be removed soon            #  
 ###################################################  
 # -------------------------------------------------------- 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 ();  
 #}  
   
 ###############################################################  ###############################################################
   
 =pod   =pod 
Line 947  Uses global $thesaurus_db_file. Line 901  Uses global $thesaurus_db_file.
 =cut  =cut
   
 ###############################################################  ###############################################################
   
 sub get_related_words {  sub get_related_words {
     my $keyword = shift;      my $keyword = shift;
     my %thesaurus_db;      my %thesaurus_db;
Line 1195  sub findallcourses { Line 1148  sub findallcourses {
 ###############################################  ###############################################
   
 sub bodytag {  sub bodytag {
     my ($function,$title,$addentries)=@_;      my ($title,$function,$addentries)=@_;
       unless ($function) {
    $function='student';
           if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
       $function='coordinator';
           }
    if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
               $function='admin';
           }
           if (($ENV{'request.role'}=~/^(au|ca)/) ||
               ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
               $function='author';
           }
       }
     my $img='';      my $img='';
     my $pgbg='';      my $pgbg='';
     my $tabbg='';      my $tabbg='';
Line 1214  sub bodytag { Line 1180  sub bodytag {
         $img='coordinator';          $img='coordinator';
         $pgbg='#CCFFFF';          $pgbg='#CCFFFF';
         $tabbg='#CCCCFF';          $tabbg='#CCCCFF';
         $font='#000033';          $font='#000044';
         $link='#003333';          $link='#003333';
         $vlink='#006633';          $vlink='#006633';
    } elsif ($function eq 'author') {     } elsif ($function eq 'author') {
         $img='author';          $img='author';
         $pgbg='#CCFFFF';          $pgbg='#CCFFFF';
         $tabbg='#CCFFCC';          $tabbg='#CCFFCC';
         $font='#003300';          $font='#004400';
         $link='#003333';          $link='#003333';
         $vlink='#006666';          $vlink='#006666';
     } else {      } else {
         $img='student';          $img='student';
         $pgbg='#FFFF99';          $pgbg='#FFFFAA';
         $tabbg='#FF9900';          $tabbg='#FF9900';
         $font='#991100';          $font='#991100';
         $link='#993300';          $link='#993300';
         $vlink='#996600';          $vlink='#996600';
     }      }
     my $role=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);  # role and realm
       my ($role,$realm)
          =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
   # realm
     if ($ENV{'request.course.id'}) {      if ($ENV{'request.course.id'}) {
  $role.='<br>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};   $realm=
            $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
     }      }
       unless ($realm) { $realm='&nbsp;'; }
   # Set messages
       my $messages=localtime();
   # Output
     return(<<ENDBODY);      return(<<ENDBODY);
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 $addentries>  $addentries>
 <table cellspacing="0" border="0" cellpadding="2">  <table width="100%" cellspacing="0" border="0" cellpadding="0">
 <tr><td colspan="2" bgcolor="$tabbg">  <tr><td bgcolor="$font">
 <img src="/adm/lonInterFace/$img.jpg" /></td></tr>  <img src="/adm/lonInterFace/$img.jpg" /></td>
   <td bgcolor="$font"><font color='$pgbg'>$messages</font></td>
   </tr>
 <tr>  <tr>
 <td rowspan="2" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
 <font size="5"><b>$title</b></font>  &nbsp;<font size="5"><b>$title</b></font>
 <td bgcolor="$tabbg"  align="right">  <td bgcolor="$tabbg"  align="right">
 <font size="2">  <font size="2">
     $ENV{'environment.firstname'}      $ENV{'environment.firstname'}
     $ENV{'environment.middlename'}      $ENV{'environment.middlename'}
     $ENV{'environment.lastname'}      $ENV{'environment.lastname'}
     $ENV{'environment.generation'}      $ENV{'environment.generation'}
 </font>      </font>&nbsp;
 </td>  </td>
 </tr>  </tr>
 <tr><td bgcolor="$tabbg" align="right">  <tr><td bgcolor="$tabbg" align="right">
 <font size="2">$role</font>  <font size="2">$role</font>&nbsp;
 </td></tr>  </td></tr>
   <tr>
   <td bgcolor="$tabbg" align="right"><font size="2">$realm</font>&nbsp;</td></tr>
 </table><br>  </table><br>
 ENDBODY  ENDBODY
 }  }
Line 1345  sub upfile_store { Line 1323  sub upfile_store {
     return $datatoken;      return $datatoken;
 }  }
   
   =pod
   
 =item load_tmp_file($r)  =item load_tmp_file($r)
   
 Load uploaded file from tmp, $r should be the HTTP Request object,  Load uploaded file from tmp, $r should be the HTTP Request object,
Line 1366  sub load_tmp_file { Line 1346  sub load_tmp_file {
     $ENV{'form.upfile'}=join('',@studentdata);      $ENV{'form.upfile'}=join('',@studentdata);
 }  }
   
   =pod
   
 =item upfile_record_sep()  =item upfile_record_sep()
   
 Separate uploaded file into records  Separate uploaded file into records
Line 1381  sub upfile_record_sep { Line 1363  sub upfile_record_sep {
     }      }
 }  }
   
   =pod
   
 =item record_sep($record)  =item record_sep($record)
   
 Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}  Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
Line 1431  sub record_sep { Line 1415  sub record_sep {
     return %components;      return %components;
 }  }
   
   =pod
   
 =item upfile_select_html()  =item upfile_select_html()
   
 return HTML code to select file and specify its type  return HTML code to select file and specify its type
Line 1449  sub upfile_select_html { Line 1435  sub upfile_select_html {
 ENDUPFORM  ENDUPFORM
 }  }
   
   =pod
   
 =item csv_print_samples($r,$records)  =item csv_print_samples($r,$records)
   
 Prints a table of sample values from each column uploaded $r is an  Prints a table of sample values from each column uploaded $r is an
Line 1479  sub csv_print_samples { Line 1467  sub csv_print_samples {
     $r->print('</tr></table><br />'."\n");      $r->print('</tr></table><br />'."\n");
 }  }
   
   =pod
   
 =item csv_print_select_table($r,$records,$d)  =item csv_print_select_table($r,$records,$d)
   
 Prints a table to create associations between values and table columns.  Prints a table to create associations between values and table columns.
Line 1511  sub csv_print_select_table { Line 1501  sub csv_print_select_table {
     return $i;      return $i;
 }  }
   
   =pod
   
 =item csv_samples_select_table($r,$records,$d)  =item csv_samples_select_table($r,$records,$d)
   
 Prints a table of sample values from the upload and can make associate samples to internal names.  Prints a table of sample values from the upload and can make associate samples to internal names.
Removed from v.1.54  
changed lines
  Added in v.1.56

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