[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom Lond.pm lond loncom/cgi listcodes.pl lonauthcgi.pm loncom/interface domainprefs.pm domainstatus.pm loncom/lonnet/perl lonnet.pm

raeburn raeburn at source.lon-capa.org
Wed Jan 1 12:41:56 EST 2014


raeburn		Wed Jan  1 17:41:56 2014 EDT

  Added files:                 
    /loncom/cgi	listcodes.pl 

  Modified files:              
    /loncom	lond Lond.pm 
    /loncom/lonnet/perl	lonnet.pm 
    /loncom/interface	domainprefs.pm domainstatus.pm 
    /loncom/cgi	lonauthcgi.pm 
    /doc/loncapafiles	loncapafiles.lpml 
  Log:
  - Access to information about courses in a domain with six character
    unique codes (html, xml or csv format).
    - Initial use case is for a separate portal (token-based auth) 
      where students enter the code to sign up for a specific "textbook" 
      course.
  
  
-------------- next part --------------
Index: loncom/lond
diff -u loncom/lond:1.504 loncom/lond:1.505
--- loncom/lond:1.504	Thu Dec  5 13:16:00 2013
+++ loncom/lond	Wed Jan  1 17:41:37 2014
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.504 2013/12/05 13:16:00 raeburn Exp $
+# $Id: lond,v 1.505 2014/01/01 17:41:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -61,7 +61,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.504 $'; #' stupid emacs
+my $VERSION='$Revision: 1.505 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -3837,7 +3837,9 @@
 #                 creationcontext - include courses created in specified context 
 #
 #                 domcloner - flag to indicate if user can create CCs in course's domain.
-#                             If so, ability to clone course is automatic. 
+#                             If so, ability to clone course is automatic.
+#                 hasuniquecode - filter by courses for which a six character unique code has 
+#                                 been set.
 #
 #     $client  - The socket open on the client.
 # Returns:
@@ -3862,7 +3864,7 @@
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
-        $creationcontext,$domcloner) =split(/:/,$tail);
+        $creationcontext,$domcloner,$hasuniquecode) =split(/:/,$tail);
     my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {
@@ -3935,6 +3937,9 @@
     } else {
         $creationcontext = '.';
     }
+    unless ($hasuniquecode) {
+        $hasuniquecode = '.';
+    }
     my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
         $typefilter eq '.') {
@@ -4023,6 +4028,9 @@
                 $selfenroll_end = $items->{'selfenroll_end_date'};
                 $created = $items->{'created'};
                 $context = $items->{'context'};
+                if ($hasuniquecode ne '.') {
+                    next unless ($items->{'uniquecode'});
+                }
                 if ($selfenrollonly) {
                     next if (!$selfenroll_types);
                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.5 loncom/Lond.pm:1.6
--- loncom/Lond.pm:1.5	Wed Jul 24 18:21:52 2013
+++ loncom/Lond.pm	Wed Jan  1 17:41:37 2014
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: Lond.pm,v 1.5 2013/07/24 18:21:52 bisitz Exp $
+# $Id: Lond.pm,v 1.6 2014/01/01 17:41:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -333,7 +333,7 @@
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
-        $creationcontext,$domcloner) = split(/:/,$tail);
+        $creationcontext,$domcloner,$hasuniquecode) = split(/:/,$tail);
     my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {
@@ -406,6 +406,9 @@
     } else {
         $creationcontext = '.';
     }
+    unless ($hasuniquecode) {
+        $hasuniquecode = '.';
+    }
     my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
         $typefilter eq '.') {
@@ -530,6 +533,9 @@
                         next if !$showhidden;
                     }
                 }
