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

Diff for /loncom/lond between versions 1.207 and 1.210

version 1.207, 2004/07/23 11:03:05 version 1.210, 2004/07/23 15:24:57
Line 955  sub EditFile { Line 955  sub EditFile {
 #    Reference to a hash bound to the db file or alternatively undef  #    Reference to a hash bound to the db file or alternatively undef
 #    if the tie failed.  #    if the tie failed.
 #  #
 sub TieDomainHash {  sub tie_domain_hash {
     my ($domain,       my ($domain,$namespace,$how,$loghead,$logtail) = @_;
  $namespace,  
  $how)     = @_;  
           
     # Filter out any whitespace in the domain name:      # Filter out any whitespace in the domain name:
           
Line 972  sub TieDomainHash { Line 970  sub TieDomainHash {
     my %hash;      my %hash;
     if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {      if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {
  if (scalar @_) { # Need to log the operation.   if (scalar @_) { # Need to log the operation.
     my $logFh = IO::File->new(">>domain_dir/$namespace.hist");      my $logFh = IO::File->new(">>$domain_dir/$namespace.hist");
     if($logFh) {      if($logFh) {
  my $timestamp = time;   my $timestamp = time;
  my ($loghead, $logtail) = @_;  
  print $logFh "$loghead:$timestamp:$logtail\n";   print $logFh "$loghead:$timestamp:$logtail\n";
     }      }
       $logFh->close;
  }   }
  return \%hash; # Return the tied hash.   return \%hash; # Return the tied hash.
     }      } else {
     else {  
  return undef; # Tie failed.   return undef; # Tie failed.
     }      }
 }  }
Line 1005  sub TieDomainHash { Line 1002  sub TieDomainHash {
 #   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 TieUserHash {  sub tie_user_hash {
     my ($domain,      my ($domain,$user,$namespace,$how,$loghead,$what) = @_;
  $user,  
  $namespace,  
  $how)       = @_;  
   
       
     $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);
         
     # If this is a namespace for which a history is kept,  
     # make the history log entry:  
       
       
     if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) {  
  my $args = scalar @_;  
  Debug(" Opening history: $namespace $args");  
  my $hfh = IO::File->new(">>$proname/$namespace.hist");   
  if($hfh) {  
     my $now = time;  
     my $loghead  = shift;  
     my $what    = shift;  
     print $hfh "$loghead:$now:$what\n";  
  }  
     }  
     #  Tie the database.      #  Tie the database.
           
     my %hash;      my %hash;
     if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",      if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",
    $how, 0640)) {     $how, 0640)) {
    # If this is a namespace for which a history is kept,
    # make the history log entry:    
    if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) {
       my $args = scalar @_;
       Debug(" Opening history: $namespace $args");
       my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
       if($hfh) {
    my $now = time;
    print $hfh "$loghead:$now:$what\n";
       }
       $hfh->close;
    }
  return \%hash;   return \%hash;
     }      } else {
     else {  
  return undef;   return undef;
     }      }
           
