--- loncom/automation/batchcreatecourse.pm 2008/07/02 18:44:16 1.27 +++ loncom/automation/batchcreatecourse.pm 2019/07/26 02:28:28 1.43 @@ -1,5 +1,5 @@ # -# $Id: batchcreatecourse.pm,v 1.27 2008/07/02 18:44:16 raeburn Exp $ +# $Id: batchcreatecourse.pm,v 1.43 2019/07/26 02:28:28 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -56,6 +56,7 @@ use strict; # Underwater Basket Weaving # Course # ss05ubw101 +# 3 # msul1 # msu # /res/msu/ @@ -74,6 +75,7 @@ use strict; # # nav # 20 +# 1 # 466011437c34194msul1 # msu # shift @@ -81,6 +83,7 @@ use strict; # # 1 # 1 +# 1 # 0 # keyadmin:msu # 1 @@ -122,6 +125,7 @@ use strict; # Spartanx # # +# # # # @@ -149,7 +153,8 @@ use strict; # # Many of these are binary options (corresponding to either checkboxes or # 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 # checked checkbox or 'Yes' response in the original CCRS web page. @@ -159,7 +164,7 @@ use strict; # firstres can be nav, syl, or blank for "Navigate Contents", Syllabus, or # no entry respectively. # -# crstype can be Course or Group +# crstype can be Course, Community or Placement # # crsquota is the total disk space permitted for course group portfolio files # in all course groups. @@ -176,16 +181,19 @@ use strict; # /home/httpd/perl/tmp/addcourse/$dom/auto/pending if $context = auto # /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 # context - auto if called from command line, web if called from browser # dom - domain for which the course is being created # uname - username 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. -# logmsg - text to be logged -# keysmsg - text containing link(s) to manage keys page(s) +# outputs (four) - output - text recording user roles added etc. +# logmsg - text to be logged +# 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 { @@ -197,14 +205,15 @@ sub create_courses { open(FILE,"<$$perlvarref{'lonTabDir'}.'/rolesplain.tab"); my @rolesplain = ; close(FILE); - foreach (@rolesplain) { - if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) { - $longroles{$1} = $2; + foreach my $item (@rolesplain) { + if ($item =~ /^(st|ta|ep|ad|in|cc|co):([\w\s]+):?([\w\s]*)/) { + $longroles{'Course'}{$1} = $2; + $longroles{'Community'}{$1} = $3; } } - my ($logmsg,$keysmsg,$newusermsg,$addresult); + my ($logmsg,$keysmsg,$newusermsg,$addresult,%codehash,%instcodes); my %enrollcount = (); - my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context; + my $newcoursedir = LONCAPA::tempdir().'/addcourse/'.$dom.'/'.$context; if ($context eq 'auto') { $newcoursedir .= '/pending'; } else { @@ -219,16 +228,26 @@ sub create_courses { 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); + foreach my $num (sort(keys(%details))) { + my $reqdetails = $details{$num}; + 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; + } + if ($details{$num}{'coursecode'} ne '') { + push(@{$instcodes{$details{$num}{'coursecode'}}},$courseid); + } } } } } } - return ($output,$logmsg,$keysmsg); + return ($output,$logmsg,$keysmsg,\%codehash,\%instcodes); } ############################################################# @@ -251,7 +270,8 @@ sub parse_coursereqs { my $xlist = 0; my $userkey = ''; my $role = ''; - my @items = ('title','optional_id','coursecode','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','datemode','dateshift','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 @possroles = qw(st ad ep ta in cc co); my @dateitems = ('enrollstart','enrollend','accessstart','accessend'); my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID'); my $p = HTML::Parser->new @@ -271,7 +291,7 @@ sub parse_coursereqs { } if ("@state" eq "class users user roles role") { $role = $attr->{id}; - if ($role =~ /^(st|ad|ep|ta|in|cc)$/) { + if (grep(/^\Q$role\E$/,@possroles)) { push(@{$$details{$num}{'users'}{$userkey}{'roles'}}, $role); %{$$details{$num}{'users'}{$userkey}{$role}} = (); @{$$details{$num}{'users'}{$userkey}{$role}{'usec'}} = (); @@ -317,17 +337,17 @@ sub parse_coursereqs { @{$$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); + $$details{$num}{'users'}{$userkey}{'emailenc'} = &LONCAPA::escape($text); } 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); } } 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); } } 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 '') { push(@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}},$text); } @@ -370,7 +390,7 @@ sub parse_coursereqs { # build_course() # # inputs -# domain +# course 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 @@ -379,8 +399,14 @@ sub parse_coursereqs { # 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 +# ref to scalar used to accumulate information about added roles +# 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 # LON-CAPA courseID for new (created) course @@ -388,123 +414,156 @@ sub parse_coursereqs { ######################################################### sub build_course { - my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_; - my $owner_uname = $$details{$num}{'owner'}; - my $owner_domain = $$details{$num}{'domain'}; + my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult, + $enrollcount,$output,$keysmsg,$udom,$uname,$cnum,$category,$coderef) = @_; + return unless (ref($details) eq 'HASH'); + my $owner_uname = $details->{'owner'}; + my $owner_domain = $details->{'domain'}; my $owner = $owner_uname.':'.$owner_domain; my $sectionstr = ''; my $xliststr = ''; my $noenddate = ''; 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 { + if ($details->{'crstype'} eq 'Placement') { + $crstype = $details->{'crstype'}; + } else { + $crstype = 'Course'; + } + $ccrole = 'cc'; + if (ref($longroles) eq 'HASH') { + $rolenames = $longroles->{'Course'}; + } + } my $linefeed; if ($context eq 'auto') { $linefeed = "\n"; } else { $linefeed = "
\n"; } - if ($$details{$num}{'accessend'} eq '') { + if ($details->{'accessend'} eq '') { $noenddate = 1; } - my $reshome = $$details{$num}{'reshome'}; + my $reshome = $details->{'reshome'}; if ($reshome eq '') { $reshome = '/res/'.$cdom; } - my $firstres = $$details{$num}{'firstres'}; + my $firstres = $details->{'firstres'}; if ($firstres eq '') { - $firstres = 'syl'; + if ($crstype eq 'Community') { + $firstres = 'nav'; + } elsif ($crstype eq 'Placement') { + $firstres = 'blank'; + } else { + $firstres = 'syl'; + } } - foreach my $secid (sort keys %{$$details{$num}{'sections'}}) { - $sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'}.','; + foreach my $secid (sort(keys(%{$details->{'sections'}}))) { + $sectionstr .= $details->{'sections'}{$secid}{'inst'}.':'.$details->{'sections'}{$secid}{'loncapa'}.','; } $sectionstr =~ s/,$//; - foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) { - $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}.','; + foreach my $xlist (sort(keys(%{$details->{'crosslists'}}))) { + $xliststr .= $details->{'crosslists'}{$xlist}{'inst'}.':'.$details->{'crosslists'}{$xlist}{'loncapa'}.','; } $xliststr =~ s/,$//; my %courseinfo = ( - inst_code => $$details{$num}{'coursecode'}, - description => $$details{$num}{'title'} + inst_code => $details->{'coursecode'}, + description => $details->{'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'}, - 'udom' => $$details{$num}{'domain'}, - 'uname' => $$details{$num}{'owner'}, - 'pid' => $$details{$num}{'users'}{$owner}{'studentID'}, - 'first' => $$details{$num}{'users'}{$owner}{'firstname'}, - 'middle' => $$details{$num}{'users'}{$owner}{'middlename'}, - 'last' => $$details{$num}{'users'}{$owner}{'lastname'}, - 'gene' => $$details{$num}{'users'}{$owner}{'generation'}, + if (&Apache::lonnet::homeserver($details->{'owner'},$details->{'domain'}) eq 'no_host') { # Add user if no account + my $ownerargs = {'auth' => $details->{'ownerauthtype'}, + 'authparam' => $details->{'ownerauthparam'}, + 'emailenc' => $details->{'emailenc'}, + 'udom' => $details->{'domain'}, + 'uname' => $details->{'owner'}, + 'pid' => $details->{'users'}{$owner}{'studentID'}, + 'first' => $details->{'users'}{$owner}{'firstname'}, + 'middle' => $details->{'users'}{$owner}{'middlename'}, + 'last' => $details->{'users'}{$owner}{'lastname'}, + 'gene' => $details->{'users'}{$owner}{'generation'}, 'usec' => '', 'end' => '', 'start' => '', - 'emailaddr' => $$details{$num}{'users'}{$owner}{'email'}, + 'emailaddr' => $details->{'users'}{$owner}{'email'}, 'cid' => '', 'context' => 'createowner', 'linefeed' => $linefeed, - 'role' => 'cc', + 'role' => $ccrole, }; - $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo,$context); + $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$rolenames,\%courseinfo,$context); } else { $outcome = 'ok'; } if ($outcome eq 'ok') { - if ($$details{$num}{'datemode'} !~ /^(preserve|shift|delete)$/) { - $$details{$num}{'datemode'} = 'shift'; - $$details{$num}{'dateshift'} = 365; + if ($details->{'datemode'} !~ /^(preserve|shift|delete)$/) { + $details->{'datemode'} = 'shift'; + $details->{'dateshift'} = 365; } my $courseargs = { - ccuname => $$details{$num}{'owner'}, - ccdomain => $$details{$num}{'domain'}, - cdescr => $$details{$num}{'title'}, - crstype => $$details{$num}{'crstype'}, - curl => $$details{$num}{'topmap'}, + ccuname => $details->{'owner'}, + ccdomain => $details->{'domain'}, + cdescr => $details->{'title'}, + crstype => $details->{'crstype'}, + curl => $details->{'topmap'}, course_domain => $cdom, - course_home => $$details{$num}{'coursehome'}, - nonstandard => $$details{$num}{'nonstandard'}, - crscode => $$details{$num}{'coursecode'}, - crsquota => $$details{$num}{'crsquota'}, - clonecourse => $$details{$num}{'clonecrs'}, - clonedomain => $$details{$num}{'clonedom'}, - datemode => $$details{$num}{'datemode'}, - dateshift => $$details{$num}{'dateshift'}, - crsid => $$details{$num}{'optional_id'}, - curruser => $$details{$num}{'owner'}, + course_home => $details->{'coursehome'}, + nonstandard => $details->{'nonstandard'}, + crscode => $details->{'coursecode'}, + defaultcredits => $details->{'defaultcredits'}, + crsquota => $details->{'crsquota'}, + uniquecode => $details->{'uniquecode'}, + clonecourse => $details->{'clonecrs'}, + clonedomain => $details->{'clonedom'}, + datemode => $details->{'datemode'}, + dateshift => $details->{'dateshift'}, + crsid => $details->{'optional_id'}, + curruser => $details->{'owner'}, crssections => $sectionstr, crsxlist => $xliststr, - autoadds => $$details{$num}{'adds'}, - autodrops => $$details{$num}{'drops'}, - notify => $$details{$num}{'notify_owner'}, - notify_dc => $$details{$num}{'notify_dc'}, + autoadds => $details->{'adds'}, + autodrops => $details->{'drops'}, + notify => $details->{'notify_owner'}, + notify_dc => $details->{'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 => $$details{$num}{'setpolicy'}, - setcontent => $$details{$num}{'setcontent'}, + showphotos => $details->{'showphotos'}, + authtype => $details->{'authtype'}, + autharg => $details->{'authparam'}, + enrollstart => $details->{'enrollstart'}, + enrollend => $details->{'enrollend'}, + startaccess => $details->{'accessstart'}, + endaccess => $details->{'accessend'}, + setpolicy => $details->{'setpolicy'}, + setcontent => $details->{'setcontent'}, + setcomment => $details->{'setcomment'}, reshome => $reshome, - setkeys => $$details{$num}{'setkeys'}, - keyauth => $$details{$num}{'keyauth'}, - disresdis => $$details{$num}{'disresdis'}, - disablechat => $$details{$num}{'disablechat'}, - openall => $$details{$num}{'openall'}, + setkeys => $details->{'setkeys'}, + keyauth => $details->{'keyauth'}, + disresdis => $details->{'disresdis'}, + disablechat => $details->{'disablechat'}, + openall => $details->{'openall'}, firstres => $firstres }; + if ($details->{'textbook'}) { + $courseargs->{'textbook'} = $details->{'textbook'}; + } my %host_servers = &Apache::lonnet::get_servers($cdom,'library'); - if (! exists($host_servers{$$details{$num}{'coursehome'}})) { - $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'}; + 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); + my ($success, $msg) = + &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum, + $udom,$uname,$context,$cnum,$category,$coderef); $$logmsg .= $msg; if (!$success) { return; @@ -512,112 +571,207 @@ sub build_course { } else { return; } - + # -# Make owner a course coordinator +# Make owner a coordinator # if (($owner_domain) && ($owner_uname)) { - &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc','','','','',$context); + &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,$ccrole,'','','','',$context); } # # 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 = ''; - foreach my $userkey (sort keys %{$$details{$num}{'users'}}) { + foreach my $userkey (sort(keys(%{$details->{'users'}}))) { 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; if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account - my $firstrole = $$details{$num}{'users'}{$userkey}{'roles'}[0]; - my $firstsec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0]; + my @reqroles = @{$details->{'users'}{$userkey}{'roles'}}; + 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 = { - 'auth' => $$details{$num}{'users'}{$userkey}{'authtype'}, - 'authparam' => $$details{$num}{'users'}{$userkey}{'autharg'}, - 'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'}, + 'auth' => $details->{'users'}{$userkey}{'authtype'}, + 'authparam' => $details->{'users'}{$userkey}{'autharg'}, + 'emailenc' => $details->{'users'}{$userkey}{'emailenc'}, 'udom' => $userdom, 'uname' => $username, - 'pid' => $$details{$num}{'users'}{$userkey}{'studentID'}, - 'first' => $$details{$num}{'users'}{$userkey}{'firstname'}, - 'middle' => $$details{$num}{'users'}{$userkey}{'middlename'}, - 'last' => $$details{$num}{'users'}{$userkey}{'lastname'}, - 'gene' => $$details{$num}{'users'}{$userkey}{'generation'}, + 'pid' => $details->{'users'}{$userkey}{'studentID'}, + 'first' => $details->{'users'}{$userkey}{'firstname'}, + 'middle' => $details->{'users'}{$userkey}{'middlename'}, + 'last' => $details->{'users'}{$userkey}{'lastname'}, + 'gene' => $details->{'users'}{$userkey}{'generation'}, 'usec' => $firstsec, - 'end' => $$details{$num}{'users'}{$userkey}{'end'}, - 'start' => $$details{$num}{'users'}{$userkey}{'start'}, - 'emailaddr' => $$details{$num}{'users'}{$userkey}{'emailaddr'}, + 'end' => $details->{'users'}{$userkey}{'end'}, + 'start' => $details->{'users'}{$userkey}{'start'}, + 'emailaddr' => $details->{'users'}{$userkey}{'emailaddr'}, 'cid' => $courseid, 'crs' => $crsunum, 'cdom' => $crsudom, 'context' => 'createcourse', 'linefeed' => $linefeed, - 'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0], + 'role' => $details->{'users'}{$userkey}{'roles'}[0], }; + 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. 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++) { + if ((($firstrole ne 'st') && ($firstrole ne $ccrole) && ($firstrole ne '')) && (@{$details->{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) { + for (my $i=1; $i<@{$details->{'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]; + my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; + my $end = $details->{'users'}{$userkey}{$curr_role}{'end'}; + my $usec = $details->{'users'}{$userkey}{$firstrole}{'usec'}[$i]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + 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) { - 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 (@reqroles > 0) { + foreach my $curr_role (@reqroles) { + my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; + my $end = $details->{'users'}{$userkey}{$curr_role}{'end'}; 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; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); - } else { - foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) { + my $credits; + if (exists($details->{'users'}{$userkey}{'credits'})) { + $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; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + 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 { - 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'}; + foreach my $curr_role (@{$details->{'users'}{$userkey}{'roles'}}) { + my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; + my $end = $details->{'users'}{$userkey}{$curr_role}{'end'}; 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; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); - } else { - if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) { - foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) { + my $credits; + if (exists($details->{'users'}{$userkey}{'credits'})) { + $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 ((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; if ($usec ne '') { $url .= '/'.$usec; } - my $stdresult = &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + 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; } } else { $url = '/'.$crsudom.'/'.$crsunum; - $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'',$context); + 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); } } } @@ -625,15 +779,26 @@ sub build_course { } # Information about keys. - if ($$details{$num}{'setkeys'}) { + if ($details->{'setkeys'}) { $$keysmsg .= - ''.&mt('Manage Access Keys').' for '.$$details{$num}{'title'}.$linefeed; + ''.&mt('Manage Access Keys').' for '.$details->{'title'}.$linefeed; } # Flush the course logs so reverse user roles immediately updated &Apache::lonnet::flushcourselogs(); 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()