Annotation of loncom/interface/loncommon.pm, revision 1.59

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.59    ! www         4: # $Id: loncommon.pm,v 1.58 2002/08/22 21:05:25 albertel Exp $
1.10      albertel    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: #
1.12      harris41   28: # YEAR=2001
                     29: # 2/13-12/7 Guy Albertelli
1.17      harris41   30: # 12/11,12/12,12/17 Scott Harrison
1.18      www        31: # 12/21 Gerd Kortemeyer
1.20      www        32: # 12/21 Scott Harrison
1.22      www        33: # 12/25,12/28 Gerd Kortemeyer
1.23      www        34: # YEAR=2002
                     35: # 1/4 Gerd Kortemeyer
1.43      ng         36: # 6/24,7/2 H. K. Ng
1.1       albertel   37: 
                     38: # Makes a table out of the previous attempts
1.2       albertel   39: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   40: # Reads in non-network-related .tab files
1.1       albertel   41: 
1.35      matthew    42: # POD header:
                     43: 
1.45      matthew    44: =pod
                     45: 
1.35      matthew    46: =head1 NAME
                     47: 
                     48: Apache::loncommon - pile of common routines
                     49: 
                     50: =head1 SYNOPSIS
                     51: 
                     52: Referenced by other mod_perl Apache modules.
                     53: 
                     54: Invocation:
                     55:  &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
                     56: 
                     57: =head1 INTRODUCTION
                     58: 
                     59: Common collection of used subroutines.  This collection helps remove
                     60: redundancy from other modules and increase efficiency of memory usage.
                     61: 
                     62: Current things done:
                     63: 
                     64:  Makes a table out of the previous homework attempts
                     65:  Inputs result_from_symbread, user, domain, course_id
                     66:  Reads in non-network-related .tab files
                     67: 
                     68: This is part of the LearningOnline Network with CAPA project
                     69: described at http://www.lon-capa.org.
                     70: 
1.41      ng         71: =head2 General Subroutines
1.35      matthew    72: 
                     73: =over 4
                     74: 
                     75: =cut 
                     76: 
                     77: # End of POD header
1.1       albertel   78: package Apache::loncommon;
                     79: 
                     80: use strict;
1.22      www        81: use Apache::lonnet();
1.46      matthew    82: use GDBM_File;
1.51      www        83: use POSIX qw(strftime mktime);
1.1       albertel   84: use Apache::Constants qw(:common);
                     85: use Apache::lonmsg();
1.22      www        86: my $readit;
                     87: 
1.46      matthew    88: =pod 
                     89: 
                     90: =item Global Variables
                     91: 
                     92: =over 4
                     93: 
                     94: =cut
1.20      www        95: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41   96: my %language;
                     97: my %cprtag;
                     98: my %fe; my %fd;
1.41      ng         99: my %category_extensions;
1.12      harris41  100: 
1.46      matthew   101: # ---------------------------------------------- Thesaurus variables
                    102: 
                    103: =pod
                    104: 
                    105: =item %Keywords  
                    106: 
                    107: A hash used by &keyword to determine if a word is considered a keyword.
                    108: 
                    109: =item $thesaurus_db_file
                    110: 
                    111: Scalar containing the full path to the thesaurus database.                 
                    112: 
                    113: =cut
                    114: 
                    115: my %Keywords;
                    116: my $thesaurus_db_file;
                    117: 
                    118: 
                    119: =pod
                    120: 
                    121: =back
                    122: 
                    123: =cut
1.20      www       124: 
1.12      harris41  125: # ----------------------------------------------------------------------- BEGIN
1.41      ng        126: 
                    127: =pod
                    128: 
1.35      matthew   129: =item BEGIN() 
                    130: 
                    131: Initialize values from language.tab, copyright.tab, filetypes.tab,
1.45      matthew   132: thesaurus.tab, and filecategories.tab.
1.35      matthew   133: 
                    134: =cut
1.45      matthew   135: 
1.35      matthew   136: # ----------------------------------------------------------------------- BEGIN
                    137: 
1.18      www       138: BEGIN {
1.46      matthew   139:     # Variable initialization
                    140:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    141:     #
1.22      www       142:     unless ($readit) {
1.12      harris41  143: # ------------------------------------------------------------------- languages
                    144:     {
                    145: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    146: 				 '/language.tab');
1.16      harris41  147: 	if ($fh) {
                    148: 	    while (<$fh>) {
                    149: 		next if /^\#/;
                    150: 		chomp;
                    151: 		my ($key,$val)=(split(/\s+/,$_,2));
                    152: 		$language{$key}=$val;
                    153: 	    }
1.12      harris41  154: 	}
                    155:     }
                    156: # ------------------------------------------------------------------ copyrights
                    157:     {
1.16      harris41  158: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
                    159: 				  '/copyright.tab');
                    160: 	if ($fh) {
                    161: 	    while (<$fh>) {
                    162: 		next if /^\#/;
                    163: 		chomp;
                    164: 		my ($key,$val)=(split(/\s+/,$_,2));
                    165: 		$cprtag{$key}=$val;
                    166: 	    }
1.12      harris41  167: 	}
                    168:     }
1.15      harris41  169: # ------------------------------------------------------------- file categories
                    170:     {
                    171: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16      harris41  172: 				  '/filecategories.tab');
                    173: 	if ($fh) {
                    174: 	    while (<$fh>) {
                    175: 		next if /^\#/;
                    176: 		chomp;
1.41      ng        177: 		my ($extension,$category)=(split(/\s+/,$_,2));
                    178: 		push @{$category_extensions{lc($category)}},$extension;
1.16      harris41  179: 	    }
1.15      harris41  180: 	}
                    181:     }
1.12      harris41  182: # ------------------------------------------------------------------ file types
                    183:     {
1.16      harris41  184: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    185: 	       '/filetypes.tab');
                    186: 	if ($fh) {
                    187:             while (<$fh>) {
                    188: 		next if (/^\#/);
                    189: 		chomp;
                    190: 		my ($ending,$emb,$descr)=split(/\s+/,$_,3);
                    191: 		if ($descr ne '') { 
                    192: 		    $fe{$ending}=lc($emb);
                    193: 		    $fd{$ending}=$descr;
                    194: 		}
1.12      harris41  195: 	    }
                    196: 	}
                    197:     }
1.22      www       198:     &Apache::lonnet::logthis(
1.46      matthew   199:               "<font color=yellow>INFO: Read file types</font>");
1.22      www       200:     $readit=1;
1.46      matthew   201:     }  # end of unless($readit) 
1.32      matthew   202:     
                    203: }
                    204: # ============================================================= END BEGIN BLOCK
