--- loncom/interface/loncommon.pm 2009/08/10 12:09:58 1.883
+++ loncom/interface/loncommon.pm 2010/02/26 22:48:43 1.925.2.12
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.883 2009/08/10 12:09:58 droeschl Exp $
+# $Id: loncommon.pm,v 1.925.2.12 2010/02/26 22:48:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -482,8 +482,11 @@ ENDAUTHORBRW
}
sub coursebrowser_javascript {
- my ($domainfilter,$sec_element,$formname)=@_;
- my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Community - for which you wish to add/modify a user role');
+ my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
+ my $wintitle = &mt('Course Browser');
+ if ($crstype ne '') {
+ $wintitle = &mt($crstype);
+ }
my $id_functions = &javascript_index_functions();
my $output = '
END_MYBLOCK
+
+ $output = Apache::lonhtmlcommon::scripttag($output);
+
my $popupUrl = "/adm/blockingstatus/$querystring";
+ my $text = mt('Communication Blocked');
+
$output .= <<"END_BLOCK";
END_BLOCK
@@ -4035,7 +4116,7 @@ sub determinedomain {
my $domain=shift;
if (! $domain) {
# Determine domain if we have not been given one
- $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
+ $domain = &Apache::lonnet::default_login_domain();
if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
if ($env{'request.role.domain'}) {
$domain=$env{'request.role.domain'};
@@ -4286,18 +4367,30 @@ sub CSTR_pageheader {
} else {
$lastitem = $thisdisfn;
}
- return
+
+ my $output =
'
'
.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
.''.&mt('Construction Space:').' '
.''
.&Apache::lonmenu::constspaceform()
.'
';
+
+ return $output;
}
###############################################
@@ -4374,6 +4467,10 @@ sub bodytag {
'link' => &designparm($function.'.link',$domain),);
@design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
+ my $custommenu;
+ if ($env{'environment.remote'} eq 'off') {
+ $custommenu = &needs_gci_custom();
+ }
# role and realm
my ($role,$realm) = split(/\./,$env{'request.role'},2);
if ($role eq 'ca') {
@@ -4383,11 +4480,22 @@ sub bodytag {
# realm
if ($env{'request.course.id'}) {
if ($env{'request.role'} !~ /^cr/) {
- $role = &Apache::lonnet::plaintext($role,&course_type());
+ if (($custommenu) && ($role eq 'cm')) {
+ undef($role);
+ } else {
+ $role = &Apache::lonnet::plaintext($role,&course_type());
+ }
}
+ if ($env{'request.course.sec'}) {
+ $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
+ }
$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
} else {
- $role = &Apache::lonnet::plaintext($role);
+ if (($custommenu) && ($role eq 'cm')) {
+ undef($role);
+ } else {
+ $role = &Apache::lonnet::plaintext($role);
+ }
}
if (!$realm) { $realm=' '; }
@@ -4419,40 +4527,83 @@ sub bodytag {
$env{'course.'.$env{'request.course.id'}.
'.domain'}.'/'})) {
my $cid = $env{'request.course.id'};
- $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
+ $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info =~ s/\s+$//;
- $dc_info = '('.$dc_info.')';
}
- $role = "($role)" if $role;
+ $role = '('.$role.')' if $role;
&get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
if ($env{'environment.remote'} eq 'off') {
# No Remote
- if ($env{'request.state'} eq 'construct') {
- $forcereg=1;
- }
-
-# if ($env{'request.state'} eq 'construct') {
-# $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
-# }
-
- my $titletable = '
';
$itemcount ++;
}
- $output .= &Apache::loncommon::end_data_table();
+ if ($itemcount) {
+ $output = &Apache::loncommon::start_data_table().
+ $table.
+ &Apache::loncommon::end_data_table();
+ }
}
}
}
@@ -9855,11 +10050,24 @@ sub check_clone {
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
my $clonemsg;
my $can_clone = 0;
-
+ my $lctype = lc($args->{'crstype'});
+ if ($lctype ne 'community') {
+ $lctype = 'course';
+ }
if ($clonehome eq 'no_host') {
- $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ if ($args->{'crstype'} eq 'Community') {
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ } else {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ }
} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
+ if ($args->{'crstype'} eq 'Community') {
+ if ($clonedesc{'type'} ne 'Community') {
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ return ($can_clone, $clonemsg, $cloneid, $clonehome);
+ }
+ }
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
$can_clone = 1;
@@ -9872,15 +10080,23 @@ sub check_clone {
} elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
$can_clone = 1;
} else {
+ my $ccrole = 'cc';
+ if ($args->{'crstype'} eq 'Community') {
+ $ccrole = 'co';
+ }
my %roleshash =
&Apache::lonnet::get_my_roles($args->{'ccuname'},
$args->{'ccdomain'},
- 'userroles',['active'],['cc'],
+ 'userroles',['active'],[$ccrole],
[$args->{'clonedomain'}]);
- if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
+ if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
$can_clone = 1;
} else {
- $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ if ($args->{'crstype'} eq 'Community') {
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ } else {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ }
}
}
}
@@ -9889,7 +10105,7 @@ sub check_clone {
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
my $outcome;
my $linefeed = ' '."\n";
if ($context eq 'auto') {
@@ -9928,7 +10144,7 @@ sub construct_course {
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
$args->{'crstype'},
- $cnum);
+ $cnum,$context,$category);
# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment
@@ -10215,6 +10431,21 @@ sub construct_course {
$outcome .= ($fatal?$errtext:'write ok').$linefeed;
}
+ if ($args->{'cloneroster'}) {
+ my ($numadded,$clisterror) = &Apache::lonclonecourse::copyroster($cloneid,$$courseid,$args->{'startaccess'},$args->{'endaccess'});
+ if ($clisterror) {
+ $outcome .= "\0".&mt('An error occurred when copying the student roster from the old course to the new course; the error was: [_1].',$clisterror).$linefeed;
+ if ($numadded) {
+ $outcome .= &mt('Although [quant,_1,student] have received roles in the new course the roster does not report this. It is ').$linefeed;
+ }
+ } else {
+ if ($numadded) {
+ $outcome .= "\0".&mt('[quant,_1,student] copied from roster for old course to roster for new course.',$numadded).$linefeed;
+ } else {
+ $outcome .= "\0".&mt('No students have been enrolled in the new Concept Test.').' '.&mt('This is because either (a) an error occurred, or (b) there were no students with either current access or access which ended on/after the current default end date set for access to the old course.').$linefeed;
+ }
+ }
+ }
return (1,$outcome);
}
@@ -10242,6 +10473,16 @@ sub group_term {
return $names{$crstype};
}
+sub course_types {
+ my @types = ('official','unofficial','community');
+ my %typename = (
+ official => 'Official course',
+ unofficial => 'Unofficial course',
+ community => 'Community',
+ );
+ return (\@types,\%typename);
+}
+
sub icon {
my ($file)=@_;
my $curfext = lc((split(/\./,$file))[-1]);
@@ -10471,6 +10712,60 @@ sub _add_to_env {
}
}
+sub new_roles_update {
+ my $rolecount = 0;
+ foreach my $envkey (keys(%env)) {
+ next unless ($envkey =~ /^user\.role\./);
+ $rolecount ++;
+ }
+ my $newrolecount = 0;
+ if (!$rolecount) {
+ my %userenv;
+ foreach my $crstype ('official','unofficial','community') {
+ $userenv{'canrequest.'.$crstype} =
+ &Apache::lonnet::usertools_access($env{'user.name'},
+ $env{'user.domain'},$crstype,'reload','requestcourses');
+ }
+ my $then=$env{'user.login.time'};
+ my $refresh=time;
+ my (%userroles,%allroles,%allgroups,@newroles);
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active','future','previous'],undef,undef,1);
+ foreach my $item (keys(%roleshash)) {
+ my ($uname,$udom,$role,$section) = split(':',$item);
+ my $where = '/'.$udom.'/'.$uname;
+ my ($tstart,$tend) = split(':',$roleshash{$item});
+ if ($section ne '') {
+ $where .= '/'.$section;
+ }
+ my $spec = $role.'.'.$where;
+ &Apache::lonnet::set_arearole($role,$where,$tstart,$tend,
+ $env{'user.domain'},$env{'user.name'});
+ $userroles{'user.role.'.$spec} = $tstart.'.'.$tend;
+ $newrolecount ++;
+ unless (grep(/^\Q$role\E$/,@newroles)) {
+ push(@newroles,$role);
+ }
+ my $status =
+ &Apache::lonnet::curr_role_status($tstart,$tend,$refresh,$then);
+ if ($status eq 'active') {
+ &Apache::lonnet::gather_roleprivs(\%allroles,\%allgroups,\%userroles,
+ $where,$role,$tstart,$tend);
+ }
+ }
+ if (@newroles) {
+ my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles,
+ \%allgroups);
+ &Apache::lonnet::appenv(\%userroles,[@newroles,'cm']);
+ $userenv{'user.adv'} = $adv;
+ $userenv{'user.author'} = $author;
+ $userenv{'user.refresh.time'} = $refresh;
+ }
+ &Apache::lonnet::appenv(\%userenv);
+ }
+ return $newrolecount;
+}
+
# --- Get the symbolic name of a problem and the url
sub get_symb {
my ($request,$silent) = @_;
@@ -10512,6 +10807,76 @@ sub clean_symb {
return ($symb,$enc);
}
+sub needs_gci_custom {
+ my $custommenu;
+ my $numdc = &check_for_gci_dc();
+ unless ($numdc) {
+ my $then=$env{'user.login.time'};
+ my $now = time;
+ my %cnums = (
+ review => '9615072b469884921gcil1',
+ submit => '1H96711d710194bfegcil1',
+ );
+ if ($env{'user.role.st./gci/'.$cnums{'review'}}) {
+ my ($start,$end) =
+ split('.',$env{'user.role.st./gci/'.$cnums{'review'}});
+ if (((!$start) || ($start && $start <= $now)) &&
+ ((!$end) || ($end > $now))) {
+ $custommenu = 1;
+ if ($env{'user.role.cc./gci/'.$cnums{'review'}}) {
+ my ($ccstart,$ccend) =
+ split('.',$env{'user.role.cc./gci/'.$cnums{'review'}});
+ if (((!$start) || ($start && $start <= $now)) &&
+ ((!$end) || ($end > $now))) {
+ $custommenu = '';
+ }
+ }
+ }
+ }
+ }
+ return $custommenu;
+}
+
+sub check_for_gci_dc {
+ my $then=$env{'user.login.time'};
+ my $numdc = 0;
+ foreach my $dom ('gci','gcitest') {
+ if ($env{'user.role.dc./'.$dom.'/'}) {
+ my $livedc = 1;
+ my ($tstart,$tend)=split(/\./,$env{'user.role.dc./'.$dom.'/'});
+ if ($tstart && $tstart>$then) { $livedc = 0; }
+ if ($tend && $tend <$then) { $livedc = 0; }
+ if ($livedc) {
+ $numdc++;
+ }
+ }
+ }
+ return $numdc;
+}
+
+sub existing_gcitest_courses {
+ my ($role) = @_;
+ my %courses;
+ my $cdom = 'gcitest';
+ my $now = time;
+ foreach my $envkey (keys(%env)) {
+ my $cnum;
+ if ($envkey =~ m{^user\.role\.\Q$role\E\./\Q$cdom\E/($match_courseid)$}) {
+ $cnum = $1;
+ } else {
+ next;
+ }
+ my ($tstart,$tend) = split('.',$env{$envkey});
+ if (((!$tstart) || ($tstart < $now)) && ((!$tend) || ($tend > $now))) {
+ my $descr = $env{'course.'.$cdom.'_'.$cnum.'.description'};
+ if ($descr ne '') {
+ $courses{$cdom.'_'.$cnum}{'description'} = $descr;
+ }
+ }
+ }
+ return %courses;
+}
+
=pod
=back
+ title='$text'>
+