--- loncom/lond 2004/12/24 19:26:33 1.269 +++ loncom/lond 2005/01/03 16:34:46 1.274 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.269 2004/12/24 19:26:33 raeburn Exp $ +# $Id: lond,v 1.274 2005/01/03 16:34:46 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.269 $'; #' stupid emacs +my $VERSION='$Revision: 1.274 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -3108,6 +3108,14 @@ sub reply_query_handler { # $tail - Tail of the command. In this case consists of a colon # separated list contaning the domain to apply this to and # an ampersand separated list of keyword=value pairs. +# Each value is a colon separated list that includes: +# description, institutional code and course owner. +# For backward compatibility with versions included +# in LON-CAPA 1.1.X (and earlier) and 1.2.X, institutional +# code and/or course owner are preserved from the existing +# record when writing a new record in response to 1.1 or +# 1.2 implementations of lonnet::flushcourselogs(). +# # $client - Socket open on the client. # Returns: # 1 - indicating that processing should continue @@ -3129,7 +3137,23 @@ sub put_course_id_handler { my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { foreach my $pair (@pairs) { - my ($key,$courseinfo) = split(/=/,$pair); + my ($key,$courseinfo) = split(/=/,$pair,2); + $courseinfo =~ s/=/:/g; + + my @current_items = split(/:/,$hashref->{$key}); + shift(@current_items); # remove description + pop(@current_items); # remove last access + my $numcurrent = scalar(@current_items); + + my @new_items = split(/:/,$courseinfo); + my $numnew = scalar(@new_items); + if ($numcurrent > 0) { + if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier + $courseinfo .= ':'.join(':',@current_items); + } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X + $courseinfo .= ':'.$current_items[$numcurrent-1]; + } + } $hashref->{$key}=$courseinfo.':'.$now; } if (untie(%$hashref)) { @@ -3168,6 +3192,15 @@ sub put_course_id_handler { # description - regular expression that is used to filter # the dump. Only keywords matching this regexp # will be used. +# institutional code - optional supplied code to filter +# the dump. Only courses with an institutional code +# that match the supplied code will be returned. +# owner - optional supplied username of owner to filter +# the dump. Only courses for which the course +# owner matches the supplied username will be +# returned. Implicit assumption that owner +# is a user in the domain in which the +# course database is defined. # $client - The socket open on the client. # Returns: # 1 - Continue processing. @@ -3201,13 +3234,9 @@ sub dump_course_id_handler { if ($hashref) { while (my ($key,$value) = each(%$hashref)) { my ($descr,$lasttime,$inst_code,$owner); - if ($value =~ m/^([^\:]*):([^\:]*):([^\:]*):(\d+)$/) { - ($descr,$inst_code,$owner,$lasttime)=($1,$2,$3,$4); - } elsif ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { - ($descr,$inst_code,$lasttime)=($1,$2,$3); - } else { - ($descr,$lasttime) = split(/\:/,$value); - } + my @courseitems = split(/:/,$value); + $lasttime = pop(@courseitems); + ($descr,$inst_code,$owner)=@courseitems; if ($lasttime<$since) { next; } my $match = 1; unless ($description eq '.') { @@ -5106,7 +5135,7 @@ sub validate_user { my $krbserver = &Authen::Krb5::parse_name($krbservice); my $credentials= &Authen::Krb5::cc_default(); $credentials->initialize($krbclient); - my $krbreturn = &Authen::KRb5::get_in_tkt_with_password($krbclient, + my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, $krbserver, $password, $credentials);