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