[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.422 and 1.425

version 1.422, 2009/08/18 20:08:13 version 1.425, 2009/08/24 20:08:31
Line 4052  sub put_domain_handler { Line 4052  sub put_domain_handler {
 }  }
 &register_handler("putdom", \&put_domain_handler, 0, 1, 0);  &register_handler("putdom", \&put_domain_handler, 0, 1, 0);
   
 #  
 # Puts a piece of new data in a namespace db file at the domain level   
 # returns error if key already exists  
 #  
 # Parameters:  
 #    $cmd      - The command that got us here.  
 #    $tail     - Tail of the command (remaining parameters).  
 #    $client   - File descriptor connected to client.  
 # Returns  
 #     0        - Requested to exit, caller should shut down.  
 #     1        - Continue processing.  
 #  Side effects:  
 #     reply is written to $client.  
 #  
 sub newput_domain_handler {  
     my ($cmd, $tail, $client)  = @_;  
   
     my $userinput = "$cmd:$tail";  
   
     my ($udom,$namespace,$what) =split(/:/,$tail,3);  
     chomp($what);  
     my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(),  
                                    "N", $what);  
     if(!$hashref) {  
         &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".  
                   "while attempting newputdom\n", $userinput);  
         return 1;  
     }  
   
     my @pairs=split(/\&/,$what);  
     foreach my $pair (@pairs) {  
         my ($key,$value)=split(/=/,$pair);  
         if (exists($hashref->{$key})) {  
             &Failure($client, "key_exists: ".$key."\n",$userinput);  
             return 1;  
         }  
     }  
   
     foreach my $pair (@pairs) {  
         my ($key,$value)=split(/=/,$pair);  
         $hashref->{$key}=$value;  
     }  
   
     if (&untie_domain_hash($hashref)) {  
         &Reply( $client, "ok\n", $userinput);  
     } else {  
         &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".  
                  "while attempting newputdom\n",  
                  $userinput);  
     }  
     return 1;  
 }  
 &register_handler("newputdom", \&newput_domain_handler, 0, 1, 0);  
   
 # Unencrypted get from the namespace database file at the domain level.  # Unencrypted get from the namespace database file at the domain level.
 # This function retrieves a keyed item from a specific named database in the  # This function retrieves a keyed item from a specific named database in the
 # domain directory.  # domain directory.
Line 4156  sub get_domain_handler { Line 4102  sub get_domain_handler {
 &register_handler("getdom", \&get_domain_handler, 0, 1, 0);  &register_handler("getdom", \&get_domain_handler, 0, 1, 0);
   
 #  #
 #   Deletes a key in a user profile database.  
 #    
 #   Parameters:  
 #       $cmd                  - Command keyword (deldom).  
 #       $tail                 - Command tail.  IN this case a colon  
 #                               separated list containing:  
 #                               the domain to which the database file belongs;    
 #                               the namespace (name of the database file);  
 #                               & separated list of keys to delete.  
 #       $client              - File open on client socket.  
 # Returns:  
 #     1   - Continue processing  
 #     0   - Exit server.  
 #  
 #  
 sub delete_domain_entry {  
     my ($cmd, $tail, $client) = @_;  
   
     my $userinput = "cmd:$tail";  
   
     my ($udom,$namespace,$what) = split(/:/,$tail);  
     chomp($what);  
     my $hashref = &tie_domain_hash($udom, $namespace, &GDBM_WRCREAT(),  
                                  "D",$what);  
     if ($hashref) {  
         my @keys=split(/\&/,$what);  
         foreach my $key (@keys) {  
             delete($hashref->{$key});  
         }  
         if (&untie_user_hash($hashref)) {  
             &Reply($client, "ok\n", $userinput);  
         } else {  
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".  
                     "while attempting deldom\n", $userinput);  
         }  
     } else {  
         &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".  
                  "while attempting deldom\n", $userinput);  
     }  
     return 1;  
 }  
 &register_handler("deldom", \&delete_domain_entry, 0, 1, 0);  
   
 #  
 #  Puts an id to a domains id database.   #  Puts an id to a domains id database. 
 #  #
 #  Parameters:  #  Parameters:
