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; |