Annotation of loncom/cgi/loncgi.pm, revision 1.3
1.1 matthew 1: #
2: # LON-CAPA helpers for cgi-bin scripts
3: #
1.3 ! albertel 4: # $Id: loncgi.pm,v 1.2 2005/04/05 20:43:27 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: use vars qw(%env);
56:
1.1 matthew 57: use CGI();
58: use CGI::Cookie();
59: use Fcntl qw(:flock);
60: use LONCAPA::Configuration();
1.2 albertel 61: require Exporter;
62:
63: our @ISA = qw (Exporter);
64: our @EXPORT = qw(%env);
1.1 matthew 65:
66: my $lonidsdir;
67:
68: BEGIN {
69: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
70: delete $perlvar->{'lonReceipt'};
71: $lonidsdir = $perlvar->{'lonIDsDir'};
72: }
73:
74: #############################################
75: #############################################
76:
77: =pod
78:
79: =item check_cookie_and_load_env
80:
81: Inputs: none
82:
83: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
1.3 ! albertel 84: Loads the users environment into the %env hash if the cookie is correct.
1.1 matthew 85:
86: =cut
87:
88: #############################################
89: #############################################
90: sub check_cookie_and_load_env {
91: my %cookies=fetch CGI::Cookie;
92: if (exists($cookies{'lonID'}) &&
93: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
94: # cookie found
95: &transfer_profile_to_env($cookies{'lonID'}->value);
96: return 1;
97: } else {
98: # No cookie found
99: return 0;
100: }
101: }
102:
103: #############################################
104: #############################################
105:
106: =pod
107:
108: =item check_cookie
109:
110: Inputs: none
111:
112: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
113:
114: =cut
115:
116: #############################################
117: #############################################
118: sub check_cookie {
119: my %cookies=fetch CGI::Cookie;
120: if (exists($cookies{'lonID'}) &&
121: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
122: # cookie found
123: return 1;
124: } else {
125: # No cookie found
126: return 0;
127: }
128: }
129:
130: #############################################
131: #############################################
132:
133: =pod
134:
135: =item transfer_profile_to_env
136:
1.3 ! albertel 137: Load the users environment into the %env hash.
1.1 matthew 138:
139: Inputs: $handle, the name of the users LON-CAPA cookie.
140:
141: Returns: undef
142:
143: =cut
144:
145: #############################################
146: #############################################
147: sub transfer_profile_to_env {
148: my ($handle)=@_;
149: my @profile;
150: {
151: open(IDFILE, "<$lonidsdir/$handle.id");
152: flock(IDFILE,LOCK_SH);
153: @profile=<IDFILE>;
154: close(IDFILE);
155: }
156: foreach my $envrow (@profile) {
157: chomp($envrow);
158: my ($envname,$envvalue)=split(/=/,$envrow);
159: $ENV{$envname} = $envvalue;
1.2 albertel 160: $env{$envname} = $envvalue;
1.1 matthew 161: }
162: $ENV{'user.environment'} = "$lonidsdir/$handle.id";
1.2 albertel 163: $env{'user.environment'} = "$lonidsdir/$handle.id";
1.1 matthew 164: return undef;
165: }
166:
167: #############################################
168: #############################################
169:
170: =pod
171:
172: =back
173:
174: =cut
175:
176: 1;
177:
178: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>