1.42      matthew   205: ###############################################################
                    206: ##           HTML and Javascript Helper Functions            ##
                    207: ###############################################################
                    208: 
                    209: =pod 
                    210: 
                    211: =item browser_and_searcher_javascript 
                    212: 
                    213: Returns scalar containing javascript to open a browser window
                    214: or a searcher window.  Also creates 
                    215: 
                    216: =over 4
                    217: 
                    218: =item openbrowser(formname,elementname,only,omit) [javascript]
                    219: 
                    220: inputs: formname, elementname, only, omit
                    221: 
                    222: formname and elementname indicate the name of the html form and name of
                    223: the element that the results of the browsing selection are to be placed in. 
                    224: 
                    225: Specifying 'only' will restrict the browser to displaying only files
                    226: with the given extension.  Can be a comma seperated list.
                    227: 
                    228: Specifying 'omit' will restrict the browser to NOT displaying files
                    229: with the given extension.  Can be a comma seperated list.
                    230: 
                    231: =item opensearcher(formname, elementname) [javascript]
                    232: 
                    233: Inputs: formname, elementname
                    234: 
                    235: formname and elementname specify the name of the html form and the name
                    236: of the element the selection from the search results will be placed in.
                    237: 
                    238: =back
                    239: 
                    240: =cut
                    241: 
                    242: ###############################################################
                    243: sub browser_and_searcher_javascript {
                    244:     return <<END;
1.50      matthew   245:     var editbrowser = null;
1.42      matthew   246:     function openbrowser(formname,elementname,only,omit) {
                    247:         var url = '/res/?';
                    248:         if (editbrowser == null) {
                    249:             url += 'launch=1&';
                    250:         }
                    251:         url += 'catalogmode=interactive&';
                    252:         url += 'mode=edit&';
                    253:         url += 'form=' + formname + '&';
                    254:         if (only != null) {
                    255:             url += 'only=' + only + '&';
                    256:         } 
                    257:         if (omit != null) {
                    258:             url += 'omit=' + omit + '&';
                    259:         }
                    260:         url += 'element=' + elementname + '';
                    261:         var title = 'Browser';
                    262:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    263:         options += ',width=700,height=600';
                    264:         editbrowser = open(url,title,options,'1');
                    265:         editbrowser.focus();
                    266:     }
                    267:     var editsearcher;
                    268:     function opensearcher(formname,elementname) {
                    269:         var url = '/adm/searchcat?';
                    270:         if (editsearcher == null) {
                    271:             url += 'launch=1&';
                    272:         }
                    273:         url += 'catalogmode=interactive&';
                    274:         url += 'mode=edit&';
                    275:         url += 'form=' + formname + '&';
                    276:         url += 'element=' + elementname + '';
                    277:         var title = 'Search';
                    278:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    279:         options += ',width=700,height=600';
                    280:         editsearcher = open(url,title,options,'1');
                    281:         editsearcher.focus();
                    282:     }
                    283: END
                    284: }
                    285: 
                    286: 
                    287: 
                    288: ###############################################################
                    289: 
                    290: =pod
1.36      matthew   291: 
                    292: =item linked_select_forms(...)
                    293: 
                    294: linked_select_forms returns a string containing a <script></script> block
                    295: and html for two <select> menus.  The select menus will be linked in that
                    296: changing the value of the first menu will result in new values being placed
                    297: in the second menu.  The values in the select menu will appear in alphabetical
                    298: order.
                    299: 
                    300: linked_select_forms takes the following ordered inputs:
                    301: 
                    302: =over 4
                    303: 
                    304: =item $formname, the name of the <form> tag
                    305: 
                    306: =item $middletext, the text which appears between the <select> tags
                    307: 
                    308: =item $firstdefault, the default value for the first menu
                    309: 
                    310: =item $firstselectname, the name of the first <select> tag
                    311: 
                    312: =item $secondselectname, the name of the second <select> tag
                    313: 
                    314: =item $hashref, a reference to a hash containing the data for the menus.
                    315: 
1.41      ng        316: =back 
                    317: 
1.36      matthew   318: Below is an example of such a hash.  Only the 'text', 'default', and 
                    319: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    320: values for the first select menu.  The text that coincides with the 
1.41      ng        321: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   322: and text for the second menu are given in the hash pointed to by 
                    323: $menu{$choice1}->{'select2'}.  
                    324: 
1.41      ng        325: my %menu = ( A1 => { text =>"Choice A1" ,
1.36      matthew   326:                       default => "B3",
                    327:                       select2 => { 
                    328:                           B1 => "Choice B1",
                    329:                           B2 => "Choice B2",
                    330:                           B3 => "Choice B3",
                    331:                           B4 => "Choice B4"
                    332:                           }
                    333:                   },
                    334:               A2 => { text =>"Choice A2" ,
                    335:                       default => "C2",
                    336:                       select2 => { 
                    337:                           C1 => "Choice C1",
                    338:                           C2 => "Choice C2",
                    339:                           C3 => "Choice C3"
                    340:                           }
                    341:                   },
                    342:               A3 => { text =>"Choice A3" ,
                    343:                       default => "D6",
                    344:                       select2 => { 
                    345:                           D1 => "Choice D1",
                    346:                           D2 => "Choice D2",
                    347:                           D3 => "Choice D3",
                    348:                           D4 => "Choice D4",
                    349:                           D5 => "Choice D5",
                    350:                           D6 => "Choice D6",
                    351:                           D7 => "Choice D7"
                    352:                           }
                    353:                   }
                    354:               );
                    355: 
                    356: =cut
                    357: 
                    358: # ------------------------------------------------
                    359: 
                    360: sub linked_select_forms {
                    361:     my ($formname,
                    362:         $middletext,
                    363:         $firstdefault,
                    364:         $firstselectname,
                    365:         $secondselectname, 
                    366:         $hashref
                    367:         ) = @_;
                    368:     my $second = "document.$formname.$secondselectname";
                    369:     my $first = "document.$formname.$firstselectname";
                    370:     # output the javascript to do the changing
                    371:     my $result = '';
                    372:     $result.="<script>\n";
                    373:     $result.="var select2data = new Object();\n";
                    374:     $" = '","';
                    375:     my $debug = '';
                    376:     foreach my $s1 (sort(keys(%$hashref))) {
                    377:         $result.="select2data.d_$s1 = new Object();\n";        
                    378:         $result.="select2data.d_$s1.def = new String('".
                    379:             $hashref->{$s1}->{'default'}."');\n";
                    380:         $result.="select2data.d_$s1.values = new Array(";        
                    381:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
                    382:         $result.="\"@s2values\");\n";
                    383:         $result.="select2data.d_$s1.texts = new Array(";        
                    384:         my @s2texts;
                    385:         foreach my $value (@s2values) {
                    386:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                    387:         }
                    388:         $result.="\"@s2texts\");\n";
                    389:     }
                    390:     $"=' ';
                    391:     $result.= <<"END";
                    392: 
                    393: function select1_changed() {
                    394:     // Determine new choice
                    395:     var newvalue = "d_" + $first.value;
                    396:     // update select2
                    397:     var values     = select2data[newvalue].values;
                    398:     var texts      = select2data[newvalue].texts;
                    399:     var select2def = select2data[newvalue].def;
                    400:     var i;
                    401:     // out with the old
                    402:     for (i = 0; i < $second.options.length; i++) {
                    403:         $second.options[i] = null;
                    404:     }
                    405:     // in with the nuclear
                    406:     for (i=0;i<values.length; i++) {
                    407:         $second.options[i] = new Option(values[i]);
                    408:         $second.options[i].text = texts[i];
                    409:         if (values[i] == select2def) {
                    410:             $second.options[i].selected = true;
                    411:         }
                    412:     }
                    413: }
                    414: </script>
                    415: END
                    416:     # output the initial values for the selection lists
                    417:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
                    418:     foreach my $value (sort(keys(%$hashref))) {
                    419:         $result.="    <option value=\"$value\" ";
                    420:         $result.=" selected=\"true\" " if ($value eq $firstdefault);
                    421:         $result.=">$hashref->{$value}->{'text'}</option>\n";
                    422:     }
                    423:     $result .= "</select>\n";
                    424:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                    425:     $result .= $middletext;
                    426:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                    427:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
                    428:     foreach my $value (sort(keys(%select2))) {
                    429:         $result.="    <option value=\"$value\" ";        
                    430:         $result.=" selected=\"true\" " if ($value eq $seconddefault);
                    431:         $result.=">$select2{$value}</option>\n";
                    432:     }
                    433:     $result .= "</select>\n";
                    434:     #    return $debug;
                    435:     return $result;
                    436: }   #  end of sub linked_select_forms {
                    437: 
1.33      matthew   438: ###############################################################
1.44      bowersj2  439: 
1.45      matthew   440: =pod
1.44      bowersj2  441: 
1.48      bowersj2  442: =item help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44      bowersj2  443: 
                    444: Returns a string corresponding to an HTML link to the given help $topic, where $topic corresponds to the name of a .tex file in /home/httpd/html/adm/help/tex, with underscores replaced by spaces.
                    445: 
1.48      bowersj2  446: $text will optionally be linked to the same topic, allowing you to link text in addition to the graphic. If you do not want to link text, but wish to specify one of the later parameters, pass an empty string.
                    447: 
