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