File:
[LON-CAPA] /
loncom /
enrollment /
Enrollment.pm
Revision
1.15:
download - view:
text,
annotated -
select for diffs
Thu Jun 17 18:31:24 2004 UTC (19 years, 11 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Calls to functions in localenroll.pm mediated by lonc/lond now include domain
in the set of passed parameters to support domain-specific variants in a single
localenroll.pm file housed on a multi-domain library server.
Automated enrollment now sets first access and last access dates for student
roles based on defaults set on course creation, and modifiable via a number
of mechanisms in the Enrollment Manager, and Automated Enrollment Manager.
The Automated Enrollment Manager now provides a utility to allow enrollment type
to be toggled between 'auto' and 'manual', so that students added via CSV file
or singly can become liable for automated update (dropping, section switching
etc.).
# Automated Enrollment manager
# $Id: Enrollment.pm,v 1.15 2004/06/17 18:31:24 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package LONCAPA::Enrollment;
use Apache::loncoursedata;
use Apache::lonnet;
use Apache::lonmsg;
use HTML::Entities;
use LONCAPA::Configuration;
use Time::Local;
use lib '/home/httpd/lib/perl';
use localenroll;
use strict;
sub update_LC {
my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context) = @_;
# Get current LON-CAPA student enrollment for this class
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $cid = $dom."_".$crs;
my $roster = &Apache::loncoursedata::get_classlist($cid,$dom,$crs);
my $cend = &Apache::loncoursedata::CL_END;
my $cstart = &Apache::loncoursedata::CL_START;
my $stuid=&Apache::loncoursedata::CL_ID;
my $sec=&Apache::loncoursedata::CL_SECTION;
my $status=&Apache::loncoursedata::CL_STATUS;
my $type=&Apache::loncoursedata::CL_TYPE;
my @localstudents = ();
my @futurestudents = ();
my @activestudents = ();
my $currlist;
foreach my $uname (keys %{$roster} ) {
if ($uname =~ m/^(.+):$dom$/) {
if ($$roster{$uname}[$status] eq "Active") {
push @activestudents, $1;
@{$$currlist{$1}} = @{$$roster{$uname}};
push @localstudents, $1;
} elsif ( ($$roster{$uname}[$cstart] > time) && ($$roster{$uname}[$cend] > time || $$roster{$uname}[$cend] == 0 || $$roster{$uname}[$cend] eq '') ) {
push @futurestudents, $1;
@{$$currlist{$1}} = @{$$roster{$uname}};
push @localstudents, $1;
}
}
}
my $linefeed = '';
my $addresult = '';
my $dropresult = '';
if ($context eq "updatenow") {
$linefeed = "</li>\n<li>";
} elsif ($context eq "automated") {
$linefeed = "\n";
}
my $enrollcount = 0;
my $dropcount = 0;
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand in case initial passwords have to be generated for new users.
# Get mapping of IDs to usernames for current LON-CAPA student enrollment for this class
my @LCids = ();
my %unameFromLCid = ();
foreach my $uname (sort keys %{$currlist}) {
my $stuID = $$currlist{$uname}[$stuid];
if (!grep/^$stuID$/,@LCids) {
push @LCids, $stuID;
@{$unameFromLCid{$stuID}} = ();
}
push @{$unameFromLCid{$stuID}},$uname;
}
# Get latest institutional enrollment for this class.
my %allenrolled = ();
my @reg_students = ();
my %place = ();
$place{'autharg'} = &CL_autharg();
$place{'authtype'} = &CL_authtype();
$place{'email'} = &CL_email();
$place{'enddate'} = &CL_enddate();
$place{'firstname'} = &CL_firstname();
$place{'generation'} = &CL_generation();
$place{'groupID'} = &CL_groupID();
$place{'lastname'} = &CL_lastname();
$place{'middlename'} = &CL_middlename();
$place{'startdate'} = &CL_startdate();
$place{'studentID'} = &CL_studentID();
my %ucount = ();
my %enrollinfo = ();
foreach my $class (@{$classesref}) {
my %enrolled = ();
&parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);
foreach my $uname (sort keys %enrolled ) {
if (!grep/^$uname$/,@reg_students) {
push @reg_students,$uname;
$ucount{$uname} = 0;
@{$allenrolled{$uname}} = ();
}
@{$allenrolled{$uname}[$ucount{$uname}]} = @{$enrolled{$uname}};
$ucount{$uname} ++;
}
}
# Check for multiple sections for a single student
my @okusers = ();
foreach my $uname (@reg_students) {
if (@{$allenrolled{$uname}} > 1) {
my @sections = ();
my $saved;
for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
my @stuinfo = @{$allenrolled{$uname}[$i]};
my $secnum = $stuinfo[ $place{'groupID'} ];
unless ($secnum eq '') {
unless (grep/^$secnum$/,@sections) {
$saved = $i;
push @sections,$secnum;
}
}
}
if (@sections == 0) {
@{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
push @okusers, $uname;
}
elsif (@sections == 1) {
@{$enrollinfo{$uname}} = @{$allenrolled{$uname}[$saved]};
push @okusers, $uname;
}
elsif (@sections > 1) {
$$logmsg = "$uname appears in classlists for the more than one section of this course, i.e. in sections: ";
foreach (@sections) {
$$logmsg .= " $_,";
}
chop($$logmsg);
$$logmsg .= ". Because of this ambiguity, no enrollment action was taken for this student.".$linefeed;
}
} else {
@{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
push @okusers, $uname;
}
}
# Get mapping of student IDs to usernames for users in institutional data for this class
my @allINids = ();
my %unameFromINid = ();
foreach my $uname (@okusers) {
$enrollinfo{$uname}[ $place{'studentID'} ] =~ tr/A-Z/a-z/;
my $stuID = $enrollinfo{$uname}[ $place{'studentID'} ];
if (grep/^$stuID$/,@allINids) {
push @{$unameFromINid{$stuID}},$uname;
} else {
push @allINids, $stuID;
@{$unameFromINid{$stuID}} = $uname;
}
}
# Explicitly allow access to creation/modification of students if called as an automated process.
if ($context eq 'automated') {
$ENV{'allowed.cst'}='F';
}
# Compare IDs with existing LON-CAPA enrollment for this class
foreach my $uname (@okusers) {
unless ($uname eq '') {
my %uidhash=&Apache::lonnet::idrget($dom,$uname);
my @stuinfo = @{$enrollinfo{$uname}};
my $access = '';
if (grep/^$uname$/,@localstudents) {
# Check for studentID changes
if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) ) {
unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {
$$logmsg .= "Change in ID for $uname. StudentID in LON-CAPA system is $uidhash{$uname}; StudentID in institutional data is $stuinfo[ $place{studentID} ]".$linefeed;
}
}
# Check for section changes
if ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
# Check for access date changes for students with access starting in the future.
if ( (grep/^$uname$/,@futurestudents) && ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
my $datechange = 0;
unless ($$currlist{$uname}[$cstart] eq $startdate) {
$datechange = 1;
}
if (!$datechange) {
if (!$$currlist{$uname}[$cend]) {
if ($enddate) {
$datechange = 1;
}
} elsif ($$currlist{$uname}[$cend] ne $enddate) {
$datechange = 1;
}
}
if ($datechange) {
my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto',$cid);
$access = &showaccess($enddate,$startdate);
if ($modify_access_result =~ /^ok/) {
$$logmsg .= "Change in access dates for $uname.".$access.$linefeed;
} else {
$$logmsg .= "Error when attempting to change start and/or end access dates for $uname in section: ".$stuinfo[ $place{groupID} ]." -error $modify_access_result".$linefeed;
}
}
}
} else {
if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
# Delete from roles.db for current section
my $expiretime = time;
my $uurl='/'.$cid;
$uurl=~s/\_/\//g;
if ($$currlist{$uname}[$sec]) {
$uurl.='/'.$$currlist{$uname}[$sec];
}
my $expire_role_result = &Apache::lonnet::assignrole($dom,$uname,$uurl,'st',$expiretime);
if ($expire_role_result eq 'ok') {
my $modify_section_result;
if (grep/^$uname$/,@activestudents) {
$modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$$currlist{$uname}[$cend],$$currlist{$uname}[$cstart],'auto',$cid);
} else {
$modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto',$cid);
$access = &showaccess($enddate,$startdate);
}
if ($modify_section_result =~ /^ok/) {
$$logmsg .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$access.$linefeed;
} else {
$$logmsg .= "Error when attempting section change for $uname from old section ".$$currlist{$uname}[$sec]." to new section: ".$stuinfo[ $place{groupID} ]." -error: $modify_section_result".$linefeed;
}
} else {
$$logmsg .= "Error when attempting to expire role for $uname in old section" .$$currlist{$uname}[$sec]." -error: $expire_role_result".$linefeed;
}
}
}
} else {
# Check for changed usernames by checking studentIDs
if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {
if (grep/^$$currlist{$uname}[ $place{'studentID'} ]$/,@allINids) {
foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } } ) {
if (grep/^$match$/,@okusers) {
$$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $uname and student ID: ".$$currlist{$uname}[ $place{studentID} ].". This username has been dropped from the institutional classlist, but the same student ID is used for user: $match who still appears in the institutional classlist. You may need to contact your Domain Coordinator to request a move of the student data files for user: $uname to $match".$linefeed;
}
}
}
} elsif ($adds == 1) {
# Add student to LON-CAPA classlist
my $auth = $stuinfo[ $place{'authtype'} ];
my $authparam = $stuinfo[ $place{'autharg'} ];
my $first = $stuinfo[ $place{'firstname'} ];
my $middle = $stuinfo[ $place{'middlename'} ];
my $last = $stuinfo[ $place{'lastname'} ];
my $gene = $stuinfo[ $place{'generation'} ];
my $usec = $stuinfo[ $place{'groupID'} ];
my $end = $stuinfo[ $place{'enddate'} ];
my $start = $stuinfo[ $place{'startdate'} ];
my $emailaddr = $stuinfo[ $place{'email'} ];
my $pid = $stuinfo[ $place{'studentID'} ];
# remove non alphanumeric values from section
$usec =~ s/\W//g;
unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }
my $emailenc = &HTML::Entities::encode($emailaddr,'<>&"');
# Use course defaults where entry is absent
if ( ($auth eq '') || (!defined($auth)) ) {
$auth = $authtype;
}
if ( ($authparam eq '') || (!defined($authparam)) ) {
$authparam = $autharg;
}
if ( ($end eq '') || (!defined($end)) ) {
$end = $enddate;
}
if ( ($start eq '') || (!defined($start)) ) {
$start = $startdate;
}
# Clean up whitespace
foreach (\$dom,\$uname,\$pid,\$first,\$middle,\$last,\$gene,\$usec) {
$$_ =~ s/(\s+$|^\s+)//g;
}
# Check for existing account in this LON-CAPA domain for this username
my $uhome=&Apache::lonnet::homeserver($uname,$dom);
if ($uhome eq 'no_host') { # User does not exist
my $create_passwd = 0;
my $authchk = '';
unless ($authparam eq '') { $authchk = 'ok'; };
# If no account exists and passwords should be generated
if ($auth eq "internal") {
if ($authparam eq '') {
($authparam) = &create_password();
if ($authparam eq '') {
$authchk = '';
} else {
$create_passwd = 1;
$authchk = 'ok';
}
}
} elsif ($auth eq "localauth") {
($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);
} elsif ($auth =~ m/^krb/) {
if ($authparam eq '') {
$$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new student was not enrolled in the course.".$linefeed;
$authchk = 'invalid';
}
} else {
$authchk = 'invalid';
$$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the student was not enrolled in the course.".$linefeed;
}
if ($authchk eq 'ok') {
# Now create user.
my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto',$cid);
if ($reply eq 'ok') {
$access = &showaccess($end,$start);
$enrollcount ++;
$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
if ($context eq 'automated') {
$$logmsg .= "New $dom user $uname added successfully.";
}
unless ($emailenc eq '') {
my %emailHash;
$emailHash{'critnotification'} = $emailenc;
$emailHash{'notification'} = $emailenc;
my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);
}
if ($create_passwd) {
# Send e-mail with initial password to new user at $emailaddr.
# If e-mail address is invalid, send password via message to courseowner i
# (if automated call) or to user if roster update.
if ($emailaddr eq '') {
$$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";
} else {
my $subject = "New LON-CAPA account";
my $body = "You have been enrolled in the LON-CAPA system at your school, because you are a registered student in a class that is using the LON-CAPA course management and online homework system.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'};
&Apache::lonmsg::sendemail($emailaddr,$subject,$body);
}
if ($context eq 'automated') {
$$logmsg .= " Initial password - - sent to ".$emailaddr.$linefeed;
}
} else {
if ($context eq 'automated') {
$$logmsg .= $linefeed;
}
}
} else {
$$logmsg .= "An error occurred adding new user $uname - ".$reply.$linefeed;
}
}
} else {
# Get the user's information and authentication
my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);
my ($tmp) = keys(%userenv);
if ($tmp =~ /^(con_lost|error)/i) {
%userenv = ();
}
# Get the user's e-mail address
if ($userenv{critnotification} =~ m/%40/) {
unless ($emailenc eq $userenv{critnotification}) {
$$logmsg .= "Current critical notification e-mail - ".$userenv{critnotification}." for $uname is different to e-mail address in Institutional classlist - ".$emailenc.$linefeed;
}
}
if ($userenv{notification} =~ m/%40/) {
unless ($emailenc eq $userenv{critnotification}) {
$$logmsg .= "Current standard notification e-mail - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
}
}
my $krbdefdom = '';
my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
if ($currentauth=~/^(krb[45]):(.*)/) {
$currentauth = $1;
$krbdefdom = $2;
} elsif ($currentauth=~ /^(unix|internal|localauth):/) {
$currentauth = $1;
} else {
$$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;
}
# Report if authentication methods are different.
if ($currentauth ne $auth) {
$$logmsg .= "Authentication type mismatch for $uname - '$currentauth' in system, '$auth' based on information in classlist or default for this course.".$linefeed;
} elsif ($auth =~ m/^krb/) {
if ($krbdefdom ne $authparam) {
$$logmsg .= "Kerberos domain mismatch for $uname - '$krbdefdom' in system, '$authparam' based on information in classlist or default for this course.".$linefeed;
}
}
# Check user data
if ($first ne $userenv{'firstname'} ||
$middle ne $userenv{'middlename'} ||
$last ne $userenv{'lastname'} ||
$gene ne $userenv{'generation'} ||
$pid ne $userenv{'id'} ) {
# Make the change(s)
my %changeHash;
$changeHash{'firstname'} = $first;
$changeHash{'middlename'} = $middle;
$changeHash{'lastname'} = $last;
$changeHash{'generation'} = $gene;
$changeHash{'id'} = $pid;
my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
if ($putresult eq 'ok') {
$$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
} else {
$$logmsg .= "There was a problem modifying user data for existing user - $uname -error: $putresult, enrollment will still be attempted.".$linefeed;
}
}
# Assign the role of student in the course.
my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto',$cid);
if ($classlist_reply eq 'ok') {
$access = &showaccess($end,$start);
$enrollcount ++;
$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
if ($context eq 'automated') {
$$logmsg .= "Existing $dom user $uname enrolled successfully.".$linefeed;
}
} else {
$$logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment -error: $classlist_reply, so no enrollment occurred for this user.".$linefeed;
}
}
}
}
}
}
# Do drops
if ( ($drops == 1) && (@reg_students > 0) ) {
foreach my $uname (@localstudents) {
if ($$currlist{$uname}[$type] eq "auto") {
my @saved = ();
if (!grep/^$uname$/,@reg_students) {
# Check for changed usernames by checking studentIDs
if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
$$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $uname and student ID: $$currlist{$uname}[ $place{studentID} ]. This username has been dropped from the institutional classlist, but the same student ID is used for user: $match who still appears in the institutional classlist. You may need to move the student data files for user: $uname to $match.".$linefeed;
push @saved,$uname;
}
} elsif (@saved == 0) {
my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto',$cid);
if ($drop_reply !~ /^ok/) {
$$logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply.".$linefeed;
} else {
$dropcount ++;
my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
$dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname." dropped from section/group ".$$currlist{$uname}[$sec].$linefeed;
if ($context eq 'automated') {
$$logmsg .= "User $uname student role expired from course.".$linefeed;
}
}
}
}
}
}
}
# Terminated explictly allowed access to student creation/modification
if ($context eq 'automated') {
delete($ENV{'allowed.cst'});
}
if ($enrollcount > 0) {
if ($context eq "updatenow") {
$addresult = substr($addresult,0,rindex($addresult,"<li>"));
$addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</li></ul><br/><br/>";
} else {
$addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";
}
}
if ($dropcount > 0) {
if ($context eq "updatenow") {
$dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));
$dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</li></ul><br/><br/>";
} else {
$dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
}
}
if ( ($adds) && ($enrollcount == 0) ) {
$addresult = "There were no new students to add to the course.";
if ($context eq "updatenow") {
$addresult .="<br/><br/>";
} else {
$addresult .="\n";
}
}
if ( ($drops) && ($dropcount == 0) ) {
$dropresult = "There were no students with roles to expire because all active students previously added to the course from institutional classlist(s) are still officially registered.";
if ($context eq "updatenow") {
$dropresult .="<br/>";
} else {
$dropresult .="\n";
}
}
my $changecount = $enrollcount + $dropcount;
return ($changecount,$addresult.$dropresult);
}
sub showaccess {
my ($end,$start) = @_;
my $showstart;
my $showend;
if ( (!$start) || ($start <= time) ) {
$showstart = 'immediately';
} else {
$showstart = &Apache::lonlocal::locallocaltime($start);
}
if (!$end) {
$showend = 'no end date';
} else {
$showend = &Apache::lonlocal::locallocaltime($end);
}
my $access_msg = " Access starts: ".$showstart.", ends: ".$showend.".";
return $access_msg;
}
sub parse_classlist {
my ($tmpdir,$dom,$crs,$class,$placeref,$groupID,$studentsref) = @_;
my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";
my $uname = '';
my @state;
my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID');
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "students student") {
$uname = $attr->{username};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "students student groupID") {
$$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
} elsif ("@state" eq "students student startdate") {
my $start = $text;
unless ($text eq '') {
$start = &process_date($text);
}
$$studentsref{$uname}[ $$placeref{'startdate'} ] = $start;
} elsif ("@state" eq "students student enddate") {
my $end = $text;
unless ($text eq '') {
$end = &process_date($text);
}
$$studentsref{$uname}[ $$placeref{'enddate'} ] = $end;
} else {
foreach my $item (@items) {
if ("@state" eq "students student $item") {
$$studentsref{$uname}[ $$placeref{$item} ] = $text;
}
}
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->parse_file($xmlfile);
$p->eof;
if (-e "$xmlfile") {
unlink $xmlfile;
}
return;
}
sub process_date {
my $timestr = shift;
my $timestamp = '';
if ($timestr =~ m/^\d{4}:\d{2}:\d{2}/) {
my @entries = split/:/,$timestr;
for (my $j=0; $j<@entries; $j++) {
if ( length($entries[$j]) > 1 ) {
$entries[$j] =~ s/^0//;
}
}
$entries[1] = $entries[1] - 1;
$timestamp = timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);
}
return $timestamp;
}
sub create_password {
my $passwd = '';
my @letts = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
for (my $i=0; $i<8; $i++) {
my $lettnum = int (rand 2);
my $item = '';
if ($lettnum) {
$item = $letts[int( rand(26) )];
my $uppercase = int(rand 2);
if ($uppercase) {
$item =~ tr/a-z/A-Z/;
}
} else {
$item = int( rand(10) );
}
$passwd .= $item;
}
return ($passwd);
}
sub check_user_status {
my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;
my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
my @uroles = keys %userinfo;
my $srchstr;
my $active_chk = 'none';
if (@uroles > 0) {
if ( ($role eq 'cc') || ($secgrp eq '') || ( !defined($secgrp) ) ) {
$srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
} else {
$srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role;
}
if (grep/^$srchstr$/,@uroles) {
my $role_end = 0;
my $role_start = 0;
$active_chk = 'ok';
if ( $userinfo{$srchstr} =~ m/^($role)_(\d+)/ ) {
$role_end = $2;
if ( $userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/ )
{
$role_start = $3;
}
}
if ($role_start > 0) {
if (time < $role_start) {
$active_chk = 'expired';
}
}
if ($role_end > 0) {
if (time > $role_end) {
$active_chk = 'expired';
}
}
}
}
return $active_chk;
}
sub CL_autharg { return 0; }
sub CL_authtype { return 1;}
sub CL_email { return 2;}
sub CL_enddate { return 3;}
sub CL_firstname { return 4;}
sub CL_generation { return 5;}
sub CL_groupID { return 6;}
sub CL_lastname { return 7;}
sub CL_middlename { return 8;}
sub CL_startdate { return 9; }
sub CL_studentID { return 10; }
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Enrollment.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / enrollment