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

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

version 1.11, 2008/12/25 01:51:03 version 1.15, 2016/08/01 15:19:05
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();
Line 153  Returns: undef Line 154  Returns: undef
 #############################################  #############################################
 sub transfer_profile_to_env {  sub transfer_profile_to_env {
     my ($handle)=@_;      my ($handle)=@_;
    if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),      if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),
     0640)) {      0640)) {
  %Apache::lonnet::env = %disk_env;   %Apache::lonnet::env = %disk_env;
  untie(%disk_env);   untie(%disk_env);
Line 199  END Line 200  END
   
 =cgi_getitems()  =cgi_getitems()
   
 Inputs: $query (the CGI query string), and $getitems, a reference to a hash   Inputs: $query - the CGI query string (required)
           $getitems - reference to a hash (required)
           $possname - permitted names of keys (optional)
   
 Returns: nothing  Returns: nothing
   
Line 212  Side Effects: populates $getitems hash r Line 215  Side Effects: populates $getitems hash r
 #############################################  #############################################
 #############################################  #############################################
 sub cgi_getitems {  sub cgi_getitems {
     my ($query,$getitems)= @_;      my ($query,$getitems,$possnames)= @_;
     foreach (split(/&/,$query)) {      foreach (split(/&/,$query)) {
         my ($name, $value) = split(/=/,$_);          my ($name, $value) = split(/=/,$_);
         $name = &unescape($name);          $name = &unescape($name);
           if (ref($possnames) eq 'ARRAY') {
               next unless (grep(/^\Q$name\E$/,@{$possnames}));
           }
         $value =~ tr/+/ /;          $value =~ tr/+/ /;
         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;          $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
         push(@{$$getitems{$name}},$value);          push(@{$$getitems{$name}},$value);
     }      }
     return;      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.11  
changed lines
  Added in v.1.15

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