Annotation of loncom/cgi/listcodes.pl, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: $|=1;
! 3: # Listing of domain's courses with unique six character codes
! 4: # $Id: listcodes.pl,v 1.1 2013/12/31 20:23:36 raeburn Exp $
! 5: #
! 6: # Copyright Michigan State University Board of Trustees
! 7: #
! 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 9: #
! 10: # LON-CAPA is free software; you can redistribute it and/or modify
! 11: # it under the terms of the GNU General Public License as published by
! 12: # the Free Software Foundation; either version 2 of the License, or
! 13: # (at your option) any later version.
! 14: #
! 15: # LON-CAPA is distributed in the hope that it will be useful,
! 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 18: # GNU General Public License for more details.
! 19: #
! 20: # You should have received a copy of the GNU General Public License
! 21: # along with LON-CAPA; if not, write to the Free Software
! 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 23: #
! 24: # /home/httpd/html/adm/gpl.txt
! 25: #
! 26: # http://www.lon-capa.org/
! 27: #
! 28: #############################################
! 29: #############################################
! 30:
! 31: =pod
! 32:
! 33: =head1 NAME
! 34:
! 35: listcodes.pl
! 36:
! 37: =head1 SYNOPSIS
! 38:
! 39: CGI script to display course codes and associated
! 40: information as plain text or XML.
! 41:
! 42: Possible formats are: plain text (CSV), XML or HTML
! 43: and the desired format is specified in query string.
! 44:
! 45: The query string should also contain the domain for
! 46: which this data is being requested.
! 47:
! 48: The current server needs to be the homeserver of the
! 49: special domconfig "user", which will be the primary
! 50: library server in the domain.
! 51:
! 52: =head1 Subroutines
! 53:
! 54: =over 4
! 55:
! 56: =cut
! 57:
! 58: #############################################
! 59: #############################################
! 60:
! 61: use strict;
! 62:
! 63: use lib '/home/httpd/lib/perl/';
! 64: use LONCAPA::loncgi;
! 65: use LONCAPA::lonauthcgi;
! 66: use Apache::lonnet();
! 67: use Apache::loncommon();
! 68: use Apache::lonlocal;
! 69: use LONCAPA;
! 70:
! 71: &main();
! 72: exit 0;
! 73:
! 74: #############################################
! 75: #############################################
! 76:
! 77: =pod
! 78:
! 79: =item main()
! 80:
! 81: Inputs: None
! 82:
! 83: Returns: Nothing
! 84:
! 85: Description: Main program. Determines if requesting IP is allowed
! 86: to view unique codes for domains for which this server
! 87: is the primary library server.
! 88:
! 89: =cut
! 90:
! 91: #############################################
! 92: #############################################
! 93:
! 94: sub main {
! 95: my (%gets,$reqdom,$domdesc);
! 96: &LONCAPA::loncgi::cgi_getitems($ENV{'QUERY_STRING'},\%gets);
! 97: if (ref($gets{'domain'}) eq 'ARRAY') {
! 98: $gets{'domain'}->[0] =~ s/^\s+|\s+$//g;
! 99: if ($gets{'domain'}->[0] =~ /^$LONCAPA::match_domain$/) {
! 100: my $domdesc = &Apache::lonnet::domain($gets{'domain'}->[0]);
! 101: unless ($domdesc eq '') {
! 102: $reqdom = $gets{'domain'}->[0];
! 103: }
! 104: }
! 105: }
! 106: if ($reqdom eq '') {
! 107: print &LONCAPA::loncgi::cgi_header('text/plain',1);
! 108: &Apache::lonlocal::get_language_handle();
! 109: print &mt('The query string needs to include domain=dom, where dom is a valid domain.')."\n";
! 110: return;
! 111: }
! 112: my @hosts = &Apache::lonnet::current_machine_ids();
! 113: my $confname = $reqdom.'-domainconfig';
! 114: my $confhome = &Apache::lonnet::homeserver($confname,$reqdom);
! 115: unless (grep(/^\Q$confhome\E$/,@hosts)) {
! 116: print &LONCAPA::loncgi::cgi_header('text/plain',1);
! 117: &Apache::lonlocal::get_language_handle();
! 118: print &mt("This server is not the home server for the domain config 'user' for the requested domain.")."\n".
! 119: &mt('You will need to access this information from: [_1].',$confhome);
! 120: return;
! 121: }
! 122: my $remote_ip = $ENV{'REMOTE_ADDR'};
! 123: my $allowed;
! 124: if (&LONCAPA::lonauthcgi::check_ipbased_access('uniquecodes',$remote_ip)) {
! 125: $allowed = 1;
! 126: } elsif (&LONCAPA::loncgi::check_cookie_and_load_env()) {
! 127: $allowed = &LONCAPA::lonauthcgi::can_view('uniquecodes');
! 128: }
! 129: &LONCAPA::loncgi::check_cookie_and_load_env();
! 130: &Apache::lonlocal::get_language_handle();
! 131: if ($allowed ne '') {
! 132: my ($format,@okdoms);
! 133: unless ($allowed == 1) {
! 134: @okdoms = split(/\&/,$allowed);
! 135: unless (grep(/^\Q$reqdom\E$/,@okdoms)) {
! 136: print &LONCAPA::loncgi::cgi_header('text/plain',1);
! 137: print &mt('You do not have access rights to view course codes for the requested domain.')."\n";
! 138: return;
! 139: }
! 140: }
! 141: if (ref($gets{'format'}) eq 'ARRAY') {
! 142: $format = $gets{'format'}->[0];
! 143: }
! 144: if ($format eq 'html') {
! 145: print &LONCAPA::loncgi::cgi_header('text/html',1);
! 146: } elsif ($format eq 'xml') {
! 147: print &LONCAPA::loncgi::cgi_header('text/xml',1);
! 148: } else {
! 149: $format = 'csv';
! 150: print &LONCAPA::loncgi::cgi_header('text/plain',1);
! 151: }
! 152: my ($count,$output) = &show_results($reqdom,$format,\%gets);
! 153: if ($output) {
! 154: if ($format eq 'html') {
! 155: &start_html($reqdom,&mt('LON-CAPA Courses with Unique Six Character Codes'));
! 156: print $output;
! 157: &end_html;
! 158: } elsif ($count) {
! 159: if ($format eq 'xml') {
! 160: &start_xml();
! 161: }
! 162: print $output;
! 163: }
! 164: }
! 165: } else {
! 166: print &LONCAPA::loncgi::cgi_header('text/plain',1);
! 167: &LONCAPA::lonauthcgi::unauthorized_msg('uniquecodes');
! 168: }
! 169: return;
! 170: }
! 171:
! 172: #############################################
! 173: #############################################
! 174:
! 175: =pod
! 176:
! 177: =item show_results()
! 178:
! 179: Inputs: $reqdom - domain for which unique codes and course information
! 180: are to be shown.
! 181: $format - format for output, one of: html, xml or csv. csv
! 182: is the default, if no format specified.
! 183: $getshash - references to hash of key=value pairs from the
! 184: query string. Keys which will be used are: code,
! 185: and num.
! 186:
! 187: Returns: $count - number of items detected
! 188: $output - output to display.
! 189: If there are no matches, or the input argument
! 190: (code or num) was invalid, no output is returned
! 191: unless the requested format is html.
! 192: Note: in the case of a query without a
! 193: specific code or courseID, the output
! 194: is printed within the &show_results()
! 195: routine when looping over courses retrieved
! 196: by a call to lonnet::courseiddump, so $output
! 197: is blank, in this case, unless no courses match.
! 198:
! 199: Description: Displays LON-CAPA courseID, unique codes, course owner,
! 200: and course title.
! 201:
! 202: Data displayed can be a single record, if the query string
! 203: contains code=<six character code> or
! 204: num=<LON CAPA course ID>.
! 205:
! 206: Data formats are: html, xml, or plain text (csv).
! 207:
! 208: =cut
! 209:
! 210: #############################################
! 211: #############################################
! 212:
! 213: sub show_results {
! 214: my ($reqdom,$format,$gethash) = @_;
! 215: my ($uniquecode,$cnum,$output);
! 216: if (ref($gethash) eq 'HASH') {
! 217: if (ref($gethash->{'code'}) eq 'ARRAY') {
! 218: $gethash->{'code'}->[0] =~ s/^\s+|\s+$//g;
! 219: if ($gethash->{'code'}->[0] =~ /^\w{6}$/) {
! 220: $uniquecode = $gethash->{'code'}->[0];
! 221: } else {
! 222: if ($format eq 'html') {
! 223: $output = &mt('Invalid code');
! 224: }
! 225: return (0,$output);
! 226: }
! 227: }
! 228: if (ref($gethash->{'num'}) eq 'ARRAY') {
! 229: $gethash->{'num'}->[0] =~ s/^\s+|\s+$//g;
! 230: if ($gethash->{'num'}->[0] =~ /^$LONCAPA::match_courseid$/) {
! 231: my $chome = &Apache::lonnet::homeserver($gethash->{'num'}->[0],$reqdom);
! 232: if ($chome ne 'no_host') {
! 233: $cnum = $gethash->{'num'}->[0];
! 234: } else {
! 235: if ($format eq 'html') {
! 236: $output = &mt('Course ID does not exist');
! 237: }
! 238: return (0,$output);
! 239: }
! 240: } else {
! 241: if ($format eq 'html') {
! 242: $output = &mt('Invalid course ID');
! 243: }
! 244: return (0,$output);
! 245: }
! 246: }
! 247: }
! 248: if ($uniquecode) {
! 249: my $confname = $reqdom.'-domainconfig';
! 250: my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$reqdom,$confname);
! 251: if ($codes{$uniquecode}) {
! 252: my %courseinfo = &Apache::lonnet::coursedescription($reqdom.'_'.$codes{$uniquecode},{one_time => 1});
! 253: if (keys(%courseinfo)) {
! 254: $output = &buildline($format,$codes{$uniquecode},\%courseinfo);
! 255: return (1,$output);
! 256: } else {
! 257: if ($format eq 'html') {
! 258: $output = &mt('Code matched, but course ID to which this mapped is invalid.');
! 259: }
! 260: return (0,$output);
! 261: }
! 262: } else {
! 263: if ($format eq 'html') {
! 264: $output = &mt('No match');
! 265: }
! 266: return (0,$output);
! 267: }
! 268: }
! 269: if ($cnum) {
! 270: my %courseinfo = &Apache::lonnet::coursedescription($reqdom.'_'.$cnum,{one_time => 1});
! 271: if (keys(%courseinfo)) {
! 272: $output = &buildline($format,$cnum,\%courseinfo);
! 273: return (1,$output);
! 274: } else {
! 275: if ($format eq 'html') {
! 276: $output = &mt('No match');
! 277: }
! 278: return (0,$output);
! 279: }
! 280: }
! 281: my %courses = &Apache::lonnet::courseiddump($reqdom,'.',1,'.','.','.',undef,undef,'.',undef,
! 282: undef,undef,undef,undef,undef,undef,undef,undef,
! 283: undef,undef,undef,1);
! 284: if (keys(%courses)) {
! 285: my (@rowstart,$rowend,$separator,%ownername);
! 286: if ($format eq 'html') {
! 287: &start_html($reqdom,&mt('LON-CAPA Courses with Unique Six Character Codes'));
! 288: print &html_table_start();
! 289: $rowstart[0] = '<tr class="LC_even_row"><td>';
! 290: $rowstart[1] = '<tr class="LC_odd_row"><td>';
! 291: $rowend = '</td></tr>'."\n";
! 292: $separator = '</td><td>';
! 293: } elsif ($format eq 'xml') {
! 294: &start_xml();
! 295: print "<courses>\n";
! 296: } else {
! 297: @rowstart = ('','');
! 298: $separator = ',';
! 299: $rowend = "\n";
! 300: }
! 301: my $num = 0;
! 302: foreach my $course (sort(keys(%courses))) {
! 303: if (ref($courses{$course}) eq 'HASH') {
! 304: my ($cdom,$cnum) = split(/_/,$course);
! 305: my $instructor;
! 306: if ($courses{$course}{'owner'}) {
! 307: unless (exists($ownername{$courses{$course}{'owner'}})) {
! 308: my ($uname,$udom) = split(/:/,$courses{$course}{'owner'});
! 309: $ownername{$courses{$course}{'owner'}} = &Apache::loncommon::plainname($uname,$udom,'lastname');
! 310: }
! 311: $instructor = $ownername{$courses{$course}{'owner'}};
! 312: }
! 313: if ($format eq 'xml') {
! 314: print <<"END";
! 315: <course>
! 316: <courseID>$cnum</courseID>
! 317: <code>$courses{$course}{'uniquecode'}</code>
! 318: <title>$courses{$course}{'description'}</title>
! 319: <owner>$courses{$course}{'owner'}</owner>
! 320: <name>$instructor</name>
! 321: </course>
! 322: END
! 323: } else {
! 324: my $idx = $num%2;
! 325: print $rowstart[$idx].$cnum.$separator.$courses{$course}{'uniquecode'}.$separator.
! 326: $courses{$course}{'description'}.$separator.
! 327: $courses{$course}{'owner'}.$separator.$instructor.$rowend;
! 328: }
! 329: $num ++;
! 330: }
! 331: }
! 332: if ($format eq 'html') {
! 333: print '</table>';
! 334: &end_html();
! 335: } elsif ($format eq 'xml') {
! 336: print "</courses>\n";
! 337: }
! 338: return ($num,$output);
! 339: } else {
! 340: if ($format eq 'html') {
! 341: $output = &mt('No courses currently have six character identifiers.');
! 342: }
! 343: return (0,$output);
! 344: }
! 345: }
! 346:
! 347: #############################################
! 348: #############################################
! 349:
! 350: sub buildline {
! 351: my ($format,$cnum,$courseinfo) = @_;
! 352: return unless (ref($courseinfo) eq 'HASH');
! 353: my $code = $courseinfo->{'internal.uniquecode'};
! 354: my $title = $courseinfo->{'description'};
! 355: my $owner = $courseinfo->{'internal.courseowner'};
! 356: my $fullname;
! 357: if ($owner) {
! 358: my ($uname,$udom) = split(/:/,$owner);
! 359: $fullname = &Apache::loncommon::plainname($uname,$udom,'lastname');
! 360: }
! 361: if ($format eq 'html') {
! 362: return &html_table_start().
! 363: '<tr>'.
! 364: '<td>'.$cnum.'</td>'.
! 365: '<td>'.$code.'</td>'.
! 366: '<td>'.$title.'</td>'.
! 367: '<td>'.$owner.'</td>'.
! 368: '<td>'.$fullname.'</td></tr>'.
! 369: '</table>';
! 370: } elsif ($format eq 'xml') {
! 371: <<"END";
! 372: <courses>
! 373: <course>
! 374: <courseID>$cnum</courseID>
! 375: <code>$code</code>
! 376: <title>$title</title>
! 377: <owner>$owner</owner>
! 378: <name>$fullname</name>
! 379: <course>
! 380: </courses>
! 381: END
! 382: } else {
! 383: return $cnum.','.$code.','.$title.','.$owner.','.$fullname."\n";
! 384: }
! 385: }
! 386:
! 387: sub start_html {
! 388: my ($dom,$title) = @_;
! 389: my $url;
! 390: if ($Apache::lonnet::env{'user.name'} && $Apache::lonnet::env{'user.domain'}) {
! 391: my $function = &Apache::loncommon::get_users_function();
! 392: my $bgcolor = &Apache::loncommon::designparm($function.'.pgbg',$dom);
! 393: $url = join(':',$Apache::lonnet::env{'user.name'},$Apache::lonnet::env{'user.domain'},
! 394: $Apache::lonnet::perlvar{'lonVersion'},
! 395: #time(),
! 396: $Apache::lonnet::env{'environment.color.timestamp'},
! 397: $function,$dom,$bgcolor);
! 398: $url = '/adm/css/'.&escape($url).'.css';
! 399: }
! 400: print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
! 401: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n\n".
! 402: '<head>'."\n".
! 403: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n";
! 404: if ($url) {
! 405: print '<link rel="stylesheet" type="text/css" href="'.$url.'" />'."\n";
! 406: }
! 407: print '<title>'.$title.'</title>'."\n".
! 408: '</head>'."\n".
! 409: '<body style="background-color:#ffffff">'."\n".
! 410: '<div>'."\n";
! 411: return;
! 412: }
! 413:
! 414: sub end_html {
! 415: print '</div>'."\n".
! 416: '</body>'."\n".
! 417: '</html>';
! 418: return;
! 419: }
! 420:
! 421: sub html_table_start {
! 422: return '<table class="LC_data_table">'.
! 423: '<tr class="LC_header_row">'.
! 424: '<th>'.&mt('Course ID').'</th>'."\n".
! 425: '<th>'.&mt('Code').'</th>'."\n".
! 426: '<th>'.&mt('Title').'</th>'."\n".
! 427: '<th>'.&mt('Owner').'</th>'."\n".
! 428: '<th>'.&mt('Instructor name').'</th>'."\n".
! 429: '</tr>';
! 430: }
! 431:
! 432: sub start_xml {
! 433: print '<?xml version="1.0" encoding="UTF-8"?>'."\n".'<!DOCTYPE text>'."\n";
! 434: return;
! 435: }
! 436:
! 437: =pod
! 438:
! 439: =back
! 440:
! 441: =cut
! 442:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to listcodes.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi