[LON-CAPA-cvs] cvs: loncom / lond
raeburn
raeburn@source.lon-capa.org
Sun, 22 Aug 2010 03:44:12 -0000
This is a MIME encoded message
--raeburn1282448652
Content-Type: text/plain
raeburn Sun Aug 22 03:44:12 2010 EDT
Modified files:
/loncom lond
Log:
- Checking LON-CAPA version requirements on lond side (for clients running pre-2.10).
- Move version checking from &dump_with_regex() to separate routine: &releasereqd_check()
- Fix pattern matching for roles in courses to accommodate roles with sections.
- For courses on same server as user, tie nohist_courseiddump.db directly.
- For courses with home server elsewhere use lonnet.
- Do not check version requirements for expired roles.
--raeburn1282448652
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20100822034412.txt"
Index: loncom/lond
diff -u loncom/lond:1.452 loncom/lond:1.453
--- loncom/lond:1.452 Wed Aug 18 19:25:09 2010
+++ loncom/lond Sun Aug 22 03:44:12 2010
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.452 2010/08/18 19:25:09 raeburn Exp $
+# $Id: lond,v 1.453 2010/08/22 03:44:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.452 $'; #' stupid emacs
+my $VERSION='$Revision: 1.453 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3175,40 +3175,26 @@
$clientcheckrole = $extra->{'clientcheckrole'};
}
my @ids = &Apache::lonnet::current_machine_ids();
+ my (%homecourses,$major,$minor,$now);
+ if (($namespace eq 'roles') && (!$clientcheckrole)) {
+ my $loncaparev = $clientversion;
+ if ($loncaparev eq '') {
+ $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
+ }
+ if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
+ $major = $1;
+ $minor = $2;
+ }
+ $now = time;
+ }
while (my ($key,$value) = each(%$hashref)) {
if ($namespace eq 'roles') {
- if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)_(cc|co|in|ta|ep|ad|st|cr)}) {
+ if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
my $cdom = $1;
my $cnum = $2;
unless ($clientcheckrole) {
- my $home = &Apache::lonnet::homeserver($cnum,$cdom);
- my $loncaparev = $clientversion;
- if ($loncaparev eq '') {
- $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
- }
- my ($major,$minor);
- if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
- $major = $1;
- $minor = $2;
- }
- if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(co|in|ta|ep|ad|st|cr)}) {
- if ($major eq '' && $minor eq '') {
- next unless (($home ne 'no_host') && grep(/^\Q$home\E$/,@ids));
- }
- }
- unless ($home eq 'no_host') {
- my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
- if (ref($courseinfo) eq 'HASH') {
- if (exists($courseinfo->{'releaserequired'})) {
- my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
- if ($reqdmajor ne '' && $reqdminor ne '') {
- next if (($major eq '' && $minor eq '') ||
- ($major < $reqdmajor) ||
- (($major == $reqdmajor) && ($minor < $reqdminor)));
- }
- }
- }
- }
+ next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor,
+ $now,\%homecourses,\@ids));
}
}
}
@@ -3228,6 +3214,12 @@
}
}
if (&untie_user_hash($hashref)) {
+ if (($namespace eq 'roles') && (!$clientcheckrole)) {
+ if (keys(%homecourses) > 0) {
+ $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
+ $range,$start,$end,$major,$minor);
+ }
+ }
chop($qresult);
&Reply($client, \$qresult, $userinput);
} else {
@@ -7302,21 +7294,136 @@
return;
}
+sub releasereqd_check {
+ my ($cnum,$cdom,$key,$value,$major,$minor,$now,$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 ($role,$end,$start) = split(/_/,$value);
+ if (!$end || $end > $now) {
+ 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->{$hashid}) eq 'ARRAY') {
+ push(@{$homecourses->{$hashid}},{$key=>$value});
+ } else {
+ $homecourses->{$hashid} = [{$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));
+ }
+ }
+ }
+ }
+ return 1;
+}
+
sub get_courseinfo_hash {
my ($cnum,$cdom,$home) = @_;
my $hashid = $cdom.':'.$cnum;
- my ($courseinfo,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
- if (defined($cached)) {
- return $courseinfo;
- } else {
- my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
- if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
- return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
- }
+ my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
+ if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
+ return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
}
return;
}
+sub check_homecourses {
+ my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
+ my ($result,%addtocache);
+ if (ref($homecourses) eq 'HASH') {
+ my %okcourses;
+ my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+ if ($hashref) {
+ while (my ($key,$value) = each(%$hashref)) {
+ my $unesc_key = &unescape($key);
+ next if ($unesc_key =~ /^lasttime:/);
+ my $items = &Apache::lonnet::thaw_unescape($value);
+ if (ref($items) eq 'HASH') {
+ my $hashid = $unesc_key;
+ $hashid =~ s/_/:/;
+ &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600);
+ if (ref($homecourses->{$hashid}) 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');
+ }
+ } else {
+ &logthis('Failed to tie hash for nohist_courseids.db');
+ return;
+ }
+ foreach my $hashid (keys(%okcourses)) {
+ if (ref($homecourses->{$hashid}) eq 'ARRAY') {
+ foreach my $role (@{$homecourses->{$hashid}}) {
+ 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;
+}
+
+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;
+}
+
# ----------------------------------- POD (plain old documentation, CPAN style)
=head1 NAME
--raeburn1282448652--