File:
[LON-CAPA] /
loncom /
Lond.pm
Revision
1.1:
download - view:
text,
annotated -
select for diffs
Wed Apr 11 21:32:28 2012 UTC (12 years, 5 months ago) by
droeschl
Branches:
MAIN
CVS tags:
HEAD
*work in progress* BZ #6585
Outsource functional aspects of lond into a separate module Lond.pm.
Functionality in Lond.pm will be used in lond and lonnet. lond will continue
to handle data transfer across the network while lonnet will handle requests
(e.g. dump) in cases where the request originates from the library server that
hosts the data. Thus avoiding serialization and IPC through several sockets
(lonnet <unix socket> lonc <inet socket> lond <- file.db becomes
lonnet <- file.db).
This greatly improves performance on library servers that are also used as
access servers.
See Bugzilla 6585 for details.
1: # The LearningOnline Network
2: #
3: # $Id: Lond.pm,v 1.1 2012/04/11 21:32:28 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: #TODO encapsulate $clientname and $clientversion in a object.
43: my ( $cmd, $tail, $clientname, $clientversion ) = @_;
44:
45: my $userinput = "$cmd:$tail";
46:
47: my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
48: if (defined($regexp)) {
49: $regexp=&unescape($regexp);
50: } else {
51: $regexp='.';
52: }
53: my ($start,$end);
54: if (defined($range)) {
55: if ($range =~/^(\d+)\-(\d+)$/) {
56: ($start,$end) = ($1,$2);
57: } elsif ($range =~/^(\d+)$/) {
58: ($start,$end) = (0,$1);
59: } else {
60: undef($range);
61: }
62: }
63: Apache::lonnet::logthis("Lond.pm: udom:[$udom] uname:[$uname] namespace:[$namespace]");
64: my $hashref = &tie_user_hash($udom, $uname, $namespace,
65: &GDBM_READER());
66: my $skipcheck;
67: if ($hashref) {
68: my $qresult='';
69: my $count=0;
70: #
71: # When dump is for roles.db, determine if LON-CAPA version checking is needed.
72: # Sessions on 2.10 and later will include skipcheck => 1 in extra args ref,
73: # to indicate no version checking is needed (in this case, checking occurs
74: # on the server hosting the user session, when constructing the roles/courses
75: # screen).
76: #
77: if ($extra ne '') {
78: $extra = &Apache::lonnet::thaw_unescape($extra);
79: $skipcheck = $extra->{'skipcheck'};
80: }
81: my @ids = &Apache::lonnet::current_machine_ids();
82: my (%homecourses,$major,$minor,$now);
83: #
84: # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA
85: # version on the server which requested the data. For LON-CAPA 2.9, the
86: # client session will have sent its LON-CAPA version when initiating the
87: # connection. For LON-CAPA 2.8 and older, the version is retrieved from
88: # the global %loncaparevs in lonnet.pm.
89: #
90: if (($namespace eq 'roles') && (!$skipcheck)) {
91: my $loncaparev = $clientversion;
92: if ($loncaparev eq '') {
93: $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
94: }
95: if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
96: $major = $1;
97: $minor = $2;
98: }
99: $now = time;
100: }
101: while (my ($key,$value) = each(%$hashref)) {
102: if ($namespace eq 'roles') {
103: if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
104: my $cdom = $1;
105: my $cnum = $2;
106: unless ($skipcheck) {
107: my ($role,$roleend,$rolestart) = split(/\_/,$value);
108: if (!$roleend || $roleend > $now) {
109: #
110: # For active course roles, check that requesting server is running a LON-CAPA
111: # version which meets any version requirements for the course. Do not include
112: # the role amongst the results returned if the requesting server's version is
113: # too old.
114: #
115: # This determination is handled differently depending on whether the course's
116: # homeserver is the current server, or whether it is a different server.
117: # In both cases, the course's version requirement needs to be retrieved.
118: #
119: next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
120: $minor,\%homecourses,\@ids));
121: }
122: }
123: }
124: }
125: if ($regexp eq '.') {
126: $count++;
127: if (defined($range) && $count >= $end) { last; }
128: if (defined($range) && $count < $start) { next; }
129: $qresult.=$key.'='.$value.'&';
130: } else {
131: my $unescapeKey = &unescape($key);
132: if (eval('$unescapeKey=~/$regexp/')) {
133: $count++;
134: if (defined($range) && $count >= $end) { last; }
135: if (defined($range) && $count < $start) { next; }
136: $qresult.="$key=$value&";
137: }
138: }
139: }
140: if (&untie_user_hash($hashref)) {
141: #
142: # If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
143: # version requirements for courses for which the current server is the home
144: # server permit course roles to be usable on the client server hosting the
145: # user's session. If so, include those role results in the data returned to
146: # the client server.
147: #
148: if (($namespace eq 'roles') && (!$skipcheck)) {
149: if (keys(%homecourses) > 0) {
150: $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
151: $range,$start,$end,$major,$minor);
152: }
153: }
154: chop($qresult);
155: Apache::lonnet::logthis("Lond.pm: qresult:[$qresult]");
156: return $qresult;
157: #&Reply($client, \$qresult, $userinput);
158: } else {
159: return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
160: #&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
161: # "while attempting dump\n", $userinput);
162: }
163: } else {
164: return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
165: #&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
166: # "while attempting dump\n", $userinput);
167: }
168:
169: #never get here
170: die("SHOULD NOT HAPPEN!");
171: return 1;
172: }
173:
174: 1;
175:
176: __END__
177:
178: =head1 NAME
179:
180: LONCAPA::Lond.pm
181:
182: =head1 SYNOPSIS
183:
184: #TODO
185:
186: =head1 DESCRIPTION
187:
188: #TODO
189:
190: =head1 METHODS
191:
192: =over 4
193:
194: =item dump_with_regexp( $cmd, $tail, $client )
195:
196: Dump a profile database with an optional regular expression to match against
197: the keys. In this dump, no effort is made to separate symb from version
198: information. Presumably the databases that are dumped by this command are of a
199: different structure. Need to look at this and improve the documentation of
200: both this and the currentdump handler.
201:
202: $cmd is the command keyword.
203:
204: $tail a colon separated list containing
205:
206: =over
207:
208: =item domain
209:
210: =item user
211:
212: identifying the user.
213:
214: =item namespace
215:
216: identifying the database.
217:
218: =item regexp
219:
220: optional regular expression that is matched against database keywords to do
221: selective dumps.
222:
223: =item range
224:
225: optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.
226:
227: =item extra
228:
229: optional ref to hash of additional args. currently skipcheck is only key used.
230:
231: =back
232:
233: $client is the channel open on the client.
234:
235: Returns: 1 (Continue processing).
236:
237: Side effects: response is written to $client.
238:
239: =back
240:
241: =head1 BUGS
242:
243: No known bugs at this time.
244:
245: =head1 SEE ALSO
246:
247: L<Apache::lonnet>, L<lond>
248:
249: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>