1.44      bowersj2  448: $stayOnPage is a value that will be interpreted as a boolean. If true, the link will not open a new window. If false, the link will open a new window using Javascript. (Default is false.)
                    449: 
                    450: $width and $height are optional numerical parameters that will override the width and height of the popped up window, which may be useful for certain help topics with big pictures included.
                    451: 
                    452: =cut
                    453: 
                    454: sub help_open_topic {
1.48      bowersj2  455:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
                    456:     $text = "" if (not defined $text);
1.44      bowersj2  457:     $stayOnPage = 0 if (not defined $stayOnPage);
                    458:     $width = 350 if (not defined $width);
                    459:     $height = 400 if (not defined $height);
                    460:     my $filename = $topic;
                    461:     $filename =~ s/ /_/g;
                    462: 
1.48      bowersj2  463:     my $template = "";
                    464:     my $link;
1.44      bowersj2  465: 
                    466:     if (!$stayOnPage)
                    467:     {
1.48      bowersj2  468: 	$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height'))";
1.44      bowersj2  469:     }
                    470:     else
                    471:     {
1.48      bowersj2  472: 	$link = "/adm/help/${filename}.hlp";
                    473:     }
                    474: 
                    475:     # Add the text
                    476:     if ($text ne "")
                    477:     {
                    478: 	$template .= "<a href=\"$link\">$text</a> ";
                    479:     }
                    480: 
                    481:     # Add the graphic
                    482:     $template .= <<"ENDTEMPLATE";
1.57      albertel  483: <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
1.44      bowersj2  484: ENDTEMPLATE
                    485: 
                    486:     return $template;
                    487: 
                    488: }
1.37      matthew   489: 
1.45      matthew   490: =pod
                    491: 
1.37      matthew   492: =item csv_translate($text) 
                    493: 
                    494: Translate $text to allow it to be output as a 'comma seperated values' 
                    495: format.
                    496: 
                    497: =cut
                    498: 
                    499: sub csv_translate {
                    500:     my $text = shift;
                    501:     $text =~ s/\"/\"\"/g;
                    502:     $text =~ s/\n//g;
                    503:     return $text;
                    504: }
                    505: 
                    506: ###############################################################
1.33      matthew   507: ##        Home server <option> list generating code          ##
                    508: ###############################################################
1.35      matthew   509: #-------------------------------------------
                    510: 
1.45      matthew   511: =pod
                    512: 
1.35      matthew   513: =item get_domains()
                    514: 
                    515: Returns an array containing each of the domains listed in the hosts.tab
                    516: file.
                    517: 
                    518: =cut
                    519: 
                    520: #-------------------------------------------
1.34      matthew   521: sub get_domains {
                    522:     # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
                    523:     my @domains;
                    524:     my %seen;
                    525:     foreach (sort values(%Apache::lonnet::hostdom)) {
                    526:         push (@domains,$_) unless $seen{$_}++;
                    527:     }
                    528:     return @domains;
                    529: }
                    530: 
1.35      matthew   531: #-------------------------------------------
                    532: 
1.45      matthew   533: =pod
                    534: 
1.35      matthew   535: =item select_dom_form($defdom,$name)
                    536: 
                    537: Returns a string containing a <select name='$name' size='1'> form to 
                    538: allow a user to select the domain to preform an operation in.  
                    539: See loncreateuser.pm for an example invocation and use.
                    540: 
                    541: =cut
                    542: 
                    543: #-------------------------------------------
1.34      matthew   544: sub select_dom_form {
                    545:     my ($defdom,$name) = @_;
                    546:     my @domains = get_domains();
                    547:     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
                    548:     foreach (@domains) {
                    549:         $selectdomain.="<option value=\"$_\" ".
                    550:             ($_ eq $defdom ? 'selected' : '').
                    551:                 ">$_</option>\n";
                    552:     }
                    553:     $selectdomain.="</select>";
                    554:     return $selectdomain;
                    555: }
                    556: 
1.35      matthew   557: #-------------------------------------------
                    558: 
1.45      matthew   559: =pod
                    560: 
1.52      matthew   561: =item get_library_servers($domain)
1.35      matthew   562: 
                    563: Returns a hash which contains keys like '103l3' and values like 
                    564: 'kirk.lite.msu.edu'.  All of the keys will be for machines in the
                    565: given $domain.
                    566: 
                    567: =cut
                    568: 
                    569: #-------------------------------------------
1.52      matthew   570: sub get_library_servers {
1.33      matthew   571:     my $domain = shift;
1.52      matthew   572:     my %library_servers;
1.33      matthew   573:     foreach (keys(%Apache::lonnet::libserv)) {
                    574:         if ($Apache::lonnet::hostdom{$_} eq $domain) {
1.52      matthew   575:             $library_servers{$_} = $Apache::lonnet::hostname{$_};
1.33      matthew   576:         }
                    577:     }
1.52      matthew   578:     return %library_servers;
1.33      matthew   579: }
                    580: 
1.35      matthew   581: #-------------------------------------------
                    582: 
1.45      matthew   583: =pod
                    584: 
1.35      matthew   585: =item home_server_option_list($domain)
                    586: 
                    587: returns a string which contains an <option> list to be used in a 
                    588: <select> form input.  See loncreateuser.pm for an example.
                    589: 
                    590: =cut
                    591: 
                    592: #-------------------------------------------
1.33      matthew   593: sub home_server_option_list {
                    594:     my $domain = shift;
1.52      matthew   595:     my %servers = &get_library_servers($domain);
1.33      matthew   596:     my $result = '';
                    597:     foreach (sort keys(%servers)) {
                    598:         $result.=
                    599:             '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
                    600:     }
                    601:     return $result;
                    602: }
                    603: ###############################################################
                    604: ##    End of home server <option> list generating code       ##
                    605: ###############################################################
1.32      matthew   606: 
                    607: ###############################################################
                    608: ##    Authentication changing form generation subroutines    ##
                    609: ###############################################################
                    610: ##
                    611: ## All of the authform_xxxxxxx subroutines take their inputs in a
                    612: ## hash, and have reasonable default values.
                    613: ##
                    614: ##    formname = the name given in the <form> tag.
1.35      matthew   615: #-------------------------------------------
                    616: 
1.45      matthew   617: =pod
                    618: 
1.35      matthew   619: =item authform_xxxxxx
                    620: 
                    621: The authform_xxxxxx subroutines provide javascript and html forms which 
                    622: handle some of the conveniences required for authentication forms.  
                    623: This is not an optimal method, but it works.  
                    624: 
                    625: See loncreateuser.pm for invocation and use examples.
                    626: 
                    627: =over 4
                    628: 
                    629: =item authform_header
                    630: 
                    631: =item authform_authorwarning
                    632: 
                    633: =item authform_nochange
                    634: 
                    635: =item authform_kerberos
                    636: 
                    637: =item authform_internal
                    638: 
                    639: =item authform_filesystem
                    640: 
                    641: =back
                    642: 
                    643: =cut
                    644: 
                    645: #-------------------------------------------
