[LON-CAPA-cvs] cvs: loncom /interface coursecatalog.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 29 Aug 2006 21:03:11 -0000
This is a MIME encoded message
--raeburn1156885391
Content-Type: text/plain
raeburn Tue Aug 29 17:03:11 2006 EDT
Added files:
/loncom/interface coursecatalog.pm
Log:
Display information about courses which have associated institutional codes, filtered by year, semester, department and course number. Refactoring of this script and lonsupportreq.pm to follow (shared utility functions to move to a new module).
--raeburn1156885391
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20060829170311.txt"
Index: loncom/interface/coursecatalog.pm
+++ loncom/interface/coursecatalog.pm
#
# 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/
#
package Apache::coursecatalog;
use strict;
use lib qw(/home/httpd/lib/perl);
use Apache::Constants qw(:common);
use Apache::loncommon;
use Apache::lonnet;
use Apache::lonlocal;
use Apache::lonsupportreq;
use Apache::lonacc;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
sub handler {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($r->header_only) {
return OK;
}
&Apache::lonacc::get_posted_cgi($r);
&Apache::lonlocal::get_language_handle($r);
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['sortby']);
my $codedom = $Apache::lonnet::perlvar{'lonDefDomain'};
my $ccode = '';
my %coursecodes = ();
my %codes = ();
my @codetitles = ();
my %cat_titles = ();
my %cat_order = ();
my %idlist = ();
my %idnums = ();
my %idlist_titles = ();
my $caller = 'global';
my $format_reply;
my $totcodes = 0;
my $jscript = '';
my $formname = 'coursecatalog';
$totcodes = &Apache::lonsupportreq::retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
if ($totcodes > 0) {
if ($ccode eq '') {
$format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
if ($format_reply eq 'ok') {
my $numtypes = @codetitles;
&Apache::lonsupportreq::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
&Apache::lonsupportreq::javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
}
}
if ($env{'form.state'} eq 'listing') {
$jscript .= '
function setElements() {
';
for (my $i=0; $i<@codetitles; $i++) {
if ($env{'form.'.$codetitles[$i]} != -1) {
$jscript .= '
for (var j=0; j<document.'.$formname.'.'.$codetitles[$i].'.length; j++) {
if (document.'.$formname.'.'.$codetitles[$i].'[j].value == "'.$env{'form.'.$codetitles[$i]}.'") {
document.'.$formname.'.'.$codetitles[$i].'.selectedIndex = j;
}
}
';
$jscript .= ' courseSet('."'$codetitles[$i]'".');'."\n";
} else {
last;
}
}
$jscript .= '}';
$jscript .= qq|
function changeSort(caller) {
document.coursecatalog.sortby.value = caller;
document.coursecatalog.submit();
}\n|;
}
my $js = '<script type"text/javascript">'."\n$jscript\n".
'</script>';
my %add_entries = (topmargin => "0",
marginheight => "0",
onLoad =>"setElements()",);
my $start_page =
&Apache::loncommon::start_page('Course Catalog',$js,
{
'add_entries' => \%add_entries,
'no_inline_link' => 1,});
$r->print($start_page);
my $numtitles = @codetitles;
my $domdesc = $Apache::lonnet::domaindescription{$codedom};
$r->print('<h3>'.&mt('Display information about official [_1] courses in LON-CAPA:',$domdesc).'</h3>');
$r->print(&mt('<b>Choose which course(s) to list.</b><br />'));
$r->print('<form name="coursecatalog" method="post">');
if ($numtitles > 0) {
my $lasttitle = $numtitles;
if ($numtitles > 4) {
$lasttitle = 4;
}
$r->print('<table><tr><td>'.$codetitles[0].'<br />'."\n".
'<select name="'.$codetitles[0].'" onChange="courseSet('."'$codetitles[0]'".')">'."\n".
' <option value="-1" />Select'."\n");
my @items = ();
my @longitems = ();
if ($idlist{$codetitles[0]} =~ /","/) {
@items = split/","/,$idlist{$codetitles[0]};
} else {
$items[0] = $idlist{$codetitles[0]};
}
if (defined($idlist_titles{$codetitles[0]})) {
if ($idlist_titles{$codetitles[0]} =~ /","/) {
@longitems = split/","/,$idlist_titles{$codetitles[0]};
} else {
$longitems[0] = $idlist_titles{$codetitles[0]};
}
for (my $i=0; $i<@longitems; $i++) {
if ($longitems[$i] eq '') {
$longitems[$i] = $items[$i];
}
}
} else {
@longitems = @items;
}
for (my $i=0; $i<@items; $i++) {
$r->print(' <option value="'.$items[$i].'">'.$longitems[$i].'</option>');
}
$r->print('</select></td>');
for (my $i=1; $i<$numtitles; $i++) {
$r->print('<td>'.$codetitles[$i].'<br />'."\n".
'<select name="'.$codetitles[$i].'" onChange="courseSet('."'$codetitles[$i]'".')">'."\n".
'<option value="-1"><-Pick '.$codetitles[$i-1].'</option>'."\n".
'</select>'."\n".
'</td>'
);
}
$r->print('</tr></table>');
if ($numtitles > 4) {
$r->print('<br /><br />'.$codetitles[$numtitles].'<br />'."\n".
'<select name="'.$codetitles[$numtitles].
'" onChange="courseSet('."'$codetitles[$numtitles]'".')">'."\n".
'<option value="-1"><-Pick '.$codetitles[$numtitles-1].
'</option>'."\n".'</select>'."\n");
}
}
$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>');
}
if ($env{'form.state'} eq 'listing') {
$r->print('<br /><br >'.&print_course_listing($codedom));
}
$r->print(&Apache::loncommon::end_page());
}
sub print_course_listing {
my ($domain) = @_;
my $output;
my $year = $env{'form.Year'};
my $sem = $env{'form.Semester'};
my $dept = $env{'form.Department'};
my $coursenum = $env{'form.Number'};
my $instcode;
if ($sem != -1) {
$instcode .= $sem;
}
if ($year != -1) {
$instcode .= $year;
}
if ($dept != -1) {
$instcode .= $dept;
}
if ($coursenum != -1) {
$instcode .= $coursenum;
}
my %courses = &Apache::lonnet::courseiddump($domain,'.',1,$instcode,'.','.',
undef,undef,'Course');
if (keys(%courses) == 0) {
$output = &mt('No courses match the criteria you selected');
return $output;
}
$output = &mt('<b>Note for students:</b> If STUINFO shows you as enrolled in a course, but there is no student role for the course in your LON-CAPA roles screen, please check the default access dates and/or auto-enrollment dates for the course listed below. Your roles screen will only display currently accessible roles.<br /><br />');
$output .= &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
'<th><a href="javascript:changeSort('."'code'".')">'.&mt('Code').'</a></th>'.
'<th>'.&mt('Sections').'</th>'.
'<th><a href="javascript:changeSort('."'title'".')">'.&mt('Title').'</a></th>'.
'<th><a href="javascript:changeSort('."'owner'".')">'.&mt('Owner').'</a></th>'.
'<th>'.&mt('Students').'</th>'.
'<th>'.&mt('Default Access Dates').'</th>'.
'<th>'.&mt('Auto-enrollment Dates').'</th>'.
&Apache::loncommon::end_data_table_header_row();
my %courseinfo;
foreach my $course (keys(%courses)) {
my $descr;
if ($courses{$course} =~ m/^([^:]*):/i) {
$descr = &unescape($1);
} else {
$descr = &unescape($courses{$course});
}
my $cleandesc=&HTML::Entities::encode($descr,'<>&"');
$cleandesc=~s/'/\\'/g;
my ($cdom,$cnum)=split(/\_/,$course);
my ($desc,$instcode,$owner,$ttype) = split/:/,$courses{$course};
$owner = &unescape($owner);
my ($ownername,$ownerdom);
if ($owner =~ /:/) {
($ownername,$ownerdom) = split(/:/,$owner);
} else {
$ownername = $owner;
if ($owner ne '') {
$ownerdom = $cdom;
}
}
my %ownernames;
if ($ownername ne '' && $ownerdom ne '') {
%ownernames = &Apache::loncommon::getnames($ownername,$ownerdom);
}
$courseinfo{$course}{'cdom'} = $cdom;
$courseinfo{$course}{'cnum'} = $cnum;
$courseinfo{$course}{'code'} = $instcode;
$courseinfo{$course}{'ownerlastname'} = $ownernames{'lastname'};
$courseinfo{$course}{'title'} = $cleandesc;
}
my %Sortby;
foreach my $course (sort(keys(%courses))) {
if ($env{'form.sortby'} eq 'code') {
push(@{$Sortby{$courseinfo{$course}{'code'}}},$course);
} elsif ($env{'form.sortby'} eq 'owner') {
push(@{$Sortby{$courseinfo{$course}{'ownerlastname'}}},$course);
} else {
push(@{$Sortby{$courseinfo{$course}{'title'}}},$course);
}
}
my @sorted_courses;
if (($env{'form.sortby'} eq 'code') || ($env{'form.sortby'} eq 'owner')) {
@sorted_courses = sort(keys(%Sortby));
} else {
@sorted_courses = sort { lc($a) cmp lc($b) } (keys(%Sortby));
}
foreach my $item (@sorted_courses) {
foreach my $course (@{$Sortby{$item}}) {
$output.=&Apache::loncommon::start_data_table_row();
$output.=&courseinfo_row($courseinfo{$course});
$output.=&Apache::loncommon::end_data_table_row();
}
}
$output .= &Apache::loncommon::end_data_table();
return $output;
}
sub courseinfo_row {
my ($info) = @_;
my ($cdom,$cnum,$title,$owner,$output);
if (ref($info) eq 'HASH') {
$cdom = $info->{'cdom'};
$cnum = $info->{'cnum'};
$title = $info->{'title'};
$owner = $info->{'ownerlastname'};
} else {
$output = '<td colspan="7">'.&mt('No information available').'</td>';
return $output;
}
my %coursehash = &Apache::lonnet::dump('environment',$cdom,$cnum);
my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
my %idx;
$idx{'status'} = &Apache::loncoursedata::CL_STATUS();
my %status_title = &Apache::lonlocal::texthash (
Expired => 'Previous access',
Active => 'Current access',
Future => 'Future access',
);
my %student_count = (
Expired => 0,
Active => 0,
Future => 0,
);
while (my ($student,$data) = each %$classlist) {
$student_count{$data->[$idx{'status'}]} ++;
}
my $seclist = &identify_sections($coursehash{'internal.sectionnums'});
my $countslist;
my $startaccess = '';
my $endaccess = '';
my ($accessdates,$autoenrolldates);
if ( defined($coursehash{'default_enrollment_start_date'}) ) {
$startaccess = &Apache::lonlocal::locallocaltime($coursehash{'default_enrollment_start_date'});
}
if ( defined($coursehash{'default_enrollment_end_date'}) ) {
$endaccess = &Apache::lonlocal::locallocaltime($coursehash{'default_enrollment_end_date'});
if ($coursehash{'default_enrollment_end_date'} == 0) {
$endaccess = "No ending date";
}
}
if ($startaccess) {
$accessdates .= &mt('From: ').$startaccess.'<br />';
}
if ($endaccess) {
$accessdates .= &mt('To: ').$endaccess.'<br />';
}
if (!defined($coursehash{'internal.autoadds'}) || $coursehash{'internal.autoadds'} == 0) {
$autoenrolldates = &mt('Not enabled');
} else {
my ($autostart,$autoend);
if ( defined($coursehash{'internal.autostart'}) ) {
$autostart = &Apache::lonlocal::locallocaltime($coursehash{'internal.autostart'});
}
if ( defined($coursehash{'internal.autoend'}) ) {
$autoend = &Apache::lonlocal::locallocaltime($coursehash{'internal.autoend'});
if ($coursehash{'internal.autoend'} == 0) {
$autoend = "No ending date";
}
}
if ($autostart) {
$autoenrolldates .= &mt('Starts: ').$startaccess.'<br />';
}
if ($autoend) {
$autoenrolldates .= &mt('Ends: ').$endaccess.'<br />';
}
if ($autoenrolldates eq '') {
$autoenrolldates = &mt('No start or end date set');
}
}
foreach my $status ('Active','Future','Expired') {
$countslist .= '<nobr>'.$status_title{$status}.': '.
$student_count{$status}.'</nobr><br />';
}
$output = '<td>'.$coursehash{'internal.coursecode'}.'</td>'.
'<td>'.$seclist.'</td>'.
'<td>'.$title.' <font size="-2">'.
&Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$cnum,$cdom).
'</font></td>'.
'<td>'.$owner.'</td>'.
'<td>'.$countslist.'</td>'.
'<td>'.$accessdates.'</td>'.
'<td>'.$autoenrolldates.'</td>';
return $output;
}
sub identify_sections {
my ($seclist) = @_;
my @secnums;
if ($seclist =~ /,/) {
my @sections = split/,/,$seclist;
foreach my $sec (@sections) {
$sec =~ s/:[^:]*$//;
push(@secnums,$sec);
}
} else {
if ($seclist =~ m/^([^:]+):/) {
my $sec = $1;
if (!grep/^$sec$/,@secnums) {
push (@secnums,$sec);
}
}
}
@secnums = sort {$a <=> $b} @secnums;
my $seclist = join(', ',@secnums);
return $seclist;
}
1;
--raeburn1156885391--