loncom/automation/batchcreatecourse.pm - diff

Return to batchcreatecourse.pm CVS log

Up to [LON-CAPA] / loncom / automation

Diff for /loncom/automation/batchcreatecourse.pm between versions 1.15 and 1.40.2.1.2.1

version 1.15, 2006/06/27 21:28:21	version 1.40.2.1.2.1, 2020/05/22 22:01:59
Line 29 use LONCAPA::Configuration;	Line 29 use LONCAPA::Configuration;
use LONCAPA::Enrollment;	use LONCAPA::Enrollment;
use HTML::Parser;	use HTML::Parser;
use Time::Local;	use Time::Local;
use Apache::Constants;
use Apache::lonnet;	use Apache::lonnet;
use Apache::loncommon;	use Apache::loncommon;
use Apache::loncreatecourse;
use Apache::loncreateuser;
use Apache::lonlocal;	use Apache::lonlocal;
	use LONCAPA qw(:match);

use strict;	use strict;

Line 56 use strict;	Line 54 use strict;
#<!DOCTYPE text>	#<!DOCTYPE text>
#<class id="ss05ubw101">	#<class id="ss05ubw101">
# <title>Underwater Basket Weaving</title>	# <title>Underwater Basket Weaving</title>
# <crstype>Course</coursetype>	# <crstype>Course</crstype>
# <coursecode>ss05ubw101</coursecode>	# <coursecode>ss05ubw101</coursecode>
	# <defaultcredits>3</defaultcredits>
# <coursehome>msul1</coursehome>	# <coursehome>msul1</coursehome>
# <coursedomain>msu</coursedomain>	# <coursedomain>msu</coursedomain>
# <reshome>/res/msu/</reshome>	# <reshome>/res/msu/</reshome>
Line 76 use strict;	Line 75 use strict;
# <topmap></topmap>	# <topmap></topmap>
# <firstres>nav</firstres>	# <firstres>nav</firstres>
# <crsquota>20</crsquota>	# <crsquota>20</crsquota>
	# <uniquecode>1</uniquecode>
# <clonecrs>466011437c34194msul1</clonecrs>	# <clonecrs>466011437c34194msul1</clonecrs>
# <clonedom>msu</clonedom>	# <clonedom>msu</clonedom>
	# <datemode>shift</datemode>
	# <dateshift>365</dateshift>
# <showphotos></showphotos>	# <showphotos></showphotos>
# <setpolicy>1</setpolicy>	# <setpolicy>1</setpolicy>
# <setcontent>1</setcontent>	# <setcontent>1</setcontent>
	# <setcomment>1</setcomment>
# <setkeys>0</setkeys>	# <setkeys>0</setkeys>
# <keyauth>keyadmin@msu</keyauth>	# <keyauth>keyadmin:msu</keyauth>
# <disresdis>1</disresdis>	# <disresdis>1</disresdis>
# <disablechat>1</disablechat>	# <disablechat>1</disablechat>
# <openall></openall>	# <openall></openall>
	# <openallfrom></openallfrom>
# <notify_dc>1</notify_dc>	# <notify_dc>1</notify_dc>
# <notify_owner>1</notify_owner>	# <notify_owner>1</notify_owner>
# <owner>	# <owner>
Line 122 use strict;	Line 126 use strict;
# <lastname>Spartan</lastname>x	# <lastname>Spartan</lastname>x
# <middlename></middlename>	# <middlename></middlename>
# <studentID></studentID>	# <studentID></studentID>
	# <credits></credits>
# <roles></roles>	# <roles></roles>
# </user>	# </user>
# <user>	# <user>
Line 149 use strict;	Line 154 use strict;
#	#
# Many of these are binary options (corresponding to either checkboxes or	# Many of these are binary options (corresponding to either checkboxes or
# radio buttons in the interactive CCRS page). Examples include:	# radio buttons in the interactive CCRS page). Examples include:
# setpolicy, setcontent, setkeys, disableresdis, disablechat, openall	# setpolicy, setcontent, setcomment, setkeys, disableresdis, disablechat, openall,
	# uniquecode