1.32      matthew   646: sub authform_header{  
                    647:     my %in = (
                    648:         formname => 'cu',
                    649:         kerb_def_dom => 'MSU.EDU',
                    650:         @_,
                    651:     );
                    652:     $in{'formname'} = 'document.' . $in{'formname'};
                    653:     my $result='';
                    654:     $result.=<<"END";
                    655: var current = new Object();
                    656: current.radiovalue = 'nochange';
                    657: current.argfield = null;
                    658: 
                    659: function changed_radio(choice,currentform) {
                    660:     var choicearg = choice + 'arg';
                    661:     // If a radio button in changed, we need to change the argfield
                    662:     if (current.radiovalue != choice) {
                    663:         current.radiovalue = choice;
                    664:         if (current.argfield != null) {
                    665:             currentform.elements[current.argfield].value = '';
                    666:         }
                    667:         if (choice == 'nochange') {
                    668:             current.argfield = null;
                    669:         } else {
                    670:             current.argfield = choicearg;
                    671:             switch(choice) {
                    672:                 case 'krb': 
                    673:                     currentform.elements[current.argfield].value = 
                    674:                         "$in{'kerb_def_dom'}";
                    675:                 break;
                    676:               default:
                    677:                 break;
                    678:             }
                    679:         }
                    680:     }
                    681:     return;
                    682: }
1.22      www       683: 
1.32      matthew   684: function changed_text(choice,currentform) {
                    685:     var choicearg = choice + 'arg';
                    686:     if (currentform.elements[choicearg].value !='') {
                    687:         switch (choice) {
                    688:             case 'krb': currentform.elements[choicearg].value =
                    689:                 currentform.elements[choicearg].value.toUpperCase();
                    690:                 break;
                    691:             default:
                    692:         }
                    693:         // clear old field
                    694:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                    695:             currentform.elements[current.argfield].value = '';
                    696:         }
                    697:         current.argfield = choicearg;
                    698:     }
                    699:     set_auth_radio_buttons(choice,currentform);
                    700:     return;
1.20      www       701: }
1.32      matthew   702: 
                    703: function set_auth_radio_buttons(newvalue,currentform) {
                    704:     var i=0;
                    705:     while (i < currentform.login.length) {
                    706:         if (currentform.login[i].value == newvalue) { break; }
                    707:         i++;
                    708:     }
                    709:     if (i == currentform.login.length) {
                    710:         return;
                    711:     }
                    712:     current.radiovalue = newvalue;
                    713:     currentform.login[i].checked = true;
                    714:     return;
                    715: }
                    716: END
                    717:     return $result;
                    718: }
                    719: 
                    720: sub authform_authorwarning{
                    721:     my $result='';
                    722:     $result=<<"END";
                    723: <i>As a general rule, only authors or co-authors should be filesystem
                    724: authenticated (which allows access to the server filesystem).</i>
                    725: END
                    726:     return $result;
                    727: }
                    728: 
                    729: sub authform_nochange{  
                    730:     my %in = (
                    731:               formname => 'document.cu',
                    732:               kerb_def_dom => 'MSU.EDU',
                    733:               @_,
                    734:           );
                    735:     my $result='';
                    736:     $result.=<<"END";
                    737: <input type="radio" name="login" value="nochange" checked="checked"
1.57      albertel  738:        onclick="javascript:changed_radio('nochange',$in{'formname'});" />
1.32      matthew   739: Do not change login data
                    740: END
                    741:     return $result;
                    742: }
                    743: 
                    744: sub authform_kerberos{  
                    745:     my %in = (
                    746:               formname => 'document.cu',
                    747:               kerb_def_dom => 'MSU.EDU',
                    748:               @_,
                    749:               );
                    750:     my $result='';
                    751:     $result.=<<"END";
                    752: <input type="radio" name="login" value="krb" 
                    753:        onclick="javascript:changed_radio('krb',$in{'formname'});"
1.57      albertel  754:        onchange="javascript:changed_radio('krb',$in{'formname'});" />
1.32      matthew   755: Kerberos authenticated with domain
                    756: <input type="text" size="10" name="krbarg" value=""
1.57      albertel  757:        onchange="javascript:changed_text('krb',$in{'formname'});" />
1.58      albertel  758: <input type="radio" name="krbver" value="4" checked="on" />Version 4
                    759: <input type="radio" name="krbver" value="5" />Version 5
1.32      matthew   760: END
                    761:     return $result;
                    762: }
                    763: 
                    764: sub authform_internal{  
                    765:     my %args = (
                    766:                 formname => 'document.cu',
                    767:                 kerb_def_dom => 'MSU.EDU',
                    768:                 @_,
                    769:                 );
                    770:     my $result='';
                    771:     $result.=<<"END";
                    772: <input type="radio" name="login" value="int"
                    773:        onchange="javascript:changed_radio('int',$args{'formname'});"
1.57      albertel  774:        onclick="javascript:changed_radio('int',$args{'formname'});" />
1.32      matthew   775: Internally authenticated (with initial password 
                    776: <input type="text" size="10" name="intarg" value=""
1.57      albertel  777:        onchange="javascript:changed_text('int',$args{'formname'});" />
1.32      matthew   778: END
                    779:     return $result;
                    780: }
                    781: 
                    782: sub authform_local{  
                    783:     my %in = (
                    784:               formname => 'document.cu',
                    785:               kerb_def_dom => 'MSU.EDU',
                    786:               @_,
                    787:               );
                    788:     my $result='';
                    789:     $result.=<<"END";
                    790: <input type="radio" name="login" value="loc"
                    791:        onchange="javascript:changed_radio('loc',$in{'formname'});"
1.57      albertel  792:        onclick="javascript:changed_radio('loc',$in{'formname'});" />
1.32      matthew   793: Local Authentication with argument
                    794: <input type="text" size="10" name="locarg" value=""
1.57      albertel  795:        onchange="javascript:changed_text('loc',$in{'formname'});" />
1.32      matthew   796: END
                    797:     return $result;
                    798: }
                    799: 
                    800: sub authform_filesystem{  
                    801:     my %in = (
                    802:               formname => 'document.cu',
                    803:               kerb_def_dom => 'MSU.EDU',
                    804:               @_,
                    805:               );
                    806:     my $result='';
                    807:     $result.=<<"END";
                    808: <input type="radio" name="login" value="fsys" 
                    809:        onchange="javascript:changed_radio('fsys',$in{'formname'});"
1.57      albertel  810:        onclick="javascript:changed_radio('fsys',$in{'formname'});" />
1.32      matthew   811: Filesystem authenticated (with initial password 
                    812: <input type="text" size="10" name="fsysarg" value=""
                    813:        onchange="javascript:changed_text('fsys',$in{'formname'});">
                    814: END
                    815:     return $result;
                    816: }
                    817: 
                    818: ###############################################################
                    819: ##   End Authentication changing form generation functions   ##
                    820: ###############################################################
                    821: 
1.46      matthew   822: ###############################################################
                    823: ##                Thesaurus Functions                        ##
                    824: ###############################################################
1.20      www       825: 
1.46      matthew   826: =pod
1.20      www       827: 
1.46      matthew   828: =item initialize_keywords
                    829: 
                    830: Initializes the package variable %Keywords if it is empty.  Uses the
                    831: package variable $thesaurus_db_file.
                    832: 
                    833: =cut
                    834: 
                    835: ###################################################
                    836: 
                    837: sub initialize_keywords {
                    838:     return 1 if (scalar keys(%Keywords));
                    839:     # If we are here, %Keywords is empty, so fill it up
                    840:     #   Make sure the file we need exists...
                    841:     if (! -e $thesaurus_db_file) {
                    842:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                    843:                                  " failed because it does not exist");
                    844:         return 0;
                    845:     }
                    846:     #   Set up the hash as a database
                    847:     my %thesaurus_db;
                    848:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel  849:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew   850:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                    851:                                  $thesaurus_db_file);
                    852:         return 0;
                    853:     } 
                    854:     #  Get the average number of appearances of a word.
                    855:     my $avecount = $thesaurus_db{'average.count'};
                    856:     #  Put keywords (those that appear > average) into %Keywords
                    857:     while (my ($word,$data)=each (%thesaurus_db)) {
                    858:         my ($count,undef) = split /:/,$data;
                    859:         $Keywords{$word}++ if ($count > $avecount);
                    860:     }
                    861:     untie %thesaurus_db;
                    862:     # Remove special values from %Keywords.
                    863:     foreach ('total.count','average.count') {
                    864:         delete($Keywords{$_}) if (exists($Keywords{$_}));
                    865:     }
                    866:     return 1;
                    867: }
                    868: 
                    869: ###################################################
                    870: 
                    871: =pod
                    872: 
                    873: =item keyword($word)
                    874: 
                    875: Returns true if $word is a keyword.  A keyword is a word that appears more 
                    876: than the average number of times in the thesaurus database.  Calls 
                    877: &initialize_keywords
                    878: 
                    879: =cut
                    880: 
                    881: ###################################################
