[LON-CAPA-cvs] cvs: loncom / Lond.pm lond
droeschl
droeschl at source.lon-capa.org
Thu Apr 26 15:51:41 EDT 2012
droeschl Thu Apr 26 19:51:41 2012 EDT
Modified files:
/loncom lond Lond.pm
Log:
changes related to BZ 6585
lond:
- $clientversion is now also set for clients < 2.9.
Subroutines can rely on $clientversion instead of checking for empty string
followed by a look up in %loncaparevs.
- moved functional body of dump_with_regexp into Lond.pm
- moved check_homecourses, releasereqd_check and useable_role into Lond.pm
Lond.pm:
- incorporated changes that have been made to lond 1.491 (removal of $extra
parameter)
- clean up
-------------- next part --------------
Index: loncom/lond
diff -u loncom/lond:1.491 loncom/lond:1.492
--- loncom/lond:1.491 Wed Apr 25 21:22:28 2012
+++ loncom/lond Thu Apr 26 19:51:40 2012
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.491 2012/04/25 21:22:28 raeburn Exp $
+# $Id: lond,v 1.492 2012/04/26 19:51:40 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.491 $'; #' stupid emacs
+my $VERSION='$Revision: 1.492 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1907,12 +1907,8 @@
if (ref($hostedsession) eq 'HASH') {
$hosted = $hostedsession->{'hosted'};
}
- my $loncaparev = $clientversion;
- if ($loncaparev eq '') {
- $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
- }
$canhost = &Apache::lonnet::can_host_session($udom,$clientname,
- $loncaparev,
+ $clientversion,
$remote,$hosted);
}
}
@@ -3258,130 +3254,13 @@
sub dump_with_regexp {
my ($cmd, $tail, $client) = @_;
- #TODO encapsulate $clientname and $clientversion in a object.
- my $res = LONCAPA::Lond::dump_with_regexp($cmd, $tail, $clientname, $clientversion);
+ my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientname, $clientversion);
if ($res =~ /^error:/) {
Failure($client, \$res, "$cmd:$tail");
} else {
Reply($client, \$res, "$cmd:$tail");
}
- return 1;
-
- my $userinput = "$cmd:$tail";
-
- my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
- if (defined($regexp)) {
- $regexp=&unescape($regexp);
- } else {
- $regexp='.';
- }
- my ($start,$end);
- if (defined($range)) {
- if ($range =~/^(\d+)\-(\d+)$/) {
- ($start,$end) = ($1,$2);
- } elsif ($range =~/^(\d+)$/) {
- ($start,$end) = (0,$1);
- } else {
- undef($range);
- }
- }
- my $hashref = &tie_user_hash($udom, $uname, $namespace,
- &GDBM_READER());
- if ($hashref) {
- my $qresult='';
- my $count=0;
-#
-# When dump is for roles.db, determine if LON-CAPA version checking is needed.
-# Sessions on 2.10 and later do not require version checking, as that occurs
-# on the server hosting the user session, when constructing the roles/courses
-# screen).
-#
- my $skipcheck;
- my @ids = &Apache::lonnet::current_machine_ids();
- my (%homecourses,$major,$minor,$now);
-#
-# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA
-# version on the server which requested the data. For LON-CAPA 2.9, the
-# client session will have sent its LON-CAPA version when initiating the
-# connection. For LON-CAPA 2.8 and older, the version is retrieved from
-# the global %loncaparevs in lonnet.pm.
-#
- if ($namespace eq 'roles') {
- my $loncaparev = $clientversion;
- if ($loncaparev eq '') {
- $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
- }
- if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
- $major = $1;
- $minor = $2;
- }
- if (($major > 2) || (($major == 2) && ($minor > 9))) {
- $skipcheck = 1;
- }
- $now = time;
- }
- while (my ($key,$value) = each(%$hashref)) {
- if (($namespace eq 'roles') && (!$skipcheck)) {
- if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
- my $cdom = $1;
- my $cnum = $2;
- my ($role,$roleend,$rolestart) = split(/\_/,$value);
- if (!$roleend || $roleend > $now) {
-#
-# For active course roles, check that requesting server is running a LON-CAPA
-# version which meets any version requirements for the course. Do not include
-# the role amongst the results returned if the requesting server's version is
-# too old.
-#
-# This determination is handled differently depending on whether the course's
-# homeserver is the current server, or whether it is a different server.
-# In both cases, the course's version requirement needs to be retrieved.
-#
- next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
- $minor,\%homecourses,\@ids));
- }
- }
- }
- if ($regexp eq '.') {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $qresult.=$key.'='.$value.'&';
- } else {
- my $unescapeKey = &unescape($key);
- if (eval('$unescapeKey=~/$regexp/')) {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $qresult.="$key=$value&";
- }
- }
- }
- if (&untie_user_hash($hashref)) {
-#
-# If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
-# version requirements for courses for which the current server is the home
-# server permit course roles to be usable on the client server hosting the
-# user's session. If so, include those role results in the data returned to
-# the client server.
-#
- if (($namespace eq 'roles') && (!$skipcheck)) {
- if (keys(%homecourses) > 0) {
- $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
- $range,$start,$end,$major,$minor);
- }
- }
- chop($qresult);
- &Reply($client, \$qresult, $userinput);
- } else {
- &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting dump\n", $userinput);
- }
- } else {
- &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting dump\n", $userinput);
- }
return 1;
}
@@ -6617,6 +6496,10 @@
# If the remote is attempting a local init... give that a try:
#
(my $i, my $inittype, $clientversion) = split(/:/, $remotereq);
+ # For LON-CAPA 2.9, the client session will have sent its LON-CAPA
+ # version when initiating the connection. For LON-CAPA 2.8 and older,
+ # the version is retrieved from the global %loncaparevs in lonnet.pm.
+ $clientversion ||= $Apache::lonnet::loncaparevs{$clientname};
# If the connection type is ssl, but I didn't get my
# certificate files yet, then I'll drop back to
@@ -7480,78 +7363,6 @@
return;
}
-#
-# releasereqd_check() will determine if a LON-CAPA version (defined in the
-# $major,$minor args passed) is not too old to allow use of a role in a
-# course ($cnum,$cdom args passed), if at least one of the following applies:
-# (a) the course is a Community, (b) the course's home server is *not* the
-# current server, or (c) cached course information is not stale.
-#
-# For the case where none of these apply, the course is added to the
-# $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
-# The $homecourse hash ref is for courses for which the current server is the
-# home server. LON-CAPA version requirements are checked elsewhere for the
-# items in $homecourse.
-#
-
-sub releasereqd_check {
- my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
- my $home = &Apache::lonnet::homeserver($cnum,$cdom);
- return if ($home eq 'no_host');
- my ($reqdmajor,$reqdminor,$displayrole);
- if ($cnum =~ /$LONCAPA::match_community/) {
- if ($major eq '' && $minor eq '') {
- return unless ((ref($ids) eq 'ARRAY') &&
- (grep(/^\Q$home\E$/,@{$ids})));
- } else {
- $reqdmajor = 2;
- $reqdminor = 9;
- return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
- }
- }
- my $hashid = $cdom.':'.$cnum;
- my ($courseinfo,$cached) =
- &Apache::lonnet::is_cached_new('courseinfo',$hashid);
- if (defined($cached)) {
- if (ref($courseinfo) eq 'HASH') {
- if (exists($courseinfo->{'releaserequired'})) {
- my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
- return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
- }
- }
- } else {
- if (ref($ids) eq 'ARRAY') {
- if (grep(/^\Q$home\E$/,@{$ids})) {
- if (ref($homecourses) eq 'HASH') {
- if (ref($homecourses->{$cdom}) eq 'HASH') {
- if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
- if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
- push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
- } else {
- $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
- }
- } else {
- $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
- }
- } else {
- $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
- }
- }
- return;
- }
- }
- my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
- if (ref($courseinfo) eq 'HASH') {
- if (exists($courseinfo->{'releaserequired'})) {
- my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
- return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
- }
- } else {
- return;
- }
- }
- return 1;
-}
#
# get_courseinfo_hash() is used to retrieve course information from the db
@@ -7589,125 +7400,6 @@
return;
}
-#
-# check_homecourses() will retrieve course information for those courses which
-# are keys of the $homecourses hash ref (first arg). The nohist_courseids.db
-# GDBM file is tied and course information for each course retrieved. Last
-# visit (lasttime key) is also retrieved for each, and cached values updated
-# for any courses last visited less than 24 hours ago. Cached values are also
-# updated for any courses included in the $homecourses hash ref.
-#
-# The reason for the 24 hours constraint is that the cron entry in
-# /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes
-# cached course information to be updated nightly for courses with activity
-# within the past 24 hours.
-#
-# Role information for the user (included in a ref to an array of hashes as the
-# value for each key in $homecourses) is appended to the result returned by the
-# routine, which will in turn be appended to the string returned to the client
-# hosting the user's session.
-#
-
-sub check_homecourses {
- my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
- my ($result,%addtocache);
- my $yesterday = time - 24*3600;
- if (ref($homecourses) eq 'HASH') {
- my (%okcourses,%courseinfo,%recent);
- foreach my $domain (keys(%{$homecourses})) {
- my $hashref =
- &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
- if (ref($hashref) eq 'HASH') {
- while (my ($key,$value) = each(%$hashref)) {
- my $unesc_key = &unescape($key);
- if ($unesc_key =~ /^lasttime:(\w+)$/) {
- my $cid = $1;
- $cid =~ s/_/:/;
- if ($value > $yesterday ) {
- $recent{$cid} = 1;
- }
- next;
- }
- my $items = &Apache::lonnet::thaw_unescape($value);
- if (ref($items) eq 'HASH') {
- my ($cdom,$cnum) = split(/_/,$unesc_key);
- my $hashid = $cdom.':'.$cnum;
- $courseinfo{$hashid} = $items;
- if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
- my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
- if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
- $okcourses{$hashid} = 1;
- }
- }
- }
- }
- unless (&untie_domain_hash($hashref)) {
- &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
- }
- } else {
- &logthis("Failed to tie hash for nohist_courseids.db for $domain");
- }
- }
- foreach my $hashid (keys(%recent)) {
- my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
- unless ($cached) {
- &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
- }
- }
- foreach my $cdom (keys(%{$homecourses})) {
- if (ref($homecourses->{$cdom}) eq 'HASH') {
- foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
- my $hashid = $cdom.':'.$cnum;
- next if ($recent{$hashid});
- &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
- }
- }
- }
- foreach my $hashid (keys(%okcourses)) {
- my ($cdom,$cnum) = split(/:/,$hashid);
- if ((ref($homecourses->{$cdom}) eq 'HASH') &&
- (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
- foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
- if (ref($role) eq 'HASH') {
- while (my ($key,$value) = each(%{$role})) {
- if ($regexp eq '.') {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $result.=$key.'='.$value.'&';
- } else {
- my $unescapeKey = &unescape($key);
- if (eval('$unescapeKey=~/$regexp/')) {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $result.="$key=$value&";
- }
- }
- }
- }
- }
- }
- }
- }
- return $result;
-}
-
-#
-# useable_role() will compare the LON-CAPA version required by a course with
-# the version available on the client server. If the client server's version
-# is compatible, 1 will be returned.
-#
-
-sub useable_role {
- my ($reqdmajor,$reqdminor,$major,$minor) = @_;
- if ($reqdmajor ne '' && $reqdminor ne '') {
- return if (($major eq '' && $minor eq '') ||
- ($major < $reqdmajor) ||
- (($major == $reqdmajor) && ($minor < $reqdminor)));
- }
- return 1;
-}
sub distro_and_arch {
return $dist.':'.$arch;
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.1 loncom/Lond.pm:1.2
--- loncom/Lond.pm:1.1 Wed Apr 11 21:32:28 2012
+++ loncom/Lond.pm Thu Apr 26 19:51:40 2012
@@ -1,6 +1,6 @@
# The LearningOnline Network
#
-# $Id: Lond.pm,v 1.1 2012/04/11 21:32:28 droeschl Exp $
+# $Id: Lond.pm,v 1.2 2012/04/26 19:51:40 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,73 +39,59 @@
sub dump_with_regexp {
- #TODO encapsulate $clientname and $clientversion in a object.
- my ( $cmd, $tail, $clientname, $clientversion ) = @_;
+ my ( $tail, $clientname, $clientversion ) = @_;
+ my ( $udom, $uname, $namespace, $regexp, $range ) =
+ split /:/, $tail;
- my $userinput = "$cmd:$tail";
+ $regexp = defined $regexp ? unescape($regexp) : '.';
- my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
- if (defined($regexp)) {
- $regexp=&unescape($regexp);
- } else {
- $regexp='.';
- }
my ($start,$end);
+
if (defined($range)) {
- if ($range =~/^(\d+)\-(\d+)$/) {
- ($start,$end) = ($1,$2);
- } elsif ($range =~/^(\d+)$/) {
- ($start,$end) = (0,$1);
- } else {
- undef($range);
- }
- }
- Apache::lonnet::logthis("Lond.pm: udom:[$udom] uname:[$uname] namespace:[$namespace]");
- my $hashref = &tie_user_hash($udom, $uname, $namespace,
- &GDBM_READER());
- my $skipcheck;
- if ($hashref) {
- my $qresult='';
- my $count=0;
+ if ($range =~ /^(\d+)\-(\d+)$/) {
+ ($start,$end) = ($1,$2);
+ } elsif ($range =~/^(\d+)$/) {
+ ($start,$end) = (0,$1);
+ } else {
+ undef($range);
+ }
+ }
+
+ my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or
+ return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
+
+ my $qresult = '';
+ my $count = 0;
#
# When dump is for roles.db, determine if LON-CAPA version checking is needed.
-# Sessions on 2.10 and later will include skipcheck => 1 in extra args ref,
-# to indicate no version checking is needed (in this case, checking occurs
+# Sessions on 2.10 and later do not require version checking, as that occurs
# on the server hosting the user session, when constructing the roles/courses
# screen).
#
- if ($extra ne '') {
- $extra = &Apache::lonnet::thaw_unescape($extra);
- $skipcheck = $extra->{'skipcheck'};
- }
- my @ids = &Apache::lonnet::current_machine_ids();
- my (%homecourses,$major,$minor,$now);
+ my $skipcheck;
+ my @ids = &Apache::lonnet::current_machine_ids();
+ my (%homecourses, $major, $minor, $now);
#
# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA
-# version on the server which requested the data. For LON-CAPA 2.9, the
-# client session will have sent its LON-CAPA version when initiating the
-# connection. For LON-CAPA 2.8 and older, the version is retrieved from
-# the global %loncaparevs in lonnet.pm.
+# version on the server which requested the data.
#
- if (($namespace eq 'roles') && (!$skipcheck)) {
- my $loncaparev = $clientversion;
- if ($loncaparev eq '') {
- $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
- }
- if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
- $major = $1;
- $minor = $2;
- }
- $now = time;
+ if ($namespace eq 'roles') {
+ if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
+ $major = $1;
+ $minor = $2;
+ }
+ if (($major > 2) || (($major == 2) && ($minor > 9))) {
+ $skipcheck = 1;
}
- while (my ($key,$value) = each(%$hashref)) {
- if ($namespace eq 'roles') {
+ $now = time;
+ }
+ while (my ($key,$value) = each(%$hashref)) {
+ if ($namespace eq 'roles' && (!$skipcheck)) {
if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
my $cdom = $1;
my $cnum = $2;
- unless ($skipcheck) {
- my ($role,$roleend,$rolestart) = split(/\_/,$value);
- if (!$roleend || $roleend > $now) {
+ my ($role,$roleend,$rolestart) = split(/\_/,$value);
+ if (!$roleend || $roleend > $now) {
#
# For active course roles, check that requesting server is running a LON-CAPA
# version which meets any version requirements for the course. Do not include
@@ -116,28 +102,29 @@
# homeserver is the current server, or whether it is a different server.
# In both cases, the course's version requirement needs to be retrieved.
#
- next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
- $minor,\%homecourses,\@ids));
- }
+ next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
+ $minor,\%homecourses,\@ids));
}
}
}
- if ($regexp eq '.') {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $qresult.=$key.'='.$value.'&';
- } else {
- my $unescapeKey = &unescape($key);
- if (eval('$unescapeKey=~/$regexp/')) {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $qresult.="$key=$value&";
- }
- }
- }
- if (&untie_user_hash($hashref)) {
+ if ($regexp eq '.') {
+ $count++;
+ if (defined($range) && $count >= $end) { last; }
+ if (defined($range) && $count < $start) { next; }
+ $qresult.=$key.'='.$value.'&';
+ } else {
+ my $unescapeKey = &unescape($key);
+ if (eval('$unescapeKey=~/$regexp/')) {
+ $count++;
+ if (defined($range) && $count >= $end) { last; }
+ if (defined($range) && $count < $start) { next; }
+ $qresult.="$key=$value&";
+ }
+ }
+ }
+
+ &untie_user_hash($hashref) or
+ return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
#
# If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
# version requirements for courses for which the current server is the home
@@ -145,32 +132,178 @@
# user's session. If so, include those role results in the data returned to
# the client server.
#
- if (($namespace eq 'roles') && (!$skipcheck)) {
- if (keys(%homecourses) > 0) {
- $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
- $range,$start,$end,$major,$minor);
- }
+ if (($namespace eq 'roles') && (!$skipcheck)) {
+ if (keys(%homecourses) > 0) {
+ $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
+ $range,$start,$end,$major,$minor);
+ }
+ }
+ chop($qresult);
+ return $qresult;
+}
+
+
+sub releasereqd_check {
+ my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
+ my $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ return if ($home eq 'no_host');
+ my ($reqdmajor,$reqdminor,$displayrole);
+ if ($cnum =~ /$LONCAPA::match_community/) {
+ if ($major eq '' && $minor eq '') {
+ return unless ((ref($ids) eq 'ARRAY') &&
+ (grep(/^\Q$home\E$/,@{$ids})));
+ } else {
+ $reqdmajor = 2;
+ $reqdminor = 9;
+ return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
+ }
+ }
+ my $hashid = $cdom.':'.$cnum;
+ my ($courseinfo,$cached) =
+ &Apache::lonnet::is_cached_new('courseinfo',$hashid);
+ if (defined($cached)) {
+ if (ref($courseinfo) eq 'HASH') {
+ if (exists($courseinfo->{'releaserequired'})) {
+ my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
+ return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
}
- chop($qresult);
- Apache::lonnet::logthis("Lond.pm: qresult:[$qresult]");
- return $qresult;
- #&Reply($client, \$qresult, $userinput);
- } else {
- return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
- #&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- # "while attempting dump\n", $userinput);
- }
+ }
} else {
- return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
- #&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
- # "while attempting dump\n", $userinput);
+ if (ref($ids) eq 'ARRAY') {
+ if (grep(/^\Q$home\E$/,@{$ids})) {
+ if (ref($homecourses) eq 'HASH') {
+ if (ref($homecourses->{$cdom}) eq 'HASH') {
+ if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
+ if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
+ push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
+ } else {
+ $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+ }
+ } else {
+ $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+ }
+ } else {
+ $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+ }
+ }
+ return;
+ }
+ }
+ my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
+ if (ref($courseinfo) eq 'HASH') {
+ if (exists($courseinfo->{'releaserequired'})) {
+ my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
+ return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
+ }
+ } else {
+ return;
+ }
+ }
+ return 1;
+}
+
+
+sub check_homecourses {
+ my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
+ my ($result,%addtocache);
+ my $yesterday = time - 24*3600;
+ if (ref($homecourses) eq 'HASH') {
+ my (%okcourses,%courseinfo,%recent);
+ foreach my $domain (keys(%{$homecourses})) {
+ my $hashref =
+ &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
+ if (ref($hashref) eq 'HASH') {
+ while (my ($key,$value) = each(%$hashref)) {
+ my $unesc_key = &unescape($key);
+ if ($unesc_key =~ /^lasttime:(\w+)$/) {
+ my $cid = $1;
+ $cid =~ s/_/:/;
+ if ($value > $yesterday ) {
+ $recent{$cid} = 1;
+ }
+ next;
+ }
+ my $items = &Apache::lonnet::thaw_unescape($value);
+ if (ref($items) eq 'HASH') {
+ my ($cdom,$cnum) = split(/_/,$unesc_key);
+ my $hashid = $cdom.':'.$cnum;
+ $courseinfo{$hashid} = $items;
+ if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
+ my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
+ if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
+ $okcourses{$hashid} = 1;
+ }
+ }
+ }
+ }
+ unless (&untie_domain_hash($hashref)) {
+ &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
+ }
+ } else {
+ &logthis("Failed to tie hash for nohist_courseids.db for $domain");
+ }
+ }
+ foreach my $hashid (keys(%recent)) {
+ my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
+ unless ($cached) {
+ &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+ }
+ }
+ foreach my $cdom (keys(%{$homecourses})) {
+ if (ref($homecourses->{$cdom}) eq 'HASH') {
+ foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
+ my $hashid = $cdom.':'.$cnum;
+ next if ($recent{$hashid});
+ &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+ }
+ }
+ }
+ foreach my $hashid (keys(%okcourses)) {
+ my ($cdom,$cnum) = split(/:/,$hashid);
+ if ((ref($homecourses->{$cdom}) eq 'HASH') &&
+ (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
+ foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
+ if (ref($role) eq 'HASH') {
+ while (my ($key,$value) = each(%{$role})) {
+ if ($regexp eq '.') {
+ $count++;
+ if (defined($range) && $count >= $end) { last; }
+ if (defined($range) && $count < $start) { next; }
+ $result.=$key.'='.$value.'&';
+ } else {
+ my $unescapeKey = &unescape($key);
+ if (eval('$unescapeKey=~/$regexp/')) {
+ $count++;
+ if (defined($range) && $count >= $end) { last; }
+ if (defined($range) && $count < $start) { next; }
+ $result.="$key=$value&";
+ }
+ }
+ }
+ }
+ }
+ }
+ }
}
+ return $result;
+}
+
- #never get here
- die("SHOULD NOT HAPPEN!");
+sub useable_role {
+ my ($reqdmajor,$reqdminor,$major,$minor) = @_;
+ if ($reqdmajor ne '' && $reqdminor ne '') {
+ return if (($major eq '' && $minor eq '') ||
+ ($major < $reqdmajor) ||
+ (($major == $reqdmajor) && ($minor < $reqdminor)));
+ }
return 1;
}
+
+
+
+
+
1;
__END__
@@ -191,7 +324,7 @@
=over 4
-=item dump_with_regexp( $cmd, $tail, $client )
+=item dump_with_regexp( $tail, $client )
Dump a profile database with an optional regular expression to match against
the keys. In this dump, no effort is made to separate symb from version
@@ -199,8 +332,6 @@
different structure. Need to look at this and improve the documentation of
both this and the currentdump handler.
-$cmd is the command keyword.
-
$tail a colon separated list containing
=over
@@ -224,10 +355,6 @@
optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.
-=item extra
-
-optional ref to hash of additional args. currently skipcheck is only key used.
-
=back
$client is the channel open on the client.
@@ -236,6 +363,51 @@
Side effects: response is written to $client.
+
+=item releasereqd_check( $cnum, $cdom, $key, $value, $major, $minor,
+ $homecourses, $ids )
+
+releasereqd_check() will determine if a LON-CAPA version (defined in the
+$major,$minor args passed) is not too old to allow use of a role in a
+course ($cnum,$cdom args passed), if at least one of the following applies:
+(a) the course is a Community, (b) the course's home server is *not* the
+current server, or (c) cached course information is not stale.
+
+For the case where none of these apply, the course is added to the
+$homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
+The $homecourse hash ref is for courses for which the current server is the
+home server. LON-CAPA version requirements are checked elsewhere for the
+items in $homecourse.
+
+
+=item check_homecourses( $homecourses, $regexp, $count, $range, $start, $end,
+ $major, $minor )
+
+check_homecourses() will retrieve course information for those courses which
+are keys of the $homecourses hash ref (first arg). The nohist_courseids.db
+GDBM file is tied and course information for each course retrieved. Last
+visit (lasttime key) is also retrieved for each, and cached values updated
+for any courses last visited less than 24 hours ago. Cached values are also
+updated for any courses included in the $homecourses hash ref.
+
+The reason for the 24 hours constraint is that the cron entry in
+/etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes
+cached course information to be updated nightly for courses with activity
+within the past 24 hours.
+
+Role information for the user (included in a ref to an array of hashes as the
+value for each key in $homecourses) is appended to the result returned by the
+routine, which will in turn be appended to the string returned to the client
+hosting the user's session.
+
+
+=item useable_role( $reqdmajor, $reqdminor, $major, $minor )
+
+useable_role() will compare the LON-CAPA version required by a course with
+the version available on the client server. If the client server's version
+is compatible, 1 will be returned.
+
+
=back
=head1 BUGS
More information about the LON-CAPA-cvs
mailing list