![]() ![]() | ![]() |
- the great ENV -> env switch has commenced
1: # 2: # LON-CAPA helpers for cgi-bin scripts 3: # 4: # $Id: loncgi.pm,v 1.2 2005/04/05 20:43:27 albertel Exp $ 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'; 55: use vars qw(%env); 56: 57: use CGI(); 58: use CGI::Cookie(); 59: use Fcntl qw(:flock); 60: use LONCAPA::Configuration(); 61: require Exporter; 62: 63: our @ISA = qw (Exporter); 64: our @EXPORT = qw(%env); 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. 84: Loads the users environment into the %ENV hash if the cookie is correct. 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: 137: Load the users environment into the %ENV hash. 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; 160: $env{$envname} = $envvalue; 161: } 162: $ENV{'user.environment'} = "$lonidsdir/$handle.id"; 163: $env{'user.environment'} = "$lonidsdir/$handle.id"; 164: return undef; 165: } 166: 167: ############################################# 168: ############################################# 169: 170: =pod 171: 172: =back 173: 174: =cut 175: 176: 1; 177: 178: __END__