Annotation of loncom/auth/lonroles.pm, revision 1.256.2.6.2.2
1.1 harris41 1: # The LearningOnline Network with CAPA
2: # User Roles Screen
1.31 www 3: #
1.256.2.6.2.2! (raeburn 4:: # $Id: lonroles.pm,v 1.256.2.6.2.1 2012/02/08 00:22:15 raeburn Exp $
1.31 www 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.32 harris41 28: ###
1.22 harris41 29:
1.210 jms 30: =pod
31:
32: =head1 NAME
33:
34: Apache::lonroles - User Roles Screen
35:
36: =head1 SYNOPSIS
37:
38: Invoked by /etc/httpd/conf/srm.conf:
39:
40: <Location /adm/roles>
41: PerlAccessHandler Apache::lonacc
42: SetHandler perl-script
43: PerlHandler Apache::lonroles
44: ErrorDocument 403 /adm/login
45: ErrorDocument 500 /adm/errorhandler
46: </Location>
47:
48: =head1 OVERVIEW
49:
50: =head2 Choosing Roles
51:
52: C<lonroles> is a handler that allows a user to switch roles in
53: mid-session. LON-CAPA attempts to work with "No Role Specified", the
54: default role that a user has before selecting a role, as widely as
55: possible, but certain handlers for example need specification which
56: course they should act on, etc. Both in this scenario, and when the
57: handler determines via C<lonnet>'s C<&allowed> function that a certain
58: action is not allowed, C<lonroles> is used as error handler. This
59: allows the user to select another role which may have permission to do
1.256.2.6.2.1 (raeburn 60:: what they were trying to do.
1.210 jms 61:
62: =begin latex
63:
64: \begin{figure}
65: \begin{center}
66: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
67: \caption{\label{Sample_Roles_Screen}Sample Roles Screen}
68: \end{center}
69: \end{figure}
70:
71: =end latex
72:
73: =head2 Role Initialization
74:
75: The privileges for a user are established at login time and stored in the session environment. As a consequence, a new role does not become active till the next login. Handlers are able to query for privileges using C<lonnet>'s C<&allowed> function. When a user first logs in, their role is the "common" role, which means that they have the sum of all of their privileges. During a session it might become necessary to choose a particular role, which as a consequence also limits the user to only the privileges in that particular role.
76:
77: =head1 INTRODUCTION
78:
79: This module enables a user to select what role he wishes to
80: operate under (instructor, student, teaching assistant, course
81: coordinator, etc). These roles are pre-established by the actions
82: of upper-level users.
83:
84: This is part of the LearningOnline Network with CAPA project
85: described at http://www.lon-capa.org.
86:
87: =head1 HANDLER SUBROUTINE
88:
89: This routine is called by Apache and mod_perl.
90:
91: =over 4
92:
93: =item *
94:
95: Roles Initialization (yes/no)
96:
97: =item *
98:
99: Get Error Message from Environment
100:
101: =item *
102:
103: Who is this?
104:
105: =item *
106:
107: Generate Page Output
108:
109: =item *
110:
111: Choice or no choice
112:
113: =item *
114:
115: Table
116:
117: =item *
118:
119: Privileges
120:
121: =back
122:
123: =cut
124:
125:
1.1 harris41 126: package Apache::lonroles;
127:
128: use strict;
1.118 albertel 129: use Apache::lonnet;
1.7 www 130: use Apache::lonuserstate();
1.1 harris41 131: use Apache::Constants qw(:common);
1.2 www 132: use Apache::File();
1.26 www 133: use Apache::lonmenu;
1.29 albertel 134: use Apache::loncommon;
1.104 raeburn 135: use Apache::lonhtmlcommon;
1.57 www 136: use Apache::lonannounce;
1.72 www 137: use Apache::lonlocal;
1.151 www 138: use Apache::lonpageflip();
1.167 albertel 139: use Apache::lonnavdisplay();
1.241 raeburn 140: use Apache::loncoursequeueadmin;
1.120 albertel 141: use GDBM_File;
1.170 albertel 142: use LONCAPA qw(:DEFAULT :match);
1.201 raeburn 143: use HTML::Entities;
1.256.2.4 raeburn 144:
1.1 harris41 145:
1.62 matthew 146: sub redirect_user {
1.256.2.1 raeburn 147: my ($r,$title,$url,$msg,$launch_nav) = @_;
1.62 matthew 148: $msg = $title if (! defined($msg));
1.73 www 149: &Apache::loncommon::content_type($r,'text/html');
1.62 matthew 150: &Apache::loncommon::no_cache($r);
151: $r->send_http_header;
1.256.2.1 raeburn 152: my $swinfo=&Apache::lonmenu::rawconfig();
153: my $navwindow;
154: if ($launch_nav eq 'on') {
155: $navwindow.=&Apache::lonnavdisplay::launch_win('now',undef,undef,
156: ($url =~ m-^/adm/whatsnew-));
157: } else {
158: $navwindow.=&Apache::lonnavmaps::close();
159: }
1.228 bisitz 160:
161: # Breadcrumbs
162: my $brcrum = [{'href' => $url,
163: 'text' => 'Switching Role'},];
1.147 albertel 164: my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
1.228 bisitz 165: {'redirect' => [1,$url],
166: 'bread_crumbs' => $brcrum,});
1.147 albertel 167: my $end_page = &Apache::loncommon::end_page();
168:
1.92 www 169: # Note to style police:
170: # This must only replace the spaces, nothing else, or it bombs elsewhere.
171: $url=~s/ /\%20/g;
1.93 albertel 172: $r->print(<<ENDREDIR);
1.147 albertel 173: $start_page
1.256.2.1 raeburn 174: <script type="text/javascript">
175: // <![CDATA[
176: $swinfo
177: // ]]>
178: </script>
179: $navwindow
1.222 bisitz 180: <p>$msg</p>
1.147 albertel 181: $end_page
1.62 matthew 182: ENDREDIR
183: return;
184: }
185:
1.150 www 186: sub error_page {
187: my ($r,$error,$dest)=@_;
188: &Apache::loncommon::content_type($r,'text/html');
189: &Apache::loncommon::no_cache($r);
190: $r->send_http_header;
191: return OK if $r->header_only;
1.228 bisitz 192: # Breadcrumbs
193: my $brcrum = [{'href' => $dest,
194: 'text' => 'Problems during Course Initialization'},];
195: $r->print(&Apache::loncommon::start_page('Problems during Course Initialization',
196: undef,
197: {'bread_crumbs' => $brcrum,})
198: );
199: $r->print(
1.225 bisitz 200: '<script type="text/javascript">'.
201: '// <![CDATA['.
202: &Apache::lonmenu::rawconfig().
203: '// ]]>'.
204: '</script>'.
205: '<p class="LC_error">'.&mt('The following problems occurred:').
1.228 bisitz 206: '<br />'.
1.150 www 207: $error.
1.228 bisitz 208: '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'
209: );
210: $r->print(&Apache::loncommon::end_page());
1.150 www 211: }
212:
1.1 harris41 213: sub handler {
1.10 www 214:
1.1 harris41 215: my $r = shift;
216:
1.6 www 217: my $now=time;
1.118 albertel 218: my $then=$env{'user.login.time'};
1.226 raeburn 219: my $refresh=$env{'user.refresh.time'};
1.256.2.6.2.1 (raeburn 220:: my $update=$env{'user.update.time'};
1.226 raeburn 221: if (!$refresh) {
222: $refresh = $then;
223: }
1.256.2.6.2.1 (raeburn 224:: if (!$update) {
225:: $update = $then;
226:: }
227::
228:: # -------------------------------------------------------- Check for new roles
229:: my $updateresult;
230:: if ($env{'form.doupdate'}) {
231:: my $show_course=&Apache::loncommon::show_course();
232:: my $checkingtxt;
233:: if ($show_course) {
234:: $checkingtxt = &mt('Checking for new courses ...');
235:: } else {
236:: $checkingtxt = &mt('Checking for new roles ...');
237:: }
238:: $updateresult = '<span class="LC_info">'.$checkingtxt.'</span>';
239:: $updateresult .= &update_session_roles();
240:: &Apache::lonnet::appenv({'user.update.time' => $now});
241:: $update = $now;
242:: }
243::
1.6 www 244: my $envkey;
1.107 raeburn 245: my %dcroles = ();
1.256.2.6.2.1 (raeburn 246:: my $numdc = &check_fordc(\%dcroles,$update,$then);
1.148 albertel 247: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.255 raeburn 248: my $loncaparev = $Apache::lonnet::perlvar{'lonVersion'};
1.10 www 249:
1.6 www 250: # ================================================================== Roles Init
1.118 albertel 251: if ($env{'form.selectrole'}) {
1.188 www 252:
253: my $locknum=&Apache::lonnet::get_locks();
254: if ($locknum) { return 409; }
255:
1.134 www 256: if ($env{'form.newrole'}) {
257: $env{'form.'.$env{'form.newrole'}}=1;
258: }
1.118 albertel 259: if ($env{'request.course.id'}) {
1.185 raeburn 260: # Check if user is CC trying to select a course role
261: if ($env{'form.switchrole'}) {
1.252 raeburn 262: my $switch_is_active;
263: if (defined($env{'user.role.'.$env{'form.switchrole'}})) {
264: my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
265: if (!$end || $end > $now) {
1.256.2.6.2.1 (raeburn 266:: if (!$start || $start < $update) {
1.252 raeburn 267: $switch_is_active = 1;
268: }
269: }
270: }
271: unless ($switch_is_active) {
1.256.2.6.2.1 (raeburn 272:: &adhoc_course_role($refresh,$update,$then);
1.185 raeburn 273: }
274: }
1.118 albertel 275: my %temp=('logout_'.$env{'request.course.id'} => time);
1.33 www 276: &Apache::lonnet::put('email_status',\%temp);
1.118 albertel 277: &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
1.100 albertel 278: }
1.186 raeburn 279: &Apache::lonnet::appenv({"request.course.id" => '',
280: "request.course.fn" => '',
281: "request.course.uri" => '',
282: "request.course.sec" => '',
283: "request.role" => 'cm',
284: "request.role.adv" => $env{'user.adv'},
285: "request.role.domain" => $env{'user.domain'}});
1.182 www 286: # Check if user is a DC trying to enter a course or author space and needs privs to be created
1.107 raeburn 287: if ($numdc > 0) {
1.118 albertel 288: foreach my $envkey (keys %env) {
1.240 raeburn 289: # Is this an ad-hoc Coordinator role?
290: if (my ($ccrole,$domain,$coursenum) =
291: ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
1.146 raeburn 292: if ($dcroles{$domain}) {
1.218 raeburn 293: &Apache::lonnet::check_adhoc_privs($domain,$coursenum,
1.256.2.6.2.1 (raeburn 294:: $update,$refresh,$now,$ccrole);
1.182 www 295: }
296: last;
297: }
1.193 raeburn 298: # Is this an ad-hoc CA-role?
1.183 www 299: if (my ($domain,$user) =
300: ($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {
1.206 raeburn 301: if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) {
302: delete($env{$envkey});
303: $env{'form.au./'.$domain.'/'} = 1;
304: my ($server_status,$home) = &check_author_homeserver($user,$domain);
305: if ($server_status eq 'switchserver') {
306: my $trolecode = 'au./'.$domain.'/';
1.248 raeburn 307: my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;
1.206 raeburn 308: $r->internal_redirect($switchserver);
309: }
310: last;
311: }
312: if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {
313: if (((($castart) && ($castart < $now)) || !$castart) &&
314: ((!$caend) || (($caend) && ($caend > $now)))) {
315: my ($server_status,$home) = &check_author_homeserver($user,$domain);
316: if ($server_status eq 'switchserver') {
317: my $trolecode = 'ca./'.$domain.'/'.$user;
1.248 raeburn 318: my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;
1.206 raeburn 319: $r->internal_redirect($switchserver);
320: }
321: last;
322: }
323: }
324: # Check if author blocked ca-access
1.190 www 325: my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);
326: if ($blocked{'domcoord.author'} eq 'blocked') {
1.206 raeburn 327: delete($env{$envkey});
328: $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';
329: last;
1.190 www 330: }
1.193 raeburn 331: if ($dcroles{$domain}) {
332: my ($server_status,$home) = &check_author_homeserver($user,$domain);
333: if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {
1.256.2.6.2.1 (raeburn 334:: &Apache::lonnet::check_adhoc_privs($domain,$user,$update,
1.230 raeburn 335: $refresh,$now,'ca');
1.193 raeburn 336: if ($server_status eq 'switchserver') {
337: my $trolecode = 'ca./'.$domain.'/'.$user;
338: my $switchserver = '/adm/switchserver?'
1.248 raeburn 339: .'otherserver='.$home.'&role='.$trolecode;
1.193 raeburn 340: $r->internal_redirect($switchserver);
341: }
342: } else {
343: delete($env{$envkey});
344: }
1.183 www 345: } else {
346: delete($env{$envkey});
1.182 www 347: }
348: last;
349: }
1.107 raeburn 350: }
351: }
352:
1.118 albertel 353: foreach $envkey (keys %env) {
1.40 matthew 354: next if ($envkey!~/^user\.role\./);
1.102 raeburn 355: my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
1.256.2.6.2.1 (raeburn 356:: &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
1.218 raeburn 357: \$trolecode,\$tstatus,\$tstart,\$tend);
1.118 albertel 358: if ($env{'form.'.$trolecode}) {
1.55 albertel 359: if ($tstatus eq 'is') {
360: $where=~s/^\///;
361: my ($cdom,$cnum,$csec)=split(/\//,$where);
1.255 raeburn 362: if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
363: my $home = $env{'course.'.$cdom.'_'.$cnum.'.home'};
364: my @ids = &Apache::lonnet::current_machine_ids();
365: unless ($loncaparev eq '' && $home && grep(/^\Q$home\E$/,@ids)) {
366: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
1.256 raeburn 367: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
1.255 raeburn 368: my ($switchserver,$switchwarning) =
369: &check_release_required($loncaparev,$cdom.'_'.$cnum,$trolecode,$curr_reqd_hash{'internal.releaserequired'});
1.256 raeburn 370: if ($switchwarning ne '' || $switchserver ne '') {
371: &Apache::loncommon::content_type($r,'text/html');
372: &Apache::loncommon::no_cache($r);
373: $r->send_http_header;
374: my $end_page=&Apache::loncommon::end_page();
375: $r->print(&Apache::loncommon::start_page('Selected course unavailable on this server').
376: '<p class="LC_warning">');
377: if ($switchwarning) {
378: $r->print($switchwarning.'<br /><a href="/adm/roles">');
379: if (&Apache::loncommon::show_course()) {
380: $r->print(&mt('Display courses'));
381: } else {
382: $r->print(&mt('Display roles'));
383: }
384: $r->print('</a>');
385: } elsif ($switchserver) {
386: $r->print(&mt('This course requires a newer version of LON-CAPA than is installed on this server.').
387: '<br />'.
388: '<a href="/adm/switchserver?'.$switchserver.'">'.
389: &mt('Switch Server').
390: '</a>');
1.255 raeburn 391: }
1.256 raeburn 392: $r->print('</p>'.&Apache::loncommon::end_page());
393: return OK;
1.255 raeburn 394: }
395: }
396: }
397: }
1.137 raeburn 398: # check for course groups
399: my %coursegroups = &Apache::lonnet::get_active_groups(
400: $env{'user.domain'},$env{'user.name'},$cdom, $cnum);
401: my $cgrps = join(':',keys(%coursegroups));
402:
1.111 albertel 403: # store role if recent_role list being kept
1.118 albertel 404: if ($env{'environment.recentroles'}) {
1.158 albertel 405: my %frozen_roles =
406: &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.111 albertel 407: &Apache::lonhtmlcommon::store_recent('roles',
1.158 albertel 408: $trolecode,' ',$frozen_roles{$trolecode});
1.111 albertel 409: }
410:
411:
1.53 www 412: # check for keyed access
1.55 albertel 413: if (($role eq 'st') &&
1.118 albertel 414: ($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
1.89 www 415: # who is key authority?
416: my $authdom=$cdom;
417: my $authnum=$cnum;
1.118 albertel 418: if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
1.89 www 419: ($authnum,$authdom)=
1.172 albertel 420: split(/:/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'});
1.89 www 421: }
422: # check with key authority
423: unless (&Apache::lonnet::validate_access_key(
1.118 albertel 424: $env{'environment.key.'.$cdom.'_'.$cnum},
1.89 www 425: $authdom,$authnum)) {
1.53 www 426: # there is no valid key
1.118 albertel 427: if ($env{'form.newkey'}) {
1.53 www 428: # student attempts to register a new key
1.89 www 429: &Apache::loncommon::content_type($r,'text/html');
430: &Apache::loncommon::no_cache($r);
431: $r->send_http_header;
432: my $swinfo=&Apache::lonmenu::rawconfig();
1.147 albertel 433: my $start_page=&Apache::loncommon::start_page
1.89 www 434: ('Verifying Access Key to Unlock this Course');
1.147 albertel 435: my $end_page=&Apache::loncommon::end_page();
1.90 www 436: my $buttontext=&mt('Enter Course');
437: my $message=&mt('Successfully registered key');
438: my $assignresult=
439: &Apache::lonnet::assign_access_key(
1.118 albertel 440: $env{'form.newkey'},
1.90 www 441: $authdom,$authnum,
1.91 www 442: $cdom,$cnum,
1.118 albertel 443: $env{'user.domain'},
444: $env{'user.name'},
1.204 bisitz 445: &mt('Assigned from [_1] at [_2] for [_3]'
446: ,$ENV{'REMOTE_ADDR'}
447: ,&Apache::lonlocal::locallocaltime()
448: ,$trolecode)
449: );
1.90 www 450: unless ($assignresult eq 'ok') {
451: $assignresult=~s/^error\:\s*//;
452: $message=&mt($assignresult).
453: '<br /><a href="/adm/logout">'.
1.89 www 454: &mt('Logout').'</a>';
1.90 www 455: $buttontext=&mt('Re-Enter Key');
456: }
1.89 www 457: $r->print(<<ENDENTEREDKEY);
1.147 albertel 458: $start_page
1.179 raeburn 459: <script type="text/javascript">
1.225 bisitz 460: // <![CDATA[
1.89 www 461: $swinfo
1.225 bisitz 462: // ]]>
1.89 www 463: </script>
1.225 bisitz 464: <form action="" method="post">
1.89 www 465: <input type="hidden" name="selectrole" value="1" />
466: <input type="hidden" name="$trolecode" value="1" />
1.211 tempelho 467: <span class="LC_fontsize_large">$message</span><br />
1.89 www 468: <input type="submit" value="$buttontext" />
469: </form>
1.147 albertel 470: $end_page
1.89 www 471: ENDENTEREDKEY
472: return OK;
1.55 albertel 473: } else {
1.53 www 474: # print form to enter a new key
1.73 www 475: &Apache::loncommon::content_type($r,'text/html');
1.55 albertel 476: &Apache::loncommon::no_cache($r);
477: $r->send_http_header;
478: my $swinfo=&Apache::lonmenu::rawconfig();
1.147 albertel 479: my $start_page=&Apache::loncommon::start_page
1.55 albertel 480: ('Enter Access Key to Unlock this Course');
1.147 albertel 481: my $end_page=&Apache::loncommon::end_page();
1.55 albertel 482: $r->print(<<ENDENTERKEY);
1.147 albertel 483: $start_page
1.179 raeburn 484: <script type="text/javascript">
1.225 bisitz 485: // <![CDATA[
1.53 www 486: $swinfo
1.225 bisitz 487: // ]]>
1.53 www 488: </script>
1.225 bisitz 489: <form action="" method="post">
1.89 www 490: <input type="hidden" name="selectrole" value="1" />
491: <input type="hidden" name="$trolecode" value="1" />
1.118 albertel 492: <input type="text" size="20" name="newkey" value="$env{'form.newkey'}" />
1.53 www 493: <input type="submit" value="Enter key" />
494: </form>
1.147 albertel 495: $end_page
1.53 www 496: ENDENTERKEY
1.55 albertel 497: return OK;
498: }
499: }
500: }
1.118 albertel 501: &Apache::lonnet::log($env{'user.domain'},
502: $env{'user.name'},
503: $env{'user.home'},
1.87 www 504: "Role ".$trolecode);
1.101 albertel 505:
1.56 www 506: &Apache::lonnet::appenv(
1.186 raeburn 507: {'request.role' => $trolecode,
508: 'request.role.domain' => $cdom,
509: 'request.course.sec' => $csec,
510: 'request.course.groups' => $cgrps});
1.101 albertel 511: my $tadv=0;
1.62 matthew 512:
1.125 www 513: if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
1.152 raeburn 514: my $msg;
1.55 albertel 515: my ($furl,$ferr)=
516: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1.256.2.6.2.2! (raeburn 517:: unless (($ferr) || ($env{'form.switchrole'})) {
! 518:: &Apache::lonnet::put('nohist_crslastlogin',
! 519:: {$env{'user.name'}.':'.$env{'user.domain'}.
! 520:: ':'.$csec.':'.$role => $now},$cdom,$cnum);
! 521:: }
1.118 albertel 522: if (($env{'form.orgurl'}) &&
523: ($env{'form.orgurl'}!~/^\/adm\/flip/)) {
524: my $dest=$env{'form.orgurl'};
1.219 raeburn 525: if ($env{'form.symb'}) {
526: if ($dest =~ /\?/) {
527: $dest .= '&';
528: } else {
529: $dest .= '?'
530: }
531: $dest .= 'symb='.$env{'form.symb'};
532: }
1.117 albertel 533: if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
1.186 raeburn 534: &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
1.150 www 535: if (($ferr) && ($tadv)) {
536: &error_page($r,$ferr,$dest);
537: } else {
1.255 raeburn 538: if ($dest =~ m{^/adm/coursedocs\?folderpath}) {
539: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
540: my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
541: &update_content_constraints($cdom,$cnum,$chome,$cdom.'_'.$cnum);
542: }
543: }
1.150 www 544: $r->internal_redirect($dest);
545: }
1.55 albertel 546: return OK;
547: } else {
1.155 albertel 548: if (!$env{'request.course.id'}) {
1.55 albertel 549: &Apache::lonnet::appenv(
1.186 raeburn 550: {"request.course.id" => $cdom.'_'.$cnum});
1.61 www 551: $furl='/adm/roles?tryagain=1';
1.221 bisitz 552: $msg='<p><span class="LC_error">'
553: .&mt('Could not initialize [_1] at this time.',
554: $env{'course.'.$cdom.'_'.$cnum.'.description'})
555: .'</span></p>'
556: .'<p>'.&mt('Please try again.').'</p>'
557: .'<p>'.$ferr.'</p>';
1.55 albertel 558: }
1.117 albertel 559: if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
1.186 raeburn 560: &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
1.152 raeburn 561:
1.150 www 562: if (($ferr) && ($tadv)) {
563: &error_page($r,$ferr,$furl);
564: } else {
565: # Check to see if the user is a CC entering a course
566: # for the first time
567: my (undef, undef, $role, $courseid) = split(/\./, $envkey);
568: if (substr($courseid, 0, 1) eq '/') {
569: $courseid = substr($courseid, 1);
570: }
571: $courseid =~ s/\//_/;
1.240 raeburn 572: if ((($role eq 'cc') || ($role eq 'co'))
573: && ($env{'course.' . $courseid .'.course.helper.not.run'})) {
1.150 www 574: $furl = "/adm/helper/course.initialization.helper";
575: # Send the user to the course they selected
576: } elsif ($env{'request.course.id'}) {
1.185 raeburn 577: if ($env{'form.destinationurl'}) {
578: my $dest = $env{'form.destinationurl'};
1.203 raeburn 579: if ($env{'form.destsymb'} ne '') {
580: my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&');
581: $dest .= '?symb='.$esc_symb;
582: }
1.245 droeschl 583: &redirect_user($r, &mt('Entering [_1]',
584: $env{'course.'.$courseid.'.description'}),
1.256.2.1 raeburn 585: $dest, $msg,
586: $env{'environment.remotenavmap'});
1.185 raeburn 587: return OK;
588: }
1.150 www 589: if (&Apache::lonnet::allowed('whn',
590: $env{'request.course.id'})
591: || &Apache::lonnet::allowed('whn',
592: $env{'request.course.id'}.'/'
593: .$env{'request.course.sec'})
594: ) {
595: my $startpage = &courseloadpage($courseid);
596: unless ($startpage eq 'firstres') {
1.204 bisitz 597: $msg = &mt('Entering [_1] ...',
1.162 albertel 598: $env{'course.'.$courseid.'.description'});
1.256.2.1 raeburn 599: &redirect_user($r,&mt('New in course'),
600: '/adm/whatsnew?refpage=start',$msg,
601: $env{'environment.remotenavmap'});
1.150 www 602: return OK;
603: }
604: }
605: }
1.151 www 606: # Are we allowed to look at the first resource?
1.256.2.5 raeburn 607: if (($furl !~ m|^/adm/|) ||
608: (($env{'environment.remotenavmap'} eq 'on') &&
609: ($furl =~ m{^/adm/navmaps}))) {
1.151 www 610: # Guess not ...
611: $furl=&Apache::lonpageflip::first_accessible_resource();
612: }
1.162 albertel 613: $msg = &mt('Entering [_1] ...',
614: $env{'course.'.$courseid.'.description'});
1.256.2.1 raeburn 615: &redirect_user($r,&mt('Entering [_1]',
616: $env{'course.'.$courseid.'.description'}),
617: $furl,$msg,
618: $env{'environment.remotenavmap'});
1.58 bowersj2 619: }
1.124 albertel 620: return OK;
1.55 albertel 621: }
622: }
1.62 matthew 623: #
624: # Send the user to the construction space they selected
1.125 www 625: if ($role =~ /^(au|ca|aa)$/) {
1.62 matthew 626: my $redirect_url = '/priv/';
627: if ($role eq 'au') {
1.118 albertel 628: $redirect_url.=$env{'user.name'};
1.62 matthew 629: } else {
630: $where =~ /\/(.*)$/;
631: $redirect_url .= $1;
632: }
633: $redirect_url .= '/';
1.78 sakharuk 634: &redirect_user($r,&mt('Entering Construction Space'),
1.62 matthew 635: $redirect_url);
636: return OK;
637: }
1.104 raeburn 638: if ($role eq 'dc') {
1.108 raeburn 639: my $redirect_url = '/adm/menu/';
640: &redirect_user($r,&mt('Loading Domain Coordinator Menu'),
1.104 raeburn 641: $redirect_url);
1.108 raeburn 642: return OK;
1.104 raeburn 643: }
1.220 raeburn 644: if ($role eq 'sc') {
645: my $redirect_url = '/adm/grades?command=scantronupload';
646: &redirect_user($r,&mt('Loading Data Upload Page'),
647: $redirect_url);
648: return OK;
649: }
1.55 albertel 650: }
651: }
1.6 www 652: }
1.40 matthew 653: }
1.44 www 654:
1.10 www 655:
1.6 www 656: # =============================================================== No Roles Init
1.10 www 657:
1.73 www 658: &Apache::loncommon::content_type($r,'text/html');
1.30 albertel 659: &Apache::loncommon::no_cache($r);
1.10 www 660: $r->send_http_header;
661: return OK if $r->header_only;
662:
1.224 raeburn 663: my $crumbtext = 'User Roles';
664: my $pagetitle = 'My Roles';
665: my $recent = &mt('Recent Roles');
666: my $show_course=&Apache::loncommon::show_course();
667: if ($show_course) {
668: $crumbtext = 'Courses';
669: $pagetitle = 'My Courses';
670: $recent = &mt('Recent Courses');
671: }
672: my $brcrum =[{href=>"/adm/roles",text=>$crumbtext}];
1.52 www 673: my $swinfo=&Apache::lonmenu::rawconfig();
1.224 raeburn 674: my $start_page=&Apache::loncommon::start_page($pagetitle,undef,{bread_crumbs=>$brcrum});
1.134 www 675: my $standby=&mt('Role selected. Please stand by.');
1.135 albertel 676: $standby=~s/\n/\\n/g;
1.184 raeburn 677: my $noscript='<span class="LC_error">'.&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.').'<br />'.&mt('As this is not the case, most functionality in the system will be unavailable.').'</span><br />';
1.163 www 678:
1.10 www 679: $r->print(<<ENDHEADER);
1.147 albertel 680: $start_page
1.163 www 681: <br />
1.179 raeburn 682: <noscript>
683: $noscript
684: </noscript>
685: <script type="text/javascript">
1.225 bisitz 686: // <![CDATA[
1.26 www 687: $swinfo
688: window.focus();
1.134 www 689:
690: active=true;
691:
692: function enterrole (thisform,rolecode,buttonname) {
693: if (active) {
694: active=false;
695: document.title='$standby';
696: window.status='$standby';
697: thisform.newrole.value=rolecode;
698: thisform.submit();
699: } else {
700: alert('$standby');
701: }
702: }
1.256.2.6.2.1 (raeburn 703::
704:: function setToUpdate(thisform) {
705:: thisform.doupdate.value='1';
706:: thisform.selectrole.value='';
707:: thisform.submit();
708:: }
709::
1.225 bisitz 710: // ]]>
1.26 www 711: </script>
1.10 www 712: ENDHEADER
1.6 www 713:
1.2 www 714: # ------------------------------------------ Get Error Message from Environment
715:
1.118 albertel 716: my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$env{'user.error.msg'});
717: if ($env{'user.error.msg'}) {
1.55 albertel 718: $r->log_reason(
1.118 albertel 719: "$msg for $env{'user.name'} domain $env{'user.domain'} access $priv",$fn);
1.12 www 720: }
1.1 harris41 721:
1.61 www 722: # ------------------------------------------------- Can this user re-init, etc?
1.6 www 723:
1.118 albertel 724: my $advanced=$env{'user.adv'};
1.61 www 725: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']);
1.118 albertel 726: my $tryagain=$env{'form.tryagain'};
1.209 raeburn 727: my $reinit=$env{'user.reinit'};
728: delete $env{'user.reinit'};
1.6 www 729:
1.2 www 730: # -------------------------------------------------------- Generate Page Output
1.6 www 731: # --------------------------------------------------------------- Error Header?
1.2 www 732: if ($error) {
1.187 bisitz 733: $r->print("<h1>".&mt('LON-CAPA Access Control')."</h1>");
1.174 albertel 734: $r->print("<!-- LONCAPAACCESSCONTROLERRORSCREEN --><hr /><pre>");
735: if ($priv ne '') {
1.187 bisitz 736: $r->print(&mt('Access : ').&Apache::lonnet::plaintext($priv)."\n");
1.174 albertel 737: }
738: if ($fn ne '') {
1.187 bisitz 739: $r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n");
1.174 albertel 740: }
741: if ($msg ne '') {
1.187 bisitz 742: $r->print(&mt('Action : ').$msg."\n");
1.174 albertel 743: }
744: $r->print("</pre><hr />");
1.120 albertel 745: my $url=$fn;
746: my $last;
747: if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
748: &GDBM_READER(),0640)) {
749: $last=$hash{'last_known'};
750: untie(%hash);
751: }
1.149 www 752: if ($last) { $fn.='?symb='.&escape($last); }
1.120 albertel 753:
754: &Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.',
755: &Apache::lonenc::check_encrypt($fn));
1.2 www 756: } else {
1.118 albertel 757: if ($env{'user.error.msg'}) {
1.209 raeburn 758: if ($reinit) {
759: $r->print(
760: '<h3><span class="LC_error">'.
1.234 raeburn 761: &mt('As your session file for the course or community has expired, you will need to re-select it.').'</span></h3>');
1.209 raeburn 762: } else {
763: $r->print(
1.157 albertel 764: '<h3><span class="LC_error">'.
1.235 bisitz 765: &mt('You need to choose another user role or enter a specific course or community for this function.').
766: '</span></h3>');
1.209 raeburn 767: }
768: }
1.2 www 769: }
1.6 www 770: # -------------------------------------------------------- Choice or no choice?
1.2 www 771: if ($nochoose) {
1.256.2.6.2.1 (raeburn 772:: $r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".
773:: &mt('This action is currently not authorized.').'</span>'.
774:: &Apache::loncommon::end_page());
775:: return OK;
1.6 www 776: } else {
1.256.2.6.2.1 (raeburn 777:: $r->print($updateresult);
1.18 www 778: if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
1.256.2.6.2.1 (raeburn 779:: $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
1.6 www 780: }
1.84 www 781: $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
1.116 albertel 782: $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');
783: $r->print('<input type="hidden" name="selectrole" value="1" />');
1.134 www 784: $r->print('<input type="hidden" name="newrole" value="" />');
1.6 www 785: }
1.256.2.4 raeburn 786: $r->rflush();
1.226 raeburn 787:
788: my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);
1.256.2.6.2.1 (raeburn 789:: my ($countactive,$countfuture,$inrole,$possiblerole) =
790:: &gather_roles($update,$refresh,$now,$reinit,$nochoose,\%roletext,\%sortrole,\%roleclass,
1.254 raeburn 791: \%futureroles,\%timezones,$loncaparev);
1.226 raeburn 792: $refresh = $now;
793: &Apache::lonnet::appenv({'user.refresh.time' => $refresh});
1.256.2.6.2.1 (raeburn 794:: my $updatebutton = &mt('Check for role changes');
795:: my $show_course=&Apache::loncommon::show_course();
796:: if ($show_course) {
797:: $updatebutton = &mt('Check for new courses');
798:: }
799:: my $do_update;
800:: unless (($env{'form.source'} eq 'login') || ($env{'form.doupdate'})) {
801:: $do_update = '<input type="hidden" name="doupdate" value="" />'.
802:: '<input type="button" name="update" value="'.
803:: $updatebutton.'" onclick="javascript:setToUpdate(this.form)" />';
804:: }
1.196 raeburn 805: if ($env{'user.adv'}) {
1.256.2.6.2.1 (raeburn 806:: my $showall = '<label><input type="checkbox" name="showall"';
807:: if ($env{'form.showall'}) {
808:: $showall .= ' checked="checked" ';
809:: }
810:: $showall .= ' />'.&mt('Show all roles').'</label> '.
811:: '<input type="submit" value="'.&mt('Update display').'" />';
812:: if ($do_update) {
813:: $r->print('<div class="LC_left_float"><fieldset>'.
814:: '<legend>'. &mt('Display').'</legend>'.
815:: $showall.'</fieldset></div>'.
816:: '<div class="LC_left_float"><fieldset><legend>'.
817:: &mt('Changes?').'</legend>'.
818:: $do_update.'</fieldset></div><br clear="all" />');
819:: } else {
820:: $r->print($showall);
821:: }
1.196 raeburn 822: } else {
1.256.2.6.2.1 (raeburn 823:: $r->print('<p>'.$do_update.'</p>');
1.196 raeburn 824: if ($countactive > 0) {
1.241 raeburn 825: $r->print(&Apache::loncoursequeueadmin::queued_selfenrollment());
1.196 raeburn 826: my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
1.256.2.6.2.1 (raeburn 827:: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1.233 bisitz 828: $r->print(
829: '<p>'
830: .&mt('[_1]Visit the [_2]Course/Community Catalog[_3]'
831: .' to view all [_4] LON-CAPA courses and communities.'
832: ,'<b>'
833: ,'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">'
834: ,'</a></b>',$domdesc)
835: .'<br />'
1.235 bisitz 836: .&mt('If a course or community is [_1]not[_2] in your list of current courses and communities below,'
1.233 bisitz 837: .' you may be able to enroll if self-enrollment is permitted.'
838: ,'<b>','</b>')
839: .'</p>'
840: );
1.196 raeburn 841: }
842: }
843:
1.84 www 844: # No active roles
845: if ($countactive==0) {
846: if ($inrole) {
1.234 raeburn 847: $r->print('<h2>'.&mt('Currently no additional roles, courses or communities').'</h2>');
1.84 www 848: } else {
1.234 raeburn 849: $r->print('<h2>'.&mt('Currently no active roles, courses or communities').'</h2>');
1.84 www 850: }
1.191 raeburn 851: &findcourse_advice($r);
1.234 raeburn 852: &requestcourse_advice($r);
1.191 raeburn 853: $r->print('</form>');
854: if ($countfuture) {
855: $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture));
856: my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,
857: $nochoose);
858: &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,
859: \%roletext);
860: my $tremark='';
1.212 bisitz 861: my $tbg;
1.191 raeburn 862: if ($env{'request.role'} eq 'cm') {
1.212 bisitz 863: $tbg="LC_roles_selected";
1.204 bisitz 864: $tremark=&mt('Currently selected.').' ';
1.191 raeburn 865: } else {
1.212 bisitz 866: $tbg="LC_roles_is";
1.191 raeburn 867: }
1.212 bisitz 868: $r->print(&Apache::loncommon::start_data_table_row()
869: .'<td class="'.$tbg.'"> </td>'
870: .'<td colspan="3">'
871: .&mt('No role specified')
872: .'</td>'
873: .'<td>'.$tremark.' </td>'
874: .&Apache::loncommon::end_data_table_row()
875: );
1.191 raeburn 876:
1.212 bisitz 877: $r->print(&Apache::loncommon::end_data_table());
1.191 raeburn 878: }
879: $r->print(&Apache::loncommon::end_page());
1.84 www 880: return OK;
881: }
882: # ----------------------------------------------------------------------- Table
1.247 raeburn 883:
884: if ($numdc > 0) {
885: $r->print(&coursepick_jscript());
886: $r->print(&Apache::loncommon::coursebrowser_javascript().
887: &Apache::loncommon::authorbrowser_javascript());
888: }
889:
1.224 raeburn 890: unless ((!&Apache::loncommon::show_course()) || ($nochoose) || ($countactive==1)) {
1.173 albertel 891: $r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");
1.84 www 892: }
1.229 raeburn 893: if ($env{'form.destinationurl'}) {
894: $r->print('<input type="hidden" name="destinationurl" value="'.
895: $env{'form.destinationurl'}.'" />');
896: if ($env{'form.destsymb'} ne '') {
897: $r->print('<input type="hidden" name="destsymb" value="'.
898: $env{'form.destsymb'}.'" />');
899: }
900: }
1.247 raeburn 901:
1.191 raeburn 902: my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose);
1.118 albertel 903: if ($env{'environment.recentroles'}) {
1.111 albertel 904: my %recent_roles =
1.118 albertel 905: &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.111 albertel 906: my $output='';
1.247 raeburn 907: foreach my $role (sort(keys(%recent_roles))) {
908: if (ref($roletext{'user.role.'.$role}) eq 'ARRAY') {
1.223 raeburn 909: $output.= &Apache::loncommon::start_data_table_row().
1.247 raeburn 910: $roletext{'user.role.'.$role}->[0].
1.223 raeburn 911: &Apache::loncommon::end_data_table_row();
1.249 raeburn 912: if ($roletext{'user.role.'.$role}->[1] ne '') {
913: $output .= &Apache::loncommon::continue_data_table_row().
914: $roletext{'user.role.'.$role}->[1].
915: &Apache::loncommon::end_data_table_row();
916: }
1.247 raeburn 917: if ($role =~ m{dc\./($match_domain)/}
1.170 albertel 918: && $dcroles{$1}) {
1.192 raeburn 919: $output .= &adhoc_roles_row($1,'recent');
1.133 albertel 920: }
1.113 raeburn 921: } elsif ($numdc > 0) {
1.247 raeburn 922: unless ($role =~/^error\:/) {
1.249 raeburn 923: my ($roletext,$role_text_end) = &display_cc_role('user.role.'.$role);
1.256.2.4 raeburn 924: if ($roletext) {
925: $output.= &Apache::loncommon::start_data_table_row().
926: $roletext.
927: &Apache::loncommon::end_data_table_row();
928: if ($role_text_end) {
929: $output .= &Apache::loncommon::continue_data_table_row().
930: $role_text_end.
931: &Apache::loncommon::end_data_table_row();
932: }
933: }
1.113 raeburn 934: }
1.247 raeburn 935: }
1.111 albertel 936: }
937: if ($output) {
1.212 bisitz 938: $r->print(&Apache::loncommon::start_data_table_empty_row()
939: .'<td align="center" colspan="5">'
1.224 raeburn 940: .$recent
1.212 bisitz 941: .'</td>'
942: .&Apache::loncommon::end_data_table_empty_row()
943: );
1.111 albertel 944: $r->print($output);
1.114 raeburn 945: $doheaders ++;
1.111 albertel 946: }
947: }
1.191 raeburn 948: &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext);
1.202 raeburn 949: if ($countactive > 1) {
950: my $tremark='';
1.212 bisitz 951: my $tbg;
1.202 raeburn 952: if ($env{'request.role'} eq 'cm') {
1.212 bisitz 953: $tbg="LC_roles_selected";
1.204 bisitz 954: $tremark=&mt('Currently selected.').' ';
1.202 raeburn 955: } else {
1.212 bisitz 956: $tbg="LC_roles_is";
1.202 raeburn 957: }
1.212 bisitz 958: $r->print(&Apache::loncommon::start_data_table_row());
1.202 raeburn 959: unless ($nochoose) {
960: if ($env{'request.role'} ne 'cm') {
1.212 bisitz 961: $r->print('<td class="'.$tbg.'"><input type="submit" value="'.
1.202 raeburn 962: &mt('Select').'" name="cm" /></td>');
963: } else {
1.212 bisitz 964: $r->print('<td class="'.$tbg.'"> </td>');
1.202 raeburn 965: }
966: }
1.212 bisitz 967: $r->print('<td colspan="3">'
968: .&mt('No role specified')
969: .'</td>'
970: .'<td>'.$tremark.' </td>'
971: .&Apache::loncommon::end_data_table_row()
972: );
1.202 raeburn 973: }
1.212 bisitz 974: $r->print(&Apache::loncommon::end_data_table());
1.4 www 975: unless ($nochoose) {
976: $r->print("</form>\n");
977: }
1.22 harris41 978: # ------------------------------------------------------------ Privileges Info
1.118 albertel 979: if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
1.212 bisitz 980: $r->print('<hr /><h2>'.&mt('Current Privileges').'</h2>');
1.175 albertel 981: $r->print(&privileges_info());
1.4 www 982: }
1.66 www 983: $r->print(&Apache::lonnet::getannounce());
1.65 www 984: if ($advanced) {
1.201 raeburn 985: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1.231 bisitz 986: $r->print('<p><small><i>'
987: .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion'))
988: .'</i><br />'
989: .'<a href="/adm/logout">'.&mt('Logout').'</a> '
1.201 raeburn 990: .'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">'
1.233 bisitz 991: .&mt('Course/Community Catalog')
1.225 bisitz 992: .'</a></small></p>');
1.65 www 993: }
1.147 albertel 994: $r->print(&Apache::loncommon::end_page());
1.1 harris41 995: return OK;
1.102 raeburn 996: }
997:
1.226 raeburn 998: sub gather_roles {
1.256.2.6.2.1 (raeburn 999:: my ($update,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones,$loncaparev) = @_;
1.226 raeburn 1000: my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
1001: my $advanced = $env{'user.adv'};
1002: my $tryagain = $env{'form.tryagain'};
1.254 raeburn 1003: my @ids = &Apache::lonnet::current_machine_ids();
1.226 raeburn 1004: foreach my $envkey (sort(keys(%env))) {
1005: my $button = 1;
1006: my $switchserver='';
1.254 raeburn 1007: my $switchwarning;
1.226 raeburn 1008: my ($role_text,$role_text_end,$sortkey);
1009: if ($envkey=~/^user\.role\./) {
1010: my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
1.256.2.6.2.1 (raeburn 1011:: &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
1.226 raeburn 1012: \$trolecode,\$tstatus,\$tstart,\$tend);
1013: next if (!defined($role) || $role eq '' || $role =~ /^gr/);
1014: $tremark='';
1015: $tpstart=' ';
1016: $tpend=' ';
1017: if ($env{'request.role'} eq $trolecode) {
1018: $tstatus='selected';
1019: }
1020: my $tbg;
1021: if (($tstatus eq 'is')
1022: || ($tstatus eq 'selected')
1023: || ($tstatus eq 'future')
1024: || ($env{'form.showall'})) {
1.256.2.4 raeburn 1025: my $timezone = &role_timezone($where,$timezones);
1026: if ($tstart) {
1027: $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone);
1028: }
1029: if ($tend) {
1030: $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone);
1031: }
1.226 raeburn 1032: if ($tstatus eq 'is') {
1033: $tbg='LC_roles_is';
1034: $possiblerole=$trolecode;
1035: $countactive++;
1036: } elsif ($tstatus eq 'future') {
1037: $tbg='LC_roles_future';
1038: $button=0;
1039: $futureroles->{$trolecode} = $tstart.':'.$tend;
1040: $countfuture ++;
1041: } elsif ($tstatus eq 'expired') {
1042: $tbg='LC_roles_expired';
1043: $button=0;
1044: } elsif ($tstatus eq 'will_not') {
1045: $tbg='LC_roles_will_not';
1046: $tremark.=&mt('Expired after logout.').' ';
1047: } elsif ($tstatus eq 'selected') {
1048: $tbg='LC_roles_selected';
1049: $inrole=1;
1050: $countactive++;
1051: $tremark.=&mt('Currently selected.').' ';
1052: }
1053: my $trole;
1054: if ($role =~ /^cr\//) {
1055: my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
1056: if ($tremark) { $tremark.='<br />'; }
1.253 bisitz 1057: $tremark.=&mt('Customrole defined by [_1].',$rauthor.':'.$rdomain);
1.226 raeburn 1058: }
1059: $trole=Apache::lonnet::plaintext($role);
1060: my $ttype;
1061: my $twhere;
1062: my ($tdom,$trest,$tsection)=
1063: split(/\//,Apache::lonnet::declutter($where));
1064: # First, Co-Authorship roles
1065: if (($role eq 'ca') || ($role eq 'aa')) {
1066: my $home = &Apache::lonnet::homeserver($trest,$tdom);
1067: my $allowed=0;
1068: foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
1069: if (!$allowed) {
1070: $button=0;
1.248 raeburn 1071: $switchserver='otherserver='.$home.'&role='.$trolecode;
1.226 raeburn 1072: }
1073: #next if ($home eq 'no_host');
1074: $home = &Apache::lonnet::hostname($home);
1075: $ttype='Construction Space';
1076: $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
1077: ': '.$tdom.'<br />'.
1078: ' '.&mt('Server').': '.$home;
1079: $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
1080: $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
1081: $sortkey=$role."$trest:$tdom";
1082: } elsif ($role eq 'au') {
1083: # Authors
1084: my $home = &Apache::lonnet::homeserver
1085: ($env{'user.name'},$env{'user.domain'});
1086: my $allowed=0;
1087: foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
1088: if (!$allowed) {
1089: $button=0;
1.248 raeburn 1090: $switchserver='otherserver='.$home.'&role='.$trolecode;
1.226 raeburn 1091: }
1092: #next if ($home eq 'no_host');
1093: $home = &Apache::lonnet::hostname($home);
1094: $ttype='Construction Space';
1095: $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
1096: ': '.$home;
1097: $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
1098: $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
1099: $sortkey=$role;
1100: } elsif ($trest) {
1101: my $tcourseid=$tdom.'_'.$trest;
1102: $ttype = &Apache::loncommon::course_type($tcourseid);
1.242 raeburn 1103: $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
1.226 raeburn 1104: if ($env{'course.'.$tcourseid.'.description'}) {
1.254 raeburn 1105: my $home=$env{'course.'.$tcourseid.'.home'};
1.226 raeburn 1106: $twhere=$env{'course.'.$tcourseid.'.description'};
1107: $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1.248 raeburn 1108: $twhere = &HTML::Entities::encode($twhere,'"<>&');
1.226 raeburn 1109: unless ($twhere eq &mt('Currently not available')) {
1110: $twhere.=' <span class="LC_fontsize_small">'.
1111: &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
1112: '</span>';
1.254 raeburn 1113: unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
1.255 raeburn 1114: my $required = $env{'course.'.$tcourseid.'.internal.releaserequired'};
1.256.2.4 raeburn 1115: if ($required ne '') {
1116: ($switchserver,$switchwarning) =
1117: &check_release_required($loncaparev,$tcourseid,$trolecode,$required);
1118: if ($switchserver || $switchwarning) {
1119: $button = 0;
1120: }
1.254 raeburn 1121: }
1122: }
1.226 raeburn 1123: }
1124: } else {
1125: my %newhash=&Apache::lonnet::coursedescription($tcourseid);
1126: if (%newhash) {
1127: $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
1128: "\0".$envkey;
1.248 raeburn 1129: $twhere=&HTML::Entities::encode($newhash{'description'},'"<>&').
1130: ' <span class="LC_fontsize_small">'.
1131: &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
1132: '</span>';
1.226 raeburn 1133: $ttype = $newhash{'type'};
1.243 raeburn 1134: $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
1.254 raeburn 1135: my $home = $newhash{'home'};
1136: unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
1.255 raeburn 1137: my $required = $newhash{'internal.releaserequired'};
1.256.2.4 raeburn 1138: if ($required ne '') {
1139: ($switchserver,$switchwarning) =
1140: &check_release_required($loncaparev,$tcourseid,$trolecode,$required);
1141: if ($switchserver || $switchwarning) {
1142: $button = 0;
1143: }
1.254 raeburn 1144: }
1145: }
1.226 raeburn 1146: } else {
1147: $twhere=&mt('Currently not available');
1148: $env{'course.'.$tcourseid.'.description'}=$twhere;
1149: $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1150: $ttype = 'Unavailable';
1151: }
1152: }
1153: if ($tsection) {
1154: $twhere.='<br />'.&mt('Section').': '.$tsection;
1155: }
1156: if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; }
1157: } elsif ($tdom) {
1158: $ttype='Domain';
1159: $twhere=$tdom;
1160: $sortkey=$role.$twhere;
1161: } else {
1162: $ttype='System';
1163: $twhere=&mt('system wide');
1164: $sortkey=$role.$twhere;
1165: }
1166: ($role_text,$role_text_end) =
1167: &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
1168: $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
1.254 raeburn 1169: $tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning);
1.226 raeburn 1170: $roletext->{$envkey}=[$role_text,$role_text_end];
1171: if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
1172: $sortrole->{$sortkey}=$envkey;
1173: $roleclass->{$envkey}=$ttype;
1174: }
1175: }
1176: }
1177: return ($countactive,$countfuture,$inrole,$possiblerole);
1178: }
1179:
1.215 raeburn 1180: sub role_timezone {
1181: my ($where,$timezones) = @_;
1182: my $timezone;
1183: if (ref($timezones) eq 'HASH') {
1184: if ($where =~ m{^/($match_domain)/($match_courseid)}) {
1185: my $cdom = $1;
1186: my $cnum = $2;
1187: if ($cdom && $cnum) {
1188: if (!exists($timezones->{$cdom.'_'.$cnum})) {
1.256.2.4 raeburn 1189: my $tz;
1190: if ($env{'course.'.$cdom.'_'.$cnum.'.description'}) {
1191: $tz = $env{'course.'.$cdom.'_'.$cnum.'.timezone'};
1192: } else {
1193: my %timehash =
1194: &Apache::lonnet::get('environment',['timezone'],$cdom,$cnum);
1195: $tz = $timehash{'timezone'};
1196: }
1197: if ($tz eq '') {
1.215 raeburn 1198: if (!exists($timezones->{$cdom})) {
1199: my %domdefaults =
1200: &Apache::lonnet::get_domain_defaults($cdom);
1201: if ($domdefaults{'timezone_def'} eq '') {
1202: $timezones->{$cdom} = 'local';
1203: } else {
1204: $timezones->{$cdom} = $domdefaults{'timezone_def'};
1205: }
1206: }
1207: $timezones->{$cdom.'_'.$cnum} = $timezones->{$cdom};
1208: } else {
1209: $timezones->{$cdom.'_'.$cnum} =
1.256.2.4 raeburn 1210: &Apache::lonlocal::gettimezone($tz);
1.215 raeburn 1211: }
1212: }
1213: $timezone = $timezones->{$cdom.'_'.$cnum};
1214: }
1215: } else {
1216: my ($tdom) = ($where =~ m{^/($match_domain)});
1217: if ($tdom) {
1218: if (!exists($timezones->{$tdom})) {
1219: my %domdefaults = &Apache::lonnet::get_domain_defaults($tdom);
1220: if ($domdefaults{'timezone_def'} eq '') {
1221: $timezones->{$tdom} = 'local';
1222: } else {
1223: $timezones->{$tdom} = $domdefaults{'timezone_def'};
1224: }
1225: }
1226: $timezone = $timezones->{$tdom};
1227: }
1228: }
1229: if ($timezone eq 'local') {
1230: $timezone = undef;
1231: }
1232: }
1233: return $timezone;
1234: }
1235:
1.191 raeburn 1236: sub roletable_headers {
1237: my ($r,$roleclass,$sortrole,$nochoose) = @_;
1238: my $doheaders;
1239: if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) {
1.212 bisitz 1240: $r->print('<br />'
1241: .&Apache::loncommon::start_data_table()
1242: .&Apache::loncommon::start_data_table_header_row()
1243: );
1.191 raeburn 1244: if (!$nochoose) { $r->print('<th> </th>'); }
1.212 bisitz 1245: $r->print('<th>'.&mt('User Role').'</th>'
1246: .'<th>'.&mt('Extent').'</th>'
1247: .'<th>'.&mt('Start').'</th>'
1248: .'<th>'.&mt('End').'</th>'
1249: .&Apache::loncommon::end_data_table_header_row()
1250: );
1.191 raeburn 1251: $doheaders=-1;
1252: my @roletypes = &roletypes();
1253: foreach my $type (@roletypes) {
1254: my $haverole=0;
1255: foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) {
1256: if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) {
1257: $haverole=1;
1258: }
1259: }
1260: if ($haverole) { $doheaders++; }
1261: }
1262: }
1263: return $doheaders;
1264: }
1265:
1266: sub roletypes {
1.237 raeburn 1267: my @types = ('Domain','Construction Space','Course','Community','Unavailable','System');
1.191 raeburn 1268: return @types;
1269: }
1270:
1271: sub print_rolerows {
1272: my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext) = @_;
1273: if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) {
1274: my @types = &roletypes();
1275: foreach my $type (@types) {
1276: my $output;
1277: foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) {
1278: if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) {
1279: if (ref($roletext) eq 'HASH') {
1.223 raeburn 1280: if (ref($roletext->{$sortrole->{$which}}) eq 'ARRAY') {
1281: $output.= &Apache::loncommon::start_data_table_row().
1282: $roletext->{$sortrole->{$which}}->[0].
1283: &Apache::loncommon::end_data_table_row();
1.251 raeburn 1284: if ($roletext->{$sortrole->{$which}}->[1] ne '') {
1285: $output .= &Apache::loncommon::continue_data_table_row().
1286: $roletext->{$sortrole->{$which}}->[1].
1287: &Apache::loncommon::end_data_table_row();
1288: }
1.223 raeburn 1289: }
1.191 raeburn 1290: if ($sortrole->{$which} =~ m-dc\./($match_domain)/-) {
1291: if (ref($dcroles) eq 'HASH') {
1292: if ($dcroles->{$1}) {
1.192 raeburn 1293: $output .= &adhoc_roles_row($1,'');
1.191 raeburn 1294: }
1295: }
1296: }
1297: }
1298: }
1299: }
1300: if ($output) {
1301: if ($doheaders > 0) {
1.212 bisitz 1302: $r->print(&Apache::loncommon::start_data_table_empty_row()
1303: .'<td align="center" colspan="5">'
1304: .&mt($type)
1305: .'</td>'
1306: .&Apache::loncommon::end_data_table_empty_row()
1307: );
1.191 raeburn 1308: }
1309: $r->print($output);
1310: }
1311: }
1312: }
1313: }
1314:
1315: sub findcourse_advice {
1316: my ($r) = @_;
1317: my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
1.201 raeburn 1318: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1.200 raeburn 1319: if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) {
1.191 raeburn 1320: $r->print(&mt('If you were expecting to see an active role listed for a particular course in the [_1] domain, it may be missing for one of the following reasons:',$domdesc).'
1321: <ul>
1322: <li>'.&mt('The course has yet to be created.').'</li>
1323: <li>'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'</li>
1324: <li>'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'</li>
1325: <li>'.&mt('The start date for automated enrollment has yet to be reached.').'</li>
1326: <li>'.&mt('You registered for the course recently and there is a time lag between the time you register, and the time this information becomes available for the update of LON-CAPA course rosters.').'</li>
1327: </ul>');
1328: } else {
1329: $r->print(&mt('If you were expecting to see an active role listed for a particular course, that course may not have been created yet.').'<br />');
1330: }
1.235 bisitz 1331: $r->print('<h3>'.&mt('Self-Enrollment').'</h3>'.
1.234 raeburn 1332: '<p>'.&mt('The [_1]Course/Community Catalog[_2] provides information about all [_3] classes for which LON-CAPA courses have been created, as well as any communities in the domain.','<a href="/adm/coursecatalog?showdom='.$esc_dom.'">','</a>',$domdesc).'<br />');
1.241 raeburn 1333: $r->print(&mt('You can search for courses and communities which permit self-enrollment, if you would like to enroll in one.').'</p>'.
1334: &Apache::loncoursequeueadmin::queued_selfenrollment());
1.216 raeburn 1335: return;
1336: }
1337:
1.234 raeburn 1338: sub requestcourse_advice {
1339: my ($r) = @_;
1340: my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
1341: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1342: my (%can_request,%request_doms);
1343: &Apache::lonnet::check_can_request($env{'user.domain'},\%can_request,\%request_doms);
1344: if (keys(%request_doms) > 0) {
1345: my ($types,$typename) = &Apache::loncommon::course_types();
1346: if ((ref($types) eq 'ARRAY') && (ref($typename) eq 'HASH')) {
1347: $r->print('<h3>'.&mt('Request creation of a course or community').'</h3>'.
1.238 bisitz 1348: '<p>'.&mt('You have rights to request the creation of courses and/or communities in the following domain(s):').'<ul>');
1.234 raeburn 1349: my (@reqdoms,@reqtypes);
1350: foreach my $type (sort(keys(%request_doms))) {
1351: push(@reqtypes,$type);
1352: if (ref($request_doms{$type}) eq 'ARRAY') {
1353: my $domstr = join(', ',map { &Apache::lonnet::domain($_) } sort(@{$request_doms{$type}}));
1.238 bisitz 1354: $r->print(
1355: '<li>'
1356: .&mt('[_1]'.$typename->{$type}.'[_2] in domain: [_3]',
1357: '<i>',
1358: '</i>',
1359: '<b>'.$domstr.'</b>')
1360: .'</li>'
1361: );
1.234 raeburn 1362: foreach my $dom (@{$request_doms{$type}}) {
1363: unless (grep(/^\Q$dom\E/,@reqdoms)) {
1364: push(@reqdoms,$dom);
1365: }
1366: }
1367: }
1368: }
1369: my @showtypes;
1370: foreach my $type (@{$types}) {
1371: if (grep(/^\Q$type\E$/,@reqtypes)) {
1372: push(@showtypes,$type);
1373: }
1374: }
1375: my $requrl = '/adm/requestcourse';
1376: if (@reqdoms == 1) {
1377: $requrl .= '?showdom='.$reqdoms[0];
1378: }
1379: if (@showtypes > 0) {
1380: $requrl.=(($requrl=~/\?/)?'&':'?').'crstype='.$showtypes[0];
1381: }
1382: if (@reqdoms == 1 || @showtypes > 0) {
1383: $requrl .= '&state=crstype&action=new';
1384: }
1385: $r->print('</ul>'.&mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.','<a href="'.$requrl.'">','</a>').'</p>');
1386: }
1387: }
1388: return;
1389: }
1390:
1.175 albertel 1391: sub privileges_info {
1392: my ($which) = @_;
1393: my $output;
1394:
1395: $which ||= $env{'request.role'};
1396:
1397: foreach my $envkey (sort(keys(%env))) {
1398: next if ($envkey!~/^user\.priv\.\Q$which\E\.(.*)/);
1399:
1400: my $where=$1;
1401: my $ttype;
1402: my $twhere;
1403: my (undef,$tdom,$trest,$tsec)=split(m{/},$where);
1404: if ($trest) {
1405: if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
1406: $ttype='Construction Space';
1407: $twhere='User: '.$trest.', Domain: '.$tdom;
1408: } else {
1409: $ttype= &Apache::loncommon::course_type($tdom.'_'.$trest);
1410: $twhere=$env{'course.'.$tdom.'_'.$trest.'.description'};
1411: if ($tsec) {
1412: my $sec_type = 'Section';
1413: if (exists($env{"user.role.gr.$where"})) {
1414: $sec_type = 'Group';
1415: }
1416: $twhere.=' ('.$sec_type.': '.$tsec.')';
1417: }
1418: }
1419: } elsif ($tdom) {
1420: $ttype='Domain';
1421: $twhere=$tdom;
1422: } else {
1423: $ttype='System';
1424: $twhere='/';
1425: }
1.204 bisitz 1426: $output .= "\n<h3>".&mt($ttype).': '.$twhere.'</h3>'."\n<ul>";
1.175 albertel 1427: foreach my $priv (sort(split(/:/,$env{$envkey}))) {
1428: next if (!$priv);
1429:
1430: my ($prv,$restr)=split(/\&/,$priv);
1431: my $trestr='';
1432: if ($restr ne 'F') {
1433: $trestr.=' ('.
1434: join(', ',
1435: map { &Apache::lonnet::plaintext($_) }
1436: (split('',$restr))).') ';
1437: }
1438: $output .= "\n\t".
1439: '<li>'.&Apache::lonnet::plaintext($prv).$trestr.'</li>';
1440: }
1441: $output .= "\n".'</ul>';
1442: }
1443: return $output;
1444: }
1445:
1.110 raeburn 1446: sub build_roletext {
1.254 raeburn 1447: my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning) = @_;
1.223 raeburn 1448: my ($roletext,$roletext_end);
1.132 albertel 1449: my $is_dc=($trolecode =~ m/^dc\./);
1450: my $rowspan=($is_dc) ? ''
1451: : ' rowspan="2" ';
1452:
1.110 raeburn 1453: unless ($nochoose) {
1.134 www 1454: my $buttonname=$trolecode;
1455: $buttonname=~s/\W//g;
1.110 raeburn 1456: if (!$button) {
1457: if ($switchserver) {
1.212 bisitz 1458: $roletext.='<td'.$rowspan.' class="'.$tbg.'">'
1459: .'<a href="/adm/switchserver?'.$switchserver.'">'
1460: .&mt('Switch Server')
1461: .'</a></td>';
1.110 raeburn 1462: } else {
1.212 bisitz 1463: $roletext.=('<td'.$rowspan.' class="'.$tbg.'"> </td>');
1.110 raeburn 1464: }
1.255 raeburn 1465: if ($switchwarning) {
1466: if ($tremark eq '') {
1467: $tremark = $switchwarning;
1468: } else {
1469: $tremark .= '<br />'.$switchwarning;
1470: }
1471: }
1.110 raeburn 1472: } elsif ($tstatus eq 'is') {
1.212 bisitz 1473: $roletext.='<td'.$rowspan.' class="'.$tbg.'">'.
1474: '<input name="'.$buttonname.'" type="button" value="'.
1.225 bisitz 1475: &mt('Select').'" onclick="javascript:enterrole(this.form,\''.
1.192 raeburn 1476: $trolecode."','".$buttonname.'\');" /></td>';
1.110 raeburn 1477: } elsif ($tryagain) {
1478: $roletext.=
1.212 bisitz 1479: '<td'.$rowspan.' class="'.$tbg.'">'.
1480: '<input name="'.$buttonname.'" type="button" value="'.
1.225 bisitz 1481: &mt('Try Selecting Again').'" onclick="javascript:enterrole(this.form,\''.
1.192 raeburn 1482: $trolecode."','".$buttonname.'\');" /></td>';
1.110 raeburn 1483: } elsif ($advanced) {
1484: $roletext.=
1.212 bisitz 1485: '<td'.$rowspan.' class="'.$tbg.'">'.
1486: '<input name="'.$buttonname.'" type="button" value="'.
1.225 bisitz 1487: &mt('Re-Initialize').'" onclick="javascript:enterrole(this.form,\''.
1.192 raeburn 1488: $trolecode."','".$buttonname.'\');" /></td>';
1.209 raeburn 1489: } elsif ($reinit) {
1490: $roletext.=
1.212 bisitz 1491: '<td'.$rowspan.' class="'.$tbg.'">'.
1492: '<input name="'.$buttonname.'" type="button" value="'.
1.225 bisitz 1493: &mt('Re-Select').'" onclick="javascript:enterrole(this.form,\''.
1.209 raeburn 1494: $trolecode."','".$buttonname.'\');" /></td>';
1.110 raeburn 1495: } else {
1.209 raeburn 1496: $roletext.=
1.212 bisitz 1497: '<td'.$rowspan.' class="'.$tbg.'">'.
1498: '<input name="'.$buttonname.'" type="button" value="'.
1.225 bisitz 1499: &mt('Re-Select').'" onclick="javascript:enterrole(this.form,\''.
1.209 raeburn 1500: $trolecode."','".$buttonname.'\');" /></td>';
1.110 raeburn 1501: }
1502: }
1.165 albertel 1503: if ($trolecode !~ m/^(dc|ca|au|aa)\./) {
1504: $tremark.=&Apache::lonannounce::showday(time,1,
1505: &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
1506: }
1.212 bisitz 1507: $roletext.='<td>'.$trole.'</td>'
1508: .'<td>'.$twhere.'</td>'
1509: .'<td>'.$tpstart.'</td>'
1.223 raeburn 1510: .'<td>'.$tpend.'</td>';
1.132 albertel 1511: if (!$is_dc) {
1.223 raeburn 1512: $roletext_end = '<td colspan="4">'.
1513: $tremark.' '.
1514: '</td>';
1.132 albertel 1515: }
1.223 raeburn 1516: return ($roletext,$roletext_end);
1.110 raeburn 1517: }
1518:
1.202 raeburn 1519: sub check_needs_switchserver {
1520: my ($possiblerole) = @_;
1521: my $needs_switchserver;
1522: my ($role,$where) = split(/\./,$possiblerole,2);
1523: my (undef,$tdom,$twho) = split(/\//,$where);
1524: my ($server_status,$home);
1525: if (($role eq 'ca') || ($role eq 'aa')) {
1526: ($server_status,$home) = &check_author_homeserver($twho,$tdom);
1527: } else {
1528: ($server_status,$home) = &check_author_homeserver($env{'user.name'},
1529: $env{'user.domain'});
1530: }
1531: if ($server_status eq 'switchserver') {
1532: $needs_switchserver = 1;
1533: }
1534: return $needs_switchserver;
1535: }
1536:
1.193 raeburn 1537: sub check_author_homeserver {
1.183 www 1538: my ($uname,$udom)=@_;
1.193 raeburn 1539: if (($uname eq '') || ($udom eq '')) {
1540: return ('fail','');
1541: }
1.183 www 1542: my $home = &Apache::lonnet::homeserver($uname,$udom);
1.193 raeburn 1543: if (&Apache::lonnet::host_domain($home) ne $udom) {
1544: return ('fail',$home);
1545: }
1.183 www 1546: my @ids=&Apache::lonnet::current_machine_ids();
1.193 raeburn 1547: if (grep(/^\Q$home\E$/,@ids)) {
1548: return ('ok',$home);
1549: } else {
1550: return ('switchserver',$home);
1.183 www 1551: }
1552: }
1553:
1.104 raeburn 1554: sub check_fordc {
1.256.2.6.2.1 (raeburn 1555:: my ($dcroles,$update,$then) = @_;
1.104 raeburn 1556: my $numdc = 0;
1.118 albertel 1557: if ($env{'user.adv'}) {
1558: foreach my $envkey (sort keys %env) {
1.170 albertel 1559: if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) {
1.104 raeburn 1560: my $dcdom = $1;
1561: my $livedc = 1;
1.118 albertel 1562: my ($tstart,$tend)=split(/\./,$env{$envkey});
1.256.2.6.2.1 (raeburn 1563:: my $limit = $update;
1564:: if ($env{'request.role'} eq 'dc./'.$dcdom.'/') {
1565:: $limit = $then;
1566:: }
1567:: if ($tstart && $tstart>$limit) { $livedc = 0; }
1568:: if ($tend && $tend <$limit) { $livedc = 0; }
1.104 raeburn 1569: if ($livedc) {
1570: $$dcroles{$dcdom} = $envkey;
1.105 raeburn 1571: $numdc++;
1.104 raeburn 1572: }
1573: }
1574: }
1575: }
1576: return $numdc;
1577: }
1578:
1.185 raeburn 1579: sub adhoc_course_role {
1.256.2.6.2.1 (raeburn 1580:: my ($refresh,$update,$then) = @_;
1.239 raeburn 1581: my ($cdom,$cnum,$crstype);
1.201 raeburn 1582: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1583: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.239 raeburn 1584: $crstype = &Apache::loncommon::course_type();
1.256.2.6.2.1 (raeburn 1585:: if (&check_forcc($cdom,$cnum,$refresh,$update,$then,$crstype)) {
1.185 raeburn 1586: my $setprivs;
1.198 raeburn 1587: if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
1.185 raeburn 1588: $setprivs = 1;
1589: } else {
1.198 raeburn 1590: my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
1.232 raeburn 1591: if (($start && ($start>$refresh || $start == -1)) ||
1.256.2.6.2.1 (raeburn 1592:: ($end && $end<$update)) {
1.185 raeburn 1593: $setprivs = 1;
1594: }
1.232 raeburn 1595: }
1.185 raeburn 1596: if ($setprivs) {
1.198 raeburn 1597: if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)([\w/]*)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) {
1.185 raeburn 1598: my $role = $1;
1599: my $custom_role = $2;
1600: my $usec = $3;
1601: if ($role eq 'cr') {
1.199 raeburn 1602: if ($custom_role =~ m-^/$match_domain/$match_username/\w+$-) {
1.185 raeburn 1603: $role .= $custom_role;
1604: } else {
1605: return;
1606: }
1607: }
1.208 raeburn 1608: my (%userroles,%newrole,%newgroups,%group_privs);
1609: my %cgroups =
1610: &Apache::lonnet::get_active_groups($env{'user.domain'},
1611: $env{'user.name'},$cdom,$cnum);
1612: foreach my $group (keys(%cgroups)) {
1613: $group_privs{$group} =
1614: $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group};
1615: }
1616: $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs;
1.185 raeburn 1617: my $area = '/'.$cdom.'/'.$cnum;
1618: my $spec = $role.'.'.$area;
1619: if ($usec ne '') {
1620: $spec .= '/'.$usec;
1621: $area .= '/'.$usec;
1622: }
1623: &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area);
1.208 raeburn 1624: &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
1.232 raeburn 1625: my $adhocstart = $refresh-1;
1.185 raeburn 1626: $userroles{'user.role.'.$spec} = $adhocstart.'.';
1.186 raeburn 1627: &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
1.185 raeburn 1628: }
1629: }
1630: }
1631: return;
1632: }
1633:
1634: sub check_forcc {
1.256.2.6.2.1 (raeburn 1635:: my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
1.239 raeburn 1636: my ($is_cc,$ccrole);
1637: if ($crstype eq 'Community') {
1638: $ccrole = 'co';
1639: } else {
1640: $ccrole = 'cc';
1641: }
1.185 raeburn 1642: if ($cdom ne '' && $cnum ne '') {
1643: if (&Apache::lonnet::is_course($cdom,$cnum)) {
1.239 raeburn 1644: my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum;
1.185 raeburn 1645: if (defined($env{$envkey})) {
1646: $is_cc = 1;
1647: my ($tstart,$tend)=split(/\./,$env{$envkey});
1.256.2.6.2.1 (raeburn 1648:: my $limit = $update;
1649:: if ($env{'request.role'} eq $ccrole.'./'.$cdom.'/'.$cnum) {
1650:: $limit = $then;
1651:: }
1.232 raeburn 1652: if ($tstart && $tstart>$refresh) { $is_cc = 0; }
1.256.2.6.2.1 (raeburn 1653:: if ($tend && $tend <$limit) { $is_cc = 0; }
1.185 raeburn 1654: }
1655: }
1656: }
1657: return $is_cc;
1658: }
1659:
1.254 raeburn 1660: sub check_release_required {
1.255 raeburn 1661: my ($loncaparev,$tcourseid,$trolecode,$required) = @_;
1.254 raeburn 1662: my ($switchserver,$warning);
1.255 raeburn 1663: if ($required ne '') {
1664: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
1.256.2.2 raeburn 1665: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
1.254 raeburn 1666: if ($reqdmajor ne '' && $reqdminor ne '') {
1667: my $otherserver;
1668: if (($major eq '' && $minor eq '') ||
1669: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
1670: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'});
1671: my $switchlcrev =
1672: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
1673: $userdomserver);
1.256.2.2 raeburn 1674: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
1.254 raeburn 1675: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
1676: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
1677: my $cdom = $env{'course.'.$tcourseid.'.domain'};
1678: if ($cdom ne $env{'user.domain'}) {
1679: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom);
1680: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
1681: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1682: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
1683: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
1684: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
1685: my $canhost =
1686: &Apache::lonnet::can_host_session($env{'user.domain'},
1687: $coursedomserver,
1688: $remoterev,
1689: $udomdefaults{'remotesessions'},
1690: $defdomdefaults{'hostedsessions'});
1691:
1692: if ($canhost) {
1693: $otherserver = $coursedomserver;
1694: } else {
1695: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
1696: }
1697: } else {
1698: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
1699: }
1700: } else {
1701: $otherserver = $userdomserver;
1702: }
1703: }
1704: if ($otherserver ne '') {
1705: $switchserver = 'otherserver='.$otherserver.'&role='.$trolecode;
1706: }
1707: }
1708: }
1709: return ($switchserver,$warning);
1710: }
1711:
1.255 raeburn 1712: sub update_content_constraints {
1713: my ($cdom,$cnum,$chome,$cid) = @_;
1714: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
1715: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1716: my %checkresponsetypes;
1717: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1718: my ($item,$name,$value) = split(/:/,$key);
1719: if ($item eq 'resourcetag') {
1720: if ($name eq 'responsetype') {
1721: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
1722: }
1723: }
1724: }
1725: my $navmap = Apache::lonnavmaps::navmap->new();
1726: if (defined($navmap)) {
1727: my %allresponses;
1728: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
1729: my %responses = $res->responseTypes();
1730: foreach my $key (keys(%responses)) {
1731: next unless(exists($checkresponsetypes{$key}));
1732: $allresponses{$key} += $responses{$key};
1733: }
1734: }
1735: foreach my $key (keys(%allresponses)) {
1736: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
1737: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
1738: ($reqdmajor,$reqdminor) = ($major,$minor);
1739: }
1740: }
1741: undef($navmap);
1742: }
1743: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
1744: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
1745: }
1746: return;
1747: }
1748:
1.108 raeburn 1749: sub courselink {
1.193 raeburn 1750: my ($dcdom,$rowtype) = @_;
1.109 raeburn 1751: my $courseform=&Apache::loncommon::selectcourse_link
1.152 raeburn 1752: ('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
1753: 'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
1.239 raeburn 1754: $dcdom,$dcdom,undef,'Course/Community');
1.138 raeburn 1755: my $hiddenitems = '<input type="hidden" name="dcdomain'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
1756: '<input type="hidden" name="origdom'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
1757: '<input type="hidden" name="dccourse'.$rowtype.'_'.$dcdom.'" value="" />'.
1758: '<input type="hidden" name="coursedesc'.$rowtype.'_'.$dcdom.'" value="" />';
1.112 raeburn 1759: return $courseform.$hiddenitems;
1.109 raeburn 1760: }
1761:
1762: sub coursepick_jscript {
1.184 raeburn 1763: my %lt = &Apache::lonlocal::texthash(
1.239 raeburn 1764: plsu => "Please use the 'Select Course/Community' link to open a separate pick course window where you may select the course or community you wish to enter.",
1.234 raeburn 1765: youc => 'You can only use this screen to select courses and communities in the current domain.',
1.184 raeburn 1766: );
1.104 raeburn 1767: my $verify_script = <<"END";
1.179 raeburn 1768: <script type="text/javascript">
1.225 bisitz 1769: // <![CDATA[
1.108 raeburn 1770: function verifyCoursePick(caller) {
1771: var numbutton = getIndex(caller)
1.112 raeburn 1772: var pickedCourse = document.rolechoice.elements[numbutton+4].value
1773: var pickedDomain = document.rolechoice.elements[numbutton+2].value
1774: if (document.rolechoice.elements[numbutton+2].value == document.rolechoice.elements[numbutton+3].value) {
1.104 raeburn 1775: if (pickedCourse != '') {
1.108 raeburn 1776: if (numbutton != -1) {
1777: var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse
1778: document.rolechoice.elements[numbutton+1].name = courseTarget
1779: document.rolechoice.submit()
1780: }
1.104 raeburn 1781: }
1782: else {
1.184 raeburn 1783: alert("$lt{'plsu'}");
1.104 raeburn 1784: }
1785: }
1786: else {
1.184 raeburn 1787: alert("$lt{'youc'}")
1.104 raeburn 1788: }
1789: }
1.109 raeburn 1790: function getIndex(caller) {
1.108 raeburn 1791: for (var i=0;i<document.rolechoice.elements.length;i++) {
1.109 raeburn 1792: if (document.rolechoice.elements[i] == caller) {
1.108 raeburn 1793: return i;
1794: }
1795: }
1796: return -1;
1797: }
1.225 bisitz 1798: // ]]>
1.104 raeburn 1799: </script>
1800: END
1.109 raeburn 1801: return $verify_script;
1.104 raeburn 1802: }
1803:
1.193 raeburn 1804: sub coauthorlink {
1805: my ($dcdom,$rowtype) = @_;
1806: my $coauthorform=&Apache::loncommon::selectauthor_link('rolechoice',$dcdom);
1807: my $hiddenitems = '<input type="hidden" name="adhoccauname'.$rowtype.'_'.$dcdom.'" value="" />';
1808: return $coauthorform.$hiddenitems;
1809: }
1810:
1.113 raeburn 1811: sub display_cc_role {
1812: my $rolekey = shift;
1.223 raeburn 1813: my ($roletext,$roletext_end);
1.118 albertel 1814: my $advanced = $env{'user.adv'};
1815: my $tryagain = $env{'form.tryagain'};
1.113 raeburn 1816: unless ($rolekey =~/^error\:/) {
1.240 raeburn 1817: if ($rolekey =~ m{^user\.role\.(cc|co)\./($match_domain)/($match_courseid)$}) {
1818: my $ccrole = $1;
1.249 raeburn 1819: my $tdom = $2;
1820: my $trest = $3;
1821: my $tcourseid = $tdom.'_'.$trest;
1822: my $trolecode = $ccrole.'./'.$tdom.'/'.$trest;
1.113 raeburn 1823: my $twhere;
1.152 raeburn 1824: my $ttype;
1.212 bisitz 1825: my $tbg='LC_roles_is';
1.113 raeburn 1826: my %newhash=&Apache::lonnet::coursedescription($tcourseid);
1827: if (%newhash) {
1828: $twhere=$newhash{'description'}.
1.256.2.6 raeburn 1829: ' <span class="LC_fontsize_small">'.
1.249 raeburn 1830: &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
1.211 tempelho 1831: '</span>';
1.153 raeburn 1832: $ttype = $newhash{'type'};
1.113 raeburn 1833: } else {
1834: $twhere=&mt('Currently not available');
1.118 albertel 1835: $env{'course.'.$tcourseid.'.description'}=$twhere;
1.110 raeburn 1836: }
1.242 raeburn 1837: my $trole = &Apache::lonnet::plaintext($ccrole,$ttype,$tcourseid);
1.256.2.3 raeburn 1838: $twhere.="<br />".&mt('Domain').":".$tdom;
1.249 raeburn 1839: ($roletext,$roletext_end) = &build_roletext($trolecode,$tdom,$trest,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'');
1.104 raeburn 1840: }
1841: }
1.223 raeburn 1842: return ($roletext,$roletext_end);
1.104 raeburn 1843: }
1844:
1.192 raeburn 1845: sub adhoc_roles_row {
1.138 raeburn 1846: my ($dcdom,$rowtype) = @_;
1.212 bisitz 1847: my $output = &Apache::loncommon::continue_data_table_row()
1848: .' <td colspan="5">'
1849: .&mt('[_1]Ad hoc[_2] roles in domain [_3] --'
1850: ,'<span class="LC_cusr_emph">','</span>',$dcdom)
1.227 bisitz 1851: .' ';
1.193 raeburn 1852: my $selectcclink = &courselink($dcdom,$rowtype);
1.239 raeburn 1853: my $ccrole = &Apache::lonnet::plaintext('co',undef,undef,1);
1.182 www 1854: my $carole = &Apache::lonnet::plaintext('ca');
1.193 raeburn 1855: my $selectcalink = &coauthorlink($dcdom,$rowtype);
1.227 bisitz 1856: $output.=$ccrole.': '.$selectcclink
1.249 raeburn 1857: .' | '.$carole.': '.$selectcalink.'</td>'
1.212 bisitz 1858: .&Apache::loncommon::end_data_table_row();
1.108 raeburn 1859: return $output;
1860: }
1861:
1.104 raeburn 1862: sub recent_filename {
1863: my $area=shift;
1.149 www 1864: return 'nohist_recent_'.&escape($area);
1.104 raeburn 1865: }
1866:
1.139 raeburn 1867: sub courseloadpage {
1868: my ($courseid) = @_;
1869: my $startpage;
1.144 albertel 1870: my %entry_settings = &Apache::lonnet::get('nohist_whatsnew',
1871: [$courseid.':courseinit']);
1.139 raeburn 1872: my ($tmp) = %entry_settings;
1.144 albertel 1873: unless ($tmp =~ /^error: 2 /) {
1.139 raeburn 1874: $startpage = $entry_settings{$courseid.':courseinit'};
1875: }
1876: if ($startpage eq '') {
1877: if (exists($env{'environment.course_init_display'})) {
1878: $startpage = $env{'environment.course_init_display'};
1879: }
1880: }
1881: return $startpage;
1882: }
1883:
1.256.2.6.2.1 (raeburn 1884:: sub update_session_roles {
1885:: my $then=$env{'user.login.time'};
1886:: my $refresh=$env{'user.refresh.time'};
1887:: if (!$refresh) {
1888:: $refresh = $then;
1889:: }
1890:: my $update = $env{'user.update.time'};
1891:: if (!$update) {
1892:: $update = $then;
1893:: }
1894:: my $now = time;
1895:: my %roleshash =
1896:: &Apache::lonnet::get_my_roles('','','userroles',
1897:: ['active','future','previous'],
1898:: undef,undef,1);
1899:: my ($msg,@newsec,$oldsec,$currrole_expired,@changed_roles,
1900:: %changed_groups,%dbroles,%deletedroles,%allroles,%allgroups,
1901:: %userroles,%checkedgroup,%crprivs,$hasgroups,%rolechange,
1902:: %groupchange,%newrole,%newgroup,%customprivchg,%groups_roles,
1903:: @rolecodes);
1904:: my @possroles = ('cr','st','ta','ad','ep','in','co','cc');
1905:: my %courseroles;
1906:: foreach my $item (keys(%roleshash)) {
1907:: my ($uname,$udom,$role,$remainder) = split(/:/,$item,4);
1908:: my ($tstart,$tend) = split(/:/,$roleshash{$item});
1909:: my ($section,$group,@group_privs);
1910:: if ($role =~ m{^gr/(\w*)$}) {
1911:: $role = 'gr';
1912:: my $priv = $1;
1913:: next if ($tstart eq '-1');
1914:: if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
1915:: if ($priv ne '') {
1916:: push(@group_privs,$priv);
1917:: }
1918:: }
1919:: if ($remainder =~ /:/) {
1920:: (my $additional_privs,$group) =
1921:: ($remainder =~ /^([\w:]+):([^:]+)$/);
1922:: if ($additional_privs ne '') {
1923:: if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
1924:: push(@group_privs,split(/:/,$additional_privs));
1925:: @group_privs = sort(@group_privs);
1926:: }
1927:: }
1928:: } else {
1929:: $group = $remainder;
1930:: }
1931:: } else {
1932:: $section = $remainder;
1933:: }
1934:: my $where = "/$udom/$uname";
1935:: if ($section ne '') {
1936:: $where .= "/$section";
1937:: } elsif ($group ne '') {
1938:: $where .= "/$group";
1939:: }
1940:: my $rolekey = "$role.$where";
1941:: my $envkey = "user.role.$rolekey";
1942:: $dbroles{$envkey} = 1;
1943:: if (($env{'request.role'} eq $rolekey) && ($role ne 'st')) {
1944:: if (&curr_role_status($tstart,$tend,$refresh,$now) ne 'active') {
1945:: $currrole_expired = 1;
1946:: }
1947:: }
1948:: if ($env{$envkey} eq '') {
1949:: my $status_in_db =
1950:: &curr_role_status($tstart,$tend,$refresh,$now);
1951:: &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
1952:: if (($role eq 'st') && ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
1953:: if ($status_in_db eq 'active') {
1954:: if ($section eq '') {
1955:: push(@newsec,'none');
1956:: } else {
1957:: push(@newsec,$section);
1958:: }
1959:: }
1960:: } else {
1961:: unless (grep(/^\Q$role\E$/,@changed_roles)) {
1962:: push(@changed_roles,$role);
1963:: }
1964:: if ($status_in_db ne 'previous') {
1965:: if ($role eq 'gr') {
1966:: $newgroup{$rolekey} = $status_in_db;
1967:: if ($status_in_db eq 'active') {
1968:: unless (ref($courseroles{$udom}) eq 'HASH') {
1969:: %{$courseroles{$udom}} =
1970:: &Apache::lonnet::get_my_roles('','','userroles',
1971:: ['active'],\@possroles,
1972:: [$udom],1);
1973:: }
1974:: &Apache::lonnet::get_groups_roles($udom,$uname,
1975:: $courseroles{$udom},
1976:: \@rolecodes,\%groups_roles);
1977:: }
1978:: } else {
1979:: $newrole{$rolekey} = $status_in_db;
1980:: }
1981:: }
1982:: }
1983:: } else {
1984:: my ($currstart,$currend) = split(/\./,$env{$envkey});
1985:: if ($role eq 'gr') {
1986:: if (&curr_role_status($currstart,$currend,$refresh,$update) ne 'previous') {
1987:: $hasgroups = 1;
1988:: }
1989:: }
1990:: if (($currstart ne $tstart) || ($currend ne $tend)) {
1991:: my $status_in_env =
1992:: &curr_role_status($currstart,$currend,$refresh,$update);
1993:: my $status_in_db =
1994:: &curr_role_status($tstart,$tend,$refresh,$now);
1995:: if ($status_in_env ne $status_in_db) {
1996:: if ($status_in_env eq 'active') {
1997:: if ($role eq 'st') {
1998:: if ($env{'request.role'} eq $rolekey) {
1999:: my $switchsection;
2000:: unless (ref($courseroles{$udom}) eq 'HASH') {
2001:: %{$courseroles{$udom}} =
2002:: &Apache::lonnet::get_my_roles('','','userroles',
2003:: ['active'],
2004:: \@possroles,[$udom],1);
2005:: }
2006:: foreach my $crsrole (keys(%{$courseroles{$udom}})) {
2007:: if ($crsrole =~ /^\Q$uname\E:\Q$udom\E:st/) {
2008:: $switchsection = 1;
2009:: last;
2010:: }
2011:: }
2012:: if ($switchsection) {
2013:: if ($section eq '') {
2014:: $oldsec = 'none';
2015:: } else {
2016:: $oldsec = $section;
2017:: }
2018:: &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
2019:: } else {
2020:: $currrole_expired = 1;
2021:: next;
2022:: }
2023:: }
2024:: }
2025:: unless ($rolekey eq $env{'request.role'}) {
2026:: if ($role eq 'gr') {
2027:: &Apache::lonnet::delete_env_groupprivs($where,\%courseroles,\@possroles);
2028:: } else {
2029:: &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
2030:: &Apache::lonnet::delenv("user.priv.cm.$where",undef,['cm']);
2031:: }
2032:: &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
2033:: }
2034:: } elsif ($status_in_db eq 'active') {
2035:: if (($role eq 'st') &&
2036:: ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
2037:: if ($section eq '') {
2038:: push(@newsec,'none');
2039:: } else {
2040:: push(@newsec,$section);
2041:: }
2042:: } elsif ($role eq 'gr') {
2043:: unless (ref($courseroles{$udom}) eq 'HASH') {
2044:: %{$courseroles{$udom}} =
2045:: &Apache::lonnet::get_my_roles('','','userroles',
2046:: ['active'],
2047:: \@possroles,[$udom],1);
2048:: }
2049:: &Apache::lonnet::get_groups_roles($udom,$uname,
2050:: $courseroles{$udom},
2051:: \@rolecodes,\%groups_roles);
2052:: }
2053:: &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
2054:: }
2055:: unless (grep(/^\Q$role\E$/,@changed_roles)) {
2056:: push(@changed_roles,$role);
2057:: }
2058:: if ($role eq 'gr') {
2059:: $groupchange{"/$udom/$uname"}{$group} = $status_in_db;
2060:: } else {
2061:: $rolechange{$rolekey} = $status_in_db;
2062:: }
2063:: }
2064:: } else {
2065:: if ($role eq 'gr') {
2066:: unless ($checkedgroup{$where}) {
2067:: my $status_in_db =
2068:: &curr_role_status($tstart,$tend,$refresh,$now);
2069:: if ($tstart eq '-1') {
2070:: $status_in_db = 'deleted';
2071:: }
2072:: unless (ref($courseroles{$udom}) eq 'HASH') {
2073:: %{$courseroles{$udom}} =
2074:: &Apache::lonnet::get_my_roles('','','userroles',
2075:: ['active'],
2076:: \@possroles,[$udom],1);
2077:: }
2078:: if (ref($courseroles{$udom}) eq 'HASH') {
2079:: foreach my $item (keys(%{$courseroles{$udom}})) {
2080:: next unless ($item =~ /^\Q$uname\E/);
2081:: my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
2082:: my $area = '/'.$cdom.'/'.$cnum;
2083:: if ($crssec ne '') {
2084:: $area .= '/'.$crssec;
2085:: }
2086:: my $crsrolekey = $crsrole.'.'.$area;
2087:: my $currprivs = $env{'user.priv.'.$crsrole.'.'.$area.'.'.$where};
2088:: $currprivs =~ s/^://;
2089:: $currprivs =~ s/\&F$//;
2090:: my @curr_grp_privs = split(/\&F:/,$currprivs);
2091:: @curr_grp_privs = sort(@curr_grp_privs);
2092:: my @diffs;
2093:: if (@group_privs > 0 || @curr_grp_privs > 0) {
2094:: @diffs = &Apache::loncommon::compare_arrays(\@group_privs,\@curr_grp_privs);
2095:: }
2096:: if (@diffs == 0) {
2097:: last;
2098:: } else {
2099:: unless(grep(/^\Qgr\E$/,@rolecodes)) {
2100:: push(@rolecodes,'gr');
2101:: }
2102:: &gather_roleprivs(\%allroles,\%allgroups,
2103:: \%userroles,$where,$role,
2104:: $tstart,$tend,$status_in_db);
2105:: if ($status_in_db eq 'active') {
2106:: &Apache::lonnet::get_groups_roles($udom,$uname,
2107:: $courseroles{$udom},
2108:: \@rolecodes,\%groups_roles);
2109:: }
2110:: $changed_groups{$udom.'_'.$uname}{$group} = $status_in_db;
2111:: last;
2112:: }
2113:: }
2114:: }
2115:: $checkedgroup{$where} = 1;
2116:: }
2117:: } elsif ($role =~ /^cr/) {
2118:: my $status_in_db =
2119:: &curr_role_status($tstart,$tend,$refresh,$now);
2120:: my ($rdummy,$rest) = split(/\//,$role,2);
2121:: my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
2122:: my %currpriv;
2123:: unless (exists($crprivs{$rest})) {
2124:: my ($rdomain,$rauthor,$rrole)=split(/\//,$rest);
2125:: my $homsvr=&Apache::lonnet::homeserver($rauthor,$rdomain);
2126:: if (&Apache::lonnet::hostname($homsvr) ne '') {
2127:: my ($rdummy,$roledef)=
2128:: &Apache::lonnet::get('roles',["rolesdef_$rrole"],
2129:: $rdomain,$rauthor);
2130:: if (($rdummy ne 'con_lost') && ($roledef ne '')) {
2131:: my $i = 0;
2132:: my @scopes = ('sys','dom','crs');
2133:: my @privs = split(/\_/,$roledef);
2134:: foreach my $priv (@privs) {
2135:: my ($blank,@prv) = split(/:/,$priv);
2136:: @prv = map { $_ .= (/\&\w+$/ ? '':'&F') } @prv;
2137:: if (@prv) {
2138:: $priv = ':'.join(':',sort(@prv));
2139:: }
2140:: $crprivs{$rest}{$scopes[$i]} = $priv;
2141:: $i++;
2142:: }
2143:: }
2144:: }
2145:: }
2146:: $currpriv{sys} = $env{"user.priv.$rolekey./"};
2147:: $currpriv{dom} = $env{"user.priv.$rolekey./$udom/"};
2148:: $currpriv{crs} = $env{"user.priv.$rolekey.$where"};
2149:: if (keys(%crprivs)) {
2150:: if (($crprivs{$rest}{sys} ne $currpriv{sys}) ||
2151:: ($crprivs{$rest}{dom} ne $currpriv{dom})
2152:: ||
2153:: ($crprivs{$rest}{crs} ne $currpriv{crs})) {
2154:: &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
2155:: unless (grep(/^\Q$role\E$/,@changed_roles)) {
2156:: push(@changed_roles,$role);
2157:: }
2158:: my $status_in_env =
2159:: &curr_role_status($currstart,$currend,$refresh,$update);
2160:: if ($status_in_env eq 'active') {
2161:: $customprivchg{$rolekey} = $status_in_env;
2162:: }
2163:: }
2164:: }
2165:: }
2166:: }
2167:: }
2168:: }
2169:: foreach my $envkey (keys(%env)) {
2170:: next unless ($envkey =~ /^user\.role\./);
2171:: next if ($dbroles{$envkey});
2172:: next if ($envkey eq 'user.role.'.$env{'request.role'});
2173:: my ($currstart,$currend) = split(/\./,$env{$envkey});
2174:: my $status_in_env =
2175:: &curr_role_status($currstart,$currend,$refresh,$update);
2176:: my ($rolekey) = ($envkey =~ /^user\.role\.(.+)$/);
2177:: my ($role,$rest)=split(/\./,$rolekey,2);
2178:: if (&Apache::lonnet::delenv($envkey,undef,[$role])) {
2179:: if ($status_in_env eq 'active') {
2180:: if ($role eq 'gr') {
2181:: &Apache::lonnet::delete_env_groupprivs($rest,\%courseroles,
2182:: \@possroles);
2183:: } else {
2184:: &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
2185:: &Apache::lonnet::delenv("user.priv.cm.$rest",undef,['cm']);
2186:: }
2187:: unless (grep(/^\Q$role\E$/,@changed_roles)) {
2188:: push(@changed_roles,$role);
2189:: }
2190:: $deletedroles{$rolekey} = 1;
2191:: }
2192:: }
2193:: }
2194:: if (($oldsec) && (@newsec > 0)) {
2195:: if (@newsec > 1) {
2196:: $msg = '<div class="LC_warning">'.&mt('The section has changed for your current role. Log-out and log-in again to select a role for the new section.').'</div>';
2197:: } else {
2198:: my $newrole = $env{'request.role'};
2199:: if ($newsec[0] eq 'none') {
2200:: $newrole =~ s{(/[^/])$}{};
2201:: } elsif ($oldsec eq 'none') {
2202:: $newrole .= '/'.$newsec[0];
2203:: } else {
2204:: $newrole =~ s{([^/]+)$}{$newsec[0]};
2205:: }
2206:: my $coursedesc = $env{'course.'.$env{'request.course.id'}.'.description'};
2207:: my ($curr_role) = ($env{'request.role'} =~ m{^(\w+)\./$match_domain/$match_courseid});
2208:: my %temp=('logout_'.$env{'request.course.id'} => time);
2209:: &Apache::lonnet::put('email_status',\%temp);
2210:: &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
2211:: &Apache::lonnet::appenv({"request.course.id" => '',
2212:: "request.course.fn" => '',
2213:: "request.course.uri" => '',
2214:: "request.course.sec" => '',
2215:: "request.role" => 'cm',
2216:: "request.role.adv" => $env{'user.adv'},
2217:: "request.role.domain" => $env{'user.domain'}});
2218:: my $rolename = &Apache::loncommon::plainname($curr_role);
2219:: $msg = '<p><form name="reselectrole" action="/adm/roles" method="post" />'.
2220:: '<input type="hidden" name="newrole" value="" />'.
2221:: '<input type="hidden" name="selectrole" value="1" />'.
2222:: '<span class="LC_info">'.
2223:: &mt('Your section has changed for your current [_1] role in [_2].',$rolename,$coursedesc).'</span><br />';
2224:: my $button = '<input type="button" name="sectionchanged" value="'.
2225:: &mt('Re-Select').'" onclick="javascript:enterrole(this.form,'."'$newrole','sectionchanged'".')" />';
2226:: if ($newsec[0] eq 'none') {
2227:: $msg .= &mt('[_1] to continue with your new section-less role.',$button);
2228:: } else {
2229:: $msg .= &mt('[_1] to continue with your new role in section ([_2]).',$button,$newsec[0]);
2230:: }
2231:: $msg .= '</form></p>';
2232:: }
2233:: } elsif ($currrole_expired) {
2234:: $msg .= '<div class="LC_warning">';
2235:: if (&Apache::loncommon::show_course()) {
2236:: $msg .= &mt('Your role in the current course has expired.');
2237:: } else {
2238:: $msg .= &mt('Your current role has expired.');
2239:: }
2240:: $msg .= '<br />'.&mt('However you can continue to use this role until you logout, click the "Re-Select" button, or your session has been idle for more than 24 hours.').'</div>';
2241:: }
2242:: if (!@changed_roles || !(keys(%changed_groups))) {
2243:: my ($rolesmsg,$groupsmsg);
2244:: if (!@changed_roles) {
2245:: if (&Apache::loncommon::show_course()) {
2246:: $rolesmsg = &mt('No new courses or communities');
2247:: } else {
2248:: $rolesmsg = &mt('No role changes');
2249:: }
2250:: }
2251:: if ($hasgroups && !(keys(%changed_groups)) && !(grep(/gr/,@changed_roles))) {
2252:: $groupsmsg = &mt('No changes in course/community groups');
2253:: }
2254:: if (!@changed_roles && !(keys(%changed_groups))) {
2255:: if (($msg ne '') || ($groupsmsg ne '')) {
2256:: $msg .= '<ul>';
2257:: if ($rolesmsg) {
2258:: $msg .= '<li>'.$rolesmsg.'</li>';
2259:: }
2260:: if ($groupsmsg) {
2261:: $msg .= '<li>'.$groupsmsg.'</li>';
2262:: }
2263:: $msg .= '</ul>';
2264:: } else {
2265:: $msg = ' <span class="LC_cusr_emph">'.$rolesmsg.'</span><br />';
2266:: }
2267:: return $msg;
2268:: }
2269:: }
2270:: my $changemsg;
2271:: if (@changed_roles > 0) {
2272:: if (keys(%newgroup) > 0) {
2273:: my $groupmsg;
2274:: foreach my $item (sort(keys(%newgroup))) {
2275:: if (&is_active_course($item,$refresh,$update,\%roleshash)) {
2276:: $groupmsg .= '<li>'.
2277:: &mt('[_1] with status: [_2].',
2278:: $item,$newgroup{$item}).'</li>';
2279:: }
2280:: }
2281:: if ($groupmsg) {
2282:: $changemsg .= '<li>'.
2283:: &mt('Courses with new groups').'</li>'.
2284:: '<ul>'.$groupmsg.'</ul></li>';
2285:: }
2286:: }
2287:: if (keys(%newrole) > 0) {
2288:: $changemsg .= '<li>'.&mt('New roles').
2289:: '<ul>';
2290:: foreach my $item (sort(keys(%newrole))) {
2291:: $changemsg .= '<li>'.
2292:: &mt('[_1] with status: [_2].',
2293:: $item,$newrole{$item}).'</li>';
2294:: }
2295:: $changemsg .= '</ul></li>';
2296:: }
2297:: if (keys(%customprivchg) > 0) {
2298:: $changemsg .= '<li>'.
2299:: &mt('Custom roles with privilege changes').
2300:: '<ul>';
2301:: foreach my $item (sort(keys(%customprivchg))) {
2302:: $changemsg .= '<li>'.$item.'</li>';
2303:: }
2304:: $changemsg .= '</ul></li>';
2305:: }
2306:: if (keys(%rolechange) > 0) {
2307:: $changemsg .= '<li>'.
2308:: &mt('Existing roles with status changes').'</li>'.
2309:: '<ul>';
2310:: foreach my $item (sort(keys(%rolechange))) {
2311:: $changemsg .= '<li>'.
2312:: &mt('[_1] status now: [_2].',$item,
2313:: $rolechange{$item}).'</li>';
2314:: }
2315:: $changemsg .= '</ul></li>';
2316:: }
2317:: if (keys(%deletedroles) > 0) {
2318:: $changemsg .= '<li>'.
2319:: &mt('Existing roles deleted').'</li>'.
2320:: '<ul>';
2321:: foreach my $item (sort(keys(%deletedroles))) {
2322:: $changemsg .= '<li>'.$item.'</li>';
2323:: }
2324:: $changemsg .= '</ul></li>';
2325:: }
2326:: }
2327:: if ((keys(%changed_groups) > 0) || (keys(%groupchange) > 0)) {
2328:: my $groupchgmsg;
2329:: foreach my $key (sort(keys(%changed_groups))) {
2330:: my $crs = 'gr/'.$key;
2331:: $crs =~ s/_/\//;
2332:: if (&is_active_course($crs,$refresh,$update,\%roleshash)) {
2333:: if (ref($changed_groups{$key}) eq 'HASH') {
2334:: my @showgroups;
2335:: foreach my $group (sort(keys(%{$changed_groups{$key}}))) {
2336:: if ($changed_groups{$key}{$group} eq 'active') {
2337:: push(@showgroups,$group);
2338:: }
2339:: }
2340:: if (@showgroups > 0) {
2341:: $groupchgmsg .= '<li>'.
2342:: &mt('Course: [_1], groups: [_2].',$key,
2343:: join(', ',@showgroups)).
2344:: '</li>';
2345:: }
2346:: }
2347:: }
2348:: }
2349:: if (keys(%groupchange) > 0) {
2350:: $groupchgmsg .= '<li>'.
2351:: &mt('Existing course/community groups with status changes').'</li>'.
2352:: '<ul>';
2353:: foreach my $crs (sort(keys(%groupchange))) {
2354:: if (ref($groupchange{$crs}) eq 'HASH') {
2355:: $groupchgmsg .= '<li>'.&mt('Course/Community: [_1]','<b>'.$crs.'</b><ul>');
2356:: foreach my $group (sort(keys(%{$groupchange{$crs}}))) {
2357:: $groupchgmsg .= '<li>'.&mt('Group: [_1] status now: [_2].','<b>'.$group.'</b>',$groupchange{$crs}{$group}).'</li>';
2358:: }
2359:: $groupchgmsg .= '</ul></li>';
2360:: }
2361:: }
2362:: $groupchgmsg .= '</ul></li>';
2363:: }
2364:: if ($groupchgmsg) {
2365:: $changemsg .= '<li>'.
2366:: &mt('Courses with changes in groups').'</li>'.
2367:: '<ul>'.$groupchgmsg.'</ul></li>';
2368:: }
2369:: }
2370:: if ($changemsg) {
2371:: $msg .= '<ul>'.$changemsg.'</ul>';
2372:: }
2373:: &Apache::lonnet::set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
2374:: my ($curr_is_adv,$curr_role_adv,$curr_author,$curr_role_author);
2375:: $curr_author = $env{'user.author'};
2376:: if (($env{'request.role'} =~/^au/) || ($env{'request.role'} =~/^ca/) ||
2377:: ($env{'request.role'} =~/^aa/)) {
2378:: $curr_role_author=1;
2379:: }
2380:: $curr_is_adv = $env{'user.adv'};
2381:: $curr_role_adv = $env{'request.role.adv'};
2382:: if (keys(%userroles) > 0) {
2383:: foreach my $role (@changed_roles) {
2384:: unless(grep(/^\Q$role\E$/,@rolecodes)) {
2385:: push(@rolecodes,$role);
2386:: }
2387:: }
2388:: unless(grep(/^\Qcm\E$/,@rolecodes)) {
2389:: push(@rolecodes,'cm');
2390:: }
2391:: &Apache::lonnet::appenv(\%userroles,\@rolecodes);
2392:: }
2393:: my %newenv;
2394:: if (&Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'})) {
2395:: unless ($curr_is_adv) {
2396:: $newenv{'user.adv'} = 1;
2397:: }
2398:: } elsif ($curr_is_adv && !$curr_role_adv) {
2399:: &Apache::lonnet::delenv('user.adv');
2400:: }
2401:: my %authorroleshash =
2402:: &Apache::lonnet::get_my_roles('','','userroles',['active'],['au','ca','aa']);
2403:: if (keys(%authorroleshash)) {
2404:: unless ($curr_author) {
2405:: $newenv{'user.author'} = 1;
2406:: }
2407:: } elsif ($curr_author && !$curr_role_author) {
2408:: &Apache::lonnet::delenv('user.author');
2409:: }
2410:: if ($env{'request.course.id'}) {
2411:: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2412:: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2413:: my (@activecrsgroups,$crsgroupschanged);
2414:: if ($env{'request.course.groups'}) {
2415:: @activecrsgroups = split(/:/,$env{'request.course.groups'});
2416:: foreach my $item (keys(%deletedroles)) {
2417:: if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
2418:: if (grep(/^\Q$1\E$/,@activecrsgroups)) {
2419:: $crsgroupschanged = 1;
2420:: last;
2421:: }
2422:: }
2423:: }
2424:: }
2425:: unless ($crsgroupschanged) {
2426:: foreach my $item (keys(%newgroup)) {
2427:: if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
2428:: if ($newgroup{$item} eq 'active') {
2429:: $crsgroupschanged = 1;
2430:: last;
2431:: }
2432:: }
2433:: }
2434:: }
2435:: if ((ref($changed_groups{$env{'request.course.id'}}) eq 'HASH') ||
2436:: (ref($groupchange{"/$cdom/$cnum"}) eq 'HASH') ||
2437:: ($crsgroupschanged)) {
2438:: my %grouproles = &Apache::lonnet::get_my_roles('','','userroles',
2439:: ['active'],['gr'],[$cdom],1);
2440:: my @activegroups;
2441:: foreach my $item (keys(%grouproles)) {
2442:: next unless($item =~ /^\Q$cnum\E:\Q$cdom\E/);
2443:: my $group;
2444:: my ($crsn,$crsd,$role,$remainder) = split(/:/,$item,4);
2445:: if ($remainder =~ /:/) {
2446:: (my $other,$group) = ($remainder =~ /^([\w:]+):([^:]+)$/);
2447:: } else {
2448:: $group = $remainder;
2449:: }
2450:: if ($group ne '') {
2451:: push(@activegroups,$group);
2452:: }
2453:: }
2454:: $newenv{'request.course.groups'} = join(':',@activegroups);
2455:: }
2456:: }
2457:: if (keys(%newenv)) {
2458:: &Apache::lonnet::appenv(\%newenv);
2459:: }
2460:: return $msg;
2461:: }
2462::
2463:: sub curr_role_status {
2464:: my ($start,$end,$refresh,$update) = @_;
2465:: if (($start) && ($start<0)) { return 'deleted' };
2466:: my $status = 'active';
2467:: if (($end) && ($end<=$update)) {
2468:: $status = 'previous';
2469:: }
2470:: if (($start) && ($refresh<$start)) {
2471:: $status = 'future';
2472:: }
2473:: return $status;
2474:: }
2475::
2476:: sub gather_roleprivs {
2477:: my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend,$status) = @_;
2478:: return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH'));
2479:: if (($area ne '') && ($role ne '')) {
2480:: &Apache::lonnet::userrolelog($role,$env{'user.name'},$env{'user.domain'},
2481:: $area,$tstart,$tend);
2482:: my $spec=$role.'.'.$area;
2483:: $userroles->{'user.role.'.$spec} = $tstart.'.'.$tend;
2484:: my ($tdummy,$tdomain,$trest)=split(/\//,$area);
2485:: if ($status eq 'active') {
2486:: if ($role =~ /^cr\//) {
2487:: &Apache::lonnet::custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area);
2488:: } elsif ($role eq 'gr') {
2489:: my %rolehash = &Apache::lonnet::get('roles',[$area.'_'.$role],
2490:: $env{'user.domain'},
2491:: $env{'user.name'});
2492:: my ($trole) = split(/_/,$rolehash{$area.'_'.$role},2);
2493:: (undef,my $group_privs) = split(/\//,$trole);
2494:: $group_privs = &unescape($group_privs);
2495:: &Apache::lonnet::group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart);
2496:: } else {
2497:: &Apache::lonnet::standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area);
2498:: }
2499:: }
2500:: }
2501:: return;
2502:: }
2503::
2504:: sub is_active_course {
2505:: my ($rolekey,$refresh,$update,$roleshashref) = @_;
2506:: return unless(ref($roleshashref) eq 'HASH');
2507:: my ($role,$cdom,$cnum) = split(/\//,$rolekey);
2508:: my $is_active;
2509:: foreach my $key (keys(%{$roleshashref})) {
2510:: if ($key =~ /^\Q$cnum\E:\Q$cdom\E:/) {
2511:: my ($tstart,$tend) = split(/:/,$roleshashref->{$key});
2512:: my $status = &curr_role_status($tstart,$tend,$refresh,$update);
2513:: if ($status eq 'active') {
2514:: $is_active = 1;
2515:: last;
2516:: }
2517:: }
2518:: }
2519:: return $is_active;
2520:: }
2521::
1.1 harris41 2522: 1;
2523: __END__
1.32 harris41 2524:
2525: =head1 NAME
2526:
2527: Apache::lonroles - User Roles Screen
2528:
2529: =head1 SYNOPSIS
2530:
2531: Invoked by /etc/httpd/conf/srm.conf:
2532:
2533: <Location /adm/roles>
2534: PerlAccessHandler Apache::lonacc
2535: SetHandler perl-script
2536: PerlHandler Apache::lonroles
2537: ErrorDocument 403 /adm/login
2538: ErrorDocument 500 /adm/errorhandler
2539: </Location>
1.64 bowersj2 2540:
2541: =head1 OVERVIEW
2542:
2543: =head2 Choosing Roles
2544:
2545: C<lonroles> is a handler that allows a user to switch roles in
2546: mid-session. LON-CAPA attempts to work with "No Role Specified", the
2547: default role that a user has before selecting a role, as widely as
2548: possible, but certain handlers for example need specification which
2549: course they should act on, etc. Both in this scenario, and when the
2550: handler determines via C<lonnet>'s C<&allowed> function that a certain
2551: action is not allowed, C<lonroles> is used as error handler. This
2552: allows the user to select another role which may have permission to do
1.256.2.6.2.1 (raeburn 2553:: what they were trying to do.
1.64 bowersj2 2554:
2555: =begin latex
2556:
2557: \begin{figure}
2558: \begin{center}
2559: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
2560: \caption{\label{Sample_Roles_Screen}Sample Roles Screen}
2561: \end{center}
2562: \end{figure}
2563:
2564: =end latex
2565:
2566: =head2 Role Initialization
2567:
2568: The privileges for a user are established at login time and stored in the session environment. As a consequence, a new role does not become active till the next login. Handlers are able to query for privileges using C<lonnet>'s C<&allowed> function. When a user first logs in, their role is the "common" role, which means that they have the sum of all of their privileges. During a session it might become necessary to choose a particular role, which as a consequence also limits the user to only the privileges in that particular role.
1.32 harris41 2569:
2570: =head1 INTRODUCTION
2571:
2572: This module enables a user to select what role he wishes to
2573: operate under (instructor, student, teaching assistant, course
2574: coordinator, etc). These roles are pre-established by the actions
2575: of upper-level users.
2576:
2577: This is part of the LearningOnline Network with CAPA project
2578: described at http://www.lon-capa.org.
2579:
2580: =head1 HANDLER SUBROUTINE
2581:
2582: This routine is called by Apache and mod_perl.
2583:
2584: =over 4
2585:
2586: =item *
2587:
2588: Roles Initialization (yes/no)
2589:
2590: =item *
2591:
2592: Get Error Message from Environment
2593:
2594: =item *
2595:
2596: Who is this?
2597:
2598: =item *
2599:
2600: Generate Page Output
2601:
2602: =item *
2603:
2604: Choice or no choice
2605:
2606: =item *
2607:
2608: Table
2609:
2610: =item *
2611:
2612: Privileges
2613:
2614: =back
2615:
2616: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonroles.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / auth