version 1.116, 2003/03/22 17:13:40
|
version 1.118, 2003/03/25 22:03:23
|
Line 1157 sub make_new_child {
|
Line 1157 sub make_new_child {
|
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
|
# -------------------------------------------------------------------- rolesdel |
|
} elsif ($userinput =~ /^rolesdel/) { |
|
&Debug("rolesdel"); |
|
if ($wasenc==1) { |
|
my ($cmd,$exedom,$exeuser,$udom,$uname,$what) |
|
=split(/:/,$userinput); |
|
&Debug("cmd = ".$cmd." exedom= ".$exedom. |
|
"user = ".$exeuser." udom=".$udom. |
|
"what = ".$what); |
|
my $namespace='roles'; |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
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); |
|
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
|
foreach $key (@rolekeys) { |
|
delete $hash{$key}; |
|
|
|
} |
|
if (untie(%hash)) { |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." untie(GDBM) Failed ". |
|
"while attempting rolesdel\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!+0) |
|
." tie(GDBM) Failed ". |
|
"while attempting rolesdel\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
# ------------------------------------------------------------------------- get |
# ------------------------------------------------------------------------- get |
} elsif ($userinput =~ /^get/) { |
} elsif ($userinput =~ /^get/) { |
my ($cmd,$udom,$uname,$namespace,$what) |
my ($cmd,$udom,$uname,$namespace,$what) |
Line 1492 sub make_new_child {
|
Line 1534 sub make_new_child {
|
." IO::File->new Failed ". |
." IO::File->new Failed ". |
"while attempting queryreply\n"; |
"while attempting queryreply\n"; |
} |
} |
|
# ----------------------------------------------------------------- courseidput |
|
} elsif ($userinput =~ /^courseidput/) { |
|
my ($cmd,$udom,$what)=split(/:/,$userinput); |
|
chomp($what); |
|
$udom=~s/\W//g; |
|
my $proname= |
|
"$perlvar{'lonUsersDir'}/$udom/nohist_courseids"; |
|
my $now=time; |
|
my @pairs=split(/\&/,$what); |
|
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { |
|
foreach $pair (@pairs) { |
|
($key,$value)=split(/=/,$pair); |
|
$hash{$key}=$value.':'.$now; |
|
} |
|
if (untie(%hash)) { |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." untie(GDBM) Failed ". |
|
"while attempting courseidput\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!+0) |
|
." tie(GDBM) Failed ". |
|
"while attempting courseidput\n"; |
|
} |
|
# ---------------------------------------------------------------- courseiddump |
|
} elsif ($userinput =~ /^courseiddump/) { |
|
my ($cmd,$udom,$since,$description) |
|
=split(/:/,$userinput); |
|
if (defined($description)) { |
|
$description=&unescape($description); |
|
} else { |
|
$description='.'; |
|
} |
|
unless (defined($since)) { $since=0; } |
|
my $qresult=''; |
|
my $proname= |
|
"$perlvar{'lonUsersDir'}/$udom/nohist_courseids"; |
|
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
|
while (($key,$value) = each(%hash)) { |
|
my ($descr,$lasttime)=split(/\:/,$value); |
|
if ($lasttime<$since) { next; } |
|
if ($regexp eq '.') { |
|
$qresult.=$key.'='.$descr.'&'; |
|
} else { |
|
my $unescapeVal = &unescape($descr); |
|
if (eval('$unescapeVal=~/$description/')) { |
|
$qresult.="$key=$descr&"; |
|
} |
|
} |
|
} |
|
if (untie(%hash)) { |
|
chop($qresult); |
|
print $client "$qresult\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." untie(GDBM) Failed ". |
|
"while attempting courseiddump\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!+0) |
|
." tie(GDBM) Failed ". |
|
"while attempting courseiddump\n"; |
|
} |
# ----------------------------------------------------------------------- idput |
# ----------------------------------------------------------------------- idput |
} elsif ($userinput =~ /^idput/) { |
} elsif ($userinput =~ /^idput/) { |
my ($cmd,$udom,$what)=split(/:/,$userinput); |
my ($cmd,$udom,$what)=split(/:/,$userinput); |