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

Diff for /loncom/interface/loncommon.pm between versions 1.157 and 1.165

version 1.157, 2003/12/01 14:36:22 version 1.165, 2003/12/27 23:55:10
Line 102  BEGIN { Line 102  BEGIN {
     unless ($readit) {      unless ($readit) {
 # ------------------------------------------------------------------- languages  # ------------------------------------------------------------------- languages
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.          my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
  '/language.tab');                                     '/language.tab';
  if ($fh) {          if ( open(my $fh,"<$langtabfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));                  my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
  $language{$key}=$val.' - '.$enc;                  $language{$key}=$val.' - '.$enc;
  if ($sup) {                  if ($sup) {
     $supported_language{$key}=$sup;                      $supported_language{$key}=$sup;
  }                  }
     }              }
  }              close($fh);
           }
     }      }
 # ------------------------------------------------------------------ copyrights  # ------------------------------------------------------------------ copyrights
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.          my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
   '/copyright.tab');                                    '/copyright.tab';
  if ($fh) {          if ( open (my $fh,"<$copyrightfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($key,$val)=(split(/\s+/,$_,2));                  my ($key,$val)=(split(/\s+/,$_,2));
  $cprtag{$key}=$val;                  $cprtag{$key}=$val;
     }              }
  }              close($fh);
           }
     }      }
   
 # -------------------------------------------------------------- domain designs  # -------------------------------------------------------------- domain designs
Line 138  BEGIN { Line 140  BEGIN {
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  my ($domain)=($filename=~/^(\w+)\./);   my ($domain)=($filename=~/^(\w+)\./);
     {      {
  my $fh=Apache::File->new($designdir.'/'.$filename);          my $designfile = $designdir.'/'.$filename;
  if ($fh) {          if ( open (my $fh,"<$designfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($key,$val)=(split(/\=/,$_));                  my ($key,$val)=(split(/\=/,$_));
  if ($val) { $designhash{$domain.'.'.$key}=$val; }                  if ($val) { $designhash{$domain.'.'.$key}=$val; }
     }              }
  }              close($fh);
           }
     }      }
   
     }      }
Line 155  BEGIN { Line 158  BEGIN {
   
 # ------------------------------------------------------------- file categories  # ------------------------------------------------------------- file categories
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.          my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
   '/filecategories.tab');                                    '/filecategories.tab';
  if ($fh) {          if ( open (my $fh,"<$categoryfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($extension,$category)=(split(/\s+/,$_,2));                  my ($extension,$category)=(split(/\s+/,$_,2));
  push @{$category_extensions{lc($category)}},$extension;                  push @{$category_extensions{lc($category)}},$extension;
     }              }
  }              close($fh);
           }
   
     }      }
 # ------------------------------------------------------------------ file types  # ------------------------------------------------------------------ file types
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.          my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
        '/filetypes.tab');                 '/filetypes.tab';
  if ($fh) {          if ( open (my $fh,"<$typesfile") ) {
             while (<$fh>) {              while (<$fh>) {
  next if (/^\#/);                  next if (/^\#/);
  chomp;                  chomp;
  my ($ending,$emb,$descr)=split(/\s+/,$_,3);                  my ($ending,$emb,$descr)=split(/\s+/,$_,3);
  if ($descr ne '') {                   if ($descr ne '') {
     $fe{$ending}=lc($emb);                      $fe{$ending}=lc($emb);
     $fd{$ending}=$descr;                      $fd{$ending}=$descr;
  }                  }
     }              }
  }              close($fh);
           }
     }      }
     &Apache::lonnet::logthis(      &Apache::lonnet::logthis(
               "<font color=yellow>INFO: Read file types</font>");                "<font color=yellow>INFO: Read file types</font>");
