[23095] | 1 | #!/moira/bin/perl -Tw |
---|
[24319] | 2 | # $Id: grouper.pl 3956 2010-01-05 20:56:56Z zacheiss $ |
---|
[23095] | 3 | |
---|
| 4 | die "Usage: $0 password\n" unless ($#ARGV == 0); |
---|
| 5 | $whpassword = $ARGV[0]; |
---|
| 6 | $db = ""; |
---|
| 7 | $mrtest = "mrtest"; |
---|
| 8 | $logfile = "/moira/grouper.log"; |
---|
| 9 | $ENV{'PATH'} = "/moira/bin"; |
---|
| 10 | use DBI; |
---|
| 11 | |
---|
| 12 | $warehouse = DBI->connect("dbi:Oracle:warehouse", "moira", $whpassword, |
---|
| 13 | { RaiseError => 1 }); |
---|
| 14 | $moira = DBI->connect("dbi:Oracle:moira", "moira", "moira", |
---|
| 15 | { RaiseError => 1}); |
---|
| 16 | |
---|
| 17 | # Get the current term |
---|
| 18 | ($term) = $warehouse->selectrow_array("SELECT term_code ". |
---|
| 19 | "FROM wareuser.whsis_academic_terms ". |
---|
| 20 | "WHERE is_current_term='Y'"); |
---|
| 21 | # Convert from "2000FA" to "FA00" |
---|
| 22 | $term =~ s/\d\d(\d\d)(..)/$2$1/; |
---|
| 23 | |
---|
| 24 | # Get list of current classes |
---|
| 25 | $classes = |
---|
| 26 | $warehouse->selectcol_arrayref("SELECT UNIQUE master_subject ". |
---|
| 27 | "FROM wareuser.subject_enrollment_moira ". |
---|
| 28 | "WHERE term = " . $warehouse->quote($term)); |
---|
| 29 | |
---|
| 30 | # Get names of current Grouper lists |
---|
| 31 | $sth = $moira->prepare("SELECT name FROM list"); |
---|
| 32 | $sth->execute; |
---|
| 33 | while (($name) = $sth->fetchrow_array) { |
---|
| 34 | next if $name !~ /^(fa|sp|su|ja)\d\d-/; |
---|
| 35 | $lists{$name} = $name; |
---|
| 36 | } |
---|
| 37 | |
---|
| 38 | $lists{"registrar"} = "registrar"; |
---|
| 39 | |
---|
| 40 | # And MIT ID to username mappings |
---|
| 41 | $sth = $moira->prepare("SELECT login, clearid FROM users ". |
---|
| 42 | "WHERE status = 1 OR status = 2"); |
---|
| 43 | $sth->execute; |
---|
| 44 | while (($user, $mitid) = $sth->fetchrow_array) { |
---|
| 45 | $users{$mitid} = $user; |
---|
| 46 | } |
---|
| 47 | |
---|
| 48 | ($root_id) = $moira->selectrow_array("SELECT users_id FROM users ". |
---|
| 49 | "WHERE login = 'root'"); |
---|
| 50 | |
---|
| 51 | open(MRTEST, "|$mrtest >/dev/null 2>&1"); |
---|
| 52 | print MRTEST "connect $db\n"; |
---|
| 53 | print MRTEST "auth\n"; |
---|
| 54 | open(LOG, ">>$logfile"); |
---|
| 55 | |
---|
| 56 | # Create any lists that don't already exist in Moira |
---|
| 57 | foreach $class (@$classes) { |
---|
| 58 | $base = "\L$term-$class"; |
---|
| 59 | $staff = "$base-staff"; |
---|
| 60 | |
---|
| 61 | # check_list(name, owner, export, desc) |
---|
| 62 | &check_list($staff, $staff, 0, |
---|
| 63 | "Teaching staff list for $class"); |
---|
| 64 | &check_list("$base-reg", $staff, 0, |
---|
| 65 | "*** DO NOT MODIFY *** Automatically-created registered students list for $class"); |
---|
| 66 | &check_list("$base-others", $staff, 0, |
---|
| 67 | "Non-registered students and miscellaneous people list for $class"); |
---|
| 68 | &check_list($base, $staff, 1, |
---|
| 69 | "*** DO NOT MODIFY *** Automatically-created participants list for $class"); |
---|
| 70 | if (!$lists{$base}) { |
---|
| 71 | &add_member($staff, LIST, $base); |
---|
| 72 | &add_member("$base-reg", LIST, $base); |
---|
| 73 | &add_member("$base-others", LIST, $base); |
---|
| 74 | } |
---|
| 75 | } |
---|
| 76 | |
---|
| 77 | # Now fill in -reg lists |
---|
| 78 | foreach $class (@$classes) { |
---|
| 79 | $changed = 0; |
---|
| 80 | $clist = "\L$term-$class-reg"; |
---|
| 81 | |
---|
| 82 | # Get current list membership in Moira |
---|
| 83 | %mstudents = (); |
---|
| 84 | $sth = $moira->prepare("SELECT u.login FROM users u, imembers i, list l ". |
---|
| 85 | "WHERE l.list_id = i.list_id AND i.member_id = ". |
---|
| 86 | "u.users_id AND i.direct = 1 AND i.member_type = ". |
---|
| 87 | "'USER' AND l.name = " . $moira->quote($clist)); |
---|
| 88 | $sth->execute; |
---|
| 89 | while (($login) = $sth->fetchrow_array) { |
---|
| 90 | $mstudents{$login} = $login; |
---|
| 91 | } |
---|
| 92 | |
---|
| 93 | $wstudents = $warehouse->selectcol_arrayref("SELECT UNIQUE mit_id ". |
---|
| 94 | "FROM wareuser.subject_enrollment_moira ". |
---|
| 95 | "WHERE term = " . $warehouse->quote($term) . |
---|
| 96 | " AND master_subject = " . |
---|
| 97 | $warehouse->quote($class)); |
---|
| 98 | |
---|
| 99 | foreach $mitid (@$wstudents) { |
---|
| 100 | $login = $users{$mitid}; |
---|
| 101 | next if !$login; |
---|
| 102 | if (!$mstudents{$login}) { |
---|
| 103 | print LOG "Adding $login to $clist\n"; |
---|
| 104 | &add_member($login, USER, $clist); |
---|
| 105 | $changed = 1; |
---|
| 106 | } else { |
---|
| 107 | delete $mstudents{$login}; |
---|
| 108 | } |
---|
| 109 | } |
---|
| 110 | |
---|
| 111 | # Everyone in wstudents will have been removed from mstudents |
---|
| 112 | # now, so delete the remaining users since they don't belong |
---|
| 113 | foreach $login (keys(%mstudents)) { |
---|
| 114 | print LOG "Deleting $login from $clist\n"; |
---|
| 115 | &del_member($login, USER, $clist); |
---|
| 116 | $changed = 1; |
---|
| 117 | } |
---|
| 118 | |
---|
| 119 | if ($changed) { |
---|
| 120 | $moira->do("UPDATE list SET modtime = SYSDATE, modby = $root_id, ". |
---|
| 121 | "modwith = 'grouper' WHERE name = " . |
---|
| 122 | $moira->quote($clist)); |
---|
| 123 | } |
---|
| 124 | } |
---|
| 125 | |
---|
| 126 | print MRTEST "quit\n"; |
---|
| 127 | close(MRTEST); |
---|
| 128 | close(LOG); |
---|
| 129 | $moira->disconnect; |
---|
| 130 | $warehouse->disconnect; |
---|
| 131 | |
---|
| 132 | exit 0; |
---|
| 133 | |
---|
| 134 | sub check_list { |
---|
| 135 | my ( $name, $owner, $export, $desc ) = @_; |
---|
| 136 | if (!$lists{$name}) { |
---|
| 137 | print LOG "Creating $name\n"; |
---|
| 138 | print MRTEST "qy alis $name 0 0 1 $export $export \"create unique GID\" 0 0 [NONE] LIST $owner NONE NONE \"$desc\"\n"; |
---|
| 139 | } |
---|
| 140 | } |
---|
| 141 | |
---|
| 142 | sub add_member { |
---|
| 143 | my ( $user, $type, $list ) = @_; |
---|
| 144 | print MRTEST "qy amtl $list $type $user\n"; |
---|
| 145 | } |
---|
| 146 | |
---|
| 147 | sub del_member { |
---|
| 148 | my ( $user, $type, $list ) = @_; |
---|
| 149 | print MRTEST "qy dmfl $list $type $user\n"; |
---|
| 150 | } |
---|