vdw/trunk/WOU_Faculty.pm

package WOU_Faculty;

# Routines pertaining to Faculty
#
# Jeremy Hickerson, 6/25/2003

use strict;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    # set the version for version checking
    $VERSION     = 1.00;
    @ISA         = qw(Exporter);
    @EXPORT      = qw(&term_faculty &fac_sched &regular_cred_hrs &regular_sched
                      &term_fac_sched );
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw( );
}
use vars @EXPORT_OK;
use subs qw(term_faculty fac_sched regular_cred_hrs regular_sched
            term_fac_sched);

use DBI;
use WOU_Util;


# ============================================================================
#                             Package-Level Stuff
# ============================================================================
my %glb_prepared_sql;  # Hash that holds $sth's for prepared sql;
                       # helps performance.  Entries are of the form:
               # ( "sth_qry_fac_sched" => $sth_qry_fac_sched, ... )

my ($sth_qry_term_faculty, $sth_pls_term_faculty, $sth_qry_fac_sched);


# ============================================================================
#                                 Routines
# ============================================================================

# Note1:  some data is pulled from wops database, and $fte_type refers to
#         wops ptvcmty_code.
#
# Note2:  fte_type may be left null (not passed, in which case it is derived
#         from the term (i.e., a term ending in "01" will be FFT, "02" WFT).
sub term_faculty {
    my ($dbh, $term, $fte_type) = @_;

    my ($pidm, $dept, $divs, $fte, $tenure_code, $tenure, $rank_code, $rank_type,
        $rank, $gender, $ethnicity, @results);

    # bind vars seem to default to 28 chars otherwise
    space_pad(60, \$dept, \$divs, \$fte, \$tenure_code, \$tenure, \$rank_code,
        \$rank_type, \$rank, \$gender, \$ethnicity);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_term_faculty"} ) {
        $sth_qry_term_faculty = $glb_prepared_sql{"sth_qry_term_faculty"};
    }
    else {
    # add fields to below as needed
    $sth_qry_term_faculty = $dbh->prepare( q{
        select distinct sirasgn_pidm,
                   sirasgn_term_code
        from sirasgn
        where sirasgn_term_code = ?            AND
        sirasgn_primary_ind = 'Y' } );


        $glb_prepared_sql{"sth_qry_term_faculty"} = $sth_qry_term_faculty;
    }


    if (exists $glb_prepared_sql{"sth_pls_term_faculty"} ) {
        $sth_pls_term_faculty = $glb_prepared_sql{"sth_pls_term_faculty"};
    }
    else {
        $sth_pls_term_faculty = $dbh->prepare( q{
            begin
                baninst1.wou_hr_pub.p_facstaff_data(:sis_pidm, :term, :fte_type,
                    :emp_type, :divs, :dept, :fte, :tenure_code, :tenure,
                    :rank_code, :rank_type, :rank, :gender, :ethnicity);
            end; } );

        $glb_prepared_sql{"sth_pls_term_faculty"} = $sth_pls_term_faculty;
    }

    $sth_qry_term_faculty->execute($term);

    # these only need bound once
    $sth_pls_term_faculty->bind_param_inout(":dept",         \$dept,        1);
    $sth_pls_term_faculty->bind_param_inout(":divs",         \$divs,        1);
    $sth_pls_term_faculty->bind_param_inout(":fte",          \$fte,         1);
    $sth_pls_term_faculty->bind_param_inout(":tenure_code",  \$tenure_code, 1);
    $sth_pls_term_faculty->bind_param_inout(":tenure",       \$tenure,      1);
    $sth_pls_term_faculty->bind_param_inout(":rank_code",    \$rank_code,   1);
    $sth_pls_term_faculty->bind_param_inout(":rank_type",    \$rank_type,   1);
    $sth_pls_term_faculty->bind_param_inout(":rank",         \$rank,        1);
    $sth_pls_term_faculty->bind_param_inout(":gender",       \$gender,      1);
    $sth_pls_term_faculty->bind_param_inout(":ethnicity",    \$ethnicity,   1);

    $sth_pls_term_faculty->bind_param(":term",     $term);      # never changes
    $sth_pls_term_faculty->bind_param(":fte_type", $fte_type);  # never changes
    $sth_pls_term_faculty->bind_param(":emp_type", 'T');        # Teaching, never c.

    while ( ($pidm) = $sth_qry_term_faculty->fetchrow_array ) {

        $sth_pls_term_faculty->bind_param(":sis_pidm", $pidm);

        # reset bind_inout vars
        $dept = ""; $divs = ""; $fte = 0; $tenure_code = ""; $tenure = "";
        $rank_code = ""; $rank_type = ""; $rank = ""; $gender = ""; $ethnicity = "";

        $sth_pls_term_faculty->execute;

        push @results, { "pidm"         => $pidm,
                         "term"         => $term,  # for obj_srvr
                         "dept"         => $dept      ? $dept      : "",
                         "divs"         => $divs      ? $divs      : "",
                         "fte"          => $fte,
                         "tenure_code"  => $tenure_code,
                         "tenure"       => $tenure,
                         "rank_code"    => $rank_code ? $rank_code : "",
                         "rank_type"    => $rank_type ? $rank_type : "",
                         "rank"         => $rank      ? $rank      : "",
                         "gender"       => $gender    ? $gender    : "",
                         "ethnicity"    => $ethnicity ? $ethnicity : "" };

    }

    return \@results;
            
}