Line 4296  sub get_id_handler { Line 4198  sub get_id_handler {
 }  }
 &register_handler("idget", \&get_id_handler, 0, 1, 0);  &register_handler("idget", \&get_id_handler, 0, 1, 0);
   
 sub dump_dom_with_regexp {  
     my ($cmd, $tail, $client) = @_;  
     my $userinput = "$cmd:$tail";  
     my ($udom,$namespace,$regexp,$range)=split(/:/,$tail);  
     if (defined($regexp)) {  
         $regexp=&unescape($regexp);  
     } else {  
         $regexp='.';  
     }  
     my ($start,$end);  
     if (defined($range)) {  
         if ($range =~/^(\d+)\-(\d+)$/) {  
             ($start,$end) = ($1,$2);  
         } elsif ($range =~/^(\d+)$/) {  
             ($start,$end) = (0,$1);  
         } else {  
             undef($range);  
         }  
     }  
     my $hashref = &tie_domain_hash($udom, $namespace, &GDBM_READER());  
     if ($hashref) {  
         my $qresult='';  
         my $count=0;  
         while (my ($key,$value) = each(%$hashref)) {  
             if ($regexp eq '.') {  
                 $count++;  
                 if (defined($range) && $count >= $end)   { last; }  
                 if (defined($range) && $count <  $start) { next; }  
                 $qresult.=$key.'='.$value.'&';  
             } else {  
                 my $unescapeKey = &unescape($key);  
                 if (eval('$unescapeKey=~/$regexp/')) {  
                     $count++;  
                     if (defined($range) && $count >= $end)   { last; }  
                     if (defined($range) && $count <  $start) { next; }  
                     $qresult.="$key=$value&";  
                 }  
             }  
         }  
         if (&untie_user_hash($hashref)) {  
             chop($qresult);  
             &Reply($client, \$qresult, $userinput);  
         } else {  
             &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".  
                      "while attempting dump\n", $userinput);  
         }  
     } else {  
         &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".  
                 "while attempting dump\n", $userinput);  
     }  
     return 1;  
 }  
 &register_handler("dumpdom", \&dump_dom_with_regexp, 0, 1, 0);  
   
 #  #
 # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database   # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database 
 #  #
Line 4870  sub enrollment_enabled_handler { Line 4718  sub enrollment_enabled_handler {
 &register_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0);  &register_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0);
   
 #  #
 #   Validate an institutional code use for a LON-CAPA course.            #   Validate an institutional code used for a LON-CAPA course.          
 #  #
 # Formal Parameters:  # Formal Parameters:
 #   $cmd          - The command request that got us dispatched.  #   $cmd          - The command request that got us dispatched.
 #   $tail         - The tail of the command.  In this case,  #   $tail         - The tail of the command.  In this case,
 #                   this is a colon separated set of words that will be split  #                   this is a colon separated set of words that will be split
 #                   into:  #                   into:
 #                        $inst_course_id - The institutional cod3 from the  #                        $dom      - The domain for which the check of 
 #                                          institutions point of view.  #                                    institutional course code will occur.
 #                        $cdom           - The domain from the institutions  #
 #                                          point of view.  #                        $instcode - The institutional code for the course
   #                                    being requested, or validated for rights
   #                                    to request.
   #
   #                        $owner    - The course requestor (who will be the
   #                                    course owner, in the form username:domain
   #
 #   $client       - Socket open on the client.  #   $client       - Socket open on the client.
 # Returns:  # Returns:
 #    1           - Indicating processing should continue.  #    1           - Indicating processing should continue.
Line 4888  sub enrollment_enabled_handler { Line 4742  sub enrollment_enabled_handler {
 sub validate_instcode_handler {  sub validate_instcode_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($dom,$instcode,$owner,$inststatus,$instseclist) = split(/:/, $tail);      my ($dom,$instcode,$owner) = split(/:/, $tail);
     $instcode = &unescape($instcode);      $instcode = &unescape($instcode);
     $owner = &unescape($owner);      $owner = &unescape($owner);
     $inststatus = &unescape($inststatus);      my $outcome=&localenroll::validate_instcode($dom,$instcode,$owner);
     $instseclist = &unescape($instseclist);  
     my $outcome=&localenroll::validate_instcode($dom,$instcode,$owner,  
                                                 $inststatus,$instseclist);  
     &Reply($client, \$outcome, $userinput);      &Reply($client, \$outcome, $userinput);
   
     return 1;      return 1;
Line 5104  sub retrieve_auto_file_handler { Line 4955  sub retrieve_auto_file_handler {
 }  }
 &register_handler("autoretrieve", \&retrieve_auto_file_handler, 0,1,0);  &register_handler("autoretrieve", \&retrieve_auto_file_handler, 0,1,0);
   
   sub crsreq_checks_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my $dom = $tail;
       my $result;
       my @reqtypes = ('official','unofficial','community');
       eval {
           local($SIG{__DIE__})='DEFAULT';
           my %validations;
           my $response = &localenroll::crsreq_checks($dom,\@reqtypes,
                                                      \%validations);
           if ($response eq 'ok') { 
               foreach my $key (keys(%validations)) {
                   $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&';
               }
               $result =~ s/\&$//;
           } else {
               $result = 'error';
           }
       };
       if (!$@) {
           &Reply($client, \$result, $userinput);
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
       return 1;
   }
   &register_handler("autocrsreqchecks", \&crsreq_checks_handler, 0, 1, 0);
   
   sub validate_crsreq_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail);
       $instcode = &unescape($instcode);
       $owner = &unescape($owner);
       $crstype = &unescape($crstype);
       $inststatuslist = &unescape($inststatuslist);
       $instcode = &unescape($instcode);
       $instseclist = &unescape($instseclist);
       my $outcome;
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,
                                                    $inststatuslist,$instcode,
                                                    $instseclist);
       };
       if (!$@) {
           &Reply($client, \$outcome, $userinput);
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
       return 1;
   }
   &register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);
   
 #  #
 #   Read and retrieve institutional code format (for support form).  #   Read and retrieve institutional code format (for support form).
 # Formal Parameters:  # Formal Parameters:
Removed from v.1.422  
changed lines
  Added in v.1.425

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>