1.20      www       882: 
                    883: sub keyword {
1.46      matthew   884:     return if (!&initialize_keywords());
                    885:     my $word=lc(shift());
                    886:     $word=~s/\W//g;
                    887:     return exists($Keywords{$word});
1.20      www       888: }
1.46      matthew   889: 
                    890: ###############################################################
                    891: 
                    892: =pod 
1.20      www       893: 
1.46      matthew   894: =item get_related_words
                    895: 
                    896: Look up a word in the thesaurus.  Takes a scalar arguement and returns
                    897: an array of words.  If the keyword is not in the thesaurus, an empty array
                    898: will be returned.  The order of the words returned is determined by the
                    899: database which holds them.
                    900: 
                    901: Uses global $thesaurus_db_file.
                    902: 
                    903: =cut
                    904: 
                    905: ###############################################################
                    906: sub get_related_words {
                    907:     my $keyword = shift;
                    908:     my %thesaurus_db;
                    909:     if (! -e $thesaurus_db_file) {
                    910:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                    911:                                  "failed because the file does not exist");
                    912:         return ();
                    913:     }
                    914:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel  915:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew   916:         return ();
                    917:     } 
                    918:     my @Words=();
                    919:     if (exists($thesaurus_db{$keyword})) {
                    920:         $_ = $thesaurus_db{$keyword};
                    921:         (undef,@Words) = split/:/;  # The first element is the number of times
                    922:                                     # the word appears.  We do not need it now.
                    923:         for (my $i=0;$i<=$#Words;$i++) {
                    924:             ($Words[$i],undef)= split/\,/,$Words[$i];
1.20      www       925:         }
                    926:     }
1.46      matthew   927:     untie %thesaurus_db;
                    928:     return @Words;
1.14      harris41  929: }
1.46      matthew   930: 
                    931: ###############################################################
                    932: ##              End Thesaurus Functions                      ##
                    933: ###############################################################
1.14      harris41  934: 
                    935: # ---------------------------------------------------------------- Language IDs
                    936: sub languageids {
1.16      harris41  937:     return sort(keys(%language));
1.14      harris41  938: }
                    939: 
                    940: # -------------------------------------------------------- Language Description
                    941: sub languagedescription {
1.16      harris41  942:     return $language{shift(@_)};
1.14      harris41  943: }
                    944: 
                    945: # --------------------------------------------------------------- Copyright IDs
                    946: sub copyrightids {
1.16      harris41  947:     return sort(keys(%cprtag));
1.14      harris41  948: }
                    949: 
                    950: # ------------------------------------------------------- Copyright Description
                    951: sub copyrightdescription {
1.16      harris41  952:     return $cprtag{shift(@_)};
1.14      harris41  953: }
                    954: 
                    955: # ------------------------------------------------------------- File Categories
                    956: sub filecategories {
1.41      ng        957:     return sort(keys(%category_extensions));
1.15      harris41  958: }
1.14      harris41  959: 
1.17      harris41  960: # -------------------------------------- File Types within a specified category
1.15      harris41  961: sub filecategorytypes {
1.41      ng        962:     return @{$category_extensions{lc($_[0])}};
1.14      harris41  963: }
                    964: 
                    965: # ------------------------------------------------------------------ File Types
                    966: sub fileextensions {
1.16      harris41  967:     return sort(keys(%fe));
1.14      harris41  968: }
                    969: 
                    970: # ------------------------------------------------------------- Embedding Style
                    971: sub fileembstyle {
1.16      harris41  972:     return $fe{lc(shift(@_))};
1.14      harris41  973: }
                    974: 
                    975: # ------------------------------------------------------------ Description Text
                    976: sub filedescription {
1.16      harris41  977:     return $fd{lc(shift(@_))};
                    978: }
                    979: 
                    980: # ------------------------------------------------------------ Description Text
                    981: sub filedescriptionex {
                    982:     my $ex=shift;
                    983:     return '.'.$ex.' '.$fd{lc($ex)};
1.12      harris41  984: }
1.1       albertel  985: 
1.40      ng        986: # ---- Retrieve attempts by students
                    987: # input
                    988: # $symb             - problem including path
                    989: # $username,$domain - that of the student
                    990: # $course           - course name
                    991: # $getattempt       - leave blank if want all attempts, else put something.
1.43      ng        992: # $regexp           - regular expression. If string matches regexp send to
                    993: # $gradesub         - routine that process the string if it matches regexp
1.40      ng        994: # 
                    995: # output
                    996: # formatted as a table all the attempts, if any.
                    997: #
1.1       albertel  998: sub get_previous_attempt {
1.43      ng        999:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 1000:   my $prevattempts='';
1.43      ng       1001:   no strict 'refs';
1.1       albertel 1002:   if ($symb) {
1.3       albertel 1003:     my (%returnhash)=
                   1004:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 1005:     if ($returnhash{'version'}) {
                   1006:       my %lasthash=();
                   1007:       my $version;
                   1008:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19      harris41 1009:         foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1       albertel 1010: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.19      harris41 1011:         }
1.1       albertel 1012:       }
1.43      ng       1013:       $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
1.40      ng       1014:       $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
1.16      harris41 1015:       foreach (sort(keys %lasthash)) {
1.31      albertel 1016: 	my ($ign,@parts) = split(/\./,$_);
1.41      ng       1017: 	if ($#parts > 0) {
1.31      albertel 1018: 	  my $data=$parts[-1];
                   1019: 	  pop(@parts);
1.40      ng       1020: 	  $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';
1.31      albertel 1021: 	} else {
1.41      ng       1022: 	  if ($#parts == 0) {
                   1023: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   1024: 	  } else {
                   1025: 	    $prevattempts.='<th>'.$ign.'</th>';
                   1026: 	  }
1.31      albertel 1027: 	}
1.16      harris41 1028:       }
1.40      ng       1029:       if ($getattempt eq '') {
                   1030: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
                   1031: 	  $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
                   1032: 	    foreach (sort(keys %lasthash)) {
                   1033: 	       my $value;
                   1034: 	       if ($_ =~ /timestamp/) {
                   1035: 		  $value=scalar(localtime($returnhash{$version.':'.$_}));
                   1036: 	       } else {
                   1037: 		  $value=$returnhash{$version.':'.$_};
                   1038: 	       }
                   1039: 	       $prevattempts.='<td>'.$value.'&nbsp;</td>';   
                   1040: 	    }
                   1041: 	 }
1.1       albertel 1042:       }
1.40      ng       1043:       $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
1.16      harris41 1044:       foreach (sort(keys %lasthash)) {
1.5       albertel 1045: 	my $value;
                   1046: 	if ($_ =~ /timestamp/) {
                   1047: 	  $value=scalar(localtime($lasthash{$_}));
                   1048: 	} else {
                   1049: 	  $value=$lasthash{$_};
                   1050: 	}
1.49      ng       1051: 	if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40      ng       1052: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 1053:       }
1.40      ng       1054:       $prevattempts.='</tr></table></td></tr></table>';
1.1       albertel 1055:     } else {
                   1056:       $prevattempts='Nothing submitted - no attempts.';
                   1057:     }
                   1058:   } else {
                   1059:     $prevattempts='No data.';
                   1060:   }
