[LON-CAPA-cvs] cvs: loncom /automation batchcreatecourse.pm /interface courseprefs.pm loncommon.pm loncoursequeueadmin.pm loncreatecourse.pm lonrequestcourse.pm

raeburn raeburn at source.lon-capa.org
Wed Dec 25 04:52:48 EST 2013


raeburn		Wed Dec 25 09:52:48 2013 EDT

  Modified files:              
    /loncom/interface	courseprefs.pm loncommon.pm 
                     	loncoursequeueadmin.pm loncreatecourse.pm 
                     	lonrequestcourse.pm 
    /loncom/automation	batchcreatecourse.pm 
  Log:
  - Unique six character identifier for a course can be created automatically,
    when a course is created, if domain configuration set to include this for
    course requests.
    - Initial use case is for a separate portal (toke-based auth) where students 
      enter the code to sign up for a specific "textbook" course.
  
  
-------------- next part --------------
Index: loncom/interface/courseprefs.pm
diff -u loncom/interface/courseprefs.pm:1.63 loncom/interface/courseprefs.pm:1.64
--- loncom/interface/courseprefs.pm:1.63	Mon Nov 25 20:11:41 2013
+++ loncom/interface/courseprefs.pm	Wed Dec 25 09:52:42 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set configuration settings for a course
 #
-# $Id: courseprefs.pm,v 1.63 2013/11/25 20:11:41 raeburn Exp $
+# $Id: courseprefs.pm,v 1.64 2013/12/25 09:52:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -272,6 +272,7 @@
                 edit => 'Edit Community Settings',
                 gens => 'General community settings',
                 idnu => 'Community ID or number',
+                unco => 'Unique code',
                 desc => 'Community Description',
                 ownr => 'Community Owner',
                 cown => 'Community Co-owners',
@@ -299,6 +300,7 @@
                 edit => 'Edit Course Settings',
                 gens => 'General course settings',
                 idnu => 'Course ID or number',
+                unco => 'Unique code',
                 desc => 'Course Description',
                 cred => 'Student credits', 
                 ownr => 'Course Owner',
@@ -357,13 +359,15 @@
                    { text => $lt{'gens'},
                      help => 'Course_Prefs_General',
                      ordered => ['owner','co-owners','loncaparev','description',
-                                 'clonedfrom','courseid','categories','hidefromcat',
-                                 'externalsyllabus','cloners','url','rolenames'],
+                                 'clonedfrom','courseid','uniquecode','categories',
+                                 'hidefromcat','externalsyllabus','cloners','url',
+                                 'rolenames'],
                      itemtext => {
                                    'owner'            => $lt{'ownr'},
                                    'co-owners'        => $lt{'cown'},
                                    'description'      => $lt{'desc'},
                                    'courseid'         => $lt{'idnu'},
+                                   'uniquecode'       => $lt{'unco'},
                                    'categories'       => $lt{'catg'},
                                    'hidefromcat'      => $lt{'excc'},
                                    'cloners'          => $lt{'clon'}, 
@@ -1863,6 +1867,9 @@
                    input => 'textbox',
                    size  => '25',
                           },
+        'uniquecode'   => {
+                   text => '<b>'.&mt($itemtext->{'uniquecode'}).'</b>',
+                          },
         'cloners'      => { 
                    text => '<b>'.&mt($itemtext->{'cloners'}).'</b><br />'.
                            &mt('Owner and Coordinators included automatically'),
@@ -1908,6 +1915,8 @@
             next if (!$can_toggle_cat);
         } elsif ($item eq 'categories') {
             next if (!$can_categorize);
+        } elsif ($item eq 'uniquecode') {
+            next if (!$env{'course.'.$env{'request.course.id'}.'.internal.uniquecode'});
         }
         unless (($item eq 'cloners') || ($item eq 'rolenames')) {
             $colspan = 2; 
@@ -2053,6 +2062,11 @@
                 }
             }
             $datatable .= $clonedfrom;
