version 1.4, 2005/05/03 22:22:47
|
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 52 package LONCAPA::loncgi;
|
Line 52 package LONCAPA::loncgi;
|
use strict; |
use strict; |
use warnings FATAL=>'all'; |
use warnings FATAL=>'all'; |
no warnings 'uninitialized'; |
no warnings 'uninitialized'; |
use vars qw(%env); |
|
|
|
|
use lib '/home/httpd/lib/perl/'; |
use CGI(); |
use CGI(); |
use CGI::Cookie(); |
use CGI::Cookie(); |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
|
use LONCAPA; |
use LONCAPA::Configuration(); |
use LONCAPA::Configuration(); |
require Exporter; |
use GDBM_File; |
|
use Apache::lonlocal; |
#our @ISA = qw (Exporter); |
|
#our @EXPORT = qw(%env); |
|
|
|
my $lonidsdir; |
my $lonidsdir; |
|
|
Line 71 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 88 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 105 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 132 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 146 Returns: undef
|
Line 153 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); |
|
$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 167 sub transfer_profile_to_env {
|
Line 167 sub transfer_profile_to_env {
|
|
|
=pod |
=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 |
|
|
=back |
=back |
|
|
=cut |
=cut |