[LON-CAPA-cvs] cvs: modules /msu localenroll.pm
raeburn
raeburn at source.lon-capa.org
Tue Jun 15 16:55:57 EDT 2021
raeburn Tue Jun 15 20:55:57 2021 EDT
Modified files:
/modules/msu localenroll.pm
Log:
- Integration with MSU campus information systems
For Fall 2021 onwards, course sections can be alphanumeric (up to 5
characters) instead of being 3 digits (including leading zeroes).
Index: modules/msu/localenroll.pm
diff -u modules/msu/localenroll.pm:1.78 modules/msu/localenroll.pm:1.79
--- modules/msu/localenroll.pm:1.78 Mon Jun 14 16:40:45 2021
+++ modules/msu/localenroll.pm Tue Jun 15 20:55:57 2021
@@ -1,6 +1,6 @@
# functions to glue school database system into Lon-CAPA for
# automated enrollment
-# $Id: localenroll.pm,v 1.78 2021/06/14 16:40:45 raeburn Exp $
+# $Id: localenroll.pm,v 1.79 2021/06/15 20:55:57 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -144,11 +144,12 @@
unless ($canuse) {
# Check if the owner or any of the co-owner(s) is a Dept. Administrator
my $check_clifms;
- if ($class =~ m/^([suf]s)(\d{2})(\w{2,4})(\d{3,4}\w?)(\d{3})$/) {
+ if ($class =~ /^([suf]s)(\d{2})(\w{2,4})(\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my ($sem,$yr,$subj,$crse,$sec) = ($1,$2,$3,$4,$5);
$sem =~tr/a-z/A-Z/;
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
+ $sec =~s/^_//;
my ($check_clifms,$error);
if (&is_dept_administrator($sem,$yr,$subj,$crse,$owner,$dbh,\$error)) {
$check_clifms = 1;
@@ -183,15 +184,16 @@
<!DOCTYPE text>
<students>
|;
- if ($class =~ m/^([suf]s\d{2})(\w{2,4})(\d{3,4}\w?)(\d{3})$/) {
+ if ($class =~ /^([suf]s\d{2})(\w{2,4})(\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my ($sem,$subj,$crse,$sec) = ($1,$2,$3,$4);
$sem =~tr/a-z/A-Z/;
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
+ $sec =~s/^_//;
my $sth = $dbh->prepare("SELECT Pid,Pilot_Id,Student_Name,Sctn_Crdt_Hours FROM RO_ClassList WHERE (Term_Code = '$sem' AND Subj_Code = '$subj' AND Crse_Code = '$crse' AND Sctn_Code = '$sec') ORDER BY Student_Name");
$sth->execute();
while ( my($pid,$pilot,$name,$credits) = $sth->fetchrow_array ) {
- if ($pilot =~ m/^\w{2,8}$/) {
+ if ($pilot =~ /^\w{2,8}$/) {
$pilotcount ++;
$name =~ s/^\s+//;
$name =~ s/\s+$//;
@@ -272,7 +274,11 @@
$sth->execute();
while ( my @row = $sth->fetchrow_array() ) {
if (!grep/^99/, at row) {
- push(@secs, at row);
+ foreach my $poss (@row) {
+ if ($poss =~ /^\w{1,5}$/) {
+ push(@secs,$poss);
+ }
+ }
}
}
$sth->finish;
@@ -313,12 +319,13 @@
$outcome = "Inclusion of enrollment could not be established for the course section $course_id because the username of the owner contains invalid characters.";
return $outcome;
}
- if ($course_id =~ m/^([suf]s)(\d{2})(\w{2,4})(\d{3,4}\w?)(\d{3})$/) {
+ if ($course_id =~ /^([suf]s)(\d{2})(\w{2,4})(\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my ($sem,$yr,$subj,$crse,$sec) = ($1,$2,$3,$4,$5);
my $term = $sem.$yr;
$term =~tr/a-z/A-Z/;
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
+ $sec =~s/^_//;
my $recordtype;
if (($yr > 21) || (($yr == 21) && ($sem eq 'fs'))) {
$recordtype = qq(Record_Type='PI' OR Record_Type='SI' OR Record_Type ='GA');
@@ -362,7 +369,7 @@
}
}
if (@netids > 0) {
- foreach my $coowner (@netids) {
+ foreach my $coowner (@netids) {
my $clifmscoowner = $dbh->selectrow_array("SELECT count(*) FROM RO_CLIFMS WHERE Term_Code='$term' AND Subj_Code='$subj' AND Crse_Code='$crse' AND Sctn_Code='$sec' AND MSUNetID='$coowner' AND ($recordtype)");
if ($clifmscoowner > 0) {
if ($dbflaglc) {
@@ -487,7 +494,7 @@
sub validate_courseID {
my ($course_id,$dom) = @_;
my $outcome = '';
- if ($course_id =~ m/^([suf]s\d{2})(\w{2,4})(\d{3,4}\w?)(\d{3})$/) {
+ if ($course_id =~ /^([suf]s\d{2})(\w{2,4})(\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my $term = $1;
my $subj = $2;
my $crse = $3;
@@ -496,6 +503,7 @@
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
$term =~tr/a-z/A-Z/;
+ $sec=~s/^_//;
my $database = 'SIS';
if (($yr > 21) || (($yr == 21) && ($sem eq 'fs'))) {
$database = 'SISCS';
@@ -708,7 +716,7 @@
my $outcome = '';
if ($instcode =~ m/^([suf]s\d{2}\w{2,4})\d{3,4}\w?$/) {
my $semyrdept = $1;
- if ($inst_xlist =~ m/^(\Q$semyrdept\E\d{3,4}\w?)\d{3}$/) {
+ if ($inst_xlist =~ /^(\Q$semyrdept\E\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my $xlistcode = $1;
($outcome) = &validate_instcode($dom,$xlistcode,$coowner);
}
@@ -836,6 +844,33 @@
return 'ok';
}
+sub instsec_reformat {
+ my ($dom,$action,$instsecref) = @_;
+ if ((ref($instsecref) eq 'HASH') &&
+ (($action eq 'clutter') || ($action eq 'declutter'))) {
+ foreach my $key (keys(%{$instsecref})) {
+ if (ref($instsecref->{$key}) eq 'ARRAY') {
+ foreach my $item (@{$instsecref->{$key}}) {
+ if ($action eq 'clutter') {
+ unless ($item =~ /^\d{3}$/) {
+ $item = '_'.$item;
+ }
+ } elsif ($action eq 'declutter') {
+ if ($item =~ /^([suf]s\d{2}\w{2,4}\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
+ my ($instcode,$instsec) = ($1,$2);
+ $instsec =~ s/^_//;
+ $item = $instcode.$instsec;
+ } elsif ($item =~ /^_[A-Za-z0-9]{1,5}$/) {
+ $item =~ s/^_//;
+ }
+ }
+ }
+ }
+ }
+ }
+ return 'ok';
+}
+
sub create_password {
my ($authparam,$dom) = @_;
my $authchk = 'ok';
@@ -1022,11 +1057,12 @@
my ($dbh,$class,$stuinfo) = @_;
my $pidcount = 0;
my $blankcount = 0;
- if ($class =~ m/^([suf]s\d{2})(\w{2,4})(\d{3,4}\w?)(\d{3})$/) {
+ if ($class =~ /^([suf]s\d{2})(\w{2,4})(\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my ($term,$subj,$crse,$sec) = ($1,$2,$3,$4);
$term =~tr/a-z/A-Z/;
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
+ $sec =~s/^_//;
eval {
my $sth = $dbh->prepare("SELECT Pid,Pilot_Id FROM RO_ClassList WHERE Term_Code = '$term' AND Subj_Code = '$subj' AND Crse_Code = '$crse' AND Sctn_Code = '$sec' ORDER BY Pid");
$sth->execute();
@@ -1096,11 +1132,12 @@
next if ($ownerdom ne $dom);
}
if (defined($person) && $person ne '') {
- if ($class =~ m/^([suf]s\d{2})(\w{2,4})(\d{3,4}\w?)(\d{3})$/) {
+ if ($class =~ /^([suf]s\d{2})(\w{2,4})(\d{3,4}[A-Za-z]?)(\d{3}|_[A-Za-z0-9]{1,5})$/) {
my ($semyr,$subj,$crs,$sec) = ($1,$2,$3,$4);
$semyr =~tr/a-z/A-Z/;
$subj =~tr/a-z/A-Z/;
$crs =~tr/a-z/A-Z/;
+ $sec =~s/^_//;
# Check if section exists in LONCAPA table.
if (!$dbflaglc) {
($dbhlc,$dbflaglc) = &connect_DB('LC');
More information about the LON-CAPA-cvs
mailing list