Annotation of loncom/interface/domainprefs.pm, revision 1.33
1.1 raeburn 1: # The LearningOnline Network with CAPA
2: # Handler to set domain-wide configuration settings
3: #
1.33 ! raeburn 4: # $Id: domainprefs.pm,v 1.32 2007/11/10 03:51:46 raeburn Exp $
1.2 albertel 5: #
1.1 raeburn 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: # /home/httpd/html/adm/gpl.txt
24: #
25: # http://www.lon-capa.org/
26: #
27: #
28: ###############################################################
29: ##############################################################
30:
31: package Apache::domainprefs;
32:
33: use strict;
34: use Apache::Constants qw(:common :http);
35: use Apache::lonnet;
36: use Apache::loncommon();
37: use Apache::lonhtmlcommon();
38: use Apache::lonlocal;
39: use LONCAPA();
1.6 raeburn 40: use LONCAPA::Enrollment;
1.9 raeburn 41: use File::Copy;
1.1 raeburn 42:
43: sub handler {
44: my $r=shift;
45: if ($r->header_only) {
46: &Apache::loncommon::content_type($r,'text/html');
47: $r->send_http_header;
48: return OK;
49: }
50:
51: my $dom = $env{'request.role.domain'};
1.5 albertel 52: my $domdesc = &Apache::lonnet::domain($dom,'description');
1.1 raeburn 53: if (&Apache::lonnet::allowed('mau',$dom)) {
54: &Apache::loncommon::content_type($r,'text/html');
55: $r->send_http_header;
56: } else {
57: $env{'user.error.msg'}=
58: "/adm/domainprefs:mau:0:0:Cannot modify domain settings";
59: return HTTP_NOT_ACCEPTABLE;
60: }
61: &Apache::lonhtmlcommon::clear_breadcrumbs();
62: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
63: ['phase']);
1.30 raeburn 64: my $phase = 'pickactions';
1.3 raeburn 65: if ( exists($env{'form.phase'}) ) {
66: $phase = $env{'form.phase'};
67: }
68: my %domconfig =
1.6 raeburn 69: &Apache::lonnet::get_dom('configuration',['login','rolecolors',
1.27 raeburn 70: 'quotas','autoenroll','autoupdate','directorysrch',
1.33 ! raeburn 71: 'usercreation','usermodification','contacts'],$dom);
1.30 raeburn 72: my @prefs_order = ('rolecolors','login','quotas','autoenroll',
73: 'autoupdate','directorysrch','contacts',
1.33 ! raeburn 74: 'usercreation','usermodification');
1.30 raeburn 75: my %prefs = (
76: 'rolecolors' =>
77: { text => 'Default color schemes',
78: help => 'Default_Color_Schemes',
79: header => [{col1 => 'Student Settings',
80: col2 => '',},
81: {col1 => 'Coordinator Settings',
82: col2 => '',},
83: {col1 => 'Author Settings',
84: col2 => '',},
85: {col1 => 'Administrator Settings',
86: col2 => '',}],
87: },
88: 'login' =>
89: { text => 'Log-in page options',
90: help => 'Domain_Log-in_Page',
91: header => [{col1 => 'Item',
92: col2 => '',}],
93: },
94: 'quotas' =>
95: { text => 'Default quotas for user portfolios',
96: help => 'Default_User_Quota',
97: header => [{col1 => 'User type',
98: col2 => 'Default quota'}],
99: },
100: 'autoenroll' =>
101: { text => 'Auto-enrollment settings',
102: help => 'Domain_Auto_Enrollment',
103: header => [{col1 => 'Configuration setting',
104: col2 => 'Value(s)'}],
105: },
106: 'autoupdate' =>
107: { text => 'Auto-update settings',
108: help => 'Domain_Auto_Update',
109: header => [{col1 => 'Setting',
110: col2 => 'Value',},
111: {col1 => 'User Population',
112: col2 => 'Updataeable user data'}],
113: },
114: 'directorysrch' =>
115: { text => 'Institutional directory searches',
116: help => 'Domain_Directory_Search',
117: header => [{col1 => 'Setting',
118: col2 => 'Value',}],
119: },
120: 'contacts' =>
121: { text => 'Contact Information',
122: help => 'Domain_Contact_Information',
123: header => [{col1 => 'Setting',
124: col2 => 'Value',}],
125: },
126:
127: 'usercreation' =>
128: { text => 'User creation',
129: help => 'Domain_User_Creation',
130: header => [{col1 => 'Setting',
131: col2 => 'Value',},
132: {col1 => 'Context',
133: col2 => 'Assignable Authentication Types'}],
134: },
1.33 ! raeburn 135: 'usermodification' =>
! 136: { text => 'User modification',
! 137: help => 'Domain_User_Modification',
! 138: header => [{col1 => 'Target user has role',
! 139: col2 => 'User information updateable in author context'},
! 140: {col1 => 'Target user has role',
! 141: col2 => 'User information updateable in course context'}],
! 142: },
1.3 raeburn 143: );
1.6 raeburn 144: my @roles = ('student','coordinator','author','admin');
1.30 raeburn 145: my @actions = &Apache::loncommon::get_env_multiple('form.actions');
1.3 raeburn 146: &Apache::lonhtmlcommon::add_breadcrumb
1.30 raeburn 147: ({href=>"javascript:changePage(document.$phase,'pickactions')",
148: text=>"Pick functionality"});
1.9 raeburn 149: my $confname = $dom.'-domainconfig';
1.3 raeburn 150: if ($phase eq 'process') {
1.1 raeburn 151: &Apache::lonhtmlcommon::add_breadcrumb
1.30 raeburn 152: ({href=>"javascript:changePage(document.$phase,'display')",
153: text=>"Domain Configuration"},
154: {href=>"javascript:changePage(document.$phase,'$phase')",
1.3 raeburn 155: text=>"Updated"});
156: &print_header($r,$phase);
1.30 raeburn 157: foreach my $item (@prefs_order) {
158: if (grep(/^\Q$item\E$/,@actions)) {
159: $r->print('<h3>'.&mt($prefs{$item}{'text'}).'</h3>'.
160: &process_changes($r,$dom,$confname,$item,
161: \@roles,%domconfig));
162: }
1.3 raeburn 163: }
164: $r->print('<p>');
1.30 raeburn 165: &print_footer($r,$phase,'display','Back to configuration display',
166: \@actions);
1.3 raeburn 167: $r->print('</p>');
1.30 raeburn 168: } elsif ($phase eq 'display') {
169: &Apache::lonhtmlcommon::add_breadcrumb
170: ({href=>"javascript:changePage(document.$phase,'display')",
171: text=>"Domain Configuration"});
172: &print_header($r,$phase);
173: if (@actions > 0) {
174: my $rowsum = 0;
175: my (%output,%rowtotal,@items);
176: my $halfway = @actions/2;
177: foreach my $item (@prefs_order) {
178: if (grep(/^\Q$item\E$/,@actions)) {
179: push(@items,$item);
180: ($output{$item},$rowtotal{$item}) =
181: &print_config_box($r,$dom,$confname,$phase,
182: $item,$prefs{$item},
183: $domconfig{$item});
184: $rowsum += $rowtotal{$item};
185: }
186: }
187: my $colend;
188: my $halfway = $rowsum/2;
189: my $aggregate = 0;
190: my $sumleft = 0;
191: my $sumright = 0;
192: my $crossover;
193: for (my $i=0; $i<@items; $i++) {
194: $aggregate += $rowtotal{$items[$i]};
195: if ($aggregate > $halfway) {
196: $crossover = $i;
197: last;
198: }
199: }
200: for (my $i=0; $i<$crossover; $i++) {
201: $sumleft += $rowtotal{$items[$i]};
202: }
203: for (my $i=$crossover+1; $i<@items; $i++) {
204: $sumright += $rowtotal{$items[$i]};
205: }
206: if ((@items > 1) && ($env{'form.numcols'} == 2)) {
207: my $sumdiff = $sumright - $sumleft;
208: if ($sumdiff > 0) {
209: $colend = $crossover + 1;
210: } else {
211: $colend = $crossover;
212: }
213: } else {
214: $colend = @items;
215: }
216: $r->print('<p><table class="LC_double_column"><tr><td class="LC_left_col">');
217: for (my $i=0; $i<$colend; $i++) {
218: $r->print($output{$items[$i]});
219: }
220: $r->print('</td><td></td><td class="LC_right_col">');
221: if ($colend < @items) {
222: for (my $i=$colend; $i<@items; $i++) {
223: $r->print($output{$items[$i]});
224: }
225: }
226: $r->print('</td></tr></table></p>');
227: $r->print(&print_footer($r,$phase,'process','Save',\@actions));
228: } else {
229: $r->print('<input type="hidden" name="phase" value="" />'.
230: '<input type="hidden" name="numcols" value="'.
231: $env{'form.numcols'}.'" />'."\n".
232: '<span clas="LC_error">'.&mt('No settings chosen').
233: '</span>');
234: }
235: $r->print('</form>');
236: $r->print(&Apache::loncommon::end_page());
1.1 raeburn 237: } else {
1.3 raeburn 238: if ($phase eq '') {
1.30 raeburn 239: $phase = 'pickactions';
1.1 raeburn 240: }
1.30 raeburn 241: my %helphash;
1.3 raeburn 242: &print_header($r,$phase);
1.21 raeburn 243: if (keys(%domconfig) == 0) {
244: my $primarylibserv = &Apache::lonnet::domain($dom,'primary');
1.29 raeburn 245: my @ids=&Apache::lonnet::current_machine_ids();
246: if (!grep(/^\Q$primarylibserv\E$/,@ids)) {
1.21 raeburn 247: my %designhash = &Apache::loncommon::get_domainconf($dom);
248: my @loginimages = ('img','logo','domlogo');
249: my $custom_img_count = 0;
250: foreach my $img (@loginimages) {
251: if ($designhash{$dom.'.login.'.$img} ne '') {
252: $custom_img_count ++;
253: }
254: }
255: foreach my $role (@roles) {
256: if ($designhash{$dom.'.'.$role.'.img'} ne '') {
257: $custom_img_count ++;
258: }
259: }
260: if ($custom_img_count > 0) {
261: my $switch_server = &check_switchserver($dom,$confname);
1.29 raeburn 262: $r->print(
263: &mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').'<br />'.
264: &mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'<br /><br />'.
265: &mt("Thereafter, (with a Domain Coordinator role selected in the domain) you will be able to update settings when logged in to any server in the LON-CAPA network.").'<br />'.
266: &mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'<br /><br />');
267: if ($switch_server) {
1.30 raeburn 268: $r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
1.29 raeburn 269: }
1.21 raeburn 270: return OK;
271: }
272: }
273: }
1.30 raeburn 274: $r->print('<h3>'.&mt('Functionality to display/modify').'</h3>');
275: $r->print('<script type="text/javascript">'."\n".
276: &Apache::loncommon::check_uncheck_jscript()."\n".
277: '</script>'."\n".'<p><input type="button" value="check all" '.
278: 'onclick="javascript:checkAll(document.pickactions.actions)"'.
279: ' /> '.
280: '<input type="button" value="uncheck all" '.
281: 'onclick="javascript:uncheckAll(document.pickactions.actions)"'.
282: ' /></p>');
283: foreach my $item (@prefs_order) {
284: $r->print('<p><label><input type="checkbox" name="actions" value="'.$item.'" /> '.$prefs{$item}->{'text'}.'</label></p>');
285: }
286: $r->print('<h3>'.&mt('Display options').'</h3>'."\n".
287: '<p><span class="LC_nobreak">'.&mt('Display using: ')."\n".
288: '<label><input type="radio" name="numcols" value="1">'.
289: &mt('one column').'</label> '.
290: '<input type="radio" name="numcols" value="2">'.
291: &mt('two columns').'</label></span></p>');
292: $r->print(&print_footer($r,$phase,'display','Go'));
293: $r->print('</form>');
294: $r->print(&Apache::loncommon::end_page());
1.3 raeburn 295: }
296: return OK;
297: }
298:
299: sub process_changes {
1.9 raeburn 300: my ($r,$dom,$confname,$action,$roles,%domconfig) = @_;
1.3 raeburn 301: my $output;
302: if ($action eq 'login') {
1.9 raeburn 303: $output = &modify_login($r,$dom,$confname,%domconfig);
1.6 raeburn 304: } elsif ($action eq 'rolecolors') {
1.9 raeburn 305: $output = &modify_rolecolors($r,$dom,$confname,$roles,
306: %domconfig);
1.3 raeburn 307: } elsif ($action eq 'quotas') {
308: $output = &modify_quotas($dom,%domconfig);
309: } elsif ($action eq 'autoenroll') {
310: $output = &modify_autoenroll($dom,%domconfig);
311: } elsif ($action eq 'autoupdate') {
312: $output = &modify_autoupdate($dom,%domconfig);
1.23 raeburn 313: } elsif ($action eq 'directorysrch') {
314: $output = &modify_directorysrch($dom,%domconfig);
1.27 raeburn 315: } elsif ($action eq 'usercreation') {
1.28 raeburn 316: $output = &modify_usercreation($dom,%domconfig);
1.33 ! raeburn 317: } elsif ($action eq 'usermodification') {
! 318: $output = &modify_usermodification($dom,%domconfig);
1.28 raeburn 319: } elsif ($action eq 'contacts') {
320: $output = &modify_contacts($dom,%domconfig);
1.3 raeburn 321: }
322: return $output;
323: }
324:
325: sub print_config_box {
1.9 raeburn 326: my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_;
1.30 raeburn 327: my $rowtotal = 0;
328: my $output =
329: '<table class="LC_nested_outer">
1.3 raeburn 330: <tr>
1.30 raeburn 331: <th align="left"><span class="LC_nobreak">'.&mt($item->{text}).
332: ' </span></th></tr>';
1.22 raeburn 333: #
334: # FIXME - put the help link back in when the help files exist
335: # <th>'.&mt($item->{text}).' '.
336: # &Apache::loncommon::help_open_topic($item->{'help'}).'</th>
337: # </tr>');
1.30 raeburn 338: $rowtotal ++;
1.28 raeburn 339: if (($action eq 'autoupdate') || ($action eq 'rolecolors') ||
1.33 ! raeburn 340: ($action eq 'usercreation') || ($action eq 'usermodification')) {
1.6 raeburn 341: my $colspan = ($action eq 'rolecolors')?' colspan="2"':'';
1.30 raeburn 342: $output .= '
1.3 raeburn 343: <tr>
344: <td>
345: <table class="LC_nested">
346: <tr class="LC_info_row">
1.6 raeburn 347: <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[0]->{'col1'}.'</td>
1.3 raeburn 348: <td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td>
1.30 raeburn 349: </tr>';
350: $rowtotal ++;
1.6 raeburn 351: if ($action eq 'autoupdate') {
1.30 raeburn 352: $output .= &print_autoupdate('top',$dom,$settings,\$rowtotal);
1.28 raeburn 353: } elsif ($action eq 'usercreation') {
1.33 ! raeburn 354: $output .= &print_usercreation('top',$dom,$settings,\$rowtotal);
! 355: } elsif ($action eq 'usermodification') {
! 356: $output .= &print_usermodification('top',$dom,$settings,\$rowtotal);
1.6 raeburn 357: } else {
1.30 raeburn 358: $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal);
1.6 raeburn 359: }
1.30 raeburn 360: $output .= '
1.6 raeburn 361: </table>
362: </td>
363: </tr>
364: <tr>
365: <td>
366: <table class="LC_nested">
367: <tr class="LC_info_row">
368: <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[1]->{'col1'}.'</td>
369: <td class="LC_right_item">'.$item->{'header'}->[1]->{'col2'}.'</td>
1.30 raeburn 370: </tr>';
371: $rowtotal ++;
1.6 raeburn 372: if ($action eq 'autoupdate') {
1.30 raeburn 373: $output .= &print_autoupdate('bottom',$dom,$settings,\$rowtotal);
1.28 raeburn 374: } elsif ($action eq 'usercreation') {
1.30 raeburn 375: $output .= &print_usercreation('bottom',$dom,$settings,\$rowtotal);
1.33 ! raeburn 376: } elsif ($action eq 'usermodification') {
! 377: $output .= &print_usermodification('bottom',$dom,$settings,\$rowtotal);
1.6 raeburn 378: } else {
1.30 raeburn 379: $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
1.6 raeburn 380: </table>
381: </td>
382: </tr>
383: <tr>
384: <td>
385: <table class="LC_nested">
386: <tr class="LC_info_row">
387: <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[2]->{'col1'}.'</td>
388: <td class="LC_right_item">'.$item->{'header'}->[2]->{'col2'}.'</td>
1.3 raeburn 389: </tr>'.
1.30 raeburn 390: &print_rolecolors($phase,'author',$dom,$confname,$settings,\$rowtotal).'
1.3 raeburn 391: </table>
392: </td>
393: </tr>
394: <tr>
395: <td>
396: <table class="LC_nested">
397: <tr class="LC_info_row">
1.6 raeburn 398: <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[3]->{'col1'}.'</td>
399: <td class="LC_right_item">'.$item->{'header'}->[3]->{'col2'}.'</td>
1.3 raeburn 400: </tr>'.
1.30 raeburn 401: &print_rolecolors($phase,'admin',$dom,$confname,$settings,\$rowtotal);
402: $rowtotal += 2;
1.6 raeburn 403: }
1.3 raeburn 404: } else {
1.30 raeburn 405: $output .= '
1.3 raeburn 406: <tr>
407: <td>
408: <table class="LC_nested">
1.30 raeburn 409: <tr class="LC_info_row">';
1.24 raeburn 410: if (($action eq 'login') || ($action eq 'directorysrch')) {
1.30 raeburn 411: $output .= '
412: <td class="LC_left_item" colspan="2">'.$item->{'header'}->[0]->{'col1'}.'</td>';
1.6 raeburn 413: } else {
1.30 raeburn 414: $output .= '
415: <td class="LC_left_item">'.$item->{'header'}->[0]->{'col1'}.'</td>';
1.6 raeburn 416: }
1.30 raeburn 417: $output .= '
1.3 raeburn 418: <td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td>
1.30 raeburn 419: </tr>';
420: $rowtotal ++;
1.3 raeburn 421: if ($action eq 'login') {
1.30 raeburn 422: $output .= &print_login($dom,$confname,$phase,$settings,\$rowtotal);
1.3 raeburn 423: } elsif ($action eq 'quotas') {
1.30 raeburn 424: $output .= &print_quotas($dom,$settings,\$rowtotal);
1.3 raeburn 425: } elsif ($action eq 'autoenroll') {
1.30 raeburn 426: $output .= &print_autoenroll($dom,$settings,\$rowtotal);
1.23 raeburn 427: } elsif ($action eq 'directorysrch') {
1.30 raeburn 428: $output .= &print_directorysrch($dom,$settings,\$rowtotal);
1.28 raeburn 429: } elsif ($action eq 'contacts') {
1.30 raeburn 430: $output .= &print_contacts($dom,$settings,\$rowtotal);
1.27 raeburn 431: }
1.3 raeburn 432: }
1.30 raeburn 433: $output .= '
1.3 raeburn 434: </table>
435: </td>
436: </tr>
1.30 raeburn 437: </table><br />';
438: return ($output,$rowtotal);
1.1 raeburn 439: }
440:
441: sub print_header {
1.3 raeburn 442: my ($r,$phase) = @_;
1.30 raeburn 443: my $alert = &mt('You must select at least one functionality type to display.');
1.6 raeburn 444: my $js = '
1.1 raeburn 445: <script type="text/javascript">
446: function changePage(formname,newphase) {
447: formname.phase.value = newphase;
1.30 raeburn 448: numchecked = 0;
449: if (formname == document.pickactions) {
450: if (formname.actions.length > 0) {
451: for (var i = 0; i <formname.actions.length; i++) {
452: if (formname.actions[i].checked) {
453: numchecked ++;
454: }
455: }
456: } else {
457: if (formname.actions.checked) {
458: numchecked ++;
459: }
460: }
461: if (numchecked > 0) {
462: formname.submit();
463: } else {
464: alert("'.$alert.'");
465: return;
466: }
467: }
1.1 raeburn 468: formname.submit();
1.30 raeburn 469: }'."\n";
470: if ($phase eq 'pickactions') {
471: $js .=
472: &Apache::lonhtmlcommon::set_form_elements({actions => 'checkbox',numcols => 'radio',})."\n".
473: &javascript_set_colnums();
474: } elsif ($phase eq 'display') {
475: $js .= &color_pick_js()."\n";
476: }
1.31 raeburn 477: $js .= &Apache::loncommon::viewport_size_js().'
1.1 raeburn 478: </script>
1.6 raeburn 479: ';
1.30 raeburn 480: my $additem;
481: if ($phase eq 'pickactions') {
482: my %loaditems = (
1.31 raeburn 483: 'onload' => "javascript:getViewportDims(document.$phase.width,document.$phase.height);setDisplayColumns();setFormElements(document.pickactions);",
1.30 raeburn 484: );
485: $additem = {'add_entries' => \%loaditems,};
486: } else {
487: my %loaditems = (
1.31 raeburn 488: 'onload' => "javascript:getViewportDims(document.$phase.width,document.$phase.height);",
1.30 raeburn 489: );
490: $additem = {'add_entries' => \%loaditems,};
491: }
1.2 albertel 492: $r->print(&Apache::loncommon::start_page('View/Modify Domain Settings',
1.30 raeburn 493: $js,$additem));
1.3 raeburn 494: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Domain Settings'));
1.6 raeburn 495: $r->print('
1.8 raeburn 496: <form name="parmform" action="">
1.6 raeburn 497: <input type="hidden" name="pres_marker" />
498: <input type="hidden" name="pres_type" />
499: <input type="hidden" name="pres_value" />
500: </form>
501: ');
502: $r->print('<form method="post" name="'.$phase.'" action="/adm/domainprefs"'.
503: ' enctype="multipart/form-data">');
1.1 raeburn 504: return;
505: }
506:
507: sub print_footer {
1.30 raeburn 508: my ($r,$phase,$newphase,$button_text,$actions) = @_;
1.3 raeburn 509: $button_text = &mt($button_text);
1.30 raeburn 510: $r->print('<input type="hidden" name="phase" value="" />'.
511: '<input type="hidden" name="width" value="'.
512: $env{'form.width'}.'" />'.
513: '<input type="hidden" name="height" value="'.
514: $env{'form.height'}.'" />');
515: if (($phase eq 'display') || ($phase eq 'process')) {
516: if (ref($actions) eq 'ARRAY') {
517: foreach my $item (@{$actions}) {
518: $r->print('<input type="hidden" name="actions" value="'.$item.'" />')."\n";
519: }
520: }
521: $r->print('<input type="hidden" name="numcols" value="'.$env{'form.numcols'}.'" />');
522: }
1.3 raeburn 523: my $dest='"javascript:changePage(document.'.$phase.','."'$newphase'".')"';
524: if ($phase eq 'process') {
1.30 raeburn 525: $r->print('<p><a href='.$dest.'>'.$button_text.'</a></p>');
1.3 raeburn 526: } else {
1.30 raeburn 527: my $onclick;
528: if ($phase eq 'display') {
529: $onclick = '"javascript:changePage(document.'.$phase.','."'$newphase'".')"';
530: } else {
531: $onclick = '"javascript:changePage(document.'.$phase.','."'$newphase'".')"';
532: }
533: $r->print('<p><input type="button" name="store" value="'.
534: $button_text.'" onclick='.$onclick.' /></p>');
535: }
536: if ($phase eq 'process') {
537: $r->print('</form>'.&Apache::loncommon::end_page());
1.3 raeburn 538: }
1.1 raeburn 539: return;
540: }
541:
1.3 raeburn 542: sub print_login {
1.30 raeburn 543: my ($dom,$confname,$phase,$settings,$rowtotal) = @_;
1.6 raeburn 544: my %choices = &login_choices();
545: my ($catalogon,$catalogoff,$adminmailon,$adminmailoff);
546: $catalogon = ' checked="checked" ';
547: $adminmailoff = ' checked="checked" ';
548: my @images = ('img','logo','domlogo');
549: my @bgs = ('pgbg','mainbg','sidebg');
550: my @links = ('link','alink','vlink');
1.7 albertel 551: my %designhash = &Apache::loncommon::get_domainconf($dom);
1.6 raeburn 552: my %defaultdesign = %Apache::loncommon::defaultdesign;
553: my (%is_custom,%designs);
554: my %defaults = (
555: font => $defaultdesign{'login.font'},
556: );
557: foreach my $item (@images) {
558: $defaults{$item} = $defaultdesign{'login.'.$item};
559: }
560: foreach my $item (@bgs) {
561: $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item};
562: }
563: foreach my $item (@links) {
564: $defaults{'links'}{$item} = $defaultdesign{'login.'.$item};
565: }
1.3 raeburn 566: if (ref($settings) eq 'HASH') {
567: if ($settings->{'coursecatalog'} eq '0') {
1.1 raeburn 568: $catalogoff = $catalogon;
569: $catalogon = ' ';
570: }
1.3 raeburn 571: if ($settings->{'adminmail'} eq '1') {
1.1 raeburn 572: $adminmailon = $adminmailoff;
573: $adminmailoff = ' ';
574: }
1.6 raeburn 575: foreach my $item (@images) {
576: if ($settings->{$item} ne '') {
577: $designs{$item} = $settings->{$item};
578: $is_custom{$item} = 1;
579: }
580: }
581: if ($settings->{'font'} ne '') {
582: $designs{'font'} = $settings->{'font'};
583: $is_custom{'font'} = 1;
584: }
585: foreach my $item (@bgs) {
586: if ($settings->{$item} ne '') {
587: $designs{'bgs'}{$item} = $settings->{$item};
588: $is_custom{$item} = 1;
589: }
590: }
591: foreach my $item (@links) {
592: if ($settings->{$item} ne '') {
593: $designs{'links'}{$item} = $settings->{$item};
594: $is_custom{$item} = 1;
595: }
596: }
597: } else {
598: if ($designhash{$dom.'.login.font'} ne '') {
599: $designs{'font'} = $designhash{$dom.'.login.font'};
600: $is_custom{'font'} = 1;
601: }
1.8 raeburn 602: foreach my $item (@images) {
603: if ($designhash{$dom.'.login.'.$item} ne '') {
604: $designs{$item} = $designhash{$dom.'.login.'.$item};
605: $is_custom{$item} = 1;
606: }
607: }
1.6 raeburn 608: foreach my $item (@bgs) {
609: if ($designhash{$dom.'.login.'.$item} ne '') {
610: $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item};
611: $is_custom{$item} = 1;
612: }
613: }
614: foreach my $item (@links) {
615: if ($designhash{$dom.'.login.'.$item} ne '') {
616: $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item};
617: $is_custom{$item} = 1;
618: }
619: }
1.1 raeburn 620: }
1.6 raeburn 621: my %alt_text = &Apache::lonlocal::texthash ( img => 'Log-in banner',
622: logo => 'Institution Logo',
623: domlogo => 'Domain Logo');
624: my $itemcount = 1;
625: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.3 raeburn 626: my $datatable =
1.6 raeburn 627: '<tr'.$css_class.'><td colspan="2">'.$choices{'coursecatalog'}.
628: '</td><td>'.
1.8 raeburn 629: '<span class="LC_nobreak"><label><input type="radio" name="coursecatalog"'.
630: $catalogon.' value="1" />'.&mt('Yes').'</label> '.
631: '<label><input type="radio" name="coursecatalog"'.
632: $catalogoff.'value="0" />'.&mt('No').'</label></span></td>'.
1.6 raeburn 633: '</tr>';
634: $itemcount ++;
635: $css_class = $itemcount%2?' class="LC_odd_row"':'';
636: $datatable .= '<tr'.$css_class.'>'.
637: '<td colspan="2">'.$choices{'adminmail'}.'</td>'.
1.8 raeburn 638: '<td><span class="LC_nobreak">'.
639: '<label><input type="radio" name="adminmail"'.
640: $adminmailon.' value="1" />'.&mt('Yes').'</label> '.
641: '<label><input type="radio" name="adminmail"'.
642: $adminmailoff.'value="0" />'.&mt('No').'</label></span></td></tr>';
1.6 raeburn 643: $itemcount ++;
1.30 raeburn 644: $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal);
1.6 raeburn 645: $datatable .= '</tr></table></td></tr>';
646: return $datatable;
647: }
648:
649: sub login_choices {
650: my %choices =
651: &Apache::lonlocal::texthash (
652: coursecatalog => 'Display Course Catalog link?',
653: adminmail => "Display Administrator's E-mail Address?",
654: img => "Header",
655: logo => "Main Logo",
656: domlogo => "Domain Logo",
657: bgs => "Background colors",
658: links => "Link colors",
659: font => "Font color",
660: pgbg => "Page",
661: mainbg => "Main panel",
662: sidebg => "Side panel",
663: link => "Link",
664: alink => "Active link",
665: vlink => "Visited link",
666: );
667: return %choices;
668: }
669:
670: sub print_rolecolors {
1.30 raeburn 671: my ($phase,$role,$dom,$confname,$settings,$rowtotal) = @_;
1.6 raeburn 672: my %choices = &color_font_choices();
673: my @bgs = ('pgbg','tabbg','sidebg');
674: my @links = ('link','alink','vlink');
675: my @images = ('img');
676: my %alt_text = &Apache::lonlocal::texthash(img => "Banner for $role role");
1.7 albertel 677: my %designhash = &Apache::loncommon::get_domainconf($dom);
1.6 raeburn 678: my %defaultdesign = %Apache::loncommon::defaultdesign;
679: my (%is_custom,%designs);
680: my %defaults = (
681: img => $defaultdesign{$role.'.img'},
682: font => $defaultdesign{$role.'.font'},
683: );
684: foreach my $item (@bgs) {
685: $defaults{'bgs'}{$item} = $defaultdesign{$role.'.'.$item};
686: }
687: foreach my $item (@links) {
688: $defaults{'links'}{$item} = $defaultdesign{$role.'.'.$item};
689: }
690: if (ref($settings) eq 'HASH') {
691: if (ref($settings->{$role}) eq 'HASH') {
692: if ($settings->{$role}->{'img'} ne '') {
693: $designs{'img'} = $settings->{$role}->{'img'};
694: $is_custom{'img'} = 1;
695: }
696: if ($settings->{$role}->{'font'} ne '') {
697: $designs{'font'} = $settings->{$role}->{'font'};
698: $is_custom{'font'} = 1;
699: }
700: foreach my $item (@bgs) {
701: if ($settings->{$role}->{$item} ne '') {
702: $designs{'bgs'}{$item} = $settings->{$role}->{$item};
703: $is_custom{$item} = 1;
704: }
705: }
706: foreach my $item (@links) {
707: if ($settings->{$role}->{$item} ne '') {
708: $designs{'links'}{$item} = $settings->{$role}->{$item};
709: $is_custom{$item} = 1;
710: }
711: }
712: }
713: } else {
714: if ($designhash{$dom.'.'.$role.'.img'} ne '') {
715: $designs{img} = $designhash{$dom.'.'.$role.'.img'};
716: $is_custom{'img'} = 1;
717: }
718: if ($designhash{$dom.'.'.$role.'.font'} ne '') {
719: $designs{font} = $designhash{$dom.'.'.$role.'.font'};
720: $is_custom{'font'} = 1;
721: }
722: foreach my $item (@bgs) {
723: if ($designhash{$dom.'.'.$role.'.'.$item} ne '') {
724: $designs{'bgs'}{$item} = $designhash{$dom.'.'.$role.'.'.$item};
725: $is_custom{$item} = 1;
726:
727: }
728: }
729: foreach my $item (@links) {
730: if ($designhash{$dom.'.'.$role.'.'.$item} ne '') {
731: $designs{'links'}{$item} = $designhash{$dom.'.'.$role.'.'.$item};
732: $is_custom{$item} = 1;
733: }
734: }
735: }
736: my $itemcount = 1;
1.30 raeburn 737: my $datatable = &display_color_options($dom,$confname,$phase,$role,$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal);
1.6 raeburn 738: $datatable .= '</tr></table></td></tr>';
739: return $datatable;
740: }
741:
742: sub display_color_options {
1.9 raeburn 743: my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs,
1.30 raeburn 744: $images,$bgs,$links,$alt_text,$rowtotal) = @_;
1.6 raeburn 745: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
746: my $datatable = '<tr'.$css_class.'>'.
747: '<td>'.$choices->{'font'}.'</td>';
748: if (!$is_custom->{'font'}) {
1.30 raeburn 749: $datatable .= '<td>'.&mt('Default in use:').' <span id="css_default_'.$role.'_font" style="color: '.$defaults->{'font'}.';">'.$defaults->{'font'}.'</span></td>';
1.6 raeburn 750: } else {
751: $datatable .= '<td> </td>';
752: }
753: my $fontlink = &color_pick($phase,$role,'font',$choices->{'font'},$designs->{'font'});
1.8 raeburn 754: $datatable .= '<td><span class="LC_nobreak">'.
1.6 raeburn 755: '<input type="text" size="10" name="'.$role.'_font"'.
1.8 raeburn 756: ' value="'.$designs->{'font'}.'" /> '.$fontlink.
1.30 raeburn 757: ' <span id="css_'.$role.'_font" style="background-color: '.
758: $designs->{'font'}.';"> </span>'.
1.8 raeburn 759: '</span></td></tr>';
1.9 raeburn 760: my $switchserver = &check_switchserver($dom,$confname);
1.6 raeburn 761: foreach my $img (@{$images}) {
1.18 albertel 762: $itemcount ++;
1.6 raeburn 763: $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.8 raeburn 764: $datatable .= '<tr'.$css_class.'>'.
1.6 raeburn 765: '<td>'.$choices->{$img}.'</td>';
1.18 albertel 766: my ($imgfile, $img_import);
1.6 raeburn 767: if ($designs->{$img} ne '') {
768: $imgfile = $designs->{$img};
1.18 albertel 769: $img_import = ($imgfile =~ m{^/adm/});
1.6 raeburn 770: } else {
771: $imgfile = $defaults->{$img};
772: }
773: if ($imgfile) {
1.9 raeburn 774: my ($showfile,$fullsize);
775: if ($imgfile =~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
1.6 raeburn 776: my $urldir = $1;
777: my $filename = $2;
778: my @info = &Apache::lonnet::stat_file($designs->{$img});
779: if (@info) {
780: my $thumbfile = 'tn-'.$filename;
781: my @thumb=&Apache::lonnet::stat_file($urldir.'/'.$thumbfile);
782: if (@thumb) {
783: $showfile = $urldir.'/'.$thumbfile;
784: } else {
785: $showfile = $imgfile;
786: }
787: } else {
788: $showfile = '';
789: }
790: } elsif ($imgfile =~ m-^/(adm/[^/]+)/([^/]+)$-) {
1.16 raeburn 791: $showfile = $imgfile;
1.6 raeburn 792: my $imgdir = $1;
793: my $filename = $2;
794: if (-e "/home/httpd/html/$imgdir/tn-".$filename) {
795: $showfile = "/$imgdir/tn-".$filename;
796: } else {
797: my $input = "/home/httpd/html".$imgfile;
798: my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename;
799: if (!-e $output) {
1.9 raeburn 800: my ($width,$height) = &thumb_dimensions();
1.16 raeburn 801: my ($fullwidth,$fullheight) = &check_dimensions($input);
802: if ($fullwidth ne '' && $fullheight ne '') {
803: if ($fullwidth > $width && $fullheight > $height) {
804: my $size = $width.'x'.$height;
805: system("convert -sample $size $input $output");
806: $showfile = '/'.$imgdir.'/tn-'.$filename;
807: }
808: }
1.6 raeburn 809: }
810: }
1.16 raeburn 811: }
1.6 raeburn 812: if ($showfile) {
1.9 raeburn 813: $showfile = &Apache::loncommon::lonhttpdurl($showfile);
814: $fullsize = &Apache::loncommon::lonhttpdurl($imgfile);
1.6 raeburn 815: $datatable.= '<td>';
816: if (!$is_custom->{$img}) {
817: $datatable .= &mt('Default in use:').'<br />';
818: }
1.18 albertel 819: if ($img_import) {
820: $datatable.= '<input type="hidden" name="'.$role.'_import_'.$img.'" value="'.$imgfile.'" />';
821: }
1.9 raeburn 822: $datatable.= '<a href="'.$fullsize.'" target="_blank"><img src="'.
823: $showfile.'" alt="'.$alt_text->{$img}.
824: '" border="0" /></a></td>';
1.6 raeburn 825: if ($is_custom->{$img}) {
1.8 raeburn 826: $datatable.='<td><span class="LC_nobreak"><label><input type="checkbox" name="'.
827: $role.'_del_'.$img.'" value="1" />'.&mt('Delete?').
828: '</label> '.&mt('Replace:').'</span><br />';
1.6 raeburn 829: } else {
830: $datatable.='<td valign="bottom">'.&mt('Upload:').'<br />';
831: }
832: } else {
833: $datatable .= '<td colspan="2" class="LC_right_item"><br />'.
834: &mt('Upload:');
835: }
836: } else {
837: $datatable .= '<td colspan="2" class="LC_right_item"><br />'.
838: &mt('Upload:');
839: }
1.9 raeburn 840: if ($switchserver) {
841: $datatable .= &mt('Upload to library server: [_1]',$switchserver);
842: } else {
843: $datatable .=' <input type="file" name="'.$role.'_'.$img.'" />';
844: }
845: $datatable .= '</td></tr>';
1.6 raeburn 846: }
847: $itemcount ++;
848: $css_class = $itemcount%2?' class="LC_odd_row"':'';
849: $datatable .= '<tr'.$css_class.'>'.
850: '<td>'.$choices->{'bgs'}.'</td>';
851: my $bgs_def;
852: foreach my $item (@{$bgs}) {
853: if (!$is_custom->{$item}) {
1.30 raeburn 854: $bgs_def .= '<td>'.$choices->{$item}.' <span id="css_default_'.$role.'_'.$item.'" style="background-color: '.$defaults->{'bgs'}{$item}.';"> </span><br />'.$defaults->{'bgs'}{$item}.'</td>';
1.6 raeburn 855: }
856: }
857: if ($bgs_def) {
1.8 raeburn 858: $datatable .= '<td>'.&mt('Default(s) in use:').'<br /><table border="0"><tr>'.$bgs_def.'</tr></table></td>';
1.6 raeburn 859: } else {
860: $datatable .= '<td> </td>';
861: }
862: $datatable .= '<td class="LC_right_item">'.
863: '<table border="0"><tr>';
864: foreach my $item (@{$bgs}) {
865: my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'bgs'}{$item});
866: $datatable .= '<td align="center">'.$link;
867: if ($designs->{'bgs'}{$item}) {
1.30 raeburn 868: $datatable .= ' <span id="css_'.$role.'_'.$item.'" style="background-color: '.$designs->{'bgs'}{$item}.';"> </span>';
1.6 raeburn 869: }
870: $datatable .= '<br /><input type="text" size="8" name="'.$role.'_'.$item.'" value="'.$designs->{'bgs'}{$item}.
1.30 raeburn 871: '" onblur = "javascript:document.display.css_'.$role.'_'.$item.'.style.background-color = document.display.'.$role.'_'.$item.'.value;"/></td>';
1.6 raeburn 872: }
873: $datatable .= '</tr></table></td></tr>';
874: $itemcount ++;
875: $css_class = $itemcount%2?' class="LC_odd_row"':'';
876: $datatable .= '<tr'.$css_class.'>'.
877: '<td>'.$choices->{'links'}.'</td>';
878: my $links_def;
879: foreach my $item (@{$links}) {
880: if (!$is_custom->{$item}) {
1.30 raeburn 881: $links_def .= '<td>'.$choices->{$item}.'<br /><span id="css_default_'.$role.'_'.$item.'" style="color: '.$defaults->{'links'}{$item}.';">'.$defaults->{'links'}{$item}.'</span></td>';
1.6 raeburn 882: }
883: }
884: if ($links_def) {
1.8 raeburn 885: $datatable .= '<td>'.&mt('Default(s) in use:').'<br /><table border="0"><tr>'.$links_def.'</tr></table></td>';
1.6 raeburn 886: } else {
887: $datatable .= '<td> </td>';
888: }
889: $datatable .= '<td class="LC_right_item">'.
890: '<table border="0"><tr>';
891: foreach my $item (@{$links}) {
1.30 raeburn 892: $datatable .= '<td align="center">'."\n".
893: &color_pick($phase,$role,$item,$choices->{$item},
894: $designs->{'links'}{$item});
1.6 raeburn 895: if ($designs->{'links'}{$item}) {
1.30 raeburn 896: $datatable.=' <span id="css_'.$role.'_'.$item.'" style="background-color: '.$designs->{'links'}{$item}.';"> </span>';
1.6 raeburn 897: }
898: $datatable .= '<br /><input type="text" size="8" name="'.$role.'_'.$item.'" value="'.$designs->{'links'}{$item}.
899: '" /></td>';
900: }
1.30 raeburn 901: $$rowtotal += $itemcount;
1.3 raeburn 902: return $datatable;
903: }
904:
1.6 raeburn 905: sub color_pick {
906: my ($phase,$role,$item,$desc,$curcol) = @_;
907: my $link = '<a href="javascript:pjump('."'color_custom','".$desc.
908: "','".$curcol."','".$role.'_'.$item."','parmform.pres','psub'".
909: ');">'.$desc.'</a>';
910: return $link;
911: }
912:
913: sub color_pick_js {
914: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
915: my $output = <<"ENDCOL";
916: function pclose() {
917: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms","height=350,width=350,scrollbars=no,menubar=no");
918: parmwin.close();
919: }
920:
921: $pjump_def
922:
923: function psub() {
924: pclose();
925: if (document.parmform.pres_marker.value!='') {
926: if (document.parmform.pres_type.value!='') {
927: eval('document.display.'+
928: document.parmform.pres_marker.value+
929: '.value=document.parmform.pres_value.value;');
930: }
931: } else {
932: document.parmform.pres_value.value='';
933: document.parmform.pres_marker.value='';
934: }
935: }
936: ENDCOL
937: return $output;
938: }
939:
1.3 raeburn 940: sub print_quotas {
1.30 raeburn 941: my ($dom,$settings,$rowtotal) = @_;
1.3 raeburn 942: my $datatable;
1.23 raeburn 943: my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
1.3 raeburn 944: my $typecount = 0;
945: my $css_class;
1.26 raeburn 946: if (ref($types) eq 'ARRAY') {
1.23 raeburn 947: foreach my $type (@{$types}) {
1.3 raeburn 948: if (defined($usertypes->{$type})) {
949: $typecount ++;
950: $css_class = $typecount%2?' class="LC_odd_row"':'';
951: $datatable .= '<tr'.$css_class.'>'.
952: '<td>'.$usertypes->{$type}.'</td>'.
1.8 raeburn 953: '<td class="LC_right_item"><span class="LC_nobreak">'.
1.3 raeburn 954: '<input type="text" name="quota_'.$type.
955: '" value="'.$settings->{$type}.
1.8 raeburn 956: '" size="5" /> Mb</span></td></tr>';
1.3 raeburn 957: }
958: }
959: }
960: my $defaultquota = '20';
961: if (ref($settings) eq 'HASH') {
962: if (defined($settings->{'default'})) {
963: $defaultquota = $settings->{'default'};
964: }
965: }
966: $typecount ++;
967: $css_class = $typecount%2?' class="LC_odd_row"':'';
968: $datatable .= '<tr'.$css_class.'>'.
1.26 raeburn 969: '<td>'.$othertitle.'</td>'.
1.8 raeburn 970: '<td class="LC_right_item"><span class="LC_nobreak">'.
1.15 raeburn 971: '<input type="text" name="defaultquota" value="'.
1.8 raeburn 972: $defaultquota.'" size="5" /> Mb</span></td></tr>';
1.30 raeburn 973: $$rowtotal += $typecount;
1.3 raeburn 974: return $datatable;
975: }
976:
977: sub print_autoenroll {
1.30 raeburn 978: my ($dom,$settings,$rowtotal) = @_;
1.3 raeburn 979: my $autorun = &Apache::lonnet::auto_run(undef,$dom),
1.17 raeburn 980: my ($defdom,$runon,$runoff);
1.3 raeburn 981: if (ref($settings) eq 'HASH') {
982: if (exists($settings->{'run'})) {
983: if ($settings->{'run'} eq '0') {
984: $runoff = ' checked="checked" ';
985: $runon = ' ';
986: } else {
987: $runon = ' checked="checked" ';
988: $runoff = ' ';
989: }
990: } else {
991: if ($autorun) {
992: $runon = ' checked="checked" ';
993: $runoff = ' ';
994: } else {
995: $runoff = ' checked="checked" ';
996: $runon = ' ';
997: }
998: }
999: if (exists($settings->{'sender_domain'})) {
1000: $defdom = $settings->{'sender_domain'};
1001: }
1.14 raeburn 1002: } else {
1003: if ($autorun) {
1004: $runon = ' checked="checked" ';
1005: $runoff = ' ';
1006: } else {
1007: $runoff = ' checked="checked" ';
1008: $runon = ' ';
1009: }
1.3 raeburn 1010: }
1011: my $domform = &Apache::loncommon::select_dom_form($defdom,'sender_domain',1);
1012: my $datatable='<tr class="LC_odd_row">'.
1013: '<td>'.&mt('Auto-enrollment active?').'</td>'.
1.8 raeburn 1014: '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
1.3 raeburn 1015: '<input type="radio" name="autoenroll_run"'.
1.8 raeburn 1016: $runon.' value="1" />'.&mt('Yes').'</label> '.
1017: '<label><input type="radio" name="autoenroll_run"'.
1.14 raeburn 1018: $runoff.' value="0" />'.&mt('No').'</label></span></td>'.
1.3 raeburn 1019: '</tr><tr>'.
1020: '<td>'.&mt('Notification messages - sender').
1.8 raeburn 1021: '</td><td class="LC_right_item"><span class="LC_nobreak">'.
1.3 raeburn 1022: &mt('username').': '.
1023: '<input type="text" name="sender_uname" value="'.
1024: $settings->{'sender_uname'}.
1025: '" size="10" /> '.&mt('domain').
1.8 raeburn 1026: ': '.$domform.'</span></td></tr>';
1.30 raeburn 1027: $$rowtotal += 2;
1.3 raeburn 1028: return $datatable;
1029: }
1030:
1031: sub print_autoupdate {
1.30 raeburn 1032: my ($position,$dom,$settings,$rowtotal) = @_;
1.3 raeburn 1033: my $datatable;
1034: if ($position eq 'top') {
1035: my $updateon = ' ';
1036: my $updateoff = ' checked="checked" ';
1037: my $classlistson = ' ';
1038: my $classlistsoff = ' checked="checked" ';
1039: if (ref($settings) eq 'HASH') {
1040: if ($settings->{'run'} eq '1') {
1041: $updateon = $updateoff;
1042: $updateoff = ' ';
1043: }
1044: if ($settings->{'classlists'} eq '1') {
1045: $classlistson = $classlistsoff;
1046: $classlistsoff = ' ';
1047: }
1048: }
1049: my %title = (
1050: run => 'Auto-update active?',
1051: classlists => 'Update information in classlists?',
1052: );
1053: $datatable = '<tr class="LC_odd_row">'.
1054: '<td>'.&mt($title{'run'}).'</td>'.
1.8 raeburn 1055: '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
1.3 raeburn 1056: '<input type="radio" name="autoupdate_run"'.
1.8 raeburn 1057: $updateon.' value="1" />'.&mt('Yes').'</label> '.
1058: '<label><input type="radio" name="autoupdate_run"'.
1059: $updateoff.'value="0" />'.&mt('No').'</label></span></td>'.
1.3 raeburn 1060: '</tr><tr>'.
1061: '<td>'.&mt($title{'classlists'}).'</td>'.
1.8 raeburn 1062: '<td class="LC_right_item"><span class="LC_nobreak">'.
1063: '<label><input type="radio" name="classlists"'.
1064: $classlistson.' value="1" />'.&mt('Yes').'</label> '.
1065: '<label><input type="radio" name="classlists"'.
1066: $classlistsoff.'value="0" />'.&mt('No').'</label></span></td>'.
1.3 raeburn 1067: '</tr>';
1.30 raeburn 1068: $$rowtotal += 2;
1.3 raeburn 1069: } else {
1.23 raeburn 1070: my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
1.20 raeburn 1071: my @fields = ('lastname','firstname','middlename','gen',
1072: 'permanentemail','id');
1.33 ! raeburn 1073: my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
1.3 raeburn 1074: my $numrows = 0;
1.26 raeburn 1075: if (ref($types) eq 'ARRAY') {
1076: if (@{$types} > 0) {
1077: $datatable =
1078: &usertype_update_row($settings,$usertypes,\%fieldtitles,
1079: \@fields,$types,\$numrows);
1.30 raeburn 1080: $$rowtotal += @{$types};
1.26 raeburn 1081: }
1.3 raeburn 1082: }
1083: $datatable .=
1084: &usertype_update_row($settings,{'default' => $othertitle},
1085: \%fieldtitles,\@fields,['default'],
1086: \$numrows);
1.30 raeburn 1087: $$rowtotal ++;
1.3 raeburn 1088: }
1089: return $datatable;
1090: }
1091:
1.23 raeburn 1092: sub print_directorysrch {
1.30 raeburn 1093: my ($dom,$settings,$rowtotal) = @_;
1.23 raeburn 1094: my $srchon = ' ';
1095: my $srchoff = ' checked="checked" ';
1.25 raeburn 1096: my ($exacton,$containson,$beginson);
1.24 raeburn 1097: my $localon = ' ';
1098: my $localoff = ' checked="checked" ';
1.23 raeburn 1099: if (ref($settings) eq 'HASH') {
1100: if ($settings->{'available'} eq '1') {
1101: $srchon = $srchoff;
1102: $srchoff = ' ';
1103: }
1.24 raeburn 1104: if ($settings->{'localonly'} eq '1') {
1105: $localon = $localoff;
1106: $localoff = ' ';
1107: }
1.25 raeburn 1108: if (ref($settings->{'searchtypes'}) eq 'ARRAY') {
1109: foreach my $type (@{$settings->{'searchtypes'}}) {
1110: if ($type eq 'exact') {
1111: $exacton = ' checked="checked" ';
1112: } elsif ($type eq 'contains') {
1113: $containson = ' checked="checked" ';
1114: } elsif ($type eq 'begins') {
1115: $beginson = ' checked="checked" ';
1116: }
1117: }
1118: } else {
1119: if ($settings->{'searchtypes'} eq 'exact') {
1120: $exacton = ' checked="checked" ';
1121: } elsif ($settings->{'searchtypes'} eq 'contains') {
1122: $containson = ' checked="checked" ';
1123: } elsif ($settings->{'searchtypes'} eq 'specify') {
1124: $exacton = ' checked="checked" ';
1125: $containson = ' checked="checked" ';
1126: }
1.23 raeburn 1127: }
1128: }
1129: my ($searchtitles,$titleorder) = &sorted_searchtitles();
1130: my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
1131:
1132: my $numinrow = 4;
1.26 raeburn 1133: my $cansrchrow = 0;
1.23 raeburn 1134: my $datatable='<tr class="LC_odd_row">'.
1.30 raeburn 1135: '<td colspan="2"><span class ="LC_nobreak">'.&mt('Directory search available?').'</span></td>'.
1.23 raeburn 1136: '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
1137: '<input type="radio" name="dirsrch_available"'.
1138: $srchon.' value="1" />'.&mt('Yes').'</label> '.
1139: '<label><input type="radio" name="dirsrch_available"'.
1140: $srchoff.' value="0" />'.&mt('No').'</label></span></td>'.
1141: '</tr><tr>'.
1.30 raeburn 1142: '<td colspan="2"><span class ="LC_nobreak">'.&mt('Other domains can search?').'</span></td>'.
1.24 raeburn 1143: '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
1144: '<input type="radio" name="dirsrch_localonly"'.
1145: $localoff.' value="0" />'.&mt('Yes').'</label> '.
1146: '<label><input type="radio" name="dirsrch_localonly"'.
1147: $localon.' value="1" />'.&mt('No').'</label></span></td>'.
1.25 raeburn 1148: '</tr>';
1.30 raeburn 1149: $$rowtotal += 2;
1.26 raeburn 1150: if (ref($usertypes) eq 'HASH') {
1151: if (keys(%{$usertypes}) > 0) {
1152: $datatable .= &users_cansearch_row($settings,$types,$usertypes,$dom,
1153: $numinrow,$othertitle);
1154: $cansrchrow = 1;
1155: }
1156: }
1157: if ($cansrchrow) {
1.30 raeburn 1158: $$rowtotal ++;
1.26 raeburn 1159: $datatable .= '<tr>';
1160: } else {
1161: $datatable .= '<tr class="LC_odd_row">';
1162: }
1.30 raeburn 1163: $datatable .= '<td><span class ="LC_nobreak">'.&mt('Supported search methods').
1164: '</span></td><td class="LC_left_item" colspan="2"><table><tr>';
1.25 raeburn 1165: foreach my $title (@{$titleorder}) {
1166: if (defined($searchtitles->{$title})) {
1167: my $check = ' ';
1168: if (ref($settings->{'searchby'}) eq 'ARRAY') {
1169: if (grep(/^\Q$title\E$/,@{$settings->{'searchby'}})) {
1170: $check = ' checked="checked" ';
1171: }
1172: }
1173: $datatable .= '<td class="LC_left_item">'.
1174: '<span class="LC_nobreak"><label>'.
1175: '<input type="checkbox" name="searchby" '.
1176: 'value="'.$title.'"'.$check.'/>'.
1177: $searchtitles->{$title}.'</label></span></td>';
1178: }
1179: }
1.26 raeburn 1180: $datatable .= '</tr></table></td></tr>';
1.30 raeburn 1181: $$rowtotal ++;
1.26 raeburn 1182: if ($cansrchrow) {
1183: $datatable .= '<tr class="LC_odd_row">';
1184: } else {
1185: $datatable .= '<tr>';
1186: }
1.30 raeburn 1187: $datatable .= '<td><span class ="LC_nobreak">'.&mt('Search latitude').'</span></td>'.
1.26 raeburn 1188: '<td class="LC_left_item" colspan="2">'.
1.25 raeburn 1189: '<span class="LC_nobreak"><label>'.
1190: '<input type="checkbox" name="searchtypes" '.
1191: $exacton.' value="exact" />'.&mt('Exact match').
1192: '</label> '.
1193: '<label><input type="checkbox" name="searchtypes" '.
1194: $beginson.' value="begins" />'.&mt('Begins with').
1195: '</label> '.
1196: '<label><input type="checkbox" name="searchtypes" '.
1197: $containson.' value="contains" />'.&mt('Contains').
1198: '</label></span></td></tr>';
1.30 raeburn 1199: $$rowtotal ++;
1.25 raeburn 1200: return $datatable;
1201: }
1202:
1.28 raeburn 1203: sub print_contacts {
1.30 raeburn 1204: my ($dom,$settings,$rowtotal) = @_;
1.28 raeburn 1205: my $datatable;
1206: my @contacts = ('adminemail','supportemail');
1207: my (%checked,%to,%otheremails);
1208: my @mailings = ('errormail','packagesmail','helpdeskmail');
1209: foreach my $type (@mailings) {
1210: $otheremails{$type} = '';
1211: }
1212: if (ref($settings) eq 'HASH') {
1213: foreach my $item (@contacts) {
1214: if (exists($settings->{$item})) {
1215: $to{$item} = $settings->{$item};
1216: }
1217: }
1218: foreach my $type (@mailings) {
1219: if (exists($settings->{$type})) {
1220: if (ref($settings->{$type}) eq 'HASH') {
1221: foreach my $item (@contacts) {
1222: if ($settings->{$type}{$item}) {
1223: $checked{$type}{$item} = ' checked="checked" ';
1224: }
1225: }
1226: $otheremails{$type} = $settings->{$type}{'others'};
1227: }
1228: }
1229: }
1230: } else {
1231: $to{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
1232: $to{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
1233: $checked{'errormail'}{'adminemail'} = ' checked="checked" ';
1234: $checked{'packagesmail'}{'adminemail'} = ' checked="checked" ';
1235: $checked{'helpdeskmail'}{'supportemail'} = ' checked="checked" ';
1236: }
1237: my ($titles,$short_titles) = &contact_titles();
1238: my $rownum = 0;
1239: my $css_class;
1240: foreach my $item (@contacts) {
1241: if ($rownum%2) {
1242: $css_class = '';
1243: } else {
1244: $css_class = ' class="LC_odd_row" ';
1245: }
1.30 raeburn 1246: $datatable .= '<tr'.$css_class.'>'.
1247: '<td><span class="LC_nobreak">'.$titles->{$item}.
1248: '</span></td><td class="LC_right_item">'.
1.28 raeburn 1249: '<input type="text" name="'.$item.'" value="'.
1250: $to{$item}.'" /></td></tr>';
1251: $rownum ++;
1252: }
1253: foreach my $type (@mailings) {
1254: if ($rownum%2) {
1255: $css_class = '';
1256: } else {
1257: $css_class = ' class="LC_odd_row" ';
1258: }
1259: $datatable .= '<tr'.$css_class.'>'.
1.30 raeburn 1260: '<td><span class="LC_nobreak">'.
1261: $titles->{$type}.': </span></td>'.
1.28 raeburn 1262: '<td class="LC_left_item">'.
1263: '<span class="LC_nobreak">';
1264: foreach my $item (@contacts) {
1265: $datatable .= '<label>'.
1266: '<input type="checkbox" name="'.$type.'"'.
1267: $checked{$type}{$item}.
1268: ' value="'.$item.'" />'.$short_titles->{$item}.
1269: '</label> ';
1270: }
1271: $datatable .= '</span><br />'.&mt('Others').': '.
1272: '<input type="text" name="'.$type.'_others" '.
1273: 'value="'.$otheremails{$type}.'" />'.
1274: '</td></tr>'."\n";
1275: $rownum ++;
1276: }
1.30 raeburn 1277: $$rowtotal += $rownum;
1.28 raeburn 1278: return $datatable;
1279: }
1280:
1281: sub contact_titles {
1282: my %titles = &Apache::lonlocal::texthash (
1283: 'supportemail' => 'Support E-mail address',
1284: 'adminemail' => 'Default Server Admin E-mail address',
1285: 'errormail' => 'Error reports to be e-mailed to',
1286: 'packagesmail' => 'Package update alerts to be e-mailed to',
1287: 'helpdeskmail' => 'Helpdesk requests to be e-mailed to'
1288: );
1289: my %short_titles = &Apache::lonlocal::texthash (
1290: adminemail => 'Admin E-mail address',
1291: supportemail => 'Support E-mail',
1292: );
1293: return (\%titles,\%short_titles);
1294: }
1295:
1.27 raeburn 1296: sub print_usercreation {
1.30 raeburn 1297: my ($position,$dom,$settings,$rowtotal) = @_;
1.27 raeburn 1298: my $numinrow = 4;
1.28 raeburn 1299: my $datatable;
1300: my %lt = &Apache::lonlocal::texthash (
1301: nondc => 'User creation other than by Domain Coordinator: ',
1302: author => 'When adding a co-author/assistant author',
1303: course => 'When adding users to a course',
1304: );
1305: if ($position eq 'top') {
1306: my %checked;
1307: if (ref($settings) eq 'HASH') {
1308: if (ref($settings->{'cancreate'}) eq 'ARRAY') {
1309: foreach my $item (@{$settings->{'cancreate'}}) {
1310: $checked{$item} = ' checked="checked" ';
1311: }
1312: }
1313: }
1314: $datatable = '<tr class="LC_odd_row">'.
1.30 raeburn 1315: '<td><span class="LC_nobreak">'.$lt{'nondc'}.
1316: '</span></td><td class="LC_left_item"><table>';
1.28 raeburn 1317: foreach my $item ('author','course') {
1318: $datatable .= '<tr><td><span class="LC_nobreak"><label>'.
1319: '<input type="checkbox" name="can_createuser" '.
1320: $checked{$item}.' value="'.$item.'" />'.
1321: $lt{$item}.'</label><span></td></tr>';
1322: }
1323: $datatable .= '</table></td></tr>';
1.30 raeburn 1324: $$rowtotal ++;
1.32 raeburn 1325: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username');
1326: my $rowcount = 0;
1.28 raeburn 1327: if (ref($rules) eq 'HASH') {
1328: if (keys(%{$rules}) > 0) {
1.32 raeburn 1329: $datatable .= &user_formats_row('username',$settings,$rules,
1330: $ruleorder,$numinrow,$rowcount);
1.30 raeburn 1331: $$rowtotal ++;
1.32 raeburn 1332: $rowcount ++;
1333: }
1334: }
1335: my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id');
1336: if (ref($idrules) eq 'HASH') {
1337: if (keys(%{$idrules}) > 0) {
1338: $datatable .= &user_formats_row('id',$settings,$idrules,
1339: $idruleorder,$numinrow,$rowcount);
1340: $$rowtotal ++;
1341: $rowcount ++;
1.28 raeburn 1342: }
1343: }
1344: } else {
1345: my @contexts = ('author','course','domain');
1346: my @authtypes = ('int','krb4','krb5','loc');
1347: my %checked;
1348: if (ref($settings) eq 'HASH') {
1349: if (ref($settings->{'authtypes'}) eq 'HASH') {
1350: foreach my $item (@contexts) {
1351: if (ref($settings->{'authtypes'}{$item}) eq 'HASH') {
1352: foreach my $auth (@authtypes) {
1353: if ($settings->{'authtypes'}{$item}{$auth}) {
1354: $checked{$item}{$auth} = ' checked="checked" ';
1355: }
1356: }
1357: }
1358: }
1.27 raeburn 1359: }
1360: }
1.28 raeburn 1361: my @authtypes = ('int','krb4','krb5','loc');
1362: my %title = &context_names();
1363: my %authname = &authtype_names();
1364: my $rownum = 0;
1365: my $css_class;
1366: foreach my $item (@contexts) {
1367: if ($rownum%2) {
1368: $css_class = '';
1369: } else {
1370: $css_class = ' class="LC_odd_row" ';
1371: }
1.30 raeburn 1372: $datatable .= '<tr'.$css_class.'>'.
1.28 raeburn 1373: '<td>'.$title{$item}.
1374: '</td><td class="LC_left_item">'.
1375: '<span class="LC_nobreak">';
1376: foreach my $auth (@authtypes) {
1377: $datatable .= '<label>'.
1378: '<input type="checkbox" name="'.$item.'_auth" '.
1379: $checked{$item}{$auth}.' value="'.$auth.'" />'.
1380: $authname{$auth}.'</label> ';
1381: }
1382: $datatable .= '</span></td></tr>';
1383: $rownum ++;
1.27 raeburn 1384: }
1.30 raeburn 1385: $$rowtotal += $rownum;
1.27 raeburn 1386: }
1387: return $datatable;
1388: }
1389:
1.32 raeburn 1390: sub user_formats_row {
1391: my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_;
1392: my $output;
1393: my %text = (
1394: 'username' => 'new usernames',
1395: 'id' => 'IDs',
1396: );
1397: my $css_class = $rowcount%2?' class="LC_odd_row"':'';
1398: $output = '<tr '.$css_class.'>'.
1399: '<td><span class="LC_nobreak">'.
1400: &mt("Format rules to check for $text{$type}: ").
1401: '</span></td>'.
1402: '<td class="LC_left_item" colspan="2"><table>';
1.27 raeburn 1403: my $rem;
1404: if (ref($ruleorder) eq 'ARRAY') {
1405: for (my $i=0; $i<@{$ruleorder}; $i++) {
1406: if (ref($rules->{$ruleorder->[$i]}) eq 'HASH') {
1407: my $rem = $i%($numinrow);
1408: if ($rem == 0) {
1409: if ($i > 0) {
1410: $output .= '</tr>';
1411: }
1412: $output .= '<tr>';
1413: }
1414: my $check = ' ';
1.32 raeburn 1415: if (ref($settings->{$type.'_rule'}) eq 'ARRAY') {
1416: if (grep(/^\Q$ruleorder->[$i]\E$/,@{$settings->{$type.'_rule'}})) {
1.27 raeburn 1417: $check = ' checked="checked" ';
1418: }
1419: }
1420: $output .= '<td class="LC_left_item">'.
1421: '<span class="LC_nobreak"><label>'.
1.32 raeburn 1422: '<input type="checkbox" name="'.$type.'_rule" '.
1.27 raeburn 1423: 'value="'.$ruleorder->[$i].'"'.$check.'/>'.
1424: $rules->{$ruleorder->[$i]}{'name'}.'</label></span></td>';
1425: }
1426: }
1427: $rem = @{$ruleorder}%($numinrow);
1428: }
1429: my $colsleft = $numinrow - $rem;
1430: if ($colsleft > 1 ) {
1431: $output .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
1432: ' </td>';
1433: } elsif ($colsleft == 1) {
1434: $output .= '<td class="LC_left_item"> </td>';
1435: }
1436: $output .= '</tr></table></td></tr>';
1437: return $output;
1438: }
1439:
1.28 raeburn 1440: sub authtype_names {
1441: my %lt = &Apache::lonlocal::texthash(
1442: int => 'Internal',
1443: krb4 => 'Kerberos 4',
1444: krb5 => 'Kerberos 5',
1445: loc => 'Local',
1446: );
1447: return %lt;
1448: }
1449:
1450: sub context_names {
1451: my %context_title = &Apache::lonlocal::texthash(
1452: author => 'Creating users when an Author',
1453: course => 'Creating users when in a course',
1454: domain => 'Creating users when a Domain Coordinator',
1455: );
1456: return %context_title;
1457: }
1458:
1.33 ! raeburn 1459: sub print_usermodification {
! 1460: my ($position,$dom,$settings,$rowtotal) = @_;
! 1461: my $numinrow = 4;
! 1462: my ($context,$datatable,$rowcount);
! 1463: if ($position eq 'top') {
! 1464: $rowcount = 0;
! 1465: $context = 'author';
! 1466: foreach my $role ('ca','aa') {
! 1467: $datatable .= &modifiable_userdata_row($context,$role,$settings,
! 1468: $numinrow,$rowcount);
! 1469: $$rowtotal ++;
! 1470: $rowcount ++;
! 1471: }
! 1472: } else {
! 1473: $context = 'course';
! 1474: $rowcount = 0;
! 1475: foreach my $role ('st','ep','ta','in','cr') {
! 1476: $datatable .= &modifiable_userdata_row($context,$role,$settings,
! 1477: $numinrow,$rowcount);
! 1478: $$rowtotal ++;
! 1479: $rowcount ++;
! 1480: }
! 1481: }
! 1482: return $datatable;
! 1483: }
! 1484:
! 1485: sub modifiable_userdata_row {
! 1486: my ($context,$role,$settings,$numinrow,$rowcount) = @_;
! 1487: my $rolename;
! 1488: if ($role eq 'cr') {
! 1489: $rolename = &mt('Custom role');
! 1490: } else {
! 1491: $rolename = &Apache::lonnet::plaintext($role);
! 1492: }
! 1493: my @fields = ('lastname','firstname','middlename','generation',
! 1494: 'permanentemail','id');
! 1495: my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
! 1496: my $output;
! 1497: my $css_class = $rowcount%2?' class="LC_odd_row"':'';
! 1498: $output = '<tr '.$css_class.'>'.
! 1499: '<td><span class="LC_nobreak">'.$rolename.'</span></td>'.
! 1500: '<td class="LC_left_item" colspan="2"><table>';
! 1501: my $rem;
! 1502: my %checks;
! 1503: if (ref($settings) eq 'HASH') {
! 1504: if (ref($settings->{$context}) eq 'HASH') {
! 1505: if (ref($settings->{$context}->{$role}) eq 'HASH') {
! 1506: foreach my $field (@fields) {
! 1507: if ($settings->{$context}->{$role}->{$field}) {
! 1508: $checks{$field} = ' checked="checked" ';
! 1509: }
! 1510: }
! 1511: }
! 1512: }
! 1513: }
! 1514: for (my $i=0; $i<@fields; $i++) {
! 1515: my $rem = $i%($numinrow);
! 1516: if ($rem == 0) {
! 1517: if ($i > 0) {
! 1518: $output .= '</tr>';
! 1519: }
! 1520: $output .= '<tr>';
! 1521: }
! 1522: my $check = ' ';
! 1523: if (exists($checks{$fields[$i]})) {
! 1524: $check = $checks{$fields[$i]}
! 1525: } else {
! 1526: if ($role eq 'st') {
! 1527: if (ref($settings) ne 'HASH') {
! 1528: $check = ' checked="checked" ';
! 1529: }
! 1530: }
! 1531: }
! 1532: $output .= '<td class="LC_left_item">'.
! 1533: '<span class="LC_nobreak"><label>'.
! 1534: '<input type="checkbox" name="canmodify_'.$role.'" '.
! 1535: 'value="'.$fields[$i].'"'.$check.'/>'.$fieldtitles{$fields[$i]}.
! 1536: '</label></span></td>';
! 1537: $rem = @fields%($numinrow);
! 1538: }
! 1539: my $colsleft = $numinrow - $rem;
! 1540: if ($colsleft > 1 ) {
! 1541: $output .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
! 1542: ' </td>';
! 1543: } elsif ($colsleft == 1) {
! 1544: $output .= '<td class="LC_left_item"> </td>';
! 1545: }
! 1546: $output .= '</tr></table></td></tr>';
! 1547: return $output;
! 1548: }
1.28 raeburn 1549:
1.25 raeburn 1550: sub users_cansearch_row {
1551: my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_;
1552: my $output = '<tr class="LC_odd_row">'.
1.24 raeburn 1553: '<td>'.&mt('Users allowed to search').' ('.$dom.')'.
1554: '</td><td class="LC_left_item" colspan="2"><table>';
1.26 raeburn 1555: my $rem;
1556: if (ref($types) eq 'ARRAY') {
1557: for (my $i=0; $i<@{$types}; $i++) {
1558: if (defined($usertypes->{$types->[$i]})) {
1559: my $rem = $i%($numinrow);
1560: if ($rem == 0) {
1561: if ($i > 0) {
1562: $output .= '</tr>';
1563: }
1564: $output .= '<tr>';
1.23 raeburn 1565: }
1.26 raeburn 1566: my $check = ' ';
1567: if (ref($settings->{'cansearch'}) eq 'ARRAY') {
1568: if (grep(/^\Q$types->[$i]\E$/,@{$settings->{'cansearch'}})) {
1569: $check = ' checked="checked" ';
1570: }
1.23 raeburn 1571: }
1.26 raeburn 1572: $output .= '<td class="LC_left_item">'.
1573: '<span class="LC_nobreak"><label>'.
1574: '<input type="checkbox" name="cansearch" '.
1575: 'value="'.$types->[$i].'"'.$check.'/>'.
1576: $usertypes->{$types->[$i]}.'</label></span></td>';
1.23 raeburn 1577: }
1578: }
1.26 raeburn 1579:
1580: $rem = @{$types}%($numinrow);
1.23 raeburn 1581: }
1582: my $colsleft = $numinrow - $rem;
1583: if ($colsleft > 1) {
1.25 raeburn 1584: $output .= '<td colspan="'.$colsleft.'" class="LC_left_item">';
1.23 raeburn 1585: } else {
1.25 raeburn 1586: $output .= '<td class="LC_left_item">';
1.23 raeburn 1587: }
1588: my $defcheck = ' ';
1589: if (ref($settings->{'cansearch'}) eq 'ARRAY') {
1.26 raeburn 1590: if (grep(/^default$/,@{$settings->{'cansearch'}})) {
1591: $defcheck = ' checked="checked" ';
1592: }
1.23 raeburn 1593: }
1.25 raeburn 1594: $output .= '<span class="LC_nobreak"><label>'.
1595: '<input type="checkbox" name="cansearch" '.
1596: 'value="default"'.$defcheck.'/>'.
1597: $othertitle.'</label></span></td>'.
1598: '</tr></table></td></tr>';
1599: return $output;
1.23 raeburn 1600: }
1601:
1602: sub sorted_inst_types {
1603: my ($dom) = @_;
1604: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
1.26 raeburn 1605: my $othertitle = &mt('All users');
1.23 raeburn 1606: my @types;
1607: if (ref($order) eq 'ARRAY') {
1608: @types = @{$order};
1609: }
1610: if (@types == 0) {
1611: if (ref($usertypes) eq 'HASH') {
1612: @types = sort(keys(%{$usertypes}));
1613: }
1614: }
1615: if (keys(%{$usertypes}) > 0) {
1616: $othertitle = &mt('Other users');
1617: }
1618: return ($othertitle,$usertypes,\@types);
1619: }
1620:
1621: sub sorted_searchtitles {
1622: my %searchtitles = &Apache::lonlocal::texthash(
1623: 'uname' => 'username',
1624: 'lastname' => 'last name',
1625: 'lastfirst' => 'last name, first name',
1626: );
1627: my @titleorder = ('uname','lastname','lastfirst');
1628: return (\%searchtitles,\@titleorder);
1629: }
1630:
1.25 raeburn 1631: sub sorted_searchtypes {
1632: my %srchtypes_desc = (
1633: exact => 'is exact match',
1634: contains => 'contains ..',
1635: begins => 'begins with ..',
1636: );
1637: my @srchtypeorder = ('exact','begins','contains');
1638: return (\%srchtypes_desc,\@srchtypeorder);
1639: }
1640:
1.3 raeburn 1641: sub usertype_update_row {
1642: my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_;
1643: my $datatable;
1644: my $numinrow = 4;
1645: foreach my $type (@{$types}) {
1646: if (defined($usertypes->{$type})) {
1647: $$rownums ++;
1648: my $css_class = $$rownums%2?' class="LC_odd_row"':'';
1649: $datatable .= '<tr'.$css_class.'><td>'.$usertypes->{$type}.
1650: '</td><td class="LC_left_item"><table>';
1651: for (my $i=0; $i<@{$fields}; $i++) {
1652: my $rem = $i%($numinrow);
1653: if ($rem == 0) {
1654: if ($i > 0) {
1655: $datatable .= '</tr>';
1656: }
1657: $datatable .= '<tr>';
1658: }
1659: my $check = ' ';
1660: if (ref($settings->{'fields'}) eq 'HASH') {
1661: if (ref($settings->{'fields'}{$type}) eq 'ARRAY') {
1662: if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) {
1663: $check = ' checked="checked" ';
1664: }
1665: }
1666: }
1667:
1668: if ($i == @{$fields}-1) {
1669: my $colsleft = $numinrow - $rem;
1670: if ($colsleft > 1) {
1671: $datatable .= '<td colspan="'.$colsleft.'">';
1672: } else {
1673: $datatable .= '<td>';
1674: }
1675: } else {
1676: $datatable .= '<td>';
1677: }
1.8 raeburn 1678: $datatable .= '<span class="LC_nobreak"><label>'.
1679: '<input type="checkbox" name="updateable_'.$type.
1680: '_'.$fields->[$i].'" value="1"'.$check.'/>'.
1681: $fieldtitles->{$fields->[$i]}.'</label></span></td>';
1.3 raeburn 1682: }
1683: $datatable .= '</tr></table></td></tr>';
1684: }
1685: }
1686: return $datatable;
1.1 raeburn 1687: }
1688:
1689: sub modify_login {
1.9 raeburn 1690: my ($r,$dom,$confname,%domconfig) = @_;
1.6 raeburn 1691: my ($resulttext,$errors,$colchgtext,%changes,%colchanges);
1.1 raeburn 1692: my %title = ( coursecatalog => 'Display course catalog',
1693: adminmail => 'Display administrator E-mail address');
1.3 raeburn 1694: my @offon = ('off','on');
1.6 raeburn 1695: my %loginhash;
1.9 raeburn 1696: ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
1697: \%domconfig,\%loginhash);
1.6 raeburn 1698: $loginhash{login}{coursecatalog} = $env{'form.coursecatalog'};
1699: $loginhash{login}{adminmail} = $env{'form.adminmail'};
1700: if (ref($colchanges{'login'}) eq 'HASH') {
1701: $colchgtext = &display_colorchgs($dom,\%colchanges,['login'],
1702: \%loginhash);
1703: }
1.1 raeburn 1704: my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash,
1705: $dom);
1706: if ($putresult eq 'ok') {
1.3 raeburn 1707: if (($domconfig{'login'}{'coursecatalog'} eq '0') &&
1.1 raeburn 1708: ($env{'form.coursecatalog'} eq '1')) {
1709: $changes{'coursecatalog'} = 1;
1.3 raeburn 1710: } elsif (($domconfig{'login'}{'coursecatalog'} eq '' ||
1711: $domconfig{'login'}{'coursecatalog'} eq '1') &&
1.1 raeburn 1712: ($env{'form.coursecatalog'} eq '0')) {
1713: $changes{'coursecatalog'} = 1;
1714: }
1.3 raeburn 1715: if (($domconfig{'login'}{'adminmail'} eq '1') &&
1.1 raeburn 1716: ($env{'form.adminmail'} eq '0')) {
1717: $changes{'adminmail'} = 1;
1718: } elsif (($domconfig{'login'}{'adminmail'} eq '' ||
1719: $domconfig{'login'}{'adminmail'} eq '0') &&
1720: ($env{'form.adminmail'} eq '1')) {
1721: $changes{'adminmail'} = 1;
1722: }
1.6 raeburn 1723: if (keys(%changes) > 0 || $colchgtext) {
1.1 raeburn 1724: $resulttext = &mt('Changes made:').'<ul>';
1725: foreach my $item (sort(keys(%changes))) {
1726: $resulttext .= '<li>'.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'</li>';
1727: }
1.6 raeburn 1728: $resulttext .= $colchgtext.'</ul>';
1.1 raeburn 1729: } else {
1730: $resulttext = &mt('No changes made to log-in page settings');
1731: }
1732: } else {
1.11 albertel 1733: $resulttext = '<span class="LC_error">'.
1734: &mt('An error occurred: [_1]',$putresult).'</span>';
1.1 raeburn 1735: }
1.6 raeburn 1736: if ($errors) {
1.9 raeburn 1737: $resulttext .= '<br />'.&mt('The following errors occurred: ').'<ul>'.
1.6 raeburn 1738: $errors.'</ul>';
1739: }
1740: return $resulttext;
1741: }
1742:
1743: sub color_font_choices {
1744: my %choices =
1745: &Apache::lonlocal::texthash (
1746: img => "Header",
1747: bgs => "Background colors",
1748: links => "Link colors",
1749: font => "Font color",
1750: pgbg => "Page",
1751: tabbg => "Header",
1752: sidebg => "Border",
1753: link => "Link",
1754: alink => "Active link",
1755: vlink => "Visited link",
1756: );
1757: return %choices;
1758: }
1759:
1760: sub modify_rolecolors {
1.9 raeburn 1761: my ($r,$dom,$confname,$roles,%domconfig) = @_;
1.6 raeburn 1762: my ($resulttext,%rolehash);
1763: $rolehash{'rolecolors'} = {};
1.9 raeburn 1764: my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles,
1.6 raeburn 1765: $domconfig{'rolecolors'},$rolehash{'rolecolors'});
1766: my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash,
1767: $dom);
1768: if ($putresult eq 'ok') {
1769: if (keys(%changes) > 0) {
1770: $resulttext = &display_colorchgs($dom,\%changes,$roles,
1771: $rolehash{'rolecolors'});
1772: } else {
1773: $resulttext = &mt('No changes made to default color schemes');
1774: }
1775: } else {
1.11 albertel 1776: $resulttext = '<span class="LC_error">'.
1777: &mt('An error occurred: [_1]',$putresult).'</span>';
1.6 raeburn 1778: }
1779: if ($errors) {
1780: $resulttext .= &mt('The following errors occurred: ').'<ul>'.
1781: $errors.'</ul>';
1782: }
1783: return $resulttext;
1784: }
1785:
1786: sub modify_colors {
1.9 raeburn 1787: my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;
1.12 raeburn 1788: my (%changes,%choices);
1.6 raeburn 1789: my @bgs = ('pgbg','mainbg','sidebg');
1790: my @links = ('link','alink','vlink');
1791: my @images;
1792: my $servadm = $r->dir_config('lonAdmEMail');
1793: my $errors;
1794: foreach my $role (@{$roles}) {
1795: if ($role eq 'login') {
1.12 raeburn 1796: %choices = &login_choices();
1797: } else {
1798: %choices = &color_font_choices();
1799: }
1800: if ($role eq 'login') {
1.6 raeburn 1801: @images = ('img','logo','domlogo');
1802: } else {
1803: @images = ('img');
1804: }
1805: $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};
1806: foreach my $item (@bgs,@links) {
1807: $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
1808: }
1.9 raeburn 1809: my ($configuserok,$author_ok,$switchserver,%currroles);
1810: my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);
1811: ($configuserok,%currroles) = &check_configuser($uhome,$dom,
1812: $confname,$servadm);
1813: if ($configuserok eq 'ok') {
1814: $switchserver = &check_switchserver($dom,$confname);
1815: if ($switchserver eq '') {
1816: $author_ok = &check_authorstatus($dom,$confname,%currroles);
1817: }
1818: }
1819: my ($width,$height) = &thumb_dimensions();
1.8 raeburn 1820: foreach my $img (@images) {
1.18 albertel 1821: if ( ! $env{'form.'.$role.'_'.$img.'.filename'}
1822: && !defined($domconfig->{$role}{$img})
1823: && !$env{'form.'.$role.'_del_'.$img}
1824: && $env{'form.'.$role.'_import_'.$img}) {
1825: # import the old configured image from the .tab setting
1826: # if they haven't provided a new one
1827: $domconfig->{$role}{$img} =
1828: $env{'form.'.$role.'_import_'.$img};
1829: }
1.6 raeburn 1830: if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') {
1.9 raeburn 1831: my $error;
1.6 raeburn 1832: if ($configuserok eq 'ok') {
1.9 raeburn 1833: if ($switchserver) {
1.12 raeburn 1834: $error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver);
1.9 raeburn 1835: } else {
1836: if ($author_ok eq 'ok') {
1837: my ($result,$logourl) =
1838: &publishlogo($r,'upload',$role.'_'.$img,
1839: $dom,$confname,$img,$width,$height);
1840: if ($result eq 'ok') {
1841: $confhash->{$role}{$img} = $logourl;
1.12 raeburn 1842: $changes{$role}{'images'}{$img} = 1;
1.9 raeburn 1843: } else {
1.12 raeburn 1844: $error = &mt("Upload of [_1] image for $role page(s) failed because an error occurred publishing the file in RES space. Error was: [_2].",$choices{img},$result);
1.9 raeburn 1845: }
1846: } else {
1.12 raeburn 1847: $error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuation user ([_2]) in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$author_ok);
1.6 raeburn 1848: }
1849: }
1850: } else {
1.12 raeburn 1851: $error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuation user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$configuserok);
1.9 raeburn 1852: }
1853: if ($error) {
1.8 raeburn 1854: &Apache::lonnet::logthis($error);
1.11 albertel 1855: $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
1.8 raeburn 1856: }
1857: } elsif ($domconfig->{$role}{$img} ne '') {
1.9 raeburn 1858: if ($domconfig->{$role}{$img} !~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
1859: my $error;
1860: if ($configuserok eq 'ok') {
1861: # is confname an author?
1862: if ($switchserver eq '') {
1863: if ($author_ok eq 'ok') {
1864: my ($result,$logourl) =
1865: &publishlogo($r,'copy',$domconfig->{$role}{$img},
1866: $dom,$confname,$img,$width,$height);
1867: if ($result eq 'ok') {
1868: $confhash->{$role}{$img} = $logourl;
1.18 albertel 1869: $changes{$role}{'images'}{$img} = 1;
1.9 raeburn 1870: }
1871: }
1872: }
1873: }
1.6 raeburn 1874: }
1875: }
1876: }
1877: if (ref($domconfig) eq 'HASH') {
1878: if (ref($domconfig->{$role}) eq 'HASH') {
1879: foreach my $img (@images) {
1880: if ($domconfig->{$role}{$img} ne '') {
1881: if ($env{'form.'.$role.'_del_'.$img}) {
1882: $confhash->{$role}{$img} = '';
1.12 raeburn 1883: $changes{$role}{'images'}{$img} = 1;
1.6 raeburn 1884: } else {
1.9 raeburn 1885: if ($confhash->{$role}{$img} eq '') {
1886: $confhash->{$role}{$img} = $domconfig->{$role}{$img};
1887: }
1.6 raeburn 1888: }
1889: } else {
1890: if ($env{'form.'.$role.'_del_'.$img}) {
1891: $confhash->{$role}{$img} = '';
1.12 raeburn 1892: $changes{$role}{'images'}{$img} = 1;
1.6 raeburn 1893: }
1894: }
1895: }
1896: if ($domconfig->{$role}{'font'} ne '') {
1897: if ($confhash->{$role}{'font'} ne $domconfig->{$role}{'font'}) {
1898: $changes{$role}{'font'} = 1;
1899: }
1900: } else {
1901: if ($confhash->{$role}{'font'}) {
1902: $changes{$role}{'font'} = 1;
1903: }
1904: }
1905: foreach my $item (@bgs) {
1906: if ($domconfig->{$role}{$item} ne '') {
1907: if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
1908: $changes{$role}{'bgs'}{$item} = 1;
1909: }
1910: } else {
1911: if ($confhash->{$role}{$item}) {
1912: $changes{$role}{'bgs'}{$item} = 1;
1913: }
1914: }
1915: }
1916: foreach my $item (@links) {
1917: if ($domconfig->{$role}{$item} ne '') {
1918: if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
1919: $changes{$role}{'links'}{$item} = 1;
1920: }
1921: } else {
1922: if ($confhash->{$role}{$item}) {
1923: $changes{$role}{'links'}{$item} = 1;
1924: }
1925: }
1926: }
1927: } else {
1928: &default_change_checker($role,\@images,\@links,\@bgs,
1929: $confhash,\%changes);
1930: }
1931: } else {
1932: &default_change_checker($role,\@images,\@links,\@bgs,
1933: $confhash,\%changes);
1934: }
1935: }
1936: return ($errors,%changes);
1937: }
1938:
1939: sub default_change_checker {
1940: my ($role,$images,$links,$bgs,$confhash,$changes) = @_;
1941: foreach my $item (@{$links}) {
1942: if ($confhash->{$role}{$item}) {
1943: $changes->{$role}{'links'}{$item} = 1;
1944: }
1945: }
1946: foreach my $item (@{$bgs}) {
1947: if ($confhash->{$role}{$item}) {
1948: $changes->{$role}{'bgs'}{$item} = 1;
1949: }
1950: }
1951: foreach my $img (@{$images}) {
1952: if ($env{'form.'.$role.'_del_'.$img}) {
1953: $confhash->{$role}{$img} = '';
1.12 raeburn 1954: $changes->{$role}{'images'}{$img} = 1;
1.6 raeburn 1955: }
1956: }
1957: if ($confhash->{$role}{'font'}) {
1958: $changes->{$role}{'font'} = 1;
1959: }
1960: }
1961:
1962: sub display_colorchgs {
1963: my ($dom,$changes,$roles,$confhash) = @_;
1964: my (%choices,$resulttext);
1.7 albertel 1965: &Apache::loncommon::devalidate_domconfig_cache($dom);
1.6 raeburn 1966: if (!grep(/^login$/,@{$roles})) {
1967: $resulttext = &mt('Changes made:').'<br />';
1968: }
1969: foreach my $role (@{$roles}) {
1970: if ($role eq 'login') {
1971: %choices = &login_choices();
1972: } else {
1973: %choices = &color_font_choices();
1974: }
1975: if (ref($changes->{$role}) eq 'HASH') {
1976: if ($role ne 'login') {
1977: $resulttext .= '<h4>'.&mt($role).'</h4>';
1978: }
1979: foreach my $key (sort(keys(%{$changes->{$role}}))) {
1980: if ($role ne 'login') {
1981: $resulttext .= '<ul>';
1982: }
1983: if (ref($changes->{$role}{$key}) eq 'HASH') {
1984: if ($role ne 'login') {
1985: $resulttext .= '<li>'.&mt($choices{$key}).':<ul>';
1986: }
1987: foreach my $item (sort(keys(%{$changes->{$role}{$key}}))) {
1988: if ($confhash->{$role}{$item} eq '') {
1989: $resulttext .= '<li>'.&mt("$choices{$item} set to default").'</li>';
1990: } else {
1.12 raeburn 1991: my $newitem = $confhash->{$role}{$item};
1992: if ($key eq 'images') {
1993: $newitem = '<img src="'.$confhash->{$role}{$item}.'" alt="'.$choices{$item}.'" valign="bottom" />';
1994: }
1995: $resulttext .= '<li>'.&mt("$choices{$item} set to [_1]",$newitem).'</li>';
1.6 raeburn 1996: }
1997: }
1998: if ($role ne 'login') {
1999: $resulttext .= '</ul></li>';
2000: }
2001: } else {
2002: if ($confhash->{$role}{$key} eq '') {
2003: $resulttext .= '<li>'.&mt("$choices{$key} set to default").'</li>';
2004: } else {
2005: $resulttext .= '<li>'.&mt("$choices{$key} set to [_1]",$confhash->{$role}{$key}).'</li>';
2006: }
2007: }
2008: if ($role ne 'login') {
2009: $resulttext .= '</ul>';
2010: }
2011: }
2012: }
2013: }
1.3 raeburn 2014: return $resulttext;
1.1 raeburn 2015: }
2016:
1.9 raeburn 2017: sub thumb_dimensions {
2018: return ('200','50');
2019: }
2020:
1.16 raeburn 2021: sub check_dimensions {
2022: my ($inputfile) = @_;
2023: my ($fullwidth,$fullheight);
2024: if ($inputfile =~ m|^[/\w.\-]+$|) {
2025: if (open(PIPE,"identify $inputfile 2>&1 |")) {
2026: my $imageinfo = <PIPE>;
2027: if (!close(PIPE)) {
2028: &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");
2029: }
2030: chomp($imageinfo);
2031: my ($fullsize) =
1.21 raeburn 2032: ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);
1.16 raeburn 2033: if ($fullsize) {
2034: ($fullwidth,$fullheight) = split(/x/,$fullsize);
2035: }
2036: }
2037: }
2038: return ($fullwidth,$fullheight);
2039: }
2040:
1.9 raeburn 2041: sub check_configuser {
2042: my ($uhome,$dom,$confname,$servadm) = @_;
2043: my ($configuserok,%currroles);
2044: if ($uhome eq 'no_host') {
2045: srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
2046: my $configpass = &LONCAPA::Enrollment::create_password();
2047: $configuserok =
2048: &Apache::lonnet::modifyuser($dom,$confname,'','internal',
2049: $configpass,'','','','','',undef,$servadm);
2050: } else {
2051: $configuserok = 'ok';
2052: %currroles =
2053: &Apache::lonnet::get_my_roles($confname,$dom,'userroles');
2054: }
2055: return ($configuserok,%currroles);
2056: }
2057:
2058: sub check_authorstatus {
2059: my ($dom,$confname,%currroles) = @_;
2060: my $author_ok;
2061: if (!$currroles{':'.$dom.':au'}) {
2062: my $start = time;
2063: my $end = 0;
2064: $author_ok =
2065: &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/',
2066: 'au',$end,$start);
2067: } else {
2068: $author_ok = 'ok';
2069: }
2070: return $author_ok;
2071: }
2072:
2073: sub publishlogo {
2074: my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight) = @_;
2075: my ($output,$fname,$logourl);
2076: if ($action eq 'upload') {
2077: $fname=$env{'form.'.$formname.'.filename'};
2078: chop($env{'form.'.$formname});
2079: } else {
2080: ($fname) = ($formname =~ /([^\/]+)$/);
2081: }
2082: $fname=&Apache::lonnet::clean_filename($fname);
2083: # See if there is anything left
2084: unless ($fname) { return ('error: no uploaded file'); }
2085: $fname="$subdir/$fname";
2086: my $filepath='/home/'.$confname.'/public_html';
2087: my ($fnamepath,$file,$fetchthumb);
2088: $file=$fname;
2089: if ($fname=~m|/|) {
2090: ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|);
2091: }
2092: my @parts=split(/\//,$filepath.'/'.$fnamepath);
2093: my $count;
2094: for ($count=4;$count<=$#parts;$count++) {
2095: $filepath.="/$parts[$count]";
2096: if ((-e $filepath)!=1) {
2097: mkdir($filepath,02770);
2098: }
2099: }
2100: # Check for bad extension and disallow upload
2101: if ($file=~/\.(\w+)$/ &&
2102: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
2103: $output =
2104: &mt('Invalid file extension ([_1]) - reserved for LONCAPA use.',$1);
2105: } elsif ($file=~/\.(\w+)$/ &&
2106: !defined(&Apache::loncommon::fileembstyle($1))) {
2107: $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
2108: } elsif ($file=~/\.(\d+)\.(\w+)$/) {
2109: $output = &mt('File name not allowed a rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
2110: } elsif (-d "$filepath/$file") {
2111: $output = &mt('File name is a directory name - rename the file and re-upload');
2112: } else {
2113: my $source = $filepath.'/'.$file;
2114: my $logfile;
2115: if (!open($logfile,">>$source".'.log')) {
2116: return (&mt('No write permission to Construction Space'));
2117: }
2118: print $logfile
2119: "\n================= Publish ".localtime()." ================\n".
2120: $env{'user.name'}.':'.$env{'user.domain'}."\n";
2121: # Save the file
2122: if (!open(FH,'>'.$source)) {
2123: &Apache::lonnet::logthis('Failed to create '.$source);
2124: return (&mt('Failed to create file'));
2125: }
2126: if ($action eq 'upload') {
2127: if (!print FH ($env{'form.'.$formname})) {
2128: &Apache::lonnet::logthis('Failed to write to '.$source);
2129: return (&mt('Failed to write file'));
2130: }
2131: } else {
2132: my $original = &Apache::lonnet::filelocation('',$formname);
2133: if(!copy($original,$source)) {
2134: &Apache::lonnet::logthis('Failed to copy '.$original.' to '.$source);
2135: return (&mt('Failed to write file'));
2136: }
2137: }
2138: close(FH);
2139: chmod(0660, $source); # Permissions to rw-rw---.
2140:
2141: my $docroot=$r->dir_config('lonDocRoot');
2142: my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath;
2143: my $copyfile=$targetdir.'/'.$file;
2144:
2145: my @parts=split(/\//,$targetdir);
2146: my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
2147: for (my $count=5;$count<=$#parts;$count++) {
2148: $path.="/$parts[$count]";
2149: if (!-e $path) {
2150: print $logfile "\nCreating directory ".$path;
2151: mkdir($path,02770);
2152: }
2153: }
2154: my $versionresult;
2155: if (-e $copyfile) {
2156: $versionresult = &logo_versioning($targetdir,$file,$logfile);
2157: } else {
2158: $versionresult = 'ok';
2159: }
2160: if ($versionresult eq 'ok') {
2161: if (copy($source,$copyfile)) {
2162: print $logfile "\nCopied original source to ".$copyfile."\n";
2163: $output = 'ok';
2164: &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile);
2165: $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname;
2166: } else {
2167: print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
2168: $output = &mt('Failed to copy file to RES space').", $!";
2169: }
2170: if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
2171: my $inputfile = $filepath.'/'.$file;
2172: my $outfile = $filepath.'/'.'tn-'.$file;
1.16 raeburn 2173: my ($fullwidth,$fullheight) = &check_dimensions($inputfile);
2174: if ($fullwidth ne '' && $fullheight ne '') {
2175: if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
2176: my $thumbsize = $thumbwidth.'x'.$thumbheight;
2177: system("convert -sample $thumbsize $inputfile $outfile");
2178: chmod(0660, $filepath.'/tn-'.$file);
2179: if (-e $outfile) {
2180: my $copyfile=$targetdir.'/tn-'.$file;
2181: if (copy($outfile,$copyfile)) {
2182: print $logfile "\nCopied source to ".$copyfile."\n";
2183: &write_metadata($dom,$confname,$formname,
2184: $targetdir,'tn-'.$file,$logfile);
2185: } else {
2186: print $logfile "\nUnable to write ".$copyfile.
2187: ':'.$!."\n";
2188: }
2189: }
1.9 raeburn 2190: }
2191: }
2192: }
2193: } else {
2194: $output = $versionresult;
2195: }
2196: }
2197: return ($output,$logourl);
2198: }
2199:
2200: sub logo_versioning {
2201: my ($targetdir,$file,$logfile) = @_;
2202: my $target = $targetdir.'/'.$file;
2203: my ($maxversion,$fn,$extn,$output);
2204: $maxversion = 0;
2205: if ($file =~ /^(.+)\.(\w+)$/) {
2206: $fn=$1;
2207: $extn=$2;
2208: }
2209: opendir(DIR,$targetdir);
2210: while (my $filename=readdir(DIR)) {
2211: if ($filename=~/\Q$fn\E\.(\d+)\.\Q$extn\E$/) {
2212: $maxversion=($1>$maxversion)?$1:$maxversion;
2213: }
2214: }
2215: $maxversion++;
2216: print $logfile "\nCreating old version ".$maxversion."\n";
2217: my $copyfile=$targetdir.'/'.$fn.'.'.$maxversion.'.'.$extn;
2218: if (copy($target,$copyfile)) {
2219: print $logfile "Copied old target to ".$copyfile."\n";
2220: $copyfile=$copyfile.'.meta';
2221: if (copy($target.'.meta',$copyfile)) {
2222: print $logfile "Copied old target metadata to ".$copyfile."\n";
2223: $output = 'ok';
2224: } else {
2225: print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
2226: $output = &mt('Failed to copy old meta').", $!, ";
2227: }
2228: } else {
2229: print $logfile "Unable to write ".$copyfile.':'.$!."\n";
2230: $output = &mt('Failed to copy old target').", $!, ";
2231: }
2232: return $output;
2233: }
2234:
2235: sub write_metadata {
2236: my ($dom,$confname,$formname,$targetdir,$file,$logfile) = @_;
2237: my (%metadatafields,%metadatakeys,$output);
2238: $metadatafields{'title'}=$formname;
2239: $metadatafields{'creationdate'}=time;
2240: $metadatafields{'lastrevisiondate'}=time;
2241: $metadatafields{'copyright'}='public';
2242: $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
2243: $env{'user.domain'};
2244: $metadatafields{'authorspace'}=$confname.':'.$dom;
2245: $metadatafields{'domain'}=$dom;
2246: {
2247: print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file;
2248: my $mfh;
2249: unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) {
2250: $output = &mt('Could not write metadata');
2251: }
2252: foreach (sort keys %metadatafields) {
2253: unless ($_=~/\./) {
2254: my $unikey=$_;
2255: $unikey=~/^([A-Za-z]+)/;
2256: my $tag=$1;
2257: $tag=~tr/A-Z/a-z/;
2258: print $mfh "\n\<$tag";
2259: foreach (split(/\,/,$metadatakeys{$unikey})) {
2260: my $value=$metadatafields{$unikey.'.'.$_};
2261: $value=~s/\"/\'\'/g;
2262: print $mfh ' '.$_.'="'.$value.'"';
2263: }
2264: print $mfh '>'.
2265: &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
2266: .'</'.$tag.'>';
2267: }
2268: }
2269: $output = 'ok';
2270: print $logfile "\nWrote metadata";
2271: close($mfh);
2272: }
2273: }
2274:
2275: sub check_switchserver {
2276: my ($dom,$confname) = @_;
2277: my ($allowed,$switchserver);
2278: my $home = &Apache::lonnet::homeserver($confname,$dom);
2279: if ($home eq 'no_host') {
2280: $home = &Apache::lonnet::domain($dom,'primary');
2281: }
2282: my @ids=&Apache::lonnet::current_machine_ids();
1.10 albertel 2283: foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
2284: if (!$allowed) {
2285: $switchserver='<a href="/adm/switchserver?otherserver='.$home.'&role=dc./'.$dom.'/">'.&mt('Switch Server').'</a>';
1.9 raeburn 2286: }
2287: return $switchserver;
2288: }
2289:
1.30 raeburn 2290: sub javascript_set_colnums {
2291: return <<END;
2292: function setDisplayColumns() {
2293: if (document.pickactions.width.value > 1100) {
2294: document.pickactions.numcols[1].checked = true;
2295: } else {
2296: document.pickactions.numcols[0].checked = true;
2297: }
2298: }
2299: END
2300: }
2301:
1.1 raeburn 2302: sub modify_quotas {
1.3 raeburn 2303: my ($dom,%domconfig) = @_;
1.1 raeburn 2304: my ($resulttext,%changes);
1.26 raeburn 2305: my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
1.1 raeburn 2306: my %formhash;
2307: foreach my $key (keys(%env)) {
2308: if ($key =~ /^form\.quota_(.+)$/) {
2309: $formhash{$1} = $env{$key};
2310: }
2311: }
1.15 raeburn 2312: $formhash{'default'} = $env{'form.defaultquota'};
1.1 raeburn 2313: if (ref($domconfig{'quotas'}) eq 'HASH') {
2314: foreach my $key (keys(%{$domconfig{'quotas'}})) {
2315: if (exists($formhash{$key})) {
2316: if ($formhash{$key} ne $domconfig{'quotas'}{$key}) {
2317: $changes{$key} = 1;
2318: }
2319: } else {
2320: $formhash{$key} = $domconfig{'quotas'}{$key};
2321: }
2322: }
2323: }
2324: foreach my $key (keys(%formhash)) {
2325: if ($formhash{$key} ne '') {
1.3 raeburn 2326: if (!exists($domconfig{'quotas'}{$key})) {
1.1 raeburn 2327: $changes{$key} = 1;
2328: }
2329: }
2330: }
2331: my %quotahash = (
1.3 raeburn 2332: quotas => {%formhash},
1.1 raeburn 2333: );
2334: my $putresult = &Apache::lonnet::put_dom('configuration',\%quotahash,
2335: $dom);
2336: if ($putresult eq 'ok') {
2337: if (keys(%changes) > 0) {
2338: $resulttext = &mt('Changes made:').'<ul>';
1.26 raeburn 2339: foreach my $type (@{$types},'default') {
2340: if (defined($changes{$type})) {
2341: my $typetitle = $usertypes->{$type};
2342: if ($type eq 'default') {
2343: $typetitle = $othertitle;
2344: }
2345: $resulttext .= '<li>'.&mt('[_1] set to [_2] Mb',$typetitle,$formhash{$type}).'</li>';
2346: }
1.1 raeburn 2347: }
2348: $resulttext .= '</ul>';
2349: } else {
2350: $resulttext = &mt('No changes made to default quotas');
2351: }
2352: } else {
1.11 albertel 2353: $resulttext = '<span class="LC_error">'.
2354: &mt('An error occurred: [_1]',$putresult).'</span>';
1.1 raeburn 2355: }
1.3 raeburn 2356: return $resulttext;
1.1 raeburn 2357: }
2358:
1.3 raeburn 2359: sub modify_autoenroll {
2360: my ($dom,%domconfig) = @_;
1.1 raeburn 2361: my ($resulttext,%changes);
2362: my %currautoenroll;
2363: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
2364: foreach my $key (keys(%{$domconfig{'autoenroll'}})) {
2365: $currautoenroll{$key} = $domconfig{'autoenroll'}{$key};
2366: }
2367: }
2368: my $autorun = &Apache::lonnet::auto_run(undef,$dom),
2369: my %title = ( run => 'Auto-enrollment active',
2370: sender => 'Sender for notification messages');
2371: my @offon = ('off','on');
1.17 raeburn 2372: my $sender_uname = $env{'form.sender_uname'};
2373: my $sender_domain = $env{'form.sender_domain'};
2374: if ($sender_domain eq '') {
2375: $sender_uname = '';
2376: } elsif ($sender_uname eq '') {
2377: $sender_domain = '';
2378: }
1.1 raeburn 2379: my %autoenrollhash = (
2380: autoenroll => { run => $env{'form.autoenroll_run'},
1.17 raeburn 2381: sender_uname => $sender_uname,
2382: sender_domain => $sender_domain,
1.1 raeburn 2383:
2384: }
2385: );
1.4 raeburn 2386: my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash,
2387: $dom);
1.1 raeburn 2388: if ($putresult eq 'ok') {
2389: if (exists($currautoenroll{'run'})) {
2390: if ($currautoenroll{'run'} ne $env{'form.autoenroll_run'}) {
2391: $changes{'run'} = 1;
2392: }
2393: } elsif ($autorun) {
2394: if ($env{'form.autoenroll_run'} ne '1') {
1.23 raeburn 2395: $changes{'run'} = 1;
1.1 raeburn 2396: }
2397: }
1.17 raeburn 2398: if ($currautoenroll{'sender_uname'} ne $sender_uname) {
1.1 raeburn 2399: $changes{'sender'} = 1;
2400: }
1.17 raeburn 2401: if ($currautoenroll{'sender_domain'} ne $sender_domain) {
1.1 raeburn 2402: $changes{'sender'} = 1;
2403: }
2404: if (keys(%changes) > 0) {
2405: $resulttext = &mt('Changes made:').'<ul>';
1.3 raeburn 2406: if ($changes{'run'}) {
1.1 raeburn 2407: $resulttext .= '<li>'.&mt("$title{'run'} set to $offon[$env{'form.autoenroll_run'}]").'</li>';
2408: }
2409: if ($changes{'sender'}) {
1.17 raeburn 2410: if ($sender_uname eq '' || $sender_domain eq '') {
2411: $resulttext .= '<li>'.&mt("$title{'sender'} set to default (course owner).").'</li>';
2412: } else {
2413: $resulttext .= '<li>'.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'</li>';
2414: }
1.1 raeburn 2415: }
2416: $resulttext .= '</ul>';
2417: } else {
2418: $resulttext = &mt('No changes made to auto-enrollment settings');
2419: }
2420: } else {
1.11 albertel 2421: $resulttext = '<span class="LC_error">'.
2422: &mt('An error occurred: [_1]',$putresult).'</span>';
1.1 raeburn 2423: }
1.3 raeburn 2424: return $resulttext;
1.1 raeburn 2425: }
2426:
2427: sub modify_autoupdate {
1.3 raeburn 2428: my ($dom,%domconfig) = @_;
1.1 raeburn 2429: my ($resulttext,%currautoupdate,%fields,%changes);
2430: if (ref($domconfig{'autoupdate'}) eq 'HASH') {
2431: foreach my $key (keys(%{$domconfig{'autoupdate'}})) {
2432: $currautoupdate{$key} = $domconfig{'autoupdate'}{$key};
2433: }
2434: }
2435: my @offon = ('off','on');
2436: my %title = &Apache::lonlocal::texthash (
2437: run => 'Auto-update:',
2438: classlists => 'Updates to user information in classlists?'
2439: );
1.26 raeburn 2440: my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
1.1 raeburn 2441: my %fieldtitles = &Apache::lonlocal::texthash (
2442: id => 'Student/Employee ID',
1.20 raeburn 2443: permanentemail => 'E-mail address',
1.1 raeburn 2444: lastname => 'Last Name',
2445: firstname => 'First Name',
2446: middlename => 'Middle Name',
2447: gen => 'Generation',
2448: );
2449: my $othertitle = &mt('All users');
2450: if (keys(%{$usertypes}) > 0) {
1.26 raeburn 2451: $othertitle = &mt('Other users');
1.1 raeburn 2452: }
2453: foreach my $key (keys(%env)) {
2454: if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) {
2455: push(@{$fields{$1}},$2);
2456: }
2457: }
2458: my %updatehash = (
2459: autoupdate => { run => $env{'form.autoupdate_run'},
2460: classlists => $env{'form.classlists'},
2461: fields => {%fields},
2462: }
2463: );
2464: foreach my $key (keys(%currautoupdate)) {
2465: if (($key eq 'run') || ($key eq 'classlists')) {
2466: if (exists($updatehash{autoupdate}{$key})) {
2467: if ($currautoupdate{$key} ne $updatehash{autoupdate}{$key}) {
2468: $changes{$key} = 1;
2469: }
2470: }
2471: } elsif ($key eq 'fields') {
2472: if (ref($currautoupdate{$key}) eq 'HASH') {
1.26 raeburn 2473: foreach my $item (@{$types},'default') {
1.1 raeburn 2474: if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') {
2475: my $change = 0;
2476: foreach my $type (@{$currautoupdate{$key}{$item}}) {
2477: if (!exists($fields{$item})) {
2478: $change = 1;
2479: } elsif (ref($fields{$item}) eq 'ARRAY') {
1.26 raeburn 2480: if (!grep(/^\Q$type\E$/,@{$fields{$item}})) {
1.1 raeburn 2481: $change = 1;
2482: }
2483: }
2484: }
2485: if ($change) {
2486: push(@{$changes{$key}},$item);
2487: }
1.26 raeburn 2488: }
1.1 raeburn 2489: }
2490: }
2491: }
2492: }
1.26 raeburn 2493: foreach my $item (@{$types},'default') {
2494: if (defined($fields{$item})) {
2495: if (ref($currautoupdate{'fields'}) eq 'HASH') {
2496: if (!exists($currautoupdate{'fields'}{$item})) {
2497: push(@{$changes{'fields'}},$item);
2498: }
2499: } else {
2500: push(@{$changes{'fields'}},$item);
1.1 raeburn 2501: }
2502: }
2503: }
2504: my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash,
2505: $dom);
2506: if ($putresult eq 'ok') {
2507: if (keys(%changes) > 0) {
2508: $resulttext = &mt('Changes made:').'<ul>';
2509: foreach my $key (sort(keys(%changes))) {
2510: if (ref($changes{$key}) eq 'ARRAY') {
2511: foreach my $item (@{$changes{$key}}) {
2512: my @newvalues;
2513: foreach my $type (@{$fields{$item}}) {
2514: push(@newvalues,$fieldtitles{$type});
2515: }
1.3 raeburn 2516: my $newvaluestr;
2517: if (@newvalues > 0) {
2518: $newvaluestr = join(', ',@newvalues);
2519: } else {
2520: $newvaluestr = &mt('none');
1.6 raeburn 2521: }
1.1 raeburn 2522: if ($item eq 'default') {
1.26 raeburn 2523: $resulttext .= '<li>'.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).'</li>';
1.1 raeburn 2524: } else {
1.26 raeburn 2525: $resulttext .= '<li>'.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).'</li>';
1.1 raeburn 2526: }
2527: }
2528: } else {
2529: my $newvalue;
2530: if ($key eq 'run') {
2531: $newvalue = $offon[$env{'form.autoupdate_run'}];
2532: } else {
2533: $newvalue = $offon[$env{'form.'.$key}];
1.3 raeburn 2534: }
1.1 raeburn 2535: $resulttext .= '<li>'.&mt("[_1] set to $newvalue",$title{$key}).'</li>';
2536: }
2537: }
2538: $resulttext .= '</ul>';
2539: } else {
1.3 raeburn 2540: $resulttext = &mt('No changes made to autoupdates');
1.1 raeburn 2541: }
2542: } else {
1.11 albertel 2543: $resulttext = '<span class="LC_error">'.
2544: &mt('An error occurred: [_1]',$putresult).'</span>';
1.1 raeburn 2545: }
1.3 raeburn 2546: return $resulttext;
1.1 raeburn 2547: }
2548:
1.23 raeburn 2549: sub modify_directorysrch {
2550: my ($dom,%domconfig) = @_;
2551: my ($resulttext,%changes);
2552: my %currdirsrch;
2553: if (ref($domconfig{'directorysrch'}) eq 'HASH') {
2554: foreach my $key (keys(%{$domconfig{'directorysrch'}})) {
2555: $currdirsrch{$key} = $domconfig{'directorysrch'}{$key};
2556: }
2557: }
2558: my %title = ( available => 'Directory search available',
1.24 raeburn 2559: localonly => 'Other domains can search',
1.23 raeburn 2560: searchby => 'Search types',
2561: searchtypes => 'Search latitude');
2562: my @offon = ('off','on');
1.24 raeburn 2563: my @otherdoms = ('Yes','No');
1.23 raeburn 2564:
1.25 raeburn 2565: my @searchtypes = &Apache::loncommon::get_env_multiple('form.searchtypes');
1.23 raeburn 2566: my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch');
2567: my @searchby = &Apache::loncommon::get_env_multiple('form.searchby');
2568:
1.26 raeburn 2569: my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
2570: if (keys(%{$usertypes}) == 0) {
2571: @cansearch = ('default');
2572: } else {
2573: if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') {
2574: foreach my $type (@{$currdirsrch{'cansearch'}}) {
2575: if (!grep(/^\Q$type\E$/,@cansearch)) {
2576: push(@{$changes{'cansearch'}},$type);
2577: }
1.23 raeburn 2578: }
1.26 raeburn 2579: foreach my $type (@cansearch) {
2580: if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) {
2581: push(@{$changes{'cansearch'}},$type);
2582: }
1.23 raeburn 2583: }
1.26 raeburn 2584: } else {
2585: push(@{$changes{'cansearch'}},@cansearch);
1.23 raeburn 2586: }
2587: }
2588:
2589: if (ref($currdirsrch{'searchby'}) eq 'ARRAY') {
2590: foreach my $by (@{$currdirsrch{'searchby'}}) {
2591: if (!grep(/^\Q$by\E$/,@searchby)) {
2592: push(@{$changes{'searchby'}},$by);
2593: }
2594: }
2595: foreach my $by (@searchby) {
2596: if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) {
2597: push(@{$changes{'searchby'}},$by);
2598: }
2599: }
2600: } else {
2601: push(@{$changes{'searchby'}},@searchby);
2602: }
1.25 raeburn 2603:
2604: if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') {
2605: foreach my $type (@{$currdirsrch{'searchtypes'}}) {
2606: if (!grep(/^\Q$type\E$/,@searchtypes)) {
2607: push(@{$changes{'searchtypes'}},$type);
2608: }
2609: }
2610: foreach my $type (@searchtypes) {
2611: if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) {
2612: push(@{$changes{'searchtypes'}},$type);
2613: }
2614: }
2615: } else {
2616: if (exists($currdirsrch{'searchtypes'})) {
2617: foreach my $type (@searchtypes) {
2618: if ($type ne $currdirsrch{'searchtypes'}) {
2619: push(@{$changes{'searchtypes'}},$type);
2620: }
2621: }
2622: if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) {
2623: push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'});
2624: }
2625: } else {
2626: push(@{$changes{'searchtypes'}},@searchtypes);
2627: }
2628: }
2629:
1.23 raeburn 2630: my %dirsrch_hash = (
2631: directorysrch => { available => $env{'form.dirsrch_available'},
2632: cansearch => \@cansearch,
1.24 raeburn 2633: localonly => $env{'form.dirsrch_localonly'},
1.23 raeburn 2634: searchby => \@searchby,
1.25 raeburn 2635: searchtypes => \@searchtypes,
1.23 raeburn 2636: }
2637: );
2638: my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash,
2639: $dom);
2640: if ($putresult eq 'ok') {
2641: if (exists($currdirsrch{'available'})) {
2642: if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) {
2643: $changes{'available'} = 1;
2644: }
2645: } else {
2646: if ($env{'form.dirsrch_available'} eq '1') {
2647: $changes{'available'} = 1;
2648: }
2649: }
1.24 raeburn 2650: if (exists($currdirsrch{'localonly'})) {
2651: if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) {
2652: $changes{'localonly'} = 1;
2653: }
2654: } else {
2655: if ($env{'form.dirsrch_localonly'} eq '1') {
2656: $changes{'localonly'} = 1;
2657: }
2658: }
1.23 raeburn 2659: if (keys(%changes) > 0) {
2660: $resulttext = &mt('Changes made:').'<ul>';
2661: if ($changes{'available'}) {
2662: $resulttext .= '<li>'.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").'</li>';
2663: }
1.24 raeburn 2664: if ($changes{'localonly'}) {
2665: $resulttext .= '<li>'.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").'</li>';
2666: }
2667:
1.23 raeburn 2668: if (ref($changes{'cansearch'}) eq 'ARRAY') {
2669: my $chgtext;
1.26 raeburn 2670: if (ref($usertypes) eq 'HASH') {
2671: if (keys(%{$usertypes}) > 0) {
2672: foreach my $type (@{$types}) {
2673: if (grep(/^\Q$type\E$/,@cansearch)) {
2674: $chgtext .= $usertypes->{$type}.'; ';
2675: }
2676: }
2677: if (grep(/^default$/,@cansearch)) {
2678: $chgtext .= $othertitle;
2679: } else {
2680: $chgtext =~ s/\; $//;
2681: }
2682: $resulttext .= '<li>'.&mt("Users from domain '<span class=\"LC_cusr_emph\">[_1]</span>' permitted to search the institutional directory set to: [_2]",$dom,$chgtext).'</li>';
1.23 raeburn 2683: }
2684: }
2685: }
2686: if (ref($changes{'searchby'}) eq 'ARRAY') {
2687: my ($searchtitles,$titleorder) = &sorted_searchtitles();
2688: my $chgtext;
2689: foreach my $type (@{$titleorder}) {
2690: if (grep(/^\Q$type\E$/,@searchby)) {
2691: if (defined($searchtitles->{$type})) {
2692: $chgtext .= $searchtitles->{$type}.'; ';
2693: }
2694: }
2695: }
2696: $chgtext =~ s/\; $//;
2697: $resulttext .= '<li>'.&mt("$title{'searchby'} set to: [_1]",$chgtext).'</li>';
2698: }
1.25 raeburn 2699: if (ref($changes{'searchtypes'}) eq 'ARRAY') {
2700: my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes();
2701: my $chgtext;
2702: foreach my $type (@{$srchtypeorder}) {
2703: if (grep(/^\Q$type\E$/,@searchtypes)) {
2704: if (defined($srchtypes_desc->{$type})) {
2705: $chgtext .= $srchtypes_desc->{$type}.'; ';
2706: }
2707: }
2708: }
2709: $chgtext =~ s/\; $//;
2710: $resulttext .= '<li>'.&mt("$title{'searchtypes'} set to: \"[_1]\"",$chgtext).'</li>';
1.23 raeburn 2711: }
2712: $resulttext .= '</ul>';
2713: } else {
2714: $resulttext = &mt('No changes made to institution directory search settings');
2715: }
2716: } else {
2717: $resulttext = '<span class="LC_error">'.
1.27 raeburn 2718: &mt('An error occurred: [_1]',$putresult).'</span>';
2719: }
2720: return $resulttext;
2721: }
2722:
1.28 raeburn 2723: sub modify_contacts {
2724: my ($dom,%domconfig) = @_;
2725: my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash);
2726: if (ref($domconfig{'contacts'}) eq 'HASH') {
2727: foreach my $key (keys(%{$domconfig{'contacts'}})) {
2728: $currsetting{$key} = $domconfig{'contacts'}{$key};
2729: }
2730: }
2731: my (%others,%to);
2732: my @contacts = ('supportemail','adminemail');
2733: my @mailings = ('errormail','packagesmail','helpdeskmail');
2734: foreach my $type (@mailings) {
2735: @{$newsetting{$type}} =
2736: &Apache::loncommon::get_env_multiple('form.'.$type);
2737: foreach my $item (@contacts) {
2738: if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) {
2739: $contacts_hash{contacts}{$type}{$item} = 1;
2740: } else {
2741: $contacts_hash{contacts}{$type}{$item} = 0;
2742: }
2743: }
2744: $others{$type} = $env{'form.'.$type.'_others'};
2745: $contacts_hash{contacts}{$type}{'others'} = $others{$type};
2746: }
2747: foreach my $item (@contacts) {
2748: $to{$item} = $env{'form.'.$item};
2749: $contacts_hash{'contacts'}{$item} = $to{$item};
2750: }
2751: if (keys(%currsetting) > 0) {
2752: foreach my $item (@contacts) {
2753: if ($to{$item} ne $currsetting{$item}) {
2754: $changes{$item} = 1;
2755: }
2756: }
2757: foreach my $type (@mailings) {
2758: foreach my $item (@contacts) {
2759: if (ref($currsetting{$type}) eq 'HASH') {
2760: if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) {
2761: push(@{$changes{$type}},$item);
2762: }
2763: } else {
2764: push(@{$changes{$type}},@{$newsetting{$type}});
2765: }
2766: }
2767: if ($others{$type} ne $currsetting{$type}{'others'}) {
2768: push(@{$changes{$type}},'others');
2769: }
2770: }
2771: } else {
2772: my %default;
2773: $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
2774: $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
2775: $default{'errormail'} = 'adminemail';
2776: $default{'packagesmail'} = 'adminemail';
2777: $default{'helpdeskmail'} = 'supportemail';
2778: foreach my $item (@contacts) {
2779: if ($to{$item} ne $default{$item}) {
2780: $changes{$item} = 1;
2781: }
2782: }
2783: foreach my $type (@mailings) {
2784: if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) {
2785:
2786: push(@{$changes{$type}},@{$newsetting{$type}});
2787: }
2788: if ($others{$type} ne '') {
2789: push(@{$changes{$type}},'others');
2790: }
2791: }
2792: }
2793: my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash,
2794: $dom);
2795: if ($putresult eq 'ok') {
2796: if (keys(%changes) > 0) {
2797: my ($titles,$short_titles) = &contact_titles();
2798: $resulttext = &mt('Changes made:').'<ul>';
2799: foreach my $item (@contacts) {
2800: if ($changes{$item}) {
2801: $resulttext .= '<li>'.$titles->{$item}.
2802: &mt(' set to: ').
2803: '<span class="LC_cusr_emph">'.
2804: $to{$item}.'</span></li>';
2805: }
2806: }
2807: foreach my $type (@mailings) {
2808: if (ref($changes{$type}) eq 'ARRAY') {
2809: $resulttext .= '<li>'.$titles->{$type}.': ';
2810: my @text;
2811: foreach my $item (@{$newsetting{$type}}) {
2812: push(@text,$short_titles->{$item});
2813: }
2814: if ($others{$type} ne '') {
2815: push(@text,$others{$type});
2816: }
2817: $resulttext .= '<span class="LC_cusr_emph">'.
2818: join(', ',@text).'</span></li>';
2819: }
2820: }
2821: $resulttext .= '</ul>';
2822: } else {
2823: $resulttext = &mt('No changes made to contact information.');
2824: }
2825: } else {
2826: $resulttext = '<span class="LC_error">'.
2827: &mt('An error occurred: [_1].',$putresult).'</span>';
2828: }
2829: return $resulttext;
2830: }
2831:
2832: sub modify_usercreation {
1.27 raeburn 2833: my ($dom,%domconfig) = @_;
1.28 raeburn 2834: my ($resulttext,%curr_usercreation,%changes,%authallowed);
1.27 raeburn 2835: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2836: foreach my $key (keys(%{$domconfig{'usercreation'}})) {
2837: $curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
2838: }
2839: }
2840: my %title = &Apache::lonlocal::texthash (
2841: author => 'adding co-authors/assistant authors',
2842: course => 'adding users to a course',
2843: );
2844: my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule');
1.32 raeburn 2845: my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule');
1.27 raeburn 2846: my @cancreate = &Apache::loncommon::get_env_multiple('form.can_createuser');
2847: if (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
2848: foreach my $type (@{$curr_usercreation{'cancreate'}}) {
2849: if (!grep(/^\Q$type\E$/,@cancreate)) {
2850: push(@{$changes{'cancreate'}},$type);
2851: }
2852: }
2853: foreach my $type (@cancreate) {
2854: if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'cancreate'}})) {
2855: push(@{$changes{'cancreate'}},$type);
2856: }
2857: }
2858: } else {
2859: push(@{$changes{'cancreate'}},@cancreate);
2860: }
2861: if (ref($curr_usercreation{'username_rule'}) eq 'ARRAY') {
2862: foreach my $type (@{$curr_usercreation{'username_rule'}}) {
2863: if (!grep(/^\Q$type\E$/,@username_rule)) {
2864: push(@{$changes{'username_rule'}},$type);
2865: }
2866: }
2867: foreach my $type (@username_rule) {
2868: if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'username_rule'}})) {
2869: push(@{$changes{'username_rule'}},$type);
2870: }
2871: }
2872: } else {
2873: push(@{$changes{'username_rule'}},@username_rule);
2874: }
2875:
1.32 raeburn 2876: if (ref($curr_usercreation{'id_rule'}) eq 'ARRAY') {
2877: foreach my $type (@{$curr_usercreation{'id_rule'}}) {
2878: if (!grep(/^\Q$type\E$/,@id_rule)) {
2879: push(@{$changes{'id_rule'}},$type);
2880: }
2881: }
2882: foreach my $type (@id_rule) {
2883: if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'id_rule'}})) {
2884: push(@{$changes{'id_rule'}},$type);
2885: }
2886: }
2887: } else {
2888: push(@{$changes{'id_rule'}},@id_rule);
2889: }
2890:
1.28 raeburn 2891: my @contexts = ('author','course','domain');
2892: my @authtypes = ('int','krb4','krb5','loc');
2893: my %authhash;
2894: foreach my $item (@contexts) {
2895: my @authallowed = &Apache::loncommon::get_env_multiple('form.'.$item.'_auth');
2896: foreach my $auth (@authtypes) {
2897: if (grep(/^\Q$auth\E$/,@authallowed)) {
2898: $authhash{$item}{$auth} = 1;
2899: } else {
2900: $authhash{$item}{$auth} = 0;
2901: }
2902: }
2903: }
2904: if (ref($curr_usercreation{'authtypes'}) eq 'HASH') {
2905: foreach my $item (@contexts) {
2906: if (ref($curr_usercreation{'authtypes'}{$item}) eq 'HASH') {
2907: foreach my $auth (@authtypes) {
2908: if ($authhash{$item}{$auth} ne $curr_usercreation{'authtypes'}{$item}{$auth}) {
2909: push(@{$changes{'authtypes'}},$item);
2910: last;
2911: }
2912: }
2913: }
2914: }
2915: } else {
2916: foreach my $item (@contexts) {
2917: push(@{$changes{'authtypes'}},$item);
2918: }
2919: }
2920:
1.27 raeburn 2921: my %usercreation_hash = (
1.28 raeburn 2922: usercreation => {
1.27 raeburn 2923: cancreate => \@cancreate,
2924: username_rule => \@username_rule,
1.32 raeburn 2925: id_rule => \@id_rule,
2926: authtypes => \%authhash,
1.27 raeburn 2927: }
2928: );
2929:
2930: my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
2931: $dom);
2932: if ($putresult eq 'ok') {
2933: if (keys(%changes) > 0) {
2934: $resulttext = &mt('Changes made:').'<ul>';
2935: if (ref($changes{'cancreate'}) eq 'ARRAY') {
2936: my $chgtext = '<ul>';
2937: foreach my $type (@cancreate) {
2938: $chgtext .= '<li>'.$title{$type}.'</li>';
2939: }
2940: $chgtext .= '</ul>';
2941: if (@cancreate > 0) {
2942: $resulttext .= '<li>'.&mt('Creation of new users is permitted by a Domain Coordinator, and also by other users when: ').$chgtext.'</li>';
2943: } else {
2944: $resulttext .= '<li>'.&mt("Creation of new users is now only allowed when the user's role is Domain Coordinator.").'</li>';
2945: }
2946: }
2947: if (ref($changes{'username_rule'}) eq 'ARRAY') {
1.32 raeburn 2948: my ($rules,$ruleorder) =
2949: &Apache::lonnet::inst_userrules($dom,'username');
1.27 raeburn 2950: my $chgtext = '<ul>';
2951: foreach my $type (@username_rule) {
2952: if (ref($rules->{$type}) eq 'HASH') {
2953: $chgtext .= '<li>'.$rules->{$type}{'name'}.'</li>';
2954: }
2955: }
2956: $chgtext .= '</ul>';
2957: if (@username_rule > 0) {
2958: $resulttext .= '<li>'.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'</li>';
2959: } else {
1.28 raeburn 2960: $resulttext .= '<li>'.&mt('There are now no username formats restricted to verified users in the institutional directory.').'</li>';
1.27 raeburn 2961: }
2962: }
1.32 raeburn 2963: if (ref($changes{'id_rule'}) eq 'ARRAY') {
2964: my ($idrules,$idruleorder) =
2965: &Apache::lonnet::inst_userrules($dom,'id');
2966: my $chgtext = '<ul>';
2967: foreach my $type (@id_rule) {
2968: if (ref($idrules->{$type}) eq 'HASH') {
2969: $chgtext .= '<li>'.$idrules->{$type}{'name'}.'</li>';
2970: }
2971: }
2972: $chgtext .= '</ul>';
2973: if (@id_rule > 0) {
2974: $resulttext .= '<li>'.&mt('IDs with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'</li>';
2975: } else {
2976: $resulttext .= '<li>'.&mt('There are now no ID formats restricted to verified users in the institutional directory.').'</li>';
2977: }
2978: }
1.28 raeburn 2979: my %authname = &authtype_names();
2980: my %context_title = &context_names();
2981: if (ref($changes{'authtypes'}) eq 'ARRAY') {
2982: my $chgtext = '<ul>';
2983: foreach my $type (@{$changes{'authtypes'}}) {
2984: my @allowed;
2985: $chgtext .= '<li><span class="LC_cusr_emph">'.$context_title{$type}.'</span> - '.&mt('assignable authentication types: ');
2986: foreach my $auth (@authtypes) {
2987: if ($authhash{$type}{$auth}) {
2988: push(@allowed,$authname{$auth});
2989: }
2990: }
2991: $chgtext .= join(', ',@allowed).'</li>';
2992: }
2993: $chgtext .= '</ul>';
2994: $resulttext .= '<li>'.&mt('Authentication types available for assignment to new users').'<br />'.$chgtext;
2995: $resulttext .= '</li>';
2996: }
1.27 raeburn 2997: $resulttext .= '</ul>';
2998: } else {
1.28 raeburn 2999: $resulttext = &mt('No changes made to user creation settings');
1.27 raeburn 3000: }
3001: } else {
3002: $resulttext = '<span class="LC_error">'.
1.23 raeburn 3003: &mt('An error occurred: [_1]',$putresult).'</span>';
3004: }
3005: return $resulttext;
3006: }
3007:
1.33 ! raeburn 3008: sub modify_usermodification {
! 3009: my ($dom,%domconfig) = @_;
! 3010: my ($resulttext,%curr_usermodification,%changes);
! 3011: if (ref($domconfig{'usermodification'}) eq 'HASH') {
! 3012: foreach my $key (keys(%{$domconfig{'usermodification'}})) {
! 3013: $curr_usermodification{$key} = $domconfig{'usermodification'}{$key};
! 3014: }
! 3015: }
! 3016: my @contexts = ('author','course');
! 3017: my %context_title = (
! 3018: author => 'In author context',
! 3019: course => 'In course context',
! 3020: );
! 3021: my @fields = ('lastname','firstname','middlename','generation',
! 3022: 'permanentemail','id');
! 3023: my %roles = (
! 3024: author => ['ca','aa'],
! 3025: course => ['st','ep','ta','in','cr'],
! 3026: );
! 3027: my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
! 3028: my %modifyhash;
! 3029: foreach my $context (@contexts) {
! 3030: foreach my $role (@{$roles{$context}}) {
! 3031: my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$role);
! 3032: foreach my $item (@fields) {
! 3033: if (grep(/^\Q$item\E$/,@modifiable)) {
! 3034: $modifyhash{$context}{$role}{$item} = 1;
! 3035: } else {
! 3036: $modifyhash{$context}{$role}{$item} = 0;
! 3037: }
! 3038: }
! 3039: }
! 3040: if (ref($curr_usermodification{$context}) eq 'HASH') {
! 3041: foreach my $role (@{$roles{$context}}) {
! 3042: if (ref($curr_usermodification{$context}{$role}) eq 'HASH') {
! 3043: foreach my $field (@fields) {
! 3044: if ($modifyhash{$context}{$role}{$field} ne
! 3045: $curr_usermodification{$context}{$role}{$field}) {
! 3046: push(@{$changes{$context}},$role);
! 3047: last;
! 3048: }
! 3049: }
! 3050: }
! 3051: }
! 3052: } else {
! 3053: foreach my $context (@contexts) {
! 3054: foreach my $role (@{$roles{$context}}) {
! 3055: push(@{$changes{$context}},$role);
! 3056: }
! 3057: }
! 3058: }
! 3059: }
! 3060: my %usermodification_hash = (
! 3061: usermodification => \%modifyhash,
! 3062: );
! 3063: my $putresult = &Apache::lonnet::put_dom('configuration',
! 3064: \%usermodification_hash,$dom);
! 3065: if ($putresult eq 'ok') {
! 3066: if (keys(%changes) > 0) {
! 3067: $resulttext = &mt('Changes made: ').'<ul>';
! 3068: foreach my $context (@contexts) {
! 3069: if (ref($changes{$context}) eq 'ARRAY') {
! 3070: $resulttext .= '<li>'.$context_title{$context}.':<ul>';
! 3071: if (ref($changes{$context}) eq 'ARRAY') {
! 3072: foreach my $role (@{$changes{$context}}) {
! 3073: my $rolename;
! 3074: if ($role eq 'cr') {
! 3075: $rolename = &mt('Custom');
! 3076: } else {
! 3077: $rolename = &Apache::lonnet::plaintext($role);
! 3078: }
! 3079: my @modifiable;
! 3080: $resulttext .= '<li><span class="LC_cusr_emph">'.&mt('Target user with [_1] role',$rolename).'</span> - '.&mt('modifiable fields: ');
! 3081: foreach my $field (@fields) {
! 3082: if ($modifyhash{$context}{$role}{$field}) {
! 3083: push(@modifiable,$fieldtitles{$field});
! 3084: }
! 3085: }
! 3086: if (@modifiable > 0) {
! 3087: $resulttext .= join(', ',@modifiable);
! 3088: } else {
! 3089: $resulttext .= &mt('none');
! 3090: }
! 3091: $resulttext .= '</li>';
! 3092: }
! 3093: $resulttext .= '</ul></li>';
! 3094: }
! 3095: }
! 3096: }
! 3097: $resulttext .= '</ul>';
! 3098: } else {
! 3099: $resulttext = &mt('No changes made to user modification settings');
! 3100: }
! 3101: } else {
! 3102: $resulttext = '<span class="LC_error">'.
! 3103: &mt('An error occurred: [_1]',$putresult).'</span>';
! 3104: }
! 3105: return $resulttext;
! 3106: }
! 3107:
1.3 raeburn 3108: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to domainprefs.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface