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

Diff for /loncom/lond between versions 1.310 and 1.312

version 1.310, 2006/01/31 04:40:12 version 1.312, 2006/01/31 15:56:46
Line 971  sub tie_domain_hash { Line 971  sub tie_domain_hash {
           
     my $user_top_dir   = $perlvar{'lonUsersDir'};      my $user_top_dir   = $perlvar{'lonUsersDir'};
     my $domain_dir     = $user_top_dir."/$domain";      my $domain_dir     = $user_top_dir."/$domain";
     my $resource_file  = $domain_dir."/$namespace.db";      my $resource_file  = $domain_dir."/$namespace";
     my %hash;      return &_do_hash_tie($resource_file,$namespace,$how,$loghead,$logtail);
     if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {  
  if (defined($loghead)) { # Need to log the operation.  
     my $logFh = IO::File->new(">>$domain_dir/$namespace.hist");  
     if($logFh) {  
  my $timestamp = time;  
  print $logFh "$loghead:$timestamp:$logtail\n";  
     }  
     $logFh->close;  
  }  
  return \%hash; # Return the tied hash.  
     } else {  
  return undef; # Tie failed.  
     }  
 }  }
   
   sub untie_domain_hash {
       return &_do_hash_untie(@_);
   }
 #  #
 #   Ties a user's resource file to a hash.    #   Ties a user's resource file to a hash.  
 #   If necessary, an appropriate history  #   If necessary, an appropriate history
