'.
''.$choices->{$img}.' ';
- my $imgfile;
+ my ($imgfile,$img_import,$login_hdr_pick,$logincolors);
if ($designs->{$img} ne '') {
$imgfile = $designs->{$img};
+ $img_import = ($imgfile =~ m{^/adm/});
} else {
$imgfile = $defaults->{$img};
}
+ if ($img eq 'login') {
+ $login_hdr_pick = &login_header_options($img,$role,$defaults,$is_custom,$choices,
+ $loginheader);
+ $logincolors =
+ &login_text_colors($img,$role,$logintext,$phase,$choices,$designs);
+ }
if ($imgfile) {
my ($showfile,$fullsize);
if ($imgfile =~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
@@ -550,6 +911,7 @@ sub display_color_options {
$showfile = '';
}
} elsif ($imgfile =~ m-^/(adm/[^/]+)/([^/]+)$-) {
+ $showfile = $imgfile;
my $imgdir = $1;
my $filename = $2;
if (-e "/home/httpd/html/$imgdir/tn-".$filename) {
@@ -559,29 +921,44 @@ sub display_color_options {
my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename;
if (!-e $output) {
my ($width,$height) = &thumb_dimensions();
- my $size = $width.'x'.$height;
- system("convert -sample $size $input $output");
+ my ($fullwidth,$fullheight) = &check_dimensions($input);
+ if ($fullwidth ne '' && $fullheight ne '') {
+ if ($fullwidth > $width && $fullheight > $height) {
+ my $size = $width.'x'.$height;
+ system("convert -sample $size $input $output");
+ $showfile = '/'.$imgdir.'/tn-'.$filename;
+ }
+ }
}
- $showfile = '/'.$imgdir.'/tn-'.$filename;
}
- }
+ }
if ($showfile) {
- $showfile = &Apache::loncommon::lonhttpdurl($showfile);
- $fullsize = &Apache::loncommon::lonhttpdurl($imgfile);
- $datatable.= '';
- if (!$is_custom->{$img}) {
- $datatable .= &mt('Default in use:').' ';
- if ($is_custom->{$img}) {
- $datatable.=''.&mt('Upload:').' ';
+ if ($img eq 'login') {
+ $datatable .= $login_hdr_pick;
+ }
+ $datatable .= &image_changes($is_custom->{$img},$alt_text->{$img},$img_import,
+ $showfile,$fullsize,$role,$img,$imgfile,$logincolors);
} else {
$datatable .= ' '.$choices->{$item}.' ';
+ $bgs_def .= ''.$choices->{$item}.' ';
}
}
if ($bgs_def) {
@@ -618,10 +995,10 @@ sub display_color_options {
my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'bgs'}{$item});
$datatable .= ''.$link;
if ($designs->{'bgs'}{$item}) {
- $datatable .= ' ';
+ $datatable .= ' ';
}
$datatable .= ' ';
+ '" onblur = "javascript:colchg_span('."'css_".$role.'_'.$item."'".',this);" />';
}
$datatable .= '';
$itemcount ++;
@@ -631,7 +1008,7 @@ sub display_color_options {
my $links_def;
foreach my $item (@{$links}) {
if (!$is_custom->{$item}) {
- $links_def .= ''.$choices->{$item}.' ';
+ $links_def .= ''.$choices->{$item}.''.$defaults->{'links'}{$item}.' ';
}
}
if ($links_def) {
@@ -642,20 +1019,92 @@ sub display_color_options {
$datatable .= ''.
'';
foreach my $item (@{$links}) {
- $datatable .= '';
- my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'links'}{$item});
+ $datatable .= ' '."\n".
+ &color_pick($phase,$role,$item,$choices->{$item},
+ $designs->{'links'}{$item});
if ($designs->{'links'}{$item}) {
- $datatable.=''.
- $link.' ';
- } else {
- $datatable .= $link;
+ $datatable.=' ';
}
$datatable .= ' ';
}
+ $$rowtotal += $itemcount;
return $datatable;
}
+sub login_header_options {
+ my ($img,$role,$defaults,$is_custom,$choices,$loginheader) = @_;
+ my $image_checked = ' checked="checked" ';
+ my $text_checked = ' ';
+ if ($loginheader eq 'text') {
+ $image_checked = ' ';
+ $text_checked = ' checked="checked" ';
+ }
+ my $output = ' ';
+ }
+ $output .= ''.$logincolors.''.
+ ' '.&mt('Replace:').' '.$logincolors.&mt('Upload:').' 0) {
- foreach my $type (@types) {
+ if (ref($types) eq 'ARRAY') {
+ foreach my $type (@{$types}) {
if (defined($usertypes->{$type})) {
$typecount ++;
$css_class = $typecount%2?' class="LC_odd_row"':'';
@@ -720,7 +1178,6 @@ sub print_quotas {
'" size="5" /> Mb ';
}
}
- $othertitle = "Other users";
}
my $defaultquota = '20';
if (ref($settings) eq 'HASH') {
@@ -731,18 +1188,18 @@ sub print_quotas {
$typecount ++;
$css_class = $typecount%2?' class="LC_odd_row"':'';
$datatable .= ''.
- ''.&mt($othertitle).' '.
+ ''.$othertitle.' '.
''.
' '.
''.&mt('Auto-enrollment active?').' '.
''.
@@ -786,14 +1247,14 @@ sub print_autoenroll {
' '.
&mt('username').': '.
' ';
+ $$rowtotal += 2;
return $datatable;
}
sub print_autoupdate {
- my ($position,$dom,$settings) = @_;
+ my ($position,$dom,$settings,$rowtotal) = @_;
my $datatable;
if ($position eq 'top') {
my $updateon = ' ';
@@ -829,44 +1290,1259 @@ sub print_autoupdate {
''.
+ ''.&mt('Directory search available?').' '.
+ ' '.
+ ' '.
+ ''.&mt('Other domains can search?').' '.
+ ' '.
+ ' ';
+ $$rowtotal += 2;
+ if (ref($usertypes) eq 'HASH') {
+ if (keys(%{$usertypes}) > 0) {
+ $datatable .= &users_cansearch_row($settings,$types,$usertypes,$dom,
+ $numinrow,$othertitle);
+ $cansrchrow = 1;
+ }
+ }
+ if ($cansrchrow) {
+ $$rowtotal ++;
+ $datatable .= '';
+ } else {
+ $datatable .= ' ';
+ }
+ $datatable .= ''.&mt('Supported search methods').
+ ' ';
+ $$rowtotal ++;
+ if ($cansrchrow) {
+ $datatable .= '';
+ } else {
+ $datatable .= ' ';
+ }
+ $datatable .= ''.&mt('Search latitude').' '.
+ ''.
+ ' '.
+ ' ';
+ $$rowtotal ++;
+ return $datatable;
+}
+
+sub print_contacts {
+ my ($dom,$settings,$rowtotal) = @_;
+ my $datatable;
+ my @contacts = ('adminemail','supportemail');
+ my (%checked,%to,%otheremails);
+ my @mailings = ('errormail','packagesmail','helpdeskmail');
+ foreach my $type (@mailings) {
+ $otheremails{$type} = '';
+ }
+ if (ref($settings) eq 'HASH') {
+ foreach my $item (@contacts) {
+ if (exists($settings->{$item})) {
+ $to{$item} = $settings->{$item};
+ }
+ }
+ foreach my $type (@mailings) {
+ if (exists($settings->{$type})) {
+ if (ref($settings->{$type}) eq 'HASH') {
+ foreach my $item (@contacts) {
+ if ($settings->{$type}{$item}) {
+ $checked{$type}{$item} = ' checked="checked" ';
+ }
+ }
+ $otheremails{$type} = $settings->{$type}{'others'};
+ }
+ }
+ }
+ } else {
+ $to{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
+ $to{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
+ $checked{'errormail'}{'adminemail'} = ' checked="checked" ';
+ $checked{'packagesmail'}{'adminemail'} = ' checked="checked" ';
+ $checked{'helpdeskmail'}{'supportemail'} = ' checked="checked" ';
+ }
+ my ($titles,$short_titles) = &contact_titles();
+ my $rownum = 0;
+ my $css_class;
+ foreach my $item (@contacts) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.$titles->{$item}.
+ ' '.
+ ' ';
+ $rownum ++;
+ }
+ foreach my $type (@mailings) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.
+ $titles->{$type}.': '.
+ '';
+ foreach my $item (@contacts) {
+ $datatable .= ''.
+ ' ';
+ }
+ $datatable .= ' '."\n";
+ $rownum ++;
+ }
+ $$rowtotal += $rownum;
+ return $datatable;
+}
+
+sub contact_titles {
+ my %titles = &Apache::lonlocal::texthash (
+ 'supportemail' => 'Support E-mail address',
+ 'adminemail' => 'Default Server Admin E-mail address',
+ 'errormail' => 'Error reports to be e-mailed to',
+ 'packagesmail' => 'Package update alerts to be e-mailed to',
+ 'helpdeskmail' => 'Helpdesk requests to be e-mailed to'
+ );
+ my %short_titles = &Apache::lonlocal::texthash (
+ adminemail => 'Admin E-mail address',
+ supportemail => 'Support E-mail',
+ );
+ return (\%titles,\%short_titles);
+}
+
+sub print_usercreation {
+ my ($position,$dom,$settings,$rowtotal) = @_;
+ my $numinrow = 4;
+ my $datatable;
+ if ($position eq 'top') {
+ $$rowtotal ++;
+ my $rowcount = 0;
+ my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username');
+ if (ref($rules) eq 'HASH') {
+ if (keys(%{$rules}) > 0) {
+ $datatable .= &user_formats_row('username',$settings,$rules,
+ $ruleorder,$numinrow,$rowcount);
+ $$rowtotal ++;
+ $rowcount ++;
+ }
+ }
+ my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id');
+ if (ref($idrules) eq 'HASH') {
+ if (keys(%{$idrules}) > 0) {
+ $datatable .= &user_formats_row('id',$settings,$idrules,
+ $idruleorder,$numinrow,$rowcount);
+ $$rowtotal ++;
+ $rowcount ++;
+ }
+ }
+ my ($emailrules,$emailruleorder) =
+ &Apache::lonnet::inst_userrules($dom,'email');
+ if (ref($emailrules) eq 'HASH') {
+ if (keys(%{$emailrules}) > 0) {
+ $datatable .= &user_formats_row('email',$settings,$emailrules,
+ $emailruleorder,$numinrow,$rowcount);
+ $$rowtotal ++;
+ $rowcount ++;
+ }
+ }
+ if ($rowcount == 0) {
+ $datatable .= ''.&mt('No format rules have been defined for usernames or IDs in this domain.').' '.
+ ''.$lt{$item}.
+ ' ';
+ my @options;
+ if ($item eq 'selfcreate') {
+ push(@options,('email','login','sso'));
+ } else {
+ @options = ('any');
+ if (ref($rules) eq 'HASH') {
+ if (keys(%{$rules}) > 0) {
+ push(@options,('official','unofficial'));
+ }
+ }
+ push(@options,'none');
+ }
+ foreach my $option (@options) {
+ my $type = 'radio';
+ my $check = ' ';
+ if ($item eq 'selfcreate') {
+ $type = 'checkbox';
+ if (grep(/^\Q$option\E$/,@selfcreate)) {
+ $check = ' checked="checked" ';
+ }
+ } else {
+ if ($checked{$item} eq $option) {
+ $check = ' checked="checked" ';
+ }
+ }
+ $datatable .= ''.
+ ' ';
+ }
+ } else {
+ my @contexts = ('author','course','domain');
+ my @authtypes = ('int','krb4','krb5','loc');
+ my %checked;
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{'authtypes'}) eq 'HASH') {
+ foreach my $item (@contexts) {
+ if (ref($settings->{'authtypes'}{$item}) eq 'HASH') {
+ foreach my $auth (@authtypes) {
+ if ($settings->{'authtypes'}{$item}{$auth}) {
+ $checked{$item}{$auth} = ' checked="checked" ';
+ }
+ }
+ }
+ }
+ }
+ } else {
+ foreach my $item (@contexts) {
+ foreach my $auth (@authtypes) {
+ $checked{$item}{$auth} = ' checked="checked" ';
+ }
+ }
+ }
+ my %title = &context_names();
+ my %authname = &authtype_names();
+ my $rownum = 0;
+ my $css_class;
+ foreach my $item (@contexts) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.$title{$item}.
+ ' '.
+ '';
+ foreach my $auth (@authtypes) {
+ $datatable .= ''.
+ ' ';
+ }
+ $datatable .= ' ';
+ $rownum ++;
+ }
+ $$rowtotal += $rownum;
}
return $datatable;
}
+sub user_formats_row {
+ my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_;
+ my $output;
+ my %text = (
+ 'username' => 'new usernames',
+ 'id' => 'IDs',
+ 'email' => 'self-created accounts (e-mail)',
+ );
+ my $css_class = $rowcount%2?' class="LC_odd_row"':'';
+ $output = ''.
+ '';
+ if ($type eq 'email') {
+ $output .= &mt("Formats disallowed for $text{$type}: ");
+ } else {
+ $output .= &mt("Format rules to check for $text{$type}: ");
+ }
+ $output .= ' ';
+ return $output;
+}
+
+sub usercreation_types {
+ my %lt = &Apache::lonlocal::texthash (
+ author => 'When adding a co-author',
+ course => 'When adding a user to a course',
+ selfcreate => 'User creates own account',
+ any => 'Any',
+ official => 'Institutional only ',
+ unofficial => 'Non-institutional only',
+ email => 'Email address',
+ login => 'Institutional Login',
+ sso => 'SSO',
+ none => 'None',
+ );
+ return %lt;
+}
+
+sub authtype_names {
+ my %lt = &Apache::lonlocal::texthash(
+ int => 'Internal',
+ krb4 => 'Kerberos 4',
+ krb5 => 'Kerberos 5',
+ loc => 'Local',
+ );
+ return %lt;
+}
+
+sub context_names {
+ my %context_title = &Apache::lonlocal::texthash(
+ author => 'Creating users when an Author',
+ course => 'Creating users when in a course',
+ domain => 'Creating users when a Domain Coordinator',
+ );
+ return %context_title;
+}
+
+sub print_usermodification {
+ my ($position,$dom,$settings,$rowtotal) = @_;
+ my $numinrow = 4;
+ my ($context,$datatable,$rowcount);
+ if ($position eq 'top') {
+ $rowcount = 0;
+ $context = 'author';
+ foreach my $role ('ca','aa') {
+ $datatable .= &modifiable_userdata_row($context,$role,$settings,
+ $numinrow,$rowcount);
+ $$rowtotal ++;
+ $rowcount ++;
+ }
+ } elsif ($position eq 'middle') {
+ $context = 'course';
+ $rowcount = 0;
+ foreach my $role ('st','ep','ta','in','cr') {
+ $datatable .= &modifiable_userdata_row($context,$role,$settings,
+ $numinrow,$rowcount);
+ $$rowtotal ++;
+ $rowcount ++;
+ }
+ } elsif ($position eq 'bottom') {
+ $context = 'selfcreate';
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
+ $usertypes->{'default'} = $othertitle;
+ if (ref($types) eq 'ARRAY') {
+ push(@{$types},'default');
+ $usertypes->{'default'} = $othertitle;
+ foreach my $status (@{$types}) {
+ $datatable .= &modifiable_userdata_row($context,$status,$settings,
+ $numinrow,$rowcount,$usertypes);
+ $$rowtotal ++;
+ $rowcount ++;
+ }
+ }
+ }
+ return $datatable;
+}
+
+sub print_defaults {
+ my ($dom,$rowtotal) = @_;
+ my @items = ('auth_def','auth_arg_def','lang_def','timezone_def');
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
+ my $titles = &defaults_titles();
+ my $rownum = 0;
+ my ($datatable,$css_class);
+ foreach my $item (@items) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.$titles->{$item}.
+ ' ';
+ if ($item eq 'auth_def') {
+ my @authtypes = ('internal','krb4','krb5','localauth');
+ my %shortauth = (
+ internal => 'int',
+ krb4 => 'krb4',
+ krb5 => 'krb5',
+ localauth => 'loc'
+ );
+ my %authnames = &authtype_names();
+ foreach my $auth (@authtypes) {
+ my $checked = ' ';
+ if ($domdefaults{$item} eq $auth) {
+ $checked = ' checked="checked" ';
+ }
+ $datatable .= ' ';
+ $rownum ++;
+ }
+ $$rowtotal += $rownum;
+ return $datatable;
+}
+
+sub defaults_titles {
+ my %titles = &Apache::lonlocal::texthash (
+ 'auth_def' => 'Default authentication type',
+ 'auth_arg_def' => 'Default authentication argument',
+ 'lang_def' => 'Default language',
+ 'timezone_def' => 'Default timezone',
+ );
+ return (\%titles);
+}
+
+sub print_scantronformat {
+ my ($r,$dom,$confname,$settings,$rowtotal) = @_;
+ my $itemcount = 1;
+ my ($datatable,$css_class,$scantronurl,$is_custom,%error,%scantronurls,
+ %confhash);
+ my $switchserver = &check_switchserver($dom,$confname);
+ my %lt = &Apache::lonlocal::texthash (
+ default => 'Default scantron format file error',
+ custom => 'Custom scantron format file error',
+ );
+ my %scantronfiles = (
+ default => 'default.tab',
+ custom => 'custom.tab',
+ );
+ foreach my $key (keys(%scantronfiles)) {
+ $scantronurls{$key} = '/res/'.$dom.'/'.$confname.'/scantron/'
+ .$scantronfiles{$key};
+ }
+ my @defaultinfo = &Apache::lonnet::stat_file($scantronurls{'default'});
+ if ((!@defaultinfo) || ($defaultinfo[0] eq 'no_such_dir')) {
+ if (!$switchserver) {
+ my $servadm = $r->dir_config('lonAdmEMail');
+ my ($configuserok,$author_ok) = &config_check($dom,$confname,$servadm);
+ if ($configuserok eq 'ok') {
+ if ($author_ok eq 'ok') {
+ my %legacyfile = (
+ default => $Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab',
+ custom => $Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab',
+ );
+ my %md5chk;
+ foreach my $type (keys(%legacyfile)) {
+ ($md5chk{$type}) = split(/ /,`md5sum $legacyfile{$type}`);
+ chomp($md5chk{$type});
+ }
+ if ($md5chk{'default'} ne $md5chk{'custom'}) {
+ foreach my $type (keys(%legacyfile)) {
+ ($scantronurls{$type},my $error) =
+ &legacy_scantronformat($r,$dom,$confname,
+ $type,$legacyfile{$type},
+ $scantronurls{$type},
+ $scantronfiles{$type});
+ if ($error ne '') {
+ $error{$type} = $error;
+ }
+ }
+ if (keys(%error) == 0) {
+ $is_custom = 1;
+ $confhash{'scantron'}{'scantronformat'} =
+ $scantronurls{'custom'};
+ my $putresult =
+ &Apache::lonnet::put_dom('configuration',
+ \%confhash,$dom);
+ if ($putresult ne 'ok') {
+ $error{'custom'} =
+ ''.
+ &mt('An error occurred updating the domain configuration: [_1]',$putresult).' ';
+ }
+ }
+ } else {
+ ($scantronurls{'default'},my $error) =
+ &legacy_scantronformat($r,$dom,$confname,
+ 'default',$legacyfile{'default'},
+ $scantronurls{'default'},
+ $scantronfiles{'default'});
+ if ($error eq '') {
+ $confhash{'scantron'}{'scantronformat'} = '';
+ my $putresult =
+ &Apache::lonnet::put_dom('configuration',
+ \%confhash,$dom);
+ if ($putresult ne 'ok') {
+ $error{'default'} =
+ ''.
+ &mt('An error occurred updating the domain configuration: [_1]',$putresult).' ';
+ }
+ } else {
+ $error{'default'} = $error;
+ }
+ }
+ }
+ }
+ } else {
+ $error{'default'} = &mt("Unable to copy default scantron formatfile to domain's RES space: [_1]",$switchserver);
+ }
+ }
+ if (ref($settings) eq 'HASH') {
+ if ($settings->{'scantronformat'} eq "/res/$dom/$confname/scantron/custom.tab") {
+ my @info = &Apache::lonnet::stat_file($settings->{'scantronformat'});
+ if ((!@info) || ($info[0] eq 'no_such_dir')) {
+ $scantronurl = '';
+ } else {
+ $scantronurl = $settings->{'scantronformat'};
+ }
+ $is_custom = 1;
+ } else {
+ $scantronurl = $scantronurls{'default'};
+ }
+ } else {
+ if ($is_custom) {
+ $scantronurl = $scantronurls{'custom'};
+ } else {
+ $scantronurl = $scantronurls{'default'};
+ }
+ }
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ $datatable .= '';
+ if (!$is_custom) {
+ $datatable .= ''.&mt('Default in use:').'';
+ if ($scantronurl) {
+ $datatable .= ''.
+ &mt('Default scantron format file').' ';
+ } else {
+ $datatable = &mt('File unavailable for display');
+ }
+ $datatable .= ' ';
+ if (keys(%error) == 0) {
+ $datatable .= '';
+ if (!$switchserver) {
+ $datatable .= &mt('Upload:').' '.$errorstr;
+ }
+ } else {
+ if (keys(%error) > 0) {
+ my $errorstr;
+ foreach my $key (sort(keys(%error))) {
+ $errorstr .= $lt{$key}.': '.$error{$key}.' '.$errorstr.' ';
+ } elsif ($scantronurl) {
+ $datatable .= ' '.
+ ''.
+ &mt('Custom scantron format file').' '.
+ ' '.
+ &mt('Replace:').' '.
+ ' ';
+ }
+ }
+ $datatable .= ''.
+ ''.$title{'togglecats'}.' '.
+ ''.
+ ' '.
+ ' '.
+ ''.$title{'categorize'}.' '.
+ ''.
+ ' ';
+ $$rowtotal += 2;
+ } else {
+ my $css_class;
+ my $itemcount = 1;
+ my $cathash;
+ if (ref($settings) eq 'HASH') {
+ $cathash = $settings->{'cats'};
+ }
+ if (ref($cathash) eq 'HASH') {
+ my (@cats,@trails,%allitems,%idx,@jsarray);
+ &Apache::loncommon::extract_categories($cathash,\@cats,\@trails,
+ \%allitems,\%idx,\@jsarray);
+ my $maxdepth = scalar(@cats);
+ my $colattrib = '';
+ if ($maxdepth > 2) {
+ $colattrib = ' colspan="2" ';
+ }
+ my @path;
+ if (@cats > 0) {
+ if (ref($cats[0]) eq 'ARRAY') {
+ my $numtop = @{$cats[0]};
+ my $maxnum = $numtop;
+ if ((!grep(/^instcode$/,@{$cats[0]})) || ($cathash->{'instcode::0'} eq '')) {
+ $maxnum ++;
+ }
+ my $lastidx;
+ for (my $i=0; $i<$numtop; $i++) {
+ my $parent = $cats[0][$i];
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ my $item = &escape($parent).'::0';
+ my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','$item','$idx{$item}'".');"';
+ $lastidx = $idx{$item};
+ $datatable .= ''
+ .'';
+ for (my $k=0; $k<=$maxnum; $k++) {
+ my $vpos = $k+1;
+ my $selstr;
+ if ($k == $i) {
+ $selstr = ' selected="selected" ';
+ }
+ $datatable .= ''.$vpos.' ';
+ }
+ $datatable .= ' ';
+ if ($parent eq 'instcode') {
+ $datatable .= ''.&mt('Official courses')
+ .' ('
+ .&mt('with institutional codes').') '
+ .'';
+ for (my $k=0; $k<=$maxnum; $k++) {
+ my $vpos = $k+1;
+ my $selstr;
+ if ($k == $numtop) {
+ $selstr = ' selected="selected" ';
+ }
+ $datatable .= ''.$vpos.' ';
+ }
+ $datatable .= ' '.&mt('Add category:').' '
+ .' '
+ .''.
+ '';
+ for (my $k=0; $k<=$maxnum; $k++) {
+ my $vpos = $k+1;
+ my $selstr;
+ if ($k == $maxnum) {
+ $selstr = ' selected="selected" ';
+ }
+ $datatable .= ''.$vpos.' ';
+ }
+ $datatable .= ' '
+ .&mt('Official courses').' '.'('
+ .&mt('with institutional codes').') '.$hdritem->{'header'}->[0]->{'col2'}.' '
+ .&initialize_categories($itemcount);
+ }
+ $$rowtotal += $itemcount;
+ }
+ return $datatable;
+}
+
+sub coursecategories_javascript {
+ my ($settings) = @_;
+ my ($output,$jstext,$cathash);
+ if (ref($settings) eq 'HASH') {
+ $cathash = $settings->{'cats'};
+ }
+ if (ref($cathash) eq 'HASH') {
+ my (@cats,@jsarray,%idx);
+ &Apache::loncommon::gather_categories($cathash,\@cats,\%idx,\@jsarray);
+ if (@jsarray > 0) {
+ $jstext = ' var categories = Array('.scalar(@jsarray).');'."\n";
+ for (my $i=0; $i<@jsarray; $i++) {
+ if (ref($jsarray[$i]) eq 'ARRAY') {
+ my $catstr = join('","',@{$jsarray[$i]});
+ $jstext .= ' categories['.$i.'] = Array("'.$catstr.'");'."\n";
+ }
+ }
+ }
+ } else {
+ $jstext = ' var categories = Array(1);'."\n".
+ ' categories[0] = Array("instcode_pos");'."\n";
+ }
+ $output = <<"ENDSCRIPT";
+
+
+ENDSCRIPT
+ return $output;
+}
+
+sub initialize_categories {
+ my ($itemcount) = @_;
+ my $datatable;
+ my $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','instcode_pos','0'".');"';
+
+ $datatable = ''
+ .'1 '
+ .'2 '
+ .''
+ .' '
+ .'1 '
+ .'2 '.&mt('Name:')
+ .' ';
+ my ($idxnum,$parent_name,$parent_item);
+ my $higher = $depth - 1;
+ if ($higher == 0) {
+ $parent_name = &escape($parent).'::'.$higher;
+ } else {
+ if (ref($path) eq 'ARRAY') {
+ $parent_name = &escape($parent).':'.&escape($path->[-2]).':'.$higher;
+ }
+ }
+ $parent_item = 'addcategory_pos_'.$parent_name;
+ for (my $j=0; $j<=$numchildren; $j++) {
+ if ($j < $numchildren) {
+ $name = $cats->[$depth]{$parent}[$j];
+ $item = &escape($name).':'.&escape($parent).':'.$depth;
+ $idxnum = $idx->{$item};
+ } else {
+ $name = $parent_name;
+ $item = $parent_item;
+ }
+ $chgstr = ' onchange="javascript:reorderCats(this.form,'."'$parent_name','$item','$idxnum'".');"';
+ $text .= '';
+ for (my $i=0; $i<=$numchildren; $i++) {
+ my $vpos = $i+1;
+ my $selstr;
+ if ($j == $i) {
+ $selstr = ' selected="selected" ';
+ }
+ $text .= ''.$vpos.' ';
+ }
+ $text .= ' ';
+ if ($j < $numchildren) {
+ my $deeper = $depth+1;
+ $text .= $name.' '
+ .'';
+ if(ref($path) eq 'ARRAY') {
+ push(@{$path},$name);
+ $text .= &build_category_rows($itemcount,$cats,$deeper,$name,$path,$idx);
+ pop(@{$path});
+ }
+ } else {
+ $text .= &mt('Add subcategory:').'
'.&mt('Add subcategory:').' ';
+ }
+ }
+ }
+ }
+ return $text;
+}
+
+sub modifiable_userdata_row {
+ my ($context,$role,$settings,$numinrow,$rowcount,$usertypes) = @_;
+ my $rolename;
+ if ($context eq 'selfcreate') {
+ if (ref($usertypes) eq 'HASH') {
+ $rolename = $usertypes->{$role};
+ } else {
+ $rolename = $role;
+ }
+ } else {
+ if ($role eq 'cr') {
+ $rolename = &mt('Custom role');
+ } else {
+ $rolename = &Apache::lonnet::plaintext($role);
+ }
+ }
+ my @fields = ('lastname','firstname','middlename','generation',
+ 'permanentemail','id');
+ my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
+ my $output;
+ my $css_class = $rowcount%2?' class="LC_odd_row"':'';
+ $output = ''.
+ ''.$rolename.' ';
+ return $output;
+}
+
+sub users_cansearch_row {
+ my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_;
+ my $output = ''.
+ ''.&mt('Users allowed to search').' ('.$dom.')'.
+ ' ';
+ return $output;
+}
+
+sub sorted_searchtitles {
+ my %searchtitles = &Apache::lonlocal::texthash(
+ 'uname' => 'username',
+ 'lastname' => 'last name',
+ 'lastfirst' => 'last name, first name',
+ );
+ my @titleorder = ('uname','lastname','lastfirst');
+ return (\%searchtitles,\@titleorder);
+}
+
+sub sorted_searchtypes {
+ my %srchtypes_desc = (
+ exact => 'is exact match',
+ contains => 'contains ..',
+ begins => 'begins with ..',
+ );
+ my @srchtypeorder = ('exact','begins','contains');
+ return (\%srchtypes_desc,\@srchtypeorder);
+}
+
sub usertype_update_row {
my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_;
my $datatable;
@@ -886,10 +2562,12 @@ sub usertype_update_row {
$datatable .= '';
}
my $check = ' ';
- if (ref($settings->{'fields'}) eq 'HASH') {
- if (ref($settings->{'fields'}{$type}) eq 'ARRAY') {
- if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) {
- $check = ' checked="checked" ';
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{'fields'}) eq 'HASH') {
+ if (ref($settings->{'fields'}{$type}) eq 'ARRAY') {
+ if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) {
+ $check = ' checked="checked" ';
+ }
}
}
}
@@ -919,13 +2597,18 @@ sub modify_login {
my ($r,$dom,$confname,%domconfig) = @_;
my ($resulttext,$errors,$colchgtext,%changes,%colchanges);
my %title = ( coursecatalog => 'Display course catalog',
- adminmail => 'Display administrator E-mail address');
+ adminmail => 'Display administrator E-mail address',
+ newuser => 'Link for visitors to create a user account',
+ loginheader => 'Log-in box header');
my @offon = ('off','on');
my %loginhash;
($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
\%domconfig,\%loginhash);
- $loginhash{login}{coursecatalog} = $env{'form.coursecatalog'};
- $loginhash{login}{adminmail} = $env{'form.adminmail'};
+ my @toggles = ('coursecatalog','adminmail','newuser');
+ foreach my $item (@toggles) {
+ $loginhash{login}{$item} = $env{'form.'.$item};
+ }
+ $loginhash{login}{loginheader} = $env{'form.loginheader'};
if (ref($colchanges{'login'}) eq 'HASH') {
$colchgtext = &display_colorchgs($dom,\%colchanges,['login'],
\%loginhash);
@@ -933,26 +2616,52 @@ sub modify_login {
my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash,
$dom);
if ($putresult eq 'ok') {
- if (($domconfig{'login'}{'coursecatalog'} eq '0') &&
- ($env{'form.coursecatalog'} eq '1')) {
- $changes{'coursecatalog'} = 1;
- } elsif (($domconfig{'login'}{'coursecatalog'} eq '' ||
- $domconfig{'login'}{'coursecatalog'} eq '1') &&
- ($env{'form.coursecatalog'} eq '0')) {
- $changes{'coursecatalog'} = 1;
- }
- if (($domconfig{'login'}{'adminmail'} eq '1') &&
- ($env{'form.adminmail'} eq '0')) {
- $changes{'adminmail'} = 1;
- } elsif (($domconfig{'login'}{'adminmail'} eq '' ||
- $domconfig{'login'}{'adminmail'} eq '0') &&
- ($env{'form.adminmail'} eq '1')) {
- $changes{'adminmail'} = 1;
+ my @toggles = ('coursecatalog','adminmail','newuser');
+ my %defaultchecked = (
+ 'coursecatalog' => 'on',
+ 'adminmail' => 'off',
+ 'newuser' => 'off',
+ );
+ if (ref($domconfig{'login'}) eq 'HASH') {
+ foreach my $item (@toggles) {
+ if ($defaultchecked{$item} eq 'on') {
+ if (($domconfig{'login'}{$item} eq '0') &&
+ ($env{'form.'.$item} eq '1')) {
+ $changes{$item} = 1;
+ } elsif (($domconfig{'login'}{$item} eq '' ||
+ $domconfig{'login'}{$item} eq '1') &&
+ ($env{'form.'.$item} eq '0')) {
+ $changes{$item} = 1;
+ }
+ } elsif ($defaultchecked{$item} eq 'off') {
+ if (($domconfig{'login'}{$item} eq '1') &&
+ ($env{'form.'.$item} eq '0')) {
+ $changes{$item} = 1;
+ } elsif (($domconfig{'login'}{$item} eq '' ||
+ $domconfig{'login'}{$item} eq '0') &&
+ ($env{'form.'.$item} eq '1')) {
+ $changes{$item} = 1;
+ }
+ }
+ }
+ if (($domconfig{'login'}{'loginheader'} eq 'text') &&
+ ($env{'form.loginheader'} eq 'image')) {
+ $changes{'loginheader'} = 1;
+ } elsif (($domconfig{'login'}{'loginheader'} eq '' ||
+ $domconfig{'login'}{'loginheader'} eq 'image') &&
+ ($env{'form.loginheader'} eq 'text')) {
+ $changes{'loginheader'} = 1;
+ }
}
if (keys(%changes) > 0 || $colchgtext) {
+ &Apache::loncommon::devalidate_domconfig_cache($dom);
$resulttext = &mt('Changes made:').'';
foreach my $item (sort(keys(%changes))) {
- $resulttext .= ''.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").' ';
+ if ($item eq 'loginheader') {
+ $resulttext .= ''.&mt("$title{$item} set to $env{'form.loginheader'}").' ';
+ } else {
+ $resulttext .= ''.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").' ';
+ }
}
$resulttext .= $colchgtext.' ';
} else {
@@ -975,6 +2684,7 @@ sub color_font_choices {
img => "Header",
bgs => "Background colors",
links => "Link colors",
+ images => "Images",
font => "Font color",
pgbg => "Page",
tabbg => "Header",
@@ -990,12 +2700,18 @@ sub modify_rolecolors {
my ($r,$dom,$confname,$roles,%domconfig) = @_;
my ($resulttext,%rolehash);
$rolehash{'rolecolors'} = {};
+ if (ref($domconfig{'rolecolors'}) ne 'HASH') {
+ if ($domconfig{'rolecolors'} eq '') {
+ $domconfig{'rolecolors'} = {};
+ }
+ }
my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles,
$domconfig{'rolecolors'},$rolehash{'rolecolors'});
my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash,
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
+ &Apache::loncommon::devalidate_domconfig_cache($dom);
$resulttext = &display_colorchgs($dom,\%changes,$roles,
$rolehash{'rolecolors'});
} else {
@@ -1015,38 +2731,46 @@ sub modify_rolecolors {
sub modify_colors {
my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;
my (%changes,%choices);
- my @bgs = ('pgbg','mainbg','sidebg');
+ my @bgs;
my @links = ('link','alink','vlink');
+ my @logintext;
my @images;
my $servadm = $r->dir_config('lonAdmEMail');
my $errors;
foreach my $role (@{$roles}) {
if ($role eq 'login') {
%choices = &login_choices();
+ @logintext = ('textcol','bgcol');
} else {
%choices = &color_font_choices();
}
if ($role eq 'login') {
- @images = ('img','logo','domlogo');
+ @images = ('img','logo','domlogo','login');
+ @bgs = ('pgbg','mainbg','sidebg');
} else {
@images = ('img');
+ @bgs = ('pgbg','tabbg','sidebg');
}
$confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};
- foreach my $item (@bgs,@links) {
+ foreach my $item (@bgs,@links,@logintext) {
$confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
}
- my ($configuserok,$author_ok,$switchserver,%currroles);
- my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);
- ($configuserok,%currroles) = &check_configuser($uhome,$dom,
- $confname,$servadm);
- if ($configuserok eq 'ok') {
- $switchserver = &check_switchserver($dom,$confname);
- if ($switchserver eq '') {
- $author_ok = &check_authorstatus($dom,$confname,%currroles);
- }
- }
+ my ($configuserok,$author_ok,$switchserver) =
+ &config_check($dom,$confname,$servadm);
my ($width,$height) = &thumb_dimensions();
+ if (ref($domconfig->{$role}) ne 'HASH') {
+ $domconfig->{$role} = {};
+ }
foreach my $img (@images) {
+ if ( ! $env{'form.'.$role.'_'.$img.'.filename'}
+ && !defined($domconfig->{$role}{$img})
+ && !$env{'form.'.$role.'_del_'.$img}
+ && $env{'form.'.$role.'_import_'.$img}) {
+ # import the old configured image from the .tab setting
+ # if they haven't provided a new one
+ $domconfig->{$role}{$img} =
+ $env{'form.'.$role.'_import_'.$img};
+ }
if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') {
my $error;
if ($configuserok eq 'ok') {
@@ -1064,11 +2788,11 @@ sub modify_colors {
$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);
}
} else {
- $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);
+ $error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$author_ok);
}
}
} else {
- $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);
+ $error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$configuserok);
}
if ($error) {
&Apache::lonnet::logthis($error);
@@ -1086,6 +2810,7 @@ sub modify_colors {
$dom,$confname,$img,$width,$height);
if ($result eq 'ok') {
$confhash->{$role}{$img} = $logourl;
+ $changes{$role}{'images'}{$img} = 1;
}
}
}
@@ -1143,20 +2868,46 @@ sub modify_colors {
}
}
}
+ foreach my $item (@logintext) {
+ if ($domconfig->{$role}{$item} ne '') {
+ if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
+ $changes{$role}{'logintext'}{$item} = 1;
+ }
+ } else {
+ if ($confhash->{$role}{$item}) {
+ $changes{$role}{'logintext'}{$item} = 1;
+ }
+ }
+ }
} else {
&default_change_checker($role,\@images,\@links,\@bgs,
- $confhash,\%changes);
+ \@logintext,$confhash,\%changes);
}
} else {
&default_change_checker($role,\@images,\@links,\@bgs,
- $confhash,\%changes);
+ \@logintext,$confhash,\%changes);
}
}
return ($errors,%changes);
}
+sub config_check {
+ my ($dom,$confname,$servadm) = @_;
+ my ($configuserok,$author_ok,$switchserver,%currroles);
+ my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);
+ ($configuserok,%currroles) = &check_configuser($uhome,$dom,
+ $confname,$servadm);
+ if ($configuserok eq 'ok') {
+ $switchserver = &check_switchserver($dom,$confname);
+ if ($switchserver eq '') {
+ $author_ok = &check_authorstatus($dom,$confname,%currroles);
+ }
+ }
+ return ($configuserok,$author_ok,$switchserver);
+}
+
sub default_change_checker {
- my ($role,$images,$links,$bgs,$confhash,$changes) = @_;
+ my ($role,$images,$links,$bgs,$logintext,$confhash,$changes) = @_;
foreach my $item (@{$links}) {
if ($confhash->{$role}{$item}) {
$changes->{$role}{'links'}{$item} = 1;
@@ -1167,6 +2918,11 @@ sub default_change_checker {
$changes->{$role}{'bgs'}{$item} = 1;
}
}
+ foreach my $item (@{$logintext}) {
+ if ($confhash->{$role}{$item}) {
+ $changes->{$role}{'logintext'}{$item} = 1;
+ }
+ }
foreach my $img (@{$images}) {
if ($env{'form.'.$role.'_del_'.$img}) {
$confhash->{$role}{$img} = '';
@@ -1176,12 +2932,11 @@ sub default_change_checker {
if ($confhash->{$role}{'font'}) {
$changes->{$role}{'font'} = 1;
}
-}
+}
sub display_colorchgs {
my ($dom,$changes,$roles,$confhash) = @_;
my (%choices,$resulttext);
- &Apache::loncommon::devalidate_domconfig_cache($dom);
if (!grep(/^login$/,@{$roles})) {
$resulttext = &mt('Changes made:').';
+ if (!close(PIPE)) {
+ &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");
+ }
+ chomp($imageinfo);
+ my ($fullsize) =
+ ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);
+ if ($fullsize) {
+ ($fullwidth,$fullheight) = split(/x/,$fullsize);
+ }
+ }
+ }
+ return ($fullwidth,$fullheight);
+}
+
sub check_configuser {
my ($uhome,$dom,$confname,$servadm) = @_;
my ($configuserok,%currroles);
@@ -1262,7 +3037,7 @@ sub check_authorstatus {
my $end = 0;
$author_ok =
&Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/',
- 'au',$end,$start);
+ 'au',$end,$start,'','','domconfig');
} else {
$author_ok = 'ok';
}
@@ -1270,7 +3045,7 @@ sub check_authorstatus {
}
sub publishlogo {
- my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight) = @_;
+ my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight,$savefileas) = @_;
my ($output,$fname,$logourl);
if ($action eq 'upload') {
$fname=$env{'form.'.$formname.'.filename'};
@@ -1278,6 +3053,9 @@ sub publishlogo {
} else {
($fname) = ($formname =~ /([^\/]+)$/);
}
+ if ($savefileas ne '') {
+ $fname = $savefileas;
+ }
$fname=&Apache::lonnet::clean_filename($fname);
# See if there is anything left
unless ($fname) { return ('error: no uploaded file'); }
@@ -1305,7 +3083,7 @@ sub publishlogo {
!defined(&Apache::loncommon::fileembstyle($1))) {
$output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
} elsif ($file=~/\.(\d+)\.(\w+)$/) {
- $output = &mt('File name not allowed a rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
+ $output = &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
} elsif (-d "$filepath/$file") {
$output = &mt('File name is a directory name - rename the file and re-upload');
} else {
@@ -1369,17 +3147,23 @@ $env{'user.name'}.':'.$env{'user.domain'
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
my $inputfile = $filepath.'/'.$file;
my $outfile = $filepath.'/'.'tn-'.$file;
- my $thumbsize = $thumbwidth.'x'.$thumbheight;
- system("convert -sample $thumbsize $inputfile $outfile");
- chmod(0660, $filepath.'/tn-'.$file);
- if (-e $outfile) {
- my $copyfile=$targetdir.'/tn-'.$file;
- if (copy($outfile,$copyfile)) {
- print $logfile "\nCopied source to ".$copyfile."\n";
- &write_metadata($dom,$confname,$formname,$targetdir,
- 'tn-'.$file,$logfile);
- } else {
- print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
+ my ($fullwidth,$fullheight) = &check_dimensions($inputfile);
+ if ($fullwidth ne '' && $fullheight ne '') {
+ if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
+ my $thumbsize = $thumbwidth.'x'.$thumbheight;
+ system("convert -sample $thumbsize $inputfile $outfile");
+ chmod(0660, $filepath.'/tn-'.$file);
+ if (-e $outfile) {
+ my $copyfile=$targetdir.'/tn-'.$file;
+ if (copy($outfile,$copyfile)) {
+ print $logfile "\nCopied source to ".$copyfile."\n";
+ &write_metadata($dom,$confname,$formname,
+ $targetdir,'tn-'.$file,$logfile);
+ } else {
+ print $logfile "\nUnable to write ".$copyfile.
+ ':'.$!."\n";
+ }
+ }
}
}
}
@@ -1480,11 +3264,22 @@ sub check_switchserver {
return $switchserver;
}
+sub javascript_set_colnums {
+ return < 1100) {
+ document.pickactions.numcols[1].checked = true;
+ } else {
+ document.pickactions.numcols[0].checked = true;
+ }
+}
+END
+}
+
sub modify_quotas {
my ($dom,%domconfig) = @_;
my ($resulttext,%changes);
- my ($usertypes,$order) =
- &Apache::lonnet::retrieve_inst_usertypes($dom);
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
my %formhash;
foreach my $key (keys(%env)) {
if ($key =~ /^form\.quota_(.+)$/) {
@@ -1505,7 +3300,11 @@ sub modify_quotas {
}
foreach my $key (keys(%formhash)) {
if ($formhash{$key} ne '') {
- if (!exists($domconfig{'quotas'}{$key})) {
+ if (ref($domconfig{'quotas'}) eq 'HASH') {
+ if (!exists($domconfig{'quotas'}{$key})) {
+ $changes{$key} = 1;
+ }
+ } else {
$changes{$key} = 1;
}
}
@@ -1518,8 +3317,14 @@ sub modify_quotas {
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'';
- foreach my $item (sort(keys(%changes))) {
- $resulttext .= ''.&mt('[_1] set to [_2] Mb',$usertypes->{$item},$formhash{$item}).' ';
+ foreach my $type (@{$types},'default') {
+ if (defined($changes{$type})) {
+ my $typetitle = $usertypes->{$type};
+ if ($type eq 'default') {
+ $typetitle = $othertitle;
+ }
+ $resulttext .= ''.&mt('[_1] set to [_2] Mb',$typetitle,$formhash{$type}).' ';
+ }
}
$resulttext .= ' ';
} else {
@@ -1545,10 +3350,17 @@ sub modify_autoenroll {
my %title = ( run => 'Auto-enrollment active',
sender => 'Sender for notification messages');
my @offon = ('off','on');
+ my $sender_uname = $env{'form.sender_uname'};
+ my $sender_domain = $env{'form.sender_domain'};
+ if ($sender_domain eq '') {
+ $sender_uname = '';
+ } elsif ($sender_uname eq '') {
+ $sender_domain = '';
+ }
my %autoenrollhash = (
autoenroll => { run => $env{'form.autoenroll_run'},
- sender_uname => $env{'form.sender_uname'},
- sender_domain => $env{'form.sender_domain'},
+ sender_uname => $sender_uname,
+ sender_domain => $sender_domain,
}
);
@@ -1561,21 +3373,13 @@ sub modify_autoenroll {
}
} elsif ($autorun) {
if ($env{'form.autoenroll_run'} ne '1') {
- $changes{'run'} = 1;
+ $changes{'run'} = 1;
}
}
- if (exists($currautoenroll{sender_uname})) {
- if ($currautoenroll{'sender_uname'} ne $env{'form.sender_uname'}) {
- $changes{'sender'} = 1;
- }
- } else {
+ if ($currautoenroll{'sender_uname'} ne $sender_uname) {
$changes{'sender'} = 1;
}
- if (exists($currautoenroll{sender_domain})) {
- if ($currautoenroll{'sender_domain'} ne $env{'form.sender_domain'}) {
- $changes{'sender'} = 1;
- }
- } else {
+ if ($currautoenroll{'sender_domain'} ne $sender_domain) {
$changes{'sender'} = 1;
}
if (keys(%changes) > 0) {
@@ -1584,7 +3388,11 @@ sub modify_autoenroll {
$resulttext .= ''.&mt("$title{'run'} set to $offon[$env{'form.autoenroll_run'}]").' ';
}
if ($changes{'sender'}) {
- $resulttext .= ''.&mt("$title{'sender'} set to [_1]",$env{'form.sender_uname'}.':'.$env{'form.sender_domain'}).' ';
+ if ($sender_uname eq '' || $sender_domain eq '') {
+ $resulttext .= ''.&mt("$title{'sender'} set to default (course owner).").' ';
+ } else {
+ $resulttext .= ''.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).' ';
+ }
}
$resulttext .= '';
} else {
@@ -1610,10 +3418,10 @@ sub modify_autoupdate {
run => 'Auto-update:',
classlists => 'Updates to user information in classlists?'
);
- my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
my %fieldtitles = &Apache::lonlocal::texthash (
id => 'Student/Employee ID',
- email => 'E-mail address',
+ permanentemail => 'E-mail address',
lastname => 'Last Name',
firstname => 'First Name',
middlename => 'Middle Name',
@@ -1621,7 +3429,7 @@ sub modify_autoupdate {
);
my $othertitle = &mt('All users');
if (keys(%{$usertypes}) > 0) {
- $othertitle = "Other users";
+ $othertitle = &mt('Other users');
}
foreach my $key (keys(%env)) {
if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) {
@@ -1643,14 +3451,14 @@ sub modify_autoupdate {
}
} elsif ($key eq 'fields') {
if (ref($currautoupdate{$key}) eq 'HASH') {
- foreach my $item (keys(%{$currautoupdate{$key}})) {
+ foreach my $item (@{$types},'default') {
if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') {
my $change = 0;
foreach my $type (@{$currautoupdate{$key}{$item}}) {
if (!exists($fields{$item})) {
$change = 1;
} elsif (ref($fields{$item}) eq 'ARRAY') {
- if (!grep/^\Q$type\E$/,@{$fields{$item}}) {
+ if (!grep(/^\Q$type\E$/,@{$fields{$item}})) {
$change = 1;
}
}
@@ -1658,18 +3466,20 @@ sub modify_autoupdate {
if ($change) {
push(@{$changes{$key}},$item);
}
- }
+ }
}
}
}
}
- foreach my $key (keys(%fields)) {
- if (ref($currautoupdate{'fields'}) eq 'HASH') {
- if (!exists($currautoupdate{'fields'}{$key})) {
- push(@{$changes{'fields'}},$key);
+ foreach my $item (@{$types},'default') {
+ if (defined($fields{$item})) {
+ if (ref($currautoupdate{'fields'}) eq 'HASH') {
+ if (!exists($currautoupdate{'fields'}{$item})) {
+ push(@{$changes{'fields'}},$item);
+ }
+ } else {
+ push(@{$changes{'fields'}},$item);
}
- } else {
- push(@{$changes{'fields'}},$key);
}
}
my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash,
@@ -1691,9 +3501,9 @@ sub modify_autoupdate {
$newvaluestr = &mt('none');
}
if ($item eq 'default') {
- $resulttext .= ''.&mt("Updates for $othertitle set to: [_1]",$newvaluestr).' ';
+ $resulttext .= ''.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).' ';
} else {
- $resulttext .= ''.&mt("Updates for [_1] set to: [_2]",$usertypes->{$item},$newvaluestr).' ';
+ $resulttext .= ''.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).' ';
}
}
} else {
@@ -1717,5 +3527,1121 @@ sub modify_autoupdate {
return $resulttext;
}
-1;
+sub modify_directorysrch {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%changes);
+ my %currdirsrch;
+ if (ref($domconfig{'directorysrch'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'directorysrch'}})) {
+ $currdirsrch{$key} = $domconfig{'directorysrch'}{$key};
+ }
+ }
+ my %title = ( available => 'Directory search available',
+ localonly => 'Other domains can search',
+ searchby => 'Search types',
+ searchtypes => 'Search latitude');
+ my @offon = ('off','on');
+ my @otherdoms = ('Yes','No');
+
+ my @searchtypes = &Apache::loncommon::get_env_multiple('form.searchtypes');
+ my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch');
+ my @searchby = &Apache::loncommon::get_env_multiple('form.searchby');
+
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
+ if (keys(%{$usertypes}) == 0) {
+ @cansearch = ('default');
+ } else {
+ if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') {
+ foreach my $type (@{$currdirsrch{'cansearch'}}) {
+ if (!grep(/^\Q$type\E$/,@cansearch)) {
+ push(@{$changes{'cansearch'}},$type);
+ }
+ }
+ foreach my $type (@cansearch) {
+ if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) {
+ push(@{$changes{'cansearch'}},$type);
+ }
+ }
+ } else {
+ push(@{$changes{'cansearch'}},@cansearch);
+ }
+ }
+
+ if (ref($currdirsrch{'searchby'}) eq 'ARRAY') {
+ foreach my $by (@{$currdirsrch{'searchby'}}) {
+ if (!grep(/^\Q$by\E$/,@searchby)) {
+ push(@{$changes{'searchby'}},$by);
+ }
+ }
+ foreach my $by (@searchby) {
+ if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) {
+ push(@{$changes{'searchby'}},$by);
+ }
+ }
+ } else {
+ push(@{$changes{'searchby'}},@searchby);
+ }
+
+ if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') {
+ foreach my $type (@{$currdirsrch{'searchtypes'}}) {
+ if (!grep(/^\Q$type\E$/,@searchtypes)) {
+ push(@{$changes{'searchtypes'}},$type);
+ }
+ }
+ foreach my $type (@searchtypes) {
+ if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) {
+ push(@{$changes{'searchtypes'}},$type);
+ }
+ }
+ } else {
+ if (exists($currdirsrch{'searchtypes'})) {
+ foreach my $type (@searchtypes) {
+ if ($type ne $currdirsrch{'searchtypes'}) {
+ push(@{$changes{'searchtypes'}},$type);
+ }
+ }
+ if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) {
+ push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'});
+ }
+ } else {
+ push(@{$changes{'searchtypes'}},@searchtypes);
+ }
+ }
+
+ my %dirsrch_hash = (
+ directorysrch => { available => $env{'form.dirsrch_available'},
+ cansearch => \@cansearch,
+ localonly => $env{'form.dirsrch_localonly'},
+ searchby => \@searchby,
+ searchtypes => \@searchtypes,
+ }
+ );
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (exists($currdirsrch{'available'})) {
+ if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) {
+ $changes{'available'} = 1;
+ }
+ } else {
+ if ($env{'form.dirsrch_available'} eq '1') {
+ $changes{'available'} = 1;
+ }
+ }
+ if (exists($currdirsrch{'localonly'})) {
+ if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) {
+ $changes{'localonly'} = 1;
+ }
+ } else {
+ if ($env{'form.dirsrch_localonly'} eq '1') {
+ $changes{'localonly'} = 1;
+ }
+ }
+ if (keys(%changes) > 0) {
+ $resulttext = &mt('Changes made:').'';
+ if ($changes{'available'}) {
+ $resulttext .= ''.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").' ';
+ }
+ if ($changes{'localonly'}) {
+ $resulttext .= ''.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").' ';
+ }
+
+ if (ref($changes{'cansearch'}) eq 'ARRAY') {
+ my $chgtext;
+ if (ref($usertypes) eq 'HASH') {
+ if (keys(%{$usertypes}) > 0) {
+ foreach my $type (@{$types}) {
+ if (grep(/^\Q$type\E$/,@cansearch)) {
+ $chgtext .= $usertypes->{$type}.'; ';
+ }
+ }
+ if (grep(/^default$/,@cansearch)) {
+ $chgtext .= $othertitle;
+ } else {
+ $chgtext =~ s/\; $//;
+ }
+ $resulttext .= ''.&mt("Users from domain '[_1] ' permitted to search the institutional directory set to: [_2]",$dom,$chgtext).' ';
+ }
+ }
+ }
+ if (ref($changes{'searchby'}) eq 'ARRAY') {
+ my ($searchtitles,$titleorder) = &sorted_searchtitles();
+ my $chgtext;
+ foreach my $type (@{$titleorder}) {
+ if (grep(/^\Q$type\E$/,@searchby)) {
+ if (defined($searchtitles->{$type})) {
+ $chgtext .= $searchtitles->{$type}.'; ';
+ }
+ }
+ }
+ $chgtext =~ s/\; $//;
+ $resulttext .= ''.&mt("$title{'searchby'} set to: [_1]",$chgtext).' ';
+ }
+ if (ref($changes{'searchtypes'}) eq 'ARRAY') {
+ my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes();
+ my $chgtext;
+ foreach my $type (@{$srchtypeorder}) {
+ if (grep(/^\Q$type\E$/,@searchtypes)) {
+ if (defined($srchtypes_desc->{$type})) {
+ $chgtext .= $srchtypes_desc->{$type}.'; ';
+ }
+ }
+ }
+ $chgtext =~ s/\; $//;
+ $resulttext .= ''.&mt("$title{'searchtypes'} set to: \"[_1]\"",$chgtext).' ';
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to institution directory search settings');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ return $resulttext;
+}
+
+sub modify_contacts {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash);
+ if (ref($domconfig{'contacts'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'contacts'}})) {
+ $currsetting{$key} = $domconfig{'contacts'}{$key};
+ }
+ }
+ my (%others,%to);
+ my @contacts = ('supportemail','adminemail');
+ my @mailings = ('errormail','packagesmail','helpdeskmail');
+ foreach my $type (@mailings) {
+ @{$newsetting{$type}} =
+ &Apache::loncommon::get_env_multiple('form.'.$type);
+ foreach my $item (@contacts) {
+ if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) {
+ $contacts_hash{contacts}{$type}{$item} = 1;
+ } else {
+ $contacts_hash{contacts}{$type}{$item} = 0;
+ }
+ }
+ $others{$type} = $env{'form.'.$type.'_others'};
+ $contacts_hash{contacts}{$type}{'others'} = $others{$type};
+ }
+ foreach my $item (@contacts) {
+ $to{$item} = $env{'form.'.$item};
+ $contacts_hash{'contacts'}{$item} = $to{$item};
+ }
+ if (keys(%currsetting) > 0) {
+ foreach my $item (@contacts) {
+ if ($to{$item} ne $currsetting{$item}) {
+ $changes{$item} = 1;
+ }
+ }
+ foreach my $type (@mailings) {
+ foreach my $item (@contacts) {
+ if (ref($currsetting{$type}) eq 'HASH') {
+ if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) {
+ push(@{$changes{$type}},$item);
+ }
+ } else {
+ push(@{$changes{$type}},@{$newsetting{$type}});
+ }
+ }
+ if ($others{$type} ne $currsetting{$type}{'others'}) {
+ push(@{$changes{$type}},'others');
+ }
+ }
+ } else {
+ my %default;
+ $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
+ $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
+ $default{'errormail'} = 'adminemail';
+ $default{'packagesmail'} = 'adminemail';
+ $default{'helpdeskmail'} = 'supportemail';
+ foreach my $item (@contacts) {
+ if ($to{$item} ne $default{$item}) {
+ $changes{$item} = 1;
+ }
+ }
+ foreach my $type (@mailings) {
+ if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) {
+
+ push(@{$changes{$type}},@{$newsetting{$type}});
+ }
+ if ($others{$type} ne '') {
+ push(@{$changes{$type}},'others');
+ }
+ }
+ }
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ my ($titles,$short_titles) = &contact_titles();
+ $resulttext = &mt('Changes made:').'';
+ foreach my $item (@contacts) {
+ if ($changes{$item}) {
+ $resulttext .= ''.$titles->{$item}.
+ &mt(' set to: ').
+ ''.
+ $to{$item}.' ';
+ }
+ }
+ foreach my $type (@mailings) {
+ if (ref($changes{$type}) eq 'ARRAY') {
+ $resulttext .= ''.$titles->{$type}.': ';
+ my @text;
+ foreach my $item (@{$newsetting{$type}}) {
+ push(@text,$short_titles->{$item});
+ }
+ if ($others{$type} ne '') {
+ push(@text,$others{$type});
+ }
+ $resulttext .= ''.
+ join(', ',@text).' ';
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to contact information');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1].',$putresult).' ';
+ }
+ return $resulttext;
+}
+
+sub modify_usercreation {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate);
+ my $warningmsg;
+ if (ref($domconfig{'usercreation'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'usercreation'}})) {
+ $curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
+ }
+ }
+ my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule');
+ my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule');
+ my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');
+ my @contexts = ('author','course','selfcreate');
+ foreach my $item(@contexts) {
+ if ($item eq 'selfcreate') {
+ @{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item);
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
+ if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {
+ if (ref($cancreate{$item}) eq 'ARRAY') {
+ if (grep(/^login$/,@{$cancreate{$item}})) {
+ $warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.');
+ }
+ }
+ }
+ } else {
+ $cancreate{$item} = $env{'form.can_createuser_'.$item};
+ }
+ }
+ if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
+ foreach my $item (@contexts) {
+ if ($item eq 'selfcreate') {
+ if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
+ foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) {
+ if (!grep(/^$curr$/,@{$cancreate{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ } else {
+ if ($curr_usercreation{'cancreate'}{$item} eq '') {
+ if (@{$cancreate{$item}} > 0) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } else {
+ if ($curr_usercreation{'cancreate'}{$item} eq 'any') {
+ if (@{$cancreate{$item}} < 3) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif ($curr_usercreation{'cancreate'}{$item} eq 'none') {
+ if (@{$cancreate{$item}} > 0) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif (!grep(/^$curr_usercreation{'cancreate'}{$item}$/,@{$cancreate{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ foreach my $type (@{$cancreate{$item}}) {
+ if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
+ if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif (($curr_usercreation{'cancreate'}{$item} ne 'any') &&
+ ($curr_usercreation{'cancreate'}{$item} ne 'none')) {
+ if ($curr_usercreation{'cancreate'}{$item} ne $type) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ }
+ } else {
+ if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ } elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
+ foreach my $item (@contexts) {
+ if (!grep(/^\Q$item\E$/,@{$curr_usercreation{'cancreate'}})) {
+ if ($cancreate{$item} ne 'any') {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ } else {
+ if ($cancreate{$item} ne 'none') {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ } else {
+ foreach my $item (@contexts) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+
+ if (ref($curr_usercreation{'username_rule'}) eq 'ARRAY') {
+ foreach my $type (@{$curr_usercreation{'username_rule'}}) {
+ if (!grep(/^\Q$type\E$/,@username_rule)) {
+ push(@{$changes{'username_rule'}},$type);
+ }
+ }
+ foreach my $type (@username_rule) {
+ if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'username_rule'}})) {
+ push(@{$changes{'username_rule'}},$type);
+ }
+ }
+ } else {
+ push(@{$changes{'username_rule'}},@username_rule);
+ }
+ if (ref($curr_usercreation{'id_rule'}) eq 'ARRAY') {
+ foreach my $type (@{$curr_usercreation{'id_rule'}}) {
+ if (!grep(/^\Q$type\E$/,@id_rule)) {
+ push(@{$changes{'id_rule'}},$type);
+ }
+ }
+ foreach my $type (@id_rule) {
+ if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'id_rule'}})) {
+ push(@{$changes{'id_rule'}},$type);
+ }
+ }
+ } else {
+ push(@{$changes{'id_rule'}},@id_rule);
+ }
+
+ if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') {
+ foreach my $type (@{$curr_usercreation{'email_rule'}}) {
+ if (!grep(/^\Q$type\E$/,@email_rule)) {
+ push(@{$changes{'email_rule'}},$type);
+ }
+ }
+ foreach my $type (@email_rule) {
+ if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) {
+ push(@{$changes{'email_rule'}},$type);
+ }
+ }
+ } else {
+ push(@{$changes{'email_rule'}},@email_rule);
+ }
+
+ my @authen_contexts = ('author','course','domain');
+ my @authtypes = ('int','krb4','krb5','loc');
+ my %authhash;
+ foreach my $item (@authen_contexts) {
+ my @authallowed = &Apache::loncommon::get_env_multiple('form.'.$item.'_auth');
+ foreach my $auth (@authtypes) {
+ if (grep(/^\Q$auth\E$/,@authallowed)) {
+ $authhash{$item}{$auth} = 1;
+ } else {
+ $authhash{$item}{$auth} = 0;
+ }
+ }
+ }
+ if (ref($curr_usercreation{'authtypes'}) eq 'HASH') {
+ foreach my $item (@authen_contexts) {
+ if (ref($curr_usercreation{'authtypes'}{$item}) eq 'HASH') {
+ foreach my $auth (@authtypes) {
+ if ($authhash{$item}{$auth} ne $curr_usercreation{'authtypes'}{$item}{$auth}) {
+ push(@{$changes{'authtypes'}},$item);
+ last;
+ }
+ }
+ }
+ }
+ } else {
+ foreach my $item (@authen_contexts) {
+ push(@{$changes{'authtypes'}},$item);
+ }
+ }
+
+ my %usercreation_hash = (
+ usercreation => {
+ cancreate => \%cancreate,
+ username_rule => \@username_rule,
+ id_rule => \@id_rule,
+ email_rule => \@email_rule,
+ authtypes => \%authhash,
+ }
+ );
+
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
+ $dom);
+
+ my %selfcreatetypes = (
+ sso => 'users authenticated by institutional single sign on',
+ login => 'users authenticated by institutional log-in',
+ email => 'users who provide a valid e-mail address for use as the username',
+ );
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ $resulttext = &mt('Changes made:').'';
+ if (ref($changes{'cancreate'}) eq 'ARRAY') {
+ my %lt = &usercreation_types();
+ foreach my $type (@{$changes{'cancreate'}}) {
+ my $chgtext = $lt{$type}.', ';
+ if ($type eq 'selfcreate') {
+ if (@{$cancreate{$type}} == 0) {
+ $chgtext .= &mt('creation of a new user account is not permitted.');
+ } else {
+ $chgtext .= &mt('creation of a new account is permitted for:');
+ foreach my $case (@{$cancreate{$type}}) {
+ $chgtext .= ''.$selfcreatetypes{$case}.' ';
+ }
+ $chgtext .= ' ';
+ }
+ } else {
+ if ($cancreate{$type} eq 'none') {
+ $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
+ } elsif ($cancreate{$type} eq 'any') {
+ $chgtext .= &mt('creation of new users is permitted for both institutional and non-institutional usernames.');
+ } elsif ($cancreate{$type} eq 'official') {
+ $chgtext .= &mt('creation of new users is only permitted for institutional usernames.');
+ } elsif ($cancreate{$type} eq 'unofficial') {
+ $chgtext .= &mt('creation of new users is only permitted for non-institutional usernames.');
+ }
+ }
+ $resulttext .= ''.$chgtext.' ';
+ }
+ }
+ if (ref($changes{'username_rule'}) eq 'ARRAY') {
+ my ($rules,$ruleorder) =
+ &Apache::lonnet::inst_userrules($dom,'username');
+ my $chgtext = '';
+ foreach my $type (@username_rule) {
+ if (ref($rules->{$type}) eq 'HASH') {
+ $chgtext .= ''.$rules->{$type}{'name'}.' ';
+ }
+ }
+ $chgtext .= ' ';
+ if (@username_rule > 0) {
+ $resulttext .= ''.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.' ';
+ } else {
+ $resulttext .= ''.&mt('There are now no username formats restricted to verified users in the institutional directory.').' ';
+ }
+ }
+ if (ref($changes{'id_rule'}) eq 'ARRAY') {
+ my ($idrules,$idruleorder) =
+ &Apache::lonnet::inst_userrules($dom,'id');
+ my $chgtext = '';
+ foreach my $type (@id_rule) {
+ if (ref($idrules->{$type}) eq 'HASH') {
+ $chgtext .= ''.$idrules->{$type}{'name'}.' ';
+ }
+ }
+ $chgtext .= ' ';
+ if (@id_rule > 0) {
+ $resulttext .= ''.&mt('IDs with the following formats are restricted to verified users in the institutional directory: ').$chgtext.' ';
+ } else {
+ $resulttext .= ''.&mt('There are now no ID formats restricted to verified users in the institutional directory.').' ';
+ }
+ }
+ if (ref($changes{'email_rule'}) eq 'ARRAY') {
+ my ($emailrules,$emailruleorder) =
+ &Apache::lonnet::inst_userrules($dom,'email');
+ my $chgtext = '';
+ foreach my $type (@email_rule) {
+ if (ref($emailrules->{$type}) eq 'HASH') {
+ $chgtext .= ''.$emailrules->{$type}{'name'}.' ';
+ }
+ }
+ $chgtext .= ' ';
+ if (@email_rule > 0) {
+ $resulttext .= ''.&mt('Accounts may not be created by users self-enrolling with e-mail addresses of the following types: ').$chgtext.' ';
+ } else {
+ $resulttext .= ''.&mt('There are now no restrictions on e-mail addresses which may be used as a username when self-enrolling.').' ';
+ }
+ }
+
+ my %authname = &authtype_names();
+ my %context_title = &context_names();
+ if (ref($changes{'authtypes'}) eq 'ARRAY') {
+ my $chgtext = '';
+ foreach my $type (@{$changes{'authtypes'}}) {
+ my @allowed;
+ $chgtext .= ''.$context_title{$type}.' - '.&mt('assignable authentication types: ');
+ foreach my $auth (@authtypes) {
+ if ($authhash{$type}{$auth}) {
+ push(@allowed,$authname{$auth});
+ }
+ }
+ if (@allowed > 0) {
+ $chgtext .= join(', ',@allowed).' ';
+ $resulttext .= ''.&mt('Authentication types available for assignment to new users').' ';
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to user creation settings');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ if ($warningmsg ne '') {
+ $resulttext .= ''.$warningmsg.' ';
+ foreach my $context (@contexts) {
+ if (ref($changes{$context}) eq 'ARRAY') {
+ $resulttext .= ''.$context_title{$context}.':';
+ if (ref($changes{$context}) eq 'ARRAY') {
+ foreach my $role (@{$changes{$context}}) {
+ my $rolename;
+ if ($context eq 'selfcreate') {
+ $rolename = $role;
+ if (ref($usertypes) eq 'HASH') {
+ if ($usertypes->{$role} ne '') {
+ $rolename = $usertypes->{$role};
+ }
+ }
+ } else {
+ if ($role eq 'cr') {
+ $rolename = &mt('Custom');
+ } else {
+ $rolename = &Apache::lonnet::plaintext($role);
+ }
+ }
+ my @modifiable;
+ if ($context eq 'selfcreate') {
+ $resulttext .= ''.&mt('Self-creation of account by users with status: [_1] ',$rolename).' - '.&mt('modifiable fields (if institutional data blank): ');
+ } else {
+ $resulttext .= ''.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: ');
+ }
+ foreach my $field (@fields) {
+ if ($modifyhash{$context}{$role}{$field}) {
+ push(@modifiable,$fieldtitles{$field});
+ }
+ }
+ if (@modifiable > 0) {
+ $resulttext .= join(', ',@modifiable);
+ } else {
+ $resulttext .= &mt('none');
+ }
+ $resulttext .= ' ';
+ }
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to user modification settings');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ return $resulttext;
+}
+
+sub modify_defaults {
+ my ($dom,$r) = @_;
+ my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors);
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
+ my @items = ('auth_def','auth_arg_def','lang_def','timezone_def');
+ my @authtypes = ('internal','krb4','krb5','localauth');
+ foreach my $item (@items) {
+ $newvalues{$item} = $env{'form.'.$item};
+ if ($item eq 'auth_def') {
+ if ($newvalues{$item} ne '') {
+ if (!grep(/^\Q$newvalues{$item}\E$/,@authtypes)) {
+ push(@errors,$item);
+ }
+ }
+ } elsif ($item eq 'lang_def') {
+ if ($newvalues{$item} ne '') {
+ if ($newvalues{$item} =~ /^(\w+)/) {
+ my $langcode = $1;
+ if (code2language($langcode) eq '') {
+ push(@errors,$item);
+ }
+ } else {
+ push(@errors,$item);
+ }
+ }
+ } elsif ($item eq 'timezone_def') {
+ if ($newvalues{$item} ne '') {
+ if (!DateTime::TimeZone->is_valid_name($newvalues{$item})) {
+ push(@errors,$item);
+ }
+ }
+ }
+ if (grep(/^\Q$item\E$/,@errors)) {
+ $newvalues{$item} = $domdefaults{$item};
+ } elsif ($domdefaults{$item} ne $newvalues{$item}) {
+ $changes{$item} = 1;
+ }
+ }
+ my %defaults_hash = (
+ defaults => { auth_def => $newvalues{'auth_def'},
+ auth_arg_def => $newvalues{'auth_arg_def'},
+ lang_def => $newvalues{'lang_def'},
+ timezone_def => $newvalues{'timezone_def'},
+ }
+ );
+ my $title = &defaults_titles();
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%defaults_hash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ $resulttext = &mt('Changes made:').'';
+ my $version = $r->dir_config('lonVersion');
+ my $mailmsgtext = "Changes made to domain settings in a LON-CAPA installation - domain: $dom (running version: $version) - dns_domain.tab needs to be updated with the following changes, to support legacy 2.4, 2.5 and 2.6 versions of LON-CAPA.\n\n";
+ foreach my $item (sort(keys(%changes))) {
+ my $value = $env{'form.'.$item};
+ if ($value eq '') {
+ $value = &mt('none');
+ } elsif ($item eq 'auth_def') {
+ my %authnames = &authtype_names();
+ my %shortauth = (
+ internal => 'int',
+ krb4 => 'krb4',
+ krb5 => 'krb5',
+ localauth => 'loc',
+ );
+ $value = $authnames{$shortauth{$value}};
+ }
+ $resulttext .= ''.&mt('[_1] set to "[_2]"',$title->{$item},$value).' ';
+ $mailmsgtext .= "$title->{$item} set to $value\n";
+ }
+ $resulttext .= ' ';
+ $mailmsgtext .= "\n";
+ my $cachetime = 24*60*60;
+ &Apache::lonnet::do_cache_new('domdefaults',$dom,
+ $defaults_hash{'defaults'},$cachetime);
+ if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'}) {
+ my $sysmail = $r->dir_config('lonSysEMail');
+ &Apache::lonmsg::sendemail($sysmail,"LON-CAPA Domain Settings Change - $dom",$mailmsgtext);
+ }
+ } else {
+ $resulttext = &mt('No changes made to default authentication/language/timezone settings');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ if (@errors > 0) {
+ $resulttext .= ''.$error.' ';
+ if ($confhash{'scantron'}{'scantronformat'} eq '') {
+ $resulttext .= ''.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).' ';
+ } else {
+ $resulttext .= ''.&mt('Custom scantron format file ([_1]) uploaded for use with courses in this domain.',$custom).' ';
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('Changes made to scantron format file.');
+ }
+ $resulttext .= '';
+ &Apache::loncommon::devalidate_domconfig_cache($dom);
+ } else {
+ $resulttext = &mt('No changes made to scantron format file');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ } else {
+ $resulttext = &mt('No changes made to scantron format file');
+ }
+ if ($errors) {
+ $resulttext .= &mt('The following errors occurred: ').'';
+ }
+ return $resulttext;
+}
+
+sub modify_coursecategories {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%deletions,%reorderings,%needreordering,%adds,%changes,$errors,
+ $cathash);
+ my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory');
+ if (ref($domconfig{'coursecategories'}) eq 'HASH') {
+ $cathash = $domconfig{'coursecategories'}{'cats'};
+ if ($domconfig{'coursecategories'}{'togglecats'} ne $env{'form.togglecats'}) {
+ $changes{'togglecats'} = 1;
+ $domconfig{'coursecategories'}{'togglecats'} = $env{'form.togglecats'};
+ }
+ if ($domconfig{'coursecategories'}{'categorize'} ne $env{'form.categorize'}) {
+ $changes{'categorize'} = 1;
+ $domconfig{'coursecategories'}{'categorize'} = $env{'form.categorize'};
+ }
+ } else {
+ $changes{'togglecats'} = 1;
+ $changes{'categorize'} = 1;
+ $domconfig{'coursecategories'}{'togglecats'} = $env{'form.togglecats'};
+ $domconfig{'coursecategories'}{'categorize'} = $env{'form.categorize'};
+ }
+ if (ref($cathash) eq 'HASH') {
+ if (($domconfig{'coursecategories'}{'cats'}{'instcode::0'} ne '') && ($env{'form.instcode'} == 0)) {
+ push (@deletecategory,'instcode::0');
+ }
+ }
+ my (@predelcats,@predeltrails,%predelallitems,%sort_by_deltrail);
+ if (ref($cathash) eq 'HASH') {
+ if (@deletecategory > 0) {
+ #FIXME Need to remove category from all courses using a deleted category
+ &Apache::loncommon::extract_categories($cathash,\@predelcats,\@predeltrails,\%predelallitems);
+ foreach my $item (@deletecategory) {
+ if ($domconfig{'coursecategories'}{'cats'}{$item} ne '') {
+ delete($domconfig{'coursecategories'}{'cats'}{$item});
+ $deletions{$item} = 1;
+ &recurse_cat_deletes($item,$cathash,\%deletions);
+ }
+ }
+ }
+ foreach my $item (keys(%{$cathash})) {
+ my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
+ if ($cathash->{$item} ne $env{'form.'.$item}) {
+ $reorderings{$item} = 1;
+ $domconfig{'coursecategories'}{'cats'}{$item} = $env{'form.'.$item};
+ }
+ if ($env{'form.addcategory_name_'.$item} ne '') {
+ my $newcat = $env{'form.addcategory_name_'.$item};
+ my $newdepth = $depth+1;
+ my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos_'.$item};
+ $adds{$newitem} = 1;
+ }
+ if ($env{'form.subcat_'.$item} ne '') {
+ my $newcat = $env{'form.subcat_'.$item};
+ my $newdepth = $depth+1;
+ my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = 0;
+ $adds{$newitem} = 1;
+ }
+ }
+ }
+ if ($env{'form.instcode'} eq '1') {
+ if (ref($cathash) eq 'HASH') {
+ my $newitem = 'instcode::0';
+ if ($cathash->{$newitem} eq '') {
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'};
+ $adds{$newitem} = 1;
+ }
+ } else {
+ my $newitem = 'instcode::0';
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'};
+ $adds{$newitem} = 1;
+ }
+ }
+ if ($env{'form.addcategory_name'} ne '') {
+ my $newitem = &escape($env{'form.addcategory_name'}).'::0';
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos'};
+ $adds{$newitem} = 1;
+ }
+ my $putresult;
+ if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
+ if (keys(%deletions) > 0) {
+ foreach my $key (keys(%deletions)) {
+ if ($predelallitems{$key} ne '') {
+ $sort_by_deltrail{$predelallitems{$key}} = $predeltrails[$predelallitems{$key}];
+ }
+ }
+ }
+ my (@chkcats,@chktrails,%chkallitems);
+ &Apache::loncommon::extract_categories($domconfig{'coursecategories'}{'cats'},\@chkcats,\@chktrails,\%chkallitems);
+ if (ref($chkcats[0]) eq 'ARRAY') {
+ my $depth = 0;
+ my $chg = 0;
+ for (my $i=0; $i<@{$chkcats[0]}; $i++) {
+ my $name = $chkcats[0][$i];
+ my $item;
+ if ($name eq '') {
+ $chg ++;
+ } else {
+ $item = &escape($name).'::0';
+ if ($chg) {
+ $domconfig{'coursecategories'}{'cats'}{$item} -= $chg;
+ }
+ $depth ++;
+ &recurse_check(\@chkcats,$domconfig{'coursecategories'}{'cats'},$depth,$name);
+ $depth --;
+ }
+ }
+ }
+ }
+ if ((keys(%changes) > 0) || (keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
+ $putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
+ if ($putresult eq 'ok') {
+ my %title = (
+ togglecats => 'Show/Hide a course in the catalog',
+ categorize => 'Category assigned to course',
+ );
+ my %level = (
+ dom => 'set from "Modify Course" (Domain)',
+ crs => 'set from "Parameters" (Course)',
+ );
+ $resulttext = &mt('Changes made:').'';
+ if ($changes{'togglecats'}) {
+ $resulttext .= ''.&mt("$title{'togglecats'} $level{$env{'form.togglecats'}}").' ';
+ }
+ if ($changes{'categorize'}) {
+ $resulttext .= ''.&mt("$title{'categorize'} $level{$env{'form.categorize'}}").' ';
+ }
+ if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
+ my $cathash;
+ if (ref($domconfig{'coursecategories'}) eq 'HASH') {
+ $cathash = $domconfig{'coursecategories'}{'cats'};
+ } else {
+ $cathash = {};
+ }
+ my (@cats,@trails,%allitems);
+ &Apache::loncommon::extract_categories($cathash,\@cats,\@trails,\%allitems);
+ if (keys(%deletions) > 0) {
+ $resulttext .= ''.&mt('Deleted categories:').'';
+ foreach my $predeltrail (sort {$a <=> $b } (keys(%sort_by_deltrail))) {
+ $resulttext .= ''.$predeltrails[$predeltrail].' ';
+ }
+ $resulttext .= ' ';
+ }
+ if (keys(%reorderings) > 0) {
+ my %sort_by_trail;
+ $resulttext .= ''.&mt('Reordered categories:').'';
+ foreach my $key (keys(%reorderings)) {
+ if ($allitems{$key} ne '') {
+ $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
+ }
+ }
+ foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
+ $resulttext .= ''.$trails[$trail].' ';
+ }
+ $resulttext .= ' ';
+ }
+ if (keys(%adds) > 0) {
+ my %sort_by_trail;
+ $resulttext .= ''.&mt('Added categories:').'';
+ foreach my $key (keys(%adds)) {
+ if ($allitems{$key} ne '') {
+ $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
+ }
+ }
+ foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
+ $resulttext .= ''.$trails[$trail].' ';
+ }
+ $resulttext .= ' ';
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ } else {
+ $resulttext = &mt('No changes made to course categories');
+ }
+ return $resulttext;
+}
+
+sub recurse_check {
+ my ($chkcats,$categories,$depth,$name) = @_;
+ if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
+ my $chg = 0;
+ for (my $j=0; $j<@{$chkcats->[$depth]{$name}}; $j++) {
+ my $category = $chkcats->[$depth]{$name}[$j];
+ my $item;
+ if ($category eq '') {
+ $chg ++;
+ } else {
+ my $deeper = $depth + 1;
+ $item = &escape($category).':'.&escape($name).':'.$depth;
+ if ($chg) {
+ $categories->{$item} -= $chg;
+ }
+ &recurse_check($chkcats,$categories,$deeper,$category);
+ $deeper --;
+ }
+ }
+ }
+ return;
+}
+
+sub recurse_cat_deletes {
+ my ($item,$coursecategories,$deletions) = @_;
+ my ($deleted,$container,$depth) = map { &unescape($_); } split(/:/,$item);
+ my $subdepth = $depth + 1;
+ if (ref($coursecategories) eq 'HASH') {
+ foreach my $subitem (keys(%{$coursecategories})) {
+ my ($child,$parent,$itemdepth) = map { &unescape($_); } split(/:/,$subitem);
+ if (($parent eq $deleted) && ($itemdepth == $subdepth)) {
+ delete($coursecategories->{$subitem});
+ $deletions->{$subitem} = 1;
+ &recurse_cat_deletes($subitem,$coursecategories,$deletions);
+ }
+ }
+ }
+ return;
+}
+
+1;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.