Annotation of loncom/interface/coursecatalog.pm, revision 1.4
1.1 raeburn 1: #
2: # Copyright Michigan State University Board of Trustees
3: #
4: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
5: #
6: # LON-CAPA is free software; you can redistribute it and/or modify
7: # it under the terms of the GNU General Public License as published by
8: # the Free Software Foundation; either version 2 of the License, or
9: # (at your option) any later version.
10: #
11: # LON-CAPA is distributed in the hope that it will be useful,
12: # but WITHOUT ANY WARRANTY; without even the implied warranty of
13: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: # GNU General Public License for more details.
15: #
16: # You should have received a copy of the GNU General Public License
17: # along with LON-CAPA; if not, write to the Free Software
18: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19: #
20: # /home/httpd/html/adm/gpl.txt
21: #
22: # http://www.lon-capa.org/
23: #
24:
25: package Apache::coursecatalog;
26:
27: use strict;
28: use lib qw(/home/httpd/lib/perl);
29: use Apache::Constants qw(:common);
30: use Apache::loncommon;
31: use Apache::lonnet;
32: use Apache::lonlocal;
33: use Apache::lonsupportreq;
34: use Apache::lonacc;
35: use lib '/home/httpd/lib/perl/';
36: use LONCAPA;
37:
38: sub handler {
39: my ($r) = @_;
40: &Apache::loncommon::content_type($r,'text/html');
41: $r->send_http_header;
42: if ($r->header_only) {
43: return OK;
44: }
45: &Apache::lonacc::get_posted_cgi($r);
46: &Apache::lonlocal::get_language_handle($r);
47: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['sortby']);
48: my $codedom = $Apache::lonnet::perlvar{'lonDefDomain'};
49: my $ccode = '';
50: my %coursecodes = ();
51: my %codes = ();
52: my @codetitles = ();
53: my %cat_titles = ();
54: my %cat_order = ();
55: my %idlist = ();
56: my %idnums = ();
57: my %idlist_titles = ();
58: my $caller = 'global';
59: my $format_reply;
60: my $totcodes = 0;
61: my $jscript = '';
62: my $formname = 'coursecatalog';
63: $totcodes = &Apache::lonsupportreq::retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
64: if ($totcodes > 0) {
65: if ($ccode eq '') {
66: $format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
67: if ($format_reply eq 'ok') {
68: my $numtypes = @codetitles;
69: &Apache::lonsupportreq::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
70: &Apache::lonsupportreq::javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
71: }
72: }
73: if ($env{'form.state'} eq 'listing') {
74: $jscript .= '
75: function setElements() {
76: ';
77: for (my $i=0; $i<@codetitles; $i++) {
78: if ($env{'form.'.$codetitles[$i]} != -1) {
79: $jscript .= '
80: for (var j=0; j<document.'.$formname.'.'.$codetitles[$i].'.length; j++) {
81: if (document.'.$formname.'.'.$codetitles[$i].'[j].value == "'.$env{'form.'.$codetitles[$i]}.'") {
82: document.'.$formname.'.'.$codetitles[$i].'.selectedIndex = j;
83: }
84: }
85: ';
86: $jscript .= ' courseSet('."'$codetitles[$i]'".');'."\n";
87: } else {
88: last;
89: }
90: }
91: $jscript .= '}';
92: $jscript .= qq|
93: function changeSort(caller) {
94: document.coursecatalog.sortby.value = caller;
95: document.coursecatalog.submit();
96: }\n|;
97: }
98: my $js = '<script type"text/javascript">'."\n$jscript\n".
99: '</script>';
100: my %add_entries = (topmargin => "0",
101: marginheight => "0",
102: onLoad =>"setElements()",);
103: my $start_page =
104: &Apache::loncommon::start_page('Course Catalog',$js,
105: {
106: 'add_entries' => \%add_entries,
107: 'no_inline_link' => 1,});
108: $r->print($start_page);
109:
110: my $numtitles = @codetitles;
111: my $domdesc = $Apache::lonnet::domaindescription{$codedom};
1.2 raeburn 112: $r->print('<h3>'.&mt('Display information about official [_1] classes for which LON-CAPA courses have been created:',$domdesc).'</h3>');
1.1 raeburn 113: $r->print(&mt('<b>Choose which course(s) to list.</b><br />'));
114: $r->print('<form name="coursecatalog" method="post">');
115: if ($numtitles > 0) {
116: my $lasttitle = $numtitles;
117: if ($numtitles > 4) {
118: $lasttitle = 4;
119: }
120: $r->print('<table><tr><td>'.$codetitles[0].'<br />'."\n".
121: '<select name="'.$codetitles[0].'" onChange="courseSet('."'$codetitles[0]'".')">'."\n".
122: ' <option value="-1" />Select'."\n");
123: my @items = ();
124: my @longitems = ();
125: if ($idlist{$codetitles[0]} =~ /","/) {
1.4 ! albertel 126: @items = split(/","/,$idlist{$codetitles[0]});
1.1 raeburn 127: } else {
128: $items[0] = $idlist{$codetitles[0]};
129: }
130: if (defined($idlist_titles{$codetitles[0]})) {
131: if ($idlist_titles{$codetitles[0]} =~ /","/) {
1.4 ! albertel 132: @longitems = split(/","/,$idlist_titles{$codetitles[0]});
1.1 raeburn 133: } else {
134: $longitems[0] = $idlist_titles{$codetitles[0]};
135: }
136: for (my $i=0; $i<@longitems; $i++) {
137: if ($longitems[$i] eq '') {
138: $longitems[$i] = $items[$i];
139: }
140: }
141: } else {
142: @longitems = @items;
143: }
144: for (my $i=0; $i<@items; $i++) {
145: $r->print(' <option value="'.$items[$i].'">'.$longitems[$i].'</option>');
146: }
147: $r->print('</select></td>');
148: for (my $i=1; $i<$numtitles; $i++) {
149: $r->print('<td>'.$codetitles[$i].'<br />'."\n".
150: '<select name="'.$codetitles[$i].'" onChange="courseSet('."'$codetitles[$i]'".')">'."\n".
151: '<option value="-1"><-Pick '.$codetitles[$i-1].'</option>'."\n".
152: '</select>'."\n".
153: '</td>'
154: );
155: }
156: $r->print('</tr></table>');
157: if ($numtitles > 4) {
158: $r->print('<br /><br />'.$codetitles[$numtitles].'<br />'."\n".
159: '<select name="'.$codetitles[$numtitles].
160: '" onChange="courseSet('."'$codetitles[$numtitles]'".')">'."\n".
161: '<option value="-1"><-Pick '.$codetitles[$numtitles-1].
162: '</option>'."\n".'</select>'."\n");
163: }
164: }
165: $r->print('<br /><input type="hidden" name="state" value="listing" /><input type="hidden" name="sortby" value="" /><input type="submit" name="catalogfilter" value="'.&mt('Display courses').'" /></form>');
166: }
167: if ($env{'form.state'} eq 'listing') {
1.4 ! albertel 168: $r->print('<br /><br />'.&print_course_listing($codedom));
1.1 raeburn 169: }
170: $r->print(&Apache::loncommon::end_page());
171: }
172:
173: sub print_course_listing {
174: my ($domain) = @_;
175: my $output;
176: my $year = $env{'form.Year'};
177: my $sem = $env{'form.Semester'};
178: my $dept = $env{'form.Department'};
179: my $coursenum = $env{'form.Number'};
180: my $instcode;
181: if ($sem != -1) {
182: $instcode .= $sem;
183: }
184: if ($year != -1) {
185: $instcode .= $year;
186: }
187: if ($dept != -1) {
188: $instcode .= $dept;
189: }
190: if ($coursenum != -1) {
191: $instcode .= $coursenum;
192: }
193: my %courses = &Apache::lonnet::courseiddump($domain,'.',1,$instcode,'.','.',
194: undef,undef,'Course');
195: if (keys(%courses) == 0) {
1.2 raeburn 196: $output = &mt('No courses match the criteria you selected.');
1.1 raeburn 197: return $output;
198: }
1.2 raeburn 199: $output = &mt('<b>Note for students:</b> If you are officially enrolled in a course but there is no student role for the course in your LON-CAPA roles screen, check the default access dates and/or auto-enrollment settings for the course below. Your roles screen displays only currently accessible roles.<br /><br />');
1.1 raeburn 200: $output .= &Apache::loncommon::start_data_table().
201: &Apache::loncommon::start_data_table_header_row().
202: '<th><a href="javascript:changeSort('."'code'".')">'.&mt('Code').'</a></th>'.
203: '<th>'.&mt('Sections').'</th>'.
1.2 raeburn 204: '<th>'.&mt('Crosslisted').'</th>'.
1.1 raeburn 205: '<th><a href="javascript:changeSort('."'title'".')">'.&mt('Title').'</a></th>'.
206: '<th><a href="javascript:changeSort('."'owner'".')">'.&mt('Owner').'</a></th>'.
1.2 raeburn 207: '<th>'.&mt('Student Status').'</th>'.
1.1 raeburn 208: '<th>'.&mt('Default Access Dates').'</th>'.
1.2 raeburn 209: '<th>'.&mt('Auto-enrollment').'</th>'.
1.1 raeburn 210: &Apache::loncommon::end_data_table_header_row();
211: my %courseinfo;
212: foreach my $course (keys(%courses)) {
213: my $descr;
214: if ($courses{$course} =~ m/^([^:]*):/i) {
215: $descr = &unescape($1);
216: } else {
217: $descr = &unescape($courses{$course});
218: }
219: my $cleandesc=&HTML::Entities::encode($descr,'<>&"');
220: $cleandesc=~s/'/\\'/g;
221: my ($cdom,$cnum)=split(/\_/,$course);
1.2 raeburn 222:
1.4 ! albertel 223: my ($desc,$instcode,$owner,$ttype) = split(/:/,$courses{$course});
1.1 raeburn 224: $owner = &unescape($owner);
225: my ($ownername,$ownerdom);
226: if ($owner =~ /:/) {
227: ($ownername,$ownerdom) = split(/:/,$owner);
228: } else {
229: $ownername = $owner;
230: if ($owner ne '') {
231: $ownerdom = $cdom;
232: }
233: }
234: my %ownernames;
235: if ($ownername ne '' && $ownerdom ne '') {
236: %ownernames = &Apache::loncommon::getnames($ownername,$ownerdom);
237: }
238: $courseinfo{$course}{'cdom'} = $cdom;
239: $courseinfo{$course}{'cnum'} = $cnum;
240: $courseinfo{$course}{'code'} = $instcode;
241: $courseinfo{$course}{'ownerlastname'} = $ownernames{'lastname'};
242: $courseinfo{$course}{'title'} = $cleandesc;
1.2 raeburn 243: $courseinfo{$course}{'owner'} = $owner;
1.1 raeburn 244: }
245: my %Sortby;
246: foreach my $course (sort(keys(%courses))) {
247: if ($env{'form.sortby'} eq 'code') {
248: push(@{$Sortby{$courseinfo{$course}{'code'}}},$course);
249: } elsif ($env{'form.sortby'} eq 'owner') {
250: push(@{$Sortby{$courseinfo{$course}{'ownerlastname'}}},$course);
251: } else {
252: push(@{$Sortby{$courseinfo{$course}{'title'}}},$course);
253: }
254: }
255: my @sorted_courses;
256: if (($env{'form.sortby'} eq 'code') || ($env{'form.sortby'} eq 'owner')) {
257: @sorted_courses = sort(keys(%Sortby));
258: } else {
259: @sorted_courses = sort { lc($a) cmp lc($b) } (keys(%Sortby));
260: }
261: foreach my $item (@sorted_courses) {
262: foreach my $course (@{$Sortby{$item}}) {
263: $output.=&Apache::loncommon::start_data_table_row();
264: $output.=&courseinfo_row($courseinfo{$course});
265: $output.=&Apache::loncommon::end_data_table_row();
266: }
267: }
268: $output .= &Apache::loncommon::end_data_table();
269: return $output;
270: }
271:
272: sub courseinfo_row {
273: my ($info) = @_;
1.2 raeburn 274: my ($cdom,$cnum,$title,$ownerlast,$code,$owner,$output);
1.1 raeburn 275: if (ref($info) eq 'HASH') {
276: $cdom = $info->{'cdom'};
277: $cnum = $info->{'cnum'};
278: $title = $info->{'title'};
1.2 raeburn 279: $ownerlast = $info->{'ownerlastname'};
280: $code = $info->{'code'};
281: $owner = $info->{'owner'};
1.1 raeburn 282: } else {
1.2 raeburn 283: $output = '<td colspan="8">'.&mt('No information available for [_1].',
284: $code).'</td>';
1.1 raeburn 285: return $output;
286: }
287: my %coursehash = &Apache::lonnet::dump('environment',$cdom,$cnum);
288: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
289: my %idx;
1.2 raeburn 290: my @classids;
291: my @crosslistings;
1.1 raeburn 292: $idx{'status'} = &Apache::loncoursedata::CL_STATUS();
1.4 ! albertel 293: my %status_title = &Apache::lonlocal::texthash(
1.1 raeburn 294: Expired => 'Previous access',
295: Active => 'Current access',
296: Future => 'Future access',
297: );
298: my %student_count = (
299: Expired => 0,
300: Active => 0,
301: Future => 0,
302: );
1.4 ! albertel 303: while (my ($student,$data) = each(%$classlist)) {
1.1 raeburn 304: $student_count{$data->[$idx{'status'}]} ++;
305: }
306: my $seclist = &identify_sections($coursehash{'internal.sectionnums'});
1.2 raeburn 307: my $xlist_items = &identify_sections($coursehash{'internal.crosslistings'});
1.1 raeburn 308: my $countslist;
309: my $startaccess = '';
310: my $endaccess = '';
1.2 raeburn 311: my $now;
312: my ($accessdates,$autoenrolldates,$showsyllabus);
1.1 raeburn 313: if ( defined($coursehash{'default_enrollment_start_date'}) ) {
314: $startaccess = &Apache::lonlocal::locallocaltime($coursehash{'default_enrollment_start_date'});
315: }
316: if ( defined($coursehash{'default_enrollment_end_date'}) ) {
317: $endaccess = &Apache::lonlocal::locallocaltime($coursehash{'default_enrollment_end_date'});
318: if ($coursehash{'default_enrollment_end_date'} == 0) {
319: $endaccess = "No ending date";
320: }
321: }
322: if ($startaccess) {
323: $accessdates .= &mt('From: ').$startaccess.'<br />';
324: }
325: if ($endaccess) {
326: $accessdates .= &mt('To: ').$endaccess.'<br />';
327: }
1.2 raeburn 328: $autoenrolldates = &mt('Not enabled');
329: if (defined($coursehash{'internal.autoadds'}) && $coursehash{'internal.autoadds'} == 1) {
1.1 raeburn 330: my ($autostart,$autoend);
331: if ( defined($coursehash{'internal.autostart'}) ) {
332: $autostart = &Apache::lonlocal::locallocaltime($coursehash{'internal.autostart'});
333: }
334: if ( defined($coursehash{'internal.autoend'}) ) {
335: $autoend = &Apache::lonlocal::locallocaltime($coursehash{'internal.autoend'});
1.2 raeburn 336: }
337: if ($coursehash{'internal.autostart'} > $now) {
338: if ($coursehash{'internal.autoend'} && $coursehash{'internal.autoend'} < $now) {
339: $autoenrolldates = &mt('Not enabled');
340: } else {
341: my $valid_classes = &get_valid_classes($seclist,$xlist_items,
342: $code,$owner,$cdom,$cnum);
343: if ($valid_classes ne '') {
344: $autoenrolldates = &mt('Not enabled<br />Starts: ').
345: $autostart.'<br />'.$valid_classes;
346: }
347: }
348: } else {
349: if ($coursehash{'internal.autoend'} && $coursehash{'internal.autoend'} < $now) {
350: $autoenrolldates = &mt('Not enabled<br />Ended: ').$autoend;
351: } else {
352: my $valid_classes = &get_valid_classes($seclist,$xlist_items,
353: $code,$owner,$cdom,$cnum);
354: if ($valid_classes ne '') {
355: $autoenrolldates = &mt('Currently enabled<br />').
356: $valid_classes;
357: }
1.1 raeburn 358: }
359: }
360: }
1.2 raeburn 361: if (defined($coursehash{'showsyllabus'})) {
362: $showsyllabus = $coursehash{'showsyllabus'};
363: }
1.1 raeburn 364: foreach my $status ('Active','Future','Expired') {
365: $countslist .= '<nobr>'.$status_title{$status}.': '.
366: $student_count{$status}.'</nobr><br />';
367: }
1.2 raeburn 368: if ($xlist_items eq '') {
369: $xlist_items = &mt('No');
370: }
1.1 raeburn 371: $output = '<td>'.$coursehash{'internal.coursecode'}.'</td>'.
372: '<td>'.$seclist.'</td>'.
1.2 raeburn 373: '<td>'.$xlist_items.'</td>'.
374: '<td>'.$title.' <font size="-2">';
375: if ($showsyllabus) {
376: $output .= &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$cnum,$cdom);
377: }
378: $output .= '</font></td>'.
379: '<td>'.$ownerlast.'</td>'.
380: '<td>'.$countslist.'</td>'.
381: '<td>'.$accessdates.'</td>'.
382: '<td>'.$autoenrolldates.'</td>';
1.1 raeburn 383: return $output;
384: }
385:
386: sub identify_sections {
387: my ($seclist) = @_;
388: my @secnums;
389: if ($seclist =~ /,/) {
1.4 ! albertel 390: my @sections = split(/,/,$seclist);
1.1 raeburn 391: foreach my $sec (@sections) {
392: $sec =~ s/:[^:]*$//;
393: push(@secnums,$sec);
394: }
395: } else {
396: if ($seclist =~ m/^([^:]+):/) {
397: my $sec = $1;
1.4 ! albertel 398: if (!grep(/^\Q$sec\E$/,@secnums)) {
! 399: push(@secnums,$sec);
1.1 raeburn 400: }
401: }
402: }
403: @secnums = sort {$a <=> $b} @secnums;
404: my $seclist = join(', ',@secnums);
405: return $seclist;
406: }
407:
1.2 raeburn 408: sub get_valid_classes {
409: my ($seclist,$xlist_items,$crscode,$owner,$cdom,$cnum) = @_;
410: my $response;
411: my %validations;
412: @{$validations{'sections'}} = ();
413: @{$validations{'xlists'}} = ();
414: my $totalitems = 0;
415: if ($seclist) {
416: foreach my $sec (split(',',$seclist)) {
417: my $class = $crscode.$sec;
1.3 albertel 418: if (&Apache::lonnet::auto_validate_class_sec($cdom,$cnum,$owner,
419: $class) eq 'ok') {
1.2 raeburn 420: if (!grep(/^\Q$sec$\E/,@{$validations{'sections'}})) {
1.4 ! albertel 421: push(@{$validations{'sections'}},$sec);
1.2 raeburn 422: $totalitems ++;
423: }
424: }
425: }
426: }
427: if ($xlist_items) {
428: foreach my $item (split(',',$xlist_items)) {
1.3 albertel 429: if (&Apache::lonnet::auto_validate_class_sec($cdom,$cnum,$owner,
430: $item) eq 'ok') {
1.2 raeburn 431: if (!grep(/^\Q$item$\E/,@{$validations{'xlists'}})) {
1.4 ! albertel 432: push(@{$validations{'xlists'}},$item);
1.2 raeburn 433: $totalitems ++;
434: }
435: }
436: }
437: }
438: if ($totalitems > 0) {
439: if (@{$validations{'sections'}}) {
440: $response = &mt('Sections: ').
441: join(',',@{$validations{'sections'}}).'<br />';
442: }
443: if (@{$validations{'xlists'}}) {
444: $response .= &mt('Courses: ').
445: join(',',@{$validations{'xlists'}});
446: }
447: }
448: return $response;
449: }
450:
1.1 raeburn 451:
452: 1;
453:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to coursecatalog.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface