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.

#!/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