1 |
package WOU_Schedule; |
2 |
|
3 |
# Routines for Banner SIS Schedule |
4 |
# |
5 |
# Subs in this package that use DBI expect to be passed a database handle |
6 |
# ($dbh) that has been granted the appropriate roles by WOU_Secure.pm. |
7 |
# |
8 |
# Jeremy Hickerson, 3/09/2004 |
9 |
|
10 |
use strict; |
11 |
|
12 |
BEGIN { |
13 |
use Exporter (); |
14 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
15 |
|
16 |
# set the version for version checking |
17 |
$VERSION = 1.00; |
18 |
@ISA = qw(Exporter); |
19 |
@EXPORT = qw(&term_sections §ion &instructor §ion_meet |
20 |
&primary_instructor &term_schedule); |
21 |
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], |
22 |
@EXPORT_OK = qw( ); |
23 |
|
24 |
( grep /gen\$com/i, @INC ) || unshift @INC, "gen\$com"; |
25 |
} |
26 |
use vars @EXPORT_OK; |
27 |
use subs qw(term_sections section instructor section_meet primary_instructor |
28 |
term_schedule); |
29 |
|
30 |
use DBI; |
31 |
use WOU_Person qw(id real_ssn); |
32 |
use WOU_Util qw(add2hash join_table_subs); |
33 |
|
34 |
# ============================================================================ |
35 |
# Package-Level Stuff |
36 |
# ============================================================================ |
37 |
|
38 |
my %glb_prepared_sql; # Hash that holds $sth's for prepared sql; |
39 |
# helps performance. Entries are of the form: |
40 |
# ( "sth_qry_section" => $sth_qry_section, ... ) |
41 |
|
42 |
my ($sth_qry_section, $sth_qry_instructor, $sth_qry_section_meet); |
43 |
|
44 |
|
45 |
# ============================================================================ |
46 |
# Routines |
47 |
# ============================================================================ |
48 |
|
49 |
# ================================================ |
50 |
# term_sections - all active sections for a term |
51 |
# ================================================ |
52 |
sub term_sections { |
53 |
my ($dbh, $term) = @_; |
54 |
|
55 |
my ( $crn, $ptrm, $subj, $crse, $ssts_code, $schd_code, $crse_title, |
56 |
$credit_hrs, $bill_hrs, $gmod_code, $gradable, $max_enrl, $enrl, |
57 |
$seats_avail, $lec_hr, $lab_hr, $oth_hr, $cont_hr, $cip, $start_date, |
58 |
$end_date, $campus, @term_sections ); |
59 |
|
60 |
my $sth_qry_term_sections = $dbh->prepare( q{ |
61 |
select ssbsect_crn, |
62 |
SSBSECT_PTRM_CODE, |
63 |
SSBSECT_SUBJ_CODE, |
64 |
SSBSECT_CRSE_NUMB, |
65 |
SSBSECT_SSTS_CODE, |
66 |
SSBSECT_SCHD_CODE, |
67 |
nvl(SSBSECT_CRSE_TITLE, scbcrse_title), |
68 |
nvl(SSBSECT_CREDIT_HRS, scbcrse_credit_hr_low), |
69 |
SSBSECT_BILL_HRS, |
70 |
SSBSECT_GMOD_CODE, |
71 |
SSBSECT_GRADABLE_IND, |
72 |
SSBSECT_MAX_ENRL, |
73 |
SSBSECT_ENRL, |
74 |
SSBSECT_SEATS_AVAIL, |
75 |
SSBSECT_LEC_HR, |
76 |
SSBSECT_LAB_HR, |
77 |
SSBSECT_OTH_HR, |
78 |
SSBSECT_CONT_HR, |
79 |
scbcrse_cipc_code, |
80 |
to_char(ssbsect_ptrm_start_date, 'mm/dd/yyyy'), |
81 |
to_char(ssbsect_ptrm_end_date, 'mm/dd/yyyy'), |
82 |
ssbsect_camp_code |
83 |
from ssbsect, |
84 |
scbcrse |
85 |
where ssbsect_term_code = ? AND |
86 |
ssbsect_ssts_code = 'A' AND |
87 |
scbcrse_subj_code = ssbsect_subj_code AND |
88 |
scbcrse_crse_numb = ssbsect_crse_numb AND |
89 |
scbcrse_eff_term = ( |
90 |
select max(scbcrse_eff_term) |
91 |
from scbcrse |
92 |
where scbcrse_subj_code = ssbsect_subj_code and |
93 |
scbcrse_crse_numb = ssbsect_crse_numb and |
94 |
scbcrse_eff_term <= ssbsect_term_code) } ); |
95 |
|
96 |
|
97 |
$sth_qry_term_sections->execute($term); |
98 |
|
99 |
while ( ( $crn, |
100 |
$ptrm, |
101 |
$subj, |
102 |
$crse, |
103 |
$ssts_code, |
104 |
$schd_code, |
105 |
$crse_title, |
106 |
$credit_hrs, |
107 |
$bill_hrs, |
108 |
$gmod_code, |
109 |
$gradable, |
110 |
$max_enrl, |
111 |
$enrl, |
112 |
$seats_avail, |
113 |
$lec_hr, |
114 |
$lab_hr, |
115 |
$oth_hr, |
116 |
$cont_hr, |
117 |
$cip, |
118 |
$start_date, |
119 |
$end_date, |
120 |
$campus ) = $sth_qry_term_sections->fetchrow_array ) { |
121 |
|
122 |
push @term_sections, { "term" => $term, |
123 |
"crn" => $crn, |
124 |
"ptrm" => $ptrm, |
125 |
"subj" => $subj, |
126 |
"crse" => $crse, |
127 |
"ssts_code" => $ssts_code, |
128 |
"schd_code" => $schd_code, |
129 |
"crse_title" => $crse_title, |
130 |
"credit_hrs" => $credit_hrs, |
131 |
"bill_hrs" => $bill_hrs, |
132 |
"gmod_code" => $gmod_code, |
133 |
"gradable" => $gradable, |
134 |
"max_enrl" => $max_enrl, |
135 |
"enrl" => $enrl, |
136 |
"seats_avail" => $seats_avail, |
137 |
"lec_hr" => $lec_hr, |
138 |
"lab_hr" => $lab_hr, |
139 |
"oth_hr" => $oth_hr, |
140 |
"cont_hr" => $cont_hr, |
141 |
"cip" => $cip, |
142 |
"start_date" => $start_date, |
143 |
"end_date" => $end_date, |
144 |
"campus" => $campus }; |
145 |
} |
146 |
return \@term_sections; |
147 |
} |
148 |
|
149 |
|
150 |
sub term_schedule { |
151 |
my ($dbh, $term) = @_; |
152 |
|
153 |
return join_table_subs( \&term_sections, |
154 |
[ $dbh, $term ], |
155 |
\§ion_meet, |
156 |
[ $dbh, $term, "\$crn" ], |
157 |
'Y' ); # final parm means do outer join; |
158 |
# this returns schedule rows even |
159 |
# if no time and room assigned |
160 |
} |
161 |
|
162 |
|
163 |
# ======================================================== |
164 |
# section - returns info about a course section |
165 |
# ======================================================== |
166 |
sub section { |
167 |
my ($dbh, $term, $crn) = @_; |
168 |
|
169 |
my ( $ptrm, $subj, $crse, $ssts_code, $schd_code, $crse_title, $credit_hrs, |
170 |
$bill_hrs, $gmod_code, $gradable, $max_enrl, $enrl, $seats_avail, |
171 |
$lec_hr, $lab_hr, $oth_hr, $cont_hr, $cip, $start_date, $end_date, |
172 |
$campus ); |
173 |
|
174 |
# for performance we will only prepare repeated sql once |
175 |
if (exists $glb_prepared_sql{"sth_qry_section"} ) { |
176 |
$sth_qry_section = $glb_prepared_sql{"sth_qry_section"}; |
177 |
} |
178 |
else { |
179 |
$sth_qry_section = $dbh->prepare( q{ |
180 |
select SSBSECT_PTRM_CODE, |
181 |
SSBSECT_SUBJ_CODE, |
182 |
SSBSECT_CRSE_NUMB, |
183 |
SSBSECT_SSTS_CODE, |
184 |
SSBSECT_SCHD_CODE, |
185 |
nvl(SSBSECT_CRSE_TITLE, scbcrse_title), |
186 |
SSBSECT_CREDIT_HRS, |
187 |
SSBSECT_BILL_HRS, |
188 |
SSBSECT_GMOD_CODE, |
189 |
SSBSECT_GRADABLE_IND, |
190 |
SSBSECT_MAX_ENRL, |
191 |
SSBSECT_ENRL, |
192 |
SSBSECT_SEATS_AVAIL, |
193 |
SSBSECT_LEC_HR, |
194 |
SSBSECT_LAB_HR, |
195 |
SSBSECT_OTH_HR, |
196 |
SSBSECT_CONT_HR, |
197 |
scbcrse_cipc_code, |
198 |
to_char(ssbsect_ptrm_start_date, 'mm/dd/yyyy'), |
199 |
to_char(ssbsect_ptrm_end_date, 'mm/dd/yyyy'), |
200 |
ssbsect_camp_code |
201 |
from ssbsect, |
202 |
scbcrse |
203 |
where ssbsect_term_code = ? AND |
204 |
ssbsect_crn = ? AND |
205 |
scbcrse_subj_code = ssbsect_subj_code AND |
206 |
scbcrse_crse_numb = ssbsect_crse_numb AND |
207 |
scbcrse_eff_term = ( |
208 |
select max(scbcrse_eff_term) |
209 |
from scbcrse |
210 |
where scbcrse_subj_code = ssbsect_subj_code and |
211 |
scbcrse_crse_numb = ssbsect_crse_numb and |
212 |
scbcrse_eff_term <= ssbsect_term_code) } ); |
213 |
|
214 |
$glb_prepared_sql{"sth_qry_section"} = $sth_qry_section; |
215 |
} |
216 |
|
217 |
$sth_qry_section->execute($term, $crn); |
218 |
|
219 |
( $ptrm, |
220 |
$subj, |
221 |
$crse, |
222 |
$ssts_code, |
223 |
$schd_code, |
224 |
$crse_title, |
225 |
$credit_hrs, |
226 |
$bill_hrs, |
227 |
$gmod_code, |
228 |
$gradable, |
229 |
$max_enrl, |
230 |
$enrl, |
231 |
$seats_avail, |
232 |
$lec_hr, |
233 |
$lab_hr, |
234 |
$oth_hr, |
235 |
$cont_hr, |
236 |
$cip, |
237 |
$start_date, |
238 |
$end_date, |
239 |
$campus ) = $sth_qry_section->fetchrow_array; |
240 |
|
241 |
return { "crn" => $crn, |
242 |
"ptrm" => $ptrm, |
243 |
"subj" => $subj, |
244 |
"crse" => $crse, |
245 |
"ssts_code" => $ssts_code, |
246 |
"schd_code" => $schd_code, |
247 |
"crse_title" => $crse_title, |
248 |
"credit_hrs" => $credit_hrs, |
249 |
"bill_hrs" => $bill_hrs, |
250 |
"gmod_code" => $gmod_code, |
251 |
"gradable" => $gradable, |
252 |
"max_enrl" => $max_enrl, |
253 |
"enrl" => $enrl, |
254 |
"seats_avail" => $seats_avail, |
255 |
"lec_hr" => $lec_hr, |
256 |
"lab_hr" => $lab_hr, |
257 |
"oth_hr" => $oth_hr, |
258 |
"cont_hr" => $cont_hr, |
259 |
"cip" => $cip, |
260 |
"start_date" => $start_date, |
261 |
"end_date" => $end_date, |
262 |
"campus" => $campus }; |
263 |
} |
264 |
|
265 |
|
266 |
sub instructor { |
267 |
my ($dbh, $term, $crn) = @_; |
268 |
|
269 |
my (@instructor, $instr_pidm, $pcnt, $primary, $rh_instr); |
270 |
|
271 |
# for performance we will only prepare repeated sql once |
272 |
if (exists $glb_prepared_sql{"sth_qry_instructor"} ) { |
273 |
$sth_qry_instructor = $glb_prepared_sql{"sth_qry_instructor"}; |
274 |
} |
275 |
else { |
276 |
$sth_qry_instructor = $dbh->prepare( q{ |
277 |
select sirasgn_pidm, |
278 |
sirasgn_percent_sess, |
279 |
sirasgn_primary_ind |
280 |
from sirasgn |
281 |
where sirasgn_term_code = ? and |
282 |
sirasgn_crn = ? and |
283 |
sirasgn_primary_ind = 'Y' } ); |
284 |
|
285 |
$glb_prepared_sql{"sth_qry_instructor"} = $sth_qry_instructor; |
286 |
} |
287 |
|
288 |
$sth_qry_instructor->execute($term, $crn); |
289 |
|
290 |
while ( ( $instr_pidm, $pcnt, $primary ) = |
291 |
$sth_qry_instructor->fetchrow_array ) { |
292 |
|
293 |
$rh_instr = { "crn" => $crn, |
294 |
"pidm" => $instr_pidm, |
295 |
"pc_instruct" => $pcnt, |
296 |
"primary" => $primary }; |
297 |
|
298 |
add2hash($rh_instr, id($dbh, $instr_pidm) ); |
299 |
|
300 |
$rh_instr->{ssn} = real_ssn($dbh, $instr_pidm); |
301 |
|
302 |
push @instructor, $rh_instr; |
303 |
|
304 |
} |
305 |
|
306 |
return \@instructor; |
307 |
} |
308 |
|
309 |
|
310 |
sub primary_instructor { |
311 |
my ($dbh, $term, $crn) = @_; |
312 |
|
313 |
my ($ra_instr, $rh_instr); |
314 |
|
315 |
$ra_instr = instructor($dbh, $term, $crn); |
316 |
|
317 |
while ( $rh_instr = shift @{ $ra_instr } ) { |
318 |
return $rh_instr if $rh_instr->{primary} eq "Y"; |
319 |
} |
320 |
|
321 |
# fall-through, shouldn't get here |
322 |
return { }; |
323 |
} |
324 |
|
325 |
|
326 |
sub section_meet { |
327 |
my ($dbh, $term, $crn) = @_; |
328 |
|
329 |
my ( @section_meet, $beg_time, $end_time, $sunday, $monday, $tuesday, |
330 |
$wednesday, $thursday, $friday, $saturday, $start_date, $end_date, |
331 |
$bldg, $room, $days, $time, $capacity ); |
332 |
|
333 |
# for performance we will only prepare repeated sql once |
334 |
if (exists $glb_prepared_sql{"sth_qry_section_meet"} ) { |
335 |
$sth_qry_section_meet = $glb_prepared_sql{"sth_qry_section_meet"}; |
336 |
} |
337 |
else { |
338 |
$sth_qry_section_meet = $dbh->prepare( q{ |
339 |
select ssrmeet_begin_time, |
340 |
ssrmeet_end_time, |
341 |
ssrmeet_sun_day, |
342 |
ssrmeet_mon_day, |
343 |
ssrmeet_tue_day, |
344 |
ssrmeet_wed_day, |
345 |
ssrmeet_thu_day, |
346 |
ssrmeet_fri_day, |
347 |
ssrmeet_sat_day, |
348 |
to_char(ssrmeet_start_date, 'mm/dd/yyyy'), |
349 |
to_char(ssrmeet_end_date, 'mm/dd/yyyy'), |
350 |
ssrmeet_bldg_code, |
351 |
ssrmeet_room_code, |
352 |
slbrdef_capacity |
353 |
from ssrmeet, |
354 |
slbrdef |
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 and |
361 |
slbrdef_bldg_code (+)= ssrmeet_bldg_code and |
362 |
slbrdef_room_number (+)= ssrmeet_room_code } ); |
363 |
|
364 |
$glb_prepared_sql{"sth_qry_section_meet"} = $sth_qry_section_meet; |
365 |
} |
366 |
|
367 |
$sth_qry_section_meet->execute($term, $crn); |
368 |
|
369 |
while ( ( $beg_time, $end_time, $sunday, $monday, $tuesday, $wednesday, |
370 |
$thursday, $friday, $saturday, $start_date, $end_date, $bldg, |
371 |
$room, $capacity ) = $sth_qry_section_meet->fetchrow_array ) { |
372 |
|
373 |
# do this before assignment of Y/N values below |
374 |
$days = $sunday ? $sunday : '-'; |
375 |
$days .= $monday ? $monday : '-'; |
376 |
$days .= $tuesday ? $tuesday : '-'; |
377 |
$days .= $wednesday ? $wednesday : '-'; |
378 |
$days .= $thursday ? $thursday : '-'; |
379 |
$days .= $friday ? $friday : '-'; |
380 |
$days .= $saturday ? $saturday : '-'; |
381 |
|
382 |
$sunday = $sunday ? "Y" : "N"; |
383 |
$monday = $monday ? "Y" : "N"; |
384 |
$tuesday = $tuesday ? "Y" : "N"; |
385 |
$wednesday = $wednesday ? "Y" : "N"; |
386 |
$thursday = $thursday ? "Y" : "N"; |
387 |
$friday = $friday ? "Y" : "N"; |
388 |
$saturday = $saturday ? "Y" : "N"; |
389 |
|
390 |
|
391 |
$beg_time = substr($beg_time, 0, 2) . ":" . substr($beg_time, 2); |
392 |
$end_time = substr($end_time, 0, 2) . ":" . substr($end_time, 2); |
393 |
|
394 |
$time = $beg_time . '-' . $end_time; |
395 |
$time =~ s/://g; |
396 |
|
397 |
push @section_meet, { "crn" => $crn, |
398 |
"beg_time" => $beg_time, |
399 |
"end_time" => $end_time, |
400 |
"sunday" => $sunday, |
401 |
"monday" => $monday, |
402 |
"tuesday" => $tuesday, |
403 |
"wednesday" => $wednesday, |
404 |
"thursday" => $thursday, |
405 |
"friday" => $friday, |
406 |
"saturday" => $saturday, |
407 |
"start_date" => $start_date, |
408 |
"end_date" => $end_date, |
409 |
"bldg" => $bldg, |
410 |
"room" => $room, |
411 |
"days" => $days, |
412 |
"time" => $time, |
413 |
"capacity" => $capacity }; |
414 |
} |
415 |
|
416 |
return \@section_meet; |
417 |
} |
418 |
|
419 |
|
420 |
# ============================================================================ |
421 |
# Subroutines |
422 |
# ============================================================================ |
423 |
|
424 |
return 1; |
425 |
|