#	#
# A value of 1 between opening and closing tags is equivalent to a	# A value of 1 between opening and closing tags is equivalent to a
# checked checkbox or 'Yes' response in the original CCRS web page.	# checked checkbox or 'Yes' response in the original CCRS web page.
Line 159 use strict;	Line 165 use strict;
# firstres can be nav, syl, or blank for "Navigate Contents", Syllabus, or	# firstres can be nav, syl, or blank for "Navigate Contents", Syllabus, or
# no entry respectively.	# no entry respectively.
#	#
# crstype can be Course or Group	# crstype can be Course or Community
#	#
# crsquota is the total disk space permitted for course group portfolio files	# crsquota is the total disk space permitted for course group portfolio files
# in all course groups.	# in all course groups.
Line 176 use strict;	Line 182 use strict;
# /home/httpd/perl/tmp/addcourse/$dom/auto/pending if $context = auto	# /home/httpd/perl/tmp/addcourse/$dom/auto/pending if $context = auto
# /home/httpd/perl/tmp/addcourse/$dom/web/$uname_$udom/pending if $context = web	# /home/httpd/perl/tmp/addcourse/$dom/web/$uname_$udom/pending if $context = web
#	#
# inputs (five) - requests - ref to array of filename(s) containing course requests	# inputs (six) - requests - ref to array of filename(s) containing course requests
# courseids - ref to hash to store LON-CAPA course ids of new courses	# courseids - ref to hash to store LON-CAPA course ids of new courses
# context - auto if called from command line, web if called from browser	# context - auto if called from command line, web if called from browser
# dom - domain for which the course is being created	# dom - domain for which the course is being created
# uname - username of DC who is requesting course creation	# uname - username of DC who is requesting course creation
# udom - domain of DC who is requesting course creation	# udom - domain of DC who is requesting course creation
#	#
# outputs (three) - output - text recording user roles added etc.	# outputs (four) - output - text recording user roles added etc.
# logmsg - text to be logged	# logmsg - text to be logged
# keysmsg - text containing link(s) to manage keys page(s)	# keysmsg - text containing link(s) to manage keys page(s)
	# codehash - reference to hash containing courseID => unique code
	# where unique code is a 6 character code, to distribute
	# to students as a shortcut to the course.
#############################################################	#############################################################

