File:  [LON-CAPA] / loncom / Lond.pm
Revision 1.1: download - view: text, annotated - select for diffs
Wed Apr 11 21:32:28 2012 UTC (11 years, 11 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.

# The LearningOnline Network
#
# $Id: Lond.pm,v 1.1 2012/04/11 21:32:28 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###

#NOTE perldoc at the end of file

package LONCAPA::Lond;

use strict;
use lib '/home/httpd/lib/perl/';

use LONCAPA;
use Apache::lonnet;
use GDBM_File;


sub dump_with_regexp {
    #TODO encapsulate $clientname and $clientversion in a object.
    my ( $cmd, $tail, $clientname, $clientversion ) = @_;

    my $userinput = "$cmd:$tail";

    my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
    if (defined($regexp)) {
	$regexp=&unescape($regexp);
    } else {
	$regexp='.';
    }
    my ($start,$end);
    if (defined($range)) {
	if ($range =~/^(\d+)\-(\d+)$/) {
	    ($start,$end) = ($1,$2);
	} elsif ($range =~/^(\d+)$/) {
	    ($start,$end) = (0,$1);
	} else {
	    undef($range);
	}
    }
    Apache::lonnet::logthis("Lond.pm: udom:[$udom] uname:[$uname] namespace:[$namespace]");
    my $hashref = &tie_user_hash($udom, $uname, $namespace,
				 &GDBM_READER());
    my $skipcheck;
    if ($hashref) {
        my $qresult='';
	my $count=0;
#
# When dump is for roles.db, determine if LON-CAPA version checking is needed.
# Sessions on 2.10 and later will include skipcheck => 1 in extra args ref,
# to indicate no version checking is needed (in this case, checking occurs
# on the server hosting the user session, when constructing the roles/courses 
# screen).
# 
        if ($extra ne '') {
            $extra = &Apache::lonnet::thaw_unescape($extra);
            $skipcheck = $extra->{'skipcheck'};
        }
        my @ids = &Apache::lonnet::current_machine_ids();
        my (%homecourses,$major,$minor,$now);
# 
# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
# version on the server which requested the data. For LON-CAPA 2.9, the  
# client session will have sent its LON-CAPA version when initiating the
# connection. For LON-CAPA 2.8 and older, the version is retrieved from
# the global %loncaparevs in lonnet.pm.
# 
        if (($namespace eq 'roles') && (!$skipcheck)) {
            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)$}) {
                    my $cdom = $1;
                    my $cnum = $2;
                    unless ($skipcheck) {
                        my ($role,$roleend,$rolestart) = split(/\_/,$value);
                        if (!$roleend || $roleend > $now) {
#
# For active course roles, check that requesting server is running a LON-CAPA
# version which meets any version requirements for the course. Do not include
# the role amongst the results returned if the requesting server's version is
# too old.
#
# This determination is handled differently depending on whether the course's 
# homeserver is the current server, or whether it is a different server.
# In both cases, the course's version requirement needs to be retrieved.
# 
                            next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                                                            $minor,\%homecourses,\@ids));
                        }
                    }
                }
            }
	    if ($regexp eq '.') {
		$count++;
		if (defined($range) && $count >= $end)   { last; }
		if (defined($range) && $count <  $start) { next; }
		$qresult.=$key.'='.$value.'&';
	    } else {
		my $unescapeKey = &unescape($key);
		if (eval('$unescapeKey=~/$regexp/')) {
		    $count++;
		    if (defined($range) && $count >= $end)   { last; }
		    if (defined($range) && $count <  $start) { next; }
		    $qresult.="$key=$value&";
		}
	    }
	}
	if (&untie_user_hash($hashref)) {
#
# If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
# version requirements for courses for which the current server is the home
# server permit course roles to be usable on the client server hosting the
# user's session. If so, include those role results in the data returned to  
# the client server.
#
            if (($namespace eq 'roles') && (!$skipcheck)) {
                if (keys(%homecourses) > 0) {
                    $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
                                                   $range,$start,$end,$major,$minor);
                }
            }
	    chop($qresult);
        Apache::lonnet::logthis("Lond.pm: qresult:[$qresult]");
        return $qresult;
        #&Reply($client, \$qresult, $userinput);
	} else {
	    return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
         #&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
		 #     "while attempting dump\n", $userinput);
	}
    } else {
	    return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
    #&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
	#	"while attempting dump\n", $userinput);
    }

    #never get here
    die("SHOULD NOT HAPPEN!");
    return 1;
}

1;

__END__

=head1 NAME

LONCAPA::Lond.pm

=head1 SYNOPSIS

#TODO

=head1 DESCRIPTION

#TODO

=head1 METHODS

=over 4

=item dump_with_regexp( $cmd, $tail, $client )

Dump a profile database with an optional regular expression to match against
the keys.  In this dump, no effort is made to separate symb from version
information. Presumably the databases that are dumped by this command are of a
different structure.  Need to look at this and improve the documentation of
both this and the currentdump handler.

$cmd is the command keyword.

$tail a colon separated list containing

=over 

=item domain

=item user 

identifying the user.

=item namespace    

identifying the database.

=item regexp     

optional regular expression that is matched against database keywords to do
selective dumps.

=item range       

optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.  

=item extra        

optional ref to hash of additional args. currently skipcheck is only key used.   

=back

$client is the channel open on the client.

Returns: 1 (Continue processing).

Side effects: response is written to $client.  

=back

=head1 BUGS

No known bugs at this time.

=head1 SEE ALSO

L<Apache::lonnet>, L<lond>

=cut  

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>