+        } elsif ($item eq 'uniquecode') {
+            my $code = $env{'course.'.$env{'request.course.id'}.'.internal.uniquecode'}; 
+            if ($code) {
+                $datatable .= $code;
+            }
         } elsif ($item eq 'co-owners') {
             my $coowners = $env{'course.'.$env{'request.course.id'}.'.internal.co-owners'};
             my @currcoown;
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1165 loncom/interface/loncommon.pm:1.1166
--- loncom/interface/loncommon.pm:1.1165	Tue Dec 24 19:15:10 2013
+++ loncom/interface/loncommon.pm	Wed Dec 25 09:52:42 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1165 2013/12/24 19:15:10 raeburn Exp $
+# $Id: loncommon.pm,v 1.1166 2013/12/25 09:52:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -13884,7 +13884,7 @@
 }
 
 sub construct_course {
-    my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
+    my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
     my $outcome;
     my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {
@@ -13981,7 +13981,8 @@
                    'plc.users.denied',
                    'hidefromcat',
                    'checkforpriv',
-                   'categories'],
+                   'categories',
+                   'internal.uniquecode'],
                    $$crsudom,$$crsunum);
     }
 
@@ -14166,6 +14167,19 @@
 	}
     }
 
+#
+# course should have uniquecode (available to course requester).
+#
+    if ($args->{'uniquecode'}) {
+        my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
+        if ($code) {
+            $cenv{'internal.uniquecode'} = $code;
+            if (ref($coderef)) {
+                $$coderef = $code;
+            }
+        }
+    }
+
     if ($args->{'disresdis'}) {
         $cenv{'pch.roles.denied'}='st';
     }
@@ -14234,6 +14248,60 @@
     return (1,$outcome);
 }
 
+sub make_unique_code {
+    my ($cdom,$cnum) = @_;
+    # get lock on uniquecodes db
+    my $lockhash = {
+                      $cnum."\0".'uniquecodes' => $env{'user.name'}.
+                                                  ':'.$env{'user.domain'},
+                   };
+    my $tries = 0;
+    my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+    my ($code,$error);
+  
+    while (($gotlock ne 'ok') && ($tries<3)) {
+        $tries ++;
+        sleep 1;
+        $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+    }
+    if ($gotlock eq 'ok') {
+        my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
+        my $gotcode;
+        my $attempts = 0;
+        while ((!$gotcode) && ($attempts < 100)) {
+            $code = &generate_code();
+            if (!exists($currcodes{$code})) {
+                $gotcode = 1;
+                unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
+                    $error = 'nostore';
+                }
+            }
+            $attempts ++;
+        }
+        my @del_lock = ($cnum."\0".'uniquecodes');
+        my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
+    } else {
+        $error = 'nolock';
+    }
+    return ($code,$error);
+}
+
+sub generate_code {
+    my $code;
+    my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
+    for (my $i=0; $i<6; $i++) {
+        my $lettnum = int (rand 2);
+        my $item = '';
+        if ($lettnum) {
+            $item = $letts[int( rand(18) )];
+        } else {
+            $item = 1+int( rand(8) );
+        }
+        $code .= $item;
+    }
+    return $code;
+}
+
 ############################################################
 ############################################################
 
Index: loncom/interface/loncoursequeueadmin.pm
diff -u loncom/interface/loncoursequeueadmin.pm:1.38 loncom/interface/loncoursequeueadmin.pm:1.39
--- loncom/interface/loncoursequeueadmin.pm:1.38	Tue Dec 24 19:15:10 2013
+++ loncom/interface/loncoursequeueadmin.pm	Wed Dec 25 09:52:42 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Utilities to administer domain course requests and course self-enroll requests
 #
-# $Id: loncoursequeueadmin.pm,v 1.38 2013/12/24 19:15:10 raeburn Exp $
+# $Id: loncoursequeueadmin.pm,v 1.39 2013/12/25 09:52:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -224,6 +224,11 @@
         if (ref($textstr) eq 'ARRAY') {
             push(@rawmsg,@{$textstr});
         }