sub create_courses {	sub create_courses {
Line 197 sub create_courses {	Line 206 sub create_courses {
open(FILE,"<$$perlvarref{'lonTabDir'}.'/rolesplain.tab");	open(FILE,"<$$perlvarref{'lonTabDir'}.'/rolesplain.tab");
my @rolesplain = <FILE>;	my @rolesplain = <FILE>;
close(FILE);	close(FILE);
foreach (@rolesplain) {	foreach my $item (@rolesplain) {
if ($_ =~ /^(st\|ta\|ex\|ad\|in\|cc):([\w\s]+)$/) {	if ($item =~ /^(st\|ta\|ep\|ad\|in\|cc\|co):([\w\s]+):?([\w\s]*)/) {
$longroles{$1} = $2;	$longroles{'Course'}{$1} = $2;
	$longroles{'Community'}{$1} = $3;
}	}
}	}
my ($logmsg,$keysmsg,$newusermsg,$addresult);	my ($logmsg,$keysmsg,$newusermsg,$addresult,%codehash);
my %enrollcount = ();	my %enrollcount = ();
my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context;	my $newcoursedir = LONCAPA::tempdir().'/addcourse/'.$dom.'/'.$context;
if ($context eq 'auto') {	if ($context eq 'auto') {
$newcoursedir .= '/pending';	$newcoursedir .= '/pending';
} else {	} else {
Line 219 sub create_courses {	Line 229 sub create_courses {
my %details = ();	my %details = ();
if (-e $newcoursedir.'/'.$request) {	if (-e $newcoursedir.'/'.$request) {
&parse_coursereqs($newcoursedir.'/'.$request, \%details);	&parse_coursereqs($newcoursedir.'/'.$request, \%details);
foreach my $num (sort keys %details) {	foreach my $num (sort(keys(%details))) {
my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg);	my $reqdetails = $details{$num};
$$courseids{$courseid} = $details{$num}{'class'};	my $code;
	my $courseid =
	&build_course($dom,$num,$context,$reqdetails,\%longroles,\$logmsg,\$newusermsg,
	\$addresult,\%enrollcount,\$output,\$keysmsg,undef,undef,undef,undef,\$code);
	if ($courseid =~m{^/$match_domain/$match_courseid}) {
	$$courseids{$courseid} = $details{$num}{'class'};
	if ($code) {
	$codehash{$courseid} = $code;
	}
	}
}	}
}	}
}	}
}	}
return ($output,$logmsg,$keysmsg);	return ($output,$logmsg,$keysmsg,\%codehash);
}	}

#############################################################	#############################################################
Line 249 sub parse_coursereqs {	Line 268 sub parse_coursereqs {
my $xlist = 0;	my $xlist = 0;
my $userkey = '';	my $userkey = '';
my $role = '';	my $role = '';
my @items = ('title','optional_id','coursecode','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','showphotos','setpolicy','setcontent','setkeys','keyauth','disresdis','disablechat','openall','notify_owner','notify_dc','crstype','crsquota');	my @items = ('title','optional_id','coursecode','defaultcredits','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','datemode','dateshift','showphotos','setpolicy','setcontent','setcomment','setkeys','keyauth','disresdis','disablechat','openall','notify_owner','notify_dc','crstype','crsquota','uniquecode');
my @dateitems = ('enrollstart','enrollend','accessstart','accessend');	my @possroles = qw(st ad ep ta in cc co);
	my @dateitems = ('enrollstart','enrollend','accessstart','accessend','openallfrom');
my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');	my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');
my $p = HTML::Parser->new	my $p = HTML::Parser->new
(	(
Line 269 sub parse_coursereqs {	Line 289 sub parse_coursereqs {
}	}
if ("@state" eq "class users user roles role") {	if ("@state" eq "class users user roles role") {
$role = $attr->{id};	$role = $attr->{id};
if ($role =~ /^(st\|ad\|ep\|ta\|in\|cc)$/) {	if (grep(/^\Q$role\E$/,@possroles)) {
push(@{$$details{$num}{'users'}{$userkey}{'roles'}}, $role);	push(@{$$details{$num}{'users'}{$userkey}{'roles'}}, $role);
%{$$details{$num}{'users'}{$userkey}{$role}} = ();	%{$$details{$num}{'users'}{$userkey}{$role}} = ();
@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}} = ();	@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}} = ();
Line 315 sub parse_coursereqs {	Line 335 sub parse_coursereqs {
@{$$details{$num}{'users'}{$userkey}{'roles'}} = ();	@{$$details{$num}{'users'}{$userkey}{'roles'}} = ();
} elsif ("@state" eq "class users user email") {	} elsif ("@state" eq "class users user email") {
$$details{$num}{'users'}{$userkey}{'emailaddr'} = $text;	$$details{$num}{'users'}{$userkey}{'emailaddr'} = $text;
$$details{$num}{'users'}{$userkey}{'emailenc'} = &Apache::lonnet::escape($text);	$$details{$num}{'users'}{$userkey}{'emailenc'} = &LONCAPA::escape($text);
} elsif ("@state" eq "class users user roles role start") {	} elsif ("@state" eq "class users user roles role start") {
if ($role =~ /^(st\|ad\|ep\|ta\|in\|cc)$/) {	if (grep(/^\Q$role\E$/,@possroles)) {
$$details{$num}{'users'}{$userkey}{$role}{'start'} = &process_date($text);	$$details{$num}{'users'}{$userkey}{$role}{'start'} = &process_date($text);
}	}
} elsif ("@state" eq "class users user roles role end") {	} elsif ("@state" eq "class users user roles role end") {
if ($role =~ /^(st\|ad\|ep\|ta\|in\|cc)$/) {	if (grep(/^\Q$role\E$/,@possroles)) {
$$details{$num}{'users'}{$userkey}{$role}{'end'} = &process_date($text);	$$details{$num}{'users'}{$userkey}{$role}{'end'} = &process_date($text);
}	}
} elsif ("@state" eq "class users user roles role usec") {	} elsif ("@state" eq "class users user roles role usec") {
if ($role =~ /^(st\|ad\|ep\|ta\|in\|cc)$/) {	if (grep(/^\Q$role\E$/,@possroles)) {
unless ($text eq '') {	unless ($text eq '') {
push(@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}},$text);	push(@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}},$text);
}	}
Line 368 sub parse_coursereqs {	Line 388 sub parse_coursereqs {
# build_course()	# build_course()
#	#
# inputs	# inputs
# domain	# course domain
# course request number	# course request number
# context - auto if called from command line, web if called from DC web interface	# context - auto if called from command line, web if called from DC web interface
# ref to hash of course creation information	# ref to hash of course creation information
Line 377 sub parse_coursereqs {	Line 397 sub parse_coursereqs {
# ref to scalar used to accumulate messages sent to new users	# ref to scalar used to accumulate messages sent to new users
# ref to scalar used to accumulate results of new user additions	# ref to scalar used to accumulate results of new user additions
# ref to hash of enrollment counts for different roles	# ref to hash of enrollment counts for different roles
# ref to scalar used to accumulate iformation about added roles	# ref to scalar used to accumulate information about added roles
# ref to scalar used to accumulate	# ref to scalar used to accumulate information about access keys
	# domain of DC creating course
	# username of DC creating course
	# optional course number, if unique course number already obtained (e.g., for
	# course requests submitted via course request form.
	# optional category
	# optional ref to scalar for six character unique identifier
#	#
# outputs	# outputs
# LON-CAPA courseID for new (created) course	# LON-CAPA courseID for new (created) course
Line 386 sub parse_coursereqs {	Line 412 sub parse_coursereqs {
#########################################################	#########################################################

sub build_course {	sub build_course {
my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_;	my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,
my $owner_uname = $$details{$num}{'owner'};	$enrollcount,$output,$keysmsg,$udom,$uname,$cnum,$category,$coderef) = @_;
my $owner_domain = $$details{$num}{'domain'};	return unless (ref($details) eq 'HASH');
	my $owner_uname = $details->{'owner'};
	my $owner_domain = $details->{'domain'};
my $owner = $owner_uname.':'.$owner_domain;	my $owner = $owner_uname.':'.$owner_domain;
my $sectionstr = '';	my $sectionstr = '';
my $xliststr = '';	my $xliststr = '';
my $noenddate = '';	my $noenddate = '';
my $outcome;	my $outcome;
my ($courseid,$crsudom,$crsunum);	my ($courseid,$crsudom,$crsunum,$crstype,$ccrole,$rolenames);
	if ($details->{'crstype'} eq 'Community') {
	$crstype = $details->{'crstype'};
	$ccrole ='co';
	if (ref($longroles) eq 'HASH') {
	$rolenames = $longroles->{'Community'};
	}
	} else {
	$crstype = 'Course';
	$ccrole = 'cc';
	if (ref($longroles) eq 'HASH') {
	$rolenames = $longroles->{'Course'};
	}
	}
my $linefeed;	my $linefeed;
if ($context eq 'auto') {	if ($context eq 'auto') {
$linefeed = "\n";	$linefeed = "\n";
} else {	} else {
$linefeed = "<br />\n";	$linefeed = "<br />\n";
}	}
if ($$details{$num}{'accessend'} eq '') {	if ($details->{'accessend'} eq '') {
$noenddate = 1;	$noenddate = 1;
}	}
my $reshome = $$details{$num}{'reshome'};	my $reshome = $details->{'reshome'};
if ($reshome eq '') {	if ($reshome eq '') {
$reshome = '/res/'.$cdom;	$reshome = '/res/'.$cdom;
}	}
my $firstres = $$details{$num}{'firstres'};	my $firstres = $details->{'firstres'};
if ($firstres eq '') {	if ($firstres eq '') {
$firstres = 'syl';	if ($crstype eq 'Community') {
	$firstres = 'nav';
	} else {
	$firstres = 'syl';
	}
}	}
foreach my $secid (sort keys %{$$details{$num}{'sections'}}) {	foreach my $secid (sort(keys(%{$details->{'sections'}}))) {
$sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'}.',';	$sectionstr .= $details->{'sections'}{$secid}{'inst'}.':'.$details->{'sections'}{$secid}{'loncapa'}.',';
}	}
$sectionstr =~ s/,$//;	$sectionstr =~ s/,$//;

foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) {	foreach my $xlist (sort(keys(%{$details->{'crosslists'}}))) {
$xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}.',';	$xliststr .= $details->{'crosslists'}{$xlist}{'inst'}.':'.$details->{'crosslists'}{$xlist}{'loncapa'}.',';
}	}
$xliststr =~ s/,$//;	$xliststr =~ s/,$//;

my %courseinfo = (	my %courseinfo = (
inst_code => $$details{$num}{'coursecode'},	inst_code => $details->{'coursecode'},
description => $$details{$num}{'title'}	description => $details->{'title'}
);	);
if (&Apache::lonnet::homeserver($$details{$num}{'owner'},$$details{$num}{'domain'}) eq 'no_host') { # Add user if no account	if (&Apache::lonnet::homeserver($details->{'owner'},$details->{'domain'}) eq 'no_host') { # Add user if no account
my $ownerargs = {'auth' => $$details{$num}{'ownerauthtype'},	my $ownerargs = {'auth' => $details->{'ownerauthtype'},
'authparam' => $$details{$num}{'ownerauthparam'},	'authparam' => $details->{'ownerauthparam'},
'emailenc' => $$details{$num}{'emailenc'},	'emailenc' => $details->{'emailenc'},
'udom' => $$details{$num}{'domain'},	'udom' => $details->{'domain'},
'uname' => $$details{$num}{'owner'},	'uname' => $details->{'owner'},
'pid' => $$details{$num}{'users'}{$owner}{'studentID'},	'pid' => $details->{'users'}{$owner}{'studentID'},
'first' => $$details{$num}{'users'}{$owner}{'firstname'},	'first' => $details->{'users'}{$owner}{'firstname'},
'middle' => $$details{$num}{'users'}{$owner}{'middlename'},	'middle' => $details->{'users'}{$owner}{'middlename'},
'last' => $$details{$num}{'users'}{$owner}{'lastname'},	'last' => $details->{'users'}{$owner}{'lastname'},
'gene' => $$details{$num}{'users'}{$owner}{'generation'},	'gene' => $details->{'users'}{$owner}{'generation'},
'usec' => '',	'usec' => '',
'end' => '',	'end' => '',
'start' => '',	'start' => '',
'emailaddr' => $$details{$num}{'users'}{$owner}{'email'},	'emailaddr' => $details->{'users'}{$owner}{'email'},
'cid' => '',	'cid' => '',
'context' => 'createowner',	'context' => 'createowner',
'linefeed' => $linefeed,	'linefeed' => $linefeed,
'role' => 'cc',	'role' => $ccrole,
};	};
$outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo);	$outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$rolenames,\%courseinfo,$context);
} else {	} else {
$outcome = 'ok';	$outcome = 'ok';
}	}

if ($outcome eq 'ok') {	if ($outcome eq 'ok') {
	if ($details->{'datemode'} !~ /^(preserve\|shift\|delete)$/) {
	$details->{'datemode'} = 'shift';
	$details->{'dateshift'} = 365;
	}
my $courseargs = {	my $courseargs = {
ccuname => $$details{$num}{'owner'},	ccuname => $details->{'owner'},
ccdomain => $$details{$num}{'domain'},	ccdomain => $details->{'domain'},
cdescr => $$details{$num}{'title'},	cdescr => $details->{'title'},
crstype => $$details{$num}{'crstype'},	crstype => $details->{'crstype'},
curl => $$details{$num}{'topmap'},	curl => $details->{'topmap'},
course_domain => $cdom,	course_domain => $cdom,
course_home => $$details{$num}{'coursehome'},	course_home => $details->{'coursehome'},
nonstandard => $$details{$num}{'nonstandard'},	nonstandard => $details->{'nonstandard'},
crscode => $$details{$num}{'coursecode'},	crscode => $details->{'coursecode'},
crsquota => $$details{$num}{'crsquota'},	defaultcredits => $details->{'defaultcredits'},
clonecourse => $$details{$num}{'clonecrs'},	crsquota => $details->{'crsquota'},
clonedomain => $$details{$num}{'clonedom'},	uniquecode => $details->{'uniquecode'},
crsid => $$details{$num}{'optional_id'},	clonecourse => $details->{'clonecrs'},
curruser => $$details{$num}{'owner'},	clonedomain => $details->{'clonedom'},
	datemode => $details->{'datemode'},
	dateshift => $details->{'dateshift'},
	crsid => $details->{'optional_id'},
	curruser => $details->{'owner'},
crssections => $sectionstr,	crssections => $sectionstr,
crsxlist => $xliststr,	crsxlist => $xliststr,
autoadds => $$details{$num}{'adds'},	autoadds => $details->{'adds'},
autodrops => $$details{$num}{'drops'},	autodrops => $details->{'drops'},
notify => $$details{$num}{'notify_owner'},	notify => $details->{'notify_owner'},
notify_dc => $$details{$num}{'notify_dc'},	notify_dc => $details->{'notify_dc'},
no_end_date => $noenddate,	no_end_date => $noenddate,
showphotos => $$details{$num}{'showphotos'},	showphotos => $details->{'showphotos'},
authtype => $$details{$num}{'authtype'},	authtype => $details->{'authtype'},
autharg => $$details{$num}{'authparam'},	autharg => $details->{'authparam'},
enrollstart => $$details{$num}{'enrollstart'},	enrollstart => $details->{'enrollstart'},
enrollend => $$details{$num}{'enrollend'},	enrollend => $details->{'enrollend'},
startaccess => $$details{$num}{'accessstart'},	startaccess => $details->{'accessstart'},
endaccess => $$details{$num}{'accessend'},	endaccess => $details->{'accessend'},
setpolicy => $$details{$num}{'setpolicy'},	setpolicy => $details->{'setpolicy'},
setcontent => $$details{$num}{'setcontent'},	setcontent => $details->{'setcontent'},
	setcomment => $details->{'setcomment'},
reshome => $reshome,	reshome => $reshome,
setkeys => $$details{$num}{'setkeys'},	setkeys => $details->{'setkeys'},
keyauth => $$details{$num}{'keyauth'},	keyauth => $details->{'keyauth'},
disresdis => $$details{$num}{'disresdis'},	disresdis => $details->{'disresdis'},
disablechat => $$details{$num}{'disablechat'},	disablechat => $details->{'disablechat'},
openall => $$details{$num}{'openall'},	openall => $details->{'openall'},
	openallfrom => $details->{'openallfrom'},
firstres => $firstres	firstres => $firstres
};	};
	if ($details->{'textbook'}) {
my %host_servers = &Apache::loncommon::get_library_servers($cdom);	$courseargs->{'textbook'} = $details->{'textbook'};
if (! exists($host_servers{$$details{$num}{'coursehome'}})) {	}
$$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};	my %host_servers = &Apache::lonnet::get_servers($cdom,'library');
	if (! exists($host_servers{$details->{'coursehome'}})) {
	$$logmsg .= &mt('Invalid home server for course').': '.$details->{'coursehome'};
	return;
	}
	my ($success, $msg) =
	&Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,
	$udom,$uname,$context,$cnum,$category,$coderef);
	$$logmsg .= $msg;
	if (!$success) {
return;	return;
}	}

&Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname);
} else {	} else {
return;	return;
}	}

#	#
# Make owner a course coordinator	# Make owner a coordinator
#	#
if (($owner_domain) && ($owner_uname)) {	if (($owner_domain) && ($owner_uname)) {
&Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc');	&Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,$ccrole,'','','','',$context);
}	}

#	#
# Process other reqested users	# Process other reqested users
#	#

	my @courseroles = qw(st ep ta in);
	push(@courseroles,$ccrole);
	if (&owner_is_dc($owner_uname,$owner_domain,$crsudom)) {
	push(@courseroles,'ad');
	}
my $stulogmsg = '';	my $stulogmsg = '';
foreach my $userkey (sort keys %{$$details{$num}{'users'}}) {	foreach my $userkey (sort(keys(%{$details->{'users'}}))) {
my $url = '/'.$crsudom.'/'.$crsunum;	my $url = '/'.$crsudom.'/'.$crsunum;
if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 0) {	next if (ref($details->{'users'}{$userkey}{'roles'}) ne 'ARRAY');
	if (@{$details->{'users'}{$userkey}{'roles'}} > 0) {
my ($username,$userdom) = split/:/,$userkey;	my ($username,$userdom) = split/:/,$userkey;
if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account	if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account
my $firstrole = $$details{$num}{'users'}{$userkey}{'roles'}[0];	my @reqroles = @{$details->{'users'}{$userkey}{'roles'}};
my $firstsec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0];	my @badroles;
	my $firstrole = shift(@reqroles);
	while (@reqroles > 0) {
	if ($firstrole =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
	if (($1 eq $owner_domain) && ($2 eq $owner_uname)) {
	last;
	} else {
	push(@badroles,$firstrole);
	$firstrole = shift(@reqroles);
	}
	} elsif (grep(/^\Q$firstrole\E$/,@courseroles)) {
	last;
	} else {
	push(@badroles,$firstrole);
	$firstrole = shift(@reqroles);
	}
	}
	if (@badroles > 0) {
	if (@badroles > 1) {
	$$output .= &mt('The following requested roles are unavailable:').' '.join(', ',@badroles);
	} else {
	$$output .= &mt('The following requested role: [_1] is unavailable.',$badroles[0]);
	}
	}
	my $firstsec;
	unless (($firstrole eq $ccrole) \|\| ($firstrole eq '')) {
	$firstsec = $details->{'users'}{$userkey}{$firstrole}{'usec'}[0];
	}
my $userargs = {	my $userargs = {
'auth' => $$details{$num}{'users'}{$userkey}{'authtype'},	'auth' => $details->{'users'}{$userkey}{'authtype'},
'authparam' => $$details{$num}{'users'}{$userkey}{'autharg'},	'authparam' => $details->{'users'}{$userkey}{'autharg'},
'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'},	'emailenc' => $details->{'users'}{$userkey}{'emailenc'},
'udom' => $userdom,	'udom' => $userdom,
'uname' => $username,	'uname' => $username,
'pid' => $$details{$num}{'users'}{$userkey}{'studentID'},	'pid' => $details->{'users'}{$userkey}{'studentID'},
'first' => $$details{$num}{'users'}{$userkey}{'firstname'},	'first' => $details->{'users'}{$userkey}{'firstname'},
'middle' => $$details{$num}{'users'}{$userkey}{'middlename'},	'middle' => $details->{'users'}{$userkey}{'middlename'},
'last' => $$details{$num}{'users'}{$userkey}{'lastname'},	'last' => $details->{'users'}{$userkey}{'lastname'},
'gene' => $$details{$num}{'users'}{$userkey}{'generation'},	'gene' => $details->{'users'}{$userkey}{'generation'},
'usec' => $firstsec,	'usec' => $firstsec,
'end' => $$details{$num}{'users'}{$userkey}{'end'},	'end' => $details->{'users'}{$userkey}{'end'},
'start' => $$details{$num}{'users'}{$userkey}{'start'},	'start' => $details->{'users'}{$userkey}{'start'},
'emailaddr' => $$details{$num}{'users'}{$userkey}{'emailaddr'},	'emailaddr' => $details->{'users'}{$userkey}{'emailaddr'},
'cid' => $courseid,	'cid' => $courseid,
'crs' => $crsunum,	'crs' => $crsunum,
'cdom' => $crsudom,	'cdom' => $crsudom,
'context' => 'createcourse',	'context' => 'createcourse',
'linefeed' => $linefeed,	'linefeed' => $linefeed,
'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0],	'role' => $details->{'users'}{$userkey}{'roles'}[0],
};	};
$outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo);	if ($userargs->{'role'} eq 'st') {
	if (exists($details->{'users'}{$userkey}{'credits'})) {
	$userargs->{'credits'} = $details->{'users'}{$userkey}{'credits'};
	$userargs->{'credits'} =~ s/[^\d\.]//g;
	}
	}
	$outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo,$context);
# now add other roles and other sections.	# now add other roles and other sections.
if ($outcome eq 'ok') {	if ($outcome eq 'ok') {
if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {	if ((($firstrole ne 'st') && ($firstrole ne $ccrole) && ($firstrole ne '')) && (@{$details->{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {
for (my $i=1; $i<@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}}; $i++) {	for (my $i=1; $i<@{$details->{'users'}{$userkey}{$firstrole}{'usec'}}; $i++) {
my $curr_role = $firstrole;	my $curr_role = $firstrole;
my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'};	my $start = $details->{'users'}{$userkey}{$curr_role}{'start'};
my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'};	my $end = $details->{'users'}{$userkey}{$curr_role}{'end'};
my $usec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[$i];	my $usec = $details->{'users'}{$userkey}{$firstrole}{'usec'}[$i];
$url = '/'.$crsudom.'/'.$crsunum;	$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {	if ($usec ne '') {
$url .= '/'.$usec;	$url .= '/'.$usec;
}	}
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);	if ($firstrole =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
	$$output .= &Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context);
	} else {
	$$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context);
	}
}	}
}	}
if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 1) {	if (@reqroles > 0) {
for (my $j=1; $j<@{$$details{$num}{'users'}{$userkey}{'roles'}}; $j++) {	foreach my $curr_role (@reqroles) {
my $curr_role = $$details{$num}{'users'}{$userkey}{'roles'}[$j];	my $start = $details->{'users'}{$userkey}{$curr_role}{'start'};
my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'};	my $end = $details->{'users'}{$userkey}{$curr_role}{'end'};
my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'};
if ($curr_role eq 'st') {	if ($curr_role eq 'st') {
my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0];	my $usec = $details->{'users'}{$userkey}{$curr_role}{'usec'}[0];
$url = '/'.$crsudom.'/'.$crsunum;	$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {	if ($usec ne '') {
$url .= '/'.$usec;	$url .= '/'.$usec;
}	}
$$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);	my $credits;
} else {	if (exists($details->{'users'}{$userkey}{'credits'})) {
foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {	$credits = $details->{'users'}{$userkey}{'credits'};
	$credits =~ s/[^\d\.]//g;
	}
	$$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context,$credits);
	} elsif ($curr_role eq $ccrole) {
	$url = '/'.$crsudom.'/'.$crsunum;
	my $usec = '';
	$$output .=
	&Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context);
	} elsif ((grep(/^\Q$curr_role\E$/,@courseroles)) \|\|
	($curr_role =~ m{^cr/$match_domain/$match_username/[^/]+$})) {
	foreach my $usec (@{$details->{'users'}{$userkey}{$curr_role}{'usec'}}) {
$url = '/'.$crsudom.'/'.$crsunum;	$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {	if ($usec ne '') {
$url .= '/'.$usec;	$url .= '/'.$usec;
}	}
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);	if ($curr_role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
	if (($1 eq $owner_domain) && ($2 eq $owner_uname)) {
	$$output .=
	&Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context);
	} else {
	$$output = &mt('Requested custom role: [_1] unavailable, as it was not defined by the course owner.',$curr_role);
	}
	} else {
	$$output .=
	&Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context);
	}
}	}
	} else {
	$$output .= &mt('Requested role: [_1] is unavailable.',$curr_role);
}	}
}	}
}	}
}	}
} else {	} else {
foreach my $curr_role (@{$$details{$num}{'users'}{$userkey}{'roles'}}) {	foreach my $curr_role (@{$details->{'users'}{$userkey}{'roles'}}) {
my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'};	my $start = $details->{'users'}{$userkey}{$curr_role}{'start'};
my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'};	my $end = $details->{'users'}{$userkey}{$curr_role}{'end'};
if ($curr_role eq 'st') {	if ($curr_role eq 'st') {
my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0];	my $usec = $details->{'users'}{$userkey}{$curr_role}{'usec'}[0];
$url = '/'.$crsudom.'/'.$crsunum;	$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {	if ($usec ne '') {
$url .= '/'.$usec;	$url .= '/'.$usec;
}	}
$$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);	my $credits;
} else {	if (exists($details->{'users'}{$userkey}{'credits'})) {
if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) {	$credits = $details->{'users'}{$userkey}{'credits'};
foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {	$credits =~ s/[^\d\.]//g;
	}
	$$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context,$credits);
	} elsif ((grep(/^\Q$curr_role\E$/,@courseroles)) \|\|
	($curr_role =~ m{^cr/$match_domain/$match_username/[^/]+$})) {
	if (@{$details->{'users'}{$userkey}{$curr_role}{'usec'}} > 0) {
	foreach my $usec (@{$details->{'users'}{$userkey}{$curr_role}{'usec'}}) {
$url = '/'.$crsudom.'/'.$crsunum;	$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {	if ($usec ne '') {
$url .= '/'.$usec;	$url .= '/'.$usec;
}	}
my $stdresult = &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);	my $stdresult;
	if ($curr_role =~ m{/^cr/($match_domain)/($match_username)/([^/]+)$}) {
	if (($1 eq $owner_domain) && ($2 eq $owner_uname)) {
	$stdresult =
	&Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context);
	} else {
	$stdresult = &mt('Requested custom role: [_1] unavailable, as it was not defined by the course owner.',$curr_role);
	}
	} else {
	$stdresult =
	&Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context);
	}
$$output .= $stdresult;	$$output .= $stdresult;
}	}
} else {	} else {
$url = '/'.$crsudom.'/'.$crsunum;	$url = '/'.$crsudom.'/'.$crsunum;
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'');	if ($curr_role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
	if (($1 eq $owner_domain) && ($2 eq $owner_uname)) {
	$$output .=
	&Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context);
	} else {
	$$output .= &mt('Requested custom role: [_1] unavailable, as it was not defined by the course owner.',$curr_role);
	}
	} else {
	$$output .=
	&Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'',$context);
	}
}	}
	} else {
	$$output .= &mt('Requested role: [_1] is unavailable.',$curr_role);
}	}
}	}
}	}
Line 615 sub build_course {	Line 772 sub build_course {
}	}

# Information about keys.	# Information about keys.
if ($$details{$num}{'setkeys'}) {	if ($details->{'setkeys'}) {
$$keysmsg .=	$$keysmsg .=
'<a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">'.&mt('Manage Access Keys').'</a> for '.$$details{$num}{'title'}.$linefeed;	'<a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">'.&mt('Manage Access Keys').'</a> for '.$details->{'title'}.$linefeed;
}	}
# Flush the course logs so reverse user roles immediately updated	# Flush the course logs so reverse user roles immediately updated
&Apache::lonnet::flushcourselogs();	&Apache::lonnet::flushcourselogs();
return $courseid;	return $courseid;
}	}

	sub owner_is_dc {
	my ($owner_uname,$owner_dom,$cdom) = @_;
	my $is_dc = 0;
	my %roles = &Apache::lonnet::get_my_roles($owner_uname,$owner_dom,'userroles',
	['active'],['dc'],[$cdom]);
	if ($roles{$owner_uname.':'.$owner_dom.':dc'}) {
	$is_dc = 1;
	}
	return $is_dc;
	}

#########################################################	#########################################################
#	#
# process_date()	# process_date()

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.15
changed lines
	Added in v.1.40.2.1.2.1