+                if ($hasuniquecode ne '.') {
+                    next unless ($items->{'uniquecode'});
+                }
             } else {
                 next if ($catfilter ne '');
                 next if ($selfenrollonly);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1246 loncom/lonnet/perl/lonnet.pm:1.1247
--- loncom/lonnet/perl/lonnet.pm:1.1246	Fri Dec 27 23:31:01 2013
+++ loncom/lonnet/perl/lonnet.pm	Wed Jan  1 17:41:42 2014
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1246 2013/12/27 23:31:01 raeburn Exp $
+# $Id: lonnet.pm,v 1.1247 2014/01/01 17:41:42 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4179,7 +4179,8 @@
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
         $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
         $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
-        $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_;
+        $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner,
+        $hasuniquecode)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -4202,7 +4203,7 @@
                                 &escape($catfilter), $showhidden, $caller, 
                                 &escape($cloner), &escape($cc_clone), $cloneonly, 
                                 &escape($createdbefore), &escape($createdafter), 
-                                &escape($creationcontext), $domcloner)));
+                                &escape($creationcontext), $domcloner, $hasuniquecode)));
                 } else {
                     $rep = &reply('courseiddump:'.&host_domain($tryserver).':'.
                              $sincefilter.':'.&escape($descfilter).':'.
@@ -4213,7 +4214,7 @@
                              $showhidden.':'.$caller.':'.&escape($cloner).':'.
                              &escape($cc_clone).':'.$cloneonly.':'.
                              &escape($createdbefore).':'.&escape($createdafter).':'.
-                             &escape($creationcontext).':'.$domcloner,
+                             &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode,
                              $tryserver);
                 }
                      
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.220 loncom/interface/domainprefs.pm:1.221
--- loncom/interface/domainprefs.pm:1.220	Wed Jan  1 16:00:11 2014
+++ loncom/interface/domainprefs.pm	Wed Jan  1 17:41:46 2014
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set domain-wide configuration settings
 #
