--- loncom/automation/batchcreatecourse.pm 2010/02/26 23:50:28 1.35.4.1 +++ loncom/automation/batchcreatecourse.pm 2013/12/25 09:52:47 1.39 @@ -1,5 +1,5 @@ # -# $Id: batchcreatecourse.pm,v 1.35.4.1 2010/02/26 23:50:28 raeburn Exp $ +# $Id: batchcreatecourse.pm,v 1.39 2013/12/25 09:52:47 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 @@ -122,6 +124,7 @@ use strict; # Spartanx # # +# # # # @@ -149,7 +152,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, 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. @@ -176,16 +180,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 +210,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 +229,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,7 +266,7 @@ 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','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'); @@ -383,12 +396,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 @@ -396,7 +410,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'}; @@ -434,7 +449,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'}.','; @@ -490,10 +509,11 @@ 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'}, - cloneroster => $details->{'cloneroster'}, datemode => $details->{'datemode'}, dateshift => $details->{'dateshift'}, crsid => $details->{'optional_id'}, @@ -527,7 +547,9 @@ sub build_course { $$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; @@ -608,8 +630,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') { @@ -640,7 +668,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 = ''; @@ -681,7 +714,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) {