--- loncom/cgi/loncgi.pm 2008/12/25 01:51:03 1.11 +++ loncom/cgi/loncgi.pm 2016/08/01 15:19:05 1.15 @@ -1,7 +1,7 @@ # # LON-CAPA helpers for cgi-bin scripts # -# $Id: loncgi.pm,v 1.11 2008/12/25 01:51:03 raeburn Exp $ +# $Id: loncgi.pm,v 1.15 2016/08/01 15:19:05 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -54,8 +54,9 @@ use warnings FATAL=>'all'; no warnings 'uninitialized'; use lib '/home/httpd/lib/perl/'; -use CGI(); +use CGI qw(:standard); use CGI::Cookie(); +use MIME::Types(); use Fcntl qw(:flock); use LONCAPA; use LONCAPA::Configuration(); @@ -153,7 +154,7 @@ Returns: undef ############################################# sub transfer_profile_to_env { 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)) { %Apache::lonnet::env = %disk_env; untie(%disk_env); @@ -199,7 +200,9 @@ END =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 @@ -212,16 +215,55 @@ Side Effects: populates $getitems hash r ############################################# ############################################# sub cgi_getitems { - my ($query,$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