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

Diff for /loncom/lond between versions 1.178.2.8 and 1.178.2.9

version 1.178.2.8, 2004/03/16 10:52:30 version 1.178.2.9, 2004/03/22 09:05:11
Line 162  sub isClient { Line 162  sub isClient {
     return (($ConnectionType eq "client") || ($ConnectionType eq "both"));      return (($ConnectionType eq "client") || ($ConnectionType eq "both"));
 }  }
 #  #
 #   Ties a resource file to a hash.  If necessary, an appropriate history  #  Ties a domain level resource file to a hash.
   #  If requested a history entry is created in the associated hist file.
   #
   #  Parameters:
   #     domain    - Name of the domain in which the resource file lives.
   #     namespace - Name of the hash within that domain.
   #     how       - How to tie the hash (e.g. GDBM_WRCREAT()).
   #     loghead   - Optional parameter, if present a log entry is created
   #                 in the associated history file and this is the first part
   #                  of that entry.
   #     logtail   - Goes along with loghead,  The actual logentry is of the
   #                 form $loghead:<timestamp>:logtail.
   # Returns:
   #    Reference to a hash bound to the db file or alternatively undef
   #    if the tie failed.
   #
   sub TieDomainHash {
       my $domain    = shift;
       my $namespace = shift;
       my $how       = shift;
   
       # Filter out any whitespace in the domain name:
   
       $domain =~ s/\W//g;
   
       # We have enough to go on to tie the hash:
   
       my $UserTopDir   = $perlvar('lonUsersDir');
       my $DomainDir    = $UserTopDir."/$domain";
       my $ResourceFile = $DomainDir."/$namespace.db";
       my %hash;
       if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {
    if (scalar @_) { # Need to log the operation.
       my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");
       if($logFH) {
    my $TimeStamp = time;
    my ($loghead, $logtail) = @_;
    print $logFH "$loghead:$TimeStamp:$logtail\n";
       }
    }
    return \%hash; # Return the tied hash.
       }
       else {
    return undef; # Tie failed.
       }
   }
   
   #
   #   Ties a user's resource file to a hash.  
   #   If necessary, an appropriate history
 #   log file entry is made as well.  #   log file entry is made as well.
 #   This sub factors out common code from the subs that manipulate  #   This sub factors out common code from the subs that manipulate
 #   the various gdbm files that keep keyword value pairs.  #   the various gdbm files that keep keyword value pairs.
