[LON-CAPA-cvs] cvs: loncom / lond /enrollment localenroll.pm /interface lonrequestcourse.pm /lonnet/perl lonnet.pm

raeburn raeburn at source.lon-capa.org
Wed Apr 16 10:40:18 EDT 2014


raeburn		Wed Apr 16 14:40:18 2014 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
    /loncom/enrollment	localenroll.pm 
    /loncom/interface	lonrequestcourse.pm 
  Log:
  - Course requests for unofficial courses, textbook courses and communities
    can include validation.
    - lonrequestcourse.pm 
      - New subroutine: pending_validation_form() generates web form used to
        proceed to validation (can be local script, or script on remote server)
      - Prepended new arg to args passed to: &print_request_outcome() and 
        &process_request()  -- $lonhost (lonHostID of current server).
   - localenroll.pm
     - &validate_crsreq() accepts additional (optional) arg -- ref to hash of
       custominfo. 
     - &crsreq_updates() supports additional action type ('prevalidate') which
       is used to generate form elements needed for validation of request.
   - lond
     - &validate_crsreq_handler() accepts additional -- $customdata
       which is a frozen hash of custominfo passed in from lonnet.pm 
   - lonnet.pm
     - &auto_courserequest_validation() accepts additional arg -- ref to hash of 
       custominfo (contains key => value for custm form elements retrieved from
       course request review page.
  
  
-------------- next part --------------
Index: loncom/lond
diff -u loncom/lond:1.507 loncom/lond:1.508
--- loncom/lond:1.507	Mon Apr  7 23:37:57 2014
+++ loncom/lond	Wed Apr 16 14:39:59 2014
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.507 2014/04/07 23:37:57 raeburn Exp $
+# $Id: lond,v 1.508 2014/04/16 14:39:59 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -61,7 +61,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.507 $'; #' stupid emacs
+my $VERSION='$Revision: 1.508 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -5290,19 +5290,20 @@
 sub validate_crsreq_handler {
     my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";
-    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail);
+    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$customdata) = split(/:/, $tail);
     $instcode = &unescape($instcode);
     $owner = &unescape($owner);
     $crstype = &unescape($crstype);
     $inststatuslist = &unescape($inststatuslist);
     $instcode = &unescape($instcode);
     $instseclist = &unescape($instseclist);
+    my $custominfo = &Apache::lonnet::thaw_unescape($customdata);
     my $outcome;
     eval {
         local($SIG{__DIE__})='DEFAULT';
         $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,
                                                  $inststatuslist,$instcode,
-                                                 $instseclist);
+                                                 $instseclist,$custominfo);
     };
     if (!$@) {
         &Reply($client, \$outcome, $userinput);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1254 loncom/lonnet/perl/lonnet.pm:1.1255
--- loncom/lonnet/perl/lonnet.pm:1.1254	Mon Mar 31 01:09:20 2014
+++ loncom/lonnet/perl/lonnet.pm	Wed Apr 16 14:40:05 2014
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1254 2014/03/31 01:09:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1255 2014/04/16 14:40:05 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -7860,17 +7860,20 @@
 }
 
 sub auto_courserequest_validation {
-    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_;
+    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$custominfo) = @_;
     my ($homeserver,$response);
     if ($dom =~ /^$match_domain$/) {
         $homeserver = &domain($dom,'primary');
     }
-    unless ($homeserver eq 'no_host') {  
-          
+    unless ($homeserver eq 'no_host') {
+        my $customdata;
+        if (ref($custominfo) eq 'HASH') {
+            $customdata = &freeze_escape($custominfo);
+        }
         $response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner).
                                     ':'.&escape($crstype).':'.&escape($inststatuslist).
-                                    ':'.&escape($instcode).':'.&escape($instseclist),
-                                    $homeserver));
+                                    ':'.&escape($instcode).':'.&escape($instseclist).':'.
+                                    $customdata,$homeserver));
     }
     return $response;
 }
Index: loncom/enrollment/localenroll.pm
diff -u loncom/enrollment/localenroll.pm:1.45 loncom/enrollment/localenroll.pm:1.46
--- loncom/enrollment/localenroll.pm:1.45	Fri Jan  3 18:39:55 2014
+++ loncom/enrollment/localenroll.pm	Wed Apr 16 14:40:11 2014
@@ -1,6 +1,6 @@
 # functions to glue school database system into Lon-CAPA for 
 # automated enrollment
