[LON-CAPA-cvs] cvs: modules(fall_2007) /msu localenroll.pm
albertel
lon-capa-cvs-allow@mail.lon-capa.org
Mon, 22 Oct 2007 19:08:00 -0000
This is a MIME encoded message
--albertel1193080080
Content-Type: text/plain
albertel Mon Oct 22 15:08:00 2007 EDT
Modified files: (Branch: fall_2007)
/modules/msu localenroll.pm
Log:
- backports of variety of fixes from between 1.17 and 1.31
--albertel1193080080
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20071022150800.txt"
Index: modules/msu/localenroll.pm
diff -u modules/msu/localenroll.pm:1.17 modules/msu/localenroll.pm:1.17.2.1
--- modules/msu/localenroll.pm:1.17 Tue Feb 7 16:59:08 2006
+++ modules/msu/localenroll.pm Mon Oct 22 15:07:58 2007
@@ -1,6 +1,6 @@
# functions to glue school database system into Lon-CAPA for
# automated enrollment
-# $Id: localenroll.pm,v 1.17 2006/02/07 21:59:08 raeburn Exp $
+# $Id: localenroll.pm,v 1.17.2.1 2007/10/22 19:07:58 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,7 +41,7 @@
my ($dom,$affiliatesref,$replyref) = @_;
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
- my ($dbh,$dbflag) = &connect_DB($$configvars{'lonDaemons'},'RO');
+ my ($dbh,$dbflag) = &connect_DB('RO',$$configvars{'lonDaemons'});
if ($dbflag) {
foreach my $crs (sort keys %{$affiliatesref}) {
my $xmlstem = $$configvars{'lonDaemons'}.'/tmp/';
@@ -61,11 +61,15 @@
}
sub connect_DB {
- my ($keydir,$type) = @_;
+ my ($type,$keydir) = @_;
$ENV{SYBASE} = '/usr/local/freetds';
my $DB_PATH;
my $DB_USER = '';
my $DB_PASSWD = '';
+ if ($keydir eq '') {
+ my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
+ $keydir = $$configvars{'lonDaemons'};
+ }
if (open (my $fh, "<$keydir/autoenroll.dat") ) {
($DB_USER,$DB_PASSWD) = split/:/,<$fh>;
chomp($DB_PASSWD);
@@ -76,6 +80,8 @@
$DB_PATH = "dbi:Sybase:server=ESDB1;database=RO_ClassList";
} elsif ($type eq 'SIS') {
$DB_PATH = "dbi:Sybase:server=msudata;database=SISInfo";
+ } elsif ($type eq 'HR') {
+ $DB_PATH = "dbi:Sybase:server=msudata;database=HR";
}
my $dbh;
@@ -84,7 +90,7 @@
if ($@) {
$dbflag = 0;
} else {
- if (defined $dbh) {
+ if (defined($dbh)) {
$dbflag = 1;
}
}
@@ -185,9 +191,7 @@
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
$term =~tr/a-z/A-Z/;
- my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
-
- my ($dbh3,$dbflag) = &connect_DB($$configvars{'lonDaemons'},'SIS');
+ my ($dbh3,$dbflag) = &connect_DB('SIS');
if ($dbflag) {
eval {
my $quotedsubj = $dbh3->quote($subj);
@@ -214,7 +218,18 @@
if ($owner eq '') {
$outcome = "Inclusion of enrollment could not be established for the course section $course_id because no owner was provided for this LON-CAPA course.";
} else {
- my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
+ if ($owner =~ /^([^:]+):([^:]+)$/) {
+ $owner = $1;
+ my $ownerdom = $2;
+ if ($ownerdom ne $dom) {
+ $outcome = "Inclusion of enrollment could not be established for the course section $course_id because the course owner is in a different domain ($ownerdom) from the course ($dom).";
+ return $outcome;
+ }
+ }
+ if ($owner =~ /\W/) {
+ $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,3})(\d{3,4}\w?)(\d{3})$/) {
my $sem = $1;
my $subj = $2;
@@ -223,10 +238,10 @@
$sem =~tr/a-z/A-Z/;
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
- my ($dbh,$dbflag) = &connect_DB($$configvars{'lonDaemons'},'RO');
+ my ($dbh,$dbflag) = &connect_DB('RO');
if ($dbflag) {
# Check if instructor is in CLIFMS for this course
- my $clifmscount = $dbh->selectrow_array("SELECT count(*) FROM RO_CLIFMS_VIEW WHERE Term_Code='$sem' AND Subj_Code='$subj' AND Crse_Code='$crse' AND Sctn_Code='$sec' AND MSUNetID='$owner' AND (Record_Type='1' OR Record_Type='2' OR Record_Type ='3')");
+ my $clifmscount = $dbh->selectrow_array("SELECT count(*) FROM RO_CLIFMS_VIEW WHERE Term_Code='$sem' AND Subj_Code='$subj' AND Crse_Code='$crse' AND Sctn_Code='$sec' AND MSUNetID='$owner' AND (Record_Type='1' OR Record_Type='2' OR Record_Type ='3' OR Record_Type = '9')");
if ($clifmscount > 0) {
my $loncount = $dbh->selectrow_array("SELECT count(*) FROM LONCAPA WHERE Term_Code='$sem' AND Subj_Code='$subj' AND Crse_Code='$crse' AND Sctn_Code='$sec' AND MSUNetID='$owner'");
if ($loncount == 0) {
@@ -260,10 +275,7 @@
$subj =~tr/a-z/A-Z/;
$crse =~tr/a-z/A-Z/;
$term =~tr/a-z/A-Z/;
-
- my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
-
- my ($dbh3,$dbflag) = &connect_DB($$configvars{'lonDaemons'},'SIS');
+ my ($dbh3,$dbflag) = &connect_DB('SIS');
if ($dbflag) {
eval {
my $quotedsubj = $dbh3->quote($subj);
@@ -339,8 +351,7 @@
my ($dom,$crs,$affiliates,$result,$action,$students) = @_;
my $outcome;
if ($action eq 'update') {
- my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
- my ($dbh,$dbflag) = &connect_DB($$configvars{'lonDaemons'},'RO');
+ my ($dbh,$dbflag) = &connect_DB('RO');
my $owner;
if ($dbflag) {
my %stuinfo;
@@ -445,4 +456,263 @@
return ($update,$comment);
}
+sub check_section {
+ my ($class,$owner,$dom,$dbh) = @_;
+ my $sectioncheck = 0;
+ my $dbflag = 0;
+ if ($owner =~ /^([^:]+):([^:]+)$/) {
+ $owner = $1;
+ my $ownerdom = $2;
+ if ($ownerdom ne $dom) {
+ return $sectioncheck;
+ }
+ }
+ if (defined($owner) && $owner ne '') {
+ if ($class =~ m/^([suf]s\d{2})(\w{2,3})(\d{3,4}\w?)(\d{3})$/) {
+# Check if section exists in LONCAPA table.
+ if (!defined($dbh)) {
+ ($dbh,$dbflag) = &connect_DB('RO');
+ if (!$dbflag) {
+ return $sectioncheck;
+ }
+ }
+ $sectioncheck = $dbh->selectrow_array(
+ "SELECT count(*) FROM LONCAPA ".
+ "WHERE Term_Code = '$1' AND Subj_Code = '$2' ".
+ "AND Crse_Code = '$3' AND Sctn_Code = '$4' ".
+ "AND MSUNetID = '$owner'");
+ if ($sectioncheck == 0) {
+ my $outcome = &new_course($class,$owner,$dom);
+ if ($outcome eq 'ok') {
+ $sectioncheck = 'ok';
+ }
+ } elsif ($sectioncheck > 0) {
+ $sectioncheck = 'ok';
+ }
+ }
+ }
+ if ($dbflag) {
+ &disconnect_DB($dbh);
+ }
+ return $sectioncheck;
+}
+
+sub instcode_defaults {
+ my ($dom,$defaults,$code_order) = @_;
+ %{$defaults} = (
+ 'Year' => '\d{2}',
+ 'Semester' => '^[sfu]s',
+ 'Department' => '\w{2,3}',
+ 'Number' => '\d{3,4}\w?',
+ );
+ @{$code_order} = ('Semester','Year','Department','Number');
+ return 'ok';
+}
+
+sub allusers_info {
+ my ($dom,$instusers,$instids) = @_;
+ my $outcome;
+ my ($dbh,$dbflag) = &connect_DB('HR');
+ if ($dbflag) {
+ my @srchtables = ('FACULTY_VU','STAFF_VU','STUDENT','AFFILIATE',
+ 'ASSISTANT','STUDENT_AFFILIATE');
+ &query_user_tables($dbh,\@srchtables,$instusers,$instids);
+ $outcome = 'ok';
+ &disconnect_DB($dbh);
+ }
+ return $outcome;
+}
+
+sub get_userinfo {
+ my ($dom,$uname,$id,$instusers,$instids,$types,
+ $srchby,$srchterm,$srchtype) = @_;
+ my $outcome;
+ my @srchtables;
+ my %tables = (Faculty => 'FACULTY_VU',
+ Staff => 'STAFF_VU',
+ Student => 'STUDENT',
+ Assistant => 'ASSISTANT',
+ StaffAff => 'AFFILIATE',
+ StuAff => 'STUDENT_AFFILIATE');
+ my ($dbh,$dbflag) = &connect_DB('HR');
+ if ($dbflag) {
+ foreach my $type (@{$types}) {
+ if (exists($tables{$type})) {
+ push(@srchtables,$tables{$type});
+ }
+ }
+ if (@srchtables == 0) {
+ foreach my $type (keys(%tables)) {
+ push(@srchtables,$tables{$type});
+ }
+ }
+ if ($srchby eq '' && $srchterm eq '') {
+ if ($uname ne '') {
+ $srchby = 'uname';
+ $srchterm = $uname;
+ } elsif ($id ne '') {
+ $srchby = 'id';
+ $srchterm = $id;
+ }
+ }
+ if ($srchterm ne '') {
+ &query_user_tables($dbh,\@srchtables,$instusers,$instids,
+ $srchby,$srchterm,$srchtype);
+ $outcome = 'ok';
+ }
+ &disconnect_DB($dbh);
+ }
+ return $outcome;
+}
+
+sub query_user_tables {
+ my ($dbh,$srchtables,$instusers,$instids,$srchby,$srchterm,$srchtype) = @_;
+ my ($condition,%multipids);
+ if ($srchby eq 'uname') {
+ if ($srchterm =~ /^\w{2,8}$/) {
+ if ($srchtype eq 'contains') {
+ $condition = "WHERE MSUNetID LIKE '%$srchterm%'";
+ } elsif ($srchtype eq 'begins') {
+ $condition = "WHERE MSUNetID LIKE '$srchterm%'";
+ } else {
+ $condition = "WHERE MSUNetID = '$srchterm'";
+ }
+ }
+ } elsif ($srchby eq 'lastname') {
+ if ($srchterm =~ /[A-Za-z\-\.']+/) {
+ if ($srchtype eq 'contains') {
+ my $quoted_last = $dbh->quote('%'.$srchterm.'%');
+ $condition = "WHERE LastName LIKE $quoted_last";
+ } elsif ($srchtype eq 'begins') {
+ my $quoted_last = $dbh->quote($srchterm.'%');
+ $condition = "WHERE LastName LIKE $quoted_last";
+ } else {
+ my $quoted_last = $dbh->quote($srchterm);
+ $condition = "WHERE LastName = $quoted_last";
+ }
+ }
+ } elsif ($srchby eq 'lastfirst') {
+ my ($srchlast,$srchfirst) = split(/,/,$srchterm);
+ if (($srchlast =~ /[A-Za-z\-\.']+/) &&
+ ($srchfirst =~ /[A-Za-z\-\.']+/)) {
+ my ($quoted_first,$quoted_last);
+ if ($srchtype eq 'contains') {
+ $quoted_last = $dbh->quote('%'.$srchlast.'%');
+ $quoted_first = $dbh->quote('%'.$srchfirst.'%');
+ } elsif ($srchtype eq 'begins') {
+ $quoted_last = $dbh->quote($srchlast.'%');
+ $quoted_first = $dbh->quote($srchfirst.'%');
+ } else {
+ $quoted_last = $dbh->quote($srchterm);
+ $quoted_first = $dbh->quote($srchterm);
+ }
+ $condition = "WHERE LastName = $quoted_last AND
+ FirstName = $quoted_first";
+ }
+ } elsif ($srchby eq 'id') {
+ if ($srchterm =~ /^[AZ]\d{8}$/) {
+ $condition = "WHERE Pid = '$srchterm'";
+ }
+ }
+
+ if ($srchby && !$condition) {
+ return;
+ }
+
+ foreach my $table (@{$srchtables}) {
+ my $statement = "SELECT MSUNetID,Pid,FirstName,LastName,Person_Type FROM $table $condition";
+ my $sth = $dbh->prepare("$statement");
+ $sth->execute();
+ while ( my($uname,$pid,$first,$last,$type) = $sth->fetchrow_array ) {
+ $pid=lc($pid);
+ if (ref($instusers->{$uname}) eq 'HASH') {
+ if (ref($instusers->{$uname}{'inststatus'}) eq 'ARRAY') {
+ if (!grep(/^$type$/,@{$instusers->{$uname}{'inststatus'}})) {
+ push(@{$instusers->{$uname}{'inststatus'}},$type);
+ }
+ }
+ if ($pid ne $instusers->{$uname}{'id'}) {
+ if ($instusers->{$uname}{'id'} =~ /^A\d{8}$/) {
+ if ($pid =~ /^A\d{8}$/) {
+ if (ref($multipids{$uname}) eq 'ARRAY') {
+ if (!grep(/^$pid$/,@{$multipids{$uname}})) {
+ push(@{$multipids{$uname}},$pid);
+ }
+ } else {
+ @{$multipids{$uname}} = ($instusers->{$uname}{'id'},$pid);
+ }
+ $instusers->{$uname}{'id'} = $pid;
+ }
+ } elsif ($instusers->{$uname}{'id'} =~ /^Z\d{8}$/) {
+ if ($pid =~ /^Z\d{8}$/) {
+ if (ref($multipids{$uname}) eq 'ARRAY') {
+ if (!grep(/^$pid$/,@{$multipids{$uname}})) {
+ push(@{$multipids{$uname}},$pid);
+ }
+ } else {
+ @{$multipids{$uname}} = ($instusers->{$uname}{'id'},$pid);
+ }
+ } elsif ($pid =~ /^A\d{8}$/) {
+ $instusers->{$uname}{'id'} = $pid;
+ }
+ }
+ }
+ } else {
+ $instusers->{$uname} = {firstname => $first,
+ lastname => $last,
+ id => $pid,
+ permanentemail => $uname.'@msu.edu',
+ inststatus => [$type],
+ };
+ }
+ if (defined($instids->{$pid})) {
+ if (ref($instids->{$pid}) eq 'ARRAY') {
+ if (!grep(/^$uname$/,@{$instids->{$pid}})) {
+ push(@{$instids->{$pid}},$uname);
+ }
+ } elsif ($instids->{$pid} ne $uname) {
+ @{$instids->{$pid}} = ($instids->{$pid},$uname);
+ }
+ } else {
+ $instids->{$pid} = $uname;
+ }
+ }
+ }
+ return;
+}
+
+sub inst_usertypes {
+ my ($dom,$usertypes,$order) = @_;
+ my $outcome = 'ok';
+ %{$usertypes} = (
+ Faculty => 'Faculty/Academic Staff',
+ Staff => 'Support Staff',
+ Student => 'Student',
+ Assistant => 'Assistant',
+ StaffAff => 'Affiliate',
+ StuAff => 'Student Affiliate'
+ );
+ @{$order}=('Faculty','Staff','Student','Assistant','StaffAff','StuAff');
+ return $outcome;
+}
+
+###############################
+# sub AUTOLOAD
+#
+# Incoming data: none
+# Returns ''
+#
+# Prevents errors when undefined subroutines are called in this package
+# Will allow new routines added in the future to be called from lond etc.
+# without the need for customized versions of local*.pm packages to be
+# modified to include the new subroutines immediately.
+#
+# See "Programming Perl" 3rd ed. pp 296-298.
+###############################
+
+sub AUTOLOAD {
+ our $AUTOLOAD;
+ return '';
+}
+
1;
--albertel1193080080--