sub fac_sched {
    my ($dbh, $fac_pidm, $term) = @_;

    my (@row, $crn, $subj, $crse, $cred_hr, $sched_code, $enrl, @sched, $title);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_qry_fac_sched"} ) {
        $sth_qry_fac_sched = $glb_prepared_sql{"sth_qry_fac_sched"};
    }
    else {
        # add fields to below as needed
        $sth_qry_fac_sched = $dbh->prepare( q{
            select ssbsect_crn,
            ssbsect_subj_code,
            ssbsect_crse_numb,
            nvl(ssbsect_crse_title, scbcrse_title),
            ssbsect_schd_code,
            ssbsect_enrl,
            trunc(nvl(nvl(ssbsect_credit_hrs, scbcrse_credit_hr_low), 0), 2)
            from sirasgn,
                 ssbsect,
                 scbcrse
            where sirasgn_pidm = ?                       AND
                  sirasgn_term_code = ?                  AND
                  sirasgn_primary_ind = 'Y'              AND
                  ssbsect_crn = sirasgn_crn              AND
                  ssbsect_term_code = sirasgn_term_code  AND
                  ssbsect_ssts_code = 'A'                AND
                  scbcrse_subj_code = ssbsect_subj_code  AND
                  scbcrse_crse_numb = ssbsect_crse_numb  AND
                  scbcrse_eff_term = (
                  select max(scbcrse_eff_term)
                  from scbcrse
                  where scbcrse_subj_code = ssbsect_subj_code and
                        scbcrse_crse_numb = ssbsect_crse_numb and
                        scbcrse_eff_term <= ssbsect_term_code) } );

        $glb_prepared_sql{"sth_qry_fac_sched"} = $sth_qry_fac_sched;
    }

    $sth_qry_fac_sched->execute($fac_pidm, $term);

    while ( @row = $sth_qry_fac_sched->fetchrow_array ) {

        ($crn,
         $subj,
         $crse,
         $title,
         $sched_code,
         $enrl,
         $cred_hr) = @row;

     push @sched, { "crn"        => $crn,
                    "subject"    => $subj,
                    "course"     => $crse,
                    "title"      => $title,
                    "sched_code" => $sched_code,
                    "enrolled"   => $enrl,
                    "credit_hrs" => $cred_hr };
    }
    return \@sched;

}


sub term_fac_sched {
    my ($dbh, $term) = @_;

    return join_table_subs( \&term_faculty,
                            [ $dbh, $term ],
                            \&fac_sched,
                            [ $dbh, "\$pidm", $term ] );
}


sub regular_cred_hrs {
    # Note:  side-effect -  creates and populates $rh_fac->{multi_level_courses}
    #        flag (* means faculty member has multi-level courses)

    my ($dbh, $rh_fac, $term, $mode) = @_;

    my ($ra_fac_sched, $rh_class, $regular_cred_hrs);

    $ra_fac_sched = fac_sched($dbh, $rh_fac->{pidm}, $term);

    # initialize multi_level
    foreach $rh_class ( @{ $ra_fac_sched } ) { $rh_class->{multi_level} = 0 }

    check_multi_level($dbh, $ra_fac_sched, $term, $rh_fac); # sets multi_level value
                                              # and $rh_fac->{multi_level_courses}

    $regular_cred_hrs = 0;

    foreach $rh_class ( @{ $ra_fac_sched } ) {

        next if ($mode && $mode eq "CORRECTED" && $rh_class->{multi_level} );

        if ( $rh_class->{sched_code} eq "1" or    # lecture
             $rh_class->{sched_code} eq "2" or    # lab
             $rh_class->{sched_code} eq "3" or    # lecture / lab
             ( ( $rh_class->{sched_code} eq "6" or
                 $rh_class->{sched_code} eq "7" )   and
               $rh_class->{enrolled} > 5 )   ) { 

            $regular_cred_hrs += $rh_class->{credit_hrs};
        }

    }

    return $regular_cred_hrs;

}