1.10      albertel 1061: }
                   1062: 
                   1063: sub get_student_view {
                   1064:   my ($symb,$username,$domain,$courseid) = @_;
                   1065:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1066:   my (%old,%moreenv);
                   1067:   my @elements=('symb','courseid','domain','username');
                   1068:   foreach my $element (@elements) {
                   1069:     $old{$element}=$ENV{'form.grade_'.$element};
                   1070:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1071:   }
1.11      albertel 1072:   &Apache::lonnet::appenv(%moreenv);
                   1073:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1074:   &Apache::lonnet::delenv('form.grade_');
                   1075:   foreach my $element (@elements) {
                   1076:     $ENV{'form.grade_'.$element}=$old{$element};
                   1077:   }
                   1078:   $userview=~s/\<body[^\>]*\>//gi;
                   1079:   $userview=~s/\<\/body\>//gi;
                   1080:   $userview=~s/\<html\>//gi;
                   1081:   $userview=~s/\<\/html\>//gi;
                   1082:   $userview=~s/\<head\>//gi;
                   1083:   $userview=~s/\<\/head\>//gi;
                   1084:   $userview=~s/action\s*\=/would_be_action\=/gi;
                   1085:   return $userview;
                   1086: }
                   1087: 
                   1088: sub get_student_answers {
                   1089:   my ($symb,$username,$domain,$courseid) = @_;
                   1090:   my ($map,$id,$feedurl) = split(/___/,$symb);
                   1091:   my (%old,%moreenv);
                   1092:   my @elements=('symb','courseid','domain','username');
                   1093:   foreach my $element (@elements) {
                   1094:     $old{$element}=$ENV{'form.grade_'.$element};
                   1095:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                   1096:   }
                   1097:   $moreenv{'form.grade_target'}='answer';
1.10      albertel 1098:   &Apache::lonnet::appenv(%moreenv);
                   1099:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                   1100:   &Apache::lonnet::delenv('form.grade_');
                   1101:   foreach my $element (@elements) {
                   1102:     $ENV{'form.grade_'.$element}=$old{$element};
                   1103:   }
                   1104:   return $userview;
1.1       albertel 1105: }
1.37      matthew  1106: 
                   1107: ###############################################
1.51      www      1108: 
                   1109: 
                   1110: sub timehash {
                   1111:     my @ltime=localtime(shift);
                   1112:     return ( 'seconds' => $ltime[0],
                   1113:              'minutes' => $ltime[1],
                   1114:              'hours'   => $ltime[2],
                   1115:              'day'     => $ltime[3],
                   1116:              'month'   => $ltime[4]+1,
                   1117:              'year'    => $ltime[5]+1900,
                   1118:              'weekday' => $ltime[6],
                   1119:              'dayyear' => $ltime[7]+1,
                   1120:              'dlsav'   => $ltime[8] );
                   1121: }
                   1122: 
                   1123: sub maketime {
                   1124:     my %th=@_;
                   1125:     return POSIX::mktime(
                   1126:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
                   1127:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
                   1128: }
                   1129: 
                   1130: 
                   1131: sub findallcourses {
                   1132:     my %courses=();
                   1133:     my $now=time;
                   1134:     foreach (keys %ENV) {
                   1135: 	if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
                   1136: 	    my ($starttime,$endtime)=$ENV{$_};
                   1137:             my $active=1;
                   1138:             if ($starttime) {
                   1139: 		if ($now<$starttime) { $active=0; }
                   1140:             }
                   1141:             if ($endtime) {
                   1142:                 if ($now>$endtime) { $active=0; }
                   1143:             }
                   1144:             if ($active) { $courses{$1.'_'.$2}=1; }
                   1145:         }
                   1146:     }
                   1147:     return keys %courses;
                   1148: }
1.37      matthew  1149: 
1.54      www      1150: ###############################################
                   1151: 
1.59    ! www      1152: sub domainlogo {
        !          1153: # Determine domain
        !          1154:     my $domain=$Apache::lonnet::perlvar{'lonDefDomain'};
        !          1155:     if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
        !          1156:     if ($ENV{'request.role.domain'}) { $domain=$ENV{'request.role.domain'}; }
        !          1157: # See if there is a logo
        !          1158:     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
        !          1159: 	return '<img src="/adm/lonDomLogos/'.$domain.'.gif" />';
        !          1160:     } else {
        !          1161:         return $Apache::lonnet::domaindescription{$domain};
        !          1162:     }
        !          1163: }
        !          1164: 
1.54      www      1165: sub bodytag {
1.55      www      1166:     my ($title,$function,$addentries)=@_;
                   1167:     unless ($function) {
                   1168: 	$function='student';
                   1169:         if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
                   1170: 	    $function='coordinator';
                   1171:         }
                   1172: 	if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
                   1173:             $function='admin';
                   1174:         }
                   1175:         if (($ENV{'request.role'}=~/^(au|ca)/) ||
                   1176:             ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   1177:             $function='author';
                   1178:         }
                   1179:     }
1.54      www      1180:     my $img='';
                   1181:     my $pgbg='';
                   1182:     my $tabbg='';
                   1183:     my $font='';
                   1184:     my $link='';
                   1185:     my $alink='#CC0000';
                   1186:     my $vlink='';
                   1187:     if ($function eq 'admin') {
                   1188:         $img='admin';
                   1189:         $pgbg='#FFFFCC';
                   1190:         $tabbg='#CCCC99';
                   1191:         $font='#772200';
                   1192:         $link='#663300';
                   1193:         $vlink='#666600';
                   1194:     } elsif ($function eq 'coordinator') {
                   1195:         $img='coordinator';
                   1196:         $pgbg='#CCFFFF';
                   1197:         $tabbg='#CCCCFF';
1.55      www      1198:         $font='#000044';
1.54      www      1199:         $link='#003333';
                   1200:         $vlink='#006633';
                   1201:    } elsif ($function eq 'author') {
                   1202:         $img='author';
                   1203:         $pgbg='#CCFFFF';
                   1204:         $tabbg='#CCFFCC';
1.55      www      1205:         $font='#004400';
1.54      www      1206:         $link='#003333';
                   1207:         $vlink='#006666';
                   1208:     } else {
                   1209:         $img='student';
1.55      www      1210:         $pgbg='#FFFFAA';
1.54      www      1211:         $tabbg='#FF9900';
                   1212:         $font='#991100';
                   1213:         $link='#993300';
                   1214:         $vlink='#996600';
                   1215:     }
1.55      www      1216: # role and realm
                   1217:     my ($role,$realm)
                   1218:        =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
                   1219: # realm
1.54      www      1220:     if ($ENV{'request.course.id'}) {
1.55      www      1221: 	$realm=
                   1222:          $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
1.54      www      1223:     }
1.55      www      1224:     unless ($realm) { $realm='&nbsp;'; }
                   1225: # Set messages
1.59    ! www      1226:     my $messages=&domainlogo();
1.55      www      1227: # Output
1.54      www      1228:     return(<<ENDBODY);
                   1229: <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
                   1230: $addentries>
1.55      www      1231: <table width="100%" cellspacing="0" border="0" cellpadding="0">
                   1232: <tr><td bgcolor="$font">
                   1233: <img src="/adm/lonInterFace/$img.jpg" /></td>
                   1234: <td bgcolor="$font"><font color='$pgbg'>$messages</font></td>
                   1235: </tr>
1.54      www      1236: <tr>
1.55      www      1237: <td rowspan="3" bgcolor="$tabbg">
                   1238: &nbsp;<font size="5"><b>$title</b></font>
1.54      www      1239: <td bgcolor="$tabbg"  align="right">
                   1240: <font size="2">
                   1241:     $ENV{'environment.firstname'}
                   1242:     $ENV{'environment.middlename'}
                   1243:     $ENV{'environment.lastname'}
                   1244:     $ENV{'environment.generation'}
1.55      www      1245:     </font>&nbsp;
1.54      www      1246: </td>
                   1247: </tr>
                   1248: <tr><td bgcolor="$tabbg" align="right">
1.55      www      1249: <font size="2">$role</font>&nbsp;
1.54      www      1250: </td></tr>
1.55      www      1251: <tr>
                   1252: <td bgcolor="$tabbg" align="right"><font size="2">$realm</font>&nbsp;</td></tr>
1.54      www      1253: </table><br>
                   1254: ENDBODY
                   1255: }
