[LON-CAPA-cvs] cvs: modules /rutgers localenroll.pm

albertel lon-capa-cvs@mail.lon-capa.org
Fri, 19 Jan 2007 05:53:54 -0000


This is a MIME encoded message

--albertel1169186034
Content-Type: text/plain

albertel		Fri Jan 19 00:53:54 2007 EDT

  Added files:                 
    /modules/rutgers	localenroll.pm 
  Log:
  - start at a rutgers localenroll
  
  
--albertel1169186034
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20070119005354.txt"


Index: modules/rutgers/localenroll.pm
+++ modules/rutgers/localenroll.pm
# functions to glue school database system into Lon-CAPA for
# automated enrollment
# $Id: localenroll.pm,v 1.1 2007/01/19 05:53:54 albertel 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/
#
package localenroll;

use strict;
use Net::LDAP;
use Net::LDAPS;
use LONCAPA::Configuration;
use Apache::lonnet;

sub run {
    my ($dom) = @_;
    if ($dom == 'rutgers') {
	return 1;
    }
    return 0;
}

sub fetch_enrollment {
    my ($dom,$affiliatesref,$replyref) = @_;
    if ($dom eq 'rutgers') {
	return &fetch_enrollment_rutgers(@_);
    }
}


sub get_sections {
    my ($coursecode,$dom) = @_;
    if ($dom eq 'rutgers') {
	return &get_sections_rutgers(@_);
    }
    return;
}


sub new_course  {
    my ($course_id,$owner,$dom) = @_;
    if ($dom eq 'rutgers') {
	return &new_course_rutgers(@_);
    }
    return 'ok';
}



sub validate_courseID {
    my ($course_id,$dom) = @_;
    if ($dom eq 'rutgers') {
	return &validate_courseID_rutgers(@_);
    }
    return 'ok';
}

sub create_password {
    my ($authparam,$dom) = @_;
    if ($dom eq 'rutgers') {
	return &create_password_rutgers(@_);
    }
}