-# $Id: localenroll.pm,v 1.45 2014/01/03 18:39:55 raeburn Exp $
+# $Id: localenroll.pm,v 1.46 2014/04/16 14:40:11 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -362,27 +362,31 @@
  (d) a comma-separated list of institutional affiliations of 
      the course owner.
  (e) the institutional code (in the MSU case this is a concatenation of
- semester code, department code, and course number, e.g., fs03nop590.
+ semester code, department code, and course number, e.g., fs03nop590).
  (f) a comma-separated list of institutional sections included in
      the course request (only applicable to official courses).
+ (g) an optional reference to a hash of custom form data.
+     The custom form data will come from crsreq_updates().
 
 A valid courserequest is confirmed by returning 'process'.
-The following can be returned: process, rejected, pending, approval or error (with error condition - no :), followed by a : and then an optional message. 
+The following can be returned: process, rejected, pending, approval or 
+error (with error condition - no :), followed by a : and then an optional message. 
 
 (a) process  - the requestor is the recorded instructor - create the course
 (b) rejected - the requestor should never be requesting this course, reject the
     request permanently
 (c) pending - the requestor is not the recorded instructor, but could
     become so after administrative action at the institution. Put the
-    request in a queue and check localenroll:validate_instcode()
-    periodically until the status changes to "valid".
+    request in a queue and, if an official course, check 
+    localenroll:validate_instcode() periodically until the status changes to 
+    "valid".
 (d) approval - the request will be held pending review by a Domain Coordinator.
 (e) error (followed by the error condition).
 
 =cut
 
 sub validate_crsreq {
-    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_;
+    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$custominfo) = @_;
     my $outcome = 'approval';
     return $outcome;
 }
