File:
[LON-CAPA] /
loncom /
Lond.pm
Revision
1.2:
download - view:
text,
annotated -
select for diffs
Thu Apr 26 19:51:40 2012 UTC (12 years, 1 month ago) by
droeschl
Branches:
MAIN
CVS tags:
HEAD
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
1: # The LearningOnline Network
2: #
3: # $Id: Lond.pm,v 1.2 2012/04/26 19:51:40 droeschl Exp $
4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/html/adm/gpl.txt
24: #
25: # http://www.lon-capa.org/
26: #
27: ###
28:
29: #NOTE perldoc at the end of file
30:
31: package LONCAPA::Lond;
32:
33: use strict;
34: use lib '/home/httpd/lib/perl/';
35:
36: use LONCAPA;
37: use Apache::lonnet;
38: use GDBM_File;
39:
40:
41: sub dump_with_regexp {
42: my ( $tail, $clientname, $clientversion ) = @_;
43: my ( $udom, $uname, $namespace, $regexp, $range ) =
44: split /:/, $tail;
45:
46: $regexp = defined $regexp ? unescape($regexp) : '.';
47:
48: my ($start,$end);
49:
50: if (defined($range)) {
51: if ($range =~ /^(\d+)\-(\d+)$/) {
52: ($start,$end) = ($1,$2);
53: } elsif ($range =~/^(\d+)$/) {
54: ($start,$end) = (0,$1);
55: } else {
56: undef($range);
57: }
58: }
59:
60: my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or
61: return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
62:
63: my $qresult = '';
64: my $count = 0;
65: #
66: # When dump is for roles.db, determine if LON-CAPA version checking is needed.
67: # Sessions on 2.10 and later do not require version checking, as that occurs
68: # on the server hosting the user session, when constructing the roles/courses
69: # screen).
70: #
71: my $skipcheck;
72: my @ids = &Apache::lonnet::current_machine_ids();
73: my (%homecourses, $major, $minor, $now);
74: #
75: # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA
76: # version on the server which requested the data.
77: #
78: if ($namespace eq 'roles') {
79: if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
80: $major = $1;
81: $minor = $2;
82: }
83: if (($major > 2) || (($major == 2) && ($minor > 9))) {
84: $skipcheck = 1;
85: }
86: $now = time;
87: }
88: while (my ($key,$value) = each(%$hashref)) {
89: if ($namespace eq 'roles' && (!$skipcheck)) {
90: if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
91: my $cdom = $1;
92: my $cnum = $2;
93: my ($role,$roleend,$rolestart) = split(/\_/,$value);
94: if (!$roleend || $roleend > $now) {
95: #
96: # For active course roles, check that requesting server is running a LON-CAPA
97: # version which meets any version requirements for the course. Do not include
98: # the role amongst the results returned if the requesting server's version is
99: # too old.
100: #
101: # This determination is handled differently depending on whether the course's
102: # homeserver is the current server, or whether it is a different server.
103: # In both cases, the course's version requirement needs to be retrieved.
104: #
105: next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
106: $minor,\%homecourses,\@ids));
107: }
108: }
109: }
110: if ($regexp eq '.') {
111: $count++;
112: if (defined($range) && $count >= $end) { last; }
113: if (defined($range) && $count < $start) { next; }
114: $qresult.=$key.'='.$value.'&';
115: } else {
116: my $unescapeKey = &unescape($key);
117: if (eval('$unescapeKey=~/$regexp/')) {
118: $count++;
119: if (defined($range) && $count >= $end) { last; }
120: if (defined($range) && $count < $start) { next; }
121: $qresult.="$key=$value&";
122: }
123: }
124: }
125:
126: &untie_user_hash($hashref) or
127: return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
128: #
129: # If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
130: # version requirements for courses for which the current server is the home
131: # server permit course roles to be usable on the client server hosting the
132: # user's session. If so, include those role results in the data returned to
133: # the client server.
134: #
135: if (($namespace eq 'roles') && (!$skipcheck)) {
136: if (keys(%homecourses) > 0) {
137: $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
138: $range,$start,$end,$major,$minor);
139: }
140: }
141: chop($qresult);
142: return $qresult;
143: }
144:
145:
146: sub releasereqd_check {
147: my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
148: my $home = &Apache::lonnet::homeserver($cnum,$cdom);
149: return if ($home eq 'no_host');
150: my ($reqdmajor,$reqdminor,$displayrole);
151: if ($cnum =~ /$LONCAPA::match_community/) {
152: if ($major eq '' && $minor eq '') {
153: return unless ((ref($ids) eq 'ARRAY') &&
154: (grep(/^\Q$home\E$/,@{$ids})));
155: } else {
156: $reqdmajor = 2;
157: $reqdminor = 9;
158: return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
159: }
160: }
161: my $hashid = $cdom.':'.$cnum;
162: my ($courseinfo,$cached) =
163: &Apache::lonnet::is_cached_new('courseinfo',$hashid);
164: if (defined($cached)) {
165: if (ref($courseinfo) eq 'HASH') {
166: if (exists($courseinfo->{'releaserequired'})) {
167: my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
168: return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
169: }
170: }
171: } else {
172: if (ref($ids) eq 'ARRAY') {
173: if (grep(/^\Q$home\E$/,@{$ids})) {
174: if (ref($homecourses) eq 'HASH') {
175: if (ref($homecourses->{$cdom}) eq 'HASH') {
176: if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
177: if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
178: push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
179: } else {
180: $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
181: }
182: } else {
183: $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
184: }
185: } else {
186: $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
187: }
188: }
189: return;
190: }
191: }
192: my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
193: if (ref($courseinfo) eq 'HASH') {
194: if (exists($courseinfo->{'releaserequired'})) {
195: my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
196: return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
197: }
198: } else {
199: return;
200: }
201: }
202: return 1;
203: }
204:
205:
206: sub check_homecourses {
207: my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
208: my ($result,%addtocache);
209: my $yesterday = time - 24*3600;
210: if (ref($homecourses) eq 'HASH') {
211: my (%okcourses,%courseinfo,%recent);
212: foreach my $domain (keys(%{$homecourses})) {
213: my $hashref =
214: &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
215: if (ref($hashref) eq 'HASH') {
216: while (my ($key,$value) = each(%$hashref)) {
217: my $unesc_key = &unescape($key);
218: if ($unesc_key =~ /^lasttime:(\w+)$/) {
219: my $cid = $1;
220: $cid =~ s/_/:/;
221: if ($value > $yesterday ) {
222: $recent{$cid} = 1;
223: }
224: next;
225: }
226: my $items = &Apache::lonnet::thaw_unescape($value);
227: if (ref($items) eq 'HASH') {
228: my ($cdom,$cnum) = split(/_/,$unesc_key);
229: my $hashid = $cdom.':'.$cnum;
230: $courseinfo{$hashid} = $items;
231: if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
232: my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
233: if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
234: $okcourses{$hashid} = 1;
235: }
236: }
237: }
238: }
239: unless (&untie_domain_hash($hashref)) {
240: &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
241: }
242: } else {
243: &logthis("Failed to tie hash for nohist_courseids.db for $domain");
244: }
245: }
246: foreach my $hashid (keys(%recent)) {
247: my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
248: unless ($cached) {
249: &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
250: }
251: }
252: foreach my $cdom (keys(%{$homecourses})) {
253: if (ref($homecourses->{$cdom}) eq 'HASH') {
254: foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
255: my $hashid = $cdom.':'.$cnum;
256: next if ($recent{$hashid});
257: &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
258: }
259: }
260: }
261: foreach my $hashid (keys(%okcourses)) {
262: my ($cdom,$cnum) = split(/:/,$hashid);
263: if ((ref($homecourses->{$cdom}) eq 'HASH') &&
264: (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
265: foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
266: if (ref($role) eq 'HASH') {
267: while (my ($key,$value) = each(%{$role})) {
268: if ($regexp eq '.') {
269: $count++;
270: if (defined($range) && $count >= $end) { last; }
271: if (defined($range) && $count < $start) { next; }
272: $result.=$key.'='.$value.'&';
273: } else {
274: my $unescapeKey = &unescape($key);
275: if (eval('$unescapeKey=~/$regexp/')) {
276: $count++;
277: if (defined($range) && $count >= $end) { last; }
278: if (defined($range) && $count < $start) { next; }
279: $result.="$key=$value&";
280: }
281: }
282: }
283: }
284: }
285: }
286: }
287: }
288: return $result;
289: }
290:
291:
292: sub useable_role {
293: my ($reqdmajor,$reqdminor,$major,$minor) = @_;
294: if ($reqdmajor ne '' && $reqdminor ne '') {
295: return if (($major eq '' && $minor eq '') ||
296: ($major < $reqdmajor) ||
297: (($major == $reqdmajor) && ($minor < $reqdminor)));
298: }
299: return 1;
300: }
301:
302:
303:
304:
305:
306:
307: 1;
308:
309: __END__
310:
311: =head1 NAME
312:
313: LONCAPA::Lond.pm
314:
315: =head1 SYNOPSIS
316:
317: #TODO
318:
319: =head1 DESCRIPTION
320:
321: #TODO
322:
323: =head1 METHODS
324:
325: =over 4
326:
327: =item dump_with_regexp( $tail, $client )
328:
329: Dump a profile database with an optional regular expression to match against
330: the keys. In this dump, no effort is made to separate symb from version
331: information. Presumably the databases that are dumped by this command are of a
332: different structure. Need to look at this and improve the documentation of
333: both this and the currentdump handler.
334:
335: $tail a colon separated list containing
336:
337: =over
338:
339: =item domain
340:
341: =item user
342:
343: identifying the user.
344:
345: =item namespace
346:
347: identifying the database.
348:
349: =item regexp
350:
351: optional regular expression that is matched against database keywords to do
352: selective dumps.
353:
354: =item range
355:
356: optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.
357:
358: =back
359:
360: $client is the channel open on the client.
361:
362: Returns: 1 (Continue processing).
363:
364: Side effects: response is written to $client.
365:
366:
367: =item releasereqd_check( $cnum, $cdom, $key, $value, $major, $minor,
368: $homecourses, $ids )
369:
370: releasereqd_check() will determine if a LON-CAPA version (defined in the
371: $major,$minor args passed) is not too old to allow use of a role in a
372: course ($cnum,$cdom args passed), if at least one of the following applies:
373: (a) the course is a Community, (b) the course's home server is *not* the
374: current server, or (c) cached course information is not stale.
375:
376: For the case where none of these apply, the course is added to the
377: $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
378: The $homecourse hash ref is for courses for which the current server is the
379: home server. LON-CAPA version requirements are checked elsewhere for the
380: items in $homecourse.
381:
382:
383: =item check_homecourses( $homecourses, $regexp, $count, $range, $start, $end,
384: $major, $minor )
385:
386: check_homecourses() will retrieve course information for those courses which
387: are keys of the $homecourses hash ref (first arg). The nohist_courseids.db
388: GDBM file is tied and course information for each course retrieved. Last
389: visit (lasttime key) is also retrieved for each, and cached values updated
390: for any courses last visited less than 24 hours ago. Cached values are also
391: updated for any courses included in the $homecourses hash ref.
392:
393: The reason for the 24 hours constraint is that the cron entry in
394: /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes
395: cached course information to be updated nightly for courses with activity
396: within the past 24 hours.
397:
398: Role information for the user (included in a ref to an array of hashes as the
399: value for each key in $homecourses) is appended to the result returned by the
400: routine, which will in turn be appended to the string returned to the client
401: hosting the user's session.
402:
403:
404: =item useable_role( $reqdmajor, $reqdminor, $major, $minor )
405:
406: useable_role() will compare the LON-CAPA version required by a course with
407: the version available on the client server. If the client server's version
408: is compatible, 1 will be returned.
409:
410:
411: =back
412:
413: =head1 BUGS
414:
415: No known bugs at this time.
416:
417: =head1 SEE ALSO
418:
419: L<Apache::lonnet>, L<lond>
420:
421: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Lond.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom