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

Diff for /loncom/interface/loncommon.pm between versions 1.152 and 1.159

version 1.152, 2003/11/10 23:25:52 version 1.159, 2003/12/15 19:23:03
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2001  
 # 2/13-12/7 Guy Albertelli  
 # 12/21 Gerd Kortemeyer  
 # 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  # Makes a table out of the previous attempts
 # Inputs result_from_symbread, user, domain, course_id  # Inputs result_from_symbread, user, domain, course_id
Line 73  use HTML::Entities; Line 66  use HTML::Entities;
   
 my $readit;  my $readit;
   
 =pod   ##
   ## Global Variables
 =head1 Global Variables  ##
   
 =cut  
   
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
Line 111  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 147  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 164  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 204  BEGIN { Line 201  BEGIN {
   
 =pod   =pod 
   
 =head1 General Subroutines  
   
 =over 4  
   
 =head1 HTML and Javascript Functions  =head1 HTML and Javascript Functions
   
 =over 4  =over 4
Line 219  containing javascript with two functions Line 212  containing javascript with two functions
 C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>  C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
 tags.  tags.
   
 =over 4  
   
 =item * openbrowser(formname,elementname,only,omit) [javascript]  =item * openbrowser(formname,elementname,only,omit) [javascript]
   
 inputs: formname, elementname, only, omit  inputs: formname, elementname, only, omit
Line 241  Inputs: formname, elementname Line 232  Inputs: formname, elementname
 formname and elementname specify the name of the html form and the name  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.  of the element the selection from the search results will be placed in.
   
 =back  
   
 =cut  =cut
   
 sub browser_and_searcher_javascript {  sub browser_and_searcher_javascript {
Line 565  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 887  Outputs: Line 878  Outputs:
   
 =back  =back
   
   =back 
   
 =cut  =cut
   
 ###############################################################  ###############################################################
Line 925  sub decode_user_agent { Line 918  sub decode_user_agent {
             $clientunicode,$clientos,);              $clientunicode,$clientos,);
 }  }
   
 =pod  
   
 =back  
   
 =cut  
   
 ###############################################################  ###############################################################
 ##    Authentication changing form generation subroutines    ##  ##    Authentication changing form generation subroutines    ##
 ###############################################################  ###############################################################
Line 971  See loncreateuser.pm for invocation and Line 958  See loncreateuser.pm for invocation and
   
 =back  =back
   
   =back 
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
Line 1155  sub authform_filesystem{ Line 1144  sub authform_filesystem{
     return $result;      return $result;
 }  }
   
 =pod  
   
 =back  
   
 =cut  
   
 ###############################################################  ###############################################################
 ##    Get Authentication Defaults for Domain                 ##  ##    Get Authentication Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 2140  sub bodytag { Line 2123  sub bodytag {
     my $bodytag = <<END;      my $bodytag = <<END;
 <style>  <style>
 h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }  h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
 a:hover { color: black; background: yellow }  
 a:focus { color: red; background: yellow }   a:focus { color: red; background: yellow } 
 </style>  </style>
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
Line 2416  sub upfile_store { Line 2398  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 2437  sub load_tmp_file { Line 2422  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);
 }  }
