version 1.21, 2005/01/30 01:07:35
|
version 1.27, 2006/01/12 01:30:44
|
Line 43 sub update_LC {
|
Line 43 sub update_LC {
|
# Get current LON-CAPA student enrollment for this class |
# Get current LON-CAPA student enrollment for this class |
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $cid = $dom."_".$crs; |
my $cid = $dom."_".$crs; |
my $roster = &Apache::loncoursedata::get_classlist($cid,$dom,$crs); |
my $roster = &Apache::loncoursedata::get_classlist($dom,$crs); |
my $cend = &Apache::loncoursedata::CL_END; |
my $cend = &Apache::loncoursedata::CL_END; |
my $cstart = &Apache::loncoursedata::CL_START; |
my $cstart = &Apache::loncoursedata::CL_START; |
my $stuid=&Apache::loncoursedata::CL_ID; |
my $stuid=&Apache::loncoursedata::CL_ID; |
Line 167 sub update_LC {
|
Line 167 sub update_LC {
|
push @okusers, $uname; |
push @okusers, $uname; |
} |
} |
elsif (@sections > 1) { |
elsif (@sections > 1) { |
$$logmsg = "$uname appears in classlists for the more than one section of this course, i.e. in sections: "; |
$$logmsg .= "$uname appears in classlists for more than one section of this course, i.e. in sections: "; |
foreach (@sections) { |
foreach (@sections) { |
$$logmsg .= " $_,"; |
$$logmsg .= " $_,"; |
} |
} |
Line 194 sub update_LC {
|
Line 194 sub update_LC {
|
} |
} |
# Explicitly allow access to creation/modification of students if called as an automated process. |
# Explicitly allow access to creation/modification of students if called as an automated process. |
if ($context eq 'automated') { |
if ($context eq 'automated') { |
$ENV{'allowed.cst'}='F'; |
$env{'allowed.cst'}='F'; |
} |
} |
|
|
# Compare IDs with existing LON-CAPA enrollment for this class |
# Compare IDs with existing LON-CAPA enrollment for this class |
Line 281 sub update_LC {
|
Line 281 sub update_LC {
|
} else { |
} else { |
# Check for changed usernames by checking studentIDs |
# Check for changed usernames by checking studentIDs |
if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) { |
if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) { |
if (grep/^$$currlist{$uname}[ $place{'studentID'} ]$/,@allINids) { |
foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } } ) { |
foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } } ) { |
$$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $match and student ID: ".$stuinfo[ $place{studentID} ].". "; |
if (grep/^$match$/,@okusers) { |
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; |
$$logmsg .= "The username $match remains in the institutional classlist, but the same student ID is used for new user: $uname now found in the institutional classlist. You may need to contact your Domain Coordinator to determine how to reolve this issue and whether to move student data files for user: $match to $uname. "; |
|
} else { |
|
unless ($drops == 1) { |
|
$$logmsg .= "This username - $match - has been dropped from the institutional classlist, but the student ID of this user is also used by $uname who now appears in the institutional classlist. You may need to contact your Domain Coordinator to request a move of the student data files for user: $match to $uname. "; |
} |
} |
} |
} |
|
$$logmsg .= "Because of this student ID conflict, the new username - $uname - has not been added to the LON-CAPA classlist.".$linefeed; |
} |
} |
} elsif ($adds == 1) { |
} elsif ($adds == 1) { |
my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc); |
my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc); |
Line 332 sub update_LC {
|
Line 336 sub update_LC {
|
# Check for changed usernames by checking studentIDs |
# Check for changed usernames by checking studentIDs |
if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) { |
if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) { |
foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) { |
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; |
$$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. Because of this, user $uname has not been dropped from the course.".$linefeed; |
push @saved,$uname; |
push @saved,$uname; |
} |
} |
} elsif (@saved == 0) { |
} elsif (@saved == 0) { |
Line 355 sub update_LC {
|
Line 359 sub update_LC {
|
|
|
# Terminated explictly allowed access to student creation/modification |
# Terminated explictly allowed access to student creation/modification |
if ($context eq 'automated') { |
if ($context eq 'automated') { |
delete($ENV{'allowed.cst'}); |
delete($env{'allowed.cst'}); |
} |
} |
if ($enrollcount > 0) { |
if ($enrollcount > 0) { |
if ($context eq "updatenow") { |
if ($context eq "updatenow") { |
Line 459 sub create_newuser {
|
Line 463 sub create_newuser {
|
if ($context eq 'createowner' || $context eq 'createcourse') { |
if ($context eq 'createowner' || $context eq 'createcourse') { |
my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr); |
my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr); |
if ($result eq 'ok' && $context eq 'createcourse') { |
if ($result eq 'ok' && $context eq 'createcourse') { |
$outcome = &Apache::loncreateuser::commit_standardrole($userurl,$role,$cdom,$crs,$start,$end); |
$outcome = &Apache::loncreateuser::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec); |
unless ($outcome =~ /^Error:/) { |
unless ($outcome =~ /^Error:/) { |
$outcome = 'ok'; |
$outcome = 'ok'; |
} |
} |
Line 482 sub create_newuser {
|
Line 486 sub create_newuser {
|
my %emailHash; |
my %emailHash; |
$emailHash{'critnotification'} = $emailenc; |
$emailHash{'critnotification'} = $emailenc; |
$emailHash{'notification'} = $emailenc; |
$emailHash{'notification'} = $emailenc; |
|
$emailHash{'permanentemail'} = $emailenc; |
my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname); |
my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname); |
} |
} |
if ($create_passwd) { |
if ($create_passwd) { |
Line 564 sub prepare_add {
|
Line 569 sub prepare_add {
|
sub execute_add { |
sub execute_add { |
my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_; |
my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_; |
# Get the user's information and authentication |
# Get the user's information and authentication |
my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname); |
my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail'],$dom,$uname); |
my ($tmp) = keys(%userenv); |
my ($tmp) = keys(%userenv); |
if ($tmp =~ /^(con_lost|error)/i) { |
if ($tmp =~ /^(con_lost|error)/i) { |
%userenv = (); |
%userenv = (); |
Line 577 sub execute_add {
|
Line 582 sub execute_add {
|
} |
} |
} |
} |
if ($userenv{notification} =~ m/%40/) { |
if ($userenv{notification} =~ m/%40/) { |
unless ($emailenc eq $userenv{critnotification}) { |
unless ($emailenc eq $userenv{notification}) { |
$$logmsg .= "Current standard notification e-mail |
$$logmsg .= "Current standard notification e-mail |
- ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed; |
- ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed; |
} |
} |
} |
} |
|
if ($userenv{permanentemail} =~ m/%40/) { |
|
unless ($emailenc eq $userenv{permanentemail}) { |
|
$$logmsg .= "Current permanent e-mail |
|
- ".$userenv{permanentemail}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed; |
|
} |
|
} |
my $krbdefdom = ''; |
my $krbdefdom = ''; |
my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom); |
my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom); |
if ($currentauth=~/^(krb[45]):(.*)/) { |
if ($currentauth=~/^(krb[45]):(.*)/) { |
Line 606 sub execute_add {
|
Line 617 sub execute_add {
|
$middle ne $userenv{'middlename'} || |
$middle ne $userenv{'middlename'} || |
$last ne $userenv{'lastname'} || |
$last ne $userenv{'lastname'} || |
$gene ne $userenv{'generation'} || |
$gene ne $userenv{'generation'} || |
$pid ne $userenv{'id'} ) { |
$pid ne $userenv{'id'} || |
|
$emailenc ne $userenv{'permanentemail'} ) { |
# Make the change(s) |
# Make the change(s) |
my %changeHash; |
my %changeHash; |
$changeHash{'firstname'} = $first; |
$changeHash{'firstname'} = $first; |
Line 614 sub execute_add {
|
Line 626 sub execute_add {
|
$changeHash{'lastname'} = $last; |
$changeHash{'lastname'} = $last; |
$changeHash{'generation'} = $gene; |
$changeHash{'generation'} = $gene; |
$changeHash{'id'} = $pid; |
$changeHash{'id'} = $pid; |
|
$changeHash{'permanentemail'} = $emailenc; |
my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname); |
my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname); |
if ($putresult eq 'ok') { |
if ($putresult eq 'ok') { |
$$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed; |
$$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed; |
Line 770 sub create_password {
|
Line 783 sub create_password {
|
return ($passwd); |
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 get_courseinfo { |
sub get_courseinfo { |
my ($dom,$crs,$courseinfo) = @_; |
my ($dom,$crs,$courseinfo) = @_; |
my $owner; |
my $owner; |