--- loncom/interface/loncreateuser.pm 2006/11/23 00:53:19 1.138 +++ loncom/interface/loncreateuser.pm 2007/06/07 22:34:56 1.151 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Create a user # -# $Id: loncreateuser.pm,v 1.138 2006/11/23 00:53:19 albertel Exp $ +# $Id: loncreateuser.pm,v 1.151 2007/06/07 22:34:56 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -66,7 +66,7 @@ use Apache::loncommon; use Apache::lonlocal; use Apache::longroup; use lib '/home/httpd/lib/perl/'; -use LONCAPA; +use LONCAPA qw(:DEFAULT :match); my $loginscript; # piece of javascript used in two separate instances my $generalrule; @@ -122,11 +122,72 @@ sub portfolio_quota { my ($ccuname,$ccdomain) = @_; my %lt = &Apache::lonlocal::texthash( 'disk' => "Disk space allocated to user's portfolio files", + 'cuqu' => "Current quota", + 'cust' => "Custom quota", + 'defa' => "Default", + 'chqu' => "Change quota", ); - my $output = '

'.$lt{'disk'}.'

'. + my ($currquota,$quotatype,$inststatus,$defquota) = + &Apache::loncommon::get_user_quota($ccuname,$ccdomain); + my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($ccdomain); + my ($longinsttype,$showquota,$custom_on,$custom_off,$defaultinfo); + if ($inststatus ne '') { + if ($usertypes->{$inststatus} ne '') { + $longinsttype = $usertypes->{$inststatus}; + } + } + $custom_on = ' '; + $custom_off = ' checked="checked" '; + my $quota_javascript = <<"END_SCRIPT"; + +END_SCRIPT + if ($quotatype eq 'custom') { + $custom_on = $custom_off; + $custom_off = ' '; + $showquota = $currquota; + if ($longinsttype eq '') { + $defaultinfo = &mt('For this user, the default quota would be [_1] + Mb.',$defquota); + } else { + $defaultinfo = &mt("For this user, the default quota would be [_1] + Mb, as determined by the user's institutional + affiliation ([_2]).",$defquota,$longinsttype); + } + } else { + if ($longinsttype eq '') { + $defaultinfo = &mt('For this user, the default quota is [_1] + Mb.',$defquota); + } else { + $defaultinfo = &mt("For this user, the default quota of [_1] + Mb, is determined by the user's institutional + affiliation ([_2]).",$defquota,$longinsttype); + } + } + my $output = $quota_javascript. + '

'.$lt{'disk'}.'