@@ -449,11 +453,16 @@
     }
     if ($action eq 'review') {
         $outgoing->{'reviewweb'} = '';
+    } elsif ($action eq 'prevalidate') {
+        $outgoing->{'formitems'} = {}; # key=>value, where key is form element name
+                                       #             and value is multiple, if there
+                                       #             are multiple form elements with
+                                       #             the same name.
     } elsif ($action eq 'process') {
         $outgoing->{'formitems'} = {}; # key=>value, where key is form element name
                                        #             and value is multiple, if there
                                        #             are multiple form elements with
-                                       #             the same name.  
+                                       #             the same name.
     } elsif ($action eq 'created') {
         $outgoing->{'createdweb'} = '';
         $outgoing->{'createdmsg'} = [{
@@ -461,8 +470,8 @@
                                      args => [],
                                     }];
     } elsif ($action eq 'queued') {
-        $outgoing->{'queuedmsg'} = [{ 
-                                     mt   => '', 
+        $outgoing->{'queuedmsg'} = [{
+                                     mt   => '',
                                      args => [],
                                     }];
         $outgoing->{'queuedweb'} = '';
Index: loncom/interface/lonrequestcourse.pm
diff -u loncom/interface/lonrequestcourse.pm:1.77 loncom/interface/lonrequestcourse.pm:1.78
--- loncom/interface/lonrequestcourse.pm:1.77	Wed Apr  9 10:50:07 2014
+++ loncom/interface/lonrequestcourse.pm	Wed Apr 16 14:40:17 2014
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Request a course
 #
-# $Id: lonrequestcourse.pm,v 1.77 2014/04/09 10:50:07 raeburn Exp $
+# $Id: lonrequestcourse.pm,v 1.78 2014/04/16 14:40:17 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1526,7 +1526,8 @@
             &Apache::lonnet::auto_possible_instcodes($dom,\@codetitles,\%cat_titles,
                                                      \%cat_order,\@code_order);
         }
-        my ($storeresult,$result) = &print_request_outcome($dom,\@codetitles,
+        my $lonhost = $r->dir_config('lonHostID');
+        my ($storeresult,$result) = &print_request_outcome($lonhost,$dom,\@codetitles,
                                                            \@code_order,$instcredits);
         $r->print($result);
         if (($storeresult eq 'ok') || ($storeresult eq 'created')) {
@@ -3335,7 +3336,7 @@
 }
 
 sub print_request_outcome {
-    my ($dom,$codetitles,$code_order,$instcredits) = @_;
+    my ($lonhost,$dom,$codetitles,$code_order,$instcredits) = @_;
     my ($output,$cnum,$now,$req_notifylist,$crstype,$enrollstart,$enrollend,
         %sections,%crosslistings,%personnel, at baduname, at missingdom,%domconfig,
         $uniquecode);
@@ -3580,13 +3581,14 @@
                     accessend      => $accessend,
                     personnel      => \%personnel,
                   };
-    my ($result,$output) = &process_request($dom,$cnum,$crstype,$now,$details,$instcode,
+    my ($result,$output) = &process_request($lonhost,$dom,$cnum,$crstype,$now,$details,$instcode,
                                             $req_notifylist,\@instsections,\%domconfig);
     return ($result,$output);
 }
     
 sub process_request {
-    my ($dom,$cnum,$crstype,$now,$details,$instcode,$req_notifylist,$instsections,$domconfig) = @_; 
+    my ($lonhost,$dom,$cnum,$crstype,$now,$details,$instcode,$req_notifylist,$instsections,
+        $domconfig) = @_; 
     my (@inststatuses,$storeresult,$creationresult,$output);
     my $val = 
         &Apache::loncoursequeueadmin::get_processtype('course',$env{'user.name'},
@@ -3606,7 +3608,7 @@
         }
         $storeresult = 'notpermitted'; 
     } else {
-        my ($disposition,$message,$reqstatus);
+        my ($disposition,$message,$reqstatus,$coursedesc);
         my %reqhash = (
                         reqtime   => $now,
                         crstype   => $crstype,
@@ -3614,6 +3616,11 @@
                       );
         my $requestkey = $dom.'_'.$cnum;
         my $validationerror;
+        my $fullname = &Apache::loncommon::plainname($env{'user.name'},
+                                                     $env{'user.domain'});
+        if (ref($details) eq 'HASH') {
+            $coursedesc = $details->{'cdescr'};
+        }
         if ($val eq 'autolimit=') {
             $disposition = 'process';
         } elsif ($val =~ /^autolimit=(\d+)$/) {
@@ -3621,7 +3628,7 @@
             $disposition = &check_autolimit($env{'user.name'},$env{'user.domain'},
                                             $dom,$crstype,$limit,\$message);
         } elsif ($val eq 'validate') {
-            my ($inststatuslist,$validationchk,$validation);
+            my ($inststatuslist,$validationchk,$validation,%custominfo);
             if (@inststatuses > 0) {
                 $inststatuslist = join(',', at inststatuses);
             }
@@ -3631,10 +3638,27 @@
                     $instseclist = join(',',@{$instsections});
                 }
             }
+            my $preprocess = &Apache::lonnet::auto_crsreq_update($dom,$cnum,$crstype,'prevalidate',$env{'user.name'},
+                                                                 $env{'user.domain'},$fullname,$coursedesc);
+            if (ref($preprocess) eq 'HASH') {
+                if (ref($preprocess->{'formitems'}) eq 'HASH') {
+                    foreach my $key (keys(%{$preprocess->{'formitems'}})) {
+                        if ($preprocess->{'formitems'}->{$key} eq 'multiple') {
+                            if (exists($env{'form.'.$key})) {
+                                @{$custominfo{$key}} = &Apache::loncommon::get_env_multiple($env{'form.'.$key});
+                            }
+                        } else {
+                            if (exists($env{'form.'.$key})) {
+                                $custominfo{$key} = $env{'form.'.$key};
+                            }
+                        }
+                    }
+                }
+            }
             $validationchk = 
                 &Apache::lonnet::auto_courserequest_validation($dom,
                     $env{'user.name'}.':'.$env{'user.domain'},$crstype,
-                    $inststatuslist,$instcode,$instseclist);
+                    $inststatuslist,$instcode,$instseclist,\%custominfo);
             if ($validationchk =~ /:/) {
                 ($validation,$message) = split(':',$validationchk);
             } else {
@@ -3651,13 +3675,8 @@
         }
         $reqhash{'disposition'} = $disposition;
         $reqstatus = $disposition;
-        my ($modified,$queued,$coursedesc,%customitems);
+        my ($modified,$queued,$coursedesc,$token,%customitems);
         unless ($disposition eq 'rejected') {
-            if (ref($details) eq 'HASH') {
-                $coursedesc = $details->{'cdescr'};
-            }
-            my $fullname = &Apache::loncommon::plainname($env{'user.name'},
-                                                         $env{'user.domain'});
             my $inprocess = &Apache::lonnet::auto_crsreq_update($dom,$cnum,$crstype,'process',$env{'user.name'},
                                                                 $env{'user.domain'},$fullname,$coursedesc);
             if (ref($inprocess) eq 'HASH') {
@@ -3742,7 +3761,8 @@
                                             crstype     => $crstype,
                                             ownername   => $env{'user.name'},
                                             ownerdom    => $env{'user.domain'},
-                                            description => $env{'form.cdescr'}, 
+                                            description => $env{'form.cdescr'},
+                                            lonhost     => $lonhost,
                                           },
                           };
             if ($crstype eq 'official') {
@@ -3760,9 +3780,19 @@
                 if (($queuehash{$cnum.'_approval'} ne '') || 
                     ($queuehash{$cnum.'_pending'} ne '')) {
                     $queued = 1;
+                    if (ref($queuehash{$cnum.'_pending'}) eq 'HASH') {
+                        $token = $queuehash{$cnum.'_pending'}{'token'};
+                    } 
                 }
             }
             unless ($queued) {
+                if (($disposition eq 'pending') && ($crstype ne 'official')) {
+                    my %reqinfo = (
+                                    $cnum.':'.$dom => $now.':'.$env{'user.name'}.':'.$env{'user.domain'},
+                                  );
+                     $token = &Apache::lonnet::tmpput(\%reqinfo,$lonhost);
+                     $request->{$requestid}->{'token'} = $token;
+                }
                 my $putresult = &Apache::lonnet::newput_dom('courserequestqueue',$request,
                                                             $dom);
                 if ($putresult eq 'ok') {
@@ -3771,9 +3801,11 @@
                     } else {
                         $output .= &mt('Your course request has been recorded.') 
                     }
-                    $output .= '<br />'.
-                              &notification_information($disposition,$req_notifylist,
-                                                        $dom,$cnum,$now);
+                    unless ($disposition eq 'pending') { 
+                        $output .= '<br />'.
+                                   &notification_information($disposition,$req_notifylist,
+                                                             $dom,$cnum,$now);
+                    }
                 } else {
                     $reqstatus = 'domainerror';
                     $reqhash{'disposition'} = $disposition;
@@ -3785,23 +3817,45 @@
         ($storeresult,my $updateresult) = 
             &Apache::loncoursequeueadmin::update_coursereq_status(\%reqhash,$dom,
                 $cnum,$reqstatus,'request',$env{'user.domain'},$env{'user.name'});
-        if ($modified && $queued && $storeresult eq 'ok') {
-            if ($crstype eq 'community') {
-                $output .= '<p>'.&mt('Your community request has been updated').'</p>';
-            } else {
-                $output .= '<p>'.&mt('Your course request has been updated').'</p>';
-            }
-            $output .= &notification_information($disposition,$req_notifylist,$dom,$cnum,$now);
-            if ($disposition eq 'approval') {
+        if ($storeresult eq 'ok') {
+            my $postprocess;
+            if (($disposition eq 'approval') || ($disposition eq 'pending')) {
+                my $updateaction = $disposition;
+                if ($disposition eq 'approval') {
+                    $updateaction = 'queued';
+                }
                 my $fullname = &Apache::loncommon::plainname($env{'user.name'},
                                                              $env{'user.domain'});
-                my $postprocess = 
-                    &Apache::lonnet::auto_crsreq_update($dom,$cnum,$crstype,'queued',$env{'user.name'},
+                $postprocess =
+                    &Apache::lonnet::auto_crsreq_update($dom,$cnum,$crstype,$updateaction,$env{'user.name'},
                                                         $env{'user.domain'},$fullname,$env{'form.cdescr'});
+            }
+            if ($modified && $queued) {
+                if ($crstype eq 'community') {
+                    $output .= '<p>'.&mt('Your community request has been updated').'</p>';
+                } else {
+                    $output .= '<p>'.&mt('Your course request has been updated').'</p>';
+                }
+                if ($disposition eq 'approval') {
+                    $output .= &notification_information($disposition,$req_notifylist,$dom,$cnum,$now);
+                }
+            }
+            if ($disposition eq 'approval') {
                 if ((ref($postprocess) eq 'HASH') && 
                     ((ref($postprocess->{'queuedmsg'}) eq 'HASH') || ($postprocess->{'queuedweb'}))) { 
                     &notification_information($disposition,undef,$dom,$cnum,$now,undef,$postprocess);
                 }
+            } elsif ($disposition eq 'pending') {
+                my $pendingform;
+                if ($crstype ne 'official') {
+                    $pendingform = &pending_validation_form($dom,$cnum,$crstype,$now,$token,
+                                                            $lonhost,$env{'form.cdescr'});
+                }
+                if ($pendingform) {
+                    $output .= $pendingform;
+                } else { 
+                    $output .= &notification_information($disposition,undef,$dom,$cnum,$now,undef,$postprocess);
+                }
             }
         }
         if ($validationerror ne '') {
@@ -4002,11 +4056,20 @@
             }
         }
     } elsif ($disposition eq 'pending') {
-        $output .= '<div class="LC_info">'.
+        my $pending_default = '<div class="LC_info">'.
 &mt('Your request has been placed in a queue pending administrative action.').'<br />'.
 &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>';
+                       '</div>';
+        if (ref($postprocess) eq 'HASH') {
+            if ($postprocess->{'pendingweb'}) {
+                $output .= $postprocess->{'pendingweb'};
+            } else {
+                $output .= $pending_default;
+            }
+        } else {
+            $output .= $pending_default;
+        }
     } elsif ($disposition eq 'created') {
         if (($code) || ((ref($postprocess) eq 'HASH') && 
             ((ref($postprocess->{'createdmsg'}) eq 'ARRAY') || ($postprocess->{'createdweb'})))) {
@@ -4058,6 +4121,53 @@
     return $output;
 }
 
+sub pending_validation_form {
+    my ($cdom,$cnum,$crstype,$now,$token,$lonhost,$cdesc) = @_;
+    my $output;
+    my %postvalues = (
+                      'owner'      => $env{'user.name'}.':'.$env{'user.domain'},
+                      'course'     => $cdom.'_'.$cnum,
+                      'coursetype' => $crstype,
+                     );
+    my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
+
+    if (ref($domconfig{'requestcourses'}) eq 'HASH') {
+        my ($url,$buttontext,$code, at fields);
+        if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
+            $postvalues{'description'} = $cdesc;
+            $url = $domconfig{'requestcourses'}{'validation'}{'url'};
+            if (ref($domconfig{'requestcourses'}{'validation'}{'fields'}) eq 'ARRAY') {
+                @fields = @{$domconfig{'requestcourses'}{'validation'}{'fields'}};
+            }
+            $buttontext = $domconfig{'requestcourses'}{'validation'}{'button'};
+            $output .= $domconfig{'requestcourses'}{'validation'}{'markup'};
+            if (($url =~ m{^(https?\://|/)}) && (@fields > 0)) {
+                $output .= '<form name="crsreqvalidation" action="'.$url.'" method="post">'."\n";
+                foreach my $field (@fields) {
+                    if ($postvalues{$field}) {
+                        $output .= '<input type="hidden" name="'.$field.'" value="'.$postvalues{$field}.'" />'."\n";
+                    }
+                }
+                if ($buttontext eq '') {
+                    if ($crstype eq 'community') {
+                        $buttontext = &mt('Create community');
+                    } else {
+                        $buttontext = &mt('Create course');
+                    }
+                }
+                my $protocol = $Apache::lonnet::protocol{$lonhost};
+                $protocol = 'http' if ($protocol ne 'https');
+                my $crscreator = $protocol.'://'.&Apache::lonnet::hostname($lonhost).'/cgi-bin/createpending.pl';
+                $output .= '<input type="hidden" name="crscreator" value="'.$crscreator.'" />'."\n".
+                           '<input type="hidden" name="token" value="'.$token.'" />'."\n".
+                           '<input type="submit" name="validate" value="'.$buttontext.'" />'."\n".
+                           '</form>'."\n";
+            }
+        }
+    }
+    return $output;
+}
+
 sub check_autolimit {
     my ($uname,$udom,$dom,$crstype,$limit,$message) = @_;
     my %crsroles = &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},
@@ -4585,7 +4695,6 @@
             }
         }
     }
-    my $crstype = 'textbook';
     my $now = time;
     my $reqtype = $env{'form.cloning'};
     my (@inststatuses,$storeresult,$creationresult);
@@ -4650,7 +4759,9 @@
         $details->{datemode} = $env{'form.datemode'};
         $details->{dateshift} = $env{'form.dateshift'};
     }
-    my ($result,$output) = &process_request($dom,$cnum,$crstype,$now,$details,'',$req_notifylist,[],$domconfig);
+    my $lonhost = $r->dir_config('lonHostID');
+    my ($result,$output) = &process_request($lonhost,$dom,$cnum,$crstype,$now,$details,'',
+                                            $req_notifylist,[],$domconfig);
     $r->print($output);
     if (&Apache::loncoursequeueadmin::author_prompt()) {
         &print_author_prompt($r,$action,$cnum,$dom,$crstype,$result);


More information about the LON-CAPA-cvs mailing list