+    } elsif ($context eq 'uniquecode') {
+        $rawsubj = 'Course Identifier';
+        if (ref($textstr) eq 'ARRAY') {
+            push(@rawmsg,@{$textstr});
+        }
     }
     my @to_notify = split(/,/,$notifylist);
     my $numsent = 0;
@@ -534,7 +539,7 @@
         @processing_errors, at warn_approves, at warn_rejects, at approvals, at warn_dels,
         @rejections, at rejectionerrors, at nopermissions,%courseroles, at toremove,
         %communityroles,%domdefs,%approvalmsg,%rejectionmsg,$crstype,$queue,
-        $firsturl);
+        $firsturl,$uniquecode,%codes);
     my $count=0;
     while (my @course = &Apache::loncommon::get_env_multiple('form.'.$count.'radioreq')) {
         if ($course[0] =~ /^\d+:.*/) {
@@ -609,6 +614,9 @@
             if (ref($domconfig{'requestcourses'}{'notify'}) eq 'HASH') { 
                 $notifylist = $domconfig{'requestcourses'}{'notify'}{'approval'};
             }
+            if ($domconfig{'requestcourses'}{'uniquecode'}) {
+                $uniquecode = 1;
+            }
         }
         $approvalmsg{'course'} = 
                         [{
@@ -784,10 +792,10 @@
                                                      $ownerdom,$ownername);
                         if ((ref($history{'details'}) eq 'HASH') && 
                             ($history{'disposition'} eq $queue)) {
-                            my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg);
+                            my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,$code);
                             my $result = &course_creation($cdom,$cnum,$context,$history{'details'},\$logmsg,
                                                       \$newusermsg,\$addresult,\$enrollcount,
-                                                      \$response,\$keysmsg,\%domdefs,$longroles);
+                                                      \$response,\$keysmsg,\%domdefs,$longroles,\$code);
                             if ($result eq 'created') {
                                 if ($crstype eq 'community') {
                                     $approvedmsg = $approvalmsg{'community'};
@@ -799,6 +807,14 @@
                                     if (ref($approvedmsg->[1]) eq 'HASH') {
                                         $approvedmsg->[1]->{'args'} = [$firsturl];
                                     }
+                                    if ($code) {
+                                        push(@{$approvedmsg},
+                                            {
+                                              mt   => 'Students can automatically select your course by entering this code: [_1]',
+                                              args => [$code],
+                                            });
+                                        $codes{$cnum} = $code;
+                                    }
                                 }
                                 push(@completed,$cnum);
                                 
@@ -1048,6 +1064,9 @@
                         }
                         my $syllabuslink =
                             &Apache::loncommon::syllabuswrapper($showcourse,$cnum,$cdom);
+                        if ($uniquecode && $codes{$cnum}) {
+                            $syllabuslink .= &mt('Unique code: [_1]',$codes{$cnum});
+                        }
                         $output .= '<li>'.$syllabuslink.'</li>';
                     }
                     $output .= '</ul></p>';
