loncom/cgi/listcodes.pl - view

File: [LON-CAPA] / loncom / cgi / listcodes.pl
Revision 1.2: download - view: text, annotated - select for diffs
Wed Jan 1 19:07:44 2014 UTC (10 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_X, version_2_11_5_msu, version_2_11_5, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0, HEAD

- Include the course ID as an attribute of the <course> tag when
  rendering unique course codes in xml format.

#!/usr/bin/perl $|=1; # Listing of domain's courses with unique six character codes # $Id: listcodes.pl,v 1.2 2014/01/01 19:07:44 raeburn Exp $ # # 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/ # ############################################# ############################################# =pod =head1 NAME listcodes.pl =head1 SYNOPSIS CGI script to display course codes and associated information as plain text or XML. Possible formats are: plain text (CSV), XML or HTML and the desired format is specified in query string. The query string should also contain the domain for which this data is being requested. The current server needs to be the homeserver of the special domconfig "user", which will be the primary library server in the domain. =head1 Subroutines =over 4 =cut ############################################# ############################################# use strict; use lib '/home/httpd/lib/perl/'; use LONCAPA::loncgi; use LONCAPA::lonauthcgi; use Apache::lonnet(); use Apache::loncommon(); use Apache::lonlocal; use LONCAPA; &main(); exit 0; ############################################# ############################################# =pod =item main() Inputs: None Returns: Nothing Description: Main program. Determines if requesting IP is allowed to view unique codes for domains for which this server is the primary library server. =cut ############################################# ############################################# sub main { my (%gets,$reqdom,$domdesc); &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets); if (ref($gets{'domain'}) eq 'ARRAY') { $gets{'domain'}->[0] =~ s/^\s+|\s+$//g; if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) { my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]); unless ($domdesc eq '') { $reqdom = $gets{'domain'}->[0]; } } } if ($reqdom eq '') { print &LONCAPA::loncgi::cgi_header('text/plain',1); &Apache::lonlocal::get_language_handle(); print &mt('The query string needs to include domain=dom, where dom is a valid domain.')."\n"; return; } my @hosts = &Apache::lonnet::current_machine_ids(); my $confname = $reqdom.'-domainconfig'; my $confhome = &Apache::lonnet::homeserver($confname,$reqdom); unless (grep(/^\Q$confhome\E$/,@hosts)) { print &LONCAPA::loncgi::cgi_header('text/plain',1); &Apache::lonlocal::get_language_handle(); print &mt("This server is not the home server for the domain config 'user' for the requested domain.")."\n". &mt('You will need to access this information from: [_1].',$confhome); return; } my $remote_ip = $ENV{'REMOTE_ADDR'}; my $allowed; if (&LONCAPA::lonauthcgi::check_ipbased_access('uniquecodes',$remote_ip)) { $allowed = 1; } elsif (&LONCAPA::loncgi::check_cookie_and_load_env()) { $allowed = &LONCAPA::lonauthcgi::can_view('uniquecodes'); } &LONCAPA::loncgi::check_cookie_and_load_env(); &Apache::lonlocal::get_language_handle(); if ($allowed ne '') { my ($format,@okdoms); unless ($allowed == 1) { @okdoms = split(/\&/,$allowed); unless (grep(/^\Q$reqdom\E$/,@okdoms)) { print &LONCAPA::loncgi::cgi_header('text/plain',1); print &mt('You do not have access rights to view course codes for the requested domain.')."\n"; return; } } if (ref($gets{'format'}) eq 'ARRAY') { $format = $gets{'format'}->[0]; } if ($format eq 'html') { print &LONCAPA::loncgi::cgi_header('text/html',1); } elsif ($format eq 'xml') { print &LONCAPA::loncgi::cgi_header('text/xml',1); } else { $format = 'csv'; print &LONCAPA::loncgi::cgi_header('text/plain',1); } my ($count,$output) = &show_results($reqdom,$format,\%gets); if ($output) { if ($format eq 'html') { &start_html($reqdom,&mt('LON-CAPA Courses with Unique Six Character Codes')); print $output; &end_html; } elsif ($count) { if ($format eq 'xml') { &start_xml(); } print $output; } } } else { print &LONCAPA::loncgi::cgi_header('text/plain',1); &LONCAPA::lonauthcgi::unauthorized_msg('uniquecodes'); } return; } ############################################# ############################################# =pod =item show_results() Inputs: $reqdom - domain for which unique codes and course information are to be shown. $format - format for output, one of: html, xml or csv. csv is the default, if no format specified. $getshash - references to hash of key=value pairs from the query string. Keys which will be used are: code, and num. Returns: $count - number of items detected $output - output to display. If there are no matches, or the input argument (code or num) was invalid, no output is returned unless the requested format is html. Note: in the case of a query without a specific code or courseID, the output is printed within the &show_results() routine when looping over courses retrieved by a call to lonnet::courseiddump, so $output is blank, in this case, unless no courses match. Description: Displays LON-CAPA courseID, unique codes, course owner, and course title. Data displayed can be a single record, if the query string contains code=<six character code> or num=<LON CAPA course ID>. Data formats are: html, xml, or plain text (csv). =cut ############################################# ############################################# sub show_results { my ($reqdom,$format,$gethash) = @_; my ($uniquecode,$cnum,$output); if (ref($gethash) eq 'HASH') { if (ref($gethash->{'code'}) eq 'ARRAY') { $gethash->{'code'}->[0] =~ s/^\s+|\s+$//g; if ($gethash->{'code'}->[0] =~ /^\w{6}$/) { $uniquecode = $gethash->{'code'}->[0]; } else { if ($format eq 'html') { $output = &mt('Invalid code'); } return (0,$output); } } if (ref($gethash->{'num'}) eq 'ARRAY') { $gethash->{'num'}->[0] =~ s/^\s+|\s+$//g; if ($gethash->{'num'}->[0] =~ /^$LONCAPA::match_courseid$/) { my $chome = &Apache::lonnet::homeserver($gethash->{'num'}->[0],$reqdom); if ($chome ne 'no_host') { $cnum = $gethash->{'num'}->[0]; } else { if ($format eq 'html') { $output = &mt('Course ID does not exist'); } return (0,$output); } } else { if ($format eq 'html') { $output = &mt('Invalid course ID'); } return (0,$output); } } } if ($uniquecode) { my $confname = $reqdom.'-domainconfig'; my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$reqdom,$confname); if ($codes{$uniquecode}) { my %courseinfo = &Apache::lonnet::coursedescription($reqdom.'_'.$codes{$uniquecode},{one_time => 1}); if (keys(%courseinfo)) { $output = &buildline($format,$codes{$uniquecode},\%courseinfo); return (1,$output); } else { if ($format eq 'html') { $output = &mt('Code matched, but course ID to which this mapped is invalid.'); } return (0,$output); } } else { if ($format eq 'html') { $output = &mt('No match'); } return (0,$output); } } if ($cnum) { my %courseinfo = &Apache::lonnet::coursedescription($reqdom.'_'.$cnum,{one_time => 1}); if (keys(%courseinfo)) { $output = &buildline($format,$cnum,\%courseinfo); return (1,$output); } else { if ($format eq 'html') { $output = &mt('No match'); } return (0,$output); } } my %courses = &Apache::lonnet::courseiddump($reqdom,'.',1,'.','.','.',undef,undef,'.',undef, undef,undef,undef,undef,undef,undef,undef,undef, undef,undef,undef,1); if (keys(%courses)) { my (@rowstart,$rowend,$separator,%ownername); if ($format eq 'html') { &start_html($reqdom,&mt('LON-CAPA Courses with Unique Six Character Codes')); print &html_table_start(); $rowstart[0] = '<tr class="LC_even_row"><td>'; $rowstart[1] = '<tr class="LC_odd_row"><td>'; $rowend = '</td></tr>'."\n"; $separator = '</td><td>'; } elsif ($format eq 'xml') { &start_xml(); print "<courses>\n"; } else { @rowstart = ('',''); $separator = ','; $rowend = "\n"; } my $num = 0; foreach my $course (sort(keys(%courses))) { if (ref($courses{$course}) eq 'HASH') { my ($cdom,$cnum) = split(/_/,$course); my $instructor; if ($courses{$course}{'owner'}) { unless (exists($ownername{$courses{$course}{'owner'}})) { my ($uname,$udom) = split(/:/,$courses{$course}{'owner'}); $ownername{$courses{$course}{'owner'}} = &Apache::loncommon::plainname($uname,$udom,'lastname'); } $instructor = $ownername{$courses{$course}{'owner'}}; } if ($format eq 'xml') { print <<"END"; <course id="$cnum"> <code>$courses{$course}{'uniquecode'}</code> <title>$courses{$course}{'description'}</title> <owner>$courses{$course}{'owner'}</owner> <name>$instructor</name> </course> END } else { my $idx = $num%2; print $rowstart[$idx].$cnum.$separator.$courses{$course}{'uniquecode'}.$separator. $courses{$course}{'description'}.$separator. $courses{$course}{'owner'}.$separator.$instructor.$rowend; } $num ++; } } if ($format eq 'html') { print '</table>'; &end_html(); } elsif ($format eq 'xml') { print "</courses>\n"; } return ($num,$output); } else { if ($format eq 'html') { $output = &mt('No courses currently have six character identifiers.'); } return (0,$output); } } ############################################# ############################################# sub buildline { my ($format,$cnum,$courseinfo) = @_; return unless (ref($courseinfo) eq 'HASH'); my $code = $courseinfo->{'internal.uniquecode'}; my $title = $courseinfo->{'description'}; my $owner = $courseinfo->{'internal.courseowner'}; my $fullname; if ($owner) { my ($uname,$udom) = split(/:/,$owner); $fullname = &Apache::loncommon::plainname($uname,$udom,'lastname'); } if ($format eq 'html') { return &html_table_start(). '<tr>'. '<td>'.$cnum.'</td>'. '<td>'.$code.'</td>'. '<td>'.$title.'</td>'. '<td>'.$owner.'</td>'. '<td>'.$fullname.'</td></tr>'. '</table>'; } elsif ($format eq 'xml') { <<"END"; <courses> <course id="$cnum"> <code>$code</code> <title>$title</title> <owner>$owner</owner> <name>$fullname</name> <course> </courses> END } else { return $cnum.','.$code.','.$title.','.$owner.','.$fullname."\n"; } } sub start_html { my ($dom,$title) = @_; my $url; if ($Apache::lonnet::env{'user.name'} && $Apache::lonnet::env{'user.domain'}) { my $function = &Apache::loncommon::get_users_function(); my $bgcolor = &Apache::loncommon::designparm($function.'.pgbg',$dom); $url = join(':',$Apache::lonnet::env{'user.name'},$Apache::lonnet::env{'user.domain'}, $Apache::lonnet::perlvar{'lonVersion'}, #time(), $Apache::lonnet::env{'environment.color.timestamp'}, $function,$dom,$bgcolor); $url = '/adm/css/'.&escape($url).'.css'; } print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n". '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n\n". '<head>'."\n". '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n"; if ($url) { print '<link rel="stylesheet" type="text/css" href="'.$url.'" />'."\n"; } print '<title>'.$title.'</title>'."\n". '</head>'."\n". '<body style="background-color:#ffffff">'."\n". '<div>'."\n"; return; } sub end_html { print '</div>'."\n". '</body>'."\n". '</html>'; return; } sub html_table_start { return '<table class="LC_data_table">'. '<tr class="LC_header_row">'. '<th>'.&mt('Course ID').'</th>'."\n". '<th>'.&mt('Code').'</th>'."\n". '<th>'.&mt('Title').'</th>'."\n". '<th>'.&mt('Owner').'</th>'."\n". '<th>'.&mt('Instructor name').'</th>'."\n". '</tr>'; } sub start_xml { print '<?xml version="1.0" encoding="UTF-8"?>'."\n".'<!DOCTYPE text>'."\n"; return; } =pod =back =cut