Annotation of loncom/Lond.pm, revision 1.1
1.1 ! droeschl 1: # The LearningOnline Network
! 2: #
! 3: # $Id: $
! 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>
![[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