--- loncom/automation/batchcreatecourse.pm 2009/08/15 00:25:34 1.30 +++ loncom/automation/batchcreatecourse.pm 2019/07/26 02:28:28 1.43 @@ -1,5 +1,5 @@ # -# $Id: batchcreatecourse.pm,v 1.30 2009/08/15 00:25:34 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 { @@ -221,15 +230,24 @@ sub create_courses { &parse_coursereqs($newcoursedir.'/'.$request, \%details); foreach my $num (sort(keys(%details))) { my $reqdetails = $details{$num}; - my $courseid = &build_course($dom,$num,$context,$reqdetails,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg); + 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); } ############################################################# @@ -252,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 @@ -272,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'}} = (); @@ -318,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); } @@ -381,12 +400,13 @@ sub parse_coursereqs { # 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 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. +# 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 @@ -394,7 +414,8 @@ sub parse_coursereqs { ######################################################### sub build_course { - my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname,$cnum,$category) = @_; + 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'}; @@ -403,7 +424,24 @@ sub build_course { 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"; @@ -419,7 +457,13 @@ sub build_course { } 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->{'sections'}}))) { $sectionstr .= $details->{'sections'}{$secid}{'inst'}.':'.$details->{'sections'}{$secid}{'loncapa'}.','; @@ -453,9 +497,9 @@ sub build_course { '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'; } @@ -475,7 +519,9 @@ sub build_course { 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'}, @@ -498,6 +544,7 @@ sub build_course { endaccess => $details->{'accessend'}, setpolicy => $details->{'setpolicy'}, setcontent => $details->{'setcontent'}, + setcomment => $details->{'setcomment'}, reshome => $reshome, setkeys => $details->{'setkeys'}, keyauth => $details->{'keyauth'}, @@ -506,12 +553,17 @@ sub build_course { 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->{'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); + my ($success, $msg) = + &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum, + $udom,$uname,$context,$cnum,$category,$coderef); $$logmsg .= $msg; if (!$success) { return; @@ -519,17 +571,23 @@ 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->{'users'}}))) { my $url = '/'.$crsudom.'/'.$crsunum; @@ -537,8 +595,35 @@ sub build_course { 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->{'users'}{$userkey}{'roles'}[0]; - my $firstsec = $details->{'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->{'users'}{$userkey}{'authtype'}, 'authparam' => $details->{'users'}{$userkey}{'autharg'}, @@ -559,12 +644,18 @@ sub build_course { 'cdom' => $crsudom, 'context' => 'createcourse', 'linefeed' => $linefeed, - 'role' => $details->{'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->{'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->{'users'}{$userkey}{$firstrole}{'usec'}}; $i++) { my $curr_role = $firstrole; my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; @@ -574,12 +665,15 @@ sub build_course { 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->{'users'}{$userkey}{'roles'}} > 1) { - for (my $j=1; $j<@{$details->{'users'}{$userkey}{'roles'}}; $j++) { - my $curr_role = $details->{'users'}{$userkey}{'roles'}[$j]; + 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') { @@ -588,15 +682,38 @@ sub build_course { if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); - } else { + 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); } } } @@ -611,21 +728,50 @@ sub build_course { if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); - } else { + 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); } } } @@ -642,6 +788,17 @@ sub build_course { 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()