-# $Id: domainprefs.pm,v 1.220 2014/01/01 16:00:11 raeburn Exp $
+# $Id: domainprefs.pm,v 1.221 2014/01/01 17:41:46 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4546,7 +4546,8 @@
 sub serverstatus_pages {
     return ('userstatus','lonstatus','loncron','server-status','codeversions',
             'checksums','clusterstatus','metadata_keywords','metadata_harvest',
-            'takeoffline','takeonline','showenv','toggledebug','ping','domconf');
+            'takeoffline','takeonline','showenv','toggledebug','ping','domconf',
+            'uniquecodes');
 }
 
 sub coursecategories_javascript {
Index: loncom/interface/domainstatus.pm
diff -u loncom/interface/domainstatus.pm:1.5 loncom/interface/domainstatus.pm:1.6
--- loncom/interface/domainstatus.pm:1.5	Sat Feb  2 00:22:51 2013
+++ loncom/interface/domainstatus.pm	Wed Jan  1 17:41:47 2014
@@ -2,7 +2,7 @@
 # Generate a menu page containing links to server status pages accessible
 # to user. 
 #
-# $Id: domainstatus.pm,v 1.5 2013/02/02 00:22:51 raeburn Exp $
+# $Id: domainstatus.pm,v 1.6 2014/01/01 17:41:47 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -78,7 +78,7 @@
 
     if (keys(%candisplay) > 0) {
         $r->print('<h2>'.&mt('Server Utilities for Domain: [_1]','<i>'.$domdesc.'</i>').
-                  '</h2>'.&print_status_menu(\%candisplay));
+                  '</h2>'.&print_status_menu(\%candisplay,$dom));
     } else {
         $r->print(
             '<h2>'.&mt('No information available').'</h2>'
@@ -93,14 +93,14 @@
 }
 
 sub print_status_menu {
-    my ($candisplay) = @_;
+    my ($candisplay,$dom) = @_;
     return '' if (ref($candisplay) ne 'HASH');
     return &Apache::lonhtmlcommon::generate_menu(
-               &servermenu_items($candisplay));
+               &servermenu_items($candisplay,$dom));
 }
 
 sub servermenu_items {
-    my ($candisplay) = @_;
+    my ($candisplay,$dom) = @_;
     my $titles = &LONCAPA::lonauthcgi::serverstatus_titles();
     my $linknames = &serverstatus_links();
     my @menu;
@@ -163,6 +163,15 @@
                  linktitle => $titles->{'checksums'},
              },
              {
+                 linktext => $linknames->{'uniquecodes'},
+                 icon => '',
+                 alttext => '',
+                 #help => 'Domain_Coordination_Uniquecodes',
+                 url => '/cgi-bin/listcodes.pl?domain='.$dom.'&format=html',
+                 permission => $candisplay->{'uniquecodes'},
+                 linktitle => $titles->{'uniquecodes'},
+             },
+             {
                  linktext => $linknames->{'showenv'},
                  icon => '',
                  alttext => '',
@@ -235,6 +244,7 @@
                     'checksums'    => 'Check for LON-CAPA Module changes',   
                     'showenv' => 'User Environment for current log-in',
                     'loncron' => 'Update Connections and Refresh Status Information',
+                    'uniquecodes' => "List Domain's Courses with Assigned Six Character codes",
                     'takeoffline' => 'Replace log-in page with offline notice',
                     'takeonline' => 'Replace offline notice with log-in page',
                     'metadata_keywords' => 'Display Metadata Keywords',
Index: loncom/cgi/lonauthcgi.pm
diff -u loncom/cgi/lonauthcgi.pm:1.11 loncom/cgi/lonauthcgi.pm:1.12
--- loncom/cgi/lonauthcgi.pm:1.11	Sun Oct 27 17:16:36 2013
+++ loncom/cgi/lonauthcgi.pm	Wed Jan  1 17:41:51 2014
@@ -1,7 +1,7 @@
 #
 # LON-CAPA authorization for cgi-bin scripts
 #
-# $Id: lonauthcgi.pm,v 1.11 2013/10/27 17:16:36 raeburn Exp $
+# $Id: lonauthcgi.pm,v 1.12 2014/01/01 17:41:51 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -390,6 +390,7 @@
                    'toggledebug'       => 'Toggle debug messages',
                    'ping'              => 'Cause server to ping another server',   
                    'domconf'           => 'Text Display of Domain Configuration',
+                   'uniquecodes'       => 'Six-character Course Codes',
                  );
     return \%titles;
 }
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.875 doc/loncapafiles/loncapafiles.lpml:1.876
--- doc/loncapafiles/loncapafiles.lpml:1.875	Sat Dec 28 23:15:53 2013
+++ doc/loncapafiles/loncapafiles.lpml	Wed Jan  1 17:41:56 2014
@@ -2,7 +2,7 @@
  "http://lpml.sourceforge.net/DTD/lpml.dtd">
 <!-- loncapafiles.lpml -->
 
-<!-- $Id: loncapafiles.lpml,v 1.875 2013/12/28 23:15:53 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.876 2014/01/01 17:41:56 raeburn Exp $ -->
 
 <!--
 
@@ -2013,6 +2013,15 @@
 </description>
 </file>
 <file>
+<source>loncom/cgi/listcodes.pl</source>
+<target dist='default'>home/httpd/cgi-bin/listcodes.pl</target>
+<categoryname>script</categoryname>
+<description>CGI script to display courses with unique six character codes.
+For use on the primary library server for a domain. Access control uses
+routines in lonauthcgi.pm.  Display formats are: csv (default), html, xml.
+</description>
+</file>
+<file>
 <source>loncom/homework/templates/sampleexternal.pl</source>
 <target dist='default'>home/httpd/cgi-bin/sampleexternal.pl</target>
 <categoryname>script</categoryname>

Index: loncom/cgi/listcodes.pl
+++ loncom/cgi/listcodes.pl
#!/usr/bin/perl
$|=1;
# Listing of domain's courses with unique six character codes
# $Id: listcodes.pl,v 1.1 2014/01/01 17:41:51 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$/, at 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, at okdoms);
        unless ($allowed == 1) {
            @okdoms = split(/\&/,$allowed);
            unless (grep(/^\Q$reqdom\E$/, at 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>
  <courseID>$cnum</courseID>
  <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> 
  <courseID>$cnum</courseID>
  <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



More information about the LON-CAPA-cvs mailing list