Line 1013  sub tie_user_hash { Line 1003  sub tie_user_hash {
     $namespace=~s/\//\_/g; # / -> _      $namespace=~s/\//\_/g; # / -> _
     $namespace=~s/\W//g; # whitespace eliminated.      $namespace=~s/\W//g; # whitespace eliminated.
     my $proname     = propath($domain, $user);      my $proname     = propath($domain, $user);
      
     #  Tie the database.      my $file_prefix="$proname/$namespace";
           return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
   }
   
   sub untie_user_hash {
       return &_do_hash_untie(@_);
   }
   
   # internal routines that handle the actual tieing and untieing process
   
   sub _do_hash_tie {
       my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
     my %hash;      my %hash;
     if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",      if(tie(%hash, 'GDBM_File', "$file_prefix.db", $how, 0640)) {
    $how, 0640)) {  
  # If this is a namespace for which a history is kept,   # If this is a namespace for which a history is kept,
  # make the history log entry:       # make the history log entry:    
  if (($namespace !~/^nohist\_/) && (defined($loghead))) {   if (($namespace !~/^nohist\_/) && (defined($loghead))) {
     my $args = scalar @_;      my $args = scalar @_;
     Debug(" Opening history: $namespace $args");      Debug(" Opening history: $file_prefix $args");
     my $hfh = IO::File->new(">>$proname/$namespace.hist");       my $hfh = IO::File->new(">>$file_prefix.hist"); 
     if($hfh) {      if($hfh) {
  my $now = time;   my $now = time;
  print $hfh "$loghead:$now:$what\n";   print $hfh "$loghead:$now:$what\n";
Line 1035  sub tie_user_hash { Line 1034  sub tie_user_hash {
     } else {      } else {
  return undef;   return undef;
     }      }
       
 }  }
   
   sub _do_hash_untie {
       my ($hashref) = @_;
       my $result = untie(%$hashref);
       return $result;
   }
 #   read_profile  #   read_profile
 #  #
 #   Returns a set of specific entries from a user's profile file.  #   Returns a set of specific entries from a user's profile file.
Line 1068  sub read_profile { Line 1071  sub read_profile {
     $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.      $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
  }   }
  $qresult=~s/\&$//;              # Remove trailing & from last lookup.   $qresult=~s/\&$//;              # Remove trailing & from last lookup.
  if (untie %$hashref) {   if (&untie_user_hash($hashref)) {
     return $qresult;      return $qresult;
  } else {   } else {
     return "error: ".($!+0)." untie (GDBM) Failed";      return "error: ".($!+0)." untie (GDBM) Failed";
Line 2377  sub put_user_profile_entry { Line 2380  sub put_user_profile_entry {
  my ($key,$value)=split(/=/,$pair);   my ($key,$value)=split(/=/,$pair);
  $hashref->{$key}=$value;   $hashref->{$key}=$value;
     }      }
     if (untie(%$hashref)) {      if (&untie_user_hash($hashref)) {
  &Reply( $client, "ok\n", $userinput);   &Reply( $client, "ok\n", $userinput);
     } else {      } else {
  &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".   &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
Line 2440  sub newput_user_profile_entry { Line 2443  sub newput_user_profile_entry {
  $hashref->{$key}=$value;   $hashref->{$key}=$value;
     }      }
   
     if (untie(%$hashref)) {      if (&untie_user_hash($hashref)) {
  &Reply( $client, "ok\n", $userinput);   &Reply( $client, "ok\n", $userinput);
     } else {      } else {
  &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".   &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
Line 2493  sub increment_user_value_handler { Line 2496  sub increment_user_value_handler {
                     }                      }
                 }                  }
     }      }
     if (untie(%$hashref)) {      if (&untie_user_hash($hashref)) {
  &Reply( $client, "ok\n", $userinput);   &Reply( $client, "ok\n", $userinput);
     } else {      } else {
  &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".   &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
Line 2560  sub roles_put_handler { Line 2563  sub roles_put_handler {
        $auth_type);         $auth_type);
     $hashref->{$key}=$value;      $hashref->{$key}=$value;
  }   }
  if (untie($hashref)) {   if (&untie_user_hash($hashref)) {
     &Reply($client, "ok\n", $userinput);      &Reply($client, "ok\n", $userinput);
  } else {   } else {
     &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2611  sub roles_delete_handler { Line 2614  sub roles_delete_handler {
  foreach my $key (@rolekeys) {   foreach my $key (@rolekeys) {
     delete $hashref->{$key};      delete $hashref->{$key};
  }   }
  if (untie(%$hashref)) {   if (&untie_user_hash(%$hashref)) {
     &Reply($client, "ok\n", $userinput);      &Reply($client, "ok\n", $userinput);
  } else {   } else {
     &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2752  sub delete_profile_entry { Line 2755  sub delete_profile_entry {
  foreach my $key (@keys) {   foreach my $key (@keys) {
     delete($hashref->{$key});      delete($hashref->{$key});
  }   }
  if (untie(%$hashref)) {   if (&untie_user_hash(%$hashref)) {
     &Reply($client, "ok\n", $userinput);      &Reply($client, "ok\n", $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 2794  sub get_profile_keys { Line 2797  sub get_profile_keys {
  foreach my $key (keys %$hashref) {   foreach my $key (keys %$hashref) {
     $qresult.="$key&";      $qresult.="$key&";
  }   }
  if (untie(%$hashref)) {   if (&untie_user_hash(%$hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 2855  sub dump_profile_database { Line 2858  sub dump_profile_database {
     $data{$symb}->{$param}=$value;      $data{$symb}->{$param}=$value;
     $data{$symb}->{'v.'.$param}=$v;      $data{$symb}->{'v.'.$param}=$v;
  }   }
  if (untie(%$hashref)) {   if (&untie_user_hash($hashref)) {
     while (my ($symb,$param_hash) = each(%data)) {      while (my ($symb,$param_hash) = each(%data)) {
  while(my ($param,$value) = each (%$param_hash)){   while(my ($param,$value) = each (%$param_hash)){
     next if ($param =~ /^v\./);       # Ignore versions...      next if ($param =~ /^v\./);       # Ignore versions...
Line 2947  sub dump_with_regexp { Line 2950  sub dump_with_regexp {
  }   }
     }      }
  }   }
  if (untie(%$hashref)) {   if (&untie_user_hash($hashref)) {
     chop($qresult);      chop($qresult);
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 3009  sub store_handler { Line 3012  sub store_handler {
     $hashref->{"$version:$rid:timestamp"}=$now;      $hashref->{"$version:$rid:timestamp"}=$now;
     $allkeys.='timestamp';      $allkeys.='timestamp';
     $hashref->{"$version:keys:$rid"}=$allkeys;      $hashref->{"$version:keys:$rid"}=$allkeys;
     if (untie($hashref)) {      if (&untie_user_hash($hashref)) {
  &Reply($client, "ok\n", $userinput);   &Reply($client, "ok\n", $userinput);
     } else {      } else {
  &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".   &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3076  sub restore_handler { Line 3079  sub restore_handler {
  $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";   $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
     }                                        }                                  
  }   }
  if (untie(%$hashref)) {   if (&untie_user_hash($hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply( $client, "$qresult\n", $userinput);      &Reply( $client, "$qresult\n", $userinput);
  } else {   } else {
Line 3309  sub put_course_id_handler { Line 3312  sub put_course_id_handler {
             }              }
     $hashref->{$key}=$courseinfo.':'.$now;      $hashref->{$key}=$courseinfo.':'.$now;
  }   }
  if (untie(%$hashref)) {   if (&untie_domain_hash($hashref)) {
     &Reply( $client, "ok\n", $userinput);      &Reply( $client, "ok\n", $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)      &Failure($client, "error: ".($!+0)
Line 3425  sub dump_course_id_handler { Line 3428  sub dump_course_id_handler {
                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';                  $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
             }              }
  }   }
  if (untie(%$hashref)) {   if (&untie_domain_hash($hashref)) {
     chop($qresult);      chop($qresult);
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 3474  sub put_id_handler { Line 3477  sub put_id_handler {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hashref->{$key}=$value;      $hashref->{$key}=$value;
  }   }
  if (untie(%$hashref)) {   if (&untie_domain_hash($hashref)) {
     &Reply($client, "ok\n", $userinput);      &Reply($client, "ok\n", $userinput);
  } else {   } else {
     &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".      &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3523  sub get_id_handler { Line 3526  sub get_id_handler {
  for (my $i=0;$i<=$#queries;$i++) {   for (my $i=0;$i<=$#queries;$i++) {
     $qresult.="$hashref->{$queries[$i]}&";      $qresult.="$hashref->{$queries[$i]}&";
  }   }
  if (untie(%$hashref)) {   if (&untie_domain_hash($hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply($client, "$qresult\n", $userinput);      &Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 3567  sub put_dcmail_handler { Line 3570  sub put_dcmail_handler {
         my ($key,$value)=split(/=/,$what);          my ($key,$value)=split(/=/,$what);
         $hashref->{$key}=$value;          $hashref->{$key}=$value;
     }      }
     if (untie(%$hashref)) {      if (&untie_domain_hash($hashref)) {
         &Reply($client, "ok\n", $userinput);          &Reply($client, "ok\n", $userinput);
     } else {      } else {
         &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".          &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3647  sub dump_dcmail_handler { Line 3650  sub dump_dcmail_handler {
                 $qresult.=$key.'='.$value.'&';                  $qresult.=$key.'='.$value.'&';
             }              }
         }          }
         if (untie(%$hashref)) {          if (&untie_domain_hash($hashref)) {
             chop($qresult);              chop($qresult);
             &Reply($client, "$qresult\n", $userinput);              &Reply($client, "$qresult\n", $userinput);
         } else {          } else {
Line 3694  sub put_domainroles_handler { Line 3697  sub put_domainroles_handler {
             my ($key,$value)=split(/=/,$pair);              my ($key,$value)=split(/=/,$pair);
             $hashref->{$key}=$value;              $hashref->{$key}=$value;
         }          }
         if (untie(%$hashref)) {          if (&untie_domain_hash($hashref)) {
             &Reply($client, "ok\n", $userinput);              &Reply($client, "ok\n", $userinput);
         } else {          } else {
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".              &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 3775  sub dump_domainroles_handler { Line 3778  sub dump_domainroles_handler {
                 $qresult.=$key.'='.$value.'&';                  $qresult.=$key.'='.$value.'&';
             }              }
         }          }
         if (untie(%$hashref)) {          if (&untie_domain_hash($hashref)) {
             chop($qresult);              chop($qresult);
             &Reply($client, "$qresult\n", $userinput);              &Reply($client, "$qresult\n", $userinput);
         } else {          } else {
Line 5629  sub get_chat { Line 5632  sub get_chat {
  &GDBM_READER());   &GDBM_READER());
     if ($hashref) {      if ($hashref) {
  @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));   @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
  untie(%$hashref);   &untie_user_hash($hashref);
     }      }
     my @participants=();      my @participants=();
     my $cutoff=time-60;      my $cutoff=time-60;
Line 5642  sub get_chat { Line 5645  sub get_chat {
  push(@participants, 'active_participant:'.$user);   push(@participants, 'active_participant:'.$user);
             }              }
         }          }
         untie(%$hashref);          &untie_user_hash($hashref);
     }      }
     return (@participants,@entries);      return (@participants,@entries);
 }  }
Line 5679  sub chat_add { Line 5682  sub chat_add {
     }      }
     close(CHATLOG);      close(CHATLOG);
  }   }
  untie(%$hashref);   &untie_user_hash($hashref);
     }      }
 }  }
   
Removed from v.1.310  
changed lines
  Added in v.1.312

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