sub regular_sched {
    # Note:  side-effect -  creates and populates $rh_fac->{multi_level_courses}
    #        flag (* means faculty member has multi-level courses)

    my ($dbh, $rh_fac, $term, $mode) = @_;

    my ($ra_fac_sched, $rh_class, @regular_sched);

    $ra_fac_sched = fac_sched($dbh, $rh_fac->{pidm}, $term);

    # initialize multi_level
    foreach $rh_class ( @{ $ra_fac_sched } ) { $rh_class->{multi_level} = 0 }

    check_multi_level($dbh, $ra_fac_sched, $term, $rh_fac); # sets multi_level value
                                              # and $rh_fac->{multi_level_courses}

    foreach $rh_class ( @{ $ra_fac_sched } ) {

        next if ($mode && $mode eq "CORRECTED" && $rh_class->{multi_level} );

        if ( $rh_class->{sched_code} eq "1" or    # lecture
             $rh_class->{sched_code} eq "2" or    # lab
             $rh_class->{sched_code} eq "3" or    # lecture / lab
             ( ( $rh_class->{sched_code} eq "6" or
                 $rh_class->{sched_code} eq "7" )   and
               $rh_class->{enrolled} > 5 )   ) { 

            push @regular_sched, $rh_class;
        }
    }

    return \@regular_sched;
}


# =================================================================================
#                                Private Subs
# =================================================================================
sub check_multi_level {
    my ($dbh, $ra_fac_sched, $term, $rh_fac) = @_;

    my ($rh_class);

    foreach $rh_class ( @{ $ra_fac_sched } ) {
        # Maybe Prof has another (unflagged) class in same room at same time; if
        # so, then flag THIS class so we don't count it's hours.  Even if more
        # than two, only one in the group will be left unflagged.

        $rh_class->{multi_level} = multi_level_class($dbh, $ra_fac_sched, $rh_class,
            $term);  

        if ( $rh_class->{multi_level} ) { 
            $rh_fac->{multi_level_courses} = "*";
        }
    }

}


sub multi_level_class {
    my ($dbh, $ra_fac_sched, $rh_class1, $term) = @_;

    my ($rh_class2);

    foreach $rh_class2 ( @{ $ra_fac_sched } ) {
        next if ( $rh_class2->{crn} eq $rh_class1->{crn} or
                  $rh_class2->{multi_level} );  # need to hide the ones we already
                                                # flagged, so guaranteed to leave 1

        if ( same_room_time($dbh, $rh_class1->{crn},
                            $rh_class2->{crn}, $term) ) {return 1 }
    }

    # fall-through
    return 0;
}


sub same_room_time {
    my ($dbh, $crn1, $crn2, $term) = @_;

    my (@row1, @row2, $arr_size, $cnt, $sth_meeting_time);

    # for performance we will only prepare repeated sql once
    if (exists $glb_prepared_sql{"sth_meeting_time"} ) {
        $sth_meeting_time = $glb_prepared_sql{"sth_meeting_time"};
    }
    else {
        $sth_meeting_time = $dbh->prepare( q{
            select SSRMEET_BEGIN_TIME,
                   SSRMEET_END_TIME,
                   SSRMEET_BLDG_CODE,
                   SSRMEET_ROOM_CODE,
                   trunc(SSRMEET_START_DATE),
                   trunc(SSRMEET_END_DATE),
                   nvl(SSRMEET_SUN_DAY, 'NULL'),
                   nvl(SSRMEET_MON_DAY, 'NULL'),
                   nvl(SSRMEET_TUE_DAY, 'NULL'),
                   nvl(SSRMEET_WED_DAY, 'NULL'),
                   nvl(SSRMEET_THU_DAY, 'NULL'),
                   nvl(SSRMEET_FRI_DAY, 'NULL'),
                   nvl(SSRMEET_SAT_DAY, 'NULL')
            from ssrmeet
            where SSRMEET_TERM_CODE = ?           and
                  SSRMEET_CRN = ?                 and
                  SSRMEET_BEGIN_TIME is not null  and
                  SSRMEET_END_TIME is not null    and
                  SSRMEET_BLDG_CODE is not null   and
                  SSRMEET_ROOM_CODE is not null
            order by ssrmeet_begin_time } );

        $glb_prepared_sql{"sth_meeting_time"} = $sth_meeting_time;
    }
    $sth_meeting_time->execute($term, $crn1);

    # we ignore "multi-row" schedules; if first row matches, consider it a match
    @row1 = $sth_meeting_time->fetchrow_array;

    $sth_meeting_time->execute($term, $crn2);
    @row2 = $sth_meeting_time->fetchrow_array;

    # sth_meeting_time has been constructed so as to only include the meaningful
    # data (such that a multi-level class will have exactly the same entries,
    # field-for-field).

    if ( !@row1 or !@row2 ) { return 0 };

    $arr_size = @row1;

    # fall-through
    for $cnt ( 0 .. $arr_size - 1 ) {

        if ( $row1[ $cnt ] ne $row2[ $cnt ] ) { return 0 }
    }

    # fall-through
    return 1;  # meeting times and room exactly the same

}


sub space_pad {

    my $length = shift;

    my ($r_var, $count);

    while ($r_var = shift) {

        $count = $length;

        while ($count--) {
            $$r_var .= " ";
        }
    }
}

return 1;  # for module

