Return to listcodes.pl CVS log

Up to [LON-CAPA] / loncom / cgi

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

    1: #!/usr/bin/perl
    2: $|=1;
    3: # Listing of domain's courses with unique six character codes
    4: # $Id: listcodes.pl,v 1.2 2014/01/01 19:07:44 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 id="$cnum">
  316:   <code>$courses{$course}{'uniquecode'}</code>
  317:   <title>$courses{$course}{'description'}</title>
  318:   <owner>$courses{$course}{'owner'}</owner>
  319:   <name>$instructor</name>
  320:  </course>
  321: END
  322:                 } else {
  323:                     my $idx = $num%2;
  324:                     print $rowstart[$idx].$cnum.$separator.$courses{$course}{'uniquecode'}.$separator.
  325:                           $courses{$course}{'description'}.$separator.
  326:                           $courses{$course}{'owner'}.$separator.$instructor.$rowend;
  327:                 }
  328:                 $num ++;
  329:             }
  330:         }
  331:         if ($format eq 'html') {
  332:             print '</table>';
  333:             &end_html();
  334:         } elsif ($format eq 'xml') {
  335:             print "</courses>\n";
  336:         }
  337:         return ($num,$output);
  338:     } else {
  339:         if ($format eq 'html') {
  340:             $output = &mt('No courses currently have six character identifiers.');
  341:         }
  342:         return (0,$output);
  343:     }
  344: }
  345: 
  346: #############################################
  347: #############################################
  348: 
  349: sub buildline {
  350:     my ($format,$cnum,$courseinfo) = @_;
  351:     return unless (ref($courseinfo) eq 'HASH');
  352:     my $code = $courseinfo->{'internal.uniquecode'};
  353:     my $title = $courseinfo->{'description'};
  354:     my $owner = $courseinfo->{'internal.courseowner'};
  355:     my $fullname;
  356:     if ($owner) {
  357:         my ($uname,$udom) = split(/:/,$owner);
  358:         $fullname = &Apache::loncommon::plainname($uname,$udom,'lastname');
  359:     }
  360:     if ($format eq 'html') {
  361:         return &html_table_start().
  362:                '<tr>'.
  363:                '<td>'.$cnum.'</td>'.
  364:                '<td>'.$code.'</td>'.
  365:                '<td>'.$title.'</td>'.
  366:                '<td>'.$owner.'</td>'.
  367:                '<td>'.$fullname.'</td></tr>'.
  368:                '</table>';
  369:     } elsif ($format eq 'xml') {
  370:          <<"END";
  371: <courses>
  372:  <course id="$cnum"> 
  373:   <code>$code</code>
  374:   <title>$title</title>
  375:   <owner>$owner</owner>
  376:   <name>$fullname</name>
  377:  <course>
  378: </courses>
  379: END
  380:     } else {
  381:         return  $cnum.','.$code.','.$title.','.$owner.','.$fullname."\n";
  382:     }
  383: }
  384: 
  385: sub start_html {
  386:     my ($dom,$title) = @_;
  387:     my $url;
  388:     if ($Apache::lonnet::env{'user.name'} && $Apache::lonnet::env{'user.domain'}) {
  389:         my $function = &Apache::loncommon::get_users_function();
  390:         my $bgcolor  = &Apache::loncommon::designparm($function.'.pgbg',$dom);
  391:         $url = join(':',$Apache::lonnet::env{'user.name'},$Apache::lonnet::env{'user.domain'},
  392:                        $Apache::lonnet::perlvar{'lonVersion'},
  393:                        #time(),
  394:                        $Apache::lonnet::env{'environment.color.timestamp'},
  395:                        $function,$dom,$bgcolor);
  396:         $url = '/adm/css/'.&escape($url).'.css';
  397:     }
  398:     print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
  399:           '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n\n".
  400:           '<head>'."\n".
  401:           '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n";
  402:     if ($url) {
  403:         print '<link rel="stylesheet" type="text/css" href="'.$url.'" />'."\n";
  404:     }
  405:     print '<title>'.$title.'</title>'."\n".
  406:           '</head>'."\n".
  407:           '<body style="background-color:#ffffff">'."\n".
  408:           '<div>'."\n"; 
  409:     return;
  410: }
  411: 
  412: sub end_html {
  413:     print '</div>'."\n".
  414:           '</body>'."\n".
  415:           '</html>';
  416:     return;
  417: }
  418: 
  419: sub html_table_start {
  420:     return '<table class="LC_data_table">'.
  421:            '<tr class="LC_header_row">'.
  422:            '<th>'.&mt('Course ID').'</th>'."\n".
  423:            '<th>'.&mt('Code').'</th>'."\n".
  424:            '<th>'.&mt('Title').'</th>'."\n".
  425:            '<th>'.&mt('Owner').'</th>'."\n".
  426:            '<th>'.&mt('Instructor name').'</th>'."\n".
  427:            '</tr>';
  428: }
  429: 
  430: sub start_xml {
  431:     print '<?xml version="1.0" encoding="UTF-8"?>'."\n".'<!DOCTYPE text>'."\n";
  432:     return;
  433: }
  434: 
  435: =pod
  436: 
  437: =back
  438: 
  439: =cut
  440: