--- loncom/automation/batchcreatecourse.pm 2009/10/31 17:54:51 1.32 +++ loncom/automation/batchcreatecourse.pm 2020/05/22 22:01:59 1.40.2.1.2.1 @@ -1,5 +1,5 @@ # -# $Id: batchcreatecourse.pm,v 1.32 2009/10/31 17:54:51 raeburn Exp $ +# $Id: batchcreatecourse.pm,v 1.40.2.1.2.1 2020/05/22 22:01:59 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,11 +83,13 @@ use strict; # # 1 # 1 +# 1 # 0 # keyadmin:msu # 1 # 1 # +# # 1 # 1 # @@ -122,6 +126,7 @@ use strict; # Spartanx # # +# # # # @@ -149,7 +154,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 +165,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 or Community # # crsquota is the total disk space permitted for course group portfolio files # in all course groups. @@ -176,16 +182,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 { @@ -203,9 +212,9 @@ sub create_courses { $longroles{'Community'}{$1} = $3; } } - my ($logmsg,$keysmsg,$newusermsg,$addresult); + my ($logmsg,$keysmsg,$newusermsg,$addresult,%codehash); my %enrollcount = (); - my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context; + my $newcoursedir = LONCAPA::tempdir().'/addcourse/'.$dom.'/'.$context; if ($context eq 'auto') { $newcoursedir .= '/pending'; } else { @@ -222,15 +231,21 @@ 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; + } } } } } } - return ($output,$logmsg,$keysmsg); + return ($output,$logmsg,$keysmsg,\%codehash); } ############################################################# @@ -253,8 +268,9 @@ 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 @dateitems = ('enrollstart','enrollend','accessstart','accessend'); + 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','openallfrom'); my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID'); my $p = HTML::Parser->new ( @@ -273,7 +289,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'}} = (); @@ -319,17 +335,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); } @@ -382,12 +398,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 @@ -395,7 +412,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'}; @@ -433,7 +451,11 @@ sub build_course { } my $firstres = $details->{'firstres'}; if ($firstres eq '') { - $firstres = 'syl'; + if ($crstype eq 'Community') { + $firstres = 'nav'; + } else { + $firstres = 'syl'; + } } foreach my $secid (sort(keys(%{$details->{'sections'}}))) { $sectionstr .= $details->{'sections'}{$secid}{'inst'}.':'.$details->{'sections'}{$secid}{'loncapa'}.','; @@ -489,7 +511,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'}, @@ -512,20 +536,27 @@ sub build_course { endaccess => $details->{'accessend'}, setpolicy => $details->{'setpolicy'}, setcontent => $details->{'setcontent'}, + setcomment => $details->{'setcomment'}, reshome => $reshome, setkeys => $details->{'setkeys'}, keyauth => $details->{'keyauth'}, disresdis => $details->{'disresdis'}, disablechat => $details->{'disablechat'}, openall => $details->{'openall'}, + openallfrom => $details->{'openallfrom'}, 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; @@ -606,8 +637,14 @@ 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') { @@ -638,7 +675,12 @@ 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); + 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 = ''; @@ -679,7 +721,12 @@ 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); + 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) {