;
close(FILE);
foreach (@rolesplain) {
if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) {
$longroles{$1} = $2;
}
}
my ($logmsg,$keysmsg,$newusermsg,$addresult);
my %enrollcount = ();
my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context;
if ($uname) {
unless ($context eq 'auto') {
$newcoursedir .= '/'.$uname;
}
}
if (@{$requests} > 0) {
foreach my $request (@{$requests}) {
my %details = ();
if (-e $newcoursedir.'/'.$request) {
&parse_coursereqs($newcoursedir.'/'.$request, \%details);
foreach my $num (sort keys %details) {
my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg);
$$courseids{$courseid} = $enrollcount;
}
}
}
}
return ($output,$logmsg,$keysmsg);
}
#############################################################
#
# parse_coursereqs()
# inputs (two) - coursefile - path to XML file containing course(s) to be created.
# - details - reference to hash containing extracted information.
# outputs (none)
#
############################################################
sub parse_coursereqs {
my ($coursefile,$details) = @_;
# Note all start and end dates should be in this format:
# YYYY:MM:DD:HH:MM:SS (:separators required).
my $uname = '';
my @state = ();
my $num = 0;
my $secid = 0;
my $xlist = 0;
my $userkey = '';
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');
my @dateitems = ('enrollstart','enrollend','accessstart','accessend');
my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push(@state, $tagname);
if ("@state" eq "class") {
%{$$details{$num}} = ();
$$details{$num}{'class'} = $attr->{id};
%{$$details{$num}{'users'}} = ();
%{$$details{$num}{'sections'}} = ();
$secid = 0;
$xlist = 0;
}
if ("@state" eq "class users user roles role") {
$role = $attr->{id};
if ($role =~ /^(st|ad|ep|ta|in|cc)$/) {
push(@{$$details{$num}{'users'}{$userkey}{'roles'}}, $role);
%{$$details{$num}{'users'}{$userkey}{$role}} = ();
@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}} = ();
}
}
if ("@state" eq "class sections section") {
$secid ++;
%{$$details{$num}{'sections'}{$secid}} = ();
}
if ("@state" eq "class crosslists xlist") {
$xlist ++;
%{$$details{$num}{'crosslists'}{$xlist}} = ();
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "class owner username") {
$$details{$num}{'owner'} = $text;
} elsif ("@state" eq "class owner domain") {
$$details{$num}{'domain'} = $text;
} elsif ("@state" eq "class sections section inst") {
$$details{$num}{'sections'}{$secid}{'inst'} = $text;
} elsif ("@state" eq "class sections section loncapa") {
$$details{$num}{'sections'}{$secid}{'loncapa'} = $text;
} elsif ("@state" eq "class crosslists xlist inst") {
$$details{$num}{'crosslists'}{$xlist}{'inst'} = $text;
} elsif ("@state" eq "class crosslists xlist loncapa") {
$$details{$num}{'crosslists'}{$xlist}{'loncapa'} = $text;
} elsif ("@state" eq "class owner authtype") {
$$details{$num}{'ownerauthtype'} = $text;
} elsif ("@state" eq "class owner autharg") {
$$details{$num}{'ownerautharg'} = $text;
} elsif ("@state" eq "class authentication method") {
$$details{$num}{'authtype'} = $text;
} elsif ("@state" eq "class authentication param") {
$$details{$num}{'authparam'} = $text;
} elsif ("@state" eq "class users user username") {
$userkey = $text;
} elsif ("@state" eq "class users user domain") {
$userkey .= ':'.$text;
%{$$details{$num}{'users'}{$userkey}} = ();
@{$$details{$num}{'users'}{$userkey}{'roles'}} = ();
} elsif ("@state" eq "class users user email") {
$$details{$num}{'users'}{$userkey}{'emailaddr'} = $text;
$$details{$num}{'users'}{$userkey}{'emailenc'} = &Apache::lonnet::escape($text);
} elsif ("@state" eq "class users user roles role start") {
if ($role =~ /^(st|ad|ep|ta|in|cc)$/) {
$$details{$num}{'users'}{$userkey}{$role}{'start'} = &process_date($text);
}
} elsif ("@state" eq "class users user roles role end") {
if ($role =~ /^(st|ad|ep|ta|in|cc)$/) {
$$details{$num}{'users'}{$userkey}{$role}{'end'} = &process_date($text);
}
} elsif ("@state" eq "class users user roles role usec") {
if ($role =~ /^(st|ad|ep|ta|in|cc)$/) {
unless ($text eq '') {
push(@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}},$text);
}
}
} else {
foreach my $item (@items) {
if ("@state" eq "class $item") {
$$details{$num}{$item} = $text;
}
}
foreach my $item (@dateitems) {
if ("@state" eq "class $item") {
$$details{$num}{$item} = &process_date($text);
}
}
foreach my $item (@useritems) {
if ("@state" eq "class users user $item") {
$$details{$num}{'users'}{$userkey}{$item} = $text;
}
}
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
if ("@state" eq "class") {
$num ++;
}
pop @state;
}, "tagname"],
);
$p->parse_file($coursefile);
$p->eof;
if (-e "$coursefile") {
# unlink $coursefile;
}
return;
}
#########################################################
#
# build_course()
#
# inputs
# domain
# course request number
# 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 role descriptions
# ref to scalar used to accumulate log messages
# ref to scalar used to accumulate messages sent to new users
# ref to scalar used to accumulate results of new user additions
# 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
#
# outputs
# LON-CAPA courseID for new (created) course
#
#########################################################
sub build_course {
my ($cdom,$num,$context,$details,$longoles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg) = @_;
my $owner_uname = $$details{$num}{'owner'};
my $owner_domain = $$details{$num}{'domain'};
my $owner = $owner_uname.':'.$owner_domain;
my $sectionstr = '';
my $xliststr = '';
my $noenddate = '';
my $outcome;
my ($courseid,$crsudom,$crsunum);
my $linefeed;
if ($context eq 'auto') {
$linefeed = "\n";
} else {
$linefeed = "
\n";
}
if ($$details{$num}{'accessend'} eq '') {
$noenddate = 1;
}
my $reshome = $$details{$num}{'reshome'};
if ($reshome eq '') {
$reshome = '/res/'.$cdom;
}
my $firstres = $$details{$num}{'firstres'};
if ($firstres eq '') {
$firstres = 'syl';
}
foreach my $secid (sort keys %{$$details{$num}{'sections'}}) {
$sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'};
}
foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) {
$xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'};
}
my %courseinfo = (
inst_code => $$details{$num}{'coursecode'},
description => $$details{$num}{'title'}
);
if (&Apache::lonnet::homeserver($$details{$num}{'owner'},$$details{$num}{'domain'}) eq 'no_host') { # Add user if no account
my $ownerargs = ('auth' => $$details{$num}{'ownerauthtype'},
'authparam' => $$details{$num}{'ownerauthparam'},
'emailenc' => $$details{$num}{'emailenc'},
'dom' => $$details{$num}{'domain'},
'uname' => $$details{$num}{'owner'},
'pid' => '',
'first' => $$details{$num}{'users'}{$owner}{'first'},
'middle' => $$details{$num}{'users'}{$owner}{'middle'},
'last' => $$details{$num}{'users'}{$owner}{'last'},
'gene' => $$details{$num}{'users'}{$owner}{'gene'},
'usec' => '',
'end' => '',
'start' => '',
'emailaddr' => $$details{$num}{'users'}{$owner}{'email'},
'cid' => '',
'context' => 'createowner',
'linefeed' => $linefeed,
'role' => 'cc'
);
$outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo);
} else {
$outcome = 'ok';
}
my $courseargs = {
ccuname => $$details{$num}{'owner'},
ccdomain => $$details{$num}{'domain'},
cdescr => $$details{$num}{'title'},
curl => $$details{$num}{'topmap'},
course_domain => $cdom,
course_home => $$details{$num}{'coursehome'},
nonstandard => $$details{$num}{'nonstandard'},
crscode => $$details{$num}{'coursecode'},
clonecourse => $$details{$num}{'clonecrs'},
clonedomain => $$details{$num}{'clonedom'},
crsid => $$details{$num}{'optional_id'},
curruser => $$details{$num}{'owner'},
crssections => $sectionstr,
crsxlist => $xliststr,
autoadds => $$details{$num}{'adds'},
autodrops => $$details{$num}{'drops'},
notify => $$details{$num}{'notify_owner'},
notify_dc => $$details{$num}{'notify_dc'},
no_end_date => $noenddate,
showphotos => $$details{$num}{'showphotos'},
authtype => $$details{$num}{'authtype'},
autharg => $$details{$num}{'authparam'},
enrollstart => $$details{$num}{'enrollstart'},
enrollend => $$details{$num}{'enrollend'},
startaccess => $$details{$num}{'accessstart'},
endaccess => $$details{$num}{'accessend'},
setpolicy => $Sdetails{$num}{'setpolicy'},
setcontent => $$details{$num}{'setcontent'},
reshome => $reshome,
setkeys => $$details{$num}{'setkeys'},
keyauth => $$details{$num}{'keyauth'},
disresdis => $$details{$num}{'disresdis'},
disablechat => $$details{$num}{'disablechat'},
openall => $$details{$num}{'openall'},
firstres => $firstres
};
if ($outcome eq 'ok') {
my %host_servers = &Apache::loncommon::get_library_servers($cdom);
if (! exists($host_servers{$$details{$num}{'coursehome'}})) {
$$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};
return;
}
&Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum);
} else {
return;
}
#
# Make owner a course coordinator
#
if (($owner_domain) && ($owner_uname)) {
&Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc');
}
#
# Process other reqested users
#
my $stulogmsg = '';
foreach my $userkey (sort keys %{$$details{$num}{'users'}}) {
my $url = '/'.$crsudom.'/'.$crsunum;
if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 0) {
my ($username,$userdom) = split/:/,$userkey;
if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account
my $firstrole = $$details{$num}{'users'}{$userkey}{'roles'}[0];
my $firssec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0];
my $userargs = ('auth' => $$details{$num}{'users'}{$userkey}{'authtype'},
'authparam' => $$details{$num}{'users'}{$userkey}{'authparam'},
'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'},
'dom' => $userdom,
'uname' => $username,
'pid' => $$details{$num}{'users'}{$userkey}{'studentID'},
'first' => $$details{$num}{'users'}{$userkey}{'first'},
'middle' => $$details{$num}{'users'}{$userkey}{'middle'},
'last' => $$details{$num}{'users'}{$userkey}{'last'},
'gene' => $$details{$num}{'users'}{$userkey}{'gene'},
'usec' => $firstsec,
'end' => $$details{$num}{'users'}{$userkey}{'end'},
'start' => $$details{$num}{'users'}{$userkey}{'start'},
'emailaddr' => $$details{$num}{'users'}{$userkey}{'email'},
'cid' => $courseid,
'context' => 'createcourse',
'linefeed' => $linefeed,
'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0],
);
$outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo);
# now add other roles and other sections.
if ($outcome eq 'ok') {
if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {
for (my $i=1; $i<@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}}; $i++) {
my $curr_role = $firstrole;
my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'};
my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'};
my $usec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[$i];
$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {
$url .= '/'.$usec;
}
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);
}
}
if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 1) {
for (my $j=1; $j<@{$$details{$num}{'users'}{$userkey}{'roles'}}; $j++) {
my $curr_role = $$details{$num}{'users'}{$userkey}{'roles'}[$j];
my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'};
my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'};
if ($curr_role eq 'st') {
my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0];
$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {
$url .= '/'.$usec;
}
$$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);
} else {
foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {
$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {
$url .= '/'.$usec;
}
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);
}
}
}
}
}
} else {
foreach my $curr_role (@{$$details{$num}{'users'}{$userkey}{'roles'}}) {
my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'};
my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'};
if ($curr_role eq 'st') {
my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0];
$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {
$url .= '/'.$usec;
}
$$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);
} else {
if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) {
foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {
$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {
$url .= '/'.$usec;
}
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);
$url = '/'.$crsudom.'/'.$crsunum;
if ($usec ne '') {
$url .= '/'.$usec;
}
}
} else {
$$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'');
}
}
}
}
}
}
# Information about keys.
if ($$details{$num}{'setkeys'}) {
$$keysmsg .=
''.&mt('Manage Access Keys').' for '.$$details{$num}{'title'}.$linefeed;
}
# Flush the course logs so reverse user roles immediately updated
&Apache::lonnet::flushcourselogs();
return $courseid;
}
#########################################################
#
# process_date()
#
# input - date/time string in format YYYY:MM:DD:HH:MM:SS (:separators required).
# output - corresponding UNIX time (seconds since epoch).
#
#########################################################
sub process_date {
my $timestr = shift;
my $timestamp = '';
if ($timestr eq "No end date") {
$timestamp = '';
} else {
my @entries = split/:/,$timestr;
for (my $j=0; $j<@entries; $j++) {
if ( length($entries[$j]) > 1 ) {
$entries[$j] =~ s/^0//;
}
}
$entries[1] = $entries[1] - 1;
$timestamp = timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);
}
return $timestamp;
}
1;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.