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

Diff for /loncom/lond between versions 1.420 and 1.427

version 1.420, 2009/08/10 23:32:26 version 1.427, 2009/09/28 19:13:32
Line 3693  sub put_course_id_hash_handler { Line 3693  sub put_course_id_hash_handler {
 #                 caller -  if set to 'coursecatalog', courses set to be hidden  #                 caller -  if set to 'coursecatalog', courses set to be hidden
 #                           from course catalog will be excluded from results (unless  #                           from course catalog will be excluded from results (unless
 #                           overridden by "showhidden".  #                           overridden by "showhidden".
 #                 cloner - escaped username:domain of course cloner (if picking course to#   #                 cloner - escaped username:domain of course cloner (if picking course to
 #                          clone).  #                          clone).
 #                 cc_clone_list - escaped comma separated list of courses for which   #                 cc_clone_list - escaped comma separated list of courses for which 
 #                                 course cloner has active CC role (and so can clone  #                                 course cloner has active CC role (and so can clone
 #                                 automatically).  #                                 automatically).
 #                 cloneonly - filter by courses for which cloner has rights to clone.   #                 cloneonly - filter by courses for which cloner has rights to clone.
   #                 createdbefore - include courses for which creation date preceeded this date.
   #                 createdafter - include courses for which creation date followed this date.
   #                 creationcontext - include courses created in specified context 
 #  #
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
Line 3711  sub dump_course_id_handler { Line 3714  sub dump_course_id_handler {
   
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,          $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly) =split(/:/,$tail);          $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
           $creationcontext) =split(/:/,$tail);
     my $now = time;      my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);      my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {      if (defined($description)) {
Line 3769  sub dump_course_id_handler { Line 3773  sub dump_course_id_handler {
             $cc_clone{$clonedom.'_'.$clonenum} = 1;              $cc_clone{$clonedom.'_'.$clonenum} = 1;
         }           } 
     }      }
       if (defined($createdbefore)) {
           $createdbefore = &unescape($createdbefore);
       } else {
          $createdbefore = 0;
       }
       if (defined($createdafter)) {
           $createdafter = &unescape($createdafter);
       } else {
           $createdafter = 0;
       }
       if (defined($creationcontext)) {
           $creationcontext = &unescape($creationcontext);
       } else {
           $creationcontext = '.';
       }
           
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
Line 3781  sub dump_course_id_handler { Line 3800  sub dump_course_id_handler {
     if ($hashref) {      if ($hashref) {
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
             my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,              my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
                 %unesc_val,$selfenroll_end,$selfenroll_types);                  %unesc_val,$selfenroll_end,$selfenroll_types,$created,
                   $context);
             $unesc_key = &unescape($key);              $unesc_key = &unescape($key);
             if ($unesc_key =~ /^lasttime:/) {              if ($unesc_key =~ /^lasttime:/) {
                 next;                  next;
Line 3832  sub dump_course_id_handler { Line 3852  sub dump_course_id_handler {
                     $unesc_val{'owner'} = $items->{'owner'};                      $unesc_val{'owner'} = $items->{'owner'};
                     $unesc_val{'type'} = $items->{'type'};                      $unesc_val{'type'} = $items->{'type'};
                     $unesc_val{'cloners'} = $items->{'cloners'};                      $unesc_val{'cloners'} = $items->{'cloners'};
                       $unesc_val{'created'} = $items->{'created'};
                       $unesc_val{'context'} = $items->{'context'};
                 }                  }
                 $selfenroll_types = $items->{'selfenroll_types'};                  $selfenroll_types = $items->{'selfenroll_types'};
                 $selfenroll_end = $items->{'selfenroll_end_date'};                  $selfenroll_end = $items->{'selfenroll_end_date'};
                   $created = $items->{'created'};
                   $context = $items->{'context'};
                 if ($selfenrollonly) {                  if ($selfenrollonly) {
                     next if (!$selfenroll_types);                      next if (!$selfenroll_types);
                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {                      if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
                         next;                          next;
                     }                      }
                 }                  }
                   if ($creationcontext ne '.') {
                       next if (($context ne '') && ($context ne $creationcontext));  
                   }
                   if ($createdbefore > 0) {
                       next if (($created eq '') || ($created > $createdbefore));   
                   }
                   if ($createdafter > 0) {
                       next if (($created eq '') || ($created <= $createdafter)); 
                   }
                 if ($catfilter ne '') {                  if ($catfilter ne '') {
                     next if ($items->{'categories'} eq '');                      next if ($items->{'categories'} eq '');
                     my @categories = split('&',$items->{'categories'});                       my @categories = split('&',$items->{'categories'}); 
Line 3863  sub dump_course_id_handler { Line 3896  sub dump_course_id_handler {
             } else {              } else {
                 next if ($catfilter ne '');                  next if ($catfilter ne '');
                 next if ($selfenrollonly);                  next if ($selfenrollonly);
                   next if ($createdbefore || $createdafter);
                   next if ($creationcontext ne '.');
                 if ((defined($clonerudom)) && (defined($cloneruname)))  {                  if ((defined($clonerudom)) && (defined($cloneruname)))  {
                     if ($cc_clone{$unesc_key}) {                      if ($cc_clone{$unesc_key}) {
                         $canclone = 1;                          $canclone = 1;
Line 4052  sub put_domain_handler { Line 4087  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 4137  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 4233  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 4559  sub dump_domainroles_handler { Line 4442  sub dump_domainroles_handler {
         $rolesfilter=&unescape($rolesfilter);          $rolesfilter=&unescape($rolesfilter);
  @roles = split(/\&/,$rolesfilter);   @roles = split(/\&/,$rolesfilter);
     }      }
                                                                                              
     my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());
     if ($hashref) {      if ($hashref) {
         my $qresult = '';          my $qresult = '';
         while (my ($key,$value) = each(%$hashref)) {          while (my ($key,$value) = each(%$hashref)) {
             my $match = 1;              my $match = 1;
             my ($start,$end) = split(/:/,&unescape($value));              my ($end,$start) = split(/:/,&unescape($value));
             my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));              my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));
             unless ($startfilter eq '.' || !defined($startfilter)) {              unless (@roles < 1) {
                 if ((defined($start)) && ($start >= $startfilter)) {                  unless (grep/^\Q$trole\E$/,@roles) {
                     $match = 0;                      $match = 0;
                       next;
                 }                  }
             }              }
             unless ($endfilter eq '.' || !defined($endfilter)) {              unless ($startfilter eq '.' || !defined($startfilter)) {
                 if ((defined($end)) && ($end <= $endfilter)) {                  if ((defined($start)) && ($start >= $startfilter)) {
                     $match = 0;                      $match = 0;
                       next;
                 }                  }
             }              }
             unless (@roles < 1) {              unless ($endfilter eq '.' || !defined($endfilter)) {
                 unless (grep/^\Q$trole\E$/,@roles) {                  if ((defined($end)) && (($end > 0) && ($end <= $endfilter))) {
                     $match = 0;                      $match = 0;
                       next;
                 }                  }
             }              }
             if ($match == 1) {              if ($match == 1) {
Line 4867  sub enrollment_enabled_handler { Line 4753  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 4886  sub validate_instcode_handler { Line 4778  sub validate_instcode_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($dom,$instcode,$owner) = split(/:/, $tail);      my ($dom,$instcode,$owner) = split(/:/, $tail);
     my $outcome=&localenroll::validate_instcode($dom,$instcode,$owner);      $instcode = &unescape($instcode);
     &Reply($client, \$outcome, $userinput);      $owner = &unescape($owner);
       my ($outcome,$description) = 
           &localenroll::validate_instcode($dom,$instcode,$owner);
       my $result = &escape($outcome).'&'.&escape($description);
       &Reply($client, \$result, $userinput);
   
     return 1;      return 1;
 }  }
Line 5096  sub retrieve_auto_file_handler { Line 4992  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.420  
changed lines
  Added in v.1.427

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