sub instcode_format {
    my ($dom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
    if ($dom eq 'rutgers') {
	return &instcode_format_rutgers(@_);
    }
}

sub institutional_photos {
    my ($dom,$crs,$affiliates,$result,$action,$students) = @_;
    if ($dom eq 'rutgers') {
	return &institutional_photos_rutgers(@_);
    }
}

sub photo_permission {
    my ($dom,$perm_reqd,$conditions) = @_;
    if ($dom eq 'rutgers') {
	return &photo_permission_rutgers(@_);
    }
}

sub manager_photo_update {
    my ($dom) = @_;
    if ($dom eq 'rutgers') {
	return &manager_photo_update_rutgers(@_);
    }
}

sub check_section {
    my ($class,$owner,$dom,$dbh) = @_;
    if ($dom eq 'rutgers') {
	return &check_section_rutgers(@_);
    }
    return 'ok';
}

sub instcode_defaults {
    my ($dom,$defaults,$code_order) = @_;
    if ($dom eq 'rutgers') {
	return &instcode_defaults_rutgers(@_);
    }
    return 'ok';
}

# --- general helper routine

sub get_owner {
    my ($dom,$crs) = @_;
    my $owner;
    if (defined($dom) && defined($crs)) {
        my %settings = &Apache::lonnet::get('environment',
					    ['internal.courseowner'],
					    $dom,$crs);
        if ( defined($settings{'internal.courseowner'}) ) {
            $owner = $settings{'internal.courseowner'};
        }
    }
    return $owner;
}


# --- rutgers implementations ---

sub fetch_enrollment_rutgers {
    my ($dom,$affiliatesref,$replyref) = @_;
    my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
 
    my $ldap = &connect_LDAP_rutgers();
    return undef if (!$ldap);
  
    foreach my $crs (sort(keys(%{$affiliatesref}))) {
	my $xmlstem =  $$configvars{'lonDaemons'}.'/tmp/';
	my $pilotcount = 0;
	my $blankcount = 1;
	my $maxtries = 5;
	my $numtries = 0;
	while ( ($numtries < $maxtries) && ($blankcount > 0) ) {
	    ($pilotcount,$blankcount) = 
		&write_class_data_rutgers($ldap,$xmlstem,
					  $affiliatesref->{$crs},
					  $dom,$crs);
	    $numtries++;
	}
	$replyref->{$crs} = $pilotcount;
    }
    &disconnect_LDAP_rutgers($ldap);
    return $dbflag;
}

sub connect_LDAP_rutgers {
    # insert the host name of your ldap server, e.g., ldap.fsu.edu
    my $ldap_host_name = 'ldap.rutgers.edu';
    # insert the ldap certificate filename - include absolute path
    my $ldap_ca_file_name = 
	'/home/httpd/lib/perl/local/rutgersldap.certificate'; 
    # certificate is required if you wish to encrypt the password.
    # e.g., /home/http/perl/lib/local/ldap.certificate
    

    my $ldap = Net::LDAPS->new($ldap_host_name,
			       # 'require' implies that a certificate is needed
			       # else set to 'none' if you do not wish to use
			       # a certificate
			       verify => 'require',
			       cafile => $ldap_ca_file_name,
			       );

    if (! defined($ldap)) {
        return undef;
    } 
    $ldap->bind;

    return $ldap;
}

sub disconnect_LDAP_rutgers {
    my ($ldap) = @_;
    $ldap->unbind;
    $ldap->disconnect;
}

sub write_class_data_rutgers {
    my ($ldap,$xmlstem,$coursesref,$dom,$crs) = @_;
    $xmlstem .= $dom."_".$crs."_";
    my $count = 0;
    my $blank = 0;
    my $owner = &get_owner($dom,$crs);
    foreach my $class (@{$coursesref}) {
	next if (&check_section_rutgers($class,$owner,$dom,$ldap) ne 'ok');
	my $xmlfile = $xmlstem.$class."_classlist.xml";
	open(FILE, ">$xmlfile");
	print FILE qq|<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE text>
<students>
|;
	my $ldap_search_base = 'ou=people,dc=rutgers,dc=edu';
	# ldap search base, at fsu this is set to 'o=fsu.edu'.

	my $mesg = $ldap->search(base   =>  $ldap_search_base,
				 filter =>
				     "rulinkRutgersEduStudentCourseReg=$class",
				 attrs => 
				     ['rutgersEduRUID','uid','sn','givenName'],
				 );
	my $max = $mesg->count; 

	for (my $index = 0; $index < $max; $index++)  {
	    $count++;
	    my $entry = $mesg->entry($index);
	    my $first = $entry->get_value('givenName');
	    my $last  = $entry->get_value('sn');
	    my $uname = $entry->get_value('uid');
	    my $pid   = $entry->get_value('rutgersEduRUID');
	    print FILE qq| <student username="$uname">
  <autharg>rutgers</autharg>
  <authtype>localauth</authtype>
  <email></email>
  <enddate></enddate>
  <firstname>$first</firstname>
  <generation></generation>
  <groupID>$class</groupID>
  <lastname>$last</lastname>
  <middlename></middlename>
  <startdate></startdate>
  <studentID>$pid</studentID>
 </student>
|;
	}
	print FILE qq|</students>|;
	close(FILE);
    }
    return ($count,$blank);
}

#FIXME can we get section numbers from ldap?
sub get_sections_rutgers {
    my ($coursecode,$dom) = @_;
}

sub new_course_rutgers {
    my ($instcode,$owner,$dom) = @_;
    if ($owner eq '') {
        return "Inclusion of enrollment could not be established for the course section $instcode because no owner was provided for this LON-CAPA course.";
    } 

    ($owner,$ownerdom) =~ /^([^:]+):([^:]+)$/) {
    if ($ownerdom ne $dom) {
	return "Inclusion of enrollment could not be established for the course section $instcode because the course owner is in a different domain ($ownerdom) from the course ($dom).";
    }
    if ($owner =~ /\W/) {
	return "Inclusion of enrollment could not be established for the course section $course_id because the username of the owner contains invalid characters.";
    }
    return 'ok';
}

sub create_password_rutgers {
    my ($authparam,$dom) = @_;
    my $authchk = 'ok';
    my $create_passwd = 0;
    return ($authparam,$create_passwd,$authchk);
}

#FIXME   year:semester:unit:curriculum:course:section:supplement
#        2003:1:01:198:323:01
# what is a unit? what is a curriculm? How to turn numbers into
# descriptions?

sub instcode_format_rutgers {
    my ($dom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
    @{$codetitles} = ("Year","Semester","Unit","Number");
    $cat_titles->{'Semester'} = { 9 => 'Fall',
				  1 => 'Spring',
				  7 => 'Summer'
				  };
    $cat_order->{'Semester'} = ['1','7','9'];
    foreach my $cid (keys(%{$instcodes})) {
	my ($year,$semester,$unit,$curriculm,$course,$section,$supplement) =
	    split(':',$instcodes->{$cid});
	$codes->{$cid}{'Semester'} = $semester;
	# FIXME unit Curriculm ? numbers? how to get them into text
	$codes->{$cid}{'Unit'}     = $unit;
	$codes->{$cid}{'Number'}   = $course;
	$codes->{$cid}{'Year'}     = $year;
	if (!defined($cat_titles->{'Year'}{$year})) {
	    $cat_titles{'Year'}{$year} = $year;
	}
    }
    return 'ok';
}

#FIXME need to disable
sub institutional_photos_rutgers {
    my ($dom,$crs,$affiliates,$result,$action,$students) = @_;
}

#FIXME need to disable
sub photo_permission_rutgers {
    my ($dom,$perm_reqd,$conditions) = @_;
}

#FIXME need to disable
sub manager_photo_update_rutgers {
    my ($dom) = @_;
}

# FIXME anyway to discover if the set owner is 'instructor of record'?
sub check_section_rutgers {
    my ($class,$owner,$dom,$ldap) = @_;
    return 'ok';
}

#FIXME  not sure how to deal with the : in the course code
sub instcode_defaults_rutgers {
    my ($dom,$defaults,$code_order) = @_;
    #year:semester:unit:curriculum:course:section:supplement;
    @{$code_order} = ('Year','Semester','Unit','Curriculm','Number');
    $defaults->{'Year'} = '^\d{4}'
        'Year' => '\d{2}',
        'Semester' => '^[sfu]s', 
        'Department' => '\w{2,3}',
        'Number' => '\d{3,4}\w?',
     );
}


###############################
# sub AUTOLOAD
#
# Incoming data: none
# Returns ''
#
# Prevents errors when undefined subroutines are called in this package
# Will allow new routines added in the future to be called from lond etc.
# without the need for customized versions of local*.pm packages to be
# modified to include the new subroutines immediately.
#
# See "Programming Perl" 3rd ed. pp 296-298.
###############################

sub AUTOLOAD {
    our $AUTOLOAD;
    return '';
}

1;

--albertel1169186034--