'. + $lt{'cuqu'}.': '.$currquota.' Mb.  '. + $defaultinfo.'
'.$lt{'chqu'}. + ':  '. + '  '. ' Mb'; + $showquota.'" onfocus="javascript:quota_changes('."'quota'".')" '. + '/> Mb'; return $output; } @@ -135,7 +196,6 @@ sub portfolio_quota { sub print_username_entry_form { my ($r) = @_; my $defdom=$env{'request.role.domain'}; - my @domains = &Apache::loncommon::get_domains(); my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain'); my $selscript=&Apache::loncommon::studentbrowser_javascript(); my $start_page = @@ -235,7 +295,7 @@ sub print_user_modification_page { ); $loginscript = &Apache::loncommon::authform_header(%param); $authformkrb = &Apache::loncommon::authform_kerberos(%param); - + $ccuname =&LONCAPA::clean_username($ccuname); $ccdomain=&LONCAPA::clean_domain($ccdomain); my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition(); @@ -251,7 +311,7 @@ sub print_user_modification_page { $groupslist = '"'.$groupslist.'"'; } - if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) { + if ($env{'request.role'} =~ m-^dc\./($match_domain)/$-) { my $dcdom = $1; $loaditem{'onload'} = "document.cu.coursedesc.value='';"; my @rolevals = ('st','ta','ep','in','cc'); @@ -358,36 +418,6 @@ sub print_user_modification_page { } return -1; } - - function setType() { - var crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; - rolevals = new Array("$rolevalslist"); - if (crstype == 'Group') { - if (document.cu.currsec.options[0].text == "$pickcrsfirst") { - document.cu.currsec.options[0].text = "$pickgrpfirst"; - } - grprolenames = new Array("$grprolenameslist"); - for (var i=0; i ENDFORMINFO my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain); - my %incdomains; my %inccourses; - foreach my $item (values(%Apache::lonnet::hostdom)) { - $incdomains{$item}=1; - } foreach my $key (keys(%env)) { - if ($key=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) { + if ($key=~/^user\.priv\.cm\.\/($match_domain)\/($match_username)/) { $inccourses{$1.'_'.$2}=1; } } @@ -619,12 +645,12 @@ END split(/_/,$role); # Is this a custom role? Get role owner and title. my ($croleudom,$croleuname,$croletitle)= - ($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/); + ($role_code=~m{^cr/($match_domain)/($match_username)/(\w+)$}); my $allowed=0; my $delallowed=0; my $sortkey=$role_code; my $class='Unknown'; - if ($area =~ /^\/(\w+)\/(\d\w+)/ ) { + if ($area =~ m{^/($match_domain)/($match_courseid)} ) { $class='Course'; my ($coursedom,$coursedir) = ($1,$2); $sortkey.="\0$coursedom"; @@ -660,7 +686,7 @@ END } } # Compute the background color based on $area - if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) { + if ($area=~m{^/($match_domain)/($match_courseid)/(\w+)}) { $carea.='
Section: '.$3; $sortkey.="\0$3"; } @@ -668,7 +694,7 @@ END } else { $sortkey.="\0".$area; # Determine if current user is able to revoke privileges - if ($area=~ /^\/(\w+)\//) { + if ($area=~m{^/($match_domain)/}) { if ((&Apache::lonnet::allowed('c'.$role_code,$1)) || (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) { $allowed=1; @@ -692,7 +718,7 @@ END } } if (($role_code eq 'ca') || ($role_code eq 'aa')) { - $area=~/\/(\w+)\/(\w+)/; + $area=~m{/($match_domain)/($match_username)}; if (&authorpriv($2,$1)) { $allowed=1; } else { @@ -725,7 +751,7 @@ END $row.=' '; } my $plaintext=''; - unless ($croletitle) { + if (!$croletitle) { $plaintext=&Apache::lonnet::plaintext($role_code,$class) } else { $plaintext= @@ -962,7 +988,7 @@ ENDNOPRIV &mt('Extent').''. ''.&mt('Start').''.&mt('End').''. &Apache::loncommon::end_data_table_header_row(); - foreach my $thisdomain ( sort( keys(%incdomains))) { + foreach my $thisdomain (sort(&Apache::lonnet::all_domains())) { foreach my $role ('dc','li','dg','au','sc') { if (&Apache::lonnet::allowed('c'.$role,$thisdomain)) { my $plrole=&Apache::lonnet::plaintext($role); @@ -994,7 +1020,7 @@ ENDNOPRIV # Course and group levels # - if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) { + if ($env{'request.role'} =~ m{^dc\./($match_domain)/$}) { $r->print(&course_level_dc($1,'Course')); $r->print('
'."\n"); } else { @@ -1099,8 +1125,8 @@ ENDNEWUSERHEAD if (lc($desiredhost) eq 'default') { $desiredhost = undef; } else { - my %home_servers = &Apache::loncommon::get_library_servers - ($env{'form.ccdomain'}); + my %home_servers = + &Apache::lonnet::get_servers($env{'form.ccdomain'},'library'); if (! exists($home_servers{$desiredhost})) { $r->print($error.&mt('Invalid home server specified')); return; @@ -1117,7 +1143,7 @@ ENDNEWUSERHEAD my $home = &Apache::lonnet::homeserver($env{'form.ccuname'}, $env{'form.ccdomain'}); $r->print('
'.&mt('Home server').': '.$home.' '. - $Apache::lonnet::libserv{$home}); + &Apache::lonnet::hostname($home)); } elsif (($env{'form.login'} ne 'nochange') && ($env{'form.login'} ne '' )) { # Modify user privileges @@ -1150,7 +1176,8 @@ ENDMODIFYUSERHEAD # Check for need to change my %userenv = &Apache::lonnet::get ('environment',['firstname','middlename','lastname','generation', - 'portfolioquota'],$env{'form.ccdomain'},$env{'form.ccuname'}); + 'portfolioquota','inststatus'],$env{'form.ccdomain'}, + $env{'form.ccuname'}); my ($tmp) = keys(%userenv); if ($tmp =~ /^(con_lost|error)/i) { %userenv = (); @@ -1160,21 +1187,55 @@ ENDMODIFYUSERHEAD # Strip leading and trailing whitespace $env{'form.c'.$item} =~ s/(\s+$|^\s+)//g; } - my ($quotachanged,$namechanged,$oldportfolioquota); + my ($quotachanged,$namechanged,$oldportfolioquota,$newportfolioquota, + $inststatus,$isdefault,$defquotatext); + my ($defquota,$settingstatus) = + &Apache::loncommon::default_quota($env{'form.ccdomain'},$inststatus); my %changeHash; - if (exists($userenv{'portfolioquota'})) { + if ($userenv{'portfolioquota'} ne '') { $oldportfolioquota = $userenv{'portfolioquota'}; - if (exists($env{'form.portfolioquota'})) { - if ($env{'form.portfolioquota'} ne $userenv{'portfolioquota'}) { - if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) { - # Current user has quota modification privileges - $quotachanged = 1; - $changeHash{'portfolioquota'} = $env{'form.portfolioquota'}; - } + if ($env{'form.customquota'} == 1) { + if ($env{'form.portfolioquota'} eq '') { + $newportfolioquota = 0; + } else { + $newportfolioquota = $env{'form.portfolioquota'}; + $newportfolioquota =~ s/[^\d\.]//g; } + if ($newportfolioquota != $userenv{'portfolioquota'}) { + $quotachanged = "a_admin($newportfolioquota,\%changeHash); + } + } else { + $quotachanged = "a_admin('',\%changeHash); + $newportfolioquota = $defquota; + $isdefault = 1; } } else { - $oldportfolioquota = &default_quota($env{'form.ccdomain'}); + $oldportfolioquota = $defquota; + if ($env{'form.customquota'} == 1) { + if ($env{'form.portfolioquota'} eq '') { + $newportfolioquota = 0; + } else { + $newportfolioquota = $env{'form.portfolioquota'}; + $newportfolioquota =~ s/[^\d\.]//g; + } + $quotachanged = "a_admin($newportfolioquota,\%changeHash); + } else { + $newportfolioquota = $defquota; + $isdefault = 1; + } + } + if ($isdefault) { + if ($settingstatus eq '') { + $defquotatext = &mt('(default)'); + } else { + my ($usertypes,$order) = + &Apache::lonnet::retrieve_inst_usertypes($env{'form.ccdomain'}); + if ($usertypes->{$settingstatus} eq '') { + $defquotatext = &mt('(default)'); + } else { + $defquotatext = &mt('(default for [_1])',$usertypes->{$settingstatus}); + } + } } if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) && ($env{'form.cfirstname'} ne $userenv{'firstname'} || @@ -1218,16 +1279,24 @@ ENDMODIFYUSERHEAD $userenv{'middlename'} $userenv{'lastname'} $userenv{'generation'} - $oldportfolioquota + $oldportfolioquota Mb $lt{'chto'} $env{'form.cfirstname'} $env{'form.cmiddlename'} $env{'form.clastname'} $env{'form.cgeneration'} - $env{'form.portfolioquota'} Mb + $newportfolioquota Mb $defquotatext END + if (($env{'form.ccdomain'} eq $env{'user.domain'}) && + ($env{'form.ccuname'} eq $env{'user.name'})) { + my %newenvhash; + foreach my $key (keys(%changeHash)) { + $newenvhash{'environment.'.$key} = $changeHash{$key}; + } + &Apache::lonnet::appenv(%newenvhash); + } } else { # error occurred $r->print("