@@ -1309,7 +1328,7 @@
 
 sub course_creation {
     my ($dom,$cnum,$context,$details,$logmsg,$newusermsg,$addresult,$enrollcount,$output,
-        $keysmsg,$domdefs,$longroles) =  @_;
+        $keysmsg,$domdefs,$longroles,$coderef) =  @_;
     unless ((ref($details) eq 'HASH') && (ref($domdefs) eq 'HASH') && 
             (ref($longroles) eq 'HASH')) {
         return 'error: Invalid request';
@@ -1332,7 +1351,7 @@
     my %reqdetails = &build_batchcreatehash($dom,$context,$details,$owneremail,$domdefs);
     my $cid = &LONCAPA::batchcreatecourse::build_course($dom,$cnum,'requestcourses',
                   \%reqdetails,$longroles,$logmsg,$newusermsg,$addresult,
-                  $enrollcount,$output,$keysmsg,$ownerdom,$ownername,$cnum,$crstype);
+                  $enrollcount,$output,$keysmsg,$ownerdom,$ownername,$cnum,$crstype,$coderef);
     if ($cid eq "/$dom/$cnum") {
         $result = 'created';
     } else {
@@ -1344,7 +1363,7 @@
 sub build_batchcreatehash {
     my ($dom,$context,$details,$owneremail,$domdefs) = @_;
     my %batchhash;
-    my @items = qw{owner domain coursehome clonecrs clonedom datemode dateshift enrollstart enrollend accessstart accessend sections crosslists users};
+    my @items = qw{owner domain coursehome clonecrs clonedom datemode dateshift enrollstart enrollend accessstart accessend sections crosslists users uniquecode};
     if ((ref($details) eq 'HASH') && (ref($domdefs) eq 'HASH')) {
         my $emailenc = &escape($owneremail);
         my $owner = $details->{'owner'}.':'.$details->{'domain'};
@@ -1700,8 +1719,8 @@
                 }
                 $reqstatus = $disposition;
                 if ($disposition eq 'process') {
-                    my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg);
-                    my $result = &course_creation($dom,$cnum,'domain',$history{'details'},\$logmsg,\$newusermsg,\$addresult,\$enrollcount,\$response,\$keysmsg,\%domdefs,\%longroles);
+                    my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,$code);
+                    my $result = &course_creation($dom,$cnum,'domain',$history{'details'},\$logmsg,\$newusermsg,\$addresult,\$enrollcount,\$response,\$keysmsg,\%domdefs,\%longroles,\$code);
                     if ($result eq 'created') {
                         $disposition = 'created';
                         $reqstatus = 'created';
Index: loncom/interface/loncreatecourse.pm
diff -u loncom/interface/loncreatecourse.pm:1.152 loncom/interface/loncreatecourse.pm:1.153
--- loncom/interface/loncreatecourse.pm:1.152	Tue Dec 24 19:15:10 2013
+++ loncom/interface/loncreatecourse.pm	Wed Dec 25 09:52:42 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Create a course
 #
-# $Id: loncreatecourse.pm,v 1.152 2013/12/24 19:15:10 raeburn Exp $
+# $Id: loncreatecourse.pm,v 1.153 2013/12/25 09:52:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -160,6 +160,7 @@
                     'crcs' => "Crosslisted courses",
                     'cscs' => "a comma separated list of course sections crosslisted with the current course, with each entry including the institutional course section name followed by a colon and then the (optional) sectionID to be used in LON-CAPA, e.g., fs03ent231001:ent1,fs03bot231001:bot1,fs03zol231002:zol2",
                     'ccre' => "Course credits",
+                    'crcd' => "Create six character course indentifier to share with students",
                     'cred' => "the number of institutional credits students will earn by completing this course",
                     'crco' => "Course Content",
                     'cncr' => "Completely new course",
@@ -343,6 +344,12 @@
                      .&Apache::lonhtmlcommon::row_closure()
             );
         }
+        $r->print(&Apache::lonhtmlcommon::row_title($lt{'crcd'})
+                     .'<span class="LC_nobreak">'
+                     .'<input type="radio" name="uniquecode" value="1" />'.&mt('Yes').(' 'x2)
+                     .'<input type="radio" name="uniquecode" value="0" checked="checked" />'.&mt('No')
+                     .&Apache::lonhtmlcommon::row_closure()
+            );
     }
     # Table: New Course / Clone Course
     $r->print(&Apache::lonhtmlcommon::row_headline()
@@ -653,6 +660,10 @@
         $args->{'defaultcredits'} = $env{'form.defaultcredits'};
     }
 
+    if ($env{'form.uniquecode'}) {
+         $args->{'uniquecode'} = 1;
+    }
+
     #
     # Verify data
     #
@@ -681,12 +692,12 @@
                      ,$env{'form.course_home'}.&Apache::loncommon::end_page()));
         return;
     }
