Annotation of loncom/cgi/loncgi.pm, revision 1.5
1.1 matthew 1: #
2: # LON-CAPA helpers for cgi-bin scripts
3: #
1.5 ! albertel 4: # $Id: loncgi.pm,v 1.4 2005/05/03 22:22:47 albertel Exp $
1.1 matthew 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: #############################################
29: #############################################
30:
31: =pod
32:
33: =head1 NAME
34:
35: loncgi
36:
37: =head1 SYNOPSIS
38:
39: Provides subroutines for checking a LON-CAPA cookie and loading the users
40: environment.
41:
42: =head1 Subroutines
43:
44: =over 4
45:
46: =cut
47:
48: #############################################
49: #############################################
50: package LONCAPA::loncgi;
51:
52: use strict;
53: use warnings FATAL=>'all';
54: no warnings 'uninitialized';
1.2 albertel 55:
1.1 matthew 56: use CGI();
57: use CGI::Cookie();
58: use Fcntl qw(:flock);
59: use LONCAPA::Configuration();
60:
61: my $lonidsdir;
62:
63: BEGIN {
64: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
65: delete $perlvar->{'lonReceipt'};
66: $lonidsdir = $perlvar->{'lonIDsDir'};
67: }
68:
69: #############################################
70: #############################################
71:
72: =pod
73:
74: =item check_cookie_and_load_env
75:
76: Inputs: none
77:
78: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
1.3 albertel 79: Loads the users environment into the %env hash if the cookie is correct.
1.1 matthew 80:
81: =cut
82:
83: #############################################
84: #############################################
85: sub check_cookie_and_load_env {
86: my %cookies=fetch CGI::Cookie;
87: if (exists($cookies{'lonID'}) &&
88: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
89: # cookie found
90: &transfer_profile_to_env($cookies{'lonID'}->value);
91: return 1;
92: } else {
93: # No cookie found
94: return 0;
95: }
96: }
97:
98: #############################################
99: #############################################
100:
101: =pod
102:
103: =item check_cookie
104:
105: Inputs: none
106:
107: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
108:
109: =cut
110:
111: #############################################
112: #############################################
113: sub check_cookie {
114: my %cookies=fetch CGI::Cookie;
115: if (exists($cookies{'lonID'}) &&
116: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
117: # cookie found
118: return 1;
119: } else {
120: # No cookie found
121: return 0;
122: }
123: }
124:
125: #############################################
126: #############################################
127:
128: =pod
129:
130: =item transfer_profile_to_env
131:
1.3 albertel 132: Load the users environment into the %env hash.
1.1 matthew 133:
134: Inputs: $handle, the name of the users LON-CAPA cookie.
135:
136: Returns: undef
137:
138: =cut
139:
140: #############################################
141: #############################################
142: sub transfer_profile_to_env {
143: my ($handle)=@_;
144: my @profile;
145: {
146: open(IDFILE, "<$lonidsdir/$handle.id");
147: flock(IDFILE,LOCK_SH);
148: @profile=<IDFILE>;
149: close(IDFILE);
150: }
151: foreach my $envrow (@profile) {
152: chomp($envrow);
153: my ($envname,$envvalue)=split(/=/,$envrow);
1.4 albertel 154: $Apache::lonnet::env{$envname} = $envvalue;
1.1 matthew 155: }
1.4 albertel 156: $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
1.1 matthew 157: return undef;
158: }
159:
160: #############################################
161: #############################################
162:
163: =pod
164:
165: =back
166:
167: =cut
168:
169: 1;
170:
171: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>