".&mt('Unable to successfully change environment for')." ". $env{'form.ccuname'}." ".&mt('in domain')." ". @@ -1254,8 +1323,10 @@ END

$lt{'gen'}: $userenv{'generation'}

END if ($putresult eq 'ok') { - if ($oldportfolioquota ne $env{'form.portfolioquota'}) { - $r->print('

'.$lt{'disk'}.': '.$env{'form.portfolioquota'}.' Mb

'); + if ($oldportfolioquota != $newportfolioquota) { + $r->print('

'.$lt{'disk'}.': '.$newportfolioquota.' Mb '. + $defquotatext.'

'); + &Apache::lonnet::appenv('environment.portfolioquota' => $changeHash{'portfolioquota'}); } } } @@ -1273,7 +1344,7 @@ END &Apache::lonnet::revokerole($env{'form.ccdomain'}, $env{'form.ccuname'},$1,$2).'
'); if ($2 eq 'st') { - $1=~/^\/(\w+)\/(\w+)/; + $1=~m{^/($match_domain)/($match_courseid)}; my $cid=$1.'_'.$2; $r->print(&mt('Drop from classlist').': '. &Apache::lonnet::critical('put:'. @@ -1285,10 +1356,10 @@ END $env{'course.'.$cid.'.home'}).'
'); } } - if ($key=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) { + if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) { # Revoke custom role $r->print(&mt('Revoking custom role:'). - ' '.$4.' by '.$3.'@'.$2.' in '.$1.': '. + ' '.$4.' by '.$3.':'.$2.' in '.$1.': '. &Apache::lonnet::revokecustomrole($env{'form.ccdomain'}, $env{'form.ccuname'},$1,$2,$3,$4). '
'); @@ -1300,7 +1371,7 @@ END &Apache::lonnet::assignrole($env{'form.ccdomain'}, $env{'form.ccuname'},$1,$2,$now,0,1).'
'); if ($2 eq 'st') { - $1=~/^\/(\w+)\/(\w+)/; + $1=~m{^/($match_domain)/($match_courseid)}; my $cid=$1.'_'.$2; $r->print(&mt('Drop from classlist').': '. &Apache::lonnet::critical('put:'. @@ -1312,7 +1383,7 @@ END $env{'course.'.$cid.'.home'}).'
'); } } - if ($key=~/^form\.del\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) { + if ($key=~m{^form\.del\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) { my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4); # Delete custom role $r->print(&mt('Deleting custom role [_1] by [_2]@[_3] in [_4]', @@ -1331,7 +1402,7 @@ END my $logmsg; my $output; if ($role eq 'st') { - if ($url =~ m-^/(\w+)/(\w+)/?(\w*)$-) { + if ($url =~ m-^/($match_domain)/($match_courseid)/?(\w*)$-) { my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3); if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) { $output = "Error: $result\n"; @@ -1351,7 +1422,7 @@ END $r->print($output); } # Re-enable custom role - if ($key=~/^form\.ren\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) { + if ($key=~m{^form\.ren\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) { my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4); my $result = &Apache::lonnet::assigncustomrole( $env{'form.ccdomain'}, $env{'form.ccuname'}, @@ -1362,7 +1433,7 @@ END } elsif ($key=~/^form\.act/) { my $udom = $env{'form.ccdomain'}; my $uname = $env{'form.ccuname'}; - if ($key=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) { + if ($key=~/^form\.act\_($match_domain)\_($match_courseid)\_cr_cr_($match_domain)_($match_username)_([^\_]+)$/) { # Activate a custom role my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5); my $url='/'.$one.'/'.$two; @@ -1393,7 +1464,7 @@ END $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end)); } } - } elsif ($key=~/^form\.act\_([^\_]+)\_(\w+)\_([^\_]+)$/) { + } elsif ($key=~/^form\.act\_($match_domain)\_($match_name)\_([^\_]+)$/) { # Activate roles for sections with 3 id numbers # set start, end times, and the url for the class my ($one,$two,$three)=($1,$2,$3); @@ -1480,6 +1551,17 @@ END $r->print(&Apache::loncommon::end_page()); } +sub quota_admin { + my ($setquota,$changeHash) = @_; + my $quotachanged; + if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) { + # Current user has quota modification privileges + $quotachanged = 1; + $changeHash->{'portfolioquota'} = $setquota; + } + return $quotachanged; +} + sub build_roles { my ($sectionstr,$sections,$role) = @_; my $num_sections = 0; @@ -1492,7 +1574,7 @@ sub build_roles { } else { foreach my $sec (@secnums) { $sec =~ ~s/\W//g; - unless ($sec eq "") { + if (!($sec eq "")) { if (exists($$sections{$sec})) { $$sections{$sec} ++; } else { @@ -1525,15 +1607,23 @@ sub custom_role_editor { $rolename=~s/[^A-Za-z0-9]//gs; - unless ($rolename) { + if (!$rolename) { &print_username_entry_form($r); return; } - - $r->print(&Apache::loncommon::start_page('Custom Role Editor')); + my $head_script = < + function setchecks() { + document.form1.bre_c.checked = false; + } + +END_SCRIPT + + $r->print(&Apache::loncommon::start_page('Custom Role Editor',$head_script)); my $syspriv=''; my $dompriv=''; my $coursepriv=''; + my ($disp_dummy,$disp_roles) = &Apache::lonnet::get('roles',["st"]); my ($rdummy,$roledef)= &Apache::lonnet::get('roles',["rolesdef_$rolename"]); # ------------------------------------------------------- Does this role exist? @@ -1551,9 +1641,15 @@ sub custom_role_editor { my %full=(); my %courselevel=(); my %courselevelcurrent=(); + my @roles = ("st:c","st:d"); + #foreach my $item (@roles) { + # &Apache::lonnet::logthis(" roles for $item: ".$Apache::lonnet::pr{$item}); + #} + foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) { + my ($priv,$restrict)=split(/\&/,$item); - unless ($restrict) { $restrict='F'; } + if (!$restrict) { $restrict='F'; } $courselevel{$priv}=$restrict; if ($coursepriv=~/\:$priv/) { $courselevelcurrent{$priv}=1; @@ -1564,7 +1660,7 @@ sub custom_role_editor { my %domainlevelcurrent=(); foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) { my ($priv,$restrict)=split(/\&/,$item); - unless ($restrict) { $restrict='F'; } + if (!$restrict) { $restrict='F'; } $domainlevel{$priv}=$restrict; if ($dompriv=~/\:$priv/) { $domainlevelcurrent{$priv}=1; @@ -1575,7 +1671,7 @@ sub custom_role_editor { my %systemlevelcurrent=(); foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) { my ($priv,$restrict)=split(/\&/,$item); - unless ($restrict) { $restrict='F'; } + if (!$restrict) { $restrict='F'; } $systemlevel{$priv}=$restrict; if ($syspriv=~/\:$priv/) { $systemlevelcurrent{$priv}=1; @@ -1586,10 +1682,10 @@ sub custom_role_editor { 'prv' => "Privilege", 'crl' => "Course Level", 'dml' => "Domain Level", - 'ssl' => "System Level" - ); + 'ssl' => "System Level"); + $r->print('
'); $r->print(< +
ENDCCF @@ -1602,13 +1698,13 @@ ENDCCF my $privtext = &Apache::lonnet::plaintext($priv); $r->print(&Apache::loncommon::start_data_table_row(). ''.$privtext.''. - ($courselevel{$priv}?'':' '). ''. - ($domainlevel{$priv}?'':' '). ''. - ($systemlevel{$priv}?'':' '). ''. &Apache::loncommon::end_data_table_row()); @@ -1626,7 +1722,7 @@ sub set_custom_role { $rolename=~s/[^A-Za-z0-9]//gs; - unless ($rolename) { + if (!$rolename) { &print_username_entry_form($r); return; } @@ -1650,24 +1746,24 @@ sub set_custom_role { foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) { my ($priv,$restrict)=split(/\&/,$item); - unless ($restrict) { $restrict=''; } - if ($env{'form.'.$priv.':c'}) { + if (!$restrict) { $restrict=''; } + if ($env{'form.'.$priv.'_c'}) { $courole.=':'.$item; } } foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) { my ($priv,$restrict)=split(/\&/,$item); - unless ($restrict) { $restrict=''; } - if ($env{'form.'.$priv.':d'}) { + if (!$restrict) { $restrict=''; } + if ($env{'form.'.$priv.'_d'}) { $domrole.=':'.$item; } } foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) { my ($priv,$restrict)=split(/\&/,$item); - unless ($restrict) { $restrict=''; } - if ($env{'form.'.$priv.':s'}) { + if (!$restrict) { $restrict=''; } + if ($env{'form.'.$priv.'_s'}) { $sysrole.=':'.$item; } } @@ -1706,7 +1802,7 @@ sub handler { (&Apache::lonnet::allowed('mau',$env{'request.role.domain'}))) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - unless ($env{'form.phase'}) { + if (!$env{'form.phase'}) { &print_username_entry_form($r); } if ($env{'form.phase'} eq 'get_user_info') { @@ -1867,7 +1963,7 @@ sub course_sections { $output = ''."\n". - '