-    my ($courseid,$crsudom,$crsunum);
+    my ($courseid,$crsudom,$crsunum,$code);
     my ($success,$output) = 
 	&Apache::loncommon::construct_course($args,\$logmsg,\$courseid,
 					     \$crsudom,\$crsunum,
 					     $env{'user.domain'},
-					     $env{'user.name'},'dc_create');
+					     $env{'user.name'},'dc_create',undef,undef,\$code);
     $r->print($output);
     if ($success) {
         #
@@ -706,6 +717,11 @@
 	    $r->print(
 		      '<p><a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">'.&mt('Manage Access Keys').'</a></p>');
 	}
+        if ($code) {
+            $r->print(
+                      '<p>'.&mt('Course indentifier to share with students: [_1]',$code).'</p>'
+                     );
+        }
         # Flush the course logs so reverse user roles immediately updated
 	$r->register_cleanup(\&Apache::lonnet::flushcourselogs);
 	$r->print('<p>'.&mt('Roles will be active at next login').'.</p>');
Index: loncom/interface/lonrequestcourse.pm
diff -u loncom/interface/lonrequestcourse.pm:1.69 loncom/interface/lonrequestcourse.pm:1.70
--- loncom/interface/lonrequestcourse.pm:1.69	Tue Dec 24 19:15:11 2013
+++ loncom/interface/lonrequestcourse.pm	Wed Dec 25 09:52:42 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Request a course
 #
-# $Id: lonrequestcourse.pm,v 1.69 2013/12/24 19:15:11 raeburn Exp $
+# $Id: lonrequestcourse.pm,v 1.70 2013/12/25 09:52:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3244,7 +3244,8 @@
 sub print_request_outcome {
     my ($dom,$codetitles,$code_order,$instcredits) = @_;
     my ($output,$cnum,$now,$req_notifylist,$crstype,$enrollstart,$enrollend,
-        %sections,%crosslistings,%personnel, at baduname, at missingdom,%domconfig);
+        %sections,%crosslistings,%personnel, at baduname, at missingdom,%domconfig,
+        $uniquecode);
     my $sectotal = $env{'form.sectotal'};
     my $crosslisttotal = 0;
     $cnum = $env{'form.cnum'};
@@ -3258,6 +3259,7 @@
         if (ref($domconfig{'requestcourses'}{'notify'}) eq 'HASH') {
             $req_notifylist = $domconfig{'requestcourses'}{'notify'}{'approval'};
         }
+        $uniquecode = $domconfig{'requestcourses'}{'uniquecode'};
     }
     $now = time;
     $crstype = $env{'form.crstype'};
@@ -3467,6 +3469,7 @@
                     crstype        => $env{'form.crstype'},
                     instcode       => $instcode,
                     defaultcredits => $credits, 
+                    uniquecode     => $uniquecode,
                     clonedom       => $clonedom,
                     clonecrs       => $clonecrs,
                     datemode       => $env{'form.datemode'},
@@ -3558,7 +3561,7 @@
             $storeresult = 'rejected';
         } elsif ($disposition eq 'process') {
             my %domdefs = &Apache::lonnet::get_domain_defaults($dom);
-            my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,%longroles);
+            my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,%longroles,$code);
             my $type = 'Course';
             if ($crstype eq 'community') {
                 $type = 'Community';
@@ -3569,7 +3572,7 @@
             }
             my $result = &Apache::loncoursequeueadmin::course_creation($dom,$cnum,
                                    'autocreate',$details,\$logmsg,\$newusermsg,\$addresult,
-                                   \$enrollcount,\$response,\$keysmsg,\%domdefs,\%longroles);
+                                   \$enrollcount,\$response,\$keysmsg,\%domdefs,\%longroles,\$code);
             if ($result eq 'created') {
                 $disposition = 'created';
                 $reqstatus = 'created';
@@ -3580,6 +3583,10 @@
                 } else {
                     $output = '<p>'.&mt('Your course request has been processed and the course has been created.');
                 }