1.37      matthew  1256: ###############################################
1.1       albertel 1257: 
1.6       albertel 1258: sub get_unprocessed_cgi {
1.25      albertel 1259:   my ($query,$possible_names)= @_;
1.26      matthew  1260:   # $Apache::lonxml::debug=1;
1.16      harris41 1261:   foreach (split(/&/,$query)) {
1.6       albertel 1262:     my ($name, $value) = split(/=/,$_);
1.25      albertel 1263:     $name = &Apache::lonnet::unescape($name);
                   1264:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   1265:       $value =~ tr/+/ /;
                   1266:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                   1267:       &Apache::lonxml::debug("Seting :$name: to :$value:");
1.30      albertel 1268:       unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 1269:     }
1.16      harris41 1270:   }
1.6       albertel 1271: }
                   1272: 
1.7       albertel 1273: sub cacheheader {
1.23      www      1274:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.8       albertel 1275:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel 1276:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                   1277:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   1278:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                   1279:   return $output;
                   1280: }
                   1281: 
1.9       albertel 1282: sub no_cache {
                   1283:   my ($r) = @_;
1.23      www      1284:   unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.24      albertel 1285:   #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.9       albertel 1286:   $r->no_cache(1);
                   1287:   $r->header_out("Pragma" => "no-cache");
1.24      albertel 1288:   #$r->header_out("Expires" => $date);
1.9       albertel 1289: }
1.25      albertel 1290: 
                   1291: sub add_to_env {
                   1292:   my ($name,$value)=@_;
1.28      albertel 1293:   if (defined($ENV{$name})) {
1.27      albertel 1294:     if (ref($ENV{$name})) {
1.25      albertel 1295:       #already have multiple values
                   1296:       push(@{ $ENV{$name} },$value);
                   1297:     } else {
                   1298:       #first time seeing multiple values, convert hash entry to an arrayref
                   1299:       my $first=$ENV{$name};
                   1300:       undef($ENV{$name});
                   1301:       push(@{ $ENV{$name} },$first,$value);
                   1302:     }
                   1303:   } else {
                   1304:     $ENV{$name}=$value;
                   1305:   }
1.31      albertel 1306: }
                   1307: 
1.41      ng       1308: =pod
1.45      matthew  1309: 
                   1310: =back 
1.41      ng       1311: 
                   1312: =head2 CSV Upload/Handling functions
1.38      albertel 1313: 
1.41      ng       1314: =over 4
                   1315: 
                   1316: =item  upfile_store($r)
                   1317: 
                   1318: Store uploaded file, $r should be the HTTP Request object,
                   1319: needs $ENV{'form.upfile'}
                   1320: returns $datatoken to be put into hidden field
                   1321: 
                   1322: =cut
1.31      albertel 1323: 
                   1324: sub upfile_store {
                   1325:     my $r=shift;
                   1326:     $ENV{'form.upfile'}=~s/\r/\n/gs;
                   1327:     $ENV{'form.upfile'}=~s/\f/\n/gs;
                   1328:     $ENV{'form.upfile'}=~s/\n+/\n/gs;
                   1329:     $ENV{'form.upfile'}=~s/\n+$//gs;
                   1330: 
                   1331:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
                   1332: 	'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
                   1333:     {
                   1334: 	my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                   1335: 				 '/tmp/'.$datatoken.'.tmp');
                   1336: 	print $fh $ENV{'form.upfile'};
                   1337:     }
                   1338:     return $datatoken;
                   1339: }
                   1340: 
1.56      matthew  1341: =pod
                   1342: 
1.41      ng       1343: =item load_tmp_file($r)
                   1344: 
                   1345: Load uploaded file from tmp, $r should be the HTTP Request object,
                   1346: needs $ENV{'form.datatoken'},
                   1347: sets $ENV{'form.upfile'} to the contents of the file
                   1348: 
                   1349: =cut
1.31      albertel 1350: 
                   1351: sub load_tmp_file {
                   1352:     my $r=shift;
                   1353:     my @studentdata=();
                   1354:     {
                   1355: 	my $fh;
                   1356: 	if ($fh=Apache::File->new($r->dir_config('lonDaemons').
                   1357: 				  '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
                   1358: 	    @studentdata=<$fh>;
                   1359: 	}
                   1360:     }
                   1361:     $ENV{'form.upfile'}=join('',@studentdata);
                   1362: }
                   1363: 
1.56      matthew  1364: =pod
                   1365: 
1.41      ng       1366: =item upfile_record_sep()
                   1367: 
                   1368: Separate uploaded file into records
                   1369: returns array of records,
                   1370: needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
                   1371: 
                   1372: =cut
1.31      albertel 1373: 
                   1374: sub upfile_record_sep {
                   1375:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1376:     } else {
                   1377: 	return split(/\n/,$ENV{'form.upfile'});
                   1378:     }
                   1379: }
                   1380: 
1.56      matthew  1381: =pod
                   1382: 
1.41      ng       1383: =item record_sep($record)
                   1384: 
                   1385: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
                   1386: 
                   1387: =cut
                   1388: 
