--- loncom/enrollment/Enrollment.pm	2017/09/18 14:21:45	1.51
+++ loncom/enrollment/Enrollment.pm	2022/02/03 17:37:57	1.58
@@ -1,5 +1,5 @@
 # Automated Enrollment manager
-# $Id: Enrollment.pm,v 1.51 2017/09/18 14:21:45 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) && (!$added)) {
+                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 {