Diff for /loncom/lond between versions 1.208 and 1.209

version 1.208, 2004/07/23 13:36:29 version 1.209, 2004/07/23 14:10:47
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,   $namespace,
  $how)     = @_;   $how)     = @_;
Line 1016  sub TieUserHash { Line 1016  sub TieUserHash {
     $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;
    my $loghead  = shift;
    my $what    = shift;
    print $hfh "$loghead:$now:$what\n";
       }
    }
  return \%hash;   return \%hash;
     }      } else {
     else {  
  return undef;   return undef;
     }      }
           
Line 2495  sub make_new_child { Line 2492  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);
     $hash{$key}=$value;      $hash{$key}=$value;
Line 2540  sub make_new_child { Line 2536  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 2592  sub make_new_child { Line 2586  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 2643  sub make_new_child { Line 2636  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 2770  sub make_new_child { Line 2761  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 2933  sub make_new_child { Line 2922  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 3167  sub make_new_child { Line 3156  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.208  
changed lines
  Added in v.1.209


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