Line 2730  sub check_if_partid_hidden { Line 2716  sub check_if_partid_hidden {
   
 =pod  =pod
   
   =back 
   
 =head1 cgi-bin script and graphing routines  =head1 cgi-bin script and graphing routines
   
   =over 4
   
 =item get_cgi_id  =item get_cgi_id
   
 Inputs: none  Inputs: none
Line 2747  the routine &Apache::lonnet::transfer_pr Line 2737  the routine &Apache::lonnet::transfer_pr
 ############################################################  ############################################################
 my $uniq=0;  my $uniq=0;
 sub get_cgi_id {  sub get_cgi_id {
     $uniq=($uniq++)%100000;      $uniq=($uniq+1)%100000;
     return (time.'_'.$uniq);      return (time.'_'.$uniq);
 }  }
   
Line 3064  sub DrawXYYGraph { Line 3054  sub DrawXYYGraph {
   
 =pod  =pod
   
   =back 
   
 =head1 Statistics helper routines?    =head1 Statistics helper routines?  
   
 Bad place for them but what the hell.  Bad place for them but what the hell.
   
   =over 4
   
 =item &chartlink  =item &chartlink
   
 Returns a link to the chart for a specific student.    Returns a link to the chart for a specific student.  
Line 3084  Inputs: Line 3078  Inputs:
   
 =back  =back
   
   =back
   
 =cut  =cut
   
 ############################################################  ############################################################
Line 3096  sub chartlink { Line 3092  sub chartlink {
        '">'.$linktext.'</a>';         '">'.$linktext.'</a>';
 }  }
   
   #######################################################
   #######################################################
   
   =pod
   
   =head1 Course Environment Routines
   
   =over 4
   
   =item &restore_course_settings 
   
   =item &store_course_settings
   
   Restores/Store indicated form parameters from the course environment.
   Will not overwrite existing values of the form parameters.
   
   Inputs: 
   a scalar describing the data (e.g. 'chart', 'problem_analysis')
   
   a hash ref describing the data to be stored.  For example:
      
   %Save_Parameters = ('Status' => 'scalar',
       'chartoutputmode' => 'scalar',
       'chartoutputdata' => 'scalar',
       'Section' => 'array',
       'StudentData' => 'array',
       'Maps' => 'array');
   
   Returns: both routines return nothing
   
   =cut
   
   #######################################################
   #######################################################
   sub store_course_settings {
       # save to the environment
       # appenv the same items, just to be safe
       my $courseid = $ENV{'request.course.id'};
       my $coursedom = $ENV{'course.'.$courseid.'.domain'};
       my ($prefix,$Settings) = @_;
       my %SaveHash;
       my %AppHash;
       while (my ($setting,$type) = each(%$Settings)) {
           my $basename = 'env.internal.'.$prefix.'.'.$setting;
           my $envname = 'course.'.$courseid.'.'.$basename;
           if (exists($ENV{'form.'.$setting})) {
               # Save this value away
               if ($type eq 'scalar' &&
                   (! exists($ENV{$envname}) || 
                    $ENV{$envname} ne $ENV{'form.'.$setting})) {
                   $SaveHash{$basename} = $ENV{'form.'.$setting};
                   $AppHash{$envname}   = $ENV{'form.'.$setting};
               } elsif ($type eq 'array') {
                   my $stored_form;
                   if (ref($ENV{'form.'.$setting})) {
                       $stored_form = join(',',
                                           map {
                                               &Apache::lonnet::escape($_);
                                           } sort(@{$ENV{'form.'.$setting}}));
                   } else {
                       $stored_form = 
                           &Apache::lonnet::escape($ENV{'form.'.$setting});
                   }
                   # Determine if the array contents are the same.
                   if ($stored_form ne $ENV{$envname}) {
                       $SaveHash{$basename} = $stored_form;
                       $AppHash{$envname}   = $stored_form;
                   }
               }
           }
       }
       my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
                                             $coursedom,
                                             $ENV{'course.'.$courseid.'.num'});
       if ($put_result !~ /^(ok|delayed)/) {
           &Apache::lonnet::logthis('unable to save form parameters, '.
                                    'got error:'.$put_result);
       }
       # Make sure these settings stick around in this session, too
       &Apache::lonnet::appenv(%AppHash);
       return;
   }
   
   sub restore_course_settings {
       my $courseid = $ENV{'request.course.id'};
       my ($prefix,$Settings) = @_;
       while (my ($setting,$type) = each(%$Settings)) {
           next if (exists($ENV{'form.'.$setting}));
           my $envname = 'course.'.$courseid.'.env.internal.'.$prefix.
               '.'.$setting;
           if (exists($ENV{$envname})) {
               if ($type eq 'scalar') {
                   $ENV{'form.'.$setting} = $ENV{$envname};
               } elsif ($type eq 'array') {
                   $ENV{'form.'.$setting} = [ 
                                              map { 
                                                  &Apache::lonnet::unescape($_); 
                                              } split(',',$ENV{$envname})
                                              ];
               }
           }
       }
   }
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
   sub propath {
       my ($udom,$uname)=@_;
       $udom=~s/\W//g;
       $uname=~s/\W//g;
       my $subdir=$uname.'__';
       $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
       my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
       return $proname;
   } 
   
   sub icon {
       my ($file)=@_;
       my @file_ext = split(/\./,$file);
       my $curfext = $file_ext[-1];
       my $iconname="unknown.gif";
       my $embstyle = &Apache::loncommon::fileembstyle($curfext);
       # The unless conditional that follows is a bit of overkill
       $iconname = $curfext.".gif" unless
    (!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn');
       return $Apache::lonnet::perlvar{'lonIconsURL'}."/$iconname";
   } 
   
 =pod  =pod
   
 =back  =back
Removed from v.1.152  
changed lines
  Added in v.1.159

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