1	dpavlin	1	package WOU_Faculty;
2
3			# Routines pertaining to Faculty
4			#
5			# Jeremy Hickerson, 6/25/2003
6
7			use strict;
8
9			BEGIN {
10			use Exporter ();
11			use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
12
13			# set the version for version checking
14			$VERSION = 1.00;
15			@ISA = qw(Exporter);
16			@EXPORT = qw(&term_faculty &fac_sched &regular_cred_hrs &regular_sched
17			&term_fac_sched );
18			%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
19			@EXPORT_OK = qw( );
20			}
21			use vars @EXPORT_OK;
22			use subs qw(term_faculty fac_sched regular_cred_hrs regular_sched
23			term_fac_sched);
24
25			use DBI;
26			use WOU_Util;
27
28
29			# ============================================================================
30			# Package-Level Stuff
31			# ============================================================================
32			my %glb_prepared_sql; # Hash that holds $sth's for prepared sql;
33			# helps performance. Entries are of the form:
34			# ( "sth_qry_fac_sched" => $sth_qry_fac_sched, ... )
35
36			my ($sth_qry_term_faculty, $sth_pls_term_faculty, $sth_qry_fac_sched);
37
38
39			# ============================================================================
40			# Routines
41			# ============================================================================
42
43			# Note1: some data is pulled from wops database, and $fte_type refers to
44			# wops ptvcmty_code.
45			#
46			# Note2: fte_type may be left null (not passed, in which case it is derived
47			# from the term (i.e., a term ending in "01" will be FFT, "02" WFT).
48			sub term_faculty {
49			my ($dbh, $term, $fte_type) = @_;
50
51			my ($pidm, $dept, $divs, $fte, $tenure_code, $tenure, $rank_code, $rank_type,
52			$rank, $gender, $ethnicity, @results);
53
54			# bind vars seem to default to 28 chars otherwise
55			space_pad(60, \$dept, \$divs, \$fte, \$tenure_code, \$tenure, \$rank_code,
56			\$rank_type, \$rank, \$gender, \$ethnicity);
57
58			# for performance we will only prepare repeated sql once
59			if (exists $glb_prepared_sql{"sth_qry_term_faculty"} ) {
60			$sth_qry_term_faculty = $glb_prepared_sql{"sth_qry_term_faculty"};
61			}
62			else {
63			# add fields to below as needed
64			$sth_qry_term_faculty = $dbh->prepare( q{
65			select distinct sirasgn_pidm,
66			sirasgn_term_code
67			from sirasgn
68			where sirasgn_term_code = ? AND
69			sirasgn_primary_ind = 'Y' } );
70
71
72			$glb_prepared_sql{"sth_qry_term_faculty"} = $sth_qry_term_faculty;
73			}
74
75
76			if (exists $glb_prepared_sql{"sth_pls_term_faculty"} ) {
77			$sth_pls_term_faculty = $glb_prepared_sql{"sth_pls_term_faculty"};
78			}
79			else {
80			$sth_pls_term_faculty = $dbh->prepare( q{
81			begin
82			baninst1.wou_hr_pub.p_facstaff_data(:sis_pidm, :term, :fte_type,
83			:emp_type, :divs, :dept, :fte, :tenure_code, :tenure,
84			:rank_code, :rank_type, :rank, :gender, :ethnicity);
85			end; } );
86
87			$glb_prepared_sql{"sth_pls_term_faculty"} = $sth_pls_term_faculty;
88			}
89
90			$sth_qry_term_faculty->execute($term);
91
92			# these only need bound once
93			$sth_pls_term_faculty->bind_param_inout(":dept", \$dept, 1);
94			$sth_pls_term_faculty->bind_param_inout(":divs", \$divs, 1);
95			$sth_pls_term_faculty->bind_param_inout(":fte", \$fte, 1);
96			$sth_pls_term_faculty->bind_param_inout(":tenure_code", \$tenure_code, 1);
97			$sth_pls_term_faculty->bind_param_inout(":tenure", \$tenure, 1);
98			$sth_pls_term_faculty->bind_param_inout(":rank_code", \$rank_code, 1);
99			$sth_pls_term_faculty->bind_param_inout(":rank_type", \$rank_type, 1);
100			$sth_pls_term_faculty->bind_param_inout(":rank", \$rank, 1);
101			$sth_pls_term_faculty->bind_param_inout(":gender", \$gender, 1);
102			$sth_pls_term_faculty->bind_param_inout(":ethnicity", \$ethnicity, 1);
103
104			$sth_pls_term_faculty->bind_param(":term", $term); # never changes
105			$sth_pls_term_faculty->bind_param(":fte_type", $fte_type); # never changes
106			$sth_pls_term_faculty->bind_param(":emp_type", 'T'); # Teaching, never c.
107
108			while ( ($pidm) = $sth_qry_term_faculty->fetchrow_array ) {
109
110			$sth_pls_term_faculty->bind_param(":sis_pidm", $pidm);
111
112			# reset bind_inout vars
113			$dept = ""; $divs = ""; $fte = 0; $tenure_code = ""; $tenure = "";
114			$rank_code = ""; $rank_type = ""; $rank = ""; $gender = ""; $ethnicity = "";
115
116			$sth_pls_term_faculty->execute;
117
118			push @results, { "pidm" => $pidm,
119			"term" => $term, # for obj_srvr
120			"dept" => $dept ? $dept : "",
121			"divs" => $divs ? $divs : "",
122			"fte" => $fte,
123			"tenure_code" => $tenure_code,
124			"tenure" => $tenure,
125			"rank_code" => $rank_code ? $rank_code : "",
126			"rank_type" => $rank_type ? $rank_type : "",
127			"rank" => $rank ? $rank : "",
128			"gender" => $gender ? $gender : "",
129			"ethnicity" => $ethnicity ? $ethnicity : "" };
130
131			}
132
133			return \@results;
134
135			}
136
137
138			sub fac_sched {
139			my ($dbh, $fac_pidm, $term) = @_;
140
141			my (@row, $crn, $subj, $crse, $cred_hr, $sched_code, $enrl, @sched, $title);
142
143			# for performance we will only prepare repeated sql once
144			if (exists $glb_prepared_sql{"sth_qry_fac_sched"} ) {
145			$sth_qry_fac_sched = $glb_prepared_sql{"sth_qry_fac_sched"};
146			}
147			else {
148			# add fields to below as needed
149			$sth_qry_fac_sched = $dbh->prepare( q{
150			select ssbsect_crn,
151			ssbsect_subj_code,
152			ssbsect_crse_numb,
153			nvl(ssbsect_crse_title, scbcrse_title),
154			ssbsect_schd_code,
155			ssbsect_enrl,
156			trunc(nvl(nvl(ssbsect_credit_hrs, scbcrse_credit_hr_low), 0), 2)
157			from sirasgn,
158			ssbsect,
159			scbcrse
160			where sirasgn_pidm = ? AND
161			sirasgn_term_code = ? AND
162			sirasgn_primary_ind = 'Y' AND
163			ssbsect_crn = sirasgn_crn AND
164			ssbsect_term_code = sirasgn_term_code AND
165			ssbsect_ssts_code = 'A' AND
166			scbcrse_subj_code = ssbsect_subj_code AND
167			scbcrse_crse_numb = ssbsect_crse_numb AND
168			scbcrse_eff_term = (
169			select max(scbcrse_eff_term)
170			from scbcrse
171			where scbcrse_subj_code = ssbsect_subj_code and
172			scbcrse_crse_numb = ssbsect_crse_numb and
173			scbcrse_eff_term <= ssbsect_term_code) } );
174
175			$glb_prepared_sql{"sth_qry_fac_sched"} = $sth_qry_fac_sched;
176			}
177
178			$sth_qry_fac_sched->execute($fac_pidm, $term);
179
180			while ( @row = $sth_qry_fac_sched->fetchrow_array ) {
181
182			($crn,
183			$subj,
184			$crse,
185			$title,
186			$sched_code,
187			$enrl,
188			$cred_hr) = @row;
189
190			push @sched, { "crn" => $crn,
191			"subject" => $subj,
192			"course" => $crse,
193			"title" => $title,
194			"sched_code" => $sched_code,
195			"enrolled" => $enrl,
196			"credit_hrs" => $cred_hr };
197			}
198			return \@sched;
199
200			}
201
202
203			sub term_fac_sched {
204			my ($dbh, $term) = @_;
205
206			return join_table_subs( \&term_faculty,
207			[ $dbh, $term ],
208			\&fac_sched,
209			[ $dbh, "\$pidm", $term ] );
210			}
211
212
213			sub regular_cred_hrs {
214			# Note: side-effect - creates and populates $rh_fac->{multi_level_courses}
215			# flag (* means faculty member has multi-level courses)
216
217			my ($dbh, $rh_fac, $term, $mode) = @_;
218
219			my ($ra_fac_sched, $rh_class, $regular_cred_hrs);
220
221			$ra_fac_sched = fac_sched($dbh, $rh_fac->{pidm}, $term);
222
223			# initialize multi_level
224			foreach $rh_class ( @{ $ra_fac_sched } ) { $rh_class->{multi_level} = 0 }
225
226			check_multi_level($dbh, $ra_fac_sched, $term, $rh_fac); # sets multi_level value
227			# and $rh_fac->{multi_level_courses}
228
229			$regular_cred_hrs = 0;
230
231			foreach $rh_class ( @{ $ra_fac_sched } ) {
232
233			next if ($mode && $mode eq "CORRECTED" && $rh_class->{multi_level} );
234
235			if ( $rh_class->{sched_code} eq "1" or # lecture
236			$rh_class->{sched_code} eq "2" or # lab
237			$rh_class->{sched_code} eq "3" or # lecture / lab
238			( ( $rh_class->{sched_code} eq "6" or
239			$rh_class->{sched_code} eq "7" ) and
240			$rh_class->{enrolled} > 5 ) ) {
241
242			$regular_cred_hrs += $rh_class->{credit_hrs};
243			}
244
245			}
246
247			return $regular_cred_hrs;
248
249			}
250
251
252			sub regular_sched {
253			# Note: side-effect - creates and populates $rh_fac->{multi_level_courses}
254			# flag (* means faculty member has multi-level courses)
255
256			my ($dbh, $rh_fac, $term, $mode) = @_;
257
258			my ($ra_fac_sched, $rh_class, @regular_sched);
259
260			$ra_fac_sched = fac_sched($dbh, $rh_fac->{pidm}, $term);
261
262			# initialize multi_level
263			foreach $rh_class ( @{ $ra_fac_sched } ) { $rh_class->{multi_level} = 0 }
264
265			check_multi_level($dbh, $ra_fac_sched, $term, $rh_fac); # sets multi_level value
266			# and $rh_fac->{multi_level_courses}
267
268			foreach $rh_class ( @{ $ra_fac_sched } ) {
269
270			next if ($mode && $mode eq "CORRECTED" && $rh_class->{multi_level} );
271
272			if ( $rh_class->{sched_code} eq "1" or # lecture
273			$rh_class->{sched_code} eq "2" or # lab
274			$rh_class->{sched_code} eq "3" or # lecture / lab
275			( ( $rh_class->{sched_code} eq "6" or
276			$rh_class->{sched_code} eq "7" ) and
277			$rh_class->{enrolled} > 5 ) ) {
278
279			push @regular_sched, $rh_class;
280			}
281			}
282
283			return \@regular_sched;
284			}
285
286
287			# =================================================================================
288			# Private Subs
289			# =================================================================================
290			sub check_multi_level {
291			my ($dbh, $ra_fac_sched, $term, $rh_fac) = @_;
292
293			my ($rh_class);
294
295			foreach $rh_class ( @{ $ra_fac_sched } ) {
296			# Maybe Prof has another (unflagged) class in same room at same time; if
297			# so, then flag THIS class so we don't count it's hours. Even if more
298			# than two, only one in the group will be left unflagged.
299
300			$rh_class->{multi_level} = multi_level_class($dbh, $ra_fac_sched, $rh_class,
301			$term);
302
303			if ( $rh_class->{multi_level} ) {
304			$rh_fac->{multi_level_courses} = "*";
305			}
306			}
307
308			}
309
310
311			sub multi_level_class {
312			my ($dbh, $ra_fac_sched, $rh_class1, $term) = @_;
313
314			my ($rh_class2);
315
316			foreach $rh_class2 ( @{ $ra_fac_sched } ) {
317			next if ( $rh_class2->{crn} eq $rh_class1->{crn} or
318			$rh_class2->{multi_level} ); # need to hide the ones we already
319			# flagged, so guaranteed to leave 1
320
321			if ( same_room_time($dbh, $rh_class1->{crn},
322			$rh_class2->{crn}, $term) ) {return 1 }
323			}
324
325			# fall-through
326			return 0;
327			}
328
329
330			sub same_room_time {
331			my ($dbh, $crn1, $crn2, $term) = @_;
332
333			my (@row1, @row2, $arr_size, $cnt, $sth_meeting_time);
334
335			# for performance we will only prepare repeated sql once
336			if (exists $glb_prepared_sql{"sth_meeting_time"} ) {
337			$sth_meeting_time = $glb_prepared_sql{"sth_meeting_time"};
338			}
339			else {
340			$sth_meeting_time = $dbh->prepare( q{
341			select SSRMEET_BEGIN_TIME,
342			SSRMEET_END_TIME,
343			SSRMEET_BLDG_CODE,
344			SSRMEET_ROOM_CODE,
345			trunc(SSRMEET_START_DATE),
346			trunc(SSRMEET_END_DATE),
347			nvl(SSRMEET_SUN_DAY, 'NULL'),
348			nvl(SSRMEET_MON_DAY, 'NULL'),
349			nvl(SSRMEET_TUE_DAY, 'NULL'),
350			nvl(SSRMEET_WED_DAY, 'NULL'),
351			nvl(SSRMEET_THU_DAY, 'NULL'),
352			nvl(SSRMEET_FRI_DAY, 'NULL'),
353			nvl(SSRMEET_SAT_DAY, 'NULL')
354			from ssrmeet
355			where SSRMEET_TERM_CODE = ? and
356			SSRMEET_CRN = ? and
357			SSRMEET_BEGIN_TIME is not null and
358			SSRMEET_END_TIME is not null and
359			SSRMEET_BLDG_CODE is not null and
360			SSRMEET_ROOM_CODE is not null
361			order by ssrmeet_begin_time } );
362
363			$glb_prepared_sql{"sth_meeting_time"} = $sth_meeting_time;
364			}
365			$sth_meeting_time->execute($term, $crn1);
366
367			# we ignore "multi-row" schedules; if first row matches, consider it a match
368			@row1 = $sth_meeting_time->fetchrow_array;
369
370			$sth_meeting_time->execute($term, $crn2);
371			@row2 = $sth_meeting_time->fetchrow_array;
372
373			# sth_meeting_time has been constructed so as to only include the meaningful
374			# data (such that a multi-level class will have exactly the same entries,
375			# field-for-field).
376
377			if ( !@row1 or !@row2 ) { return 0 };
378
379			$arr_size = @row1;
380
381			# fall-through
382			for $cnt ( 0 .. $arr_size - 1 ) {
383
384			if ( $row1[ $cnt ] ne $row2[ $cnt ] ) { return 0 }
385			}
386
387			# fall-through
388			return 1; # meeting times and room exactly the same
389
390			}
391
392
393			sub space_pad {
394
395			my $length = shift;
396
397			my ($r_var, $count);
398
399			while ($r_var = shift) {
400
401			$count = $length;
402
403			while ($count--) {
404			$$r_var .= " ";
405			}
406			}
407			}
408
409			return 1; # for module
410