+                if ($code) {
+                    $output .= &notification_information($disposition,$env{'user.name'}.':'.$env{'user.domain'},
+                                                         $cnum,$now,$code);
+                }
                 $output .= '<br />'.$role_result.'</p>';
                 $creationresult = 'created';
             } else {
@@ -3803,7 +3810,7 @@
 }
 
 sub notification_information {
-    my ($disposition,$req_notifylist,$cnum,$now) = @_;
+    my ($disposition,$req_notifylist,$cnum,$now,$code) = @_;
     my %emails = &Apache::loncommon::getemails();
     my $address;
     if (($emails{'permanentemail'} ne '') || ($emails{'notification'} ne '')) {
@@ -3831,6 +3838,23 @@
 &mt("Usually this means that your institution's information systems do not list you among the instructional personnel for this course.").'<br />'.
 &mt('The list of instructional personnel for the course will be automatically checked daily, and once you are listed the request will be processed.').
                    '</div>';
+    } elsif (($disposition eq 'created') && ($code)) {
+        my $codemsg = [{
+                         mt   => 'Students can automatically select your course by entering this code: [_1]',
+                         args => [$code],
+                     }];
+        $output .= '<br />'.
+                   &mt('Students can automatically select your course by entering this code: [_1].','<b>'.$code.'</b>').
+                   '<br />'.
+                   &mt('A message has been sent to your LON-CAPA account with this information').'</br />';
+        if ($address ne '') {
+            $output.= &mt('And an e-mail has also been sent to: [_1] with this code.',$address).'<br />';
+        }
+        my $sender = $env{'user.name'}.':'.$env{'user.domain'};
+        if ($code) {
+            &Apache::loncoursequeueadmin::send_selfserve_notification($req_notifylist,$codemsg,$cnum,$env{'form.cdescr'},
+                                                                      $now,'uniquecode',$sender);
+        }
     } else {
         $output .= '<div class="LC_warning">'.
                    &mt('Your request status is: [_1].',$disposition).
Index: loncom/automation/batchcreatecourse.pm
diff -u loncom/automation/batchcreatecourse.pm:1.38 loncom/automation/batchcreatecourse.pm:1.39
--- loncom/automation/batchcreatecourse.pm:1.38	Fri Mar  1 04:49:15 2013
+++ loncom/automation/batchcreatecourse.pm	Wed Dec 25 09:52:47 2013
@@ -1,5 +1,5 @@
 #
-# $Id: batchcreatecourse.pm,v 1.38 2013/03/01 04:49:15 raeburn Exp $
+# $Id: batchcreatecourse.pm,v 1.39 2013/12/25 09:52:47 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -75,6 +75,7 @@
 # <topmap></topmap>
 # <firstres>nav</firstres>
 # <crsquota>20</crsquota>
+# <uniquecode>1</uniquecode>
 # <clonecrs>466011437c34194msul1</clonecrs>
 # <clonedom>msu</clonedom>
 # <datemode>shift</datemode>
@@ -151,7 +152,8 @@
 #
 # 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.
@@ -178,16 +180,19 @@
 #                    /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 {
@@ -205,7 +210,7 @@
             $longroles{'Community'}{$1} = $3;
         }
     }
-    my ($logmsg,$keysmsg,$newusermsg,$addresult);
+    my ($logmsg,$keysmsg,$newusermsg,$addresult,%codehash);
     my %enrollcount = ();
     my $newcoursedir = LONCAPA::tempdir().'/addcourse/'.$dom.'/'.$context;
     if ($context eq 'auto') {
@@ -224,15 +229,21 @@
                 &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);
 }
 
 #############################################################
@@ -255,7 +266,7 @@
     my $xlist = 0;
     my $userkey = '';
     my $role = '';
-    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');
+    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');
@@ -385,12 +396,13 @@
 #   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
@@ -398,7 +410,8 @@
 #########################################################
 
 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'};
@@ -498,6 +511,7 @@
                crscode => $details->{'coursecode'},
                defaultcredits => $details->{'defaultcredits'},
                crsquota => $details->{'crsquota'},
+               uniquecode => $details->{'uniquecode'},
                clonecourse => $details->{'clonecrs'},
                clonedomain => $details->{'clonedom'},
                datemode => $details->{'datemode'},
@@ -533,7 +547,9 @@
             $$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;


More information about the LON-CAPA-cvs mailing list