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

raeburn raeburn at source.lon-capa.org
Mon Mar 5 20:37:12 EST 2012


raeburn		Tue Mar  6 01:37:12 2012 EDT

  Added files:                 
    /modules/MIT	localenroll.pm 
  Log:
  - Start on customization of localenroll.pm for MIT environment.
    - Directory search via LDAP
    - User information for indovdual users via LDAP
    - Institutional status types defined: faculty, staff, student, affiliate
  
  
-------------- next part --------------

Index: modules/MIT/localenroll.pm
+++ modules/MIT/localenroll.pm
# functions to glue school database system into Lon-CAPA for 
# automated enrollment
# $Id: localenroll.pm,v 1.1 2012/03/06 01:37:12 raeburn 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/
#

=pod

=head1 NAME

localenroll

=head1 SYNOPSIS

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.


=head1 NOTABLE SUBROUTINES

=over

=cut

package localenroll;

use strict;
use Net::LDAP;

=pod
 
=item run()
 set this to return 1 if you want the auto enrollment to run

 Beginning with LON-CAPA version 2.4, use of this routine is
 deprecated.  Whether or not Autoenroll.pl should run is set
 by the Domain Coordinator via "Set domain configuration",
 provided in the Domain Management section of the Main menu. 

=cut

sub run() {
    my $dom = shift;
    return 0;
}


=pod

=item fetch_enrollment()

 connects to the institutional classlist data source,
 reads classlist data and stores in an XML file
 in /home/httpd/perl/tmp/

 classlist files are named as follows:

 DOMAIN_COURSE_INSTITUTIONALCODE_classlist.xml

 e.g., msu_43551dedcd43febmsul1_fs03nop590001_classlist.xml
 where DOMAIN = msu  COURSE = 43551dedcd43febmsul1 
 INSTITUTIONALCODE = fs03nop590001 
 (MSU's course naming scheme - fs03 = Fall semester 2003, nop =
 department name, 590 = course number, 001 = section number.)

 fetch_enrollment requires three arguments -
 $dom - DOMAIN e.g., msu
 $affiliatesref - a reference to a hash of arrays that contains LON-CAPA 
 courses that are to be updated as keys, and institutional coursecodes 
 contributing enrollment to that LON-CAPA course as elements in each array.
 $replyref - a reference to a hash that contains LON-CAPA courses
 that are to be updated as keys, and the total enrollment count in all 
 affiliated sections, as determined from institutional data as hash elements. 

 As an example, if fetch_enrollment is called to retrieve institutional
 classlists for a single LON-CAPA course - 43551dedcd43febmsul1 which 
 corresponds to fs03nop590, sections 001, 601 and 602 , and the course
 also accommodates enrollment from a crosslisted course in the ost
 department - fs03ost580002:

 the affiliatesref would be a reference to %affiliates which would be:

 @{$affiliates{'43551dedcd43febmsul1'}} =
   ("fs03nop590001","fs03nop590601","fs03nop590602","fs03ost580002");

 fetch_enrollment would create four files in /home/httpd/perl/tmp/.
 msu_43551dedcd43febmsul1_fs03nop590001_classlist.xml
 msu_43551dedcd43febmsul1_fs03nop590601_classlist.xml
 msu_43551dedcd43febmsul1_fs03nop590602_classlist.xml
 msu_43551dedcd43febmsul1_fs03ost580002_classlist.xml

 In each file, student data would be stored in the following format
 
 <student username="smith">
  <autharg>MSU.EDU</autharg>
  <authtype>krb4</authtype>
  <email>smith at msu.edu</email>
  <enddate></enddate>
  <firstname>John</firstname>
  <generation>II</generation>
  <groupID>fs03nop590001</groupID>
  <lastname>Smith</lastname>
  <middlename>D</middlename>
  <startdate></startdate>
  <studentID>A12345678</studentID>
 </student>
 
 with the following at the top of the file
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE text>
<students>

 (all comment - s removed)

 and a closing:
