Diff for /loncom/cgi/loncgi.pm between versions 1.7 and 1.15

version 1.7, 2006/05/18 14:24:06 version 1.15, 2016/08/01 15:19:05
Line 36  loncgi Line 36  loncgi
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 Provides subroutines for checking a LON-CAPA cookie and loading the users  Provides subroutines for checking a LON-CAPA cookie, loading the user's
 environment.  environment, and retrieving arguments passed in via a CGI's Query String.
   
 =head1 Subroutines  =head1 Subroutines
   
Line 54  use warnings FATAL=>'all'; Line 54  use warnings FATAL=>'all';
 no warnings 'uninitialized';  no warnings 'uninitialized';
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use CGI();  use CGI qw(:standard);
 use CGI::Cookie();  use CGI::Cookie();
   use MIME::Types();
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use LONCAPA;  use LONCAPA;
 use LONCAPA::Configuration();  use LONCAPA::Configuration();
   use GDBM_File;
   use Apache::lonlocal;
   
 my $lonidsdir;  my $lonidsdir;
   
Line 68  BEGIN { Line 71  BEGIN {
     $lonidsdir = $perlvar->{'lonIDsDir'};      $lonidsdir = $perlvar->{'lonIDsDir'};
 }  }
   
   
 #############################################  #############################################
 #############################################  #############################################
   
 =pod  =pod
   
 =item check_cookie_and_load_env  =item check_cookie_and_load_env()
   
 Inputs: none  Inputs: 1 ( optional). When called from a handler in mod_perl,
           pass in the request object.
   
 Returns: 1 if the user has a LON-CAPA cookie 0 if not.  Returns: 1 if the user has a LON-CAPA cookie 0 if not.
 Loads the users environment into the %env hash if the cookie is correct.  Loads the users environment into the %env hash if the cookie is correct.
Line 85  Loads the users environment into the %en Line 90  Loads the users environment into the %en
 #############################################  #############################################
 #############################################  #############################################
 sub check_cookie_and_load_env {  sub check_cookie_and_load_env {
     my %cookies=fetch CGI::Cookie;      my ($r) = @_;
       my %cookies;
       if (ref($r)) {
           %cookies = CGI::Cookie->fetch($r);    
       } else {
           %cookies = CGI::Cookie->fetch();
       }
     if (exists($cookies{'lonID'}) &&       if (exists($cookies{'lonID'}) && 
         -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {          -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
         # cookie found          # cookie found
Line 102  sub check_cookie_and_load_env { Line 113  sub check_cookie_and_load_env {
   
 =pod  =pod
   
 =item check_cookie  =item check_cookie()
   
 Inputs: none  Inputs: none
   
Line 129  sub check_cookie { Line 140  sub check_cookie {
   
 =pod  =pod
   
 =item transfer_profile_to_env  =item transfer_profile_to_env()
   
 Load the users environment into the %env hash.  Load the users environment into the %env hash.
   
Line 143  Returns: undef Line 154  Returns: undef
 #############################################  #############################################
 sub transfer_profile_to_env {  sub transfer_profile_to_env {
     my ($handle)=@_;      my ($handle)=@_;
     my @profile;      if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),
     {      0640)) {
         open(IDFILE, "<$lonidsdir/$handle.id");   %Apache::lonnet::env = %disk_env;
         flock(IDFILE,LOCK_SH);   untie(%disk_env);
         @profile=<IDFILE>;  
         close(IDFILE);  
     }  
     foreach my $envrow (@profile) {  
         chomp($envrow);  
         my ($envname,$envvalue)=split(/=/,$envrow,2);  
  $envname  = &unescape($envname);  
  $envvalue = &unescape($envvalue);  
         $Apache::lonnet::env{$envname} = $envvalue;  
     }      }
     $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";      $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
     return undef;      return undef;
Line 164  sub transfer_profile_to_env { Line 166  sub transfer_profile_to_env {
 #############################################  #############################################
 #############################################  #############################################
   
   =pod
   
   =item missing_cookie_msg()
   
   Inputs: none
   Returns: HTML for a page indicating cookie information absent. 
   
   =cut
   
   #############################################
   #############################################
   sub missing_cookie_msg {
       my %lt = &Apache::lonlocal::texthash (
                           cook => 'Bad Cookie',
                           your => 'Your cookie information is incorrect.',
                );
       return <<END;
   <html>
   <head><title>$lt{'cook'}</title></head>
   <body>
   $lt{'your'}
   </body>
   </html>
   END
   
   }
   
   #############################################
   #############################################
   
   =pod
   
   =cgi_getitems()
   
   Inputs: $query - the CGI query string (required)
           $getitems - reference to a hash (required)
           $possname - permitted names of keys (optional)
   
   Returns: nothing
   
   Side Effects: populates $getitems hash ref with key => value
                 where each key is the name of the form item in the query string
                 and value is an array of corresponding values. 
   
   =cut
   
   #############################################
   #############################################
   sub cgi_getitems {
       my ($query,$getitems,$possnames)= @_;
       foreach (split(/&/,$query)) {
           my ($name, $value) = split(/=/,$_);
           $name = &unescape($name);
           if (ref($possnames) eq 'ARRAY') {
               next unless (grep(/^\Q$name\E$/,@{$possnames}));
           }
           $value =~ tr/+/ /;
           $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
           push(@{$$getitems{$name}},$value);
       }
       return;
   }
   
   #############################################
   #############################################
   
   =pod
   
   =cgi_header()
   
   Inputs: $contenttype - Content Type (e.g., text/html or text/plain)
           $nocache     - Boolean 1 = nocache
   Returns: HTTP Response headers constructed using CGI.pm
   
   =cut
   
   #############################################
   #############################################
   sub cgi_header {
       my ($contenttype,$nocache) = @_;
       my $mimetypes = MIME::Types->new;
       my %headers;
       if ($contenttype ne '') {
           if ($mimetypes->type($contenttype) ne '') {
               $headers{'-type'} = $contenttype;
               if ($contenttype =~ m{^text/}) {
                   $headers{'-charset'} = 'utf-8';
               }
           }
       }
       if ($nocache) {
          $headers{'-expires'} = 'now';
       }
       if (%headers) {
           return CGI::header(%headers);
       }
       return;
   }
   
 =pod  =pod
   

Removed from v.1.7  
changed lines
  Added in v.1.15


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