--- loncom/enrollment/Enrollment.pm 2017/06/18 22:29:01 1.50
+++ loncom/enrollment/Enrollment.pm 2022/02/03 17:37:57 1.58
@@ -1,5 +1,5 @@
# Automated Enrollment manager
-# $Id: Enrollment.pm,v 1.50 2017/06/18 22:29:01 raeburn Exp $
+# $Id: Enrollment.pm,v 1.58 2022/02/03 17:37:57 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,22 +25,24 @@
#
package LONCAPA::Enrollment;
+use lib '/home/httpd/lib/perl';
use Apache::loncoursedata;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonmsg;
use Apache::lonlocal;
use HTML::Entities;
+use HTML::Parser;
use LONCAPA::Configuration;
+use Math::Random;
use Time::Local;
-use lib '/home/httpd/lib/perl';
use strict;
sub update_LC {
my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,
- $showcredits,$defaultcredits,$autofailsafe,$classesref,$groupref,
- $logmsg,$newusermsg,$context,$phototypes) = @_;
+ $showcredits,$defaultcredits,$autofailsafe,$failsafe,$classesref,
+ $groupref,$logmsg,$newusermsg,$context,$phototypes) = @_;
# Get institutional code and title of this class
my %courseinfo = ();
&get_courseinfo($dom,$crs,\%courseinfo);
@@ -329,7 +331,7 @@ sub update_LC {
}
}
# Check for institutional section change
- if ($$currlist{$uname}[$instidx] ne $instsec) {
+ if (($$currlist{$uname}[$instidx] ne $instsec) && (!$added) && ($$currlist{$uname}[$type] eq "auto")) {
my $modify_instsec_result =
&Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
if ($modify_instsec_result =~ /^ok/) {
@@ -443,18 +445,27 @@ sub update_LC {
# Check for changed usernames by checking studentIDs
if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
- $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student/employee ID: [_2].',$uname,$$currlist{$uname}[ $place{studentID} ]).' '.&mt('This username has been dropped from the institutional classlist, but the same student/employee ID is used for user: [_1] who still appears in the institutional classlist.',$match).' '.&mt('You may need to move the student data files for user: [_1] to [_2]',$uname,$match).' '.&mt('Because of this, user [_1] has not been dropped from the course.',$uname).$linefeed;
+ $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student/employee ID: [_2].',$uname,$$currlist{$uname}[ $stuid ]).' '.&mt('This username has been dropped from the institutional classlist, but the same student/employee ID is used for user: [_1] who still appears in the institutional classlist.',$match).' '.&mt('You may need to move the student data files for user: [_1] to [_2]',$uname,$match).' '.&mt('Because of this, user [_1] has not been dropped from the course.',$uname).$linefeed;
push @saved,$uname;
}
} elsif (@saved == 0) {
# Check enrollment count for institutional section of student to be dropped
if ($$currlist{$uname}[$instidx]) {
if (exists($classcount{$$currlist{$uname}[$instidx]})) {
- if ($classcount{$$currlist{$uname}[$instidx]} == 0) {
+ if ($failsafe eq 'any') {
if ($autofailsafe) {
- push(@{$delaydrops{$$currlist{$uname}[$instidx]}},$uname);
+ push(@{$delaydrops{$$currlist{$uname}[$instidx]}},$uname);
next;
}
+ } else {
+ unless ($failsafe eq 'off') {
+ if ($classcount{$$currlist{$uname}[$instidx]} == 0) {
+ if ($autofailsafe) {
+ push(@{$delaydrops{$$currlist{$uname}[$instidx]}},$uname);
+ next;
+ }
+ }
+ }
}
}
}
@@ -477,7 +488,11 @@ sub update_LC {
foreach my $class (keys(%delaydrops)) {
if (ref($delaydrops{$class}) eq 'ARRAY') {
if ($autofailsafe < scalar(@{$delaydrops{$class}})) {
- $$logmsg .= &mt('The following students were not expired from the old section [_1] because the enrollment count retrieved for that institutional section was zero, and the number of students with roles to expire exceeded the failsafe threshold of [_2]:',$class,$autofailsafe);
+ if ($failsafe eq 'any') {
+ $$logmsg .= &mt('The following students were not expired from the old section [_1] because the number of students with roles to expire exceeded the failsafe threshold of [_2], set to apply when the enrollment retrieved for an institutional section is zero or greater:',$class,$autofailsafe);
+ } else {
+ $$logmsg .= &mt('The following students were not expired from the old section [_1] because the enrollment count retrieved for that institutional section was zero, and the number of students with roles to expire exceeded the failsafe threshold of [_2]:',$class,$autofailsafe);
+ }
if ($context eq "updatenow") {
$$logmsg .= '<br />'.join('<br />',@{$delaydrops{$class}}).$linefeed;
} elsif ($context eq "automated") {
@@ -564,7 +579,7 @@ sub create_newuser {
my $pid = $args->{'pid'};
my $first = $args->{'first'};
my $middle = $args->{'middle'};
- my $last = $args->{'last'} ;
+ my $last = $args->{'last'};
my $gene = $args->{'gene'};
my $usec = $args->{'usec'};
my $end = $args->{'end'};
@@ -586,7 +601,7 @@ sub create_newuser {
# If no account exists and passwords should be generated
if ($auth eq "internal") {
if ($authparam eq '') {
- $authparam = &create_password();
+ $authparam = &create_password($udom);
if ($authparam eq '') {
$authchk = '';
} else {
@@ -950,23 +965,80 @@ sub process_date {
}
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 ($udom) = @_;
+ my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
+ my ($min,$max,@chars);
+ $min = $Apache::lonnet::passwdmin;
+ if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+ if ($passwdconf{'min'} =~ /^\d+$/) {
+ if ($passwdconf{'min'} > $min) {
+ $min = $passwdconf{'min'};
+ }
+ }
+ if ($passwdconf{'max'} =~ /^\d+$/) {
+ $max = $passwdconf{'max'};
+ }
+ @chars = @{$passwdconf{'chars'}};
+ }
+ my @letts = qw(b c d f g h j k l m n p q r s t v w x y z);
+ my (@included,%reqd);
+ if (@chars) {
+ map { $reqd{$_} = 1; } @chars;
+ }
+ if ($reqd{'uc'}) {
+ my $letter = $letts[int( rand(21) )];
+ $letter =~ tr/a-z/A-Z/;
+ if ($letter ne '') {
+ push(@included,$letter);
+ }
+ }
+ if ($reqd{'lc'}) {
+ my $letter = $letts[int( rand(21) )];
+ if ($letter ne '') {
+ push(@included,$letter);
+ }
+ }
+ if ($reqd{'num'}) {
+ my $number = int( rand(10) );
+ if ($number ne '') {
+ push(@included,$number);
+ }
+ }
+ if ($reqd{'spec'}) {
+ my @specs = qw(! # * & _ - + $);
+ my $special = $specs[int( rand(8) )];
+ if ($special ne '') {
+ push(@included,$special);
+ }
+ }
+ my $start = 0;
+ if (scalar(@included) > 0) {
+ $start = scalar(@included);
+ }
+ my $end = 8;
+ if ($min =~ /^\d+$/) {
+ if ($min > $end) {
+ $end = $min;
+ }
+ }
+ for (my $i=$start; $i<$end; $i++) {
my $lettnum = int (rand 2);
my $item = '';
if ($lettnum) {
- $item = $letts[int( rand(26) )];
+ $item = $letts[int( rand(21) )];
my $uppercase = int(rand 2);
if ($uppercase) {
$item =~ tr/a-z/A-Z/;
}
} else {
$item = int( rand(10) );
- }
- $passwd .= $item;
+ }
+ if ($item ne '') {
+ push(@included,$item);
+ }
}
- return ($passwd);
+ my $passwd = join('',&Math::Random::random_permutation(@included));
+ return $passwd;
}
sub get_courseinfo {