[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