version 1.8, 2006/09/19 21:36:31
|
version 1.11, 2008/12/25 01:51:03
|
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 60 use Fcntl qw(:flock);
|
Line 60 use Fcntl qw(:flock);
|
use LONCAPA; |
use LONCAPA; |
use LONCAPA::Configuration(); |
use LONCAPA::Configuration(); |
use GDBM_File; |
use GDBM_File; |
|
use Apache::lonlocal; |
|
|
my $lonidsdir; |
my $lonidsdir; |
|
|
Line 69 BEGIN {
|
Line 70 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 86 Loads the users environment into the %en
|
Line 89 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 103 sub check_cookie_and_load_env {
|
Line 112 sub check_cookie_and_load_env {
|
|
|
=pod |
=pod |
|
|
=item check_cookie |
=item check_cookie() |
|
|
Inputs: none |
Inputs: none |
|
|
Line 130 sub check_cookie {
|
Line 139 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 156 sub transfer_profile_to_env {
|
Line 165 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), and $getitems, a reference to a hash |
|
|
|
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)= @_; |
|
foreach (split(/&/,$query)) { |
|
my ($name, $value) = split(/=/,$_); |
|
$name = &unescape($name); |
|
$value =~ tr/+/ /; |
|
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
push(@{$$getitems{$name}},$value); |
|
} |
|
return; |
|
} |
|
|
=pod |
=pod |
|
|