Line 548  sub help_open_topic { Line 554  sub help_open_topic {
     my $template = "";      my $template = "";
     my $link;      my $link;
   
       $topic=~s/\W/\_/g;
   
     if (!$stayOnPage)      if (!$stayOnPage)
     {      {
  $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";   $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
Line 754  sub select_form { Line 762  sub select_form {
     return $selectform;      return $selectform;
 }  }
   
   sub select_level_form {
       my ($deflevel,$name)=@_;
       unless ($deflevel) { $deflevel=0; }
       return &select_form($deflevel,$name,(
    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'));
   }
 #-------------------------------------------  #-------------------------------------------
   
 =pod  =pod
Line 979  END Line 1010  END
         $Javascript_toUpperCase = "";          $Javascript_toUpperCase = "";
     }      }
   
       my $radioval = "'nochange'";
       my $argfield = 'null';
       if ( grep/^mode$/,(keys %in) ) {
           if ($in{'mode'} eq 'modifycourse')  {
               if ( grep/^curr_authtype$/,(keys %in) ) {
                   $radioval = "'$in{'curr_authtype'}'";
               }
               if ( grep/^curr_autharg$/,(keys %in) ) {
                   unless ($in{'curr_autharg'} eq '') {
                       $argfield = "'$in{'curr_autharg'}'";
                   }
               }
           }
       }
   
     $result.=<<"END";      $result.=<<"END";
 var current = new Object();  var current = new Object();
 current.radiovalue = 'nochange';  current.radiovalue = $radioval;
 current.argfield = null;  current.argfield = $argfield;
   
 function changed_radio(choice,currentform) {  function changed_radio(choice,currentform) {
     var choicearg = choice + 'arg';      var choicearg = choice + 'arg';
Line 1069  sub authform_kerberos{ Line 1115  sub authform_kerberos{
               kerb_def_auth => 'krb4',                kerb_def_auth => 'krb4',
               @_,                @_,
               );                );
     my ($check4,$check5);      my ($check4,$check5,$krbarg);
     if ($in{'kerb_def_auth'} eq 'krb5') {      if ($in{'kerb_def_auth'} eq 'krb5') {
        $check5 = " checked=\"on\"";         $check5 = " checked=\"on\"";
     } else {      } else {
        $check4 = " checked=\"on\"";         $check4 = " checked=\"on\"";
     }      }
       $krbarg = $in{'kerb_def_dom'};
   
       my $krbcheck = "";
       if ( grep/^curr_authtype$/,(keys %in) ) {
           if ($in{'curr_authtype'} =~ m/^krb/) {
               $krbcheck = " checked=\"on\"";
               if ( grep/^curr_autharg$/,(keys %in) ) {
                   $krbarg = $in{'curr_autharg'};
               }
           }
       }
   
     my $jscall = "javascript:changed_radio('krb',$in{'formname'});";      my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
     my $result .= &mt      my $result .= &mt
         ('[_1] Kerberos authenticated with domain [_2] '.          ('[_1] Kerberos authenticated with domain [_2] '.
          '[_3] Version 4 [_4] Version 5',           '[_3] Version 4 [_4] Version 5',
          '<input type="radio" name="login" value="krb" '.           '<input type="radio" name="login" value="krb" '.
              'onclick="'.$jscall.'" onchange="'.$jscall.'" />',               'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
          '<input type="text" size="10" name="krbarg" '.           '<input type="text" size="10" name="krbarg" '.
              'value="'.$in{'kerb_def_dom'}.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'" />',
          '<input type="radio" name="krbver" value="4" '.$check4.' />',           '<input type="radio" name="krbver" value="4" '.$check4.' />',
          '<input type="radio" name="krbver" value="5" '.$check5.' />');           '<input type="radio" name="krbver" value="5" '.$check5.' />');
Line 1095  sub authform_internal{ Line 1153  sub authform_internal{
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
   
       my $intcheck = "";
       my $intarg = 'value=""';
       if ( grep/^curr_authtype$/,(keys %args) ) {
           if ($args{'curr_authtype'} eq 'int') {
               $intcheck = " checked=\"on\"";
               if ( grep/^curr_autharg$/,(keys %args) ) {
                   $intarg = "value=\"$args{'curr_autharg'}\"";
               }
           }
       }
   
     my $jscall = "javascript:changed_radio('int',$args{'formname'});";      my $jscall = "javascript:changed_radio('int',$args{'formname'});";
     my $result.=&mt      my $result.=&mt
         ('[_1] Internally authenticated (with initial password [_2])',          ('[_1] Internally authenticated (with initial password [_2])',
          '<input type="radio" name="login" value="int" '.           '<input type="radio" name="login" value="int" '.$intcheck.
              'onchange="'.$jscall.'" onclick="'.$jscall.'" />',               ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
          '<input type="text" size="10" name="intarg" value="" '.           '<input type="text" size="10" name="intarg" '.$intarg.
              'onchange="'.$jscall.'" />');               ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 1111  sub authform_local{ Line 1181  sub authform_local{
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
   
       my $loccheck = "";
       my $locarg = 'value=""';
       if ( grep/^curr_authtype$/,(keys %in) ) {
           if ($in{'curr_authtype'} eq 'loc') {
               $loccheck = " checked=\"on\"";
               if ( grep/^curr_autharg$/,(keys %in) ) {
                   $locarg = "value=\"$in{'curr_autharg'}\"";
               }
           }
       }
   
     my $jscall = "javascript:changed_radio('loc',$in{'formname'});";      my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
     my $result.=&mt('[_1] Local Authentication with arguement [_2]',      my $result.=&mt('[_1] Local Authentication with argument [_2]',
                     '<input type="radio" name="login" value="loc" '.                      '<input type="radio" name="login" value="loc" '.$loccheck.
                         'onchange="'.$jscall.'" onclick="'.$jscall.'" />',                          ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
                     '<input type="text" size="10" name="locarg" value="" '.                      '<input type="text" size="10" name="locarg" '.$locarg.
                         'onchange="'.$jscall.'" />');                          ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 1290  sub keyword { Line 1372  sub keyword {
   
 =item * get_related_words  =item * get_related_words
   
 Look up a word in the thesaurus.  Takes a scalar arguement and returns  Look up a word in the thesaurus.  Takes a scalar argument and returns
 an array of words.  If the keyword is not in the thesaurus, an empty array  an array of words.  If the keyword is not in the thesaurus, an empty array
 will be returned.  The order of the words returned is determined by the  will be returned.  The order of the words returned is determined by the
 database which holds them.  database which holds them.
Line 1896  sub maketime { Line 1978  sub maketime {
          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));           $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
 }  }
   
   
 #########################################  
 #  
 # Retro-fixing of un-backward-compatible time format  
   
 sub unsqltime {  
     my $timestamp=shift;  
     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {  
        $timestamp=&maketime(  
    'year'=>$1,'month'=>$2,'day'=>$3,  
            'hours'=>$4,'minutes'=>$5,'seconds'=>$6);  
     }  
     return $timestamp;  
 }  
   
 #########################################  #########################################
   
 sub findallcourses {  sub findallcourses {
Line 2390  sub upfile_store { Line 2457  sub upfile_store {
     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.      my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
  '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;   '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
     {      {
  my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
  '/tmp/'.$datatoken.'.tmp');                             '/tmp/'.$datatoken.'.tmp';
  print $fh $ENV{'form.upfile'};          if ( open(my $fh,">$datafile") ) {
               print $fh $ENV{'form.upfile'};
               close($fh);
           }
     }      }
     return $datatoken;      return $datatoken;
 }  }
Line 2411  sub load_tmp_file { Line 2481  sub load_tmp_file {
     my $r=shift;      my $r=shift;
     my @studentdata=();      my @studentdata=();
     {      {
  my $fh;          my $studentfile = $r->dir_config('lonDaemons').
  if ($fh=Apache::File->new($r->dir_config('lonDaemons').                                '/tmp/'.$ENV{'form.datatoken'}.'.tmp';
   '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {          if ( open(my $fh,"<$studentfile") ) {
     @studentdata=<$fh>;              @studentdata=<$fh>;
  }              close($fh);
           }
     }      }
     $ENV{'form.upfile'}=join('',@studentdata);      $ENV{'form.upfile'}=join('',@studentdata);
 }  }
Removed from v.1.157  
changed lines
  Added in v.1.165

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