Annotation of loncom/enrollment/Autoupdate.pl, revision 1.4
1.1 raeburn 1: #!/usr/bin/perl
2: #
3: # Automated Userinfo update script
1.4 ! raeburn 4: # $Id: Autoupdate.pl,v 1.3 2007/03/01 19:20:45 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.2 raeburn 34: use LONCAPA;
1.1 raeburn 35:
36: my @info = ('inststatus','lockedname','lastname','firstname','id');
37: # find out which users we need to examine
38: my @domains = sort(&Apache::lonnet::current_machine_domains());
39: foreach my $dom (@domains) {
40: my %domconfig = &Apache::lonnet::get_dom('configuration',['autoupdate'],
41: $dom);
42: #only run if configured to
43: my $run_update = 0;
44: my $settings;
45: if (ref($domconfig{'autoupdate'}) eq 'HASH') {
46: $settings = $domconfig{'autoupdate'};
1.2 raeburn 47: if ($settings->{'run'} eq '1') {
1.1 raeburn 48: $run_update = 1;
49: }
50: }
51: next if (!$run_update);
1.2 raeburn 52: # get user information
53: my (%instusers,%instids);
54: next if (&localenroll::allusers_info($dom,\%instusers,\%instids) ne 'ok');
55: my (%users,%unamechg,%possnames);
1.1 raeburn 56: my @types = ('active','future');
57: my @roles = ('st');
58: my @cdoms = ($dom);
59: my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
60: &descend_tree($dir,0,\%users);
61: foreach my $uname (keys(%users)) {
62: my %userhash = &Apache::lonnet::userenvironment($dom,$uname,@info);
1.2 raeburn 63: my (@inststatuses);
64: if (!$userhash{'internalname'}) {
65: if (defined($instusers{$uname})) {
66: (my $insttypechg,@inststatuses) =
67: &affiliations_check(\%userhash,$instusers{$uname});
68: if ($insttypechg) {
69: my $inststatusstr = join(':',&escape(@inststatuses));
70: my %statushash = ( inststatus => $inststatusstr );
71: my $statusres = &Apache::lonnet::put('environment',\%statushash,$dom,$uname);
72: }
73: }
74: }
1.1 raeburn 75: if (!$userhash{'lockedname'} && !$userhash{'internalname'}) {
1.2 raeburn 76: if (defined($instusers{$uname})) {
77: my (@fields,%changes,$changed);
78: if (@inststatuses > 0) {
79: foreach my $type (@inststatuses) {
80: if (ref($settings->{fields}{$type}) eq 'ARRAY') {
81: foreach my $field (@{$settings->{fields}{$type}}) {
82: if (!grep(/^\Q$field\E$/,@fields)) {
83: push(@fields,$field);
84: }
85: }
86: }
87: }
88: } else {
89: if (ref($settings->{fields}{'default'}) eq 'ARRAY') {
90: @fields = @{$settings->{fields}{'default'}};
1.1 raeburn 91: }
92: }
93: foreach my $field (@fields) {
1.2 raeburn 94: if ($userhash{$field} ne $instusers{$uname}{$field}) {
1.1 raeburn 95: $changed = 1;
96: if ($settings->{'classlists'} eq 'yes') {
97: if ($field eq 'id') {
98: $changes{'id'} = 1;
99: } elsif ($field eq 'lastname' || $field eq 'firstname' || $field eq 'middlename' || $field eq 'gen') {
100: $changes{'fullname'} = 1;
101: }
102: }
103: }
104: }
105: # Make the change
106: if ($changed) {
107: my %userupdate;
108: foreach my $field (@fields) {
1.2 raeburn 109: $userupdate{$field} = $instusers{$uname}{$field};
1.1 raeburn 110: }
1.2 raeburn 111: my $modresult = &Apache::lonnet::modifyuser($dom,$uname,$userupdate{'id'},undef,undef,$userupdate{'firstname'},$userupdate{'middlename'},$userupdate{'lastname'},$userupdate{'generation'},1);
112: if ($modresult eq 'ok') {
1.1 raeburn 113: if ($settings->{'classlists'} eq 'yes') {
114: if ($changes{'id'} || $changes{'fullname'}) {
115: my %roleshash =
116: &Apache::lonnet::get_my_roles($uname,
1.4 ! raeburn 117: $dom,'userroles',\@types,\@roles,\@cdoms);
1.1 raeburn 118: foreach my $item (%roleshash) {
119: my ($cnum,$cdom,$role) = split(/:/,$item);
120: my ($start,$end) = split(/:/,$roleshash{$item});
121: if (&Apache::loncommon::is_course($cdom,$cnum)) {
122: my $result = &update_classlist($cdom,$cnum,$dom,$uname,\%userupdate);
123: }
124: }
125: }
126: }
127: }
128: }
1.2 raeburn 129: } else {
130: # check if the username has changed
131: if (defined($instids{$userhash{'id'}})) {
132: if (ref($instids{$userhash{'id'}}) eq 'ARRAY') {
133: foreach my $name (@{$instids{$userhash{'id'}}}) {
134: if (!exists($users{$name})) {
135: push(@{$possnames{$uname}},$name);
136: }
137: }
138: } else {
139: if (!exists($users{$instids{$userhash{'id'}}})) {
140: $unamechg{$uname} = $instids{$userhash{'id'}};
1.4 ! raeburn 141: print &mt('Username change to [_1] detected for [_2] in domain [_3].',$unamechg{$uname},$uname,$dom)."\n";
1.2 raeburn 142: }
143: }
144: }
1.1 raeburn 145: }
146: }
147: }
1.4 ! raeburn 148: if (keys(%possnames) > 0) {
! 149: foreach my $uname (keys(%possnames)) {
! 150: my $altnames = join(' or ',@{$possnames{$uname}});
! 151: print &mt('Possible username change to [_1] detected for [_2] in domain [_3].',$altnames,$uname,$dom)."\n";
! 152: }
! 153: }
1.1 raeburn 154: }
155:
156: sub descend_tree {
157: my ($dir,$depth,$alldomusers) = @_;
158: if (-d $dir) {
159: opendir(DIR,$dir);
160: my @contents = grep(!/^\./,readdir(DIR));
161: closedir(DIR);
162: $depth ++;
163: foreach my $item (@contents) {
164: if ($depth < 4) {
165: &descend_tree($dir.'/'.$item,$depth,$alldomusers);
166: } else {
167: if (-e $dir.'/'.$item.'/environment.db') {
168:
169: $$alldomusers{$item} = '';
170: }
171: }
172: }
173: }
174: }
175:
176: sub update_classlist {
177: my ($cdom,$cnum,$udom,$uname,$user) = @_;
178: my ($uid,$fullname,$classlistentry);
179: my $fullname =
180: &Apache::lonnet::format_name($user->{'first'},$user->{'middle'},
181: $user->{'last'},$user->{'gene'},'lastname');
182: my %classhash = &Apache::lonnet::get('classlist',[$uname.':'.$udom],
183: $cdom,$cnum);
184: my @classinfo = split(/:/,$classhash{$uname.':'.$udom});
185: my $ididx=&Apache::loncoursedata::CL_ID() - 2;
186: my $nameidx=&Apache::loncoursedata::CL_FULLNAME() - 2;
187: for (my $i=0; $i<@classinfo; $i++) {
188: if ($i == $ididx) {
189: if (defined($user->{'id'})) {
190: $classlistentry .= $user->{'id'}.':';
191: } else {
192: $classlistentry .= $classinfo[$i].':';
193: }
194: } elsif ($i == $nameidx) {
195: $classlistentry .= $fullname.':';
196: } else {
197: $classlistentry .= $classinfo[$i].':';
198: }
199: }
200: $classlistentry =~ s/:$//;
201: my $reply=&Apache::lonnet::cput('classlist',
202: {"$uname:$udom" => $classlistentry},
203: $cdom,$cnum);
204: if (($reply eq 'ok') || ($reply eq 'delayed')) {
205: return 'ok';
206: } else {
207: return 'error: '.$reply;
208: }
209: }
210:
1.2 raeburn 211: sub affiliations_check {
212: my ($userhash,$insthashref) = @_;
213: my (@inststatuses,$insttypechg);;
214: if (ref($insthashref) eq 'HASH') {
215: if (ref($insthashref->{type}) eq 'ARRAY') {
216: @inststatuses = @{$insthashref->{type}};
217: }
218: }
219: my @currstatuses = &unescape(split(/:/,$userhash->{'inststatus'}));
220: foreach my $status (@inststatuses) {
221: if (!grep/^\Q$status\E/,@currstatuses) {
222: $insttypechg = 1;
223: }
224: }
225: if (!$insttypechg) {
226: foreach my $status (@currstatuses) {
227: if (!grep/^\Q$status\E/,@inststatuses) {
228: $insttypechg = 1;
229: }
230: }
231: }
232: return ($insttypechg,@inststatuses);
233: }
234:
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