Line 179  sub isClient { Line 228  sub isClient {
 #   hash to which the database is tied.  It's up to the caller to untie.  #   hash to which the database is tied.  It's up to the caller to untie.
 #   undef if the has could not be tied.  #   undef if the has could not be tied.
 #  #
 sub TieResourceHash {  sub TieUserHash {
   my $domain      = shift;    my $domain      = shift;
   my $user        = shift;    my $user        = shift;
   my $namespace   = shift;    my $namespace   = shift;
Line 1364  sub PutUserProfileEntry { Line 1413  sub PutUserProfileEntry {
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);      my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
        chomp($what);         chomp($what);
        my $hashref = TieResourceHash($udom, $uname, $namespace,         my $hashref = TieUserHash($udom, $uname, $namespace,
      &GDBM_WRCREAT(),"P",$what);       &GDBM_WRCREAT(),"P",$what);
        if($hashref) {         if($hashref) {
  my @pairs=split(/\&/,$what);   my @pairs=split(/\&/,$what);
Line 1415  sub IncrementUserValueHandler { Line 1464  sub IncrementUserValueHandler {
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);      my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
         chomp($what);          chomp($what);
  my $hashref = TieResourceHash($udom, $uname,   my $hashref = TieUserHash($udom, $uname,
       $namespace, &GDBM_WRCREAT(),        $namespace, &GDBM_WRCREAT(),
       "P",$what);        "P",$what);
  if ($hashref) {   if ($hashref) {
Line 1476  sub RolesPutHandler { Line 1525  sub RolesPutHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_WRCREAT(), "P",    &GDBM_WRCREAT(), "P",
   "$exedom:$exeuser:$what");    "$exedom:$exeuser:$what");
     #      #
Line 1533  sub RolesDeleteHandler { Line 1582  sub RolesDeleteHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_WRCREAT(), "D",    &GDBM_WRCREAT(), "D",
   "$exedom:$exeuser:$what");    "$exedom:$exeuser:$what");
   
Line 1585  sub GetProfileEntry { Line 1634  sub GetProfileEntry {
         
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
  &GDBM_READER());   &GDBM_READER());
     if ($hashref) {      if ($hashref) {
         my @queries=split(/\&/,$what);          my @queries=split(/\&/,$what);
Line 1640  sub GetProfileEntryEncrypted { Line 1689  sub GetProfileEntryEncrypted {
         
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);      my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_READER());    &GDBM_READER());
     if ($hashref) {      if ($hashref) {
         my @queries=split(/\&/,$what);          my @queries=split(/\&/,$what);
Line 1703  sub DeleteProfileEntry { Line 1752  sub DeleteProfileEntry {
   
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_WRCREAT(),    &GDBM_WRCREAT(),
   "D",$what);    "D",$what);
     if ($hashref) {      if ($hashref) {
Line 1747  sub GetProfileKeys { Line 1796  sub GetProfileKeys {
   
     my ($udom,$uname,$namespace)=split(/:/,$tail);      my ($udom,$uname,$namespace)=split(/:/,$tail);
     my $qresult='';      my $qresult='';
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_READER());    &GDBM_READER());
     if ($hashref) {      if ($hashref) {
  foreach my $key (keys %$hashref) {   foreach my $key (keys %$hashref) {
Line 1794  sub DumpProfileDatabase { Line 1843  sub DumpProfileDatabase {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my ($udom,$uname,$namespace) = split(/:/,$tail);      my ($udom,$uname,$namespace) = split(/:/,$tail);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_READER());    &GDBM_READER());
     if ($hashref) {      if ($hashref) {
  # Structure of %data:   # Structure of %data:
Line 1875  sub DumpWithRegexp { Line 1924  sub DumpWithRegexp {
     } else {      } else {
  $regexp='.';   $regexp='.';
     }      }
     my $hashref =TieResourceHash($udom, $uname, $namespace,      my $hashref =TieUserHash($udom, $uname, $namespace,
  &GDBM_READER());   &GDBM_READER());
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
Line 1935  sub StoreHandler { Line 1984  sub StoreHandler {
   
  chomp($what);   chomp($what);
  my @pairs=split(/\&/,$what);   my @pairs=split(/\&/,$what);
  my $hashref  = TieResourceHash($udom, $uname, $namespace,   my $hashref  = TieUserHash($udom, $uname, $namespace,
        &GDBM_WRCREAT(), "P",         &GDBM_WRCREAT(), "P",
        "$rid:$what");         "$rid:$what");
  if ($hashref) {   if ($hashref) {
Line 2214  sub PutCourseIdHandler { Line 2263  sub PutCourseIdHandler {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$what)=split(/:/,$tail);  
     chomp($what);      chomp($what);
     $udom=~s/\W//g;  
     my $proname=  
  "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";  
     my $now=time;      my $now=time;
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {      my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
       if ($hashref) {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hash{$key}=$value.':'.$now;      $hashref->{$key}=$value.':'.$now;
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     Reply($client, "ok\n", $userinput);      Reply($client, "ok\n", $userinput);
  } else {   } else {
     Failure( $client, "error: ".($!+0)      Failure( $client, "error: ".($!+0)
Line 2282  sub DumpCourseIdHandler { Line 2328  sub DumpCourseIdHandler {
     }      }
     unless (defined($since)) { $since=0; }      unless (defined($since)) { $since=0; }
     my $qresult='';      my $qresult='';
     my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";  
     my %hash;      my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {      if ($hashref) {
  while (my ($key,$value) = each(%hash)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($descr,$lasttime)=split(/\:/,$value);      my ($descr,$lasttime)=split(/\:/,$value);
     if ($lasttime<$since) {       if ($lasttime<$since) { 
  next;    next; 
Line 2299  sub DumpCourseIdHandler { Line 2345  sub DumpCourseIdHandler {
  }   }
     }      }
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     chop($qresult);      chop($qresult);
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 2340  sub PutIdHandler { Line 2386  sub PutIdHandler {
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     $udom=~s/\W//g;  
     my $proname="$perlvar{'lonUsersDir'}/$udom/ids";  
     my $now=time;  
     {  
  my $hfh;  
  if ($hfh=IO::File->new(">>$proname.hist")) {   
     print $hfh "P:$now:$what\n";   
  }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(),
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {   "P", $what);
       if ($hashref) {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hash{$key}=$value;      $hashref->{$key}=$value;
  }   }
  if (untie(%hash)) {   if (untie(%$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 2399  sub GetIdHandler { Line 2437  sub GetIdHandler {
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     $udom=~s/\W//g;  
     my $proname="$perlvar{'lonUsersDir'}/$udom/ids";  
     my @queries=split(/\&/,$what);      my @queries=split(/\&/,$what);
     my $qresult='';      my $qresult='';
     my %hash;      my $hashref = TieDomainHash($udom, "ids", &GDBM_READER());
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {      if ($hashref) {
  for (my $i=0;$i<=$#queries;$i++) {   for (my $i=0;$i<=$#queries;$i++) {
     $qresult.="$hash{$queries[$i]}&";      $qresult.="$hashref->{$queries[$i]}&";
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Removed from v.1.178.2.8  
changed lines
  Added in v.1.178.2.9

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