Return to Lond.pm CVS log

Up to [LON-CAPA] / loncom

*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