1.31      albertel 1389: sub record_sep {
                   1390:     my $record=shift;
                   1391:     my %components=();
                   1392:     if ($ENV{'form.upfiletype'} eq 'xml') {
                   1393:     } elsif ($ENV{'form.upfiletype'} eq 'space') {
                   1394:         my $i=0;
                   1395:         foreach (split(/\s+/,$record)) {
                   1396:             my $field=$_;
                   1397:             $field=~s/^(\"|\')//;
                   1398:             $field=~s/(\"|\')$//;
                   1399:             $components{$i}=$field;
                   1400:             $i++;
                   1401:         }
                   1402:     } elsif ($ENV{'form.upfiletype'} eq 'tab') {
                   1403:         my $i=0;
                   1404:         foreach (split(/\t+/,$record)) {
                   1405:             my $field=$_;
                   1406:             $field=~s/^(\"|\')//;
                   1407:             $field=~s/(\"|\')$//;
                   1408:             $components{$i}=$field;
                   1409:             $i++;
                   1410:         }
                   1411:     } else {
                   1412:         my @allfields=split(/\,/,$record);
                   1413:         my $i=0;
                   1414:         my $j;
                   1415:         for ($j=0;$j<=$#allfields;$j++) {
                   1416:             my $field=$allfields[$j];
                   1417:             if ($field=~/^\s*(\"|\')/) {
                   1418: 		my $delimiter=$1;
                   1419:                 while (($field!~/$delimiter$/) && ($j<$#allfields)) {
                   1420: 		    $j++;
                   1421: 		    $field.=','.$allfields[$j];
                   1422: 		}
                   1423:                 $field=~s/^\s*$delimiter//;
                   1424:                 $field=~s/$delimiter\s*$//;
                   1425:             }
                   1426:             $components{$i}=$field;
                   1427: 	    $i++;
                   1428:         }
                   1429:     }
                   1430:     return %components;
                   1431: }
                   1432: 
1.56      matthew  1433: =pod
                   1434: 
1.41      ng       1435: =item upfile_select_html()
                   1436: 
                   1437: return HTML code to select file and specify its type
                   1438: 
                   1439: =cut
                   1440: 
1.31      albertel 1441: sub upfile_select_html {
                   1442:     return (<<'ENDUPFORM');
1.57      albertel 1443: <input type="file" name="upfile" size="50" />
1.31      albertel 1444: <br />Type: <select name="upfiletype">
                   1445: <option value="csv">CSV (comma separated values, spreadsheet)</option>
                   1446: <option value="space">Space separated</option>
                   1447: <option value="tab">Tabulator separated</option>
                   1448: <option value="xml">HTML/XML</option>
                   1449: </select>
                   1450: ENDUPFORM
                   1451: }
                   1452: 
1.56      matthew  1453: =pod
                   1454: 
1.41      ng       1455: =item csv_print_samples($r,$records)
                   1456: 
                   1457: Prints a table of sample values from each column uploaded $r is an
                   1458: Apache Request ref, $records is an arrayref from
                   1459: &Apache::loncommon::upfile_record_sep
                   1460: 
                   1461: =cut
                   1462: 
1.31      albertel 1463: sub csv_print_samples {
                   1464:     my ($r,$records) = @_;
                   1465:     my (%sone,%stwo,%sthree);
                   1466:     %sone=&record_sep($$records[0]);
                   1467:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   1468:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   1469: 
                   1470:     $r->print('Samples<br /><table border="2"><tr>');
                   1471:     foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column&nbsp;'.($_+1).'</th>'); }
                   1472:     $r->print('</tr>');
                   1473:     foreach my $hash (\%sone,\%stwo,\%sthree) {
                   1474: 	$r->print('<tr>');
                   1475: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   1476: 	    $r->print('<td>');
                   1477: 	    if (defined($$hash{$_})) { $r->print($$hash{$_}); }
                   1478: 	    $r->print('</td>');
                   1479: 	}
                   1480: 	$r->print('</tr>');
                   1481:     }
                   1482:     $r->print('</tr></table><br />'."\n");
                   1483: }
                   1484: 
1.56      matthew  1485: =pod
                   1486: 
1.41      ng       1487: =item csv_print_select_table($r,$records,$d)
                   1488: 
                   1489: Prints a table to create associations between values and table columns.
                   1490: $r is an Apache Request ref,
                   1491: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   1492: $d is an array of 2 element arrays (internal name, displayed name)
                   1493: 
                   1494: =cut
                   1495: 
1.31      albertel 1496: sub csv_print_select_table {
                   1497:     my ($r,$records,$d) = @_;
                   1498:     my $i=0;my %sone;
                   1499:     %sone=&record_sep($$records[0]);
                   1500:     $r->print('Associate columns with student attributes.'."\n".
                   1501: 	     '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
                   1502:     foreach (@$d) {
                   1503: 	my ($value,$display)=@{ $_ };
                   1504: 	$r->print('<tr><td>'.$display.'</td>');
                   1505: 
                   1506: 	$r->print('<td><select name=f'.$i.
1.32      matthew  1507: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 1508: 	$r->print('<option value="none"></option>');
                   1509: 	foreach (sort({$a <=> $b} keys(%sone))) {
                   1510: 	    $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
                   1511: 	}
                   1512: 	$r->print('</select></td></tr>'."\n");
                   1513: 	$i++;
                   1514:     }
                   1515:     $i--;
                   1516:     return $i;
                   1517: }
1.56      matthew  1518: 
                   1519: =pod
1.31      albertel 1520: 
1.41      ng       1521: =item csv_samples_select_table($r,$records,$d)
                   1522: 
                   1523: Prints a table of sample values from the upload and can make associate samples to internal names.
                   1524: 
                   1525: $r is an Apache Request ref,
                   1526: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   1527: $d is an array of 2 element arrays (internal name, displayed name)
                   1528: 
                   1529: =cut
                   1530: 
1.31      albertel 1531: sub csv_samples_select_table {
                   1532:     my ($r,$records,$d) = @_;
                   1533:     my %sone; my %stwo; my %sthree;
                   1534:     my $i=0;
                   1535: 
                   1536:     $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
                   1537:     %sone=&record_sep($$records[0]);
                   1538:     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
                   1539:     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
                   1540: 
                   1541:     foreach (sort keys %sone) {
                   1542: 	$r->print('<tr><td><select name=f'.$i.
1.32      matthew  1543: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 1544: 	foreach (@$d) {
                   1545: 	    my ($value,$display)=@{ $_ };
                   1546: 	    $r->print('<option value='.$value.'>'.$display.'</option>');
                   1547: 	}
                   1548: 	$r->print('</select></td><td>');
                   1549: 	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
                   1550: 	if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
                   1551: 	if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
                   1552: 	$r->print('</td></tr>');
                   1553: 	$i++;
                   1554:     }
                   1555:     $i--;
                   1556:     return($i);
1.25      albertel 1557: }
1.1       albertel 1558: 1;
                   1559: __END__;
1.17      harris41 1560: 
1.41      ng       1561: =pod
                   1562: 
                   1563: =back
                   1564: 
                   1565: =head2 Access .tab File Data
                   1566: 
                   1567: =over 4
                   1568: 
1.35      matthew  1569: =item languageids() 
1.17      harris41 1570: 
1.35      matthew  1571: returns list of all language ids
1.17      harris41 1572: 
1.35      matthew  1573: =item languagedescription() 
1.17      harris41 1574: 
1.35      matthew  1575: returns description of a specified language id
1.17      harris41 1576: 
1.35      matthew  1577: =item copyrightids() 
1.17      harris41 1578: 
1.35      matthew  1579: returns list of all copyrights
1.17      harris41 1580: 
1.35      matthew  1581: =item copyrightdescription() 
1.17      harris41 1582: 
1.35      matthew  1583: returns description of a specified copyright id
1.17      harris41 1584: 
1.35      matthew  1585: =item filecategories() 
1.17      harris41 1586: 
1.35      matthew  1587: returns list of all file categories
1.17      harris41 1588: 
1.35      matthew  1589: =item filecategorytypes() 
1.17      harris41 1590: 
1.35      matthew  1591: returns list of file types belonging to a given file
1.17      harris41 1592: category
                   1593: 
1.35      matthew  1594: =item fileembstyle() 
1.17      harris41 1595: 
1.35      matthew  1596: returns embedding style for a specified file type
1.17      harris41 1597: 
1.35      matthew  1598: =item filedescription() 
1.17      harris41 1599: 
1.35      matthew  1600: returns description for a specified file type
1.17      harris41 1601: 
1.35      matthew  1602: =item filedescriptionex() 
1.17      harris41 1603: 
1.35      matthew  1604: returns description for a specified file type with
1.17      harris41 1605: extra formatting
                   1606: 
1.41      ng       1607: =back
                   1608: 
                   1609: =head2 Alternate Problem Views
                   1610: 
                   1611: =over 4
                   1612: 
1.35      matthew  1613: =item get_previous_attempt() 
1.17      harris41 1614: 
1.35      matthew  1615: return string with previous attempt on problem
1.17      harris41 1616: 
1.35      matthew  1617: =item get_student_view() 
1.17      harris41 1618: 
1.35      matthew  1619: show a snapshot of what student was looking at
1.17      harris41 1620: 
1.35      matthew  1621: =item get_student_answers() 
1.17      harris41 1622: 
1.35      matthew  1623: show a snapshot of how student was answering problem
1.17      harris41 1624: 
1.41      ng       1625: =back
                   1626: 
                   1627: =head2 HTTP Helper
                   1628: 
                   1629: =over 4
                   1630: 
                   1631: =item get_unprocessed_cgi($query,$possible_names)
                   1632: 
                   1633: Modify the %ENV hash to contain unprocessed CGI form parameters held in
                   1634: $query.  The parameters listed in $possible_names (an array reference),
                   1635: will be set in $ENV{'form.name'} if they do not already exist.
1.17      harris41 1636: 
1.41      ng       1637: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   1638: $possible_names is an ref to an array of form element names.  As an example:
                   1639: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
                   1640: will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
1.17      harris41 1641: 
1.35      matthew  1642: =item cacheheader() 
1.17      harris41 1643: 
1.35      matthew  1644: returns cache-controlling header code
1.17      harris41 1645: 
1.35      matthew  1646: =item nocache() 
1.17      harris41 1647: 
1.35      matthew  1648: specifies header code to not have cache
1.25      albertel 1649: 
1.35      matthew  1650: =item add_to_env($name,$value) 
1.25      albertel 1651: 
1.35      matthew  1652: adds $name to the %ENV hash with value
1.25      albertel 1653: $value, if $name already exists, the entry is converted to an array
                   1654: reference and $value is added to the array.
1.17      harris41 1655: 
                   1656: =back
                   1657: 
                   1658: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>