[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--