</students>

 The <startdate> and the <enddate> are the activation date and expiration date
 for this student's role. If they are absent, then the default access start and
 default access end dates are used. The default access dates can be set when 
 the course is created, and can be modified using the Automated Enrollment
 Manager, or via the 'Upload a class list','Enroll a single student' or 
 'Modify student data' utilities in the Enrollment Manager, by checking the 
 'make these dates the default for future enrollment' checkbox. If no default 
 dates have been set, then the tudent role will be active immediately, and will 
 remain active until the role is explicitly expired using ENRL -> Drop students. 
 If dates are to included in the XML file, they should be in the format
 YYYY:MM:DD:HH:MM:SS (: separators required).

 If there were 10 students in fs03nop590001, 5 students in fs03nop59o601, 
 8 students in fs03nop590602, and 2 students in fs03ost580002,
 then $$reply{'43551dedcd43febmsul1'} = 25

 The purpose of the %reply hash is to detect cases where the institutional 
 enrollment is 0 (most likely due to a problem with the data source).
 In such a case, the LON-CAPA course roster is left unchanged (i.e., no
 students are expired, even if automated drops is enabled.
 
 fetch_enrollment should return a 0 or 1, depending on whether a connection
 could be established to the institutional data source.
 0 is returned if no connection could be made.
 1 is returned if connection was successful

 A return of 1 is required for the calling modules to perform LON-CAPA
 roster changes based on the contents of the XML classlist file(s), e,g,,
 msu_43551dedcd43febmsul1_fs03nop590001_classlist.xml

 XML classlist files are temporary. They are deleted after the enrollment 
 update process in the calling module is complete.


=cut

sub fetch_enrollment {
    my ($dom,$affiliatesref,$replyref) = @_;
    foreach my $crs (sort keys %{$affiliatesref}) {
        $$replyref{$crs} = 0;
    }
    my $okflag = 0;
    return $okflag;
}

=pod

=item get_sections()

 This is called by the Automated Enrollment Manager interface
 (lonpopulate.pm) to create an array of valid sections for 
 a specific institutional coursecode.
 e.g., for MSU coursecode: fs03nop590
 ("001","601","602") would be returned

 If the array returned contains at least one element, then 
 the interface offerred to the course coordinator, lists
 official sections and provides a checkbox to use to
 select enrollment in the LON-CAPA course from each official section.  

 get_sections takes two arguments - (a) the institutional coursecode
 (in the MSU case this is a concatenation of semester code, department
 and course number), and (b) the LON-CAPA domain that contains the course. 
 
 If there is no access to official course sections at your institution,
 then an empty array is returned, and the Automated Enrollment Manager
 interface will allow the course coordinator to enter section numbers
 in text boxes.
 


=cut

sub get_sections {
    my ($coursecode,$dom) = @_;
    my @secs = ();
    return @secs;
}

=pod

=item new_course()

 This is called by loncreatecourse.pm and 
 lonpopulate.pm to record that fact that a new course section
 has been added to LON-CAPA that requires access to institutional data
 At MSU, this is required, as institutional classlists can only made
 available to faculty who are officially assigned to a course.
 
 The new_course subroutine is used to check that the course owner
 of the LON-CAPA course is permitted to access the institutional
 classlist for any course sections and crosslisted classes that
 the course coordinator wishes to have affiliated with the course.
 
 If access is permitted, then 'ok' is returned.
 The course section or crosslisted course will only be added to the list of
 affiliates if 'ok' is returned.

 new_course takes three required arguments -
 (a) the institutional courseID (in the MSU case this is a concatenation of 
 semester code, department code, course number, and section number
 e.g., fs03nop590001).
 (b) the course owner. This is the LON-CAPA username and domain of the course 
 coordinator assigned to the course when it is first created, in the form
 username:domain
 (c) the LON-CAPA domain that contains the course

 new_course also takes a fourth (optional) argument -
 (d) the course co-owners, as a comma-separated list of username:domain for
 any co-owners. 

=cut

sub new_course  {
    my ($course_id,$owner,$dom,$coowners) = @_;
    my $outcome = 'ok';
    return $outcome;
}

=pod

=item validate_courseID()

 This is called whenever a new course section or crosslisted course
 is being affiliated with a LON-CAPA course (i.e., by loncreatecourse.pm
 and the Automated Enrollment Manager in lonpopulate.pm).
 A check is made that the courseID that the course coordinator wishes
 to affiliate with the course is valid according to the institutional
 schedule of official classes 

 A valid courseID is confirmed by returning 'ok'

 validate_courseID takes two arguments -
 (a) the institutional courseID (in the MSU case this is a concatenation of
 semester code, department code, course number, and section number
 e.g., fs03nop590001).
 (b) the LON-CAPA domain that contains the course

=cut  

sub validate_courseID {
    my ($course_id,$dom) = @_;
    my $outcome = 'ok';
    return $outcome;   
}

=pod

=item validate_instcode()

This is called when a request is being made for an official course.
A check is made that the institutional code for which a course is
is being requested is valid according to the institutional
schedule of official classes.

If the username of the course owner is provided, a more restrictive
test is used, namely that the requestor is listed as instructor of
record for the course in the institution's course schedule/database.

validate_instcode takes three arguments -
 (a) the LON-CAPA domain that will contain the course
 (b) the institutional code (in the MSU case this is a concatenation of
 semester code, department code, and course number, e.g., fs03nop590.
 (c) an optional institutional username for the course owner.

An array is returned containing (a) the result of the check for a valid 
instcode, and (b) an (optional) course description.   
A valid instcode is confirmed by returning 'valid'.
If no course description is available, '' should be set as
the value of the second item in the returned array.

=cut

sub validate_instcode {
    my ($dom,$instcode,$owner) = @_;
    my $outcome = '';
    my $description = '';
    return ($outcome,$description);
}

=pod

=item validate_crsreq()

This is used to check whether a course request should be processed
automatically, or held in a queue pending administrative action at
the institution.

Course requests will trigger this check if the process type has been set 
to 'validate' for the course type (official, unofficial or community) and
the requestor's affiliation.  Whether "validate" is an available option
in the Domain Configuration menu is controlled by auto_courserequest_checks(). 
One scenario is where the request is for an official course, in which case
a check could be made that the requestor is listed as instructor of 
record for the course in the institution's course schedule/database.

Other scenarios are possible, and the routine can be customized according
to whatever rules a domain wishes to implement to run validations against
given the data passed in to the routine.

validate_crsreq takes six arguments -
 (a) the LON-CAPA domain that will contain the course.
 (b) the username:domain for the course owner.
 (c) the course type (official, unofficial or community)
 (d) a comma-separated list of institutional affiliations of 
     the course owner.
 (e) the institutional code (in the MSU case this is a concatenation of
 semester code, department code, and course number, e.g., fs03nop590.
 (f) a comma-separated list of institutional sections included in
     the course request (only applicable to official courses).

A valid courserequest is confirmed by returning 'process'.
The following can be returned: process, rejected, pending, approval or error (with error condition - no :), followed by a : and then an optional message. 

(a) process  - the requestor is the recorded instructor - create the course
(b) rejected - the requestor should never be requesting this course, reject the
    request permanently
(c) pending - the requestor is not the recorded instructor, but could
    become so after administrative action at the institution. Put the
    request in a queue and check localenroll:validate_instcode()
    periodically until the status changes to "valid".
(d) approval - the request will be held pending review by a Domain Coordinator.
(e) error (followed by the error condition).

=cut

sub validate_crsreq {
    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_;
    my $outcome = 'approval';
    return $outcome;
}

=pod 

=item crsreq_checks()

This is used to determine whether the "validate" option should appear in the
possible choices for course request processing in the Domain Configuration 
menu for Course Requests. Ultimately it is called by domainprefs.pm (via: 
lonnet -> lond -> localenroll.pm) The domain configuration menu includes 
a table where columns are course type (official, unofficial or community) 
and rows are institutional affiliations (e.g., Faculty, Staff, Student etc.).

crsreq_checks() takes three arguments: $dom, $reqtypes, $validations.
$dom - the domain for which validation options are needed.
$reqtypes - ref to an ARRAY of course types (i.e., official, unofficial and community.
$validations - ref to a hash of a hash which will determine whether "validate"
will be one of the possible choices for each course type (outer hash key),
and institutional type (inner hash key).

For example to allow validate to be a choice for official classes for Faculty,
req_checks would include:

$validations{'official'}{'Faculty'} = 1;

This routine is closely tied to validate_crsreq(). "Validate" should not be
a possible choice in the domain configuration menu for a particular course
type/institutional affiliation, unless a corresponding validation code has
been implemented in validate_crsreq().

For example at MSU, official courses requested by Faculty will be validated
against the official schedule of classes to check that the requestor is one
of the instructors of record for the course.  In this case validate_crsreq()
includes a call to validate_instcode().

=cut

sub crsreq_checks {
    my ($dom,$reqtypes,$validations) = @_;
    if ((ref($reqtypes) eq 'ARRAY') && (ref($validations) eq 'HASH')) {
        my (%usertypes, at order);
        if (&inst_usertypes($dom,\%usertypes,\@order) eq 'ok') {
            foreach my $type (@{$reqtypes}) {
                foreach my $inst_type (@order) {
                    if (($type eq 'official') && ($inst_type eq 'faculty')) {
                        $validations->{$type}{$inst_type} = 1;
                    } else {
                        $validations->{$type}{$inst_type} = '';
                    }
                }
            }
        }
    }
    return 'ok';
}

=pod

=item create_password()

 This is called when the authentication method set for the automated 
 enrollment process when enrolling new users in the domain is "localauth".
 This could be signalled for the specific user by the value of localauth
 for the <authtype> tag from the classlist.xml files, or if this is blank,
 the default authtype, set by the domain coordinator when creating the course
 with loncreatecourse.pm.
  
 create_password takes three arguments -
 (a) $authparam - the value of <autharg> from the classlist.xml files,
 or if this blank, the default autharg, set by the domain coordinator when 
 creating the course with loncreatecourse.pm
 (b) $dom - the domain of the new user.
 (c) $username - the username of the new user (currently not actually used)

 Four values are returned:
 (a) the value of $authparam - which might have been changed
 (b) a flag to indicate whether a password had been created
 0 means no password created
 1 means password created.  In this case the calling module - Enrollment.pm
 will send the LON-CAPA username and password to the new user's e-mail
 (if one was provided), or to the course owner (if one was not provided and
 the new user was created by the automated process), or to the active
 course coordinator (if the new user was created using the 'update roster
 now' interface included in the Automated Enrollment Manager).  
 (c) a flag to indicate that the authentication method is correct - 'ok'.
 If $authchk is not set to 'ok' then account creation and enrollment of the 
 new user will not occur.
 (d) if a password was created it can be sent along.  This is the password 
 which will be included in the e-mail sent to the new user, or made available    
 to the course owner/course coordinator if no e-mail address is provided. If
 you do not wish to send a password, but want to give instructions on obtaining
 one, you could set $newpasswd as those instructions. (e.g.,
 $newpasswd = '(Please visit room 212, ACNS Bldg. to obtain your password)';
 The value of $newpasswd is NOT written in the user's LON-CAPA passwd file in
 /home/httpd/lonUsers/$dom/a/b/c/abcuser/passwd, which in the case of a user
 employing localauth will contain 'localauth:$authparam'.  If you need to include
 a parameter in the user's passwd file, you should return it as $authparam,
 i.e., the first of the variables returned by create_password().             


=cut 

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

=pod

=item instcode_format()

 Split coursecodes into constituent parts.   
 e.g., INSTITUTIONALCODE = fs03nop590, LON-CAPA COURSEID: 43551dedcd43febmsul1
 (MSU's course naming scheme - fs03 = Fall semester 2003, nop =
 department name, 590 = course number)

 Incoming data:
 $dom (domain)
 $$instcodes{'43551dedcd43febmsul1'} = 'fs03nop590' (hash of courseIDs)
 
 fs03nop590 would be split as follows
 @{$codetitles} = ("year","semester","department","number")
 $$codes{'year'} = '2003'
 $$codes{'semester'} = 'Fall'
 $$codes{'department'} = 'nop'
 $$codes{'number'} = '590'

 requires six arguments:
 domain ($dom)
 reference to hash of institutional course IDs ($instcodes)  
 reference to hash of codes ($codes)
 reference to array of titles ($codetitles)
 reference to hash of abbreviations used in categories
 reference to hash of arrays specifying sort order used in category titles   

 e.g.,     %{$$cat_titles{'Semester'}} = (
                   fs => 'Fall',
                   ss => 'Spring',
                   us => 'Summer');

 e.g., @{$$cat_order{'Semester'}} = ('ss','us','fs'); 
 returns 1 parameter: 'ok' if no processing errors. 

 Detailed help:
 http://yourloncapaserver/adm/help/Institutional_Integration_Course_Codes.hlp

=cut


sub instcode_format () {
    my ($dom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
    my $outcome = 'ok';
    return $outcome;
}

=pod

=item possible_instcodes()

Gather acceptable values for institutional categories to use in course creation request form for official courses.

 requires five arguments:

 domain ($dom)
 reference to array of titles ($codetitles)
 reference to hash of abbreviations used in categories ($cat_titles).
 reference to hash of arrays specifying sort order used in 
           category titles ($cat_order).
 reference to array which will contain order of component parts used 
           in institutional code ($code_order).

 e.g., 
 @{$codetitles} = ('Year','Semester',"Department','Number');

 %{$$cat_titles{'Semester'}} = (
                   fs => 'Fall',
                   ss => 'Spring',
                   us => 'Summer');

 @{$$cat_order{'Semester'}} = ('ss','us','fs');
 @{$code_order} = ('Semester','Year','Department','Number');

 returns 1 parameter: 'ok' if no processing errors.

=cut

sub possible_instcodes {
    my ($dom,$codetitles,$cat_titles,$cat_order,$code_order) = @_;
    @{$codetitles} = ();
    %{$$cat_titles{'Semester'}} = ();
    @{$$cat_order{'Semester'}} = ('ss','us','fs');
    @{$code_order} = ();
    return 'ok';
}


=pod

=item institutional_photos()

 Called when automated enrollment manager is used to update student photos.

 Incoming data: six arguments
 (a) $dom (domain)
 (b) $crs (LONCAPA course number)
 (c) $affiliates: a reference to a hash with the keys set to the 
 institutional course IDs for the course.
 (d) $result: a reference to a hash which will return usernames  
     of students (& separated) in following categories (the keys):
     new, update, missing, same, deleted, noid, nouser. The list 
     includes those students for whom the result of the modification 
     process was either addition of a new photo. update of an
     existing photo, photo was found to be missing from institution's
     data store, photo used is same as before, or photo was 
     deleted from storage on LON-CAPA server housing student's
     information, no student/employee ID was available. 
               
 (e) $action: the type of action needed. (e.g., update, delete);
 (f) $students: a reference to a hash with the keys set to student 
 usernames and domains in the form username:domain, and values set
 to the studentID, if action is required for specific students.  

 returns 1 parameter: 'ok' if no processing errors.
 other course or student specific values can be stored as values
 in the appropriate referenced hashes. 

=cut

sub institutional_photos {
    my ($dom,$crs,$affiliates,$result,$action,$students) = @_;
    my $outcome = 'ok';
    return $outcome;
}

=pod

=item photo_permission()

 Incoming data: three arguments
 (a) $dom (domain)
 (b) $perm_reqd: a reference to a a scalar that is either 'yes'
 if a course owner must indicate acceptance of conditions of use,
 'no' otherwise.
 (c) $conditions: the text of the conditions of use.
    
 returns 1 parameter: 'ok' if no processing errors.
 $$perm_reqd is set to 'yes' or 'no'
 $$agreement is set to conditions of use - plain text string
             which will be displayed in a textarea in a web form.


=cut

sub photo_permission {
   my ($dom,$perm_reqd,$conditions) = @_;
   $$perm_reqd = 'no';
   $$conditions = '';
   my $outcome = 'ok';
   return $outcome;
}

=pod

=item manager_photo_update()

 Incoming data: one argument
 (a) $dom (domain)

 returns 2 parameters: update (0 or 1), and comment.
 Called by automated enrollment manager, to determine 
 whether "Update Student photos" button will be available,
 and if so, the message (plain text string) that will be displayed
 with the button. 


=cut
                                                                                        
sub manager_photo_update {
    my ($dom) = @_;
    my $update = 0;
    my $comment = '';
    return ($update,$comment);
}

=pod


=item check_section()

 Incoming data: three arguments (+ fourth optional argument)
 (a) $class - institutional class id (coursecode concatanated with section) 
 (b) $owner - course owner (2.2 and later username:domain; pre-2.2 username;
                            2.6 and later - comma-separated list of 
                            username:domain for course owner and co-owners.)
 (c) $dom - domain of course
 (d) $dbh - optional database handle

 returns 1 parameter - $sectioncheck ('ok' or other value). 
 Verifies that at least one of the course owner (or co-owners) have access 
 to classlist for specific class according to institution's SIS
 'ok' if access available  


=cut

sub check_section {
    my ($class,$owner,$dom,$dbh) = @_;
    my $sectioncheck = 'ok';
    return $sectioncheck;
}

=pod

=item instcode_defaults()

 Incoming data: three arguments
 (a) $dom - domain
 (b) $defaults - reference to hash which will contain default regular
                 expression matches for different components of an 
                 institutional course code 
 (c) $code_order - reference to array which will contain order of 
                   component parts used in institutional code.  

 returns 1 parameter - ('ok' or other value).
 Used to construct a regular expression to be used when searching for
 courses based on fragments of an institutional code.
 $defaults contains defaults to use for each component, and code_order
 contains keys of hash in order in which they are to be concatenated.

 e.g., INSTITUTIONALCODE = fs03nop590
 (MSU's course naming scheme - fs  = semester, 03 = year, nop =
 department name, 590 = course number)

     %{$defaults} = (
        'Year' => '\d{2}',
        'Semester' => '^[sfu]s', 
        'Department' => '\w{2,3}',
        'Number' => '\d{3,4}\w?',
     );

     @{$code_order} = ('Semester','Year','Department','Number');

 Detailed help:
 http://yourloncapaserver/adm/help/Institutional_Integration_Course_Codes.hlp

=cut

sub instcode_defaults {
    my ($dom,$defaults,$code_order) = @_;
    return 'ok';
}


=pod

=item allusers_info()

 Incoming data: three arguments
 (a) $dom - domain
 (b) $instusers - reference to hash which will contain hashes, 
                 where keys will be usernames and value will be a 
                 hash of user information. Keys in the inner hash 
                 will be some or all of: lastname,firstname,
                 middlename, generation, id, inststatus - 
                 institutional status (e.g., faculty,staff,student)
                 Values are all scalars except inststatus,
                 which is an array.
 (c) $instids - reference to hash which will contain ID numbers. 
                keys will be unique IDs (student or faculty/staff ID)
                values will be either: scalar (username) or an array 
                if a single ID matches multiple usernames.
 (d) $lc_users - reference to hash containing LON-CAPA usernames in 
                 in domain $dom, as keys. Needed if institutional
                 data source only allows query by username.
 returns 1 parameter - 'ok' if no processing error, or other value 
                       if an error occurred.
 side effects - populates the $instusers and $instids refs to hashes.
                with information for all users from all available 
                institutional datafeeds.


=cut

sub allusers_info {
    my ($dom,$instusers,$instids,$lc_users) = @_;
    my $outcome = 'ok';
    return $outcome; 
}

=pod

=item get_userinfo()

 Incoming data: four required arguments and additional optional arguments
 Two modes of operation:
 (1) Retrieves institutional data for a single user either by username
     if $uname is included as second argument, or by ID if $id is 
     included as a third argument.  Either (b) or (c) must be provided.
     (g), (h) and (i) will be undefined.
 (2) Retrieves institutional user data from search of an institutional
     directory based on a search. (g) and (h) are required.
     (i) is optional. (b) and (c) will be undefined. 

 (a) $dom - domain
 (b) $uname - username of user
 (c) $id - student/faculty ID of user
 (d) $instusers - reference to hash which will contain info for user
                 as key = value; keys will be one or all of:
                 lastname,firstname,middlename,generation,id,inststatus -
                 institutional status (e.g., faculty,staff,student)
                 Values are all scalars except inststatus,
                 which is an array.
 (e) $instids - reference to hash which will contain ID numbers - 
                 keys will be unique IDs (student or faculty/staff ID)  
                 values will be either: scalar (username) or an array
                 if a single ID matches multiple usernames.
 (f) $types - optional reference to array which contains 
              institutional types to check.
 (g) $srchby - optional if $uname or $id defined, otherwise required.
               Allowed values include: 1. lastfirst, 2. last, 3. uname
               corresponding to searches by 1. lastname,firstname;
               2. lastname; 3. username
 (h) $srchterm - optional if $uname or $id defined, otherwise required
                String to search for.
 (i) $srchtype - optional. Allowed values: contains, begins (defaults
                to exact match otherwise).

 returns 1 parameter - 'ok' if no processing error, or other value 
                       if an error occurred.
 side effects - populates the $instusers and $instids refs to hashes.
                with information for specified username, or specified
                id, if fifth argument provided, from all available, or 
                specified (e.g., faculty only) institutional datafeeds,
                if sixth argument provided.

 WARNING: You need to set $outcome to 'ok' once you have customized
          this routine to communicate with an instititional 
          directory data source, otherwise institutional directory 
          searches will always be reported as being unavailable
          in domain $dom.

=cut

sub get_userinfo {
    my ($dom,$uname,$id,$instusers,$instids,$types,
        $srchby,$srchterm,$srchtype) = @_;
    my $outcome;
    if ($srchby eq '' && $srchterm eq '') {
        if ($uname ne '') {
            $srchby = 'uname';
            $srchterm = $uname;
        } elsif ($id ne '') {
            $srchby = 'id';
            $srchterm = $id;
        }
    }
    if ($srchterm ne '') {
        $outcome = &query_user_tables($instusers,$instids,$srchby,
                                      $srchterm,$srchtype,$types);
    }
    return $outcome;
}

sub query_user_tables {
    my ($instusers,$instids,$srchby,$srchterm,$srchtype,$types) = @_;
    my ($outcome,$condition,%multipids,$ldapfilter);
    if ($srchby eq 'uname') {
        if ($srchterm =~ /^\w{2,8}$/) {
            if ($srchtype eq 'contains') {
                $ldapfilter = '(uid=*'.$srchterm.'*)';
            } elsif ($srchtype eq 'begins') {
                $ldapfilter = '(uid='.$srchterm.'*)';
            } else {
                $ldapfilter = '(uid='.$srchterm.')';
            }
        }
    } elsif ($srchby eq 'lastname') {
        if ($srchterm =~ /[A-Za-z\-\.'\s]+/) {
            if ($srchtype eq 'contains') {
                $ldapfilter = '(sn=*'.$srchterm.'*)';
            } elsif ($srchtype eq 'begins') {
                $ldapfilter = '(sn='.$srchterm.'*)';
            } else {
                $ldapfilter = '(sn='.$srchterm.')';
            }
        }
    } elsif ($srchby eq 'lastfirst') {
        my ($srchlast,$srchfirst) = split(/,/,$srchterm);
        $srchlast =~ s/\s+$//;
        $srchfirst =~ s/^\s+//;
        if (($srchlast =~ /[A-Za-z\-\.'\s]+/) &&
            ($srchfirst  =~ /[A-Za-z\-\.'\s]+/)) {
            my ($quoted_first,$quoted_last);
            if ($srchtype eq 'contains') {
                $ldapfilter = '(&(sn=*'.$srchlast.'*)(givenName=*'.$srchfirst.'*))';
            } elsif ($srchtype eq 'begins') {
                $ldapfilter = '(&(sn='.$srchlast.'*)(givenName='.$srchfirst.'*))';
            } else {
                $ldapfilter = '(&(sn='.$srchlast.')(givenName='.$srchfirst.'))';
            }
        }
    }
    if ($ldapfilter ne '') {
        $outcome = &ldap_search($ldapfilter,$instusers,$types);
    }
    return $outcome;
}

sub ldap_search {
    my ($ldapfilter,$instusers,$types) = @_;
    my $outcome;
    my $ldap = Net::LDAP->new( 'ldap.mit.edu' );
    if ($ldap) {
        $ldap->bind;
        my $mesg = $ldap->search(
                            base   => "dc=mit, dc=edu",
                            filter => $ldapfilter,
                            attrs  => ['sn','givenName','title','uid','mail','eduPersonAffiliation'],
                          );
        if ($mesg->code) {
            $ldap->unbind;
            return;
        } else {
            $outcome = 'ok';
        }
        foreach my $entry ($mesg->entries) {
            my $uname = $entry->get_value('uid');
            next if ($uname eq '');
            my $given = $entry->get_value('givenName');
            $given =~ s/^\s+//;
            my ($first,$middle);
            if ($given =~ m/\w\s+\w/) {
                $first = substr($given,0,index($given," "));
                $middle = substr($given,index($given," ")+1);
                $middle =~ s/^\s+//g;
                $middle =~ s/\s+$//g;
            } else {
                $first = $given;
            }
            $first =~ s/\s+$//;
            my $last = $entry->get_value('sn');
            my $email = $entry->get_value('mail');
            my $type = $entry->get_value('eduPersonAffiliation');
            if ($type eq 'staff') {
                if ($entry->get_value('title') =~ /Professor/) {
                    $type = 'faculty';
                }
            }
            if (ref($types) eq 'ARRAY') {
                if (@{$types} > 0) {
                    if (($type ne '') && !(grep(/^$type$/,@{$types}))) {
                        next if (!grep(/^default$/,@{$types}));
                    }
                    next if (($type eq '') && (!grep(/^default$/,@{$types})));
                }
            }
            if (ref($instusers->{$uname}) eq 'HASH') {
                if (ref($instusers->{$uname}{'inststatus'}) eq 'ARRAY') {
                    if (!grep(/^$type$/,@{$instusers->{$uname}{'inststatus'}})) {
                        push(@{$instusers->{$uname}{'inststatus'}},$type);
                    }
                }
            } else {
                $instusers->{$uname} = {firstname      => $first,
                                        middlename     => $middle,
                                        lastname       => $last,
                                        id             => '',
                                        permanentemail => $email,
                                        inststatus     => [$type],
                                     };
            }
        }
        $ldap->unbind;
    }
    return $outcome;
}

=pod

=item inst_usertypes() 

 Incoming data: three arguments
 (a) $dom - domain
 (b) $usertypes - reference to hash which will contain 
                 key = value, where keys are institution 
                 affiliation types (e.g., Faculty, Student etc.)
                 and values are titles (e.g., Faculty/Academic Staff)
 (c) $order - reference to array which will contain the order in
              which institutional types should be shown
              when displaying data tables (e.g., default quotas    
              or updateable user fields (see domainprefs.pm) 
 returns 1 parameter - 'ok' if no processing error, or other value 
                        if an error occurred.


=cut

sub inst_usertypes {
    my ($dom,$usertypes,$order) = @_;
    @{$order} = ();
    %{$usertypes} = ();
    my $outcome = 'ok';
    %{$usertypes} = (
                  faculty   => 'Faculty',
                  staff     => 'Staff',
                  student   => 'Student',
                  affiliate => 'Affiliate',
                 );
    @{$order}=('faculty','staff','student','affiliate');
    return $outcome;
}

=pod

=item username_rules()

 Incoming data: three arguments 
 (a) $dom - domain
 (b) $ruleshash - reference to hash containing rules
                  (a hash of a hash)
                  keys of top level hash are short names  
                   (e.g., netid, noncredit) 
                  for each key, value is a hash
                      desc => long name for rule  
                      rule => description of rule
                      authtype => (krb5,krb4,int, or loc)
                                 authentication type for rule 
                      authparm => authentication parameter for rule
                      authparmfixed => 1 if authparm used when
                          creating user for rule must be authparm  
                      authmsg => Message to display describing 
                                 authentication to use for this rule

 (c) $rulesorder - reference to array containing rule names 
                   in order to be displayed


  returns 'ok' if no processing error.

=cut

sub username_rules {
    my ($dom,$ruleshash,$rulesorder) = @_;
    %{$ruleshash} = (
                  MITid => {
                              name     => 'MIT username',
                              desc     => 'Eight characters or less',
                              authtype => 'krb5',
                              authparm => 'ATHENA.MIT.EDU',
                              authparmfixed => '',
                              authmsg       => 'A new user with a username which matches a valid MIT username will log-in using the MIT username and password.',
                           },
                 );
    @{$rulesorder} = ('MITid');
    my $outcome = 'ok';
    return $outcome;
}

=pod

=item id_rules()

 Incoming data: three arguments
 (a) $dom - domain
 (b) $ruleshash - reference to hash containing rules
                  (a hash of a hash)
                  keys of top level hash are short names
                   (e.g., netid, noncredit)
                  for each key, value is a hash
                      desc => long name for rule
                      rule => description of rule

 (c) $rulesorder - reference to array containing rule names
                   in order to be displayed

  returns 'ok' if no processing error.

=cut

sub id_rules {
    my ($dom,$ruleshash,$rulesorder) = @_;
    my $outcome;
    return $outcome;
}

=pod

=item selfcreate_rules()

 Incoming data: three arguments
 (a) $dom - domain
 (b) $ruleshash - reference to hash containing rules
                  (a hash of a hash)
                  keys of top level hash are short names
                   (e.g., netid)
                  for each key, value is a hash
                      desc => long name for rule
                      rule => description of rule

 (c) $rulesorder - reference to array containing rule names
                   in order to be displayed

  returns 'ok' if no processing error.


=cut

sub selfcreate_rules {
    my ($dom,$ruleshash,$rulesorder) = @_;
    %{$ruleshash} = (
                     MITemail  => {
                                   name     => 'MIT e-mail address ',
                                   desc     => 'MITid at mit.edu',
                                  },
                    );
    @{$rulesorder} = ('MITemail');
    my $outcome = 'ok';
    return $outcome;
}
=pod

=item username_check() 

 Incoming data: four arguments
 (a) $dom - domain (scalar) 
 (b) $uname - username to compare against rules (scalar)
 (c) $to_check (reference to array of rule names to check)
 (d) $resultshash (reference to hash of results)
                    hash of results for rule checked
                   - keys are rule names
                   - values are: 1 or 0 (for matched or unmatched) 

 returns 'ok' if no processing error.


=cut

sub username_check {
    my ($dom,$uname,$to_check,$resultshash) = @_;
    my $outcome;
    if (ref($to_check) eq 'ARRAY') {
        foreach my $item (@{$to_check}) {
            if ($item eq 'MITid') {
                if ($uname =~ /^\w{2,8}$/) {
                    $resultshash->{$item} = 1;
                } else {
                    $resultshash->{$item} = 0;
                }
            }
        }
        $outcome = 'ok';
    }
    return $outcome;
}

=pod

=item id_check()

 Incoming data: four arguments
 (a) $dom - domain (scalar)
 (b) $id - ID to compare against rules (scalar)
 (c) $to_check (reference to array of rule names to check)
 (d) $resultshash (reference to hash of results)
                    hash of results for rule checked
                   - keys are rule names
                   - values are: 1 or 0 (for matched or unmatched)

 returns 'ok' if no processing error.


=cut

sub id_check {
    my ($dom,$id,$to_check,$resultshash) = @_;
    my $outcome;
    return $outcome;
}

=pod

=item selfcreate_check()

 Incoming data: four arguments
 (a) $dom - domain (scalar)
 (b) $selfcreatename - e-mail proposed as username (compare against rules - scalar)
 (c) $to_check (reference to array of rule names to check)
 (d) $resultshash (reference to hash of results)
                   hash of results for rule checked
                   - keys are rule names
                   - values are: 1 or 0 (for matched or unmatched)

 returns 'ok' if no processing error.


=cut

sub selfcreate_check {
    my ($dom,$selfcreatename,$to_check,$resultshash) = @_;
    my $outcome;
    if (ref($to_check) eq 'ARRAY') {
        foreach my $item (@{$to_check}) {
            if ($item eq 'msuemail') {
                if ($selfcreatename =~ /^\w{2,8}\@mit\.edu$/i) {
                    $resultshash->{$item} = 1;
                } else {
                    $resultshash->{$item} = 0;
                }
            }
        }
        $outcome = 'ok';
    }
    return $outcome;
}

=pod

=item 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.   

=back

=cut

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

1;


More information about the LON-CAPA-cvs mailing list