Annotation of loncom/enrollment/Autoupdate.pl, revision 1.5
1.1 raeburn 1: #!/usr/bin/perl
2: #
3: # Automated Userinfo update script
1.5 ! raeburn 4: # $Id: Autoupdate.pl,v 1.4 2007/04/03 17:51:52 raeburn Exp $
1.1 raeburn 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: use strict;
29: use lib '/home/httpd/lib/perl';
30: use localenroll;
31: use Apache::lonnet;
32: use Apache::loncommon;
1.4 raeburn 33: use Apache::lonlocal;
1.5 ! raeburn 34: use LONCAPA::Configuration;
1.2 raeburn 35: use LONCAPA;
1.1 raeburn 36:
1.5 ! raeburn 37: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
! 38: my $hostid = $perlvarref->{'lonHostID'};
1.1 raeburn 39: my @info = ('inststatus','lockedname','lastname','firstname','id');
40: # find out which users we need to examine
41: my @domains = sort(&Apache::lonnet::current_machine_domains());
42: foreach my $dom (@domains) {
1.5 ! raeburn 43: my $primaryhost_id = &Apache::lonnet::domain($dom,'primary');
! 44: if ($primaryhost_id ne $hostid) {
! 45: next;
! 46: }
1.1 raeburn 47: my %domconfig = &Apache::lonnet::get_dom('configuration',['autoupdate'],
48: $dom);
49: #only run if configured to
50: my $run_update = 0;
51: my $settings;
52: if (ref($domconfig{'autoupdate'}) eq 'HASH') {
53: $settings = $domconfig{'autoupdate'};
1.2 raeburn 54: if ($settings->{'run'} eq '1') {
1.1 raeburn 55: $run_update = 1;
56: }
57: }
58: next if (!$run_update);
1.2 raeburn 59: # get user information
60: my (%instusers,%instids);
61: next if (&localenroll::allusers_info($dom,\%instusers,\%instids) ne 'ok');
62: my (%users,%unamechg,%possnames);
1.1 raeburn 63: my @types = ('active','future');
64: my @roles = ('st');
65: my @cdoms = ($dom);
66: my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
67: &descend_tree($dir,0,\%users);
68: foreach my $uname (keys(%users)) {
69: my %userhash = &Apache::lonnet::userenvironment($dom,$uname,@info);
1.2 raeburn 70: my (@inststatuses);
71: if (!$userhash{'internalname'}) {
72: if (defined($instusers{$uname})) {
73: (my $insttypechg,@inststatuses) =
74: &affiliations_check(\%userhash,$instusers{$uname});
75: if ($insttypechg) {
76: my $inststatusstr = join(':',&escape(@inststatuses));
77: my %statushash = ( inststatus => $inststatusstr );
78: my $statusres = &Apache::lonnet::put('environment',\%statushash,$dom,$uname);
79: }
80: }
81: }
1.1 raeburn 82: if (!$userhash{'lockedname'} && !$userhash{'internalname'}) {
1.2 raeburn 83: if (defined($instusers{$uname})) {
84: my (@fields,%changes,$changed);
85: if (@inststatuses > 0) {
86: foreach my $type (@inststatuses) {
87: if (ref($settings->{fields}{$type}) eq 'ARRAY') {
88: foreach my $field (@{$settings->{fields}{$type}}) {
89: if (!grep(/^\Q$field\E$/,@fields)) {
90: push(@fields,$field);
91: }
92: }
93: }
94: }
95: } else {
96: if (ref($settings->{fields}{'default'}) eq 'ARRAY') {
97: @fields = @{$settings->{fields}{'default'}};
1.1 raeburn 98: }
99: }
100: foreach my $field (@fields) {
1.2 raeburn 101: if ($userhash{$field} ne $instusers{$uname}{$field}) {
1.1 raeburn 102: $changed = 1;
103: if ($settings->{'classlists'} eq 'yes') {
104: if ($field eq 'id') {
105: $changes{'id'} = 1;
106: } elsif ($field eq 'lastname' || $field eq 'firstname' || $field eq 'middlename' || $field eq 'gen') {
107: $changes{'fullname'} = 1;
108: }
109: }
110: }
111: }
112: # Make the change
113: if ($changed) {
114: my %userupdate;
115: foreach my $field (@fields) {
1.2 raeburn 116: $userupdate{$field} = $instusers{$uname}{$field};
1.1 raeburn 117: }
1.2 raeburn 118: my $modresult = &Apache::lonnet::modifyuser($dom,$uname,$userupdate{'id'},undef,undef,$userupdate{'firstname'},$userupdate{'middlename'},$userupdate{'lastname'},$userupdate{'generation'},1);
119: if ($modresult eq 'ok') {
1.1 raeburn 120: if ($settings->{'classlists'} eq 'yes') {
121: if ($changes{'id'} || $changes{'fullname'}) {
122: my %roleshash =
123: &Apache::lonnet::get_my_roles($uname,
1.4 raeburn 124: $dom,'userroles',\@types,\@roles,\@cdoms);
1.1 raeburn 125: foreach my $item (%roleshash) {
126: my ($cnum,$cdom,$role) = split(/:/,$item);
127: my ($start,$end) = split(/:/,$roleshash{$item});
128: if (&Apache::loncommon::is_course($cdom,$cnum)) {
129: my $result = &update_classlist($cdom,$cnum,$dom,$uname,\%userupdate);
130: }
131: }
132: }
133: }
134: }
135: }
1.2 raeburn 136: } else {
137: # check if the username has changed
138: if (defined($instids{$userhash{'id'}})) {
139: if (ref($instids{$userhash{'id'}}) eq 'ARRAY') {
140: foreach my $name (@{$instids{$userhash{'id'}}}) {
141: if (!exists($users{$name})) {
142: push(@{$possnames{$uname}},$name);
143: }
144: }
145: } else {
146: if (!exists($users{$instids{$userhash{'id'}}})) {
147: $unamechg{$uname} = $instids{$userhash{'id'}};
1.4 raeburn 148: print &mt('Username change to [_1] detected for [_2] in domain [_3].',$unamechg{$uname},$uname,$dom)."\n";
1.2 raeburn 149: }
150: }
151: }
1.1 raeburn 152: }
153: }
154: }
1.4 raeburn 155: if (keys(%possnames) > 0) {
156: foreach my $uname (keys(%possnames)) {
157: my $altnames = join(' or ',@{$possnames{$uname}});
158: print &mt('Possible username change to [_1] detected for [_2] in domain [_3].',$altnames,$uname,$dom)."\n";
159: }
160: }
1.1 raeburn 161: }
162:
163: sub descend_tree {
164: my ($dir,$depth,$alldomusers) = @_;
165: if (-d $dir) {
166: opendir(DIR,$dir);
167: my @contents = grep(!/^\./,readdir(DIR));
168: closedir(DIR);
169: $depth ++;
170: foreach my $item (@contents) {
171: if ($depth < 4) {
172: &descend_tree($dir.'/'.$item,$depth,$alldomusers);
173: } else {
174: if (-e $dir.'/'.$item.'/environment.db') {
175:
176: $$alldomusers{$item} = '';
177: }
178: }
179: }
180: }
181: }
182:
183: sub update_classlist {
184: my ($cdom,$cnum,$udom,$uname,$user) = @_;
185: my ($uid,$fullname,$classlistentry);
186: my $fullname =
187: &Apache::lonnet::format_name($user->{'first'},$user->{'middle'},
188: $user->{'last'},$user->{'gene'},'lastname');
189: my %classhash = &Apache::lonnet::get('classlist',[$uname.':'.$udom],
190: $cdom,$cnum);
191: my @classinfo = split(/:/,$classhash{$uname.':'.$udom});
192: my $ididx=&Apache::loncoursedata::CL_ID() - 2;
193: my $nameidx=&Apache::loncoursedata::CL_FULLNAME() - 2;
194: for (my $i=0; $i<@classinfo; $i++) {
195: if ($i == $ididx) {
196: if (defined($user->{'id'})) {
197: $classlistentry .= $user->{'id'}.':';
198: } else {
199: $classlistentry .= $classinfo[$i].':';
200: }
201: } elsif ($i == $nameidx) {
202: $classlistentry .= $fullname.':';
203: } else {
204: $classlistentry .= $classinfo[$i].':';
205: }
206: }
207: $classlistentry =~ s/:$//;
208: my $reply=&Apache::lonnet::cput('classlist',
209: {"$uname:$udom" => $classlistentry},
210: $cdom,$cnum);
211: if (($reply eq 'ok') || ($reply eq 'delayed')) {
212: return 'ok';
213: } else {
214: return 'error: '.$reply;
215: }
216: }
217:
1.2 raeburn 218: sub affiliations_check {
219: my ($userhash,$insthashref) = @_;
220: my (@inststatuses,$insttypechg);;
221: if (ref($insthashref) eq 'HASH') {
222: if (ref($insthashref->{type}) eq 'ARRAY') {
223: @inststatuses = @{$insthashref->{type}};
224: }
225: }
226: my @currstatuses = &unescape(split(/:/,$userhash->{'inststatus'}));
227: foreach my $status (@inststatuses) {
228: if (!grep/^\Q$status\E/,@currstatuses) {
229: $insttypechg = 1;
230: }
231: }
232: if (!$insttypechg) {
233: foreach my $status (@currstatuses) {
234: if (!grep/^\Q$status\E/,@inststatuses) {
235: $insttypechg = 1;
236: }
237: }
238: }
239: return ($insttypechg,@inststatuses);
240: }
241:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Autoupdate.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / enrollment