--- loncom/enrollment/Enrollment.pm 2016/07/24 14:35:15 1.49 +++ loncom/enrollment/Enrollment.pm 2022/02/03 17:37:57 1.58 @@ -1,5 +1,5 @@ # Automated Enrollment manager -# $Id: Enrollment.pm,v 1.49 2016/07/24 14:35:15 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,11 +488,15 @@ 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 .= join('
',@{$delaydrops{$class}}).$linefeed; + $$logmsg .= '
'.join('
',@{$delaydrops{$class}}).$linefeed; } elsif ($context eq "automated") { - $$logmsg .= join($linefeed,@{$delaydrops{$class}}).$linefeed; + $$logmsg .= $linefeed.join($linefeed,@{$delaydrops{$class}}).$linefeed; } } else { foreach my $uname (@{$delaydrops{$class}}) { @@ -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 {