Line 2487  sub make_new_child { Line 2476  sub make_new_child {
 # ------------------------------------------------------------------------- put  # ------------------------------------------------------------------------- put
  } elsif ($userinput =~ /^put/) {   } elsif ($userinput =~ /^put/) {
     if(isClient) {      if(isClient) {
  my ($cmd,$udom,$uname,$namespace,$what,@extras)   my ($cmd,$udom,$uname,$namespace,$what)
     =split(/:/,$userinput);      =split(/:/,$userinput,5);
  $namespace=~s/\//\_/g;   $namespace=~s/\//\_/g;
  $namespace=~s/\W//g;   $namespace=~s/\W//g;
  if ($namespace ne 'roles') {   if ($namespace ne 'roles') {
                             if (@extras) {  
                                 $what .= ':'.join(':',@extras);  
                             }  
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     unless ($namespace=~/^nohist\_/) {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) { print $hfh "P:$now:$what\n"; }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',      if (tie(%hash,'GDBM_File',
     "$proname/$namespace.db",      "$proname/$namespace.db",
     &GDBM_WRCREAT(),0640)) {      &GDBM_WRCREAT(),0640)) {
    unless ($namespace=~/^nohist\_/) {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; }
    }
   
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hash{$key}=$value;      $hash{$key}=$value;
Line 2543  sub make_new_child { Line 2528  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     unless ($namespace=~/^nohist\_/) {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) { print $hfh "P:$now:$what\n"; }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',      if (tie(%hash,'GDBM_File',
     "$proname/$namespace.db",      "$proname/$namespace.db",
     &GDBM_WRCREAT(),0640)) {      &GDBM_WRCREAT(),0640)) {
    unless ($namespace=~/^nohist\_/) {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; }
    }
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
                                     # We could check that we have a number...                                      # We could check that we have a number...
Line 2595  sub make_new_child { Line 2578  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) {   
     print $hfh "P:$now:$exedom:$exeuser:$what\n";  
  }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
    {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
    print $hfh "P:$now:$exedom:$exeuser:$what\n";
       }
    }
   
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     &ManagePermissions($key, $udom, $uname,      &ManagePermissions($key, $udom, $uname,
Line 2646  sub make_new_child { Line 2628  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) {   
     print $hfh "D:$now:$exedom:$exeuser:$what\n";  
  }  
     }  
     my @rolekeys=split(/\&/,$what);      my @rolekeys=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
    {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
    print $hfh "D:$now:$exedom:$exeuser:$what\n";
       }
    }
  foreach my $key (@rolekeys) {   foreach my $key (@rolekeys) {
     delete $hash{$key};      delete $hash{$key};
  }   }
Line 2773  sub make_new_child { Line 2753  sub make_new_child {
  chomp($what);   chomp($what);
  my $proname=propath($udom,$uname);   my $proname=propath($udom,$uname);
  my $now=time;   my $now=time;
  unless ($namespace=~/^nohist\_/) {  
     my $hfh;  
     if (  
  $hfh=IO::File->new(">>$proname/$namespace.hist")  
  ) { print $hfh "D:$now:$what\n"; }  
  }  
  my @keys=split(/\&/,$what);   my @keys=split(/\&/,$what);
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {   if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
       unless ($namespace=~/^nohist\_/) {
    my $hfh;
    if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "D:$now:$what\n"; }
       }
     foreach my $key (@keys) {      foreach my $key (@keys) {
  delete($hash{$key});   delete($hash{$key});
     }      }
Line 2936  sub make_new_child { Line 2914  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     unless ($namespace=~/^nohist\_/) {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) { print $hfh "P:$now:$rid:$what\n"; }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
    unless ($namespace=~/^nohist\_/) {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {
    print $hfh "P:$now:$rid:$what\n";
       }
    }
  my @previouskeys=split(/&/,$hash{"keys:$rid"});   my @previouskeys=split(/&/,$hash{"keys:$rid"});
  my $key;   my $key;
  $hash{"version:$rid"}++;   $hash{"version:$rid"}++;
Line 3170  sub make_new_child { Line 3148  sub make_new_child {
  $udom=~s/\W//g;   $udom=~s/\W//g;
  my $proname="$perlvar{'lonUsersDir'}/$udom/ids";   my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
  my $now=time;   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 %hash;
  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
       {
    my $hfh;
    if ($hfh=IO::File->new(">>$proname.hist")) {
       print $hfh "P:$now:$what\n";
    }
       }
     foreach my $pair (@pairs) {      foreach my $pair (@pairs) {
  my ($key,$value)=split(/=/,$pair);   my ($key,$value)=split(/=/,$pair);
  $hash{$key}=$value;   $hash{$key}=$value;
Removed from v.1.207  
changed lines
  Added in v.1.210

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