--- loncom/lond 2006/01/31 16:12:12 1.313
+++ loncom/lond 2006/03/03 22:03:17 1.318.2.5
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.313 2006/01/31 16:12:12 albertel Exp $
+# $Id: lond,v 1.318.2.5 2006/03/03 22:03:17 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@ my $status='';
my $lastlog='';
my $lond_max_wait_time = 13;
-my $VERSION='$Revision: 1.313 $'; #' stupid emacs
+my $VERSION='$Revision: 1.318.2.5 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1074,10 +1074,8 @@ sub _do_hash_untie {
die();
}
- &logthis("$$ for $namespace");
$sym=&Symbol::gensym();
open($sym,"$file_prefix.db");
- &logthis("$$ for $namespace attempt lock");
my $failed=0;
eval {
local $SIG{__DIE__}='DEFAULT';
@@ -1090,11 +1088,9 @@ sub _do_hash_untie {
alarm(0);
};
if ($failed) {
- &logthis("$$ for $namespace got failed lock");
$! = 100; # throwing error # 100
return undef;
}
- &logthis("$$ for $file_prefix.db got lock");
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
}
@@ -2455,7 +2451,7 @@ sub put_user_profile_entry {
$userinput);
}
} else {
- &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+ &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting put\n", $userinput);
}
} else {
@@ -2491,7 +2487,7 @@ sub newput_user_profile_entry {
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_WRCREAT(),"N",$what);
if(!$hashref) {
- &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+ &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting put\n", $userinput);
return 1;
}
@@ -2681,7 +2677,7 @@ sub roles_delete_handler {
foreach my $key (@rolekeys) {
delete $hashref->{$key};
}
- if (&untie_user_hash(%$hashref)) {
+ if (&untie_user_hash($hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2822,7 +2818,7 @@ sub delete_profile_entry {
foreach my $key (@keys) {
delete($hashref->{$key});
}
- if (&untie_user_hash(%$hashref)) {
+ if (&untie_user_hash($hashref)) {
&Reply($client, "ok\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2864,7 +2860,7 @@ sub get_profile_keys {
foreach my $key (keys %$hashref) {
$qresult.="$key&";
}
- if (&untie_user_hash(%$hashref)) {
+ if (&untie_user_hash($hashref)) {
$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);
} else {
@@ -2919,11 +2915,21 @@ sub dump_profile_database {
while (my ($key,$value) = each(%$hashref)) {
my ($v,$symb,$param) = split(/:/,$key);
next if ($v eq 'version' || $symb eq 'keys');
- next if (exists($data{$symb}) &&
- exists($data{$symb}->{$param}) &&
- $data{$symb}->{'v.'.$param} > $v);
- $data{$symb}->{$param}=$value;
- $data{$symb}->{'v.'.$param}=$v;
+ # making old style store entries '$ver:$symb:$key = $value'
+ # look like new '$ver:compressed:$symb = "$key=$value"'
+ if ($symb eq 'compressed') {
+ $symb = $param;
+ } else {
+ $value = $param.'='.$value;
+ }
+ foreach my $pair (split(/\&/,$value)) {
+ my ($param,$value)=split(/=/,$pair);
+ next if (exists($data{$symb}) &&
+ exists($data{$symb}->{$param}) &&
+ $data{$symb}->{'v.'.$param} > $v);
+ $data{$symb}->{$param}=$value;
+ $data{$symb}->{'v.'.$param}=$v;
+ }
}
if (&untie_user_hash($hashref)) {
while (my ($symb,$param_hash) = each(%data)) {
@@ -3072,11 +3078,10 @@ sub store_handler {
my $version=$hashref->{"version:$rid"};
my $allkeys='';
foreach my $pair (@pairs) {
- my ($key,$value)=split(/=/,$pair);
+ my ($key)=split(/=/,$pair);
$allkeys.=$key.':';
- $hashref->{"$version:$rid:$key"}=$value;
}
- $hashref->{"$version:$rid:timestamp"}=$now;
+ $hashref->{"$version:compressed:$rid"}=$what."\×tamp=$now";
$allkeys.='timestamp';
$hashref->{"$version:keys:$rid"}=$allkeys;
if (&untie_user_hash($hashref)) {
@@ -3142,9 +3147,16 @@ sub restore_handler {
my @keys=split(/:/,$vkeys);
my $key;
$qresult.="$scope:keys=$vkeys&";
- foreach $key (@keys) {
- $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
- }
+ if (exists($hashref->{"$scope:compressed:$rid"})) {
+ foreach my $pair (split(/\&/,$hashref->{"$scope:compressed:$rid"})) {
+ my ($key,$value)=split(/=/,$pair);
+ $qresult.="$scope:".$pair."&";
+ }
+ } else {
+ foreach $key (@keys) {
+ $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
+ }
+ }
}
if (&untie_user_hash($hashref)) {
$qresult=~s/\&$//;
@@ -4340,6 +4352,64 @@ sub get_institutional_code_format_handle
®ister_handler("autoinstcodeformat",
\&get_institutional_code_format_handler,0,1,0);
+# Get domain specific conditions for import of student photographs to a course
+#
+# Retrieves information from photo_permission subroutine in localenroll.
+# Returns outcome (ok) if no processing errors, and whether course owner is
+# required to accept conditions of use (yes/no).
+#
+#
+sub photo_permission_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my $cdom = $tail;
+ my ($perm_reqd,$conditions);
+ my $outcome = &localenroll::photo_permission($cdom,\$perm_reqd,
+ \$conditions);
+ &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n",
+ $userinput);
+}
+®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0);
+
+#
+# Checks if student photo is available for a user in the domain, in the user's
+# directory (in /userfiles/internal/studentphoto.jpg).
+# Uses localstudentphoto:fetch() to ensure there is an up to date copy of
+# the student's photo.
+
+sub photo_check_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($udom,$uname,$pid) = split(/:/,$tail);
+ $udom = &unescape($udom);
+ $uname = &unescape($uname);
+ $pid = &unescape($pid);
+ my $path=&propath($udom,$uname).'/userfiles/internal/';
+ if (!-e $path) {
+ &mkpath($path);
+ }
+ my $response;
+ my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response);
+ $result .= ':'.$response;
+ &Reply($client, &escape($result)."\n",$userinput);
+}
+®ister_handler("autophotocheck",\&photo_check_handler,0,1,0);
+
+#
+# Retrieve information from localenroll about whether to provide a button
+# for users who have enbled import of student photos to initiate an
+# update of photo files for registered students. Also include
+# comment to display alongside button.
+
+sub photo_choice_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my $cdom = &unescape($tail);
+ my ($update,$comment) = &localenroll::manager_photo_update($cdom);
+ &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput);
+}
+®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0);
+
#
# Gets a student's photo to exist (in the correct image type) in the user's
# directory.
@@ -4352,24 +4422,33 @@ sub get_institutional_code_format_handle
# $client - The socket open on the client.
# Returns:
# 1 - continue processing.
+
sub student_photo_handler {
my ($cmd, $tail, $client) = @_;
- my ($domain,$uname,$type) = split(/:/, $tail);
+ my ($domain,$uname,$ext,$type) = split(/:/, $tail);
- my $path=&propath($domain,$uname).
- '/userfiles/internal/studentphoto.'.$type;
- if (-e $path) {
+ my $path=&propath($domain,$uname). '/userfiles/internal/';
+ my $filename = 'studentphoto.'.$ext;
+ if ($type eq 'thumbnail') {
+ $filename = 'studentphoto_tn.'.$ext;
+ }
+ if (-e $path.$filename) {
&Reply($client,"ok\n","$cmd:$tail");
return 1;
}
&mkpath($path);
- my $file=&localstudentphoto::fetch($domain,$uname);
+ my $file;
+ if ($type eq 'thumbnail') {
+ $file=&localstudentphoto::fetch_thumbnail($domain,$uname);
+ } else {
+ $file=&localstudentphoto::fetch($domain,$uname);
+ }
if (!$file) {
&Failure($client,"unavailable\n","$cmd:$tail");
return 1;
}
- if (!-e $path) { &convert_photo($file,$path); }
- if (-e $path) {
+ if (!-e $path.$filename) { &convert_photo($file,$path.$filename); }
+ if (-e $path.$filename) {
&Reply($client,"ok\n","$cmd:$tail");
return 1;
}