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