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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.732   ! raeburn     4: # $Id: loncommon.pm,v 1.731 2009/01/08 19:46:43 raeburn 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.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.479     albertel   70: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    71: use DateTime::TimeZone;
1.687     raeburn    72: use DateTime::Locale::Catalog;
1.117     www        73: 
1.517     raeburn    74: # ---------------------------------------------- Designs
                     75: use vars qw(%defaultdesign);
                     76: 
1.22      www        77: my $readit;
                     78: 
1.517     raeburn    79: 
1.157     matthew    80: ##
                     81: ## Global Variables
                     82: ##
1.46      matthew    83: 
1.643     foxr       84: 
                     85: # ----------------------------------------------- SSI with retries:
                     86: #
                     87: 
                     88: =pod
                     89: 
1.648     raeburn    90: =head1 Server Side include with retries:
1.643     foxr       91: 
                     92: =over 4
                     93: 
1.648     raeburn    94: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       95: 
                     96: Performs an ssi with some number of retries.  Retries continue either
                     97: until the result is ok or until the retry count supplied by the
                     98: caller is exhausted.  
                     99: 
                    100: Inputs:
1.648     raeburn   101: 
                    102: =over 4
                    103: 
1.643     foxr      104: resource   - Identifies the resource to insert.
1.648     raeburn   105: 
1.643     foxr      106: retries    - Count of the number of retries allowed.
1.648     raeburn   107: 
1.643     foxr      108: form       - Hash that identifies the rendering options.
                    109: 
1.648     raeburn   110: =back
                    111: 
                    112: Returns:
                    113: 
                    114: =over 4
                    115: 
1.643     foxr      116: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   117: 
1.643     foxr      118: response   - The response from the last attempt (which may or may not have been successful.
                    119: 
1.648     raeburn   120: =back
                    121: 
                    122: =back
                    123: 
1.643     foxr      124: =cut
                    125: 
                    126: sub ssi_with_retries {
                    127:     my ($resource, $retries, %form) = @_;
                    128: 
                    129: 
                    130:     my $ok = 0;			# True if we got a good response.
                    131:     my $content;
                    132:     my $response;
                    133: 
                    134:     # Try to get the ssi done. within the retries count:
                    135: 
                    136:     do {
                    137: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    138: 	$ok      = $response->is_success;
1.650     www       139:         if (!$ok) {
                    140:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    141:         }
1.643     foxr      142: 	$retries--;
                    143:     } while (!$ok && ($retries > 0));
                    144: 
                    145:     if (!$ok) {
                    146: 	$content = '';		# On error return an empty content.
                    147:     }
                    148:     return ($content, $response);
                    149: 
                    150: }
                    151: 
                    152: 
                    153: 
1.20      www       154: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  155: my %language;
1.124     www       156: my %supported_language;
1.12      harris41  157: my %cprtag;
1.192     taceyjo1  158: my %scprtag;
1.351     www       159: my %fe; my %fd; my %fm;
1.41      ng        160: my %category_extensions;
1.12      harris41  161: 
1.46      matthew   162: # ---------------------------------------------- Thesaurus variables
1.144     matthew   163: #
                    164: # %Keywords:
                    165: #      A hash used by &keyword to determine if a word is considered a keyword.
                    166: # $thesaurus_db_file 
                    167: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   168: 
                    169: my %Keywords;
                    170: my $thesaurus_db_file;
                    171: 
1.144     matthew   172: #
                    173: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    174: # thesaurus.tab, and filecategories.tab.
                    175: #
1.18      www       176: BEGIN {
1.46      matthew   177:     # Variable initialization
                    178:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    179:     #
1.22      www       180:     unless ($readit) {
1.12      harris41  181: # ------------------------------------------------------------------- languages
                    182:     {
1.158     raeburn   183:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    184:                                    '/language.tab';
                    185:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  186:             while (my $line = <$fh>) {
                    187:                 next if ($line=~/^\#/);
                    188:                 chomp($line);
                    189:                 my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158     raeburn   190:                 $language{$key}=$val.' - '.$enc;
                    191:                 if ($sup) {
                    192:                     $supported_language{$key}=$sup;
                    193:                 }
                    194:             }
                    195:             close($fh);
                    196:         }
1.12      harris41  197:     }
                    198: # ------------------------------------------------------------------ copyrights
                    199:     {
1.158     raeburn   200:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    201:                                   '/copyright.tab';
                    202:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  203:             while (my $line = <$fh>) {
                    204:                 next if ($line=~/^\#/);
                    205:                 chomp($line);
                    206:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   207:                 $cprtag{$key}=$val;
                    208:             }
                    209:             close($fh);
                    210:         }
1.12      harris41  211:     }
1.351     www       212: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  213:     {
                    214:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    215:                                   '/source_copyright.tab';
                    216:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  217:             while (my $line = <$fh>) {
                    218:                 next if ($line =~ /^\#/);
                    219:                 chomp($line);
                    220:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  221:                 $scprtag{$key}=$val;
                    222:             }
                    223:             close($fh);
                    224:         }
                    225:     }
1.63      www       226: 
1.517     raeburn   227: # -------------------------------------------------------------- default domain designs
1.63      www       228:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   229:     my $designfile = $designdir.'/default.tab';
                    230:     if ( open (my $fh,"<$designfile") ) {
                    231:         while (my $line = <$fh>) {
                    232:             next if ($line =~ /^\#/);
                    233:             chomp($line);
                    234:             my ($key,$val)=(split(/\=/,$line));
                    235:             if ($val) { $defaultdesign{$key}=$val; }
                    236:         }
                    237:         close($fh);
1.63      www       238:     }
                    239: 
1.15      harris41  240: # ------------------------------------------------------------- file categories
                    241:     {
1.158     raeburn   242:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    243:                                   '/filecategories.tab';
                    244:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  245: 	    while (my $line = <$fh>) {
                    246: 		next if ($line =~ /^\#/);
                    247: 		chomp($line);
                    248:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   249:                 push @{$category_extensions{lc($category)}},$extension;
                    250:             }
                    251:             close($fh);
                    252:         }
                    253: 
1.15      harris41  254:     }
1.12      harris41  255: # ------------------------------------------------------------------ file types
                    256:     {
1.158     raeburn   257:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    258:                '/filetypes.tab';
                    259:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  260:             while (my $line = <$fh>) {
                    261: 		next if ($line =~ /^\#/);
                    262: 		chomp($line);
                    263:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   264:                 if ($descr ne '') {
                    265:                     $fe{$ending}=lc($emb);
                    266:                     $fd{$ending}=$descr;
1.351     www       267:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   268:                 }
                    269:             }
                    270:             close($fh);
                    271:         }
1.12      harris41  272:     }
1.22      www       273:     &Apache::lonnet::logthis(
1.705     tempelho  274:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       275:     $readit=1;
1.46      matthew   276:     }  # end of unless($readit) 
1.32      matthew   277:     
                    278: }
1.112     bowersj2  279: 
1.42      matthew   280: ###############################################################
                    281: ##           HTML and Javascript Helper Functions            ##
                    282: ###############################################################
                    283: 
                    284: =pod 
                    285: 
1.112     bowersj2  286: =head1 HTML and Javascript Functions
1.42      matthew   287: 
1.112     bowersj2  288: =over 4
                    289: 
1.648     raeburn   290: =item * &browser_and_searcher_javascript()
1.112     bowersj2  291: 
                    292: X<browsing, javascript>X<searching, javascript>Returns a string
                    293: containing javascript with two functions, C<openbrowser> and
                    294: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    295: tags.
1.42      matthew   296: 
1.648     raeburn   297: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   298: 
                    299: inputs: formname, elementname, only, omit
                    300: 
                    301: formname and elementname indicate the name of the html form and name of
                    302: the element that the results of the browsing selection are to be placed in. 
                    303: 
                    304: Specifying 'only' will restrict the browser to displaying only files
1.185     www       305: with the given extension.  Can be a comma separated list.
1.42      matthew   306: 
                    307: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       308: with the given extension.  Can be a comma separated list.
1.42      matthew   309: 
1.648     raeburn   310: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   311: 
                    312: Inputs: formname, elementname
                    313: 
                    314: formname and elementname specify the name of the html form and the name
                    315: of the element the selection from the search results will be placed in.
1.542     raeburn   316: 
1.42      matthew   317: =cut
                    318: 
                    319: sub browser_and_searcher_javascript {
1.199     albertel  320:     my ($mode)=@_;
                    321:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  322:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   323:     return <<END;
1.219     albertel  324: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   325:     var editbrowser = null;
1.135     albertel  326:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       327:         var url = '$resurl/?';
1.42      matthew   328:         if (editbrowser == null) {
                    329:             url += 'launch=1&';
                    330:         }
                    331:         url += 'catalogmode=interactive&';
1.199     albertel  332:         url += 'mode=$mode&';
1.611     albertel  333:         url += 'inhibitmenu=yes&';
1.42      matthew   334:         url += 'form=' + formname + '&';
                    335:         if (only != null) {
                    336:             url += 'only=' + only + '&';
1.217     albertel  337:         } else {
                    338:             url += 'only=&';
                    339: 	}
1.42      matthew   340:         if (omit != null) {
                    341:             url += 'omit=' + omit + '&';
1.217     albertel  342:         } else {
                    343:             url += 'omit=&';
                    344: 	}
1.135     albertel  345:         if (titleelement != null) {
                    346:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  347:         } else {
                    348: 	    url += 'titleelement=&';
                    349: 	}
1.42      matthew   350:         url += 'element=' + elementname + '';
                    351:         var title = 'Browser';
1.435     albertel  352:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   353:         options += ',width=700,height=600';
                    354:         editbrowser = open(url,title,options,'1');
                    355:         editbrowser.focus();
                    356:     }
                    357:     var editsearcher;
1.135     albertel  358:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   359:         var url = '/adm/searchcat?';
                    360:         if (editsearcher == null) {
                    361:             url += 'launch=1&';
                    362:         }
                    363:         url += 'catalogmode=interactive&';
1.199     albertel  364:         url += 'mode=$mode&';
1.42      matthew   365:         url += 'form=' + formname + '&';
1.135     albertel  366:         if (titleelement != null) {
                    367:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  368:         } else {
                    369: 	    url += 'titleelement=&';
                    370: 	}
1.42      matthew   371:         url += 'element=' + elementname + '';
                    372:         var title = 'Search';
1.435     albertel  373:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   374:         options += ',width=700,height=600';
                    375:         editsearcher = open(url,title,options,'1');
                    376:         editsearcher.focus();
                    377:     }
1.219     albertel  378: // END LON-CAPA Internal -->
1.42      matthew   379: END
1.170     www       380: }
                    381: 
                    382: sub lastresurl {
1.258     albertel  383:     if ($env{'environment.lastresurl'}) {
                    384: 	return $env{'environment.lastresurl'}
1.170     www       385:     } else {
                    386: 	return '/res';
                    387:     }
                    388: }
                    389: 
                    390: sub storeresurl {
                    391:     my $resurl=&Apache::lonnet::clutter(shift);
                    392:     unless ($resurl=~/^\/res/) { return 0; }
                    393:     $resurl=~s/\/$//;
                    394:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   395:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       396:     return 1;
1.42      matthew   397: }
                    398: 
1.74      www       399: sub studentbrowser_javascript {
1.111     www       400:    unless (
1.258     albertel  401:             (($env{'request.course.id'}) && 
1.302     albertel  402:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    403: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    404: 					  '/'.$env{'request.course.sec'})
                    405: 	      ))
1.258     albertel  406:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       407:           ) { return ''; }  
1.74      www       408:    return (<<'ENDSTDBRW');
                    409: <script type="text/javascript" language="Javascript" >
                    410:     var stdeditbrowser;
1.558     albertel  411:     function openstdbrowser(formname,uname,udom,roleflag,ignorefilter) {
1.74      www       412:         var url = '/adm/pickstudent?';
                    413:         var filter;
1.558     albertel  414: 	if (!ignorefilter) {
                    415: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    416: 	}
1.74      www       417:         if (filter != null) {
                    418:            if (filter != '') {
                    419:                url += 'filter='+filter+'&';
                    420: 	   }
                    421:         }
                    422:         url += 'form=' + formname + '&unameelement='+uname+
                    423:                                     '&udomelement='+udom;
1.111     www       424: 	if (roleflag) { url+="&roles=1"; }
1.102     www       425:         var title = 'Student_Browser';
1.74      www       426:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    427:         options += ',width=700,height=600';
                    428:         stdeditbrowser = open(url,title,options,'1');
                    429:         stdeditbrowser.focus();
                    430:     }
                    431: </script>
                    432: ENDSTDBRW
                    433: }
1.42      matthew   434: 
1.74      www       435: sub selectstudent_link {
1.111     www       436:    my ($form,$unameele,$udomele)=@_;
1.258     albertel  437:    if ($env{'request.course.id'}) {  
1.302     albertel  438:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    439: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    440: 					'/'.$env{'request.course.sec'})) {
1.111     www       441: 	   return '';
                    442:        }
                    443:        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.607     albertel  444:         '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
1.74      www       445:    }
1.258     albertel  446:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.111     www       447:        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.119     www       448:         '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
1.111     www       449:    }
                    450:    return '';
1.91      www       451: }
                    452: 
1.653     raeburn   453: sub authorbrowser_javascript {
                    454:     return <<"ENDAUTHORBRW";
                    455: <script type="text/javascript">
                    456: var stdeditbrowser;
                    457: 
                    458: function openauthorbrowser(formname,udom) {
                    459:     var url = '/adm/pickauthor?';
                    460:     url += 'form='+formname+'&roledom='+udom;
                    461:     var title = 'Author_Browser';
                    462:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    463:     options += ',width=700,height=600';
                    464:     stdeditbrowser = open(url,title,options,'1');
                    465:     stdeditbrowser.focus();
                    466: }
                    467: 
                    468: </script>
                    469: ENDAUTHORBRW
                    470: }
                    471: 
1.91      www       472: sub coursebrowser_javascript {
1.468     raeburn   473:     my ($domainfilter,$sec_element,$formname)=@_;
1.377     raeburn   474:     my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');
1.468     raeburn   475:    my $output = '
1.538     albertel  476: <script type="text/javascript">
1.468     raeburn   477:     var stdeditbrowser;'."\n";
                    478:    $output .= <<"ENDSTDBRW";
1.377     raeburn   479:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91      www       480:         var url = '/adm/pickcourse?';
1.468     raeburn   481:         var domainfilter = '';
                    482:         var formid = getFormIdByName(formname);
                    483:         if (formid > -1) {
                    484:             var domid = getIndexByName(formid,udom);
                    485:             if (domid > -1) {
                    486:                 if (document.forms[formid].elements[domid].type == 'select-one') {
                    487:                     domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    488:                 }
                    489:                 if (document.forms[formid].elements[domid].type == 'hidden') {
                    490:                     domainfilter=document.forms[formid].elements[domid].value;
                    491:                 }
                    492:             }
1.91      www       493:         }
1.128     albertel  494:         if (domainfilter != null) {
                    495:            if (domainfilter != '') {
                    496:                url += 'domainfilter='+domainfilter+'&';
                    497: 	   }
                    498:         }
1.91      www       499:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  500: 	                            '&cdomelement='+udom+
                    501:                                     '&cnameelement='+desc;
1.468     raeburn   502:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   503:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   504:                 url += '&roleelement='+extra_element;
                    505:                 if (domainfilter == null || domainfilter == '') {
                    506:                     url += '&domainfilter='+extra_element;
                    507:                 }
1.234     raeburn   508:             }
1.468     raeburn   509:             else {
                    510:                 if (formname == 'portform') {
                    511:                     url += '&setroles='+extra_element;
                    512:                 }
                    513:             }     
1.230     raeburn   514:         }
1.293     raeburn   515:         if (multflag !=null && multflag != '') {
                    516:             url += '&multiple='+multflag;
                    517:         }
1.377     raeburn   518:         if (crstype == 'Course/Group') {
                    519:             if (formname == 'cu') {
                    520:                 crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; 
                    521:                 if (crstype == "") {
                    522:                     alert("$crs_or_grp_alert");
                    523:                     return;
                    524:                 }
                    525:             }
                    526:         }
                    527:         if (crstype !=null && crstype != '') {
                    528:             url += '&type='+crstype;
                    529:         }
1.102     www       530:         var title = 'Course_Browser';
1.91      www       531:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    532:         options += ',width=700,height=600';
                    533:         stdeditbrowser = open(url,title,options,'1');
                    534:         stdeditbrowser.focus();
                    535:     }
1.468     raeburn   536: 
                    537:     function getFormIdByName(formname) {
                    538:         for (var i=0;i<document.forms.length;i++) {
                    539:             if (document.forms[i].name == formname) {
                    540:                 return i;
                    541:             }
                    542:         }
                    543:         return -1; 
                    544:     }
                    545: 
                    546:     function getIndexByName(formid,item) {
                    547:         for (var i=0;i<document.forms[formid].elements.length;i++) {
                    548:             if (document.forms[formid].elements[i].name == item) {
                    549:                 return i;
                    550:             }
                    551:         }
                    552:         return -1;
                    553:     }
1.91      www       554: ENDSTDBRW
1.468     raeburn   555:     if ($sec_element ne '') {
                    556:         $output .= &setsec_javascript($sec_element,$formname);
                    557:     }
                    558:     $output .= '
                    559: </script>';
                    560:     return $output;
                    561: }
                    562: 
                    563: sub setsec_javascript {
                    564:     my ($sec_element,$formname) = @_;
                    565:     my $setsections = qq|
                    566: function setSect(sectionlist) {
1.629     raeburn   567:     var sectionsArray = new Array();
                    568:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    569:         sectionsArray = sectionlist.split(",");
                    570:     }
1.468     raeburn   571:     var numSections = sectionsArray.length;
                    572:     document.$formname.$sec_element.length = 0;
                    573:     if (numSections == 0) {
                    574:         document.$formname.$sec_element.multiple=false;
                    575:         document.$formname.$sec_element.size=1;
                    576:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    577:     } else {
                    578:         if (numSections == 1) {
                    579:             document.$formname.$sec_element.multiple=false;
                    580:             document.$formname.$sec_element.size=1;
                    581:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    582:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    583:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    584:         } else {
                    585:             for (var i=0; i<numSections; i++) {
                    586:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    587:             }
                    588:             document.$formname.$sec_element.multiple=true
                    589:             if (numSections < 3) {
                    590:                 document.$formname.$sec_element.size=numSections;
                    591:             } else {
                    592:                 document.$formname.$sec_element.size=3;
                    593:             }
                    594:             document.$formname.$sec_element.options[0].selected = false
                    595:         }
                    596:     }
1.91      www       597: }
1.468     raeburn   598: |;
                    599:     return $setsections;
                    600: }
                    601: 
1.91      www       602: 
                    603: sub selectcourse_link {
1.377     raeburn   604:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.492     albertel  605:    return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
                    606:         '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
1.74      www       607: }
1.42      matthew   608: 
1.653     raeburn   609: sub selectauthor_link {
                    610:    my ($form,$udom)=@_;
                    611:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    612:           &mt('Select Author').'</a>';
                    613: }
                    614: 
1.273     raeburn   615: sub check_uncheck_jscript {
                    616:     my $jscript = <<"ENDSCRT";
                    617: function checkAll(field) {
                    618:     if (field.length > 0) {
                    619:         for (i = 0; i < field.length; i++) {
                    620:             field[i].checked = true ;
                    621:         }
                    622:     } else {
                    623:         field.checked = true
                    624:     }
                    625: }
                    626:  
                    627: function uncheckAll(field) {
                    628:     if (field.length > 0) {
                    629:         for (i = 0; i < field.length; i++) {
                    630:             field[i].checked = false ;
1.543     albertel  631:         }
                    632:     } else {
1.273     raeburn   633:         field.checked = false ;
                    634:     }
                    635: }
                    636: ENDSCRT
                    637:     return $jscript;
                    638: }
                    639: 
1.656     www       640: sub select_timezone {
1.659     raeburn   641:    my ($name,$selected,$onchange,$includeempty)=@_;
                    642:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    643:    if ($includeempty) {
                    644:        $output .= '<option value=""';
                    645:        if (($selected eq '') || ($selected eq 'local')) {
                    646:            $output .= ' selected="selected" ';
                    647:        }
                    648:        $output .= '> </option>';
                    649:    }
1.657     raeburn   650:    my @timezones = DateTime::TimeZone->all_names;
                    651:    foreach my $tzone (@timezones) {
                    652:        $output.= '<option value="'.$tzone.'"';
                    653:        if ($tzone eq $selected) {
                    654:            $output.=' selected="selected"';
                    655:        }
                    656:        $output.=">$tzone</option>\n";
1.656     www       657:    }
                    658:    $output.="</select>";
                    659:    return $output;
                    660: }
1.273     raeburn   661: 
1.687     raeburn   662: sub select_datelocale {
                    663:     my ($name,$selected,$onchange,$includeempty)=@_;
                    664:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    665:     if ($includeempty) {
                    666:         $output .= '<option value=""';
                    667:         if ($selected eq '') {
                    668:             $output .= ' selected="selected" ';
                    669:         }
                    670:         $output .= '> </option>';
                    671:     }
                    672:     my (@possibles,%locale_names);
                    673:     my @locales = DateTime::Locale::Catalog::Locales;
                    674:     foreach my $locale (@locales) {
                    675:         if (ref($locale) eq 'HASH') {
                    676:             my $id = $locale->{'id'};
                    677:             if ($id ne '') {
                    678:                 my $en_terr = $locale->{'en_territory'};
                    679:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   680:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   681:                 if (grep(/^en$/,@languages) || !@languages) {
                    682:                     if ($en_terr ne '') {
                    683:                         $locale_names{$id} = '('.$en_terr.')';
                    684:                     } elsif ($native_terr ne '') {
                    685:                         $locale_names{$id} = $native_terr;
                    686:                     }
                    687:                 } else {
                    688:                     if ($native_terr ne '') {
                    689:                         $locale_names{$id} = $native_terr.' ';
                    690:                     } elsif ($en_terr ne '') {
                    691:                         $locale_names{$id} = '('.$en_terr.')';
                    692:                     }
                    693:                 }
                    694:                 push (@possibles,$id);
                    695:             }
                    696:         }
                    697:     }
                    698:     foreach my $item (sort(@possibles)) {
                    699:         $output.= '<option value="'.$item.'"';
                    700:         if ($item eq $selected) {
                    701:             $output.=' selected="selected"';
                    702:         }
                    703:         $output.=">$item";
                    704:         if ($locale_names{$item} ne '') {
                    705:             $output.="  $locale_names{$item}</option>\n";
                    706:         }
                    707:         $output.="</option>\n";
                    708:     }
                    709:     $output.="</select>";
                    710:     return $output;
                    711: }
                    712: 
1.42      matthew   713: =pod
1.36      matthew   714: 
1.648     raeburn   715: =item * &linked_select_forms(...)
1.36      matthew   716: 
                    717: linked_select_forms returns a string containing a <script></script> block
                    718: and html for two <select> menus.  The select menus will be linked in that
                    719: changing the value of the first menu will result in new values being placed
                    720: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn   721: order unless a defined order is provided.
1.36      matthew   722: 
                    723: linked_select_forms takes the following ordered inputs:
                    724: 
                    725: =over 4
                    726: 
1.112     bowersj2  727: =item * $formname, the name of the <form> tag
1.36      matthew   728: 
1.112     bowersj2  729: =item * $middletext, the text which appears between the <select> tags
1.36      matthew   730: 
1.112     bowersj2  731: =item * $firstdefault, the default value for the first menu
1.36      matthew   732: 
1.112     bowersj2  733: =item * $firstselectname, the name of the first <select> tag
1.36      matthew   734: 
1.112     bowersj2  735: =item * $secondselectname, the name of the second <select> tag
1.36      matthew   736: 
1.112     bowersj2  737: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew   738: 
1.609     raeburn   739: =item * $menuorder, the order of values in the first menu
                    740: 
1.41      ng        741: =back 
                    742: 
1.36      matthew   743: Below is an example of such a hash.  Only the 'text', 'default', and 
                    744: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    745: values for the first select menu.  The text that coincides with the 
1.41      ng        746: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   747: and text for the second menu are given in the hash pointed to by 
                    748: $menu{$choice1}->{'select2'}.  
                    749: 
1.112     bowersj2  750:  my %menu = ( A1 => { text =>"Choice A1" ,
                    751:                        default => "B3",
                    752:                        select2 => { 
                    753:                            B1 => "Choice B1",
                    754:                            B2 => "Choice B2",
                    755:                            B3 => "Choice B3",
                    756:                            B4 => "Choice B4"
1.609     raeburn   757:                            },
                    758:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2  759:                    },
                    760:                A2 => { text =>"Choice A2" ,
                    761:                        default => "C2",
                    762:                        select2 => { 
                    763:                            C1 => "Choice C1",
                    764:                            C2 => "Choice C2",
                    765:                            C3 => "Choice C3"
1.609     raeburn   766:                            },
                    767:                        order => ['C2','C1','C3'],
1.112     bowersj2  768:                    },
                    769:                A3 => { text =>"Choice A3" ,
                    770:                        default => "D6",
                    771:                        select2 => { 
                    772:                            D1 => "Choice D1",
                    773:                            D2 => "Choice D2",
                    774:                            D3 => "Choice D3",
                    775:                            D4 => "Choice D4",
                    776:                            D5 => "Choice D5",
                    777:                            D6 => "Choice D6",
                    778:                            D7 => "Choice D7"
1.609     raeburn   779:                            },
                    780:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2  781:                    }
                    782:                );
1.36      matthew   783: 
                    784: =cut
                    785: 
                    786: sub linked_select_forms {
                    787:     my ($formname,
                    788:         $middletext,
                    789:         $firstdefault,
                    790:         $firstselectname,
                    791:         $secondselectname, 
1.609     raeburn   792:         $hashref,
                    793:         $menuorder,
1.36      matthew   794:         ) = @_;
                    795:     my $second = "document.$formname.$secondselectname";
                    796:     my $first = "document.$formname.$firstselectname";
                    797:     # output the javascript to do the changing
                    798:     my $result = '';
1.219     albertel  799:     $result.="<script type=\"text/javascript\">\n";
1.36      matthew   800:     $result.="var select2data = new Object();\n";
                    801:     $" = '","';
                    802:     my $debug = '';
                    803:     foreach my $s1 (sort(keys(%$hashref))) {
                    804:         $result.="select2data.d_$s1 = new Object();\n";        
                    805:         $result.="select2data.d_$s1.def = new String('".
                    806:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn   807:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew   808:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn   809:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                    810:             @s2values = @{$hashref->{$s1}->{'order'}};
                    811:         }
1.36      matthew   812:         $result.="\"@s2values\");\n";
                    813:         $result.="select2data.d_$s1.texts = new Array(";        
                    814:         my @s2texts;
                    815:         foreach my $value (@s2values) {
                    816:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                    817:         }
                    818:         $result.="\"@s2texts\");\n";
                    819:     }
                    820:     $"=' ';
                    821:     $result.= <<"END";
                    822: 
                    823: function select1_changed() {
                    824:     // Determine new choice
                    825:     var newvalue = "d_" + $first.value;
                    826:     // update select2
                    827:     var values     = select2data[newvalue].values;
                    828:     var texts      = select2data[newvalue].texts;
                    829:     var select2def = select2data[newvalue].def;
                    830:     var i;
                    831:     // out with the old
                    832:     for (i = 0; i < $second.options.length; i++) {
                    833:         $second.options[i] = null;
                    834:     }
                    835:     // in with the nuclear
                    836:     for (i=0;i<values.length; i++) {
                    837:         $second.options[i] = new Option(values[i]);
1.143     matthew   838:         $second.options[i].value = values[i];
1.36      matthew   839:         $second.options[i].text = texts[i];
                    840:         if (values[i] == select2def) {
                    841:             $second.options[i].selected = true;
                    842:         }
                    843:     }
                    844: }
                    845: </script>
                    846: END
                    847:     # output the initial values for the selection lists
                    848:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn   849:     my @order = sort(keys(%{$hashref}));
                    850:     if (ref($menuorder) eq 'ARRAY') {
                    851:         @order = @{$menuorder};
                    852:     }
                    853:     foreach my $value (@order) {
1.36      matthew   854:         $result.="    <option value=\"$value\" ";
1.253     albertel  855:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www       856:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew   857:     }
                    858:     $result .= "</select>\n";
                    859:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                    860:     $result .= $middletext;
                    861:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                    862:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn   863:     
                    864:     my @secondorder = sort(keys(%select2));
                    865:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                    866:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                    867:     }
                    868:     foreach my $value (@secondorder) {
1.36      matthew   869:         $result.="    <option value=\"$value\" ";        
1.253     albertel  870:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www       871:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew   872:     }
                    873:     $result .= "</select>\n";
                    874:     #    return $debug;
                    875:     return $result;
                    876: }   #  end of sub linked_select_forms {
                    877: 
1.45      matthew   878: =pod
1.44      bowersj2  879: 
1.648     raeburn   880: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44      bowersj2  881: 
1.112     bowersj2  882: Returns a string corresponding to an HTML link to the given help
                    883: $topic, where $topic corresponds to the name of a .tex file in
                    884: /home/httpd/html/adm/help/tex, with underscores replaced by
                    885: spaces. 
                    886: 
                    887: $text will optionally be linked to the same topic, allowing you to
                    888: link text in addition to the graphic. If you do not want to link
                    889: text, but wish to specify one of the later parameters, pass an
                    890: empty string. 
                    891: 
                    892: $stayOnPage is a value that will be interpreted as a boolean. If true,
                    893: the link will not open a new window. If false, the link will open
                    894: a new window using Javascript. (Default is false.) 
                    895: 
                    896: $width and $height are optional numerical parameters that will
                    897: override the width and height of the popped up window, which may
                    898: be useful for certain help topics with big pictures included. 
1.44      bowersj2  899: 
                    900: =cut
                    901: 
                    902: sub help_open_topic {
1.48      bowersj2  903:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
                    904:     $text = "" if (not defined $text);
1.44      bowersj2  905:     $stayOnPage = 0 if (not defined $stayOnPage);
1.552     banghart  906:     if ($env{'browser.interface'} eq 'textual') {
1.79      www       907: 	$stayOnPage=1;
                    908:     }
1.44      bowersj2  909:     $width = 350 if (not defined $width);
                    910:     $height = 400 if (not defined $height);
                    911:     my $filename = $topic;
                    912:     $filename =~ s/ /_/g;
                    913: 
1.48      bowersj2  914:     my $template = "";
                    915:     my $link;
1.572     banghart  916:     
1.159     www       917:     $topic=~s/\W/\_/g;
1.44      bowersj2  918: 
1.572     banghart  919:     if (!$stayOnPage) {
1.72      bowersj2  920: 	$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.572     banghart  921:     } else {
1.48      bowersj2  922: 	$link = "/adm/help/${filename}.hlp";
                    923:     }
                    924: 
                    925:     # Add the text
1.572     banghart  926:     if ($text ne "") {
1.77      www       927: 	$template .= 
1.572     banghart  928:             "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho  929:             "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.48      bowersj2  930:     }
                    931: 
                    932:     # Add the graphic
1.179     matthew   933:     my $title = &mt('Online Help');
1.667     raeburn   934:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.48      bowersj2  935:     $template .= <<"ENDTEMPLATE";
1.436     albertel  936:  <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
1.44      bowersj2  937: ENDTEMPLATE
1.705     tempelho  938:     if ($text ne '') { $template.='</td></tr></table>' };
1.44      bowersj2  939:     return $template;
                    940: 
1.106     bowersj2  941: }
                    942: 
                    943: # This is a quicky function for Latex cheatsheet editing, since it 
                    944: # appears in at least four places
                    945: sub helpLatexCheatsheet {
1.732   ! raeburn   946:     my ($topic,$text,$not_author) = @_;
        !           947:     my $out;
1.106     bowersj2  948:     my $addOther = '';
1.732   ! raeburn   949:     if ($topic) {
        !           950: 	$addOther = &Apache::loncommon::help_open_topic($topic,$text,
        !           951: 						       undef, undef, 600).
1.106     bowersj2  952: 							   '</td><td>';
                    953:     }
1.732   ! raeburn   954:     $out = '<table><tr><td>'.
        !           955: 	   $addOther .
        !           956: 	   &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
        !           957: 					       undef,undef,600).
        !           958: 	   '</td><td>'.
        !           959: 	   &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
        !           960: 					       undef,undef,600).
        !           961: 	   '</td>';
        !           962:     unless ($not_author) {
        !           963:         $out .= '<td>'.
        !           964: 	        &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
        !           965: 	                                            undef,undef,600).
        !           966: 	        '</td>';
        !           967:     }
        !           968:     $out .= '</tr></table>';
        !           969:     return $out;
1.172     www       970: }
                    971: 
1.430     albertel  972: sub general_help {
                    973:     my $helptopic='Student_Intro';
                    974:     if ($env{'request.role'}=~/^(ca|au)/) {
                    975: 	$helptopic='Authoring_Intro';
                    976:     } elsif ($env{'request.role'}=~/^cc/) {
                    977: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn   978:     } elsif ($env{'request.role'}=~/^dc/) {
                    979:         $helptopic='Domain_Coordination_Intro';
1.430     albertel  980:     }
                    981:     return $helptopic;
                    982: }
                    983: 
                    984: sub update_help_link {
                    985:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                    986:     my $origurl = $ENV{'REQUEST_URI'};
                    987:     $origurl=~s|^/~|/priv/|;
                    988:     my $timestamp = time;
                    989:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                    990:         $$datum = &escape($$datum);
                    991:     }
                    992: 
                    993:     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
                    994:     my $output .= <<"ENDOUTPUT";
                    995: <script type="text/javascript">
                    996: banner_link = '$banner_link';
                    997: </script>
                    998: ENDOUTPUT
                    999:     return $output;
                   1000: }
                   1001: 
                   1002: # now just updates the help link and generates a blue icon
1.193     raeburn  1003: sub help_open_menu {
1.430     albertel 1004:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1005: 	= @_;    
1.430     albertel 1006:     $stayOnPage = 0 if (not defined $stayOnPage);
1.572     banghart 1007:     # only use pop-up help (stayOnPage == 0)
1.552     banghart 1008:     # if environment.remote is on (using remote control UI)
1.572     banghart 1009:     if ($env{'browser.interface'} eq 'textual' ||
                   1010:     	$env{'environment.remote'} eq 'off' ) {
1.552     banghart 1011:         $stayOnPage=1;
1.430     albertel 1012:     }
                   1013:     my $output;
                   1014:     if ($component_help) {
                   1015: 	if (!$text) {
                   1016: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1017: 				       $width,$height);
                   1018: 	} else {
                   1019: 	    my $help_text;
                   1020: 	    $help_text=&unescape($topic);
                   1021: 	    $output='<table><tr><td>'.
                   1022: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1023: 				 $width,$height).'</td></tr></table>';
                   1024: 	}
                   1025:     }
                   1026:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1027:     return $output.$banner_link;
                   1028: }
                   1029: 
                   1030: sub top_nav_help {
                   1031:     my ($text) = @_;
1.436     albertel 1032:     $text = &mt($text);
1.572     banghart 1033:     my $stay_on_page = 
1.436     albertel 1034: 	($env{'browser.interface'}  eq 'textual' ||
                   1035: 	 $env{'environment.remote'} eq 'off' );
1.572     banghart 1036:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1037: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1038:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1039: 
1.201     raeburn  1040:     my $title = &mt('Get help');
1.436     albertel 1041: 
                   1042:     return <<"END";
                   1043: $banner_link
                   1044:  <a href="$link" title="$title">$text</a>
                   1045: END
                   1046: }
                   1047: 
                   1048: sub help_menu_js {
                   1049:     my ($text) = @_;
                   1050: 
                   1051:     my $stayOnPage = 
                   1052: 	($env{'browser.interface'}  eq 'textual' ||
                   1053: 	 $env{'environment.remote'} eq 'off' );
                   1054: 
                   1055:     my $width = 620;
                   1056:     my $height = 600;
1.430     albertel 1057:     my $helptopic=&general_help();
                   1058:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1059:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1060:     my $start_page =
                   1061:         &Apache::loncommon::start_page('Help Menu', undef,
                   1062: 				       {'frameset'    => 1,
                   1063: 					'js_ready'    => 1,
                   1064: 					'add_entries' => {
                   1065: 					    'border' => '0',
1.579     raeburn  1066: 					    'rows'   => "110,*",},});
1.331     albertel 1067:     my $end_page =
                   1068:         &Apache::loncommon::end_page({'frameset' => 1,
                   1069: 				      'js_ready' => 1,});
                   1070: 
1.436     albertel 1071:     my $template .= <<"ENDTEMPLATE";
                   1072: <script type="text/javascript">
1.253     albertel 1073: // <!-- BEGIN LON-CAPA Internal
                   1074: // <![CDATA[
1.430     albertel 1075: var banner_link = '';
1.243     raeburn  1076: function helpMenu(target) {
                   1077:     var caller = this;
                   1078:     if (target == 'open') {
                   1079:         var newWindow = null;
                   1080:         try {
1.262     albertel 1081:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1082:         }
                   1083:         catch(error) {
                   1084:             writeHelp(caller);
                   1085:             return;
                   1086:         }
                   1087:         if (newWindow) {
                   1088:             caller = newWindow;
                   1089:         }
1.193     raeburn  1090:     }
1.243     raeburn  1091:     writeHelp(caller);
                   1092:     return;
                   1093: }
                   1094: function writeHelp(caller) {
1.430     albertel 1095:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn  1096:     caller.document.close()
                   1097:     caller.focus()
1.193     raeburn  1098: }
1.253     albertel 1099: // ]]>
1.219     albertel 1100: // END LON-CAPA Internal -->
1.436     albertel 1101: </script>
1.193     raeburn  1102: ENDTEMPLATE
                   1103:     return $template;
                   1104: }
                   1105: 
1.172     www      1106: sub help_open_bug {
                   1107:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1108:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1109:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1110:     $text = "" if (not defined $text);
                   1111:     $stayOnPage = 0 if (not defined $stayOnPage);
1.258     albertel 1112:     if ($env{'browser.interface'} eq 'textual' ||
                   1113: 	$env{'environment.remote'} eq 'off' ) {
1.172     www      1114: 	$stayOnPage=1;
                   1115:     }
1.184     albertel 1116:     $width = 600 if (not defined $width);
                   1117:     $height = 600 if (not defined $height);
1.172     www      1118: 
                   1119:     $topic=~s/\W+/\+/g;
                   1120:     my $link='';
                   1121:     my $template='';
1.379     albertel 1122:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1123: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1124:     if (!$stayOnPage)
                   1125:     {
                   1126: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1127:     }
                   1128:     else
                   1129:     {
                   1130: 	$link = $url;
                   1131:     }
                   1132:     # Add the text
                   1133:     if ($text ne "")
                   1134:     {
                   1135: 	$template .= 
                   1136:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1137:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1138:     }
                   1139: 
                   1140:     # Add the graphic
1.179     matthew  1141:     my $title = &mt('Report a Bug');
1.215     albertel 1142:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1143:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1144:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1145: ENDTEMPLATE
                   1146:     if ($text ne '') { $template.='</td></tr></table>' };
                   1147:     return $template;
                   1148: 
                   1149: }
                   1150: 
                   1151: sub help_open_faq {
                   1152:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1153:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1154:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1155:     $text = "" if (not defined $text);
                   1156:     $stayOnPage = 0 if (not defined $stayOnPage);
1.258     albertel 1157:     if ($env{'browser.interface'} eq 'textual' ||
                   1158: 	$env{'environment.remote'} eq 'off' ) {
1.172     www      1159: 	$stayOnPage=1;
                   1160:     }
                   1161:     $width = 350 if (not defined $width);
                   1162:     $height = 400 if (not defined $height);
                   1163: 
                   1164:     $topic=~s/\W+/\+/g;
                   1165:     my $link='';
                   1166:     my $template='';
                   1167:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1168:     if (!$stayOnPage)
                   1169:     {
                   1170: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1171:     }
                   1172:     else
                   1173:     {
                   1174: 	$link = $url;
                   1175:     }
                   1176: 
                   1177:     # Add the text
                   1178:     if ($text ne "")
                   1179:     {
                   1180: 	$template .= 
1.173     www      1181:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1182:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1183:     }
                   1184: 
                   1185:     # Add the graphic
1.179     matthew  1186:     my $title = &mt('View the FAQ');
1.215     albertel 1187:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1188:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1189:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1190: ENDTEMPLATE
                   1191:     if ($text ne '') { $template.='</td></tr></table>' };
                   1192:     return $template;
                   1193: 
1.44      bowersj2 1194: }
1.37      matthew  1195: 
1.180     matthew  1196: ###############################################################
                   1197: ###############################################################
                   1198: 
1.45      matthew  1199: =pod
                   1200: 
1.648     raeburn  1201: =item * &change_content_javascript():
1.256     matthew  1202: 
                   1203: This and the next function allow you to create small sections of an
                   1204: otherwise static HTML page that you can update on the fly with
                   1205: Javascript, even in Netscape 4.
                   1206: 
                   1207: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1208: must be written to the HTML page once. It will prove the Javascript
                   1209: function "change(name, content)". Calling the change function with the
                   1210: name of the section 
                   1211: you want to update, matching the name passed to C<changable_area>, and
                   1212: the new content you want to put in there, will put the content into
                   1213: that area.
                   1214: 
                   1215: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1216: to contain room for the original contents. You need to "make space"
                   1217: for whatever changes you wish to make, and be B<sure> to check your
                   1218: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1219: it's adequate for updating a one-line status display, but little more.
                   1220: This script will set the space to 100% width, so you only need to
                   1221: worry about height in Netscape 4.
                   1222: 
                   1223: Modern browsers are much less limiting, and if you can commit to the
                   1224: user not using Netscape 4, this feature may be used freely with
                   1225: pretty much any HTML.
                   1226: 
                   1227: =cut
                   1228: 
                   1229: sub change_content_javascript {
                   1230:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1231:     if ($env{'browser.type'} eq 'netscape' &&
                   1232: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1233: 	return (<<NETSCAPE4);
                   1234: 	function change(name, content) {
                   1235: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1236: 	    doc.open();
                   1237: 	    doc.write(content);
                   1238: 	    doc.close();
                   1239: 	}
                   1240: NETSCAPE4
                   1241:     } else {
                   1242: 	# Otherwise, we need to use semi-standards-compliant code
                   1243: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1244: 	# is really scary, and every useful browser supports it
                   1245: 	return (<<DOMBASED);
                   1246: 	function change(name, content) {
                   1247: 	    element = document.getElementById(name);
                   1248: 	    element.innerHTML = content;
                   1249: 	}
                   1250: DOMBASED
                   1251:     }
                   1252: }
                   1253: 
                   1254: =pod
                   1255: 
1.648     raeburn  1256: =item * &changable_area($name,$origContent):
1.256     matthew  1257: 
                   1258: This provides a "changable area" that can be modified on the fly via
                   1259: the Javascript code provided in C<change_content_javascript>. $name is
                   1260: the name you will use to reference the area later; do not repeat the
                   1261: same name on a given HTML page more then once. $origContent is what
                   1262: the area will originally contain, which can be left blank.
                   1263: 
                   1264: =cut
                   1265: 
                   1266: sub changable_area {
                   1267:     my ($name, $origContent) = @_;
                   1268: 
1.258     albertel 1269:     if ($env{'browser.type'} eq 'netscape' &&
                   1270: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1271: 	# If this is netscape 4, we need to use the Layer tag
                   1272: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1273:     } else {
                   1274: 	return "<span id='$name'>$origContent</span>";
                   1275:     }
                   1276: }
                   1277: 
                   1278: =pod
                   1279: 
1.648     raeburn  1280: =item * &viewport_geometry_js 
1.590     raeburn  1281: 
                   1282: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1283: 
                   1284: =cut
                   1285: 
                   1286: 
                   1287: sub viewport_geometry_js { 
                   1288:     return <<"GEOMETRY";
                   1289: var Geometry = {};
                   1290: function init_geometry() {
                   1291:     if (Geometry.init) { return };
                   1292:     Geometry.init=1;
                   1293:     if (window.innerHeight) {
                   1294:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1295:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1296:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1297:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1298:     }
                   1299:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1300:         Geometry.getViewportHeight =
                   1301:             function() { return document.documentElement.clientHeight; };
                   1302:         Geometry.getViewportWidth =
                   1303:             function() { return document.documentElement.clientWidth; };
                   1304: 
                   1305:         Geometry.getHorizontalScroll =
                   1306:             function() { return document.documentElement.scrollLeft; };
                   1307:         Geometry.getVerticalScroll =
                   1308:             function() { return document.documentElement.scrollTop; };
                   1309:     }
                   1310:     else if (document.body.clientHeight) {
                   1311:         Geometry.getViewportHeight =
                   1312:             function() { return document.body.clientHeight; };
                   1313:         Geometry.getViewportWidth =
                   1314:             function() { return document.body.clientWidth; };
                   1315:         Geometry.getHorizontalScroll =
                   1316:             function() { return document.body.scrollLeft; };
                   1317:         Geometry.getVerticalScroll =
                   1318:             function() { return document.body.scrollTop; };
                   1319:     }
                   1320: }
                   1321: 
                   1322: GEOMETRY
                   1323: }
                   1324: 
                   1325: =pod
                   1326: 
1.648     raeburn  1327: =item * &viewport_size_js()
1.590     raeburn  1328: 
                   1329: Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. 
                   1330: 
                   1331: =cut
                   1332: 
                   1333: sub viewport_size_js {
                   1334:     my $geometry = &viewport_geometry_js();
                   1335:     return <<"DIMS";
                   1336: 
                   1337: $geometry
                   1338: 
                   1339: function getViewportDims(width,height) {
                   1340:     init_geometry();
                   1341:     width.value = Geometry.getViewportWidth();
                   1342:     height.value = Geometry.getViewportHeight();
                   1343:     return;
                   1344: }
                   1345: 
                   1346: DIMS
                   1347: }
                   1348: 
                   1349: =pod
                   1350: 
1.648     raeburn  1351: =item * &resize_textarea_js()
1.565     albertel 1352: 
                   1353: emits the needed javascript to resize a textarea to be as big as possible
                   1354: 
                   1355: creates a function resize_textrea that takes two IDs first should be
                   1356: the id of the element to resize, second should be the id of a div that
                   1357: surrounds everything that comes after the textarea, this routine needs
                   1358: to be attached to the <body> for the onload and onresize events.
                   1359: 
1.648     raeburn  1360: =back
1.565     albertel 1361: 
                   1362: =cut
                   1363: 
                   1364: sub resize_textarea_js {
1.590     raeburn  1365:     my $geometry = &viewport_geometry_js();
1.565     albertel 1366:     return <<"RESIZE";
                   1367:     <script type="text/javascript">
1.590     raeburn  1368: $geometry
1.565     albertel 1369: 
1.588     albertel 1370: function getX(element) {
                   1371:     var x = 0;
                   1372:     while (element) {
                   1373: 	x += element.offsetLeft;
                   1374: 	element = element.offsetParent;
                   1375:     }
                   1376:     return x;
                   1377: }
                   1378: function getY(element) {
                   1379:     var y = 0;
                   1380:     while (element) {
                   1381: 	y += element.offsetTop;
                   1382: 	element = element.offsetParent;
                   1383:     }
                   1384:     return y;
                   1385: }
                   1386: 
                   1387: 
1.565     albertel 1388: function resize_textarea(textarea_id,bottom_id) {
                   1389:     init_geometry();
                   1390:     var textarea        = document.getElementById(textarea_id);
                   1391:     //alert(textarea);
                   1392: 
1.588     albertel 1393:     var textarea_top    = getY(textarea);
1.565     albertel 1394:     var textarea_height = textarea.offsetHeight;
                   1395:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1396:     var bottom_top      = getY(bottom);
1.565     albertel 1397:     var bottom_height   = bottom.offsetHeight;
                   1398:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1399:     var fudge           = 23;
1.565     albertel 1400:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1401:     if (new_height < 300) {
                   1402: 	new_height = 300;
                   1403:     }
                   1404:     textarea.style.height=new_height+'px';
                   1405: }
                   1406: </script>
                   1407: RESIZE
                   1408: 
                   1409: }
                   1410: 
                   1411: =pod
                   1412: 
1.256     matthew  1413: =head1 Excel and CSV file utility routines
                   1414: 
                   1415: =over 4
                   1416: 
                   1417: =cut
                   1418: 
                   1419: ###############################################################
                   1420: ###############################################################
                   1421: 
                   1422: =pod
                   1423: 
1.648     raeburn  1424: =item * &csv_translate($text) 
1.37      matthew  1425: 
1.185     www      1426: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1427: format.
                   1428: 
                   1429: =cut
                   1430: 
1.180     matthew  1431: ###############################################################
                   1432: ###############################################################
1.37      matthew  1433: sub csv_translate {
                   1434:     my $text = shift;
                   1435:     $text =~ s/\"/\"\"/g;
1.209     albertel 1436:     $text =~ s/\n/ /g;
1.37      matthew  1437:     return $text;
                   1438: }
1.180     matthew  1439: 
                   1440: ###############################################################
                   1441: ###############################################################
                   1442: 
                   1443: =pod
                   1444: 
1.648     raeburn  1445: =item * &define_excel_formats()
1.180     matthew  1446: 
                   1447: Define some commonly used Excel cell formats.
                   1448: 
                   1449: Currently supported formats:
                   1450: 
                   1451: =over 4
                   1452: 
                   1453: =item header
                   1454: 
                   1455: =item bold
                   1456: 
                   1457: =item h1
                   1458: 
                   1459: =item h2
                   1460: 
                   1461: =item h3
                   1462: 
1.256     matthew  1463: =item h4
                   1464: 
                   1465: =item i
                   1466: 
1.180     matthew  1467: =item date
                   1468: 
                   1469: =back
                   1470: 
                   1471: Inputs: $workbook
                   1472: 
                   1473: Returns: $format, a hash reference.
                   1474: 
                   1475: =cut
                   1476: 
                   1477: ###############################################################
                   1478: ###############################################################
                   1479: sub define_excel_formats {
                   1480:     my ($workbook) = @_;
                   1481:     my $format;
                   1482:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1483:                                                 bottom    => 1,
                   1484:                                                 align     => 'center');
                   1485:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1486:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1487:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1488:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1489:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1490:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1491:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1492:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1493:     return $format;
                   1494: }
                   1495: 
                   1496: ###############################################################
                   1497: ###############################################################
1.113     bowersj2 1498: 
                   1499: =pod
                   1500: 
1.648     raeburn  1501: =item * &create_workbook()
1.255     matthew  1502: 
                   1503: Create an Excel worksheet.  If it fails, output message on the
                   1504: request object and return undefs.
                   1505: 
                   1506: Inputs: Apache request object
                   1507: 
                   1508: Returns (undef) on failure, 
                   1509:     Excel worksheet object, scalar with filename, and formats 
                   1510:     from &Apache::loncommon::define_excel_formats on success
                   1511: 
                   1512: =cut
                   1513: 
                   1514: ###############################################################
                   1515: ###############################################################
                   1516: sub create_workbook {
                   1517:     my ($r) = @_;
                   1518:         #
                   1519:     # Create the excel spreadsheet
                   1520:     my $filename = '/prtspool/'.
1.258     albertel 1521:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1522:         time.'_'.rand(1000000000).'.xls';
                   1523:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1524:     if (! defined($workbook)) {
                   1525:         $r->log_error("Error creating excel spreadsheet $filename: $!");
                   1526:         $r->print('<p>'.&mt("Unable to create new Excel file.  ".
                   1527:                             "This error has been logged.  ".
                   1528:                             "Please alert your LON-CAPA administrator").
                   1529:                   '</p>');
                   1530:         return (undef);
                   1531:     }
                   1532:     #
                   1533:     $workbook->set_tempdir('/home/httpd/perl/tmp');
                   1534:     #
                   1535:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1536:     return ($workbook,$filename,$format);
                   1537: }
                   1538: 
                   1539: ###############################################################
                   1540: ###############################################################
                   1541: 
                   1542: =pod
                   1543: 
1.648     raeburn  1544: =item * &create_text_file()
1.113     bowersj2 1545: 
1.542     raeburn  1546: Create a file to write to and eventually make available to the user.
1.256     matthew  1547: If file creation fails, outputs an error message on the request object and 
                   1548: return undefs.
1.113     bowersj2 1549: 
1.256     matthew  1550: Inputs: Apache request object, and file suffix
1.113     bowersj2 1551: 
1.256     matthew  1552: Returns (undef) on failure, 
                   1553:     Filehandle and filename on success.
1.113     bowersj2 1554: 
                   1555: =cut
                   1556: 
1.256     matthew  1557: ###############################################################
                   1558: ###############################################################
                   1559: sub create_text_file {
                   1560:     my ($r,$suffix) = @_;
                   1561:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1562:     my $fh;
                   1563:     my $filename = '/prtspool/'.
1.258     albertel 1564:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1565:         time.'_'.rand(1000000000).'.'.$suffix;
                   1566:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1567:     if (! defined($fh)) {
                   1568:         $r->log_error("Couldn't open $filename for output $!");
1.683     bisitz   1569:         $r->print(&mt('Problems occurred in creating the output file. '
                   1570:                      .'This error has been logged. '
                   1571:                      .'Please alert your LON-CAPA administrator.'));
1.113     bowersj2 1572:     }
1.256     matthew  1573:     return ($fh,$filename)
1.113     bowersj2 1574: }
                   1575: 
                   1576: 
1.256     matthew  1577: =pod 
1.113     bowersj2 1578: 
                   1579: =back
                   1580: 
                   1581: =cut
1.37      matthew  1582: 
                   1583: ###############################################################
1.33      matthew  1584: ##        Home server <option> list generating code          ##
                   1585: ###############################################################
1.35      matthew  1586: 
1.169     www      1587: # ------------------------------------------
                   1588: 
                   1589: sub domain_select {
                   1590:     my ($name,$value,$multiple)=@_;
                   1591:     my %domains=map { 
1.514     albertel 1592: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1593:     } &Apache::lonnet::all_domains();
1.169     www      1594:     if ($multiple) {
                   1595: 	$domains{''}=&mt('Any domain');
1.550     albertel 1596: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1597: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1598:     } else {
1.550     albertel 1599: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169     www      1600: 	return &select_form($name,$value,%domains);
                   1601:     }
                   1602: }
                   1603: 
1.282     albertel 1604: #-------------------------------------------
                   1605: 
                   1606: =pod
                   1607: 
1.519     raeburn  1608: =head1 Routines for form select boxes
                   1609: 
                   1610: =over 4
                   1611: 
1.648     raeburn  1612: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1613: 
                   1614: Returns a string containing a <select> element int multiple mode
                   1615: 
                   1616: 
                   1617: Args:
                   1618:   $name - name of the <select> element
1.506     raeburn  1619:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1620:   $size - number of rows long the select element is
1.283     albertel 1621:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1622:           (shown text should already have been &mt())
1.506     raeburn  1623:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1624: 
1.282     albertel 1625: =cut
                   1626: 
                   1627: #-------------------------------------------
1.169     www      1628: sub multiple_select_form {
1.284     albertel 1629:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1630:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1631:     my $output='';
1.191     matthew  1632:     if (! defined($size)) {
                   1633:         $size = 4;
1.283     albertel 1634:         if (scalar(keys(%$hash))<4) {
                   1635:             $size = scalar(keys(%$hash));
1.191     matthew  1636:         }
                   1637:     }
1.169     www      1638:     $output.="\n<select name='$name' size='$size' multiple='1'>";
1.501     banghart 1639:     my @order;
1.506     raeburn  1640:     if (ref($order) eq 'ARRAY')  {
                   1641:         @order = @{$order};
                   1642:     } else {
                   1643:         @order = sort(keys(%$hash));
1.501     banghart 1644:     }
                   1645:     if (exists($$hash{'select_form_order'})) {
                   1646:         @order = @{$$hash{'select_form_order'}};
                   1647:     }
                   1648:         
1.284     albertel 1649:     foreach my $key (@order) {
1.356     albertel 1650:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1651:         $output.='selected="selected" ' if ($selected{$key});
                   1652:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1653:     }
                   1654:     $output.="</select>\n";
                   1655:     return $output;
                   1656: }
                   1657: 
1.88      www      1658: #-------------------------------------------
                   1659: 
                   1660: =pod
                   1661: 
1.648     raeburn  1662: =item * &select_form($defdom,$name,%hash)
1.88      www      1663: 
                   1664: Returns a string containing a <select name='$name' size='1'> form to 
                   1665: allow a user to select options from a hash option_name => displayed text.  
                   1666: See lonrights.pm for an example invocation and use.
                   1667: 
                   1668: =cut
                   1669: 
                   1670: #-------------------------------------------
                   1671: sub select_form {
                   1672:     my ($def,$name,%hash) = @_;
                   1673:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128     albertel 1674:     my @keys;
                   1675:     if (exists($hash{'select_form_order'})) {
                   1676: 	@keys=@{$hash{'select_form_order'}};
                   1677:     } else {
                   1678: 	@keys=sort(keys(%hash));
                   1679:     }
1.356     albertel 1680:     foreach my $key (@keys) {
                   1681:         $selectform.=
                   1682: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1683:             ($key eq $def ? 'selected="selected" ' : '').
                   1684:                 ">".&mt($hash{$key})."</option>\n";
1.88      www      1685:     }
                   1686:     $selectform.="</select>";
                   1687:     return $selectform;
                   1688: }
                   1689: 
1.475     www      1690: # For display filters
                   1691: 
                   1692: sub display_filter {
                   1693:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1694:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1695:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1696: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1697: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1698: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1699:            &mt('Filter [_1]',
1.477     www      1700: 	   &select_form($env{'form.displayfilter'},
                   1701: 			'displayfilter',
                   1702: 			('currentfolder' => 'Current folder/page',
                   1703: 			 'containing' => 'Containing phrase',
                   1704: 			 'none' => 'None'))).
1.714     bisitz   1705: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1706: }
                   1707: 
1.167     www      1708: sub gradeleveldescription {
                   1709:     my $gradelevel=shift;
                   1710:     my %gradelevels=(0 => 'Not specified',
                   1711: 		     1 => 'Grade 1',
                   1712: 		     2 => 'Grade 2',
                   1713: 		     3 => 'Grade 3',
                   1714: 		     4 => 'Grade 4',
                   1715: 		     5 => 'Grade 5',
                   1716: 		     6 => 'Grade 6',
                   1717: 		     7 => 'Grade 7',
                   1718: 		     8 => 'Grade 8',
                   1719: 		     9 => 'Grade 9',
                   1720: 		     10 => 'Grade 10',
                   1721: 		     11 => 'Grade 11',
                   1722: 		     12 => 'Grade 12',
                   1723: 		     13 => 'Grade 13',
                   1724: 		     14 => '100 Level',
                   1725: 		     15 => '200 Level',
                   1726: 		     16 => '300 Level',
                   1727: 		     17 => '400 Level',
                   1728: 		     18 => 'Graduate Level');
                   1729:     return &mt($gradelevels{$gradelevel});
                   1730: }
                   1731: 
1.163     www      1732: sub select_level_form {
                   1733:     my ($deflevel,$name)=@_;
                   1734:     unless ($deflevel) { $deflevel=0; }
1.167     www      1735:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   1736:     for (my $i=0; $i<=18; $i++) {
                   1737:         $selectform.="<option value=\"$i\" ".
1.253     albertel 1738:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      1739:                 ">".&gradeleveldescription($i)."</option>\n";
                   1740:     }
                   1741:     $selectform.="</select>";
                   1742:     return $selectform;
1.163     www      1743: }
1.167     www      1744: 
1.35      matthew  1745: #-------------------------------------------
                   1746: 
1.45      matthew  1747: =pod
                   1748: 
1.648     raeburn  1749: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc)
1.35      matthew  1750: 
                   1751: Returns a string containing a <select name='$name' size='1'> form to 
                   1752: allow a user to select the domain to preform an operation in.  
                   1753: See loncreateuser.pm for an example invocation and use.
                   1754: 
1.90      www      1755: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   1756: selected");
                   1757: 
1.563     raeburn  1758: If the $showdomdesc flag is set, the domain name is followed by the domain description. 
                   1759: 
1.35      matthew  1760: =cut
                   1761: 
                   1762: #-------------------------------------------
1.34      matthew  1763: sub select_dom_form {
1.563     raeburn  1764:     my ($defdom,$name,$includeempty,$showdomdesc) = @_;
1.550     albertel 1765:     my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90      www      1766:     if ($includeempty) { @domains=('',@domains); }
1.34      matthew  1767:     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
1.356     albertel 1768:     foreach my $dom (@domains) {
                   1769:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  1770:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   1771:         if ($showdomdesc) {
                   1772:             if ($dom ne '') {
                   1773:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   1774:                 if ($domdesc ne '') {
                   1775:                     $selectdomain .= ' ('.$domdesc.')';
                   1776:                 }
                   1777:             } 
                   1778:         }
                   1779:         $selectdomain .= "</option>\n";
1.34      matthew  1780:     }
                   1781:     $selectdomain.="</select>";
                   1782:     return $selectdomain;
                   1783: }
                   1784: 
1.35      matthew  1785: #-------------------------------------------
                   1786: 
1.45      matthew  1787: =pod
                   1788: 
1.648     raeburn  1789: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  1790: 
1.586     raeburn  1791: input: 4 arguments (two required, two optional) - 
                   1792:     $domain - domain of new user
                   1793:     $name - name of form element
                   1794:     $default - Value of 'default' causes a default item to be first 
                   1795:                             option, and selected by default. 
                   1796:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   1797:                             if 1 server found, or default, if 0 found.
1.594     raeburn  1798: output: returns 2 items: 
1.586     raeburn  1799: (a) form element which contains either:
                   1800:    (i) <select name="$name">
                   1801:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   1802:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   1803:        </select>
                   1804:        form item if there are multiple library servers in $domain, or
                   1805:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   1806:        if there is only one library server in $domain.
                   1807: 
                   1808: (b) number of library servers found.
                   1809: 
                   1810: See loncreateuser.pm for example of use.
1.35      matthew  1811: 
                   1812: =cut
                   1813: 
                   1814: #-------------------------------------------
1.586     raeburn  1815: sub home_server_form_item {
                   1816:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 1817:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  1818:     my $result;
                   1819:     my $numlib = keys(%servers);
                   1820:     if ($numlib > 1) {
                   1821:         $result .= '<select name="'.$name.'" />'."\n";
                   1822:         if ($default) {
                   1823:             $result .= '<option value="default" selected>'.&mt('default').
                   1824:                        '</option>'."\n";
                   1825:         }
                   1826:         foreach my $hostid (sort(keys(%servers))) {
                   1827:             $result.= '<option value="'.$hostid.'">'.
                   1828: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   1829:         }
                   1830:         $result .= '</select>'."\n";
                   1831:     } elsif ($numlib == 1) {
                   1832:         my $hostid;
                   1833:         foreach my $item (keys(%servers)) {
                   1834:             $hostid = $item;
                   1835:         }
                   1836:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   1837:                    $hostid.'" />';
                   1838:                    if (!$hide) {
                   1839:                        $result .= $hostid.' '.$servers{$hostid};
                   1840:                    }
                   1841:                    $result .= "\n";
                   1842:     } elsif ($default) {
                   1843:         $result .= '<input type="hidden" name="'.$name.
                   1844:                    '" value="default" />';
                   1845:                    if (!$hide) {
                   1846:                        $result .= &mt('default');
                   1847:                    }
                   1848:                    $result .= "\n";
1.33      matthew  1849:     }
1.586     raeburn  1850:     return ($result,$numlib);
1.33      matthew  1851: }
1.112     bowersj2 1852: 
                   1853: =pod
                   1854: 
1.534     albertel 1855: =back 
                   1856: 
1.112     bowersj2 1857: =cut
1.87      matthew  1858: 
                   1859: ###############################################################
1.112     bowersj2 1860: ##                  Decoding User Agent                      ##
1.87      matthew  1861: ###############################################################
                   1862: 
                   1863: =pod
                   1864: 
1.112     bowersj2 1865: =head1 Decoding the User Agent
                   1866: 
                   1867: =over 4
                   1868: 
                   1869: =item * &decode_user_agent()
1.87      matthew  1870: 
                   1871: Inputs: $r
                   1872: 
                   1873: Outputs:
                   1874: 
                   1875: =over 4
                   1876: 
1.112     bowersj2 1877: =item * $httpbrowser
1.87      matthew  1878: 
1.112     bowersj2 1879: =item * $clientbrowser
1.87      matthew  1880: 
1.112     bowersj2 1881: =item * $clientversion
1.87      matthew  1882: 
1.112     bowersj2 1883: =item * $clientmathml
1.87      matthew  1884: 
1.112     bowersj2 1885: =item * $clientunicode
1.87      matthew  1886: 
1.112     bowersj2 1887: =item * $clientos
1.87      matthew  1888: 
                   1889: =back
                   1890: 
1.157     matthew  1891: =back 
                   1892: 
1.87      matthew  1893: =cut
                   1894: 
                   1895: ###############################################################
                   1896: ###############################################################
                   1897: sub decode_user_agent {
1.247     albertel 1898:     my ($r)=@_;
1.87      matthew  1899:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   1900:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   1901:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 1902:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  1903:     my $clientbrowser='unknown';
                   1904:     my $clientversion='0';
                   1905:     my $clientmathml='';
                   1906:     my $clientunicode='0';
                   1907:     for (my $i=0;$i<=$#browsertype;$i++) {
                   1908:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   1909: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   1910: 	    $clientbrowser=$bname;
                   1911:             $httpbrowser=~/$vreg/i;
                   1912: 	    $clientversion=$1;
                   1913:             $clientmathml=($clientversion>=$minv);
                   1914:             $clientunicode=($clientversion>=$univ);
                   1915: 	}
                   1916:     }
                   1917:     my $clientos='unknown';
                   1918:     if (($httpbrowser=~/linux/i) ||
                   1919:         ($httpbrowser=~/unix/i) ||
                   1920:         ($httpbrowser=~/ux/i) ||
                   1921:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   1922:     if (($httpbrowser=~/vax/i) ||
                   1923:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   1924:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   1925:     if (($httpbrowser=~/mac/i) ||
                   1926:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   1927:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   1928:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   1929:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   1930:             $clientunicode,$clientos,);
                   1931: }
                   1932: 
1.32      matthew  1933: ###############################################################
                   1934: ##    Authentication changing form generation subroutines    ##
                   1935: ###############################################################
                   1936: ##
                   1937: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   1938: ## hash, and have reasonable default values.
                   1939: ##
                   1940: ##    formname = the name given in the <form> tag.
1.35      matthew  1941: #-------------------------------------------
                   1942: 
1.45      matthew  1943: =pod
                   1944: 
1.112     bowersj2 1945: =head1 Authentication Routines
                   1946: 
                   1947: =over 4
                   1948: 
1.648     raeburn  1949: =item * &authform_xxxxxx()
1.35      matthew  1950: 
                   1951: The authform_xxxxxx subroutines provide javascript and html forms which 
                   1952: handle some of the conveniences required for authentication forms.  
                   1953: This is not an optimal method, but it works.  
                   1954: 
                   1955: =over 4
                   1956: 
1.112     bowersj2 1957: =item * authform_header
1.35      matthew  1958: 
1.112     bowersj2 1959: =item * authform_authorwarning
1.35      matthew  1960: 
1.112     bowersj2 1961: =item * authform_nochange
1.35      matthew  1962: 
1.112     bowersj2 1963: =item * authform_kerberos
1.35      matthew  1964: 
1.112     bowersj2 1965: =item * authform_internal
1.35      matthew  1966: 
1.112     bowersj2 1967: =item * authform_filesystem
1.35      matthew  1968: 
                   1969: =back
                   1970: 
1.648     raeburn  1971: See loncreateuser.pm for invocation and use examples.
1.157     matthew  1972: 
1.35      matthew  1973: =cut
                   1974: 
                   1975: #-------------------------------------------
1.32      matthew  1976: sub authform_header{  
                   1977:     my %in = (
                   1978:         formname => 'cu',
1.80      albertel 1979:         kerb_def_dom => '',
1.32      matthew  1980:         @_,
                   1981:     );
                   1982:     $in{'formname'} = 'document.' . $in{'formname'};
                   1983:     my $result='';
1.80      albertel 1984: 
                   1985: #---------------------------------------------- Code for upper case translation
                   1986:     my $Javascript_toUpperCase;
                   1987:     unless ($in{kerb_def_dom}) {
                   1988:         $Javascript_toUpperCase =<<"END";
                   1989:         switch (choice) {
                   1990:            case 'krb': currentform.elements[choicearg].value =
                   1991:                currentform.elements[choicearg].value.toUpperCase();
                   1992:                break;
                   1993:            default:
                   1994:         }
                   1995: END
                   1996:     } else {
                   1997:         $Javascript_toUpperCase = "";
                   1998:     }
                   1999: 
1.165     raeburn  2000:     my $radioval = "'nochange'";
1.591     raeburn  2001:     if (defined($in{'curr_authtype'})) {
                   2002:         if ($in{'curr_authtype'} ne '') {
                   2003:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2004:         }
1.174     matthew  2005:     }
1.165     raeburn  2006:     my $argfield = 'null';
1.591     raeburn  2007:     if (defined($in{'mode'})) {
1.165     raeburn  2008:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2009:             if (defined($in{'curr_autharg'})) {
                   2010:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2011:                     $argfield = "'$in{'curr_autharg'}'";
                   2012:                 }
                   2013:             }
                   2014:         }
                   2015:     }
                   2016: 
1.32      matthew  2017:     $result.=<<"END";
                   2018: var current = new Object();
1.165     raeburn  2019: current.radiovalue = $radioval;
                   2020: current.argfield = $argfield;
1.32      matthew  2021: 
                   2022: function changed_radio(choice,currentform) {
                   2023:     var choicearg = choice + 'arg';
                   2024:     // If a radio button in changed, we need to change the argfield
                   2025:     if (current.radiovalue != choice) {
                   2026:         current.radiovalue = choice;
                   2027:         if (current.argfield != null) {
                   2028:             currentform.elements[current.argfield].value = '';
                   2029:         }
                   2030:         if (choice == 'nochange') {
                   2031:             current.argfield = null;
                   2032:         } else {
                   2033:             current.argfield = choicearg;
                   2034:             switch(choice) {
                   2035:                 case 'krb': 
                   2036:                     currentform.elements[current.argfield].value = 
                   2037:                         "$in{'kerb_def_dom'}";
                   2038:                 break;
                   2039:               default:
                   2040:                 break;
                   2041:             }
                   2042:         }
                   2043:     }
                   2044:     return;
                   2045: }
1.22      www      2046: 
1.32      matthew  2047: function changed_text(choice,currentform) {
                   2048:     var choicearg = choice + 'arg';
                   2049:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2050:         $Javascript_toUpperCase
1.32      matthew  2051:         // clear old field
                   2052:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2053:             currentform.elements[current.argfield].value = '';
                   2054:         }
                   2055:         current.argfield = choicearg;
                   2056:     }
                   2057:     set_auth_radio_buttons(choice,currentform);
                   2058:     return;
1.20      www      2059: }
1.32      matthew  2060: 
                   2061: function set_auth_radio_buttons(newvalue,currentform) {
                   2062:     var i=0;
                   2063:     while (i < currentform.login.length) {
                   2064:         if (currentform.login[i].value == newvalue) { break; }
                   2065:         i++;
                   2066:     }
                   2067:     if (i == currentform.login.length) {
                   2068:         return;
                   2069:     }
                   2070:     current.radiovalue = newvalue;
                   2071:     currentform.login[i].checked = true;
                   2072:     return;
                   2073: }
                   2074: END
                   2075:     return $result;
                   2076: }
                   2077: 
                   2078: sub authform_authorwarning{
                   2079:     my $result='';
1.144     matthew  2080:     $result='<i>'.
                   2081:         &mt('As a general rule, only authors or co-authors should be '.
                   2082:             'filesystem authenticated '.
                   2083:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2084:     return $result;
                   2085: }
                   2086: 
                   2087: sub authform_nochange{  
                   2088:     my %in = (
                   2089:               formname => 'document.cu',
                   2090:               kerb_def_dom => 'MSU.EDU',
                   2091:               @_,
                   2092:           );
1.586     raeburn  2093:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2094:     my $result;
                   2095:     if (keys(%can_assign) == 0) {
                   2096:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2097:     } else {
                   2098:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2099:                   '<input type="radio" name="login" value="nochange" '.
                   2100:                   'checked="checked" onclick="'.
1.281     albertel 2101:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2102: 	    '</label>';
1.586     raeburn  2103:     }
1.32      matthew  2104:     return $result;
                   2105: }
                   2106: 
1.591     raeburn  2107: sub authform_kerberos {
1.32      matthew  2108:     my %in = (
                   2109:               formname => 'document.cu',
                   2110:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2111:               kerb_def_auth => 'krb4',
1.32      matthew  2112:               @_,
                   2113:               );
1.586     raeburn  2114:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2115:         $autharg,$jscall);
                   2116:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2117:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.586     raeburn  2118:        $check5 = ' checked="on"';
1.80      albertel 2119:     } else {
1.586     raeburn  2120:        $check4 = ' checked="on"';
1.80      albertel 2121:     }
1.165     raeburn  2122:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2123:     if (defined($in{'curr_authtype'})) {
                   2124:         if ($in{'curr_authtype'} eq 'krb') {
1.586     raeburn  2125:             $krbcheck = ' checked="on"';
1.623     raeburn  2126:             if (defined($in{'mode'})) {
                   2127:                 if ($in{'mode'} eq 'modifyuser') {
                   2128:                     $krbcheck = '';
                   2129:                 }
                   2130:             }
1.591     raeburn  2131:             if (defined($in{'curr_kerb_ver'})) {
                   2132:                 if ($in{'curr_krb_ver'} eq '5') {
                   2133:                     $check5 = ' checked="on"';
                   2134:                     $check4 = '';
                   2135:                 } else {
                   2136:                     $check4 = ' checked="on"';
                   2137:                     $check5 = '';
                   2138:                 }
1.586     raeburn  2139:             }
1.591     raeburn  2140:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2141:                 $krbarg = $in{'curr_autharg'};
                   2142:             }
1.586     raeburn  2143:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2144:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2145:                     $result = 
                   2146:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2147:         $in{'curr_autharg'},$krbver);
                   2148:                 } else {
                   2149:                     $result =
                   2150:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2151:                 }
                   2152:                 return $result; 
                   2153:             }
                   2154:         }
                   2155:     } else {
                   2156:         if ($authnum == 1) {
                   2157:             $authtype = '<input type="hidden" name="login" value="krb">';
1.165     raeburn  2158:         }
                   2159:     }
1.586     raeburn  2160:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2161:         return;
1.587     raeburn  2162:     } elsif ($authtype eq '') {
1.591     raeburn  2163:         if (defined($in{'mode'})) {
1.587     raeburn  2164:             if ($in{'mode'} eq 'modifycourse') {
                   2165:                 if ($authnum == 1) {
                   2166:                     $authtype = '<input type="hidden" name="login" value="krb">';
                   2167:                 }
                   2168:             }
                   2169:         }
1.586     raeburn  2170:     }
                   2171:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2172:     if ($authtype eq '') {
                   2173:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2174:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2175:                     $krbcheck.' />';
                   2176:     }
                   2177:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2178:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2179:          $in{'curr_authtype'} eq 'krb5') ||
                   2180:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2181:          $in{'curr_authtype'} eq 'krb4')) {
                   2182:         $result .= &mt
1.144     matthew  2183:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2184:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2185:          '<label>'.$authtype,
1.281     albertel 2186:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2187:              'value="'.$krbarg.'" '.
1.144     matthew  2188:              'onchange="'.$jscall.'" />',
1.281     albertel 2189:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2190:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2191: 	 '</label>');
1.586     raeburn  2192:     } elsif ($can_assign{'krb4'}) {
                   2193:         $result .= &mt
                   2194:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2195:          '[_3] Version 4 [_4]',
                   2196:          '<label>'.$authtype,
                   2197:          '</label><input type="text" size="10" name="krbarg" '.
                   2198:              'value="'.$krbarg.'" '.
                   2199:              'onchange="'.$jscall.'" />',
                   2200:          '<label><input type="hidden" name="krbver" value="4" />',
                   2201:          '</label>');
                   2202:     } elsif ($can_assign{'krb5'}) {
                   2203:         $result .= &mt
                   2204:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2205:          '[_3] Version 5 [_4]',
                   2206:          '<label>'.$authtype,
                   2207:          '</label><input type="text" size="10" name="krbarg" '.
                   2208:              'value="'.$krbarg.'" '.
                   2209:              'onchange="'.$jscall.'" />',
                   2210:          '<label><input type="hidden" name="krbver" value="5" />',
                   2211:          '</label>');
                   2212:     }
1.32      matthew  2213:     return $result;
                   2214: }
                   2215: 
                   2216: sub authform_internal{  
1.586     raeburn  2217:     my %in = (
1.32      matthew  2218:                 formname => 'document.cu',
                   2219:                 kerb_def_dom => 'MSU.EDU',
                   2220:                 @_,
                   2221:                 );
1.586     raeburn  2222:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2223:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2224:     if (defined($in{'curr_authtype'})) {
                   2225:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2226:             if ($can_assign{'int'}) {
                   2227:                 $intcheck = 'checked="on" ';
1.623     raeburn  2228:                 if (defined($in{'mode'})) {
                   2229:                     if ($in{'mode'} eq 'modifyuser') {
                   2230:                         $intcheck = '';
                   2231:                     }
                   2232:                 }
1.591     raeburn  2233:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2234:                     $intarg = $in{'curr_autharg'};
                   2235:                 }
                   2236:             } else {
                   2237:                 $result = &mt('Currently internally authenticated.');
                   2238:                 return $result;
1.165     raeburn  2239:             }
                   2240:         }
1.586     raeburn  2241:     } else {
                   2242:         if ($authnum == 1) {
                   2243:             $authtype = '<input type="hidden" name="login" value="int">';
                   2244:         }
                   2245:     }
                   2246:     if (!$can_assign{'int'}) {
                   2247:         return;
1.587     raeburn  2248:     } elsif ($authtype eq '') {
1.591     raeburn  2249:         if (defined($in{'mode'})) {
1.587     raeburn  2250:             if ($in{'mode'} eq 'modifycourse') {
                   2251:                 if ($authnum == 1) {
                   2252:                     $authtype = '<input type="hidden" name="login" value="int">';
                   2253:                 }
                   2254:             }
                   2255:         }
1.165     raeburn  2256:     }
1.586     raeburn  2257:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2258:     if ($authtype eq '') {
                   2259:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2260:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2261:     }
1.605     bisitz   2262:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2263:                $intarg.'" onchange="'.$jscall.'" />';
                   2264:     $result = &mt
1.144     matthew  2265:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2266:          '<label>'.$authtype,'</label>'.$autharg);
1.620     www      2267:     $result.="<label><input type=\"checkbox\" name=\"visible\" onClick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  2268:     return $result;
                   2269: }
                   2270: 
                   2271: sub authform_local{  
                   2272:     my %in = (
                   2273:               formname => 'document.cu',
                   2274:               kerb_def_dom => 'MSU.EDU',
                   2275:               @_,
                   2276:               );
1.586     raeburn  2277:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2278:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2279:     if (defined($in{'curr_authtype'})) {
                   2280:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2281:             if ($can_assign{'loc'}) {
                   2282:                 $loccheck = 'checked="on" ';
1.623     raeburn  2283:                 if (defined($in{'mode'})) {
                   2284:                     if ($in{'mode'} eq 'modifyuser') {
                   2285:                         $loccheck = '';
                   2286:                     }
                   2287:                 }
1.591     raeburn  2288:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2289:                     $locarg = $in{'curr_autharg'};
                   2290:                 }
                   2291:             } else {
                   2292:                 $result = &mt('Currently using local (institutional) authentication.');
                   2293:                 return $result;
1.165     raeburn  2294:             }
                   2295:         }
1.586     raeburn  2296:     } else {
                   2297:         if ($authnum == 1) {
                   2298:             $authtype = '<input type="hidden" name="login" value="loc">';
                   2299:         }
                   2300:     }
                   2301:     if (!$can_assign{'loc'}) {
                   2302:         return;
1.587     raeburn  2303:     } elsif ($authtype eq '') {
1.591     raeburn  2304:         if (defined($in{'mode'})) {
1.587     raeburn  2305:             if ($in{'mode'} eq 'modifycourse') {
                   2306:                 if ($authnum == 1) {
                   2307:                     $authtype = '<input type="hidden" name="login" value="loc">';
                   2308:                 }
                   2309:             }
                   2310:         }
1.165     raeburn  2311:     }
1.586     raeburn  2312:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2313:     if ($authtype eq '') {
                   2314:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2315:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2316:                     $jscall.'" />';
                   2317:     }
                   2318:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2319:                $locarg.'" onchange="'.$jscall.'" />';
                   2320:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2321:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2322:     return $result;
                   2323: }
                   2324: 
                   2325: sub authform_filesystem{  
                   2326:     my %in = (
                   2327:               formname => 'document.cu',
                   2328:               kerb_def_dom => 'MSU.EDU',
                   2329:               @_,
                   2330:               );
1.586     raeburn  2331:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2332:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2333:     if (defined($in{'curr_authtype'})) {
                   2334:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2335:             if ($can_assign{'fsys'}) {
                   2336:                 $fsyscheck = 'checked="on" ';
1.623     raeburn  2337:                 if (defined($in{'mode'})) {
                   2338:                     if ($in{'mode'} eq 'modifyuser') {
                   2339:                         $fsyscheck = '';
                   2340:                     }
                   2341:                 }
1.586     raeburn  2342:             } else {
                   2343:                 $result = &mt('Currently Filesystem Authenticated.');
                   2344:                 return $result;
                   2345:             }           
                   2346:         }
                   2347:     } else {
                   2348:         if ($authnum == 1) {
                   2349:             $authtype = '<input type="hidden" name="login" value="fsys">';
                   2350:         }
                   2351:     }
                   2352:     if (!$can_assign{'fsys'}) {
                   2353:         return;
1.587     raeburn  2354:     } elsif ($authtype eq '') {
1.591     raeburn  2355:         if (defined($in{'mode'})) {
1.587     raeburn  2356:             if ($in{'mode'} eq 'modifycourse') {
                   2357:                 if ($authnum == 1) {
                   2358:                     $authtype = '<input type="hidden" name="login" value="fsys">';
                   2359:                 }
                   2360:             }
                   2361:         }
1.586     raeburn  2362:     }
                   2363:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2364:     if ($authtype eq '') {
                   2365:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2366:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2367:                     $jscall.'" />';
                   2368:     }
                   2369:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2370:                ' onchange="'.$jscall.'" />';
                   2371:     $result = &mt
1.144     matthew  2372:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2373:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2374:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2375:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2376:                   'onchange="'.$jscall.'" />');
1.32      matthew  2377:     return $result;
                   2378: }
                   2379: 
1.586     raeburn  2380: sub get_assignable_auth {
                   2381:     my ($dom) = @_;
                   2382:     if ($dom eq '') {
                   2383:         $dom = $env{'request.role.domain'};
                   2384:     }
                   2385:     my %can_assign = (
                   2386:                           krb4 => 1,
                   2387:                           krb5 => 1,
                   2388:                           int  => 1,
                   2389:                           loc  => 1,
                   2390:                      );
                   2391:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2392:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2393:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2394:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2395:             my $context;
                   2396:             if ($env{'request.role'} =~ /^au/) {
                   2397:                 $context = 'author';
                   2398:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2399:                 $context = 'domain';
                   2400:             } elsif ($env{'request.course.id'}) {
                   2401:                 $context = 'course';
                   2402:             }
                   2403:             if ($context) {
                   2404:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2405:                    %can_assign = %{$authhash->{$context}}; 
                   2406:                 }
                   2407:             }
                   2408:         }
                   2409:     }
                   2410:     my $authnum = 0;
                   2411:     foreach my $key (keys(%can_assign)) {
                   2412:         if ($can_assign{$key}) {
                   2413:             $authnum ++;
                   2414:         }
                   2415:     }
                   2416:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2417:         $authnum --;
                   2418:     }
                   2419:     return ($authnum,%can_assign);
                   2420: }
                   2421: 
1.80      albertel 2422: ###############################################################
                   2423: ##    Get Kerberos Defaults for Domain                 ##
                   2424: ###############################################################
                   2425: ##
                   2426: ## Returns default kerberos version and an associated argument
                   2427: ## as listed in file domain.tab. If not listed, provides
                   2428: ## appropriate default domain and kerberos version.
                   2429: ##
                   2430: #-------------------------------------------
                   2431: 
                   2432: =pod
                   2433: 
1.648     raeburn  2434: =item * &get_kerberos_defaults()
1.80      albertel 2435: 
                   2436: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2437: version and domain. If not found, it defaults to version 4 and the 
                   2438: domain of the server.
1.80      albertel 2439: 
1.648     raeburn  2440: =over 4
                   2441: 
1.80      albertel 2442: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2443: 
1.648     raeburn  2444: =back
                   2445: 
                   2446: =back
                   2447: 
1.80      albertel 2448: =cut
                   2449: 
                   2450: #-------------------------------------------
                   2451: sub get_kerberos_defaults {
                   2452:     my $domain=shift;
1.641     raeburn  2453:     my ($krbdef,$krbdefdom);
                   2454:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2455:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2456:         $krbdef = $domdefaults{'auth_def'};
                   2457:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2458:     } else {
1.80      albertel 2459:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2460:         my $krbdefdom=$1;
                   2461:         $krbdefdom=~tr/a-z/A-Z/;
                   2462:         $krbdef = "krb4";
                   2463:     }
                   2464:     return ($krbdef,$krbdefdom);
                   2465: }
1.112     bowersj2 2466: 
1.32      matthew  2467: 
1.46      matthew  2468: ###############################################################
                   2469: ##                Thesaurus Functions                        ##
                   2470: ###############################################################
1.20      www      2471: 
1.46      matthew  2472: =pod
1.20      www      2473: 
1.112     bowersj2 2474: =head1 Thesaurus Functions
                   2475: 
                   2476: =over 4
                   2477: 
1.648     raeburn  2478: =item * &initialize_keywords()
1.46      matthew  2479: 
                   2480: Initializes the package variable %Keywords if it is empty.  Uses the
                   2481: package variable $thesaurus_db_file.
                   2482: 
                   2483: =cut
                   2484: 
                   2485: ###################################################
                   2486: 
                   2487: sub initialize_keywords {
                   2488:     return 1 if (scalar keys(%Keywords));
                   2489:     # If we are here, %Keywords is empty, so fill it up
                   2490:     #   Make sure the file we need exists...
                   2491:     if (! -e $thesaurus_db_file) {
                   2492:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2493:                                  " failed because it does not exist");
                   2494:         return 0;
                   2495:     }
                   2496:     #   Set up the hash as a database
                   2497:     my %thesaurus_db;
                   2498:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2499:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2500:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2501:                                  $thesaurus_db_file);
                   2502:         return 0;
                   2503:     } 
                   2504:     #  Get the average number of appearances of a word.
                   2505:     my $avecount = $thesaurus_db{'average.count'};
                   2506:     #  Put keywords (those that appear > average) into %Keywords
                   2507:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2508:         my ($count,undef) = split /:/,$data;
                   2509:         $Keywords{$word}++ if ($count > $avecount);
                   2510:     }
                   2511:     untie %thesaurus_db;
                   2512:     # Remove special values from %Keywords.
1.356     albertel 2513:     foreach my $value ('total.count','average.count') {
                   2514:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2515:   }
1.46      matthew  2516:     return 1;
                   2517: }
                   2518: 
                   2519: ###################################################
                   2520: 
                   2521: =pod
                   2522: 
1.648     raeburn  2523: =item * &keyword($word)
1.46      matthew  2524: 
                   2525: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2526: than the average number of times in the thesaurus database.  Calls 
                   2527: &initialize_keywords
                   2528: 
                   2529: =cut
                   2530: 
                   2531: ###################################################
1.20      www      2532: 
                   2533: sub keyword {
1.46      matthew  2534:     return if (!&initialize_keywords());
                   2535:     my $word=lc(shift());
                   2536:     $word=~s/\W//g;
                   2537:     return exists($Keywords{$word});
1.20      www      2538: }
1.46      matthew  2539: 
                   2540: ###############################################################
                   2541: 
                   2542: =pod 
1.20      www      2543: 
1.648     raeburn  2544: =item * &get_related_words()
1.46      matthew  2545: 
1.160     matthew  2546: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2547: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2548: will be returned.  The order of the words returned is determined by the
                   2549: database which holds them.
                   2550: 
                   2551: Uses global $thesaurus_db_file.
                   2552: 
                   2553: =cut
                   2554: 
                   2555: ###############################################################
                   2556: sub get_related_words {
                   2557:     my $keyword = shift;
                   2558:     my %thesaurus_db;
                   2559:     if (! -e $thesaurus_db_file) {
                   2560:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2561:                                  "failed because the file does not exist");
                   2562:         return ();
                   2563:     }
                   2564:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2565:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2566:         return ();
                   2567:     } 
                   2568:     my @Words=();
1.429     www      2569:     my $count=0;
1.46      matthew  2570:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2571: 	# The first element is the number of times
                   2572: 	# the word appears.  We do not need it now.
1.429     www      2573: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2574: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2575: 	my $threshold=$mostfrequentcount/10;
                   2576:         foreach my $possibleword (@RelatedWords) {
                   2577:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2578:             if ($wordcount>$threshold) {
                   2579: 		push(@Words,$word);
                   2580:                 $count++;
                   2581:                 if ($count>10) { last; }
                   2582: 	    }
1.20      www      2583:         }
                   2584:     }
1.46      matthew  2585:     untie %thesaurus_db;
                   2586:     return @Words;
1.14      harris41 2587: }
1.46      matthew  2588: 
1.112     bowersj2 2589: =pod
                   2590: 
                   2591: =back
                   2592: 
                   2593: =cut
1.61      www      2594: 
                   2595: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2596: =pod
                   2597: 
1.112     bowersj2 2598: =head1 User Name Functions
                   2599: 
                   2600: =over 4
                   2601: 
1.648     raeburn  2602: =item * &plainname($uname,$udom,$first)
1.81      albertel 2603: 
1.112     bowersj2 2604: Takes a users logon name and returns it as a string in
1.226     albertel 2605: "first middle last generation" form 
                   2606: if $first is set to 'lastname' then it returns it as
                   2607: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2608: 
                   2609: =cut
1.61      www      2610: 
1.295     www      2611: 
1.81      albertel 2612: ###############################################################
1.61      www      2613: sub plainname {
1.226     albertel 2614:     my ($uname,$udom,$first)=@_;
1.537     albertel 2615:     return if (!defined($uname) || !defined($udom));
1.295     www      2616:     my %names=&getnames($uname,$udom);
1.226     albertel 2617:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2618: 					  $names{'middlename'},
                   2619: 					  $names{'lastname'},
                   2620: 					  $names{'generation'},$first);
                   2621:     $name=~s/^\s+//;
1.62      www      2622:     $name=~s/\s+$//;
                   2623:     $name=~s/\s+/ /g;
1.353     albertel 2624:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2625:     return $name;
1.61      www      2626: }
1.66      www      2627: 
                   2628: # -------------------------------------------------------------------- Nickname
1.81      albertel 2629: =pod
                   2630: 
1.648     raeburn  2631: =item * &nickname($uname,$udom)
1.81      albertel 2632: 
                   2633: Gets a users name and returns it as a string as
                   2634: 
                   2635: "&quot;nickname&quot;"
1.66      www      2636: 
1.81      albertel 2637: if the user has a nickname or
                   2638: 
                   2639: "first middle last generation"
                   2640: 
                   2641: if the user does not
                   2642: 
                   2643: =cut
1.66      www      2644: 
                   2645: sub nickname {
                   2646:     my ($uname,$udom)=@_;
1.537     albertel 2647:     return if (!defined($uname) || !defined($udom));
1.295     www      2648:     my %names=&getnames($uname,$udom);
1.68      albertel 2649:     my $name=$names{'nickname'};
1.66      www      2650:     if ($name) {
                   2651:        $name='&quot;'.$name.'&quot;'; 
                   2652:     } else {
                   2653:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2654: 	     $names{'lastname'}.' '.$names{'generation'};
                   2655:        $name=~s/\s+$//;
                   2656:        $name=~s/\s+/ /g;
                   2657:     }
                   2658:     return $name;
                   2659: }
                   2660: 
1.295     www      2661: sub getnames {
                   2662:     my ($uname,$udom)=@_;
1.537     albertel 2663:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2664:     if ($udom eq 'public' && $uname eq 'public') {
                   2665: 	return ('lastname' => &mt('Public'));
                   2666:     }
1.295     www      2667:     my $id=$uname.':'.$udom;
                   2668:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2669:     if ($cached) {
                   2670: 	return %{$names};
                   2671:     } else {
                   2672: 	my %loadnames=&Apache::lonnet::get('environment',
                   2673:                     ['firstname','middlename','lastname','generation','nickname'],
                   2674: 					 $udom,$uname);
                   2675: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2676: 	return %loadnames;
                   2677:     }
                   2678: }
1.61      www      2679: 
1.542     raeburn  2680: # -------------------------------------------------------------------- getemails
1.648     raeburn  2681: 
1.542     raeburn  2682: =pod
                   2683: 
1.648     raeburn  2684: =item * &getemails($uname,$udom)
1.542     raeburn  2685: 
                   2686: Gets a user's email information and returns it as a hash with keys:
                   2687: notification, critnotification, permanentemail
                   2688: 
                   2689: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2690: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2691:  
1.648     raeburn  2692: 
1.542     raeburn  2693: =cut
                   2694: 
1.648     raeburn  2695: 
1.466     albertel 2696: sub getemails {
                   2697:     my ($uname,$udom)=@_;
                   2698:     if ($udom eq 'public' && $uname eq 'public') {
                   2699: 	return;
                   2700:     }
1.467     www      2701:     if (!$udom) { $udom=$env{'user.domain'}; }
                   2702:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 2703:     my $id=$uname.':'.$udom;
                   2704:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   2705:     if ($cached) {
                   2706: 	return %{$names};
                   2707:     } else {
                   2708: 	my %loadnames=&Apache::lonnet::get('environment',
                   2709:                     			   ['notification','critnotification',
                   2710: 					    'permanentemail'],
                   2711: 					   $udom,$uname);
                   2712: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   2713: 	return %loadnames;
                   2714:     }
                   2715: }
                   2716: 
1.551     albertel 2717: sub flush_email_cache {
                   2718:     my ($uname,$udom)=@_;
                   2719:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2720:     if (!$uname) { $uname=$env{'user.name'};   }
                   2721:     return if ($udom eq 'public' && $uname eq 'public');
                   2722:     my $id=$uname.':'.$udom;
                   2723:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   2724: }
                   2725: 
1.728     raeburn  2726: # -------------------------------------------------------------------- getlangs
                   2727: 
                   2728: =pod
                   2729: 
                   2730: =item * &getlangs($uname,$udom)
                   2731: 
                   2732: Gets a user's language preference and returns it as a hash with key:
                   2733: language.
                   2734: 
                   2735: =cut
                   2736: 
                   2737: 
                   2738: sub getlangs {
                   2739:     my ($uname,$udom) = @_;
                   2740:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2741:     if (!$uname) { $uname=$env{'user.name'};   }
                   2742:     my $id=$uname.':'.$udom;
                   2743:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   2744:     if ($cached) {
                   2745:         return %{$langs};
                   2746:     } else {
                   2747:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   2748:                                            $udom,$uname);
                   2749:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   2750:         return %loadlangs;
                   2751:     }
                   2752: }
                   2753: 
                   2754: sub flush_langs_cache {
                   2755:     my ($uname,$udom)=@_;
                   2756:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2757:     if (!$uname) { $uname=$env{'user.name'};   }
                   2758:     return if ($udom eq 'public' && $uname eq 'public');
                   2759:     my $id=$uname.':'.$udom;
                   2760:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   2761: }
                   2762: 
1.61      www      2763: # ------------------------------------------------------------------ Screenname
1.81      albertel 2764: 
                   2765: =pod
                   2766: 
1.648     raeburn  2767: =item * &screenname($uname,$udom)
1.81      albertel 2768: 
                   2769: Gets a users screenname and returns it as a string
                   2770: 
                   2771: =cut
1.61      www      2772: 
                   2773: sub screenname {
                   2774:     my ($uname,$udom)=@_;
1.258     albertel 2775:     if ($uname eq $env{'user.name'} &&
                   2776: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 2777:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 2778:     return $names{'screenname'};
1.62      www      2779: }
                   2780: 
1.212     albertel 2781: 
1.62      www      2782: # ------------------------------------------------------------- Message Wrapper
                   2783: 
                   2784: sub messagewrapper {
1.369     www      2785:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      2786:     return 
1.441     albertel 2787:         '<a href="/adm/email?compose=individual&amp;'.
                   2788:         'recname='.$username.'&amp;recdom='.$domain.
                   2789: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  2790:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      2791: }
                   2792: # --------------------------------------------------------------- Notes Wrapper
                   2793: 
                   2794: sub noteswrapper {
                   2795:     my ($link,$un,$do)=@_;
                   2796:     return 
                   2797: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62      www      2798: }
                   2799: # ------------------------------------------------------------- Aboutme Wrapper
                   2800: 
                   2801: sub aboutmewrapper {
1.166     www      2802:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  2803:     if (!defined($username)  && !defined($domain)) {
                   2804:         return;
                   2805:     }
1.205     www      2806:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.454     banghart 2807: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';
1.62      www      2808: }
                   2809: 
                   2810: # ------------------------------------------------------------ Syllabus Wrapper
                   2811: 
                   2812: 
                   2813: sub syllabuswrapper {
1.707     bisitz   2814:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  2815:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      2816: }
1.14      harris41 2817: 
1.208     matthew  2818: sub track_student_link {
1.268     albertel 2819:     my ($linktext,$sname,$sdom,$target,$start) = @_;
                   2820:     my $link ="/adm/trackstudent?";
1.208     matthew  2821:     my $title = 'View recent activity';
                   2822:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   2823:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 2824:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  2825:         $title .= ' of this student';
1.268     albertel 2826:     } 
1.208     matthew  2827:     if (defined($target) && $target !~ /^\s*$/) {
                   2828:         $target = qq{target="$target"};
                   2829:     } else {
                   2830:         $target = '';
                   2831:     }
1.268     albertel 2832:     if ($start) { $link.='&amp;start='.$start; }
1.554     albertel 2833:     $title = &mt($title);
                   2834:     $linktext = &mt($linktext);
1.448     albertel 2835:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   2836: 	&help_open_topic('View_recent_activity');
1.208     matthew  2837: }
                   2838: 
1.508     www      2839: # ===================================================== Display a student photo
                   2840: 
                   2841: 
1.509     albertel 2842: sub student_image_tag {
1.508     www      2843:     my ($domain,$user)=@_;
                   2844:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   2845:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   2846: 	return '<img src="'.$imgsrc.'" align="right" />';
                   2847:     } else {
                   2848: 	return '';
                   2849:     }
                   2850: }
                   2851: 
1.112     bowersj2 2852: =pod
                   2853: 
                   2854: =back
                   2855: 
                   2856: =head1 Access .tab File Data
                   2857: 
                   2858: =over 4
                   2859: 
1.648     raeburn  2860: =item * &languageids() 
1.112     bowersj2 2861: 
                   2862: returns list of all language ids
                   2863: 
                   2864: =cut
                   2865: 
1.14      harris41 2866: sub languageids {
1.16      harris41 2867:     return sort(keys(%language));
1.14      harris41 2868: }
                   2869: 
1.112     bowersj2 2870: =pod
                   2871: 
1.648     raeburn  2872: =item * &languagedescription() 
1.112     bowersj2 2873: 
                   2874: returns description of a specified language id
                   2875: 
                   2876: =cut
                   2877: 
1.14      harris41 2878: sub languagedescription {
1.125     www      2879:     my $code=shift;
                   2880:     return  ($supported_language{$code}?'* ':'').
                   2881:             $language{$code}.
1.126     www      2882: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      2883: }
                   2884: 
                   2885: sub plainlanguagedescription {
                   2886:     my $code=shift;
                   2887:     return $language{$code};
                   2888: }
                   2889: 
                   2890: sub supportedlanguagecode {
                   2891:     my $code=shift;
                   2892:     return $supported_language{$code};
1.97      www      2893: }
                   2894: 
1.112     bowersj2 2895: =pod
                   2896: 
1.648     raeburn  2897: =item * &copyrightids() 
1.112     bowersj2 2898: 
                   2899: returns list of all copyrights
                   2900: 
                   2901: =cut
                   2902: 
                   2903: sub copyrightids {
                   2904:     return sort(keys(%cprtag));
                   2905: }
                   2906: 
                   2907: =pod
                   2908: 
1.648     raeburn  2909: =item * &copyrightdescription() 
1.112     bowersj2 2910: 
                   2911: returns description of a specified copyright id
                   2912: 
                   2913: =cut
                   2914: 
                   2915: sub copyrightdescription {
1.166     www      2916:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 2917: }
1.197     matthew  2918: 
                   2919: =pod
                   2920: 
1.648     raeburn  2921: =item * &source_copyrightids() 
1.192     taceyjo1 2922: 
                   2923: returns list of all source copyrights
                   2924: 
                   2925: =cut
                   2926: 
                   2927: sub source_copyrightids {
                   2928:     return sort(keys(%scprtag));
                   2929: }
                   2930: 
                   2931: =pod
                   2932: 
1.648     raeburn  2933: =item * &source_copyrightdescription() 
1.192     taceyjo1 2934: 
                   2935: returns description of a specified source copyright id
                   2936: 
                   2937: =cut
                   2938: 
                   2939: sub source_copyrightdescription {
                   2940:     return &mt($scprtag{shift(@_)});
                   2941: }
1.112     bowersj2 2942: 
                   2943: =pod
                   2944: 
1.648     raeburn  2945: =item * &filecategories() 
1.112     bowersj2 2946: 
                   2947: returns list of all file categories
                   2948: 
                   2949: =cut
                   2950: 
                   2951: sub filecategories {
                   2952:     return sort(keys(%category_extensions));
                   2953: }
                   2954: 
                   2955: =pod
                   2956: 
1.648     raeburn  2957: =item * &filecategorytypes() 
1.112     bowersj2 2958: 
                   2959: returns list of file types belonging to a given file
                   2960: category
                   2961: 
                   2962: =cut
                   2963: 
                   2964: sub filecategorytypes {
1.356     albertel 2965:     my ($cat) = @_;
                   2966:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 2967: }
                   2968: 
                   2969: =pod
                   2970: 
1.648     raeburn  2971: =item * &fileembstyle() 
1.112     bowersj2 2972: 
                   2973: returns embedding style for a specified file type
                   2974: 
                   2975: =cut
                   2976: 
                   2977: sub fileembstyle {
                   2978:     return $fe{lc(shift(@_))};
1.169     www      2979: }
                   2980: 
1.351     www      2981: sub filemimetype {
                   2982:     return $fm{lc(shift(@_))};
                   2983: }
                   2984: 
1.169     www      2985: 
                   2986: sub filecategoryselect {
                   2987:     my ($name,$value)=@_;
1.189     matthew  2988:     return &select_form($value,$name,
1.169     www      2989: 			'' => &mt('Any category'),
                   2990: 			map { $_,$_ } sort(keys(%category_extensions)));
1.112     bowersj2 2991: }
                   2992: 
                   2993: =pod
                   2994: 
1.648     raeburn  2995: =item * &filedescription() 
1.112     bowersj2 2996: 
                   2997: returns description for a specified file type
                   2998: 
                   2999: =cut
                   3000: 
                   3001: sub filedescription {
1.188     matthew  3002:     my $file_description = $fd{lc(shift())};
                   3003:     $file_description =~ s:([\[\]]):~$1:g;
                   3004:     return &mt($file_description);
1.112     bowersj2 3005: }
                   3006: 
                   3007: =pod
                   3008: 
1.648     raeburn  3009: =item * &filedescriptionex() 
1.112     bowersj2 3010: 
                   3011: returns description for a specified file type with
                   3012: extra formatting
                   3013: 
                   3014: =cut
                   3015: 
                   3016: sub filedescriptionex {
                   3017:     my $ex=shift;
1.188     matthew  3018:     my $file_description = $fd{lc($ex)};
                   3019:     $file_description =~ s:([\[\]]):~$1:g;
                   3020:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3021: }
                   3022: 
                   3023: # End of .tab access
                   3024: =pod
                   3025: 
                   3026: =back
                   3027: 
                   3028: =cut
                   3029: 
                   3030: # ------------------------------------------------------------------ File Types
                   3031: sub fileextensions {
                   3032:     return sort(keys(%fe));
                   3033: }
                   3034: 
1.97      www      3035: # ----------------------------------------------------------- Display Languages
                   3036: # returns a hash with all desired display languages
                   3037: #
                   3038: 
                   3039: sub display_languages {
                   3040:     my %languages=();
1.695     raeburn  3041:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3042: 	$languages{$lang}=1;
1.97      www      3043:     }
                   3044:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3045:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3046: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3047: 	    $languages{$lang}=1;
1.97      www      3048:         }
                   3049:     }
                   3050:     return %languages;
1.14      harris41 3051: }
                   3052: 
1.582     albertel 3053: sub languages {
                   3054:     my ($possible_langs) = @_;
1.695     raeburn  3055:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3056:     if (!ref($possible_langs)) {
                   3057: 	if( wantarray ) {
                   3058: 	    return @preferred_langs;
                   3059: 	} else {
                   3060: 	    return $preferred_langs[0];
                   3061: 	}
                   3062:     }
                   3063:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3064:     my @preferred_possibilities;
                   3065:     foreach my $preferred_lang (@preferred_langs) {
                   3066: 	if (exists($possibilities{$preferred_lang})) {
                   3067: 	    push(@preferred_possibilities, $preferred_lang);
                   3068: 	}
                   3069:     }
                   3070:     if( wantarray ) {
                   3071: 	return @preferred_possibilities;
                   3072:     }
                   3073:     return $preferred_possibilities[0];
                   3074: }
                   3075: 
1.112     bowersj2 3076: ###############################################################
                   3077: ##               Student Answer Attempts                     ##
                   3078: ###############################################################
                   3079: 
                   3080: =pod
                   3081: 
                   3082: =head1 Alternate Problem Views
                   3083: 
                   3084: =over 4
                   3085: 
1.648     raeburn  3086: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3087:     $getattempt, $regexp, $gradesub)
                   3088: 
                   3089: Return string with previous attempt on problem. Arguments:
                   3090: 
                   3091: =over 4
                   3092: 
                   3093: =item * $symb: Problem, including path
                   3094: 
                   3095: =item * $username: username of the desired student
                   3096: 
                   3097: =item * $domain: domain of the desired student
1.14      harris41 3098: 
1.112     bowersj2 3099: =item * $course: Course ID
1.14      harris41 3100: 
1.112     bowersj2 3101: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3102:     something
1.14      harris41 3103: 
1.112     bowersj2 3104: =item * $regexp: if string matches this regexp, the string will be
                   3105:     sent to $gradesub
1.14      harris41 3106: 
1.112     bowersj2 3107: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3108: 
1.112     bowersj2 3109: =back
1.14      harris41 3110: 
1.112     bowersj2 3111: The output string is a table containing all desired attempts, if any.
1.16      harris41 3112: 
1.112     bowersj2 3113: =cut
1.1       albertel 3114: 
                   3115: sub get_previous_attempt {
1.43      ng       3116:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3117:   my $prevattempts='';
1.43      ng       3118:   no strict 'refs';
1.1       albertel 3119:   if ($symb) {
1.3       albertel 3120:     my (%returnhash)=
                   3121:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3122:     if ($returnhash{'version'}) {
                   3123:       my %lasthash=();
                   3124:       my $version;
                   3125:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3126:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3127: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3128:         }
1.1       albertel 3129:       }
1.596     albertel 3130:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3131:       $prevattempts.='<th>'.&mt('History').'</th>';
1.356     albertel 3132:       foreach my $key (sort(keys(%lasthash))) {
                   3133: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3134: 	if ($#parts > 0) {
1.31      albertel 3135: 	  my $data=$parts[-1];
                   3136: 	  pop(@parts);
1.596     albertel 3137: 	  $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.31      albertel 3138: 	} else {
1.41      ng       3139: 	  if ($#parts == 0) {
                   3140: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3141: 	  } else {
                   3142: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3143: 	  }
1.31      albertel 3144: 	}
1.16      harris41 3145:       }
1.596     albertel 3146:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3147:       if ($getattempt eq '') {
                   3148: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596     albertel 3149: 	  $prevattempts.=&start_data_table_row().
                   3150: 	      '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356     albertel 3151: 	    foreach my $key (sort(keys(%lasthash))) {
1.581     albertel 3152: 		my $value = &format_previous_attempt_value($key,
                   3153: 							   $returnhash{$version.':'.$key});
                   3154: 		$prevattempts.='<td>'.$value.'&nbsp;</td>';   
1.40      ng       3155: 	    }
1.596     albertel 3156: 	  $prevattempts.=&end_data_table_row();
1.40      ng       3157: 	 }
1.1       albertel 3158:       }
1.596     albertel 3159:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3160:       foreach my $key (sort(keys(%lasthash))) {
1.581     albertel 3161: 	my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356     albertel 3162: 	if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40      ng       3163: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 3164:       }
1.596     albertel 3165:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3166:     } else {
1.596     albertel 3167:       $prevattempts=
                   3168: 	  &start_data_table().&start_data_table_row().
                   3169: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3170: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3171:     }
                   3172:   } else {
1.596     albertel 3173:     $prevattempts=
                   3174: 	  &start_data_table().&start_data_table_row().
                   3175: 	  '<td>'.&mt('No data.').'</td>'.
                   3176: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3177:   }
1.10      albertel 3178: }
                   3179: 
1.581     albertel 3180: sub format_previous_attempt_value {
                   3181:     my ($key,$value) = @_;
                   3182:     if ($key =~ /timestamp/) {
                   3183: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3184:     } elsif (ref($value) eq 'ARRAY') {
                   3185: 	$value = '('.join(', ', @{ $value }).')';
                   3186:     } else {
                   3187: 	$value = &unescape($value);
                   3188:     }
                   3189:     return $value;
                   3190: }
                   3191: 
                   3192: 
1.107     albertel 3193: sub relative_to_absolute {
                   3194:     my ($url,$output)=@_;
                   3195:     my $parser=HTML::TokeParser->new(\$output);
                   3196:     my $token;
                   3197:     my $thisdir=$url;
                   3198:     my @rlinks=();
                   3199:     while ($token=$parser->get_token) {
                   3200: 	if ($token->[0] eq 'S') {
                   3201: 	    if ($token->[1] eq 'a') {
                   3202: 		if ($token->[2]->{'href'}) {
                   3203: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3204: 		}
                   3205: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3206: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3207: 	    } elsif ($token->[1] eq 'base') {
                   3208: 		$thisdir=$token->[2]->{'href'};
                   3209: 	    }
                   3210: 	}
                   3211:     }
                   3212:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3213:     foreach my $link (@rlinks) {
1.726     raeburn  3214: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3215: 		($link=~/^\//) ||
                   3216: 		($link=~/^javascript:/i) ||
                   3217: 		($link=~/^mailto:/i) ||
                   3218: 		($link=~/^\#/)) {
                   3219: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3220: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3221: 	}
                   3222:     }
                   3223: # -------------------------------------------------- Deal with Applet codebases
                   3224:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3225:     return $output;
                   3226: }
                   3227: 
1.112     bowersj2 3228: =pod
                   3229: 
1.648     raeburn  3230: =item * &get_student_view()
1.112     bowersj2 3231: 
                   3232: show a snapshot of what student was looking at
                   3233: 
                   3234: =cut
                   3235: 
1.10      albertel 3236: sub get_student_view {
1.186     albertel 3237:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3238:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3239:   my (%form);
1.10      albertel 3240:   my @elements=('symb','courseid','domain','username');
                   3241:   foreach my $element (@elements) {
1.186     albertel 3242:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3243:   }
1.186     albertel 3244:   if (defined($moreenv)) {
                   3245:       %form=(%form,%{$moreenv});
                   3246:   }
1.236     albertel 3247:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3248:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3249:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3250:   $userview=~s/\<body[^\>]*\>//gi;
                   3251:   $userview=~s/\<\/body\>//gi;
                   3252:   $userview=~s/\<html\>//gi;
                   3253:   $userview=~s/\<\/html\>//gi;
                   3254:   $userview=~s/\<head\>//gi;
                   3255:   $userview=~s/\<\/head\>//gi;
                   3256:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3257:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3258:   if (wantarray) {
                   3259:      return ($userview,$response);
                   3260:   } else {
                   3261:      return $userview;
                   3262:   }
                   3263: }
                   3264: 
                   3265: sub get_student_view_with_retries {
                   3266:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3267: 
                   3268:     my $ok = 0;                 # True if we got a good response.
                   3269:     my $content;
                   3270:     my $response;
                   3271: 
                   3272:     # Try to get the student_view done. within the retries count:
                   3273:     
                   3274:     do {
                   3275:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3276:          $ok      = $response->is_success;
                   3277:          if (!$ok) {
                   3278:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3279:          }
                   3280:          $retries--;
                   3281:     } while (!$ok && ($retries > 0));
                   3282:     
                   3283:     if (!$ok) {
                   3284:        $content = '';          # On error return an empty content.
                   3285:     }
1.651     www      3286:     if (wantarray) {
                   3287:        return ($content, $response);
                   3288:     } else {
                   3289:        return $content;
                   3290:     }
1.11      albertel 3291: }
                   3292: 
1.112     bowersj2 3293: =pod
                   3294: 
1.648     raeburn  3295: =item * &get_student_answers() 
1.112     bowersj2 3296: 
                   3297: show a snapshot of how student was answering problem
                   3298: 
                   3299: =cut
                   3300: 
1.11      albertel 3301: sub get_student_answers {
1.100     sakharuk 3302:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3303:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3304:   my (%moreenv);
1.11      albertel 3305:   my @elements=('symb','courseid','domain','username');
                   3306:   foreach my $element (@elements) {
1.186     albertel 3307:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3308:   }
1.186     albertel 3309:   $moreenv{'grade_target'}='answer';
                   3310:   %moreenv=(%form,%moreenv);
1.497     raeburn  3311:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3312:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3313:   return $userview;
1.1       albertel 3314: }
1.116     albertel 3315: 
                   3316: =pod
                   3317: 
                   3318: =item * &submlink()
                   3319: 
1.242     albertel 3320: Inputs: $text $uname $udom $symb $target
1.116     albertel 3321: 
                   3322: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3323: 
                   3324: =cut
                   3325: 
                   3326: ###############################################
                   3327: sub submlink {
1.242     albertel 3328:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3329:     if (!($uname && $udom)) {
                   3330: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3331: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3332: 	if (!$symb) { $symb=$cursymb; }
                   3333:     }
1.254     matthew  3334:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3335:     $symb=&escape($symb);
1.242     albertel 3336:     if ($target) { $target="target=\"$target\""; }
                   3337:     return '<a href="/adm/grades?&command=submission&'.
                   3338: 	'symb='.$symb.'&student='.$uname.
                   3339: 	'&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
                   3340: }
                   3341: ##############################################
                   3342: 
                   3343: =pod
                   3344: 
                   3345: =item * &pgrdlink()
                   3346: 
                   3347: Inputs: $text $uname $udom $symb $target
                   3348: 
                   3349: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3350: 
                   3351: =cut
                   3352: 
                   3353: ###############################################
                   3354: sub pgrdlink {
                   3355:     my $link=&submlink(@_);
                   3356:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3357:     return $link;
                   3358: }
                   3359: ##############################################
                   3360: 
                   3361: =pod
                   3362: 
                   3363: =item * &pprmlink()
                   3364: 
                   3365: Inputs: $text $uname $udom $symb $target
                   3366: 
                   3367: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3368: student and a specific resource
1.242     albertel 3369: 
                   3370: =cut
                   3371: 
                   3372: ###############################################
                   3373: sub pprmlink {
                   3374:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3375:     if (!($uname && $udom)) {
                   3376: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3377: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3378: 	if (!$symb) { $symb=$cursymb; }
                   3379:     }
1.254     matthew  3380:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3381:     $symb=&escape($symb);
1.242     albertel 3382:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3383:     return '<a href="/adm/parmset?command=set&amp;'.
                   3384: 	'symb='.$symb.'&amp;uname='.$uname.
                   3385: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3386: }
                   3387: ##############################################
1.37      matthew  3388: 
1.112     bowersj2 3389: =pod
                   3390: 
                   3391: =back
                   3392: 
                   3393: =cut
                   3394: 
1.37      matthew  3395: ###############################################
1.51      www      3396: 
                   3397: 
                   3398: sub timehash {
1.687     raeburn  3399:     my ($thistime) = @_;
                   3400:     my $timezone = &Apache::lonlocal::gettimezone();
                   3401:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3402:                      ->set_time_zone($timezone);
                   3403:     my $wday = $dt->day_of_week();
                   3404:     if ($wday == 7) { $wday = 0; }
                   3405:     return ( 'second' => $dt->second(),
                   3406:              'minute' => $dt->minute(),
                   3407:              'hour'   => $dt->hour(),
                   3408:              'day'     => $dt->day_of_month(),
                   3409:              'month'   => $dt->month(),
                   3410:              'year'    => $dt->year(),
                   3411:              'weekday' => $wday,
                   3412:              'dayyear' => $dt->day_of_year(),
                   3413:              'dlsav'   => $dt->is_dst() );
1.51      www      3414: }
                   3415: 
1.370     www      3416: sub utc_string {
                   3417:     my ($date)=@_;
1.371     www      3418:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3419: }
                   3420: 
1.51      www      3421: sub maketime {
                   3422:     my %th=@_;
1.687     raeburn  3423:     my ($epoch_time,$timezone,$dt);
                   3424:     $timezone = &Apache::lonlocal::gettimezone();
                   3425:     eval {
                   3426:         $dt = DateTime->new( year   => $th{'year'},
                   3427:                              month  => $th{'month'},
                   3428:                              day    => $th{'day'},
                   3429:                              hour   => $th{'hour'},
                   3430:                              minute => $th{'minute'},
                   3431:                              second => $th{'second'},
                   3432:                              time_zone => $timezone,
                   3433:                          );
                   3434:     };
                   3435:     if (!$@) {
                   3436:         $epoch_time = $dt->epoch;
                   3437:         if ($epoch_time) {
                   3438:             return $epoch_time;
                   3439:         }
                   3440:     }
1.51      www      3441:     return POSIX::mktime(
                   3442:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3443:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3444: }
                   3445: 
                   3446: #########################################
1.51      www      3447: 
                   3448: sub findallcourses {
1.482     raeburn  3449:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3450:     my %roles;
                   3451:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3452:     my %courses;
1.51      www      3453:     my $now=time;
1.482     raeburn  3454:     if (!defined($uname)) {
                   3455:         $uname = $env{'user.name'};
                   3456:     }
                   3457:     if (!defined($udom)) {
                   3458:         $udom = $env{'user.domain'};
                   3459:     }
                   3460:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
                   3461:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
                   3462:         if (!%roles) {
                   3463:             %roles = (
                   3464:                        cc => 1,
                   3465:                        in => 1,
                   3466:                        ep => 1,
                   3467:                        ta => 1,
                   3468:                        cr => 1,
                   3469:                        st => 1,
                   3470:              );
                   3471:         }
                   3472:         foreach my $entry (keys(%roleshash)) {
                   3473:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3474:             if ($trole =~ /^cr/) { 
                   3475:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3476:             } else {
                   3477:                 next if (!exists($roles{$trole}));
                   3478:             }
                   3479:             if ($tend) {
                   3480:                 next if ($tend < $now);
                   3481:             }
                   3482:             if ($tstart) {
                   3483:                 next if ($tstart > $now);
                   3484:             }
                   3485:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3486:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3487:             if ($secpart eq '') {
                   3488:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3489:                 $sec = 'none';
                   3490:                 $realsec = '';
                   3491:             } else {
                   3492:                 $cnum = $cnumpart;
                   3493:                 ($sec,$role) = split(/_/,$secpart);
                   3494:                 $realsec = $sec;
1.490     raeburn  3495:             }
1.482     raeburn  3496:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3497:         }
                   3498:     } else {
                   3499:         foreach my $key (keys(%env)) {
1.483     albertel 3500: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3501:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3502: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3503: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3504: 	        next if (%roles && !exists($roles{$role}));
                   3505: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3506:                 my $active=1;
                   3507:                 if ($starttime) {
                   3508: 		    if ($now<$starttime) { $active=0; }
                   3509:                 }
                   3510:                 if ($endtime) {
                   3511:                     if ($now>$endtime) { $active=0; }
                   3512:                 }
                   3513:                 if ($active) {
                   3514:                     if ($sec eq '') {
                   3515:                         $sec = 'none';
                   3516:                     }
                   3517:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   3518:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  3519:                 }
                   3520:             }
1.51      www      3521:         }
                   3522:     }
1.474     raeburn  3523:     return %courses;
1.51      www      3524: }
1.37      matthew  3525: 
1.54      www      3526: ###############################################
1.474     raeburn  3527: 
                   3528: sub blockcheck {
1.482     raeburn  3529:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  3530: 
                   3531:     if (!defined($udom)) {
                   3532:         $udom = $env{'user.domain'};
                   3533:     }
                   3534:     if (!defined($uname)) {
                   3535:         $uname = $env{'user.name'};
                   3536:     }
                   3537: 
                   3538:     # If uname and udom are for a course, check for blocks in the course.
                   3539: 
                   3540:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   3541:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  3542:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  3543:         return ($startblock,$endblock);
                   3544:     }
1.474     raeburn  3545: 
1.502     raeburn  3546:     my $startblock = 0;
                   3547:     my $endblock = 0;
1.482     raeburn  3548:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  3549: 
1.490     raeburn  3550:     # If uname is for a user, and activity is course-specific, i.e.,
                   3551:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  3552: 
1.490     raeburn  3553:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   3554:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   3555:         foreach my $key (keys(%live_courses)) {
                   3556:             if ($key ne $env{'request.course.id'}) {
                   3557:                 delete($live_courses{$key});
                   3558:             }
                   3559:         }
                   3560:     }
                   3561: 
                   3562:     my $otheruser = 0;
                   3563:     my %own_courses;
                   3564:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   3565:         # Resource belongs to user other than current user.
                   3566:         $otheruser = 1;
                   3567:         # Gather courses for current user
                   3568:         %own_courses = 
                   3569:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   3570:     }
                   3571: 
                   3572:     # Gather active course roles - course coordinator, instructor, 
                   3573:     # exam proctor, ta, student, or custom role.
1.474     raeburn  3574: 
                   3575:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  3576:         my ($cdom,$cnum);
                   3577:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   3578:             $cdom = $env{'course.'.$course.'.domain'};
                   3579:             $cnum = $env{'course.'.$course.'.num'};
                   3580:         } else {
1.490     raeburn  3581:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  3582:         }
                   3583:         my $no_ownblock = 0;
                   3584:         my $no_userblock = 0;
1.533     raeburn  3585:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  3586:             # Check if current user has 'evb' priv for this
                   3587:             if (defined($own_courses{$course})) {
                   3588:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   3589:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   3590:                     if ($sec ne 'none') {
                   3591:                         $checkrole .= '/'.$sec;
                   3592:                     }
                   3593:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3594:                         $no_ownblock = 1;
                   3595:                         last;
                   3596:                     }
                   3597:                 }
                   3598:             }
                   3599:             # if they have 'evb' priv and are currently not playing student
                   3600:             next if (($no_ownblock) &&
                   3601:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   3602:         }
1.474     raeburn  3603:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  3604:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  3605:             if ($sec ne 'none') {
1.482     raeburn  3606:                 $checkrole .= '/'.$sec;
1.474     raeburn  3607:             }
1.490     raeburn  3608:             if ($otheruser) {
                   3609:                 # Resource belongs to user other than current user.
                   3610:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  3611:                 my ($trole,$tdom,$tnum,$tsec);
                   3612:                 my $entry = $live_courses{$course}{$sec};
                   3613:                 if ($entry =~ /^cr/) {
                   3614:                     ($trole,$tdom,$tnum,$tsec) = 
                   3615:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   3616:                 } else {
                   3617:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   3618:                 }
                   3619:                 my ($spec,$area,$trest,%allroles,%userroles);
                   3620:                 $area = '/'.$tdom.'/'.$tnum;
                   3621:                 $trest = $tnum;
                   3622:                 if ($tsec ne '') {
                   3623:                     $area .= '/'.$tsec;
                   3624:                     $trest .= '/'.$tsec;
                   3625:                 }
                   3626:                 $spec = $trole.'.'.$area;
                   3627:                 if ($trole =~ /^cr/) {
                   3628:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   3629:                                                       $tdom,$spec,$trest,$area);
                   3630:                 } else {
                   3631:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   3632:                                                        $tdom,$spec,$trest,$area);
                   3633:                 }
                   3634:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  3635:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   3636:                     if ($1) {
                   3637:                         $no_userblock = 1;
                   3638:                         last;
                   3639:                     }
                   3640:                 }
1.490     raeburn  3641:             } else {
                   3642:                 # Resource belongs to current user
                   3643:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  3644:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3645:                     $no_ownblock = 1;
                   3646:                     last;
                   3647:                 }
1.474     raeburn  3648:             }
                   3649:         }
                   3650:         # if they have the evb priv and are currently not playing student
1.482     raeburn  3651:         next if (($no_ownblock) &&
1.491     albertel 3652:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  3653:         next if ($no_userblock);
1.474     raeburn  3654: 
1.490     raeburn  3655:         # Retrieve blocking times and identity of blocker for course
                   3656:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  3657:         
                   3658:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   3659:         if (($start != 0) && 
                   3660:             (($startblock == 0) || ($startblock > $start))) {
                   3661:             $startblock = $start;
                   3662:         }
                   3663:         if (($end != 0)  &&
                   3664:             (($endblock == 0) || ($endblock < $end))) {
                   3665:             $endblock = $end;
                   3666:         }
1.490     raeburn  3667:     }
                   3668:     return ($startblock,$endblock);
                   3669: }
                   3670: 
                   3671: sub get_blocks {
                   3672:     my ($setters,$activity,$cdom,$cnum) = @_;
                   3673:     my $startblock = 0;
                   3674:     my $endblock = 0;
                   3675:     my $course = $cdom.'_'.$cnum;
                   3676:     $setters->{$course} = {};
                   3677:     $setters->{$course}{'staff'} = [];
                   3678:     $setters->{$course}{'times'} = [];
                   3679:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   3680:     foreach my $record (keys(%records)) {
                   3681:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   3682:         if ($start <= time && $end >= time) {
                   3683:             my ($staff_name,$staff_dom,$title,$blocks) =
                   3684:                 &parse_block_record($records{$record});
                   3685:             if ($blocks->{$activity} eq 'on') {
                   3686:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   3687:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 3688:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   3689:                     $startblock = $start;
1.490     raeburn  3690:                 }
1.491     albertel 3691:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   3692:                     $endblock = $end;
1.474     raeburn  3693:                 }
                   3694:             }
                   3695:         }
                   3696:     }
                   3697:     return ($startblock,$endblock);
                   3698: }
                   3699: 
                   3700: sub parse_block_record {
                   3701:     my ($record) = @_;
                   3702:     my ($setuname,$setudom,$title,$blocks);
                   3703:     if (ref($record) eq 'HASH') {
                   3704:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   3705:         $title = &unescape($record->{'event'});
                   3706:         $blocks = $record->{'blocks'};
                   3707:     } else {
                   3708:         my @data = split(/:/,$record,3);
                   3709:         if (scalar(@data) eq 2) {
                   3710:             $title = $data[1];
                   3711:             ($setuname,$setudom) = split(/@/,$data[0]);
                   3712:         } else {
                   3713:             ($setuname,$setudom,$title) = @data;
                   3714:         }
                   3715:         $blocks = { 'com' => 'on' };
                   3716:     }
                   3717:     return ($setuname,$setudom,$title,$blocks);
                   3718: }
                   3719: 
                   3720: sub build_block_table {
                   3721:     my ($startblock,$endblock,$setters) = @_;
                   3722:     my %lt = &Apache::lonlocal::texthash(
                   3723:         'cacb' => 'Currently active communication blocks',
                   3724:         'cour' => 'Course',
                   3725:         'dura' => 'Duration',
                   3726:         'blse' => 'Block set by'
                   3727:     );
                   3728:     my $output;
1.476     raeburn  3729:     $output = '<br />'.$lt{'cacb'}.':<br />';
1.474     raeburn  3730:     $output .= &start_data_table();
                   3731:     $output .= '
                   3732: <tr>
                   3733:  <th>'.$lt{'cour'}.'</th>
                   3734:  <th>'.$lt{'dura'}.'</th>
                   3735:  <th>'.$lt{'blse'}.'</th>
                   3736: </tr>
                   3737: ';
                   3738:     foreach my $course (keys(%{$setters})) {
                   3739:         my %courseinfo=&Apache::lonnet::coursedescription($course);
                   3740:         for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
                   3741:             my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490     raeburn  3742:             my $fullname = &plainname($uname,$udom);
                   3743:             if (defined($env{'user.name'}) && defined($env{'user.domain'})
                   3744:                 && $env{'user.name'} ne 'public' 
                   3745:                 && $env{'user.domain'} ne 'public') {
                   3746:                 $fullname = &aboutmewrapper($fullname,$uname,$udom);
                   3747:             }
1.474     raeburn  3748:             my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
                   3749:             $openblock = &Apache::lonlocal::locallocaltime($openblock);
                   3750:             $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
                   3751:             $output .= &Apache::loncommon::start_data_table_row().
                   3752:                        '<td>'.$courseinfo{'description'}.'</td>'.
                   3753:                        '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490     raeburn  3754:                        '<td>'.$fullname.'</td>'.
1.474     raeburn  3755:                         &Apache::loncommon::end_data_table_row();
                   3756:         }
                   3757:     }
                   3758:     $output .= &end_data_table();
                   3759: }
                   3760: 
1.490     raeburn  3761: sub blocking_status {
                   3762:     my ($activity,$uname,$udom) = @_;
                   3763:     my %setters;
                   3764:     my ($blocked,$output,$ownitem,$is_course);
                   3765:     my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
                   3766:     if ($startblock && $endblock) {
                   3767:         $blocked = 1;
                   3768:         if (wantarray) {
                   3769:             my $category;
                   3770:             if ($activity eq 'boards') {
                   3771:                 $category = 'Discussion posts in this course';
                   3772:             } elsif ($activity eq 'blogs') {
                   3773:                 $category = 'Blogs';
                   3774:             } elsif ($activity eq 'port') {
                   3775:                 if (defined($uname) && defined($udom)) {
                   3776:                     if ($uname eq $env{'user.name'} &&
                   3777:                         $udom eq $env{'user.domain'}) {
                   3778:                         $ownitem = 1;
                   3779:                     }
                   3780:                 }
                   3781:                 $is_course = &Apache::lonnet::is_course($udom,$uname);
                   3782:                 if ($ownitem) { 
                   3783:                     $category = 'Your portfolio files';  
                   3784:                 } elsif ($is_course) {
                   3785:                     my $coursedesc;
                   3786:                     foreach my $course (keys(%setters)) {
                   3787:                         my %courseinfo =
                   3788:                              &Apache::lonnet::coursedescription($course);
                   3789:                         $coursedesc = $courseinfo{'description'};
                   3790:                     }
                   3791:                     $category = "Group files in the course '$coursedesc'";
                   3792:                 } else {
                   3793:                     $category = 'Portfolio files belonging to ';
                   3794:                     if ($env{'user.name'} eq 'public' && 
                   3795:                         $env{'user.domain'} eq 'public') {
                   3796:                         $category .= &plainname($uname,$udom);
                   3797:                     } else {
                   3798:                         $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);  
                   3799:                     }
                   3800:                 }
                   3801:             } elsif ($activity eq 'groups') {
                   3802:                 $category = 'Groups in this course';
                   3803:             }
                   3804:             my $showstart = &Apache::lonlocal::locallocaltime($startblock);
                   3805:             my $showend = &Apache::lonlocal::locallocaltime($endblock);
                   3806:             $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
                   3807:             if (!($activity eq 'port' && !($ownitem) && !($is_course))) { 
                   3808:                 $output .= &build_block_table($startblock,$endblock,\%setters);
                   3809:             }
                   3810:         }
                   3811:     }
                   3812:     if (wantarray) {
                   3813:         return ($blocked,$output);
                   3814:     } else {
                   3815:         return $blocked;
                   3816:     }
                   3817: }
                   3818: 
1.60      matthew  3819: ###############################################
                   3820: 
1.682     raeburn  3821: sub check_ip_acc {
                   3822:     my ($acc)=@_;
                   3823:     &Apache::lonxml::debug("acc is $acc");
                   3824:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   3825:         return 1;
                   3826:     }
                   3827:     my $allowed=0;
                   3828:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   3829: 
                   3830:     my $name;
                   3831:     foreach my $pattern (split(',',$acc)) {
                   3832:         $pattern =~ s/^\s*//;
                   3833:         $pattern =~ s/\s*$//;
                   3834:         if ($pattern =~ /\*$/) {
                   3835:             #35.8.*
                   3836:             $pattern=~s/\*//;
                   3837:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   3838:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   3839:             #35.8.3.[34-56]
                   3840:             my $low=$2;
                   3841:             my $high=$3;
                   3842:             $pattern=$1;
                   3843:             if ($ip =~ /^\Q$pattern\E/) {
                   3844:                 my $last=(split(/\./,$ip))[3];
                   3845:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   3846:             }
                   3847:         } elsif ($pattern =~ /^\*/) {
                   3848:             #*.msu.edu
                   3849:             $pattern=~s/\*//;
                   3850:             if (!defined($name)) {
                   3851:                 use Socket;
                   3852:                 my $netaddr=inet_aton($ip);
                   3853:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   3854:             }
                   3855:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   3856:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   3857:             #127.0.0.1
                   3858:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   3859:         } else {
                   3860:             #some.name.com
                   3861:             if (!defined($name)) {
                   3862:                 use Socket;
                   3863:                 my $netaddr=inet_aton($ip);
                   3864:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   3865:             }
                   3866:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   3867:         }
                   3868:         if ($allowed) { last; }
                   3869:     }
                   3870:     return $allowed;
                   3871: }
                   3872: 
                   3873: ###############################################
                   3874: 
1.60      matthew  3875: =pod
                   3876: 
1.112     bowersj2 3877: =head1 Domain Template Functions
                   3878: 
                   3879: =over 4
                   3880: 
                   3881: =item * &determinedomain()
1.60      matthew  3882: 
                   3883: Inputs: $domain (usually will be undef)
                   3884: 
1.63      www      3885: Returns: Determines which domain should be used for designs
1.60      matthew  3886: 
                   3887: =cut
1.54      www      3888: 
1.60      matthew  3889: ###############################################
1.63      www      3890: sub determinedomain {
                   3891:     my $domain=shift;
1.531     albertel 3892:     if (! $domain) {
1.60      matthew  3893:         # Determine domain if we have not been given one
                   3894:         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258     albertel 3895:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   3896:         if ($env{'request.role.domain'}) { 
                   3897:             $domain=$env{'request.role.domain'}; 
1.60      matthew  3898:         }
                   3899:     }
1.63      www      3900:     return $domain;
                   3901: }
                   3902: ###############################################
1.517     raeburn  3903: 
1.518     albertel 3904: sub devalidate_domconfig_cache {
                   3905:     my ($udom)=@_;
                   3906:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   3907: }
                   3908: 
                   3909: # ---------------------- Get domain configuration for a domain
                   3910: sub get_domainconf {
                   3911:     my ($udom) = @_;
                   3912:     my $cachetime=1800;
                   3913:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   3914:     if (defined($cached)) { return %{$result}; }
                   3915: 
                   3916:     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   3917: 					     ['login','rolecolors'],$udom);
1.632     raeburn  3918:     my (%designhash,%legacy);
1.518     albertel 3919:     if (keys(%domconfig) > 0) {
                   3920:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  3921:             if (keys(%{$domconfig{'login'}})) {
                   3922:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  3923:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   3924:                         foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   3925:                             $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   3926:                                 $domconfig{'login'}{$key}{$img};
                   3927:                         }
                   3928:                     } else {
                   3929:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   3930:                     }
1.632     raeburn  3931:                 }
                   3932:             } else {
                   3933:                 $legacy{'login'} = 1;
1.518     albertel 3934:             }
1.632     raeburn  3935:         } else {
                   3936:             $legacy{'login'} = 1;
1.518     albertel 3937:         }
                   3938:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  3939:             if (keys(%{$domconfig{'rolecolors'}})) {
                   3940:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   3941:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   3942:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   3943:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   3944:                         }
1.518     albertel 3945:                     }
                   3946:                 }
1.632     raeburn  3947:             } else {
                   3948:                 $legacy{'rolecolors'} = 1;
1.518     albertel 3949:             }
1.632     raeburn  3950:         } else {
                   3951:             $legacy{'rolecolors'} = 1;
1.518     albertel 3952:         }
1.632     raeburn  3953:         if (keys(%legacy) > 0) {
                   3954:             my %legacyhash = &get_legacy_domconf($udom);
                   3955:             foreach my $item (keys(%legacyhash)) {
                   3956:                 if ($item =~ /^\Q$udom\E\.login/) {
                   3957:                     if ($legacy{'login'}) { 
                   3958:                         $designhash{$item} = $legacyhash{$item};
                   3959:                     }
                   3960:                 } else {
                   3961:                     if ($legacy{'rolecolors'}) {
                   3962:                         $designhash{$item} = $legacyhash{$item};
                   3963:                     }
1.518     albertel 3964:                 }
                   3965:             }
                   3966:         }
1.632     raeburn  3967:     } else {
                   3968:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 3969:     }
                   3970:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   3971: 				  $cachetime);
                   3972:     return %designhash;
                   3973: }
                   3974: 
1.632     raeburn  3975: sub get_legacy_domconf {
                   3976:     my ($udom) = @_;
                   3977:     my %legacyhash;
                   3978:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   3979:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   3980:     if (-e $designfile) {
                   3981:         if ( open (my $fh,"<$designfile") ) {
                   3982:             while (my $line = <$fh>) {
                   3983:                 next if ($line =~ /^\#/);
                   3984:                 chomp($line);
                   3985:                 my ($key,$val)=(split(/\=/,$line));
                   3986:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   3987:             }
                   3988:             close($fh);
                   3989:         }
                   3990:     }
                   3991:     if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
                   3992:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   3993:     }
                   3994:     return %legacyhash;
                   3995: }
                   3996: 
1.63      www      3997: =pod
                   3998: 
1.112     bowersj2 3999: =item * &domainlogo()
1.63      www      4000: 
                   4001: Inputs: $domain (usually will be undef)
                   4002: 
                   4003: Returns: A link to a domain logo, if the domain logo exists.
                   4004: If the domain logo does not exist, a description of the domain.
                   4005: 
                   4006: =cut
1.112     bowersj2 4007: 
1.63      www      4008: ###############################################
                   4009: sub domainlogo {
1.517     raeburn  4010:     my $domain = &determinedomain(shift);
1.518     albertel 4011:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4012:     # See if there is a logo
                   4013:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4014:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4015:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4016: 	    if ($imgsrc =~ m{^/res/}) {
                   4017: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4018: 		&Apache::lonnet::repcopy($local_name);
                   4019: 	    }
                   4020: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4021:         } 
                   4022:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4023:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4024:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4025:     } else {
1.60      matthew  4026:         return '';
1.59      www      4027:     }
                   4028: }
1.63      www      4029: ##############################################
                   4030: 
                   4031: =pod
                   4032: 
1.112     bowersj2 4033: =item * &designparm()
1.63      www      4034: 
                   4035: Inputs: $which parameter; $domain (usually will be undef)
                   4036: 
                   4037: Returns: value of designparamter $which
                   4038: 
                   4039: =cut
1.112     bowersj2 4040: 
1.397     albertel 4041: 
1.400     albertel 4042: ##############################################
1.397     albertel 4043: sub designparm {
                   4044:     my ($which,$domain)=@_;
1.258     albertel 4045:     if ($env{'browser.blackwhite'} eq 'on') {
1.635     raeburn  4046: 	if ($which=~/\.(font|alink|vlink|link|textcol)$/) {
1.110     www      4047: 	    return '#000000';
                   4048: 	}
1.635     raeburn  4049: 	if ($which=~/\.(pgbg|sidebg|bgcol)$/) {
1.110     www      4050: 	    return '#FFFFFF';
                   4051: 	}
                   4052: 	if ($which=~/\.tabbg$/) {
                   4053: 	    return '#CCCCCC';
                   4054: 	}
                   4055:     }
1.397     albertel 4056:     if (exists($env{'environment.color.'.$which})) {
1.258     albertel 4057: 	return $env{'environment.color.'.$which};
1.96      www      4058:     }
1.63      www      4059:     $domain=&determinedomain($domain);
1.518     albertel 4060:     my %domdesign = &get_domainconf($domain);
1.520     raeburn  4061:     my $output;
1.517     raeburn  4062:     if ($domdesign{$domain.'.'.$which} ne '') {
1.520     raeburn  4063: 	$output = $domdesign{$domain.'.'.$which};
1.63      www      4064:     } else {
1.520     raeburn  4065:         $output = $defaultdesign{$which};
                   4066:     }
                   4067:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4068:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4069:         if ($output =~ m{^/(adm|res)/}) {
                   4070: 	    if ($output =~ m{^/res/}) {
                   4071: 		my $local_name = &Apache::lonnet::filelocation('',$output);
                   4072: 		&Apache::lonnet::repcopy($local_name);
                   4073: 	    }
1.520     raeburn  4074:             $output = &lonhttpdurl($output);
                   4075:         }
1.63      www      4076:     }
1.520     raeburn  4077:     return $output;
1.63      www      4078: }
1.59      www      4079: 
1.60      matthew  4080: ###############################################
                   4081: ###############################################
                   4082: 
                   4083: =pod
                   4084: 
1.112     bowersj2 4085: =back
                   4086: 
1.549     albertel 4087: =head1 HTML Helpers
1.112     bowersj2 4088: 
                   4089: =over 4
                   4090: 
                   4091: =item * &bodytag()
1.60      matthew  4092: 
                   4093: Returns a uniform header for LON-CAPA web pages.
                   4094: 
                   4095: Inputs: 
                   4096: 
1.112     bowersj2 4097: =over 4
                   4098: 
                   4099: =item * $title, A title to be displayed on the page.
                   4100: 
                   4101: =item * $function, the current role (can be undef).
                   4102: 
                   4103: =item * $addentries, extra parameters for the <body> tag.
                   4104: 
                   4105: =item * $bodyonly, if defined, only return the <body> tag.
                   4106: 
                   4107: =item * $domain, if defined, force a given domain.
                   4108: 
                   4109: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4110:             text interface only)
1.60      matthew  4111: 
1.326     albertel 4112: =item * $customtitle, alternate text to use instead of $title
                   4113:                       in the title box that appears, this text
                   4114:                       is not auto translated like the $title is
1.309     albertel 4115: 
                   4116: =item * $notopbar, if true, keep the 'what is this' info but remove the
                   4117:                    navigational links
1.317     albertel 4118: 
1.338     albertel 4119: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4120: 
                   4121: =item * $notitle, if true keep the nav controls, but remove the title bar
                   4122: 
1.361     albertel 4123: =item * $no_inline_link, if true and in remote mode, don't show the 
                   4124:          'Switch To Inline Menu' link
                   4125: 
1.460     albertel 4126: =item * $args, optional argument valid values are
                   4127:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4128:             inherit_jsmath -> when creating popup window in a page,
                   4129:                               should it have jsmath forced on by the
                   4130:                               current page
1.460     albertel 4131: 
1.112     bowersj2 4132: =back
                   4133: 
1.60      matthew  4134: Returns: A uniform header for LON-CAPA web pages.  
                   4135: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4136: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4137: other decorations will be returned.
                   4138: 
                   4139: =cut
                   4140: 
1.54      www      4141: sub bodytag {
1.309     albertel 4142:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460     albertel 4143: 	$notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339     albertel 4144: 
1.460     albertel 4145:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4146: 
1.183     matthew  4147:     $function = &get_users_function() if (!$function);
1.339     albertel 4148:     my $img =    &designparm($function.'.img',$domain);
                   4149:     my $font =   &designparm($function.'.font',$domain);
                   4150:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4151: 
                   4152:     my %design = ( 'style'   => 'margin-top: 0px',
1.535     albertel 4153: 		   'bgcolor' => $pgbg,
1.339     albertel 4154: 		   'text'    => $font,
                   4155:                    'alink'   => &designparm($function.'.alink',$domain),
                   4156: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4157: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4158:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4159: 
1.63      www      4160:  # role and realm
1.378     raeburn  4161:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4162:     if ($role  eq 'ca') {
1.479     albertel 4163:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4164:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4165:     } 
1.55      www      4166: # realm
1.258     albertel 4167:     if ($env{'request.course.id'}) {
1.378     raeburn  4168:         if ($env{'request.role'} !~ /^cr/) {
                   4169:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4170:         }
1.359     albertel 4171: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4172:     } else {
                   4173:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4174:     }
1.433     albertel 4175: 
1.359     albertel 4176:     if (!$realm) { $realm='&nbsp;'; }
1.55      www      4177: # Set messages
1.60      matthew  4178:     my $messages=&domainlogo($domain);
1.330     albertel 4179: 
1.438     albertel 4180:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4181: 
1.101     www      4182: # construct main body tag
1.359     albertel 4183:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4184: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4185: 
1.530     albertel 4186:     if ($bodyonly) {
1.60      matthew  4187:         return $bodytag;
1.258     albertel 4188:     } elsif ($env{'browser.interface'} eq 'textual') {
1.95      www      4189: # Accessibility
1.224     raeburn  4190:           
1.337     albertel 4191: 	$bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338     albertel 4192: 	if (!$notitle) {
1.337     albertel 4193: 	    $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
                   4194: 	}
                   4195: 	return $bodytag;
1.359     albertel 4196:     }
                   4197: 
1.410     albertel 4198:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433     albertel 4199:     if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
                   4200: 	undef($role);
1.434     albertel 4201:     } else {
                   4202: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 4203:     }
1.359     albertel 4204:     
                   4205:     my $roleinfo=(<<ENDROLE);
                   4206: <td class="LC_title_bar_who">
                   4207: <div class="LC_title_bar_name">
1.410     albertel 4208:     $name
1.361     albertel 4209:     &nbsp;
1.359     albertel 4210: </div>
                   4211: <div class="LC_title_bar_role">
1.361     albertel 4212: $role&nbsp;
1.359     albertel 4213: </div>
                   4214: <div class="LC_title_bar_realm">
1.361     albertel 4215: $realm&nbsp;
1.359     albertel 4216: </div>
1.206     albertel 4217: </td>
                   4218: ENDROLE
1.235     raeburn  4219: 
1.359     albertel 4220:     my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
                   4221:     if ($customtitle) {
                   4222:         $titleinfo = $customtitle;
                   4223:     }
                   4224:     #
                   4225:     # Extra info if you are the DC
                   4226:     my $dc_info = '';
                   4227:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4228:                         $env{'course.'.$env{'request.course.id'}.
                   4229:                                  '.domain'}.'/'})) {
                   4230:         my $cid = $env{'request.course.id'};
                   4231:         $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4232:         $dc_info =~ s/\s+$//;
1.359     albertel 4233:         $dc_info = '('.$dc_info.')';
                   4234:     }
                   4235: 
1.644     www      4236:     if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) {
1.359     albertel 4237:         # No Remote
1.258     albertel 4238: 	if ($env{'request.state'} eq 'construct') {
1.359     albertel 4239: 	    $forcereg=1;
                   4240: 	}
                   4241: 
                   4242: 	if (!$customtitle && $env{'request.state'} eq 'construct') {
                   4243: 	    # this is for resources; directories have customtitle, and crumbs
                   4244:             # and select recent are created in lonpubdir.pm  
1.229     albertel 4245: 	    my ($uname,$thisdisfn)=
1.258     albertel 4246: 		($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229     albertel 4247: 	    my $formaction='/priv/'.$uname.'/'.$thisdisfn;
                   4248: 	    $formaction=~s/\/+/\//g;
                   4249: 
1.359     albertel 4250: 	    my $parentpath = '';
                   4251: 	    my $lastitem = '';
                   4252: 	    if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4253: 		$parentpath = $1;
                   4254: 		$lastitem = $2;
                   4255: 	    } else {
                   4256: 		$lastitem = $thisdisfn;
                   4257: 	    }
                   4258: 	    $titleinfo = 
1.640     bisitz   4259: 		&Apache::loncommon::help_open_menu('','',3,'Authoring')
                   4260: 		.'<b>'.&mt('Construction Space').'</b>:&nbsp;'
                   4261: 		.'<form name="dirs" method="post" action="'.$formaction
1.359     albertel 4262: 		.'" target="_top"><tt><b>'
1.705     tempelho 4263: 		.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<span class=\"LC_fontsize_big\">$lastitem</span></b></tt><br />"
1.359     albertel 4264: 		.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4265: 		.'</form>'
                   4266: 		.&Apache::lonmenu::constspaceform();
1.235     raeburn  4267:         }
1.359     albertel 4268: 
1.337     albertel 4269:         my $titletable;
1.338     albertel 4270: 	if (!$notitle) {
1.337     albertel 4271: 	    $titletable =
1.359     albertel 4272: 		'<table id="LC_title_bar">'.
                   4273:                          "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
                   4274: 			 '</tr></table>';
1.337     albertel 4275: 	}
1.359     albertel 4276: 	if ($notopbar) {
                   4277: 	    $bodytag .= $titletable;
                   4278: 	} else {
                   4279: 	    if ($env{'request.state'} eq 'construct') {
1.337     albertel 4280:                 $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
                   4281: 							  $titletable);
1.272     raeburn  4282:             } else {
1.336     albertel 4283:                 $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359     albertel 4284: 		    $titletable;
1.272     raeburn  4285:             }
1.235     raeburn  4286:         }
                   4287:         return $bodytag;
1.94      www      4288:     }
1.95      www      4289: 
1.93      www      4290: #
1.95      www      4291: # Top frame rendering, Remote is up
1.93      www      4292: #
1.359     albertel 4293: 
1.517     raeburn  4294:     my $imgsrc = $img;
                   4295:     if ($img =~ /^\/adm/) {
1.575     albertel 4296:         $imgsrc = &lonhttpdurl($img);
1.517     raeburn  4297:     }
                   4298:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359     albertel 4299: 
1.305     www      4300:     # Explicit link to get inline menu
1.361     albertel 4301:     my $menu= ($no_inline_link?''
                   4302: 	       :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245     matthew  4303:     #
1.338     albertel 4304:     if ($notitle) {
1.337     albertel 4305: 	return $bodytag;
                   4306:     }
1.94      www      4307:     return(<<ENDBODY);
1.60      matthew  4308: $bodytag
1.359     albertel 4309: <table id="LC_title_bar" class="LC_with_remote">
1.368     albertel 4310: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359     albertel 4311:     <td class="LC_title_bar_domain_logo">$messages&nbsp;</td>
1.54      www      4312: </tr>
1.359     albertel 4313: <tr><td>$titleinfo $dc_info $menu</td>
                   4314: $roleinfo
1.368     albertel 4315: </tr>
1.356     albertel 4316: </table>
1.54      www      4317: ENDBODY
1.182     matthew  4318: }
                   4319: 
1.330     albertel 4320: sub make_attr_string {
                   4321:     my ($register,$attr_ref) = @_;
                   4322: 
                   4323:     if ($attr_ref && !ref($attr_ref)) {
                   4324: 	die("addentries Must be a hash ref ".
                   4325: 	    join(':',caller(1))." ".
                   4326: 	    join(':',caller(0))." ");
                   4327:     }
                   4328: 
                   4329:     if ($register) {
1.339     albertel 4330: 	my ($on_load,$on_unload);
                   4331: 	foreach my $key (keys(%{$attr_ref})) {
                   4332: 	    if      (lc($key) eq 'onload') {
                   4333: 		$on_load.=$attr_ref->{$key}.';';
                   4334: 		delete($attr_ref->{$key});
                   4335: 
                   4336: 	    } elsif (lc($key) eq 'onunload') {
                   4337: 		$on_unload.=$attr_ref->{$key}.';';
                   4338: 		delete($attr_ref->{$key});
                   4339: 	    }
                   4340: 	}
                   4341: 	$attr_ref->{'onload'}  =
                   4342: 	    &Apache::lonmenu::loadevents().  $on_load;
                   4343: 	$attr_ref->{'onunload'}=
                   4344: 	    &Apache::lonmenu::unloadevents().$on_unload;
                   4345:     }
                   4346: 
                   4347: # Accessibility font enhance
                   4348:     if ($env{'browser.fontenhance'} eq 'on') {
                   4349: 	my $style;
                   4350: 	foreach my $key (keys(%{$attr_ref})) {
                   4351: 	    if (lc($key) eq 'style') {
                   4352: 		$style.=$attr_ref->{$key}.';';
                   4353: 		delete($attr_ref->{$key});
                   4354: 	    }
                   4355: 	}
                   4356: 	$attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330     albertel 4357:     }
1.339     albertel 4358: 
                   4359:     if ($env{'browser.blackwhite'} eq 'on') {
                   4360: 	delete($attr_ref->{'font'});
                   4361: 	delete($attr_ref->{'link'});
                   4362: 	delete($attr_ref->{'alink'});
                   4363: 	delete($attr_ref->{'vlink'});
                   4364: 	delete($attr_ref->{'bgcolor'});
                   4365: 	delete($attr_ref->{'background'});
                   4366:     }
                   4367: 
1.330     albertel 4368:     my $attr_string;
                   4369:     foreach my $attr (keys(%$attr_ref)) {
                   4370: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4371:     }
                   4372:     return $attr_string;
                   4373: }
                   4374: 
                   4375: 
1.182     matthew  4376: ###############################################
1.251     albertel 4377: ###############################################
                   4378: 
                   4379: =pod
                   4380: 
                   4381: =item * &endbodytag()
                   4382: 
                   4383: Returns a uniform footer for LON-CAPA web pages.
                   4384: 
1.635     raeburn  4385: Inputs: 1 - optional reference to an args hash
                   4386: If in the hash, key for noredirectlink has a value which evaluates to true,
                   4387: a 'Continue' link is not displayed if the page contains an
                   4388: internal redirect in the <head></head> section,
                   4389: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 4390: 
                   4391: =cut
                   4392: 
                   4393: sub endbodytag {
1.635     raeburn  4394:     my ($args) = @_;
1.251     albertel 4395:     my $endbodytag='</body>';
1.269     albertel 4396:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4397:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  4398:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   4399: 	    $endbodytag=
                   4400: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4401: 	        &mt('Continue').'</a>'.
                   4402: 	        $endbodytag;
                   4403:         }
1.315     albertel 4404:     }
1.251     albertel 4405:     return $endbodytag;
                   4406: }
                   4407: 
1.352     albertel 4408: =pod
                   4409: 
                   4410: =item * &standard_css()
                   4411: 
                   4412: Returns a style sheet
                   4413: 
                   4414: Inputs: (all optional)
                   4415:             domain         -> force to color decorate a page for a specific
                   4416:                                domain
                   4417:             function       -> force usage of a specific rolish color scheme
                   4418:             bgcolor        -> override the default page bgcolor
                   4419: 
                   4420: =cut
                   4421: 
1.343     albertel 4422: sub standard_css {
1.345     albertel 4423:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4424:     $function  = &get_users_function() if (!$function);
                   4425:     my $img    = &designparm($function.'.img',   $domain);
                   4426:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4427:     my $font   = &designparm($function.'.font',  $domain);
1.345     albertel 4428:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4429:     my $pgbg_or_bgcolor =
                   4430: 	         $bgcolor ||
1.352     albertel 4431: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4432:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4433:     my $alink  = &designparm($function.'.alink', $domain);
                   4434:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4435:     my $link   = &designparm($function.'.link',  $domain);
                   4436: 
1.704     muellerd 4437:     my $loginbg = &designparm('login.sidebg',$domain);
1.712     muellerd 4438:     my $bgcol = &designparm('login.bgcol',$domain);
                   4439:     my $textcol = &designparm('login.textcol',$domain);
1.704     muellerd 4440: 
1.602     albertel 4441:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4442:     my $mono                 = 'monospace';
1.352     albertel 4443:     my $data_table_head      = $tabbg;
                   4444:     my $data_table_light     = '#EEEEEE';
1.470     banghart 4445:     my $data_table_dark      = '#DDDDDD';
                   4446:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4447:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4448:     my $mail_new             = '#FFBB77';
                   4449:     my $mail_new_hover       = '#DD9955';
                   4450:     my $mail_read            = '#BBBB77';
                   4451:     my $mail_read_hover      = '#999944';
                   4452:     my $mail_replied         = '#AAAA88';
                   4453:     my $mail_replied_hover   = '#888855';
                   4454:     my $mail_other           = '#99BBBB';
                   4455:     my $mail_other_hover     = '#669999';
1.391     albertel 4456:     my $table_header         = '#DDDDDD';
1.489     raeburn  4457:     my $feedback_link_bg     = '#BBBBBB';
1.701     harmsja  4458:     my $lg_border_color	     = '#C8C8C8';
1.392     albertel 4459: 
1.608     albertel 4460:     my $border = ($env{'browser.type'} eq 'explorer' ||
                   4461: 		  $env{'browser.type'} eq 'safari'     ) ? '0px 2px 0px 2px'
                   4462: 	                                                 : '0px 3px 0px 4px';
1.448     albertel 4463: 
1.523     albertel 4464: 
1.343     albertel 4465:     return <<END;
1.698     harmsja  4466: body{
                   4467:      font-family: $sans;
                   4468:      line-height:130%;
1.701     harmsja  4469:      font-size:0.83em;
1.698     harmsja  4470:      color:$font;
                   4471:   }
1.701     harmsja  4472: a:link, a:visited { font-size:100%; }
1.698     harmsja  4473: 
1.343     albertel 4474: a:focus { color: red; background: yellow } 
1.510     albertel 4475: table.thinborder,
                   4476: table.thinborder tr th {
                   4477:   border-style: solid;
                   4478:   border-width: 1px;
1.698     harmsja  4479:   border-color: $lg_border_color;
1.510     albertel 4480:   background: $tabbg;
                   4481: }
1.523     albertel 4482: table.thinborder tr td {
1.510     albertel 4483:   border-style: solid;
1.698     harmsja  4484:   border-width: 1px;
                   4485:   border-color: $lg_border_color;
1.510     albertel 4486: }
1.426     albertel 4487: 
1.343     albertel 4488: form, .inline { display: inline; }
1.721     harmsja  4489: 
                   4490: .LC_center { text-align: center; }
                   4491: .LC_left { text-align:left; }
                   4492: .LC_right {text-align:right;}
                   4493: .LC_middle {vertical-align:middle;}
                   4494: .LC_top {vertical-align:top;}
                   4495: .LC_bottom {vertical-align:bottom;}
                   4496: 
                   4497: /* just for tests */
                   4498: .LC_300Box { width:300px; }
                   4499: .LC_200Box {width:200px; }
                   4500: .LC_500Box {width:500px; }
                   4501: .LC_600Box {width:600px; }
                   4502: /* end */
                   4503: 
1.593     albertel 4504: .LC_filename {font-family: $mono; white-space:pre;}
1.350     albertel 4505: .LC_error {
                   4506:   color: red;
                   4507:   font-size: larger;
                   4508: }
1.457     albertel 4509: .LC_warning,
                   4510: .LC_diff_removed {
1.721     harmsja  4511:   
1.394     albertel 4512: }
1.532     albertel 4513: 
                   4514: .LC_info,
1.457     albertel 4515: .LC_success,
                   4516: .LC_diff_added {
1.350     albertel 4517:   color: green;
                   4518: }
1.543     albertel 4519: .LC_unknown {
                   4520:   color: yellow;
                   4521: }
                   4522: 
1.440     albertel 4523: .LC_icon {
                   4524:   border: 0px;
                   4525: }
1.539     albertel 4526: .LC_indexer_icon {
                   4527:   border: 0px;
                   4528:   height: 22px;
                   4529: }
1.543     albertel 4530: .LC_docs_spacer {
                   4531:   width: 25px;
                   4532:   height: 1px;
                   4533:   border: 0px;
                   4534: }
1.346     albertel 4535: 
1.532     albertel 4536: .LC_internal_info {
                   4537:   color: #999;
                   4538: }
                   4539: 
1.458     albertel 4540: table.LC_pastsubmission {
                   4541:   border: 1px solid black;
                   4542:   margin: 2px;
                   4543: }
                   4544: 
1.606     albertel 4545: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345     albertel 4546:   width: 100%;
                   4547:   background: $pgbg;
1.392     albertel 4548:   border: 2px;
1.402     albertel 4549:   border-collapse: separate;
1.403     albertel 4550:   padding: 0px;
1.345     albertel 4551: }
1.392     albertel 4552: 
1.606     albertel 4553: table#LC_title_bar, table.LC_breadcrumbs, 
1.393     albertel 4554: table#LC_title_bar.LC_with_remote {
1.359     albertel 4555:   width: 100%;
1.392     albertel 4556:   border-color: $pgbg;
                   4557:   border-style: solid;
                   4558:   border-width: $border;
                   4559: 
1.379     albertel 4560:   background: $pgbg;
                   4561:   font-family: $sans;
1.392     albertel 4562:   border-collapse: collapse;
1.403     albertel 4563:   padding: 0px;
1.359     albertel 4564: }
1.409     albertel 4565: table.LC_docs_path {
                   4566:   width: 100%;
                   4567:   border: 0;
                   4568:   background: $pgbg;
                   4569:   font-family: $sans;
                   4570:   border-collapse: collapse;
                   4571:   padding: 0px;
                   4572: }
                   4573: 
1.359     albertel 4574: table#LC_title_bar td {
                   4575:   background: $tabbg;
                   4576: }
                   4577: table#LC_title_bar td.LC_title_bar_who {
                   4578:   background: $tabbg;
                   4579:   color: $font;
1.427     albertel 4580:   font: small $sans;
1.359     albertel 4581:   text-align: right;
                   4582: }
1.469     banghart 4583: span.LC_metadata {
                   4584:     font-family: $sans;
                   4585: }
1.359     albertel 4586: span.LC_title_bar_title {
1.416     albertel 4587:   font: bold x-large $sans;
1.359     albertel 4588: }
                   4589: table#LC_title_bar td.LC_title_bar_domain_logo {
                   4590:   background: $sidebg;
                   4591:   text-align: right;
1.368     albertel 4592:   padding: 0px;
                   4593: }
                   4594: table#LC_title_bar td.LC_title_bar_role_logo {
                   4595:   background: $sidebg;
                   4596:   padding: 0px;
1.359     albertel 4597: }
                   4598: 
1.706     harmsja  4599: table#LC_menubuttons img{
1.346     albertel 4600:   border: 0px;
                   4601: }
1.345     albertel 4602: table#LC_top_nav td {
                   4603:   background: $tabbg;
1.392     albertel 4604:   border: 0px;
1.407     albertel 4605:   font-size: small;
1.706     harmsja  4606:   vertical-align:top;
                   4607:   padding:2px 5px 2px 5px;
1.345     albertel 4608: }
                   4609: table#LC_top_nav td a, div#LC_top_nav a {
                   4610:   color: $font;
                   4611:   font-family: $sans;
                   4612: }
1.364     albertel 4613: table#LC_top_nav td.LC_top_nav_logo {
                   4614:   background: $tabbg;
1.432     albertel 4615:   text-align: left;
1.408     albertel 4616:   white-space: nowrap;
1.432     albertel 4617:   width: 31px;
1.408     albertel 4618: }
                   4619: table#LC_top_nav td.LC_top_nav_logo img {
1.432     albertel 4620:   border: 0px;
1.408     albertel 4621:   vertical-align: bottom;
1.364     albertel 4622: }
1.432     albertel 4623: table#LC_top_nav td.LC_top_nav_exit,
                   4624: table#LC_top_nav td.LC_top_nav_help {
                   4625:   width: 2.0em;
                   4626: }
1.442     albertel 4627: table#LC_top_nav td.LC_top_nav_login {
                   4628:   width: 4.0em;
                   4629:   text-align: center;
                   4630: }
1.409     albertel 4631: table.LC_breadcrumbs td, table.LC_docs_path td  {
1.357     albertel 4632:   background: $tabbg;
                   4633:   color: $font;
                   4634:   font-family: $sans;
1.358     albertel 4635:   font-size: smaller;
1.357     albertel 4636: }
1.411     albertel 4637: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409     albertel 4638: table.LC_docs_path td.LC_docs_path_component {
1.357     albertel 4639:   background: $tabbg;
                   4640:   color: $font;
                   4641:   font-family: $sans;
                   4642:   font-size: larger;
                   4643:   text-align: right;
                   4644: }
1.383     albertel 4645: td.LC_table_cell_checkbox {
                   4646:   text-align: center;
                   4647: }
1.522     albertel 4648: table#LC_mainmenu td.LC_mainmenu_column {
                   4649:     vertical-align: top;
                   4650: }
                   4651: 
1.705     tempelho 4652: .LC_fontsize_small
                   4653: {
                   4654:  font-size: 70%;
                   4655: }
                   4656: 
                   4657: .LC_fontsize_medium
                   4658: {
                   4659:  font-size: 85%;
                   4660: }
                   4661: 
                   4662: .LC_fontsize_large
                   4663: {
                   4664:  font-size: 120%;
                   4665: }
                   4666: 
                   4667: .LC_fontcolor_red
                   4668: {
                   4669:  color: #FF0000;
                   4670: }
                   4671: 
1.346     albertel 4672: .LC_menubuttons_inline_text {
                   4673:   color: $font;
                   4674:   font-family: $sans;
1.698     harmsja  4675:   font-size: 90%;
1.701     harmsja  4676:   padding-left:3px;
1.346     albertel 4677: }
                   4678: 
1.526     www      4679: .LC_menubuttons_link {
                   4680:   text-decoration: none;
                   4681: }
1.698     harmsja  4682: /*2008--9-5: new menu style sheet.Changed category*/
1.522     albertel 4683: .LC_menubuttons_category {
1.521     www      4684:   color: $font;
1.526     www      4685:   background: $pgbg;
1.521     www      4686:   font-family: $sans;
                   4687:   font-size: larger;
                   4688:   font-weight: bold;
                   4689: }
                   4690: 
1.346     albertel 4691: td.LC_menubuttons_text {
1.701     harmsja  4692:  	color: $font; 	
1.346     albertel 4693: }
1.706     harmsja  4694: 
                   4695: 
1.526     www      4696: 
1.346     albertel 4697: .LC_current_location {
                   4698:   font-family: $sans;
                   4699:   background: $tabbg;
                   4700: }
                   4701: .LC_new_mail {
                   4702:   font-family: $sans;
1.634     www      4703:   background: $tabbg;
1.346     albertel 4704:   font-weight: bold;
                   4705: }
1.347     albertel 4706: 
1.526     www      4707: 
1.527     www      4708: .LC_dropadd_labeltext {
                   4709:   font-family: $sans;
                   4710:   text-align: right;
                   4711: }
                   4712: 
                   4713: .LC_preferences_labeltext {
                   4714:   font-family: $sans;
                   4715:   text-align: right;
                   4716: }
                   4717: 
1.666     raeburn  4718: .LC_roleslog_note {
1.701     harmsja  4719:   font-size: small;
1.666     raeburn  4720: }
                   4721: 
1.715     raeburn  4722: .LC_mail_functions {
                   4723:     font-weight: bold;
                   4724: }
                   4725: 
1.440     albertel 4726: table.LC_aboutme_port {
                   4727:   border: 0px;
                   4728:   border-collapse: collapse;
                   4729:   border-spacing: 0px;
                   4730: }
1.349     albertel 4731: table.LC_data_table, table.LC_mail_list {
1.347     albertel 4732:   border: 1px solid #000000;
1.402     albertel 4733:   border-collapse: separate;
1.426     albertel 4734:   border-spacing: 1px;
1.610     albertel 4735:   background: $pgbg;
1.347     albertel 4736: }
1.422     albertel 4737: .LC_data_table_dense {
                   4738:   font-size: small;
                   4739: }
1.507     raeburn  4740: table.LC_nested_outer {
                   4741:   border: 1px solid #000000;
1.589     raeburn  4742:   border-collapse: collapse;
1.507     raeburn  4743:   border-spacing: 0px;
                   4744:   width: 100%;
                   4745: }
                   4746: table.LC_nested {
                   4747:   border: 0px;
1.589     raeburn  4748:   border-collapse: collapse;
1.507     raeburn  4749:   border-spacing: 0px;
                   4750:   width: 100%;
                   4751: }
1.523     albertel 4752: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
                   4753: table.LC_prior_tries tr th {
1.349     albertel 4754:   font-weight: bold;
                   4755:   background-color: $data_table_head;
1.701     harmsja  4756:   font-size:90%;
1.347     albertel 4757: }
1.711     raeburn  4758: table.LC_data_table tr.LC_info_row > td {
                   4759:   background-color: #CCC;
                   4760:   font-weight: bold;
                   4761:   text-align: left;
                   4762: }
1.610     albertel 4763: table.LC_data_table tr.LC_odd_row > td, 
1.709     bisitz   4764: table.LC_pick_box tr > td.LC_odd_row,
1.440     albertel 4765: table.LC_aboutme_port tr td {
1.349     albertel 4766:   background-color: $data_table_light;
1.425     albertel 4767:   padding: 2px;
1.347     albertel 4768: }
1.610     albertel 4769: table.LC_data_table tr.LC_even_row > td,
1.709     bisitz   4770: table.LC_pick_box tr > td.LC_even_row,
1.440     albertel 4771: table.LC_aboutme_port tr.LC_even_row td {
1.349     albertel 4772:   background-color: $data_table_dark;
1.709     bisitz   4773:   padding: 2px;
1.347     albertel 4774: }
1.425     albertel 4775: table.LC_data_table tr.LC_data_table_highlight td {
                   4776:   background-color: $data_table_darker;
                   4777: }
1.639     raeburn  4778: table.LC_data_table tr td.LC_leftcol_header {
                   4779:   background-color: $data_table_head;
                   4780:   font-weight: bold;
                   4781: }
1.451     albertel 4782: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  4783: table.LC_nested tr.LC_empty_row td {
1.347     albertel 4784:   background-color: #FFFFFF;
1.421     albertel 4785:   font-weight: bold;
                   4786:   font-style: italic;
                   4787:   text-align: center;
                   4788:   padding: 8px;
1.347     albertel 4789: }
1.507     raeburn  4790: table.LC_nested tr.LC_empty_row td {
1.465     albertel 4791:   padding: 4ex
                   4792: }
1.507     raeburn  4793: table.LC_nested_outer tr th {
                   4794:   font-weight: bold;
                   4795:   background-color: $data_table_head;
1.701     harmsja  4796:   font-size: small;
1.507     raeburn  4797:   border-bottom: 1px solid #000000;
                   4798: }
                   4799: table.LC_nested_outer tr td.LC_subheader {
                   4800:   background-color: $data_table_head;
                   4801:   font-weight: bold;
                   4802:   font-size: small;
                   4803:   border-bottom: 1px solid #000000;
                   4804:   text-align: right;
1.451     albertel 4805: }
1.507     raeburn  4806: table.LC_nested tr.LC_info_row td {
1.451     albertel 4807:   background-color: #CCC;
                   4808:   font-weight: bold;
                   4809:   font-size: small;
1.507     raeburn  4810:   text-align: center;
                   4811: }
1.589     raeburn  4812: table.LC_nested tr.LC_info_row td.LC_left_item,
                   4813: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  4814:   text-align: left;
1.451     albertel 4815: }
1.507     raeburn  4816: table.LC_nested td {
1.451     albertel 4817:   background-color: #FFF;
                   4818:   font-size: small;
1.507     raeburn  4819: }
                   4820: table.LC_nested_outer tr th.LC_right_item,
                   4821: table.LC_nested tr.LC_info_row td.LC_right_item,
                   4822: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   4823: table.LC_nested tr td.LC_right_item {
1.451     albertel 4824:   text-align: right;
                   4825: }
                   4826: 
1.507     raeburn  4827: table.LC_nested tr.LC_odd_row td {
1.451     albertel 4828:   background-color: #EEE;
                   4829: }
                   4830: 
1.473     raeburn  4831: table.LC_createuser {
                   4832: }
                   4833: 
                   4834: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  4835:   font-size: small;
1.473     raeburn  4836: }
                   4837: 
                   4838: table.LC_createuser tr.LC_info_row td  {
                   4839:   background-color: #CCC;
                   4840:   font-weight: bold;
                   4841:   text-align: center;
                   4842: }
                   4843: 
1.349     albertel 4844: table.LC_calendar {
                   4845:   border: 1px solid #000000;
                   4846:   border-collapse: collapse;
                   4847: }
                   4848: table.LC_calendar_pickdate {
                   4849:   font-size: xx-small;
                   4850: }
                   4851: table.LC_calendar tr td {
                   4852:   border: 1px solid #000000;
                   4853:   vertical-align: top;
                   4854: }
                   4855: table.LC_calendar tr td.LC_calendar_day_empty {
                   4856:   background-color: $data_table_dark;
                   4857: }
                   4858: table.LC_calendar tr td.LC_calendar_day_current {
                   4859:   background-color: $data_table_highlight;
                   4860: }
                   4861: 
                   4862: table.LC_mail_list tr.LC_mail_new {
                   4863:   background-color: $mail_new;
                   4864: }
                   4865: table.LC_mail_list tr.LC_mail_new:hover {
                   4866:   background-color: $mail_new_hover;
                   4867: }
                   4868: table.LC_mail_list tr.LC_mail_read {
                   4869:   background-color: $mail_read;
                   4870: }
                   4871: table.LC_mail_list tr.LC_mail_read:hover {
                   4872:   background-color: $mail_read_hover;
                   4873: }
                   4874: table.LC_mail_list tr.LC_mail_replied {
                   4875:   background-color: $mail_replied;
                   4876: }
                   4877: table.LC_mail_list tr.LC_mail_replied:hover {
                   4878:   background-color: $mail_replied_hover;
                   4879: }
                   4880: table.LC_mail_list tr.LC_mail_other {
                   4881:   background-color: $mail_other;
                   4882: }
                   4883: table.LC_mail_list tr.LC_mail_other:hover {
                   4884:   background-color: $mail_other_hover;
                   4885: }
1.494     raeburn  4886: table.LC_mail_list tr.LC_mail_even {
                   4887: }
                   4888: table.LC_mail_list tr.LC_mail_odd {
                   4889: }
                   4890: 
1.696     bisitz   4891: table.LC_data_table tr > td.LC_browser_file,
                   4892: table.LC_data_table tr > td.LC_browser_file_published {
1.389     albertel 4893:   background: #CCFF88;
                   4894: }
1.696     bisitz   4895: table.LC_data_table tr > td.LC_browser_file_locked,
                   4896: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 4897:   background: #FFAA99;
1.387     albertel 4898: }
1.696     bisitz   4899: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.389     albertel 4900:   background: #AAAAAA;
1.387     albertel 4901: }
1.696     bisitz   4902: table.LC_data_table tr > td.LC_browser_file_modified,
                   4903: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.389     albertel 4904:   background: #FFFF77;
1.387     albertel 4905: }
1.696     bisitz   4906: table.LC_data_table tr.LC_browser_folder > td {
1.389     albertel 4907:   background: #CCCCFF;
1.387     albertel 4908: }
1.696     bisitz   4909: 
1.707     bisitz   4910: table.LC_data_table tr > td.LC_roles_is {
                   4911: /*  background: #77FF77; */
                   4912: }
                   4913: table.LC_data_table tr > td.LC_roles_future {
                   4914:   background: #FFFF77;
                   4915: }
                   4916: table.LC_data_table tr > td.LC_roles_will {
                   4917:   background: #FFAA77;
                   4918: }
                   4919: table.LC_data_table tr > td.LC_roles_expired {
                   4920:   background: #FF7777;
                   4921: }
                   4922: table.LC_data_table tr > td.LC_roles_will_not {
                   4923:   background: #AAFF77;
                   4924: }
                   4925: table.LC_data_table tr > td.LC_roles_selected {
                   4926:   background: #11CC55;
                   4927: }
                   4928: 
1.388     albertel 4929: span.LC_current_location {
1.701     harmsja  4930:   font-size:larger;
1.388     albertel 4931:   background: $pgbg;
                   4932: }
1.387     albertel 4933: 
1.395     albertel 4934: span.LC_parm_menu_item {
                   4935:   font-size: larger;
                   4936:   font-family: $sans;
                   4937: }
                   4938: span.LC_parm_scope_all {
                   4939:   color: red;
                   4940: }
                   4941: span.LC_parm_scope_folder {
                   4942:   color: green;
                   4943: }
                   4944: span.LC_parm_scope_resource {
                   4945:   color: orange;
                   4946: }
                   4947: span.LC_parm_part {
                   4948:   color: blue;
                   4949: }
                   4950: span.LC_parm_folder, span.LC_parm_symb {
                   4951:   font-size: x-small;
                   4952:   font-family: $mono;
                   4953:   color: #AAAAAA;
                   4954: }
                   4955: 
1.396     albertel 4956: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
                   4957: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
                   4958:   border: 1px solid black;
                   4959:   border-collapse: collapse;
                   4960: }
                   4961: table.LC_parm_overview_restrictions td {
                   4962:   border-width: 1px 4px 1px 4px;
                   4963:   border-style: solid;
                   4964:   border-color: $pgbg;
                   4965:   text-align: center;
                   4966: }
                   4967: table.LC_parm_overview_restrictions th {
                   4968:   background: $tabbg;
                   4969:   border-width: 1px 4px 1px 4px;
                   4970:   border-style: solid;
                   4971:   border-color: $pgbg;
                   4972: }
1.398     albertel 4973: table#LC_helpmenu {
                   4974:   border: 0px;
                   4975:   height: 55px;
                   4976:   border-spacing: 0px;
                   4977: }
                   4978: 
                   4979: table#LC_helpmenu fieldset legend {
                   4980:   font-size: larger;
                   4981:   font-weight: bold;
                   4982: }
1.397     albertel 4983: table#LC_helpmenu_links {
                   4984:   width: 100%;
                   4985:   border: 1px solid black;
                   4986:   background: $pgbg;
                   4987:   padding: 0px;
                   4988:   border-spacing: 1px;
                   4989: }
                   4990: table#LC_helpmenu_links tr td {
                   4991:   padding: 1px;
                   4992:   background: $tabbg;
1.399     albertel 4993:   text-align: center;
                   4994:   font-weight: bold;
1.397     albertel 4995: }
1.396     albertel 4996: 
1.397     albertel 4997: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
                   4998: table#LC_helpmenu_links a:active {
                   4999:   text-decoration: none;
                   5000:   color: $font;
                   5001: }
                   5002: table#LC_helpmenu_links a:hover {
                   5003:   text-decoration: underline;
                   5004:   color: $vlink;
                   5005: }
1.396     albertel 5006: 
1.417     albertel 5007: .LC_chrt_popup_exists {
                   5008:   border: 1px solid #339933;
                   5009:   margin: -1px;
                   5010: }
                   5011: .LC_chrt_popup_up {
                   5012:   border: 1px solid yellow;
                   5013:   margin: -1px;
                   5014: }
                   5015: .LC_chrt_popup {
                   5016:   border: 1px solid #8888FF;
                   5017:   background: #CCCCFF;
                   5018: }
1.421     albertel 5019: table.LC_pick_box {
                   5020:   border-collapse: separate;
                   5021:   background: white;
                   5022:   border: 1px solid black;
                   5023:   border-spacing: 1px;
                   5024: }
                   5025: table.LC_pick_box td.LC_pick_box_title {
                   5026:   background: $tabbg;
                   5027:   font-weight: bold;
                   5028:   text-align: right;
                   5029:   width: 184px;
                   5030:   padding: 8px;
                   5031: }
1.645     raeburn  5032: table.LC_pick_box td.LC_selfenroll_pick_box_title {
                   5033:   background: $tabbg;
                   5034:   font-weight: bold;
                   5035:   text-align: right;
                   5036:   width: 350px;
                   5037:   padding: 8px;
                   5038: }
                   5039: 
1.579     raeburn  5040: table.LC_pick_box td.LC_pick_box_value {
                   5041:   text-align: left;
                   5042:   padding: 8px;
                   5043: }
                   5044: table.LC_pick_box td.LC_pick_box_select {
                   5045:   text-align: left;
                   5046:   padding: 8px;
                   5047: }
1.424     albertel 5048: table.LC_pick_box td.LC_pick_box_separator {
1.421     albertel 5049:   padding: 0px;
                   5050:   height: 1px;
                   5051:   background: black;
                   5052: }
                   5053: table.LC_pick_box td.LC_pick_box_submit {
                   5054:   text-align: right;
                   5055: }
1.579     raeburn  5056: table.LC_pick_box td.LC_evenrow_value {
                   5057:   text-align: left;
                   5058:   padding: 8px;
                   5059:   background-color: $data_table_light;
                   5060: }
                   5061: table.LC_pick_box td.LC_oddrow_value {
                   5062:   text-align: left;
                   5063:   padding: 8px;
                   5064:   background-color: $data_table_light;
                   5065: }
                   5066: table.LC_helpform_receipt {
                   5067:   width: 620px;
                   5068:   border-collapse: separate;
                   5069:   background: white;
                   5070:   border: 1px solid black;
                   5071:   border-spacing: 1px;
                   5072: }
                   5073: table.LC_helpform_receipt td.LC_pick_box_title {
                   5074:   background: $tabbg;
                   5075:   font-weight: bold;
                   5076:   text-align: right;
                   5077:   width: 184px;
                   5078:   padding: 8px;
                   5079: }
                   5080: table.LC_helpform_receipt td.LC_evenrow_value {
                   5081:   text-align: left;
                   5082:   padding: 8px;
                   5083:   background-color: $data_table_light;
                   5084: }
                   5085: table.LC_helpform_receipt td.LC_oddrow_value {
                   5086:   text-align: left;
                   5087:   padding: 8px;
                   5088:   background-color: $data_table_light;
                   5089: }
                   5090: table.LC_helpform_receipt td.LC_pick_box_separator {
                   5091:   padding: 0px;
                   5092:   height: 1px;
                   5093:   background: black;
                   5094: }
                   5095: span.LC_helpform_receipt_cat {
                   5096:   font-weight: bold;
                   5097: }
1.424     albertel 5098: table.LC_group_priv_box {
                   5099:   background: white;
                   5100:   border: 1px solid black;
                   5101:   border-spacing: 1px;
                   5102: }
                   5103: table.LC_group_priv_box td.LC_pick_box_title {
                   5104:   background: $tabbg;
                   5105:   font-weight: bold;
                   5106:   text-align: right;
                   5107:   width: 184px;
                   5108: }
                   5109: table.LC_group_priv_box td.LC_groups_fixed {
                   5110:   background: $data_table_light;
                   5111:   text-align: center;
                   5112: }
                   5113: table.LC_group_priv_box td.LC_groups_optional {
                   5114:   background: $data_table_dark;
                   5115:   text-align: center;
                   5116: }
                   5117: table.LC_group_priv_box td.LC_groups_functionality {
                   5118:   background: $data_table_darker;
                   5119:   text-align: center;
                   5120:   font-weight: bold;
                   5121: }
                   5122: table.LC_group_priv td {
                   5123:   text-align: left;
                   5124:   padding: 0px;
                   5125: }
                   5126: 
1.421     albertel 5127: table.LC_notify_front_page {
                   5128:   background: white;
                   5129:   border: 1px solid black;
                   5130:   padding: 8px;
                   5131: }
                   5132: table.LC_notify_front_page td {
                   5133:   padding: 8px;
                   5134: }
1.424     albertel 5135: .LC_navbuttons {
                   5136:   margin: 2ex 0ex 2ex 0ex;
                   5137: }
1.423     albertel 5138: .LC_topic_bar {
                   5139:   font-family: $sans;
                   5140:   font-weight: bold;
                   5141:   width: 100%;
                   5142:   background: $tabbg;
                   5143:   vertical-align: middle;
                   5144:   margin: 2ex 0ex 2ex 0ex;
                   5145: }
                   5146: .LC_topic_bar span {
                   5147:   vertical-align: middle;
                   5148: }
                   5149: .LC_topic_bar img {
                   5150:   vertical-align: bottom;
                   5151: }
                   5152: table.LC_course_group_status {
                   5153:   margin: 20px;
                   5154: }
                   5155: table.LC_status_selector td {
                   5156:   vertical-align: top;
                   5157:   text-align: center;
1.424     albertel 5158:   padding: 4px;
                   5159: }
                   5160: table.LC_descriptive_input td.LC_description {
                   5161:   vertical-align: top;
                   5162:   text-align: right;
                   5163:   font-weight: bold;
1.423     albertel 5164: }
1.599     albertel 5165: div.LC_feedback_link {
1.616     albertel 5166:   clear: both;
1.599     albertel 5167:   background: white;
                   5168:   width: 100%;  
1.489     raeburn  5169: }
                   5170: span.LC_feedback_link {
1.599     albertel 5171:   background: $feedback_link_bg;
                   5172:   font-size: larger;
                   5173: }
                   5174: span.LC_message_link {
                   5175:   background: $feedback_link_bg;
                   5176:   font-size: larger;
                   5177:   position: absolute;
                   5178:   right: 1em;
1.489     raeburn  5179: }
1.421     albertel 5180: 
1.515     albertel 5181: table.LC_prior_tries {
1.524     albertel 5182:   border: 1px solid #000000;
                   5183:   border-collapse: separate;
                   5184:   border-spacing: 1px;
1.515     albertel 5185: }
1.523     albertel 5186: 
1.515     albertel 5187: table.LC_prior_tries td {
1.524     albertel 5188:   padding: 2px;
1.515     albertel 5189: }
1.523     albertel 5190: 
                   5191: .LC_answer_correct {
                   5192:   background: #AAFFAA;
                   5193:   color: black;
                   5194: }
                   5195: .LC_answer_charged_try {
                   5196:   background: #FFAAAA ! important;
                   5197:   color: black;
                   5198: }
                   5199: .LC_answer_not_charged_try, 
                   5200: .LC_answer_no_grade,
                   5201: .LC_answer_late {
                   5202:   background: #FFFFAA;
                   5203:   color: black;
                   5204: }
                   5205: .LC_answer_previous {
                   5206:   background: #AAAAFF;
                   5207:   color: black;
                   5208: }
                   5209: .LC_answer_no_message {
                   5210:   background: #FFFFFF;
                   5211:   color: black;
                   5212: }
                   5213: .LC_answer_unknown {
                   5214:   background: orange;
                   5215:   color: black;
                   5216: }
                   5217: 
                   5218: 
1.529     albertel 5219: span.LC_prior_numerical,
                   5220: span.LC_prior_string,
                   5221: span.LC_prior_custom,
                   5222: span.LC_prior_reaction,
                   5223: span.LC_prior_math {
1.523     albertel 5224:   font-family: monospace;
                   5225:   white-space: pre;
                   5226: }
                   5227: 
1.525     albertel 5228: span.LC_prior_string {
                   5229:   font-family: monospace;
                   5230:   white-space: pre;
                   5231: }
                   5232: 
1.523     albertel 5233: table.LC_prior_option {
                   5234:   width: 100%;
                   5235:   border-collapse: collapse;
                   5236: }
1.528     albertel 5237: table.LC_prior_rank, table.LC_prior_match {
                   5238:   border-collapse: collapse;
                   5239: }
                   5240: table.LC_prior_option tr td,
                   5241: table.LC_prior_rank tr td,
                   5242: table.LC_prior_match tr td {
1.524     albertel 5243:   border: 1px solid #000000;
1.515     albertel 5244: }
                   5245: 
1.519     raeburn  5246: span.LC_nobreak {
1.544     albertel 5247:   white-space: nowrap;
1.519     raeburn  5248: }
                   5249: 
1.576     raeburn  5250: span.LC_cusr_emph {
                   5251:   font-style: italic;
                   5252: }
                   5253: 
1.633     raeburn  5254: span.LC_cusr_subheading {
                   5255:   font-weight: normal;
                   5256:   font-size: 85%;
                   5257: }
                   5258: 
1.545     albertel 5259: table.LC_docs_documents {
                   5260:   background: #BBBBBB;
1.547     albertel 5261:   border-width: 0px;
1.545     albertel 5262:   border-collapse: collapse;
                   5263: }
                   5264: 
                   5265: table.LC_docs_documents td.LC_docs_document {
                   5266:   border: 2px solid black;
                   5267:   padding: 4px;
                   5268: }
                   5269: 
                   5270: .LC_docs_course_commands div {
                   5271:   float: left;
                   5272:   border: 4px solid #AAAAAA;
                   5273:   padding: 4px;
                   5274:   background: #DDDDCC;
                   5275: }
                   5276: 
                   5277: .LC_docs_entry_move {
                   5278:   border: 0px;
                   5279:   border-collapse: collapse;
1.544     albertel 5280: }
                   5281: 
1.545     albertel 5282: .LC_docs_entry_move td {
                   5283:   border: 2px solid #BBBBBB;
                   5284:   background: #DDDDDD;
                   5285: }
                   5286: 
                   5287: .LC_docs_editor td.LC_docs_entry_commands {
                   5288:   background: #DDDDDD;
                   5289:   font-size: x-small;
                   5290: }
1.544     albertel 5291: .LC_docs_copy {
1.545     albertel 5292:   color: #000099;
1.544     albertel 5293: }
                   5294: .LC_docs_cut {
1.545     albertel 5295:   color: #550044;
1.544     albertel 5296: }
                   5297: .LC_docs_rename {
1.545     albertel 5298:   color: #009900;
1.544     albertel 5299: }
                   5300: .LC_docs_remove {
1.545     albertel 5301:   color: #990000;
                   5302: }
                   5303: 
1.547     albertel 5304: .LC_docs_reinit_warn,
                   5305: .LC_docs_ext_edit {
                   5306:   font-size: x-small;
                   5307: }
                   5308: 
1.545     albertel 5309: .LC_docs_editor td.LC_docs_entry_title,
                   5310: .LC_docs_editor td.LC_docs_entry_icon {
                   5311:   background: #FFFFBB;
                   5312: }
                   5313: .LC_docs_editor td.LC_docs_entry_parameter {
                   5314:   background: #BBBBFF;
                   5315:   font-size: x-small;
                   5316:   white-space: nowrap;
                   5317: }
                   5318: 
                   5319: table.LC_docs_adddocs td,
                   5320: table.LC_docs_adddocs th {
                   5321:   border: 1px solid #BBBBBB;
                   5322:   padding: 4px;
                   5323:   background: #DDDDDD;
1.543     albertel 5324: }
                   5325: 
1.584     albertel 5326: table.LC_sty_begin {
                   5327:   background: #BBFFBB;
                   5328: }
                   5329: table.LC_sty_end {
                   5330:   background: #FFBBBB;
                   5331: }
                   5332: 
1.589     raeburn  5333: table.LC_double_column {
                   5334:   border-width: 0px;
                   5335:   border-collapse: collapse;
                   5336:   width: 100%;
                   5337:   padding: 2px;
                   5338: }
                   5339: 
                   5340: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  5341:   top: 2px;
1.589     raeburn  5342:   left: 2px;
                   5343:   width: 47%;
                   5344:   vertical-align: top;
                   5345: }
                   5346: 
                   5347: table.LC_double_column tr td.LC_right_col {
                   5348:   top: 2px;
                   5349:   right: 2px; 
                   5350:   width: 47%;
                   5351:   vertical-align: top;
                   5352: }
                   5353: 
1.594     raeburn  5354: span.LC_role_level {
                   5355:   font-weight: bold;
                   5356: }
                   5357: 
1.591     raeburn  5358: div.LC_left_float {
                   5359:   float: left;
                   5360:   padding-right: 5%;
1.597     albertel 5361:   padding-bottom: 4px;
1.591     raeburn  5362: }
                   5363: 
                   5364: div.LC_clear_float_header {
1.597     albertel 5365:   padding-bottom: 2px;
1.591     raeburn  5366: }
                   5367: 
                   5368: div.LC_clear_float_footer {
1.597     albertel 5369:   padding-top: 10px;
1.591     raeburn  5370:   clear: both;
                   5371: }
                   5372: 
1.597     albertel 5373: 
                   5374: div.LC_grade_show_user {
                   5375:   margin-top: 20px;
                   5376:   border: 1px solid black;
                   5377: }
                   5378: div.LC_grade_user_name {
                   5379:   background: #DDDDEE;
                   5380:   border-bottom: 1px solid black;
1.705     tempelho 5381:   font-weight: bold;
                   5382:   font-size: large;
1.597     albertel 5383: }
                   5384: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
                   5385:   background: #DDEEDD;
                   5386: }
                   5387: 
                   5388: div.LC_grade_show_problem,
                   5389: div.LC_grade_submissions,
                   5390: div.LC_grade_message_center,
                   5391: div.LC_grade_info_links,
                   5392: div.LC_grade_assign {
                   5393:   margin: 5px;
                   5394:   width: 99%;
                   5395:   background: #FFFFFF;
                   5396: }
                   5397: div.LC_grade_show_problem_header,
                   5398: div.LC_grade_submissions_header,
                   5399: div.LC_grade_message_center_header,
                   5400: div.LC_grade_assign_header {
1.705     tempelho 5401:   font-weight: bold;
                   5402:   font-size: large;
1.597     albertel 5403: }
                   5404: div.LC_grade_show_problem_problem,
                   5405: div.LC_grade_submissions_body,
                   5406: div.LC_grade_message_center_body,
                   5407: div.LC_grade_assign_body {
                   5408:   border: 1px solid black;
                   5409:   width: 99%;
                   5410:   background: #FFFFFF;
                   5411: }
1.598     albertel 5412: span.LC_grade_check_note {
1.705     tempelho 5413:   font-weight: normal;
                   5414:   font-size: medium;
1.598     albertel 5415:   display: inline;
                   5416:   position: absolute;
                   5417:   right: 1em;
                   5418: }
1.597     albertel 5419: 
1.613     albertel 5420: table.LC_scantron_action {
                   5421:   width: 100%;
                   5422: }
                   5423: table.LC_scantron_action tr th {
1.698     harmsja  5424:   font-weight:bold;
                   5425:   font-style:normal;
1.613     albertel 5426: }
1.698     harmsja  5427: .LC_edit_problem_header, 
1.614     albertel 5428: div.LC_edit_problem_footer {
1.705     tempelho 5429:   font-weight: normal;
                   5430:   font-size:  medium;
1.602     albertel 5431:   margin: 2px;
1.600     albertel 5432: }
                   5433: div.LC_edit_problem_header,
1.602     albertel 5434: div.LC_edit_problem_header div,
1.614     albertel 5435: div.LC_edit_problem_footer,
                   5436: div.LC_edit_problem_footer div,
1.602     albertel 5437: div.LC_edit_problem_editxml_header,
                   5438: div.LC_edit_problem_editxml_header div {
1.600     albertel 5439:   margin-top: 5px;
                   5440: }
1.602     albertel 5441: div.LC_edit_problem_header_edit_row {
                   5442:   background: $tabbg;
                   5443:   padding: 3px;
                   5444:   margin-bottom: 5px;
                   5445: }
1.600     albertel 5446: div.LC_edit_problem_header_title {
1.705     tempelho 5447:   font-weight: bold;
                   5448:   font-size: larger;
1.602     albertel 5449:   background: $tabbg;
                   5450:   padding: 3px;
                   5451: }
                   5452: table.LC_edit_problem_header_title {
1.705     tempelho 5453:   font-size: larger;
                   5454:   font-weight:  bold;
1.602     albertel 5455:   width: 100%;
                   5456:   border-color: $pgbg;
                   5457:   border-style: solid;
                   5458:   border-width: $border;
                   5459: 
1.600     albertel 5460:   background: $tabbg;
1.602     albertel 5461:   border-collapse: collapse;
                   5462:   padding: 0px
                   5463: }
                   5464: 
                   5465: div.LC_edit_problem_discards {
                   5466:   float: left;
                   5467:   padding-bottom: 5px;
                   5468: }
                   5469: div.LC_edit_problem_saves {
                   5470:   float: right;
                   5471:   padding-bottom: 5px;
1.600     albertel 5472: }
                   5473: hr.LC_edit_problem_divide {
1.602     albertel 5474:   clear: both;
1.600     albertel 5475:   color: $tabbg;
                   5476:   background-color: $tabbg;
                   5477:   height: 3px;
                   5478:   border: 0px;
                   5479: }
1.679     riegler  5480: img.stift{
1.678     riegler  5481:   border-width:0;
1.679     riegler  5482:   vertical-align:middle;
1.677     riegler  5483: }
1.680     riegler  5484: 
1.681     riegler  5485: table#LC_mainmenu{
                   5486:  margin-top:10px;
                   5487:  width:80%;
                   5488: 
                   5489: }
                   5490: 
1.680     riegler  5491: table#LC_mainmenu td.LC_mainmenu_col_fieldset{
                   5492:   vertical-align: top;
                   5493:   width: 45%;
                   5494: }
                   5495: .LC_mainmenu_fieldset_category {
                   5496:   color: $font;
                   5497:   background: $pgbg;
                   5498:   font-family: $sans;
                   5499:   font-size: small;
                   5500:   font-weight: bold;
                   5501: }
                   5502: 
1.716     raeburn  5503: div.LC_createcourse {
                   5504:     margin: 10px 10px 10px 10px;
                   5505: }
                   5506: 
1.693     droeschl 5507: /* ---- Remove when done ----
                   5508: # The following styles is part of the redesign of LON-CAPA and are
                   5509: # subject to change during this project.
                   5510: # Don't rely on their current functionality as they might be 
                   5511: # changed or removed.
                   5512: # --------------------------*/
                   5513: 
1.698     harmsja  5514: a:hover,
1.721     harmsja  5515: ol.LC_smallMenu a:hover,
                   5516: ol#LC_MenuBreadcrumbs a:hover,
                   5517: ol#LC_PathBreadcrumbs a:hover,
                   5518: ul#LC_TabMainMenuContent a:hover,
                   5519: .LC_FormSectionClearButton input:hover
                   5520: ul.LC_TabContent   li:hover a{
1.698     harmsja  5521: 	color:#BF2317;
                   5522:         text-decoration:none;
1.693     droeschl 5523: }
                   5524: 
                   5525: h1 { 
1.721     harmsja  5526: 	padding:5px 10px 5px 20px;
1.693     droeschl 5527: 	line-height:130%;
                   5528: }
1.698     harmsja  5529: 
1.693     droeschl 5530: h2,h3,h4,h5,h6
                   5531: {
1.721     harmsja  5532: 	margin:5px 0px 5px 0px;
                   5533: 	padding:0px;
                   5534: 	line-height:130%;
1.693     droeschl 5535: }
1.721     harmsja  5536: .LC_hcell{
1.698     harmsja  5537:         padding:3px 15px 3px 15px;
                   5538:         margin:0px;
1.703     harmsja  5539: 	background-color:$tabbg;
                   5540: 	border-bottom:solid 1px $lg_border_color;       
1.693     droeschl 5541: }
1.721     harmsja  5542: .LC_noBorder {
1.698     harmsja  5543:         border:0px;
                   5544: }
1.693     droeschl 5545: 
1.722     harmsja  5546: .LC_bgLightGrey{
1.723     riegler  5547: 	background:URL(/adm/lonIcons/lightGreyBG.png) repeat-x left top; 
1.722     harmsja  5548: }
                   5549: .LC_bgLightGreyYellow {
                   5550: 	background-color:#EFECE0;
                   5551: }
1.693     droeschl 5552: 
1.698     harmsja  5553: /* Main Header with discription of Person, Course, etc. */
1.721     harmsja  5554: .LC_HeadRight {
1.693     droeschl 5555: 	text-align: right;
                   5556: 	float: right;
                   5557: 	margin: 0px;
                   5558: 	padding: 0px;
1.698     harmsja  5559:         right:0;
1.693     droeschl 5560:         position:absolute;
1.698     harmsja  5561:         overflow:hidden;
1.693     droeschl 5562: }
                   5563: 
1.721     harmsja  5564: p, .LC_ContentBox {
1.698     harmsja  5565: 	padding: 10px;
                   5566: 
                   5567: }
1.721     harmsja  5568: .LC_FormSectionClearButton input {
                   5569:     	    
1.698     harmsja  5570:         border:0px;
                   5571:         cursor:pointer;
                   5572:         text-decoration:underline;
1.693     droeschl 5573: }
                   5574: 
                   5575: 
1.698     harmsja  5576: dl,ul,div,fieldset {
                   5577: 	margin: 10px 10px 10px 0px;
1.693     droeschl 5578: 	overflow:hidden;
                   5579: }
1.721     harmsja  5580: ol.LC_smallMenu, ol#LC_PathBreadcrumbs {
1.698     harmsja  5581: 	margin: 0px;
1.693     droeschl 5582: }
                   5583: 
1.721     harmsja  5584: ol.LC_smallMenu li {
1.693     droeschl 5585: 	display: inline;
                   5586: 	padding: 5px 5px 0px 10px;
                   5587: 	vertical-align: top;
                   5588: }
                   5589: 
1.721     harmsja  5590: ol.LC_smallMenu li img {
1.693     droeschl 5591: 	vertical-align: bottom;
                   5592: }
                   5593: 
1.721     harmsja  5594: ol.LC_smallMenu a {
1.693     droeschl 5595: 	font-size: 90%;
                   5596: 	color: RGB(80, 80, 80);
                   5597: 	text-decoration: none;
                   5598: }
                   5599: 
1.721     harmsja  5600: ol#LC_TabMainMenuContent {
                   5601: 	display:block;
                   5602: 	list-style:none;
1.693     droeschl 5603: 	margin: 0px 0px 10px 0px;
                   5604: 	padding: 0px;
                   5605: }
                   5606: 
1.721     harmsja  5607: ol#LC_TabMainMenuContent li {
1.693     droeschl 5608: 	display: inline;
                   5609: 	vertical-align: bottom;
                   5610: 	border-bottom: solid 1px RGB(175, 175, 175);
                   5611: 	border-right: solid 1px RGB(175, 175, 175);
1.721     harmsja  5612: 	padding: 5px 10px 5px 10px;
                   5613: 	margin-right:3px;
1.693     droeschl 5614: 	line-height: 140%;
                   5615: 	font-weight: bold;
1.721     harmsja  5616: 	white-space:nowrap;
1.723     riegler  5617: 	background: url(/adm/lonIcons/lightGreyBG.png) repeat-x left top;
1.693     droeschl 5618: }
                   5619: 
1.721     harmsja  5620: ol#LC_TabMainMenuContent li a{
1.693     droeschl 5621: 	color: RGB(47, 47, 47);
                   5622: 	text-decoration: none;
                   5623: }
1.721     harmsja  5624: ul.LC_TabContent {
                   5625: 	margin:0px;
                   5626: 	padding:0px;
                   5627: 	display:block;
                   5628: 	list-style:none;
                   5629: 	min-height:1.5em;
                   5630: }
                   5631: ul.LC_TabContent li{
                   5632: 	display:inline;
                   5633: 	vertical-align:top;
                   5634: 	border-bottom:solid 1px $lg_border_color;
                   5635: 	border-right:solid 1px $lg_border_color;
                   5636: 	padding:5px 10px 5px 10px;
                   5637: 	margin-right:2px;
1.723     riegler  5638: 	background: url(/adm/lonIcons/lightGreyBG.png) repeat-x left top;
1.721     harmsja  5639: }
                   5640: ul.LC_TabContent li a, ul.LC_TabContent li{
                   5641: 	color:rgb(47,47,47);
                   5642: 	text-decoration:none;
                   5643: 	font-size:95%;
                   5644: 	font-weight:bold;
                   5645: 	white-space:nowrap;
                   5646: }
                   5647: .LC_hideThis
                   5648: {
                   5649: 	display:none;
                   5650: 	visibility:hidden;
1.693     droeschl 5651: }
                   5652: 
1.721     harmsja  5653: ol#LC_MenuBreadcrumbs, ol#LC_PathBreadcrumbs {
1.693     droeschl 5654: 	border-top: solid 1px RGB(255, 255, 255);
                   5655: 	height: 20px;
                   5656: 	line-height: 20px;
                   5657: 	vertical-align: bottom;
                   5658: 	margin: 0px 0px 30px 0px;
                   5659: 	padding-left: 10px;
                   5660: 	list-style-position: inside;
1.723     riegler  5661: 	background: url(/adm/lonIcons/lightGreyBG.png) repeat-x left top;
1.693     droeschl 5662: }
                   5663: 
1.721     harmsja  5664: ol#LC_MenuBreadcrumbs li, ol#LC_PathBreadcrumbs li {
1.723     riegler  5665: 	background: url(/adm/lonIcons/arrow_white.png) no-repeat left center;
1.693     droeschl 5666: 	display: inline;
                   5667: 	padding: 0px 0px 0px 10px;
                   5668: 	vertical-align: bottom;
                   5669: 	overflow:hidden;
                   5670: }
                   5671: 
1.721     harmsja  5672: ol#LC_MenuBreadcrumbs li a {
1.693     droeschl 5673: 	text-decoration: none;
                   5674: 	font-size:90%;
                   5675: }
1.721     harmsja  5676: ol#LC_PathBreadcrumbs li a{
1.698     harmsja  5677: 	text-decoration:none;
                   5678: 	font-size:100%;
                   5679: 	font-weight:bold;
1.693     droeschl 5680: }
1.721     harmsja  5681: .LC_ContentBoxSpecial
1.693     droeschl 5682: {
1.701     harmsja  5683: 	border: solid 1px $lg_border_color;
1.698     harmsja  5684: }
1.721     harmsja  5685: .LC_PopUp
1.693     droeschl 5686: {
1.698     harmsja  5687: 	padding:10px;
                   5688: 	border-left:solid 1px $lg_border_color;
                   5689:  	border-top:solid 1px $lg_border_color;
                   5690: 	border-bottom:outset 1px $lg_border_color;
                   5691: 	border-right:outset 1px $lg_border_color;
                   5692: 	display:none;
                   5693: 	position:absolute;
                   5694: 	right:0;
                   5695: 	background-color:white;
                   5696: 	z-index:5;
1.693     droeschl 5697: }
                   5698: 
1.721     harmsja  5699: dl.LC_ListStyleClean dt {
1.693     droeschl 5700: 	padding-right: 5px;
                   5701: 	display: table-header-group;
                   5702: }
                   5703: 
1.721     harmsja  5704: dl.LC_ListStyleClean dd {
1.693     droeschl 5705: 	display: table-row;
                   5706: }
                   5707: 
1.721     harmsja  5708: .LC_ListStyleClean,
                   5709: .LC_ListStyleSimple,
                   5710: .LC_ListStyleNormal,
                   5711: .LC_ListStyleNormal_Border,
                   5712: .LC_ListStyleSpecial
1.693     droeschl 5713: 	{
                   5714: 	/*display:block;	*/
                   5715: 	list-style-position: inside;
                   5716: 	list-style-type: none;
                   5717: 	overflow: hidden;
                   5718: 	padding: 0px;
                   5719: }
                   5720: 
1.721     harmsja  5721: .LC_ListStyleSimple li,
                   5722: .LC_ListStyleSimple dd,
                   5723: .LC_ListStyleNormal li,
                   5724: .LC_ListStyleNormal dd,
                   5725: .LC_ListStyleSpecial li,
                   5726: .LC_ListStyleSpecial dd
1.693     droeschl 5727: 	{
                   5728: 	margin: 0px;
                   5729: 	padding: 5px 5px 5px 10px;
                   5730: 	clear: both;
                   5731: }
                   5732: 
1.721     harmsja  5733: .LC_ListStyleClean li,
                   5734: .LC_ListStyleClean dd {
1.693     droeschl 5735: 	padding-top: 0px;
                   5736: 	padding-bottom: 0px;
                   5737: }
                   5738: 
1.721     harmsja  5739: .LC_ListStyleSimple dd,
                   5740: .LC_ListStyleSimple li{
1.698     harmsja  5741: 	border-bottom: solid 1px $lg_border_color;
1.693     droeschl 5742: }
                   5743: 
1.721     harmsja  5744: .LC_ListStyleSpecial li,
                   5745: .LC_ListStyleSpecial dd {
1.693     droeschl 5746: 	list-style-type: none;
                   5747: 	background-color: RGB(220, 220, 220);
                   5748: 	margin-bottom: 4px;
                   5749: }
                   5750: 
1.721     harmsja  5751: table.LC_SimpleTable {
1.698     harmsja  5752: 	margin:5px;
                   5753: 	border:solid 1px $lg_border_color;
1.693     droeschl 5754: 	}
                   5755: 
1.721     harmsja  5756: table.LC_SimpleTable tr {
1.698     harmsja  5757: 	padding:0px;
                   5758: 	border:solid 1px $lg_border_color;
1.693     droeschl 5759: }
1.721     harmsja  5760: table.LC_SimpleTable thead{
1.698     harmsja  5761: 	 background:rgb(220,220,220);
1.693     droeschl 5762: }
                   5763: 
1.721     harmsja  5764: div.LC_columnSection {
1.693     droeschl 5765: 	display: block;
                   5766: 	clear: both;
                   5767: 	overflow: hidden;
                   5768: 	margin:0px;
                   5769: }
                   5770: 
1.721     harmsja  5771: div.LC_columnSection>* {
1.693     droeschl 5772: 	float: left;
                   5773: 	margin: 10px 20px 10px 0px;
                   5774: 	overflow:hidden;	
                   5775: }
1.721     harmsja  5776: div.LC_columnSection > .LC_ContentBox,
                   5777: div.LC_columnSection > .LC_ContentBoxSpecial
1.693     droeschl 5778: 	{
1.721     harmsja  5779: 	width: 400px;	
1.693     droeschl 5780: }
1.721     harmsja  5781: 
1.719     ehlerst  5782: .ContentBoxSpecialTemplate
                   5783: {
                   5784:         border: solid 1px $lg_border_color;
                   5785: }
                   5786: .ContentBoxTemplate {
                   5787:         padding:10px;
                   5788: }
                   5789: 
1.721     harmsja  5790: div.LC_columnSection > .ContentBoxTemplate,
                   5791: div.LC_columnSection > .ContentBoxSpecialTemplate
1.719     ehlerst  5792:         {
                   5793:         width: 600px;
                   5794: 
                   5795: }
                   5796: 
1.720     ehlerst  5797: .clear{
                   5798: 	clear: both;
                   5799: 	line-height: 0px;
                   5800: 	font-size: 0px;
                   5801: 	height: 0px;
                   5802: }
1.693     droeschl 5803: 
1.694     tempelho 5804: .LC_loginpage_container {
                   5805: 	text-align:left;
                   5806: 	margin : 0 auto;
                   5807: 	width:65%;
                   5808: 	padding: 10px;
                   5809: 	height: auto;
1.712     muellerd 5810: 	background-color:#FFFFFF;
1.694     tempelho 5811: 	border:1px solid #CCCCCC;
                   5812: }
                   5813: 
                   5814: 
                   5815: .LC_loginpage_loginContainer {
                   5816: 	float:left;
1.712     muellerd 5817: 	width: 182px;
                   5818: 	border:1px solid #CCCCCC;
                   5819: 	background-color:$loginbg;
1.694     tempelho 5820: }
                   5821: 
1.717     tempelho 5822: .LC_loginpage_loginContainer h2{
1.712     muellerd 5823: 	margin-top:0;
                   5824: 	display:block;
                   5825: 	background:$bgcol;
                   5826: 	color:$textcol;
                   5827: 	padding-left:5px;
                   5828: }
1.694     tempelho 5829: .LC_loginpage_loginInfo {
                   5830: 	margin-left:20px;
                   5831: 	float:left;
                   5832: 	width:30%;
                   5833: 	border:1px solid #CCCCCC;
                   5834: 	padding:10px;
                   5835: }
                   5836: 
1.712     muellerd 5837: .LC_loginpage_loginDomain {
                   5838: 	margin-right:20px;
                   5839: 	width:20%;
                   5840: 	float:left;
                   5841: 	padding:10px;
                   5842: }
                   5843: 
1.694     tempelho 5844: .LC_loginpage_space {
                   5845: 	clear:both;
                   5846: 	margin-bottom:20px;
                   5847: 	border-bottom: 1px solid #CCCCCC;
                   5848: }
                   5849: 
                   5850: .LC_loginpage_fieldset{
                   5851: 	border: 1px solid #CCCCCC;
                   5852: 	margin: 0 auto;
                   5853: }
                   5854: 
                   5855: .LC_loginpage_legend{
                   5856: 	padding: 2px;
                   5857: 	margin: 0px;
                   5858: 	font-size:14px;
                   5859: 	font-weight:bold;
                   5860: }
                   5861: 
                   5862: 
1.343     albertel 5863: END
                   5864: }
                   5865: 
1.306     albertel 5866: =pod
                   5867: 
                   5868: =item * &headtag()
                   5869: 
                   5870: Returns a uniform footer for LON-CAPA web pages.
                   5871: 
1.307     albertel 5872: Inputs: $title - optional title for the head
                   5873:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 5874:         $args - optional arguments
1.319     albertel 5875:             force_register - if is true call registerurl so the remote is 
                   5876:                              informed
1.415     albertel 5877:             redirect       -> array ref of
                   5878:                                    1- seconds before redirect occurs
                   5879:                                    2- url to redirect to
                   5880:                                    3- whether the side effect should occur
1.315     albertel 5881:                            (side effect of setting 
                   5882:                                $env{'internal.head.redirect'} to the url 
                   5883:                                redirected too)
1.352     albertel 5884:             domain         -> force to color decorate a page for a specific
                   5885:                                domain
                   5886:             function       -> force usage of a specific rolish color scheme
                   5887:             bgcolor        -> override the default page bgcolor
1.460     albertel 5888:             no_auto_mt_title
                   5889:                            -> prevent &mt()ing the title arg
1.464     albertel 5890: 
1.306     albertel 5891: =cut
                   5892: 
                   5893: sub headtag {
1.313     albertel 5894:     my ($title,$head_extra,$args) = @_;
1.306     albertel 5895:     
1.363     albertel 5896:     my $function = $args->{'function'} || &get_users_function();
                   5897:     my $domain   = $args->{'domain'}   || &determinedomain();
                   5898:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 5899:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 5900: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 5901: 		   #time(),
1.418     albertel 5902: 		   $env{'environment.color.timestamp'},
1.363     albertel 5903: 		   $function,$domain,$bgcolor);
                   5904: 
1.369     www      5905:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 5906: 
1.308     albertel 5907:     my $result =
                   5908: 	'<head>'.
1.461     albertel 5909: 	&font_settings();
1.319     albertel 5910: 
1.461     albertel 5911:     if (!$args->{'frameset'}) {
                   5912: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   5913:     }
1.319     albertel 5914:     if ($args->{'force_register'}) {
                   5915: 	$result .= &Apache::lonmenu::registerurl(1);
                   5916:     }
1.436     albertel 5917:     if (!$args->{'no_nav_bar'} 
                   5918: 	&& !$args->{'only_body'}
                   5919: 	&& !$args->{'frameset'}) {
                   5920: 	$result .= &help_menu_js();
                   5921:     }
1.319     albertel 5922: 
1.314     albertel 5923:     if (ref($args->{'redirect'})) {
1.414     albertel 5924: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 5925: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 5926: 	if (!$inhibit_continue) {
                   5927: 	    $env{'internal.head.redirect'} = $url;
                   5928: 	}
1.313     albertel 5929: 	$result.=<<ADDMETA
                   5930: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 5931: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 5932: ADDMETA
                   5933:     }
1.306     albertel 5934:     if (!defined($title)) {
                   5935: 	$title = 'The LearningOnline Network with CAPA';
                   5936:     }
1.460     albertel 5937:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   5938:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 5939: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   5940: 	.$head_extra;
1.306     albertel 5941:     return $result;
                   5942: }
                   5943: 
                   5944: =pod
                   5945: 
1.340     albertel 5946: =item * &font_settings()
                   5947: 
                   5948: Returns neccessary <meta> to set the proper encoding
                   5949: 
                   5950: Inputs: none
                   5951: 
                   5952: =cut
                   5953: 
                   5954: sub font_settings {
                   5955:     my $headerstring='';
1.647     www      5956:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 5957: 	$headerstring.=
                   5958: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   5959:     }
                   5960:     return $headerstring;
                   5961: }
                   5962: 
1.341     albertel 5963: =pod
                   5964: 
                   5965: =item * &xml_begin()
                   5966: 
                   5967: Returns the needed doctype and <html>
                   5968: 
                   5969: Inputs: none
                   5970: 
                   5971: =cut
                   5972: 
                   5973: sub xml_begin {
                   5974:     my $output='';
                   5975: 
1.592     albertel 5976:     if ($env{'internal.start_page'}==1) {
                   5977: 	&Apache::lonhtmlcommon::init_htmlareafields();
                   5978:     }
1.342     albertel 5979: 
1.341     albertel 5980:     if ($env{'browser.mathml'}) {
                   5981: 	$output='<?xml version="1.0"?>'
                   5982:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   5983: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   5984:             
                   5985: #	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
                   5986: 	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
                   5987:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   5988: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   5989:     } else {
                   5990: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
                   5991:     }
                   5992:     return $output;
                   5993: }
1.340     albertel 5994: 
                   5995: =pod
                   5996: 
1.306     albertel 5997: =item * &endheadtag()
                   5998: 
                   5999: Returns a uniform </head> for LON-CAPA web pages.
                   6000: 
                   6001: Inputs: none
                   6002: 
                   6003: =cut
                   6004: 
                   6005: sub endheadtag {
                   6006:     return '</head>';
                   6007: }
                   6008: 
                   6009: =pod
                   6010: 
                   6011: =item * &head()
                   6012: 
                   6013: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
                   6014: 
1.648     raeburn  6015: Inputs:
                   6016: 
                   6017: =over 4
                   6018: 
                   6019: $title - optional title for the page
                   6020: 
                   6021: $head_extra - optional extra HTML to put inside the <head>
                   6022: 
                   6023: =back
1.405     albertel 6024: 
1.306     albertel 6025: =cut
                   6026: 
                   6027: sub head {
1.325     albertel 6028:     my ($title,$head_extra,$args) = @_;
                   6029:     return &headtag($title,$head_extra,$args).&endheadtag();
1.306     albertel 6030: }
                   6031: 
                   6032: =pod
                   6033: 
                   6034: =item * &start_page()
                   6035: 
                   6036: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6037: 
1.648     raeburn  6038: Inputs:
                   6039: 
                   6040: =over 4
                   6041: 
                   6042: $title - optional title for the page
                   6043: 
                   6044: $head_extra - optional extra HTML to incude inside the <head>
                   6045: 
                   6046: $args - additional optional args supported are:
                   6047: 
                   6048: =over 8
                   6049: 
                   6050:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6051:                                     arg on
1.648     raeburn  6052:              no_nav_bar     -> is true will set &bodytag() notopbar arg on
                   6053:              add_entries    -> additional attributes to add to the  <body>
                   6054:              domain         -> force to color decorate a page for a 
1.317     albertel 6055:                                     specific domain
1.648     raeburn  6056:              function       -> force usage of a specific rolish color
1.317     albertel 6057:                                     scheme
1.648     raeburn  6058:              redirect       -> see &headtag()
                   6059:              bgcolor        -> override the default page bg color
                   6060:              js_ready       -> return a string ready for being used in 
1.317     albertel 6061:                                     a javascript writeln
1.648     raeburn  6062:              html_encode    -> return a string ready for being used in 
1.320     albertel 6063:                                     a html attribute
1.648     raeburn  6064:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6065:                                     $forcereg arg
1.648     raeburn  6066:              body_title     -> alternate text to use instead of $title
1.326     albertel 6067:                                     in the title box that appears, this text
                   6068:                                     is not auto translated like the $title is
1.648     raeburn  6069:              frameset       -> if true will start with a <frameset>
1.330     albertel 6070:                                     rather than <body>
1.648     raeburn  6071:              no_title       -> if true the title bar won't be shown
                   6072:              skip_phases    -> hash ref of 
1.338     albertel 6073:                                     head -> skip the <html><head> generation
                   6074:                                     body -> skip all <body> generation
1.648     raeburn  6075:              no_inline_link -> if true and in remote mode, don't show the 
1.361     albertel 6076:                                     'Switch To Inline Menu' link
1.648     raeburn  6077:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6078:              inherit_jsmath -> when creating popup window in a page,
                   6079:                                     should it have jsmath forced on by the
                   6080:                                     current page
1.361     albertel 6081: 
1.648     raeburn  6082: =back
1.460     albertel 6083: 
1.648     raeburn  6084: =back
1.562     albertel 6085: 
1.306     albertel 6086: =cut
                   6087: 
                   6088: sub start_page {
1.309     albertel 6089:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6090:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313     albertel 6091:     my %head_args;
1.352     albertel 6092:     foreach my $arg ('redirect','force_register','domain','function',
1.460     albertel 6093: 		     'bgcolor','frameset','no_nav_bar','only_body',
                   6094: 		     'no_auto_mt_title') {
1.319     albertel 6095: 	if (defined($args->{$arg})) {
1.324     raeburn  6096: 	    $head_args{$arg} = $args->{$arg};
1.319     albertel 6097: 	}
1.313     albertel 6098:     }
1.319     albertel 6099: 
1.315     albertel 6100:     $env{'internal.start_page'}++;
1.338     albertel 6101:     my $result;
                   6102:     if (! exists($args->{'skip_phases'}{'head'}) ) {
                   6103: 	$result.=
1.341     albertel 6104: 	    &xml_begin().
1.338     albertel 6105: 	    &headtag($title,$head_extra,\%head_args).&endheadtag();
                   6106:     }
                   6107:     
                   6108:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6109: 	if ($args->{'frameset'}) {
                   6110: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6111: 						$args->{'add_entries'});
                   6112: 	    $result .= "\n<frameset $attr_string>\n";
                   6113: 	} else {
                   6114: 	    $result .=
                   6115: 		&bodytag($title, 
                   6116: 			 $args->{'function'},       $args->{'add_entries'},
                   6117: 			 $args->{'only_body'},      $args->{'domain'},
                   6118: 			 $args->{'force_register'}, $args->{'body_title'},
                   6119: 			 $args->{'no_nav_bar'},     $args->{'bgcolor'},
1.460     albertel 6120: 			 $args->{'no_title'},       $args->{'no_inline_link'},
                   6121: 			 $args);
1.338     albertel 6122: 	}
1.330     albertel 6123:     }
1.338     albertel 6124: 
1.315     albertel 6125:     if ($args->{'js_ready'}) {
1.713     kaisler  6126: 		$result = &js_ready($result);
1.315     albertel 6127:     }
1.320     albertel 6128:     if ($args->{'html_encode'}) {
1.713     kaisler  6129: 		$result = &html_encode($result);
                   6130:     }
                   6131: 
1.718     raeburn  6132:     if (exists($args->{'bread_crumbs'})) {
                   6133:         &Apache::lonhtmlcommon::clear_breadcrumbs();
                   6134:         if (ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6135:             foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6136:                 &Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6137:             }
                   6138:         }
                   6139:         $result .= &Apache::lonhtmlcommon::breadcrumbs();
1.320     albertel 6140:     }
1.713     kaisler  6141: 
1.315     albertel 6142:     return $result;
1.306     albertel 6143: }
                   6144: 
1.330     albertel 6145: 
1.306     albertel 6146: =pod
                   6147: 
                   6148: =item * &head()
                   6149: 
                   6150: Returns a complete </body></html> section for LON-CAPA web pages.
                   6151: 
1.315     albertel 6152: Inputs:         $args - additional optional args supported are:
                   6153:                  js_ready     -> return a string ready for being used in 
                   6154:                                  a javascript writeln
1.320     albertel 6155:                  html_encode  -> return a string ready for being used in 
                   6156:                                  a html attribute
1.330     albertel 6157:                  frameset     -> if true will start with a <frameset>
                   6158:                                  rather than <body>
1.493     albertel 6159:                  dicsussion   -> if true will get discussion from
                   6160:                                   lonxml::xmlend
                   6161:                                  (you can pass the target and parser arguments
                   6162:                                   through optional 'target' and 'parser' args
                   6163:                                   to this routine)
1.306     albertel 6164: 
                   6165: =cut
                   6166: 
                   6167: sub end_page {
1.315     albertel 6168:     my ($args) = @_;
                   6169:     $env{'internal.end_page'}++;
1.330     albertel 6170:     my $result;
1.335     albertel 6171:     if ($args->{'discussion'}) {
                   6172: 	my ($target,$parser);
                   6173: 	if (ref($args->{'discussion'})) {
                   6174: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6175: 				$args->{'discussion'}{'parser'});
                   6176: 	}
                   6177: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6178:     }
                   6179: 
1.330     albertel 6180:     if ($args->{'frameset'}) {
                   6181: 	$result .= '</frameset>';
                   6182:     } else {
1.635     raeburn  6183: 	$result .= &endbodytag($args);
1.330     albertel 6184:     }
                   6185:     $result .= "\n</html>";
                   6186: 
1.315     albertel 6187:     if ($args->{'js_ready'}) {
1.317     albertel 6188: 	$result = &js_ready($result);
1.315     albertel 6189:     }
1.335     albertel 6190: 
1.320     albertel 6191:     if ($args->{'html_encode'}) {
                   6192: 	$result = &html_encode($result);
                   6193:     }
1.335     albertel 6194: 
1.315     albertel 6195:     return $result;
                   6196: }
                   6197: 
1.320     albertel 6198: sub html_encode {
                   6199:     my ($result) = @_;
                   6200: 
1.322     albertel 6201:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 6202:     
                   6203:     return $result;
                   6204: }
1.317     albertel 6205: sub js_ready {
                   6206:     my ($result) = @_;
                   6207: 
1.323     albertel 6208:     $result =~ s/[\n\r]/ /xmsg;
                   6209:     $result =~ s/\\/\\\\/xmsg;
                   6210:     $result =~ s/'/\\'/xmsg;
1.372     albertel 6211:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 6212:     
                   6213:     return $result;
                   6214: }
                   6215: 
1.315     albertel 6216: sub validate_page {
                   6217:     if (  exists($env{'internal.start_page'})
1.316     albertel 6218: 	  &&     $env{'internal.start_page'} > 1) {
                   6219: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 6220: 				 $env{'internal.start_page'}.' '.
1.316     albertel 6221: 				 $ENV{'request.filename'});
1.315     albertel 6222:     }
                   6223:     if (  exists($env{'internal.end_page'})
1.316     albertel 6224: 	  &&     $env{'internal.end_page'} > 1) {
                   6225: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 6226: 				 $env{'internal.end_page'}.' '.
1.316     albertel 6227: 				 $env{'request.filename'});
1.315     albertel 6228:     }
                   6229:     if (     exists($env{'internal.start_page'})
                   6230: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 6231: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   6232: 				 $env{'request.filename'});
1.315     albertel 6233:     }
                   6234:     if (   ! exists($env{'internal.start_page'})
                   6235: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 6236: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   6237: 				 $env{'request.filename'});
1.315     albertel 6238:     }
1.306     albertel 6239: }
1.315     albertel 6240: 
1.318     albertel 6241: sub simple_error_page {
                   6242:     my ($r,$title,$msg) = @_;
                   6243:     my $page =
                   6244: 	&Apache::loncommon::start_page($title).
                   6245: 	&mt($msg).
                   6246: 	&Apache::loncommon::end_page();
                   6247:     if (ref($r)) {
                   6248: 	$r->print($page);
1.327     albertel 6249: 	return;
1.318     albertel 6250:     }
                   6251:     return $page;
                   6252: }
1.347     albertel 6253: 
                   6254: {
1.610     albertel 6255:     my @row_count;
1.347     albertel 6256:     sub start_data_table {
1.422     albertel 6257: 	my ($add_class) = @_;
                   6258: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.610     albertel 6259: 	unshift(@row_count,0);
1.422     albertel 6260: 	return '<table class="'.$css_class.'">'."\n";
1.347     albertel 6261:     }
                   6262: 
                   6263:     sub end_data_table {
1.610     albertel 6264: 	shift(@row_count);
1.389     albertel 6265: 	return '</table>'."\n";;
1.347     albertel 6266:     }
                   6267: 
                   6268:     sub start_data_table_row {
1.422     albertel 6269: 	my ($add_class) = @_;
1.610     albertel 6270: 	$row_count[0]++;
                   6271: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428     albertel 6272: 	$css_class = (join(' ',$css_class,$add_class));
1.422     albertel 6273: 	return  '<tr class="'.$css_class.'">'."\n";;
1.347     albertel 6274:     }
1.471     banghart 6275:     
                   6276:     sub continue_data_table_row {
                   6277: 	my ($add_class) = @_;
1.610     albertel 6278: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471     banghart 6279: 	$css_class = (join(' ',$css_class,$add_class));
                   6280: 	return  '<tr class="'.$css_class.'">'."\n";;
                   6281:     }
1.347     albertel 6282: 
                   6283:     sub end_data_table_row {
1.389     albertel 6284: 	return '</tr>'."\n";;
1.347     albertel 6285:     }
1.367     www      6286: 
1.421     albertel 6287:     sub start_data_table_empty_row {
1.707     bisitz   6288: #	$row_count[0]++;
1.421     albertel 6289: 	return  '<tr class="LC_empty_row" >'."\n";;
                   6290:     }
                   6291: 
                   6292:     sub end_data_table_empty_row {
                   6293: 	return '</tr>'."\n";;
                   6294:     }
                   6295: 
1.367     www      6296:     sub start_data_table_header_row {
1.389     albertel 6297: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      6298:     }
                   6299: 
                   6300:     sub end_data_table_header_row {
1.389     albertel 6301: 	return '</tr>'."\n";;
1.367     www      6302:     }
1.347     albertel 6303: }
                   6304: 
1.548     albertel 6305: =pod
                   6306: 
                   6307: =item * &inhibit_menu_check($arg)
                   6308: 
                   6309: Checks for a inhibitmenu state and generates output to preserve it
                   6310: 
                   6311: Inputs:         $arg - can be any of
                   6312:                      - undef - in which case the return value is a string 
                   6313:                                to add  into arguments list of a uri
                   6314:                      - 'input' - in which case the return value is a HTML
                   6315:                                  <form> <input> field of type hidden to
                   6316:                                  preserve the value
                   6317:                      - a url - in which case the return value is the url with
                   6318:                                the neccesary cgi args added to preserve the
                   6319:                                inhibitmenu state
                   6320:                      - a ref to a url - no return value, but the string is
                   6321:                                         updated to include the neccessary cgi
                   6322:                                         args to preserve the inhibitmenu state
                   6323: 
                   6324: =cut
                   6325: 
                   6326: sub inhibit_menu_check {
                   6327:     my ($arg) = @_;
                   6328:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   6329:     if ($arg eq 'input') {
                   6330: 	if ($env{'form.inhibitmenu'}) {
                   6331: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   6332: 	} else {
                   6333: 	    return
                   6334: 	}
                   6335:     }
                   6336:     if ($env{'form.inhibitmenu'}) {
                   6337: 	if (ref($arg)) {
                   6338: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   6339: 	} elsif ($arg eq '') {
                   6340: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   6341: 	} else {
                   6342: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   6343: 	}
                   6344:     }
                   6345:     if (!ref($arg)) {
                   6346: 	return $arg;
                   6347:     }
                   6348: }
                   6349: 
1.251     albertel 6350: ###############################################
1.182     matthew  6351: 
                   6352: =pod
                   6353: 
1.549     albertel 6354: =back
                   6355: 
                   6356: =head1 User Information Routines
                   6357: 
                   6358: =over 4
                   6359: 
1.405     albertel 6360: =item * &get_users_function()
1.182     matthew  6361: 
                   6362: Used by &bodytag to determine the current users primary role.
                   6363: Returns either 'student','coordinator','admin', or 'author'.
                   6364: 
                   6365: =cut
                   6366: 
                   6367: ###############################################
                   6368: sub get_users_function {
                   6369:     my $function = 'student';
1.258     albertel 6370:     if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182     matthew  6371:         $function='coordinator';
                   6372:     }
1.258     albertel 6373:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  6374:         $function='admin';
                   6375:     }
1.258     albertel 6376:     if (($env{'request.role'}=~/^(au|ca)/) ||
1.182     matthew  6377:         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   6378:         $function='author';
                   6379:     }
                   6380:     return $function;
1.54      www      6381: }
1.99      www      6382: 
                   6383: ###############################################
                   6384: 
1.233     raeburn  6385: =pod
                   6386: 
1.542     raeburn  6387: =item * &check_user_status()
1.274     raeburn  6388: 
                   6389: Determines current status of supplied role for a
                   6390: specific user. Roles can be active, previous or future.
                   6391: 
                   6392: Inputs: 
                   6393: user's domain, user's username, course's domain,
1.375     raeburn  6394: course's number, optional section ID.
1.274     raeburn  6395: 
                   6396: Outputs:
                   6397: role status: active, previous or future. 
                   6398: 
                   6399: =cut
                   6400: 
                   6401: sub check_user_status {
1.412     raeburn  6402:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274     raeburn  6403:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
                   6404:     my @uroles = keys %userinfo;
                   6405:     my $srchstr;
                   6406:     my $active_chk = 'none';
1.412     raeburn  6407:     my $now = time;
1.274     raeburn  6408:     if (@uroles > 0) {
1.412     raeburn  6409:         if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  6410:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   6411:         } else {
1.412     raeburn  6412:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   6413:         }
                   6414:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  6415:             my $role_end = 0;
                   6416:             my $role_start = 0;
                   6417:             $active_chk = 'active';
1.412     raeburn  6418:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   6419:                 $role_end = $1;
                   6420:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   6421:                     $role_start = $1;
1.274     raeburn  6422:                 }
                   6423:             }
                   6424:             if ($role_start > 0) {
1.412     raeburn  6425:                 if ($now < $role_start) {
1.274     raeburn  6426:                     $active_chk = 'future';
                   6427:                 }
                   6428:             }
                   6429:             if ($role_end > 0) {
1.412     raeburn  6430:                 if ($now > $role_end) {
1.274     raeburn  6431:                     $active_chk = 'previous';
                   6432:                 }
                   6433:             }
                   6434:         }
                   6435:     }
                   6436:     return $active_chk;
                   6437: }
                   6438: 
                   6439: ###############################################
                   6440: 
                   6441: =pod
                   6442: 
1.405     albertel 6443: =item * &get_sections()
1.233     raeburn  6444: 
                   6445: Determines all the sections for a course including
                   6446: sections with students and sections containing other roles.
1.419     raeburn  6447: Incoming parameters: 
                   6448: 
                   6449: 1. domain
                   6450: 2. course number 
                   6451: 3. reference to array containing roles for which sections should 
                   6452: be gathered (optional).
                   6453: 4. reference to array containing status types for which sections 
                   6454: should be gathered (optional).
                   6455: 
                   6456: If the third argument is undefined, sections are gathered for any role. 
                   6457: If the fourth argument is undefined, sections are gathered for any status.
                   6458: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  6459:  
1.374     raeburn  6460: Returns section hash (keys are section IDs, values are
                   6461: number of users in each section), subject to the
1.419     raeburn  6462: optional roles filter, optional status filter 
1.233     raeburn  6463: 
                   6464: =cut
                   6465: 
                   6466: ###############################################
                   6467: sub get_sections {
1.419     raeburn  6468:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 6469:     if (!defined($cdom) || !defined($cnum)) {
                   6470:         my $cid =  $env{'request.course.id'};
                   6471: 
                   6472: 	return if (!defined($cid));
                   6473: 
                   6474:         $cdom = $env{'course.'.$cid.'.domain'};
                   6475:         $cnum = $env{'course.'.$cid.'.num'};
                   6476:     }
                   6477: 
                   6478:     my %sectioncount;
1.419     raeburn  6479:     my $now = time;
1.240     albertel 6480: 
1.366     albertel 6481:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 6482: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 6483: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   6484: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  6485:         my $start_index = &Apache::loncoursedata::CL_START();
                   6486:         my $end_index = &Apache::loncoursedata::CL_END();
                   6487:         my $status;
1.366     albertel 6488: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  6489: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   6490: 				                     $data->[$status_index],
                   6491:                                                      $data->[$start_index],
                   6492:                                                      $data->[$end_index]);
                   6493:             if ($stu_status eq 'Active') {
                   6494:                 $status = 'active';
                   6495:             } elsif ($end < $now) {
                   6496:                 $status = 'previous';
                   6497:             } elsif ($start > $now) {
                   6498:                 $status = 'future';
                   6499:             } 
                   6500: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   6501:                 if ((!defined($possible_status)) || (($status ne '') && 
                   6502:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   6503: 		    $sectioncount{$section}++;
                   6504:                 }
1.240     albertel 6505: 	    }
                   6506: 	}
                   6507:     }
                   6508:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   6509:     foreach my $user (sort(keys(%courseroles))) {
                   6510: 	if ($user !~ /^(\w{2})/) { next; }
                   6511: 	my ($role) = ($user =~ /^(\w{2})/);
                   6512: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  6513: 	my ($section,$status);
1.240     albertel 6514: 	if ($role eq 'cr' &&
                   6515: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   6516: 	    $section=$1;
                   6517: 	}
                   6518: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   6519: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  6520:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   6521:         if ($end == -1 && $start == -1) {
                   6522:             next; #deleted role
                   6523:         }
                   6524:         if (!defined($possible_status)) { 
                   6525:             $sectioncount{$section}++;
                   6526:         } else {
                   6527:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   6528:                 $status = 'active';
                   6529:             } elsif ($end < $now) {
                   6530:                 $status = 'future';
                   6531:             } elsif ($start > $now) {
                   6532:                 $status = 'previous';
                   6533:             }
                   6534:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   6535:                 $sectioncount{$section}++;
                   6536:             }
                   6537:         }
1.233     raeburn  6538:     }
1.366     albertel 6539:     return %sectioncount;
1.233     raeburn  6540: }
                   6541: 
1.274     raeburn  6542: ###############################################
1.294     raeburn  6543: 
                   6544: =pod
1.405     albertel 6545: 
                   6546: =item * &get_course_users()
                   6547: 
1.275     raeburn  6548: Retrieves usernames:domains for users in the specified course
                   6549: with specific role(s), and access status. 
                   6550: 
                   6551: Incoming parameters:
1.277     albertel 6552: 1. course domain
                   6553: 2. course number
                   6554: 3. access status: users must have - either active, 
1.275     raeburn  6555: previous, future, or all.
1.277     albertel 6556: 4. reference to array of permissible roles
1.288     raeburn  6557: 5. reference to array of section restrictions (optional)
                   6558: 6. reference to results object (hash of hashes).
                   6559: 7. reference to optional userdata hash
1.609     raeburn  6560: 8. reference to optional statushash
1.630     raeburn  6561: 9. flag if privileged users (except those set to unhide in
                   6562:    course settings) should be excluded    
1.609     raeburn  6563: Keys of top level results hash are roles.
1.275     raeburn  6564: Keys of inner hashes are username:domain, with 
                   6565: values set to access type.
1.288     raeburn  6566: Optional userdata hash returns an array with arguments in the 
                   6567: same order as loncoursedata::get_classlist() for student data.
                   6568: 
1.609     raeburn  6569: Optional statushash returns
                   6570: 
1.288     raeburn  6571: Entries for end, start, section and status are blank because
                   6572: of the possibility of multiple values for non-student roles.
                   6573: 
1.275     raeburn  6574: =cut
1.405     albertel 6575: 
1.275     raeburn  6576: ###############################################
1.405     albertel 6577: 
1.275     raeburn  6578: sub get_course_users {
1.630     raeburn  6579:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  6580:     my %idx = ();
1.419     raeburn  6581:     my %seclists;
1.288     raeburn  6582: 
                   6583:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   6584:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   6585:     $idx{end} = &Apache::loncoursedata::CL_END();
                   6586:     $idx{start} = &Apache::loncoursedata::CL_START();
                   6587:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   6588:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   6589:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   6590:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   6591: 
1.290     albertel 6592:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 6593:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  6594:         my $now = time;
1.277     albertel 6595:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  6596:             my $match = 0;
1.412     raeburn  6597:             my $secmatch = 0;
1.419     raeburn  6598:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  6599:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  6600:             if ($section eq '') {
                   6601:                 $section = 'none';
                   6602:             }
1.291     albertel 6603:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 6604:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  6605:                     $secmatch = 1;
                   6606:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 6607:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  6608:                         $secmatch = 1;
                   6609:                     }
                   6610:                 } else {  
1.419     raeburn  6611: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  6612: 		        $secmatch = 1;
                   6613:                     }
1.290     albertel 6614: 		}
1.412     raeburn  6615:                 if (!$secmatch) {
                   6616:                     next;
                   6617:                 }
1.419     raeburn  6618:             }
1.275     raeburn  6619:             if (defined($$types{'active'})) {
1.288     raeburn  6620:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  6621:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  6622:                     $match = 1;
1.275     raeburn  6623:                 }
                   6624:             }
                   6625:             if (defined($$types{'previous'})) {
1.609     raeburn  6626:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  6627:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  6628:                     $match = 1;
1.275     raeburn  6629:                 }
                   6630:             }
                   6631:             if (defined($$types{'future'})) {
1.609     raeburn  6632:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  6633:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  6634:                     $match = 1;
1.275     raeburn  6635:                 }
                   6636:             }
1.609     raeburn  6637:             if ($match) {
                   6638:                 push(@{$seclists{$student}},$section);
                   6639:                 if (ref($userdata) eq 'HASH') {
                   6640:                     $$userdata{$student} = $$classlist{$student};
                   6641:                 }
                   6642:                 if (ref($statushash) eq 'HASH') {
                   6643:                     $statushash->{$student}{'st'}{$section} = $status;
                   6644:                 }
1.288     raeburn  6645:             }
1.275     raeburn  6646:         }
                   6647:     }
1.412     raeburn  6648:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  6649:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   6650:         my $now = time;
1.609     raeburn  6651:         my %displaystatus = ( previous => 'Expired',
                   6652:                               active   => 'Active',
                   6653:                               future   => 'Future',
                   6654:                             );
1.630     raeburn  6655:         my %nothide;
                   6656:         if ($hidepriv) {
                   6657:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   6658:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   6659:                 if ($user !~ /:/) {
                   6660:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   6661:                 } else {
                   6662:                     $nothide{$user} = 1;
                   6663:                 }
                   6664:             }
                   6665:         }
1.439     raeburn  6666:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  6667:             my $match = 0;
1.412     raeburn  6668:             my $secmatch = 0;
1.439     raeburn  6669:             my $status;
1.412     raeburn  6670:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  6671:             $user =~ s/:$//;
1.439     raeburn  6672:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   6673:             if ($end == -1 || $start == -1) {
                   6674:                 next;
                   6675:             }
                   6676:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   6677:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  6678:                 my ($uname,$udom) = split(/:/,$user);
                   6679:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 6680:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  6681:                         $secmatch = 1;
                   6682:                     } elsif ($usec eq '') {
1.420     albertel 6683:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  6684:                             $secmatch = 1;
                   6685:                         }
                   6686:                     } else {
                   6687:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   6688:                             $secmatch = 1;
                   6689:                         }
                   6690:                     }
                   6691:                     if (!$secmatch) {
                   6692:                         next;
                   6693:                     }
1.288     raeburn  6694:                 }
1.419     raeburn  6695:                 if ($usec eq '') {
                   6696:                     $usec = 'none';
                   6697:                 }
1.275     raeburn  6698:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  6699:                     if ($hidepriv) {
                   6700:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   6701:                             (!$nothide{$uname.':'.$udom})) {
                   6702:                             next;
                   6703:                         }
                   6704:                     }
1.503     raeburn  6705:                     if ($end > 0 && $end < $now) {
1.439     raeburn  6706:                         $status = 'previous';
                   6707:                     } elsif ($start > $now) {
                   6708:                         $status = 'future';
                   6709:                     } else {
                   6710:                         $status = 'active';
                   6711:                     }
1.277     albertel 6712:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  6713:                         if ($status eq $type) {
1.420     albertel 6714:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  6715:                                 push(@{$$users{$role}{$user}},$type);
                   6716:                             }
1.288     raeburn  6717:                             $match = 1;
                   6718:                         }
                   6719:                     }
1.419     raeburn  6720:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   6721:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   6722: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   6723:                         }
1.420     albertel 6724:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  6725:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   6726:                         }
1.609     raeburn  6727:                         if (ref($statushash) eq 'HASH') {
                   6728:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   6729:                         }
1.275     raeburn  6730:                     }
                   6731:                 }
                   6732:             }
                   6733:         }
1.290     albertel 6734:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  6735:             if ((defined($cdom)) && (defined($cnum))) {
                   6736:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   6737:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   6738:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  6739:                     next if ($owner eq '');
                   6740:                     my ($ownername,$ownerdom);
                   6741:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   6742:                         $ownername = $1;
                   6743:                         $ownerdom = $2;
                   6744:                     } else {
                   6745:                         $ownername = $owner;
                   6746:                         $ownerdom = $cdom;
                   6747:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  6748:                     }
                   6749:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 6750:                     if (defined($userdata) && 
1.609     raeburn  6751: 			!exists($$userdata{$owner})) {
                   6752: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   6753:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   6754:                             push(@{$seclists{$owner}},'none');
                   6755:                         }
                   6756:                         if (ref($statushash) eq 'HASH') {
                   6757:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  6758:                         }
1.290     albertel 6759: 		    }
1.279     raeburn  6760:                 }
                   6761:             }
                   6762:         }
1.419     raeburn  6763:         foreach my $user (keys(%seclists)) {
                   6764:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   6765:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   6766:         }
1.275     raeburn  6767:     }
                   6768:     return;
                   6769: }
                   6770: 
1.288     raeburn  6771: sub get_user_info {
                   6772:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 6773:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   6774: 	&plainname($uname,$udom,'lastname');
1.291     albertel 6775:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  6776:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  6777:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   6778:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  6779:     return;
                   6780: }
1.275     raeburn  6781: 
1.472     raeburn  6782: ###############################################
                   6783: 
                   6784: =pod
                   6785: 
                   6786: =item * &get_user_quota()
                   6787: 
                   6788: Retrieves quota assigned for storage of portfolio files for a user  
                   6789: 
                   6790: Incoming parameters:
                   6791: 1. user's username
                   6792: 2. user's domain
                   6793: 
                   6794: Returns:
1.536     raeburn  6795: 1. Disk quota (in Mb) assigned to student.
                   6796: 2. (Optional) Type of setting: custom or default
                   6797:    (individually assigned or default for user's 
                   6798:    institutional status).
                   6799: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   6800:    or student - types as defined in localenroll::inst_usertypes 
                   6801:    for user's domain, which determines default quota for user.
                   6802: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  6803: 
                   6804: If a value has been stored in the user's environment, 
1.536     raeburn  6805: it will return that, otherwise it returns the maximal default
                   6806: defined for the user's instituional status(es) in the domain.
1.472     raeburn  6807: 
                   6808: =cut
                   6809: 
                   6810: ###############################################
                   6811: 
                   6812: 
                   6813: sub get_user_quota {
                   6814:     my ($uname,$udom) = @_;
1.536     raeburn  6815:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  6816:     if (!defined($udom)) {
                   6817:         $udom = $env{'user.domain'};
                   6818:     }
                   6819:     if (!defined($uname)) {
                   6820:         $uname = $env{'user.name'};
                   6821:     }
                   6822:     if (($udom eq '' || $uname eq '') ||
                   6823:         ($udom eq 'public') && ($uname eq 'public')) {
                   6824:         $quota = 0;
1.536     raeburn  6825:         $quotatype = 'default';
                   6826:         $defquota = 0; 
1.472     raeburn  6827:     } else {
1.536     raeburn  6828:         my $inststatus;
1.472     raeburn  6829:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   6830:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  6831:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  6832:         } else {
1.536     raeburn  6833:             my %userenv = 
                   6834:                 &Apache::lonnet::get('environment',['portfolioquota',
                   6835:                                      'inststatus'],$udom,$uname);
1.472     raeburn  6836:             my ($tmp) = keys(%userenv);
                   6837:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   6838:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  6839:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  6840:             } else {
                   6841:                 undef(%userenv);
                   6842:             }
                   6843:         }
1.536     raeburn  6844:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  6845:         if ($quota eq '') {
1.536     raeburn  6846:             $quota = $defquota;
                   6847:             $quotatype = 'default';
                   6848:         } else {
                   6849:             $quotatype = 'custom';
1.472     raeburn  6850:         }
                   6851:     }
1.536     raeburn  6852:     if (wantarray) {
                   6853:         return ($quota,$quotatype,$settingstatus,$defquota);
                   6854:     } else {
                   6855:         return $quota;
                   6856:     }
1.472     raeburn  6857: }
                   6858: 
                   6859: ###############################################
                   6860: 
                   6861: =pod
                   6862: 
                   6863: =item * &default_quota()
                   6864: 
1.536     raeburn  6865: Retrieves default quota assigned for storage of user portfolio files,
                   6866: given an (optional) user's institutional status.
1.472     raeburn  6867: 
                   6868: Incoming parameters:
                   6869: 1. domain
1.536     raeburn  6870: 2. (Optional) institutional status(es).  This is a : separated list of 
                   6871:    status types (e.g., faculty, staff, student etc.)
                   6872:    which apply to the user for whom the default is being retrieved.
                   6873:    If the institutional status string in undefined, the domain
                   6874:    default quota will be returned. 
1.472     raeburn  6875: 
                   6876: Returns:
                   6877: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  6878: 2. (Optional) institutional type which determined the value of the
                   6879:    default quota.
1.472     raeburn  6880: 
                   6881: If a value has been stored in the domain's configuration db,
                   6882: it will return that, otherwise it returns 20 (for backwards 
                   6883: compatibility with domains which have not set up a configuration
                   6884: db file; the original statically defined portfolio quota was 20 Mb). 
                   6885: 
1.536     raeburn  6886: If the user's status includes multiple types (e.g., staff and student),
                   6887: the largest default quota which applies to the user determines the
                   6888: default quota returned.
                   6889: 
1.472     raeburn  6890: =cut
                   6891: 
                   6892: ###############################################
                   6893: 
                   6894: 
                   6895: sub default_quota {
1.536     raeburn  6896:     my ($udom,$inststatus) = @_;
                   6897:     my ($defquota,$settingstatus);
                   6898:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  6899:                                             ['quotas'],$udom);
                   6900:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  6901:         if ($inststatus ne '') {
                   6902:             my @statuses = split(/:/,$inststatus);
                   6903:             foreach my $item (@statuses) {
1.711     raeburn  6904:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   6905:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   6906:                         if ($defquota eq '') {
                   6907:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   6908:                             $settingstatus = $item;
                   6909:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   6910:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   6911:                             $settingstatus = $item;
                   6912:                         }
                   6913:                     }
                   6914:                 } else {
                   6915:                     if ($quotahash{'quotas'}{$item} ne '') {
                   6916:                         if ($defquota eq '') {
                   6917:                             $defquota = $quotahash{'quotas'}{$item};
                   6918:                             $settingstatus = $item;
                   6919:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   6920:                             $defquota = $quotahash{'quotas'}{$item};
                   6921:                             $settingstatus = $item;
                   6922:                         }
1.536     raeburn  6923:                     }
                   6924:                 }
                   6925:             }
                   6926:         }
                   6927:         if ($defquota eq '') {
1.711     raeburn  6928:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   6929:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   6930:             } else {
                   6931:                 $defquota = $quotahash{'quotas'}{'default'};
                   6932:             }
1.536     raeburn  6933:             $settingstatus = 'default';
                   6934:         }
                   6935:     } else {
                   6936:         $settingstatus = 'default';
                   6937:         $defquota = 20;
                   6938:     }
                   6939:     if (wantarray) {
                   6940:         return ($defquota,$settingstatus);
1.472     raeburn  6941:     } else {
1.536     raeburn  6942:         return $defquota;
1.472     raeburn  6943:     }
                   6944: }
                   6945: 
1.384     raeburn  6946: sub get_secgrprole_info {
                   6947:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   6948:     my %sections_count = &get_sections($cdom,$cnum);
                   6949:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   6950:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   6951:     my @groups = sort(keys(%curr_groups));
                   6952:     my $allroles = [];
                   6953:     my $rolehash;
                   6954:     my $accesshash = {
                   6955:                      active => 'Currently has access',
                   6956:                      future => 'Will have future access',
                   6957:                      previous => 'Previously had access',
                   6958:                   };
                   6959:     if ($needroles) {
                   6960:         $rolehash = {'all' => 'all'};
1.385     albertel 6961:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   6962: 	if (&Apache::lonnet::error(%user_roles)) {
                   6963: 	    undef(%user_roles);
                   6964: 	}
                   6965:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  6966:             my ($role)=split(/\:/,$item,2);
                   6967:             if ($role eq 'cr') { next; }
                   6968:             if ($role =~ /^cr/) {
                   6969:                 $$rolehash{$role} = (split('/',$role))[3];
                   6970:             } else {
                   6971:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   6972:             }
                   6973:         }
                   6974:         foreach my $key (sort(keys(%{$rolehash}))) {
                   6975:             push(@{$allroles},$key);
                   6976:         }
                   6977:         push (@{$allroles},'st');
                   6978:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   6979:     }
                   6980:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   6981: }
                   6982: 
1.555     raeburn  6983: sub user_picker {
1.627     raeburn  6984:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555     raeburn  6985:     my $currdom = $dom;
                   6986:     my %curr_selected = (
                   6987:                         srchin => 'dom',
1.580     raeburn  6988:                         srchby => 'lastname',
1.555     raeburn  6989:                       );
                   6990:     my $srchterm;
1.625     raeburn  6991:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  6992:         if ($srch->{'srchby'} ne '') {
                   6993:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   6994:         }
                   6995:         if ($srch->{'srchin'} ne '') {
                   6996:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   6997:         }
                   6998:         if ($srch->{'srchtype'} ne '') {
                   6999:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   7000:         }
                   7001:         if ($srch->{'srchdomain'} ne '') {
                   7002:             $currdom = $srch->{'srchdomain'};
                   7003:         }
                   7004:         $srchterm = $srch->{'srchterm'};
                   7005:     }
                   7006:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  7007:                     'usr'       => 'Search criteria',
1.563     raeburn  7008:                     'doma'      => 'Domain/institution to search',
1.558     albertel 7009:                     'uname'     => 'username',
                   7010:                     'lastname'  => 'last name',
1.555     raeburn  7011:                     'lastfirst' => 'last name, first name',
1.558     albertel 7012:                     'crs'       => 'in this course',
1.576     raeburn  7013:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 7014:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  7015:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 7016:                     'exact'     => 'is',
                   7017:                     'contains'  => 'contains',
1.569     raeburn  7018:                     'begins'    => 'begins with',
1.571     raeburn  7019:                     'youm'      => "You must include some text to search for.",
                   7020:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   7021:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   7022:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   7023:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   7024:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   7025:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   7026:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  7027:                                        );
1.563     raeburn  7028:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   7029:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  7030: 
                   7031:     my @srchins = ('crs','dom','alc','instd');
                   7032: 
                   7033:     foreach my $option (@srchins) {
                   7034:         # FIXME 'alc' option unavailable until 
                   7035:         #       loncreateuser::print_user_query_page()
                   7036:         #       has been completed.
                   7037:         next if ($option eq 'alc');
                   7038:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  7039:         if ($curr_selected{'srchin'} eq $option) {
                   7040:             $srchinsel .= ' 
                   7041:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7042:         } else {
                   7043:             $srchinsel .= '
                   7044:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7045:         }
1.555     raeburn  7046:     }
1.563     raeburn  7047:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  7048: 
                   7049:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  7050:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  7051:         if ($curr_selected{'srchby'} eq $option) {
                   7052:             $srchbysel .= '
                   7053:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7054:         } else {
                   7055:             $srchbysel .= '
                   7056:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7057:          }
                   7058:     }
                   7059:     $srchbysel .= "\n  </select>\n";
                   7060: 
                   7061:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  7062:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  7063:         if ($curr_selected{'srchtype'} eq $option) {
                   7064:             $srchtypesel .= '
                   7065:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7066:         } else {
                   7067:             $srchtypesel .= '
                   7068:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7069:         }
                   7070:     }
                   7071:     $srchtypesel .= "\n  </select>\n";
                   7072: 
1.558     albertel 7073:     my ($newuserscript,$new_user_create);
1.556     raeburn  7074: 
                   7075:     if ($forcenewuser) {
1.576     raeburn  7076:         if (ref($srch) eq 'HASH') {
                   7077:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627     raeburn  7078:                 if ($cancreate) {
                   7079:                     $new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
                   7080:                 } else {
                   7081:                     my $helplink = ' href="javascript:helpMenu('."'display'".')"';
                   7082:                     my %usertypetext = (
                   7083:                         official   => 'institutional',
                   7084:                         unofficial => 'non-institutional',
                   7085:                     );
                   7086:                     $new_user_create = '<br /><span class="LC_warning">'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the <a[_1]>helpdesk</a> for assistance.',$helplink).'</span><br /><br />';
                   7087:                 }
1.576     raeburn  7088:             }
                   7089:         }
                   7090: 
1.556     raeburn  7091:         $newuserscript = <<"ENDSCRIPT";
                   7092: 
1.570     raeburn  7093: function setSearch(createnew,callingForm) {
1.556     raeburn  7094:     if (createnew == 1) {
1.570     raeburn  7095:         for (var i=0; i<callingForm.srchby.length; i++) {
                   7096:             if (callingForm.srchby.options[i].value == 'uname') {
                   7097:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  7098:             }
                   7099:         }
1.570     raeburn  7100:         for (var i=0; i<callingForm.srchin.length; i++) {
                   7101:             if ( callingForm.srchin.options[i].value == 'dom') {
                   7102: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  7103:             }
                   7104:         }
1.570     raeburn  7105:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   7106:             if (callingForm.srchtype.options[i].value == 'exact') {
                   7107:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  7108:             }
                   7109:         }
1.570     raeburn  7110:         for (var i=0; i<callingForm.srchdomain.length; i++) {
                   7111:             if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
                   7112:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  7113:             }
                   7114:         }
                   7115:     }
                   7116: }
                   7117: ENDSCRIPT
1.558     albertel 7118: 
1.556     raeburn  7119:     }
                   7120: 
1.555     raeburn  7121:     my $output = <<"END_BLOCK";
1.556     raeburn  7122: <script type="text/javascript">
1.570     raeburn  7123: function validateEntry(callingForm) {
1.558     albertel 7124: 
1.556     raeburn  7125:     var checkok = 1;
1.558     albertel 7126:     var srchin;
1.570     raeburn  7127:     for (var i=0; i<callingForm.srchin.length; i++) {
                   7128: 	if ( callingForm.srchin[i].checked ) {
                   7129: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 7130: 	}
                   7131:     }
                   7132: 
1.570     raeburn  7133:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   7134:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   7135:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   7136:     var srchterm =  callingForm.srchterm.value;
                   7137:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  7138:     var msg = "";
                   7139: 
                   7140:     if (srchterm == "") {
                   7141:         checkok = 0;
1.571     raeburn  7142:         msg += "$lt{'youm'}\\n";
1.556     raeburn  7143:     }
                   7144: 
1.569     raeburn  7145:     if (srchtype== 'begins') {
                   7146:         if (srchterm.length < 2) {
                   7147:             checkok = 0;
1.571     raeburn  7148:             msg += "$lt{'thte'}\\n";
1.569     raeburn  7149:         }
                   7150:     }
                   7151: 
1.556     raeburn  7152:     if (srchtype== 'contains') {
                   7153:         if (srchterm.length < 3) {
                   7154:             checkok = 0;
1.571     raeburn  7155:             msg += "$lt{'thet'}\\n";
1.556     raeburn  7156:         }
                   7157:     }
                   7158:     if (srchin == 'instd') {
                   7159:         if (srchdomain == '') {
                   7160:             checkok = 0;
1.571     raeburn  7161:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  7162:         }
                   7163:     }
                   7164:     if (srchin == 'dom') {
                   7165:         if (srchdomain == '') {
                   7166:             checkok = 0;
1.571     raeburn  7167:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  7168:         }
                   7169:     }
                   7170:     if (srchby == 'lastfirst') {
                   7171:         if (srchterm.indexOf(",") == -1) {
                   7172:             checkok = 0;
1.571     raeburn  7173:             msg += "$lt{'whus'}\\n";
1.556     raeburn  7174:         }
                   7175:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   7176:             checkok = 0;
1.571     raeburn  7177:             msg += "$lt{'whse'}\\n";
1.556     raeburn  7178:         }
                   7179:     }
                   7180:     if (checkok == 0) {
1.571     raeburn  7181:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  7182:         return;
                   7183:     }
                   7184:     if (checkok == 1) {
1.570     raeburn  7185:         callingForm.submit();
1.556     raeburn  7186:     }
                   7187: }
                   7188: 
                   7189: $newuserscript
                   7190: 
                   7191: </script>
1.558     albertel 7192: 
                   7193: $new_user_create
                   7194: 
1.555     raeburn  7195: <table>
1.558     albertel 7196:  <tr>
1.573     raeburn  7197:   <td>$lt{'doma'}:</td>
                   7198:   <td>$domform</td>
                   7199:   </td>
                   7200:  </tr>
                   7201:  <tr>
                   7202:   <td>$lt{'usr'}:</td>
1.563     raeburn  7203:   <td>$srchbysel
                   7204:       $srchtypesel 
                   7205:       <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564     albertel 7206:       $srchinsel 
1.563     raeburn  7207:   </td>
                   7208:  </tr>
1.555     raeburn  7209: </table>
                   7210: <br />
                   7211: END_BLOCK
1.558     albertel 7212: 
1.555     raeburn  7213:     return $output;
                   7214: }
                   7215: 
1.612     raeburn  7216: sub user_rule_check {
1.615     raeburn  7217:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  7218:     my $response;
                   7219:     if (ref($usershash) eq 'HASH') {
                   7220:         foreach my $user (keys(%{$usershash})) {
                   7221:             my ($uname,$udom) = split(/:/,$user);
                   7222:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  7223:             my ($id,$newuser);
1.612     raeburn  7224:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  7225:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  7226:                 $id = $usershash->{$user}->{'id'};
                   7227:             }
                   7228:             my $inst_response;
                   7229:             if (ref($checks) eq 'HASH') {
                   7230:                 if (defined($checks->{'username'})) {
1.615     raeburn  7231:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  7232:                         &Apache::lonnet::get_instuser($udom,$uname);
                   7233:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  7234:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  7235:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   7236:                 }
1.615     raeburn  7237:             } else {
                   7238:                 ($inst_response,%{$inst_results->{$user}}) =
                   7239:                     &Apache::lonnet::get_instuser($udom,$uname);
                   7240:                 return;
1.612     raeburn  7241:             }
1.615     raeburn  7242:             if (!$got_rules->{$udom}) {
1.612     raeburn  7243:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   7244:                                                   ['usercreation'],$udom);
                   7245:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  7246:                     foreach my $item ('username','id') {
1.612     raeburn  7247:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   7248:                             $$curr_rules{$udom}{$item} = 
                   7249:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  7250:                         }
                   7251:                     }
                   7252:                 }
1.615     raeburn  7253:                 $got_rules->{$udom} = 1;  
1.585     raeburn  7254:             }
1.612     raeburn  7255:             foreach my $item (keys(%{$checks})) {
                   7256:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   7257:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   7258:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   7259:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   7260:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   7261:                                 if ($rule_check{$rule}) {
                   7262:                                     $$rulematch{$user}{$item} = $rule;
                   7263:                                     if ($inst_response eq 'ok') {
1.615     raeburn  7264:                                         if (ref($inst_results) eq 'HASH') {
                   7265:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   7266:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   7267:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   7268:                                                 }
1.612     raeburn  7269:                                             }
                   7270:                                         }
1.615     raeburn  7271:                                     }
                   7272:                                     last;
1.585     raeburn  7273:                                 }
                   7274:                             }
                   7275:                         }
                   7276:                     }
                   7277:                 }
                   7278:             }
                   7279:         }
                   7280:     }
1.612     raeburn  7281:     return;
                   7282: }
                   7283: 
                   7284: sub user_rule_formats {
                   7285:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   7286:     my %text = ( 
                   7287:                  'username' => 'Usernames',
                   7288:                  'id'       => 'IDs',
                   7289:                );
                   7290:     my $output;
                   7291:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   7292:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   7293:         if (@{$ruleorder} > 0) {
                   7294:             $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
                   7295:             foreach my $rule (@{$ruleorder}) {
                   7296:                 if (ref($curr_rules) eq 'ARRAY') {
                   7297:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   7298:                         if (ref($rules->{$rule}) eq 'HASH') {
                   7299:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   7300:                                         $rules->{$rule}{'desc'}.'</li>';
                   7301:                         }
                   7302:                     }
                   7303:                 }
                   7304:             }
                   7305:             $output .= '</ul>';
                   7306:         }
                   7307:     }
                   7308:     return $output;
                   7309: }
                   7310: 
                   7311: sub instrule_disallow_msg {
1.615     raeburn  7312:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  7313:     my $response;
                   7314:     my %text = (
                   7315:                   item   => 'username',
                   7316:                   items  => 'usernames',
                   7317:                   match  => 'matches',
                   7318:                   do     => 'does',
                   7319:                   action => 'a username',
                   7320:                   one    => 'one',
                   7321:                );
                   7322:     if ($count > 1) {
                   7323:         $text{'item'} = 'usernames';
                   7324:         $text{'match'} ='match';
                   7325:         $text{'do'} = 'do';
                   7326:         $text{'action'} = 'usernames',
                   7327:         $text{'one'} = 'ones';
                   7328:     }
                   7329:     if ($checkitem eq 'id') {
                   7330:         $text{'items'} = 'IDs';
                   7331:         $text{'item'} = 'ID';
                   7332:         $text{'action'} = 'an ID';
1.615     raeburn  7333:         if ($count > 1) {
                   7334:             $text{'item'} = 'IDs';
                   7335:             $text{'action'} = 'IDs';
                   7336:         }
1.612     raeburn  7337:     }
1.674     bisitz   7338:     $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",'<span class="LC_cusr_emph">'.$domdesc.'</span>').'<br />';
1.615     raeburn  7339:     if ($mode eq 'upload') {
                   7340:         if ($checkitem eq 'username') {
                   7341:             $response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   7342:         } elsif ($checkitem eq 'id') {
1.674     bisitz   7343:             $response .= &mt("Either upload a file which includes $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the Student/Employee ID field.");
1.615     raeburn  7344:         }
1.669     raeburn  7345:     } elsif ($mode eq 'selfcreate') {
                   7346:         if ($checkitem eq 'id') {
                   7347:             $response .= &mt("You must either choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
                   7348:         }
1.615     raeburn  7349:     } else {
                   7350:         if ($checkitem eq 'username') {
                   7351:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   7352:         } elsif ($checkitem eq 'id') {
                   7353:             $response .= &mt("You must either choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
                   7354:         }
1.612     raeburn  7355:     }
                   7356:     return $response;
1.585     raeburn  7357: }
                   7358: 
1.624     raeburn  7359: sub personal_data_fieldtitles {
                   7360:     my %fieldtitles = &Apache::lonlocal::texthash (
                   7361:                         id => 'Student/Employee ID',
                   7362:                         permanentemail => 'E-mail address',
                   7363:                         lastname => 'Last Name',
                   7364:                         firstname => 'First Name',
                   7365:                         middlename => 'Middle Name',
                   7366:                         generation => 'Generation',
                   7367:                         gen => 'Generation',
                   7368:                    );
                   7369:     return %fieldtitles;
                   7370: }
                   7371: 
1.642     raeburn  7372: sub sorted_inst_types {
                   7373:     my ($dom) = @_;
                   7374:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   7375:     my $othertitle = &mt('All users');
                   7376:     if ($env{'request.course.id'}) {
1.668     raeburn  7377:         $othertitle  = &mt('Any users');
1.642     raeburn  7378:     }
                   7379:     my @types;
                   7380:     if (ref($order) eq 'ARRAY') {
                   7381:         @types = @{$order};
                   7382:     }
                   7383:     if (@types == 0) {
                   7384:         if (ref($usertypes) eq 'HASH') {
                   7385:             @types = sort(keys(%{$usertypes}));
                   7386:         }
                   7387:     }
                   7388:     if (keys(%{$usertypes}) > 0) {
                   7389:         $othertitle = &mt('Other users');
                   7390:     }
                   7391:     return ($othertitle,$usertypes,\@types);
                   7392: }
                   7393: 
1.645     raeburn  7394: sub get_institutional_codes {
                   7395:     my ($settings,$allcourses,$LC_code) = @_;
                   7396: # Get complete list of course sections to update
                   7397:     my @currsections = ();
                   7398:     my @currxlists = ();
                   7399:     my $coursecode = $$settings{'internal.coursecode'};
                   7400: 
                   7401:     if ($$settings{'internal.sectionnums'} ne '') {
                   7402:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   7403:     }
                   7404: 
                   7405:     if ($$settings{'internal.crosslistings'} ne '') {
                   7406:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   7407:     }
                   7408: 
                   7409:     if (@currxlists > 0) {
                   7410:         foreach (@currxlists) {
                   7411:             if (m/^([^:]+):(\w*)$/) {
                   7412:                 unless (grep/^$1$/,@{$allcourses}) {
                   7413:                     push @{$allcourses},$1;
                   7414:                     $$LC_code{$1} = $2;
                   7415:                 }
                   7416:             }
                   7417:         }
                   7418:     }
                   7419:  
                   7420:     if (@currsections > 0) {
                   7421:         foreach (@currsections) {
                   7422:             if (m/^(\w+):(\w*)$/) {
                   7423:                 my $sec = $coursecode.$1;
                   7424:                 my $lc_sec = $2;
                   7425:                 unless (grep/^$sec$/,@{$allcourses}) {
                   7426:                     push @{$allcourses},$sec;
                   7427:                     $$LC_code{$sec} = $lc_sec;
                   7428:                 }
                   7429:             }
                   7430:         }
                   7431:     }
                   7432:     return;
                   7433: }
                   7434: 
1.112     bowersj2 7435: =pod
                   7436: 
1.549     albertel 7437: =back
                   7438: 
                   7439: =head1 HTTP Helpers
                   7440: 
                   7441: =over 4
                   7442: 
1.648     raeburn  7443: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 7444: 
1.258     albertel 7445: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 7446: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 7447: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 7448: 
                   7449: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   7450: $possible_names is an ref to an array of form element names.  As an example:
                   7451: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 7452: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 7453: 
                   7454: =cut
1.1       albertel 7455: 
1.6       albertel 7456: sub get_unprocessed_cgi {
1.25      albertel 7457:   my ($query,$possible_names)= @_;
1.26      matthew  7458:   # $Apache::lonxml::debug=1;
1.356     albertel 7459:   foreach my $pair (split(/&/,$query)) {
                   7460:     my ($name, $value) = split(/=/,$pair);
1.369     www      7461:     $name = &unescape($name);
1.25      albertel 7462:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   7463:       $value =~ tr/+/ /;
                   7464:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 7465:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 7466:     }
1.16      harris41 7467:   }
1.6       albertel 7468: }
                   7469: 
1.112     bowersj2 7470: =pod
                   7471: 
1.648     raeburn  7472: =item * &cacheheader() 
1.112     bowersj2 7473: 
                   7474: returns cache-controlling header code
                   7475: 
                   7476: =cut
                   7477: 
1.7       albertel 7478: sub cacheheader {
1.258     albertel 7479:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 7480:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   7481:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 7482:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   7483:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 7484:     return $output;
1.7       albertel 7485: }
                   7486: 
1.112     bowersj2 7487: =pod
                   7488: 
1.648     raeburn  7489: =item * &no_cache($r) 
1.112     bowersj2 7490: 
                   7491: specifies header code to not have cache
                   7492: 
                   7493: =cut
                   7494: 
1.9       albertel 7495: sub no_cache {
1.216     albertel 7496:     my ($r) = @_;
                   7497:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 7498: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 7499:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   7500:     $r->no_cache(1);
                   7501:     $r->header_out("Expires" => $date);
                   7502:     $r->header_out("Pragma" => "no-cache");
1.123     www      7503: }
                   7504: 
                   7505: sub content_type {
1.181     albertel 7506:     my ($r,$type,$charset) = @_;
1.299     foxr     7507:     if ($r) {
                   7508: 	#  Note that printout.pl calls this with undef for $r.
                   7509: 	&no_cache($r);
                   7510:     }
1.258     albertel 7511:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 7512:     unless ($charset) {
                   7513: 	$charset=&Apache::lonlocal::current_encoding;
                   7514:     }
                   7515:     if ($charset) { $type.='; charset='.$charset; }
                   7516:     if ($r) {
                   7517: 	$r->content_type($type);
                   7518:     } else {
                   7519: 	print("Content-type: $type\n\n");
                   7520:     }
1.9       albertel 7521: }
1.25      albertel 7522: 
1.112     bowersj2 7523: =pod
                   7524: 
1.648     raeburn  7525: =item * &add_to_env($name,$value) 
1.112     bowersj2 7526: 
1.258     albertel 7527: adds $name to the %env hash with value
1.112     bowersj2 7528: $value, if $name already exists, the entry is converted to an array
                   7529: reference and $value is added to the array.
                   7530: 
                   7531: =cut
                   7532: 
1.25      albertel 7533: sub add_to_env {
                   7534:   my ($name,$value)=@_;
1.258     albertel 7535:   if (defined($env{$name})) {
                   7536:     if (ref($env{$name})) {
1.25      albertel 7537:       #already have multiple values
1.258     albertel 7538:       push(@{ $env{$name} },$value);
1.25      albertel 7539:     } else {
                   7540:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 7541:       my $first=$env{$name};
                   7542:       undef($env{$name});
                   7543:       push(@{ $env{$name} },$first,$value);
1.25      albertel 7544:     }
                   7545:   } else {
1.258     albertel 7546:     $env{$name}=$value;
1.25      albertel 7547:   }
1.31      albertel 7548: }
1.149     albertel 7549: 
                   7550: =pod
                   7551: 
1.648     raeburn  7552: =item * &get_env_multiple($name) 
1.149     albertel 7553: 
1.258     albertel 7554: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 7555: values may be defined and end up as an array ref.
                   7556: 
                   7557: returns an array of values
                   7558: 
                   7559: =cut
                   7560: 
                   7561: sub get_env_multiple {
                   7562:     my ($name) = @_;
                   7563:     my @values;
1.258     albertel 7564:     if (defined($env{$name})) {
1.149     albertel 7565:         # exists is it an array
1.258     albertel 7566:         if (ref($env{$name})) {
                   7567:             @values=@{ $env{$name} };
1.149     albertel 7568:         } else {
1.258     albertel 7569:             $values[0]=$env{$name};
1.149     albertel 7570:         }
                   7571:     }
                   7572:     return(@values);
                   7573: }
                   7574: 
1.660     raeburn  7575: sub ask_for_embedded_content {
                   7576:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
                   7577:     my $upload_output = '
                   7578:    <form name="upload_embedded" action="'.$actionurl.'"
                   7579:                   method="post" enctype="multipart/form-data">';
                   7580:     $upload_output .= $state;
1.661     raeburn  7581:     $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660     raeburn  7582: 
                   7583:     my $num = 0;
                   7584:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
                   7585:         $upload_output .= &start_data_table_row().
                   7586:             '<td>'.$embed_file.'</td><td>';
                   7587:         if ($args->{'ignore_remote_references'}
                   7588:             && $embed_file =~ m{^\w+://}) {
                   7589:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
                   7590:         } elsif ($args->{'error_on_invalid_names'}
                   7591:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   7592: 
                   7593:             $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
                   7594: 
                   7595:         } else {
                   7596:             $upload_output .='
1.661     raeburn  7597:            <input name="embedded_item_'.$num.'" type="file" value="" />
1.660     raeburn  7598:            <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
                   7599:             my $attrib = join(':',@{$$allfiles{$embed_file}});
                   7600:             $upload_output .=
                   7601:                 "\n\t\t".
                   7602:                 '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   7603:                 $attrib.'" />';
                   7604:             if (exists($$codebase{$embed_file})) {
                   7605:                 $upload_output .=
                   7606:                     "\n\t\t".
                   7607:                     '<input name="codebase_'.$num.'" type="hidden" value="'.
                   7608:                     &escape($$codebase{$embed_file}).'" />';
                   7609:             }
                   7610:         }
                   7611:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
                   7612:         $num++;
                   7613:     }
                   7614:     $upload_output .= &Apache::loncommon::end_data_table().'<br />
                   7615:    <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
                   7616:    <input type ="submit" value="'.&mt('Upload Listed Files').'" />
                   7617:    '.&mt('(only files for which a location has been provided will be uploaded)').'
                   7618:    </form>';
                   7619:     return $upload_output;
                   7620: }
                   7621: 
1.661     raeburn  7622: sub upload_embedded {
                   7623:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
                   7624:         $current_disk_usage) = @_;
                   7625:     my $output;
                   7626:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   7627:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   7628:         my $orig_uploaded_filename =
                   7629:             $env{'form.embedded_item_'.$i.'.filename'};
                   7630: 
                   7631:         $env{'form.embedded_orig_'.$i} =
                   7632:             &unescape($env{'form.embedded_orig_'.$i});
                   7633:         my ($path,$fname) =
                   7634:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   7635:         # no path, whole string is fname
                   7636:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   7637: 
                   7638:         $path = $env{'form.currentpath'}.$path;
                   7639:         $fname = &Apache::lonnet::clean_filename($fname);
                   7640:         # See if there is anything left
                   7641:         next if ($fname eq '');
                   7642: 
                   7643:         # Check if file already exists as a file or directory.
                   7644:         my ($state,$msg);
                   7645:         if ($context eq 'portfolio') {
                   7646:             my $port_path = $dirpath;
                   7647:             if ($group ne '') {
                   7648:                 $port_path = "groups/$group/$port_path";
                   7649:             }
                   7650:             ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
                   7651:                                               $dir_root,$port_path,$disk_quota,
                   7652:                                               $current_disk_usage,$uname,$udom);
                   7653:             if ($state eq 'will_exceed_quota'
                   7654:                 || $state eq 'file_locked'
                   7655:                 || $state eq 'file_exists' ) {
                   7656:                 $output .= $msg;
                   7657:                 next;
                   7658:             }
                   7659:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   7660:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   7661:             if ($state eq 'exists') {
                   7662:                 $output .= $msg;
                   7663:                 next;
                   7664:             }
                   7665:         }
                   7666:         # Check if extension is valid
                   7667:         if (($fname =~ /\.(\w+)$/) &&
                   7668:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
                   7669:             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
                   7670:             next;
                   7671:         } elsif (($fname =~ /\.(\w+)$/) &&
                   7672:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
                   7673:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
                   7674:             next;
                   7675:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
                   7676:             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
                   7677:             next;
                   7678:         }
                   7679: 
                   7680:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   7681:         if ($context eq 'portfolio') {
                   7682:             my $result=
                   7683:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
                   7684:                                                 $dirpath.$path);
                   7685:             if ($result !~ m|^/uploaded/|) {
                   7686:                 $output .= '<span class="LC_error">'
                   7687:                       .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   7688:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   7689:                       .'</span><br />';
                   7690:                 next;
                   7691:             } else {
                   7692:                 $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
                   7693:                            $path.$fname.'</span>').'</p>';     
                   7694:             }
                   7695:         } else {
                   7696: # Save the file
                   7697:             my $target = $env{'form.embedded_item_'.$i};
                   7698:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   7699:             my $dest = $fullpath.$fname;
                   7700:             my $url = $url_root.$dirpath.'/'.$path.$fname;
                   7701:             my @parts=split(/\//,$fullpath);
                   7702:             my $count;
                   7703:             my $filepath = $dir_root;
                   7704:             for ($count=4;$count<=$#parts;$count++) {
                   7705:                 $filepath .= "/$parts[$count]";
                   7706:                 if ((-e $filepath)!=1) {
                   7707:                     mkdir($filepath,0770);
                   7708:                 }
                   7709:             }
                   7710:             my $fh;
                   7711:             if (!open($fh,'>'.$dest)) {
                   7712:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   7713:                 $output .= '<span class="LC_error">'.
                   7714:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   7715:                            '</span><br />';
                   7716:             } else {
                   7717:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   7718:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   7719:                     $output .= '<span class="LC_error">'.
                   7720:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   7721:                               '</span><br />';
                   7722:                 } else {
                   7723:                     if ($context eq 'testbank') {
                   7724:                         $output .= &mt('Embedded file uploaded successfully:').
                   7725:                                    '&nbsp;<a href="'.$url.'">'.
                   7726:                                    $orig_uploaded_filename.'</a><br />';
                   7727:                     } else {
1.705     tempelho 7728:                         $output .= '<span class=\"LC_fontsize_large\">'.
1.661     raeburn  7729:                                    &mt('View embedded file: [_1]','<a href="'.$url.'">'.
1.705     tempelho 7730:                                    $orig_uploaded_filename.'</a>').'</span><br />';
1.661     raeburn  7731:                     }
                   7732:                 }
                   7733:                 close($fh);
                   7734:             }
                   7735:         }
                   7736:     }
                   7737:     return $output;
                   7738: }
                   7739: 
                   7740: sub check_for_existing {
                   7741:     my ($path,$fname,$element) = @_;
                   7742:     my ($state,$msg);
                   7743:     if (-d $path.'/'.$fname) {
                   7744:         $state = 'exists';
                   7745:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   7746:     } elsif (-e $path.'/'.$fname) {
                   7747:         $state = 'exists';
                   7748:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   7749:     }
                   7750:     if ($state eq 'exists') {
                   7751:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   7752:     }
                   7753:     return ($state,$msg);
                   7754: }
                   7755: 
                   7756: sub check_for_upload {
                   7757:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   7758:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
                   7759:     my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
                   7760:     my $getpropath = 1;
                   7761:     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
                   7762:                                             $getpropath);
                   7763:     my $found_file = 0;
                   7764:     my $locked_file = 0;
                   7765:     foreach my $line (@dir_list) {
                   7766:         my ($file_name)=split(/\&/,$line,2);
                   7767:         if ($file_name eq $fname){
                   7768:             $file_name = $path.$file_name;
                   7769:             if ($group ne '') {
                   7770:                 $file_name = $group.$file_name;
                   7771:             }
                   7772:             $found_file = 1;
                   7773:             if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
                   7774:                 $locked_file = 1;
                   7775:             }
                   7776:         }
                   7777:     }
                   7778:     if (($current_disk_usage + $filesize) > $disk_quota){
                   7779:         my $msg = '<span class="LC_error">'.
                   7780:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   7781:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   7782:         return ('will_exceed_quota',$msg);
                   7783:     } elsif ($found_file) {
                   7784:         if ($locked_file) {
                   7785:             my $msg = '<span class="LC_error">';
                   7786:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
                   7787:             $msg .= '</span><br />';
                   7788:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   7789:             return ('file_locked',$msg);
                   7790:         } else {
                   7791:             my $msg = '<span class="LC_error">';
                   7792:             $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
                   7793:             $msg .= '</span>';
                   7794:             $msg .= '<br />';
                   7795:             $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
                   7796:             return ('file_exists',$msg);
                   7797:         }
                   7798:     }
                   7799: }
                   7800: 
1.31      albertel 7801: 
1.41      ng       7802: =pod
1.45      matthew  7803: 
1.464     albertel 7804: =back
1.41      ng       7805: 
1.112     bowersj2 7806: =head1 CSV Upload/Handling functions
1.38      albertel 7807: 
1.41      ng       7808: =over 4
                   7809: 
1.648     raeburn  7810: =item * &upfile_store($r)
1.41      ng       7811: 
                   7812: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 7813: needs $env{'form.upfile'}
1.41      ng       7814: returns $datatoken to be put into hidden field
                   7815: 
                   7816: =cut
1.31      albertel 7817: 
                   7818: sub upfile_store {
                   7819:     my $r=shift;
1.258     albertel 7820:     $env{'form.upfile'}=~s/\r/\n/gs;
                   7821:     $env{'form.upfile'}=~s/\f/\n/gs;
                   7822:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   7823:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 7824: 
1.258     albertel 7825:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   7826: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 7827:     {
1.158     raeburn  7828:         my $datafile = $r->dir_config('lonDaemons').
                   7829:                            '/tmp/'.$datatoken.'.tmp';
                   7830:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 7831:             print $fh $env{'form.upfile'};
1.158     raeburn  7832:             close($fh);
                   7833:         }
1.31      albertel 7834:     }
                   7835:     return $datatoken;
                   7836: }
                   7837: 
1.56      matthew  7838: =pod
                   7839: 
1.648     raeburn  7840: =item * &load_tmp_file($r)
1.41      ng       7841: 
                   7842: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 7843: needs $env{'form.datatoken'},
                   7844: sets $env{'form.upfile'} to the contents of the file
1.41      ng       7845: 
                   7846: =cut
1.31      albertel 7847: 
                   7848: sub load_tmp_file {
                   7849:     my $r=shift;
                   7850:     my @studentdata=();
                   7851:     {
1.158     raeburn  7852:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 7853:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  7854:         if ( open(my $fh,"<$studentfile") ) {
                   7855:             @studentdata=<$fh>;
                   7856:             close($fh);
                   7857:         }
1.31      albertel 7858:     }
1.258     albertel 7859:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 7860: }
                   7861: 
1.56      matthew  7862: =pod
                   7863: 
1.648     raeburn  7864: =item * &upfile_record_sep()
1.41      ng       7865: 
                   7866: Separate uploaded file into records
                   7867: returns array of records,
1.258     albertel 7868: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       7869: 
                   7870: =cut
1.31      albertel 7871: 
                   7872: sub upfile_record_sep {
1.258     albertel 7873:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 7874:     } else {
1.248     albertel 7875: 	my @records;
1.258     albertel 7876: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 7877: 	    if ($line=~/^\s*$/) { next; }
                   7878: 	    push(@records,$line);
                   7879: 	}
                   7880: 	return @records;
1.31      albertel 7881:     }
                   7882: }
                   7883: 
1.56      matthew  7884: =pod
                   7885: 
1.648     raeburn  7886: =item * &record_sep($record)
1.41      ng       7887: 
1.258     albertel 7888: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       7889: 
                   7890: =cut
                   7891: 
1.263     www      7892: sub takeleft {
                   7893:     my $index=shift;
                   7894:     return substr('0000'.$index,-4,4);
                   7895: }
                   7896: 
1.31      albertel 7897: sub record_sep {
                   7898:     my $record=shift;
                   7899:     my %components=();
1.258     albertel 7900:     if ($env{'form.upfiletype'} eq 'xml') {
                   7901:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 7902:         my $i=0;
1.356     albertel 7903:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 7904:             $field=~s/^(\"|\')//;
                   7905:             $field=~s/(\"|\')$//;
1.263     www      7906:             $components{&takeleft($i)}=$field;
1.31      albertel 7907:             $i++;
                   7908:         }
1.258     albertel 7909:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 7910:         my $i=0;
1.356     albertel 7911:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 7912:             $field=~s/^(\"|\')//;
                   7913:             $field=~s/(\"|\')$//;
1.263     www      7914:             $components{&takeleft($i)}=$field;
1.31      albertel 7915:             $i++;
                   7916:         }
                   7917:     } else {
1.561     www      7918:         my $separator=',';
1.480     banghart 7919:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      7920:             $separator=';';
1.480     banghart 7921:         }
1.31      albertel 7922:         my $i=0;
1.561     www      7923: # the character we are looking for to indicate the end of a quote or a record 
                   7924:         my $looking_for=$separator;
                   7925: # do not add the characters to the fields
                   7926:         my $ignore=0;
                   7927: # we just encountered a separator (or the beginning of the record)
                   7928:         my $just_found_separator=1;
                   7929: # store the field we are working on here
                   7930:         my $field='';
                   7931: # work our way through all characters in record
                   7932:         foreach my $character ($record=~/(.)/g) {
                   7933:             if ($character eq $looking_for) {
                   7934:                if ($character ne $separator) {
                   7935: # Found the end of a quote, again looking for separator
                   7936:                   $looking_for=$separator;
                   7937:                   $ignore=1;
                   7938:                } else {
                   7939: # Found a separator, store away what we got
                   7940:                   $components{&takeleft($i)}=$field;
                   7941: 	          $i++;
                   7942:                   $just_found_separator=1;
                   7943:                   $ignore=0;
                   7944:                   $field='';
                   7945:                }
                   7946:                next;
                   7947:             }
                   7948: # single or double quotation marks after a separator indicate beginning of a quote
                   7949: # we are now looking for the end of the quote and need to ignore separators
                   7950:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   7951:                $looking_for=$character;
                   7952:                next;
                   7953:             }
                   7954: # ignore would be true after we reached the end of a quote
                   7955:             if ($ignore) { next; }
                   7956:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   7957:             $field.=$character;
                   7958:             $just_found_separator=0; 
1.31      albertel 7959:         }
1.561     www      7960: # catch the very last entry, since we never encountered the separator
                   7961:         $components{&takeleft($i)}=$field;
1.31      albertel 7962:     }
                   7963:     return %components;
                   7964: }
                   7965: 
1.144     matthew  7966: ######################################################
                   7967: ######################################################
                   7968: 
1.56      matthew  7969: =pod
                   7970: 
1.648     raeburn  7971: =item * &upfile_select_html()
1.41      ng       7972: 
1.144     matthew  7973: Return HTML code to select a file from the users machine and specify 
                   7974: the file type.
1.41      ng       7975: 
                   7976: =cut
                   7977: 
1.144     matthew  7978: ######################################################
                   7979: ######################################################
1.31      albertel 7980: sub upfile_select_html {
1.144     matthew  7981:     my %Types = (
                   7982:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 7983:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  7984:                  space => &mt('Space separated'),
                   7985:                  tab   => &mt('Tabulator separated'),
                   7986: #                 xml   => &mt('HTML/XML'),
                   7987:                  );
                   7988:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  7989:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  7990:     foreach my $type (sort(keys(%Types))) {
                   7991:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   7992:     }
                   7993:     $Str .= "</select>\n";
                   7994:     return $Str;
1.31      albertel 7995: }
                   7996: 
1.301     albertel 7997: sub get_samples {
                   7998:     my ($records,$toget) = @_;
                   7999:     my @samples=({});
                   8000:     my $got=0;
                   8001:     foreach my $rec (@$records) {
                   8002: 	my %temp = &record_sep($rec);
                   8003: 	if (! grep(/\S/, values(%temp))) { next; }
                   8004: 	if (%temp) {
                   8005: 	    $samples[$got]=\%temp;
                   8006: 	    $got++;
                   8007: 	    if ($got == $toget) { last; }
                   8008: 	}
                   8009:     }
                   8010:     return \@samples;
                   8011: }
                   8012: 
1.144     matthew  8013: ######################################################
                   8014: ######################################################
                   8015: 
1.56      matthew  8016: =pod
                   8017: 
1.648     raeburn  8018: =item * &csv_print_samples($r,$records)
1.41      ng       8019: 
                   8020: Prints a table of sample values from each column uploaded $r is an
                   8021: Apache Request ref, $records is an arrayref from
                   8022: &Apache::loncommon::upfile_record_sep
                   8023: 
                   8024: =cut
                   8025: 
1.144     matthew  8026: ######################################################
                   8027: ######################################################
1.31      albertel 8028: sub csv_print_samples {
                   8029:     my ($r,$records) = @_;
1.662     bisitz   8030:     my $samples = &get_samples($records,5);
1.301     albertel 8031: 
1.594     raeburn  8032:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   8033:               &start_data_table_header_row());
1.356     albertel 8034:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
                   8035:         $r->print('<th>'.&mt('Column&nbsp;[_1]',($sample+1)).'</th>'); }
1.594     raeburn  8036:     $r->print(&end_data_table_header_row());
1.301     albertel 8037:     foreach my $hash (@$samples) {
1.594     raeburn  8038: 	$r->print(&start_data_table_row());
1.356     albertel 8039: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 8040: 	    $r->print('<td>');
1.356     albertel 8041: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 8042: 	    $r->print('</td>');
                   8043: 	}
1.594     raeburn  8044: 	$r->print(&end_data_table_row());
1.31      albertel 8045:     }
1.594     raeburn  8046:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 8047: }
                   8048: 
1.144     matthew  8049: ######################################################
                   8050: ######################################################
                   8051: 
1.56      matthew  8052: =pod
                   8053: 
1.648     raeburn  8054: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       8055: 
                   8056: Prints a table to create associations between values and table columns.
1.144     matthew  8057: 
1.41      ng       8058: $r is an Apache Request ref,
                   8059: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  8060: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       8061: 
                   8062: =cut
                   8063: 
1.144     matthew  8064: ######################################################
                   8065: ######################################################
1.31      albertel 8066: sub csv_print_select_table {
                   8067:     my ($r,$records,$d) = @_;
1.301     albertel 8068:     my $i=0;
                   8069:     my $samples = &get_samples($records,1);
1.144     matthew  8070:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  8071: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  8072:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  8073:               '<th>'.&mt('Column').'</th>'.
                   8074:               &end_data_table_header_row()."\n");
1.356     albertel 8075:     foreach my $array_ref (@$d) {
                   8076: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  8077: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 8078: 
                   8079: 	$r->print('<td><select name=f'.$i.
1.32      matthew  8080: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 8081: 	$r->print('<option value="none"></option>');
1.356     albertel 8082: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   8083: 	    $r->print('<option value="'.$sample.'"'.
                   8084:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   8085:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 8086: 	}
1.594     raeburn  8087: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 8088: 	$i++;
                   8089:     }
1.594     raeburn  8090:     $r->print(&end_data_table());
1.31      albertel 8091:     $i--;
                   8092:     return $i;
                   8093: }
1.56      matthew  8094: 
1.144     matthew  8095: ######################################################
                   8096: ######################################################
                   8097: 
1.56      matthew  8098: =pod
1.31      albertel 8099: 
1.648     raeburn  8100: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       8101: 
                   8102: Prints a table of sample values from the upload and can make associate samples to internal names.
                   8103: 
                   8104: $r is an Apache Request ref,
                   8105: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   8106: $d is an array of 2 element arrays (internal name, displayed name)
                   8107: 
                   8108: =cut
                   8109: 
1.144     matthew  8110: ######################################################
                   8111: ######################################################
1.31      albertel 8112: sub csv_samples_select_table {
                   8113:     my ($r,$records,$d) = @_;
                   8114:     my $i=0;
1.144     matthew  8115:     #
1.662     bisitz   8116:     my $max_samples = 5;
                   8117:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  8118:     $r->print(&start_data_table().
                   8119:               &start_data_table_header_row().'<th>'.
                   8120:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   8121:               &end_data_table_header_row());
1.301     albertel 8122: 
                   8123:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  8124: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  8125: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 8126: 	foreach my $option (@$d) {
                   8127: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  8128: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 8129:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  8130:                       $display.'</option>');
1.31      albertel 8131: 	}
                   8132: 	$r->print('</select></td><td>');
1.662     bisitz   8133: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 8134: 	    if (defined($samples->[$line]{$key})) { 
                   8135: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   8136: 	    }
                   8137: 	}
1.594     raeburn  8138: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 8139: 	$i++;
                   8140:     }
1.594     raeburn  8141:     $r->print(&end_data_table());
1.31      albertel 8142:     $i--;
                   8143:     return($i);
1.115     matthew  8144: }
                   8145: 
1.144     matthew  8146: ######################################################
                   8147: ######################################################
                   8148: 
1.115     matthew  8149: =pod
                   8150: 
1.648     raeburn  8151: =item * &clean_excel_name($name)
1.115     matthew  8152: 
                   8153: Returns a replacement for $name which does not contain any illegal characters.
                   8154: 
                   8155: =cut
                   8156: 
1.144     matthew  8157: ######################################################
                   8158: ######################################################
1.115     matthew  8159: sub clean_excel_name {
                   8160:     my ($name) = @_;
                   8161:     $name =~ s/[:\*\?\/\\]//g;
                   8162:     if (length($name) > 31) {
                   8163:         $name = substr($name,0,31);
                   8164:     }
                   8165:     return $name;
1.25      albertel 8166: }
1.84      albertel 8167: 
1.85      albertel 8168: =pod
                   8169: 
1.648     raeburn  8170: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 8171: 
                   8172: Returns either 1 or undef
                   8173: 
                   8174: 1 if the part is to be hidden, undef if it is to be shown
                   8175: 
                   8176: Arguments are:
                   8177: 
                   8178: $id the id of the part to be checked
                   8179: $symb, optional the symb of the resource to check
                   8180: $udom, optional the domain of the user to check for
                   8181: $uname, optional the username of the user to check for
                   8182: 
                   8183: =cut
1.84      albertel 8184: 
                   8185: sub check_if_partid_hidden {
                   8186:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 8187:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 8188: 					 $symb,$udom,$uname);
1.141     albertel 8189:     my $truth=1;
                   8190:     #if the string starts with !, then the list is the list to show not hide
                   8191:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 8192:     my @hiddenlist=split(/,/,$hiddenparts);
                   8193:     foreach my $checkid (@hiddenlist) {
1.141     albertel 8194: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 8195:     }
1.141     albertel 8196:     return !$truth;
1.84      albertel 8197: }
1.127     matthew  8198: 
1.138     matthew  8199: 
                   8200: ############################################################
                   8201: ############################################################
                   8202: 
                   8203: =pod
                   8204: 
1.157     matthew  8205: =back 
                   8206: 
1.138     matthew  8207: =head1 cgi-bin script and graphing routines
                   8208: 
1.157     matthew  8209: =over 4
                   8210: 
1.648     raeburn  8211: =item * &get_cgi_id()
1.138     matthew  8212: 
                   8213: Inputs: none
                   8214: 
                   8215: Returns an id which can be used to pass environment variables
                   8216: to various cgi-bin scripts.  These environment variables will
                   8217: be removed from the users environment after a given time by
                   8218: the routine &Apache::lonnet::transfer_profile_to_env.
                   8219: 
                   8220: =cut
                   8221: 
                   8222: ############################################################
                   8223: ############################################################
1.152     albertel 8224: my $uniq=0;
1.136     matthew  8225: sub get_cgi_id {
1.154     albertel 8226:     $uniq=($uniq+1)%100000;
1.280     albertel 8227:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  8228: }
                   8229: 
1.127     matthew  8230: ############################################################
                   8231: ############################################################
                   8232: 
                   8233: =pod
                   8234: 
1.648     raeburn  8235: =item * &DrawBarGraph()
1.127     matthew  8236: 
1.138     matthew  8237: Facilitates the plotting of data in a (stacked) bar graph.
                   8238: Puts plot definition data into the users environment in order for 
                   8239: graph.png to plot it.  Returns an <img> tag for the plot.
                   8240: The bars on the plot are labeled '1','2',...,'n'.
                   8241: 
                   8242: Inputs:
                   8243: 
                   8244: =over 4
                   8245: 
                   8246: =item $Title: string, the title of the plot
                   8247: 
                   8248: =item $xlabel: string, text describing the X-axis of the plot
                   8249: 
                   8250: =item $ylabel: string, text describing the Y-axis of the plot
                   8251: 
                   8252: =item $Max: scalar, the maximum Y value to use in the plot
                   8253: If $Max is < any data point, the graph will not be rendered.
                   8254: 
1.140     matthew  8255: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  8256: they are plotted.  If undefined, default values will be used.
                   8257: 
1.178     matthew  8258: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   8259: 
1.138     matthew  8260: =item @Values: An array of array references.  Each array reference holds data
                   8261: to be plotted in a stacked bar chart.
                   8262: 
1.239     matthew  8263: =item If the final element of @Values is a hash reference the key/value
                   8264: pairs will be added to the graph definition.
                   8265: 
1.138     matthew  8266: =back
                   8267: 
                   8268: Returns:
                   8269: 
                   8270: An <img> tag which references graph.png and the appropriate identifying
                   8271: information for the plot.
                   8272: 
1.127     matthew  8273: =cut
                   8274: 
                   8275: ############################################################
                   8276: ############################################################
1.134     matthew  8277: sub DrawBarGraph {
1.178     matthew  8278:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  8279:     #
                   8280:     if (! defined($colors)) {
                   8281:         $colors = ['#33ff00', 
                   8282:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   8283:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   8284:                   ]; 
                   8285:     }
1.228     matthew  8286:     my $extra_settings = {};
                   8287:     if (ref($Values[-1]) eq 'HASH') {
                   8288:         $extra_settings = pop(@Values);
                   8289:     }
1.127     matthew  8290:     #
1.136     matthew  8291:     my $identifier = &get_cgi_id();
                   8292:     my $id = 'cgi.'.$identifier;        
1.129     matthew  8293:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  8294:         return '';
                   8295:     }
1.225     matthew  8296:     #
                   8297:     my @Labels;
                   8298:     if (defined($labels)) {
                   8299:         @Labels = @$labels;
                   8300:     } else {
                   8301:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   8302:             push (@Labels,$i+1);
                   8303:         }
                   8304:     }
                   8305:     #
1.129     matthew  8306:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  8307:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  8308:     my %ValuesHash;
                   8309:     my $NumSets=1;
                   8310:     foreach my $array (@Values) {
                   8311:         next if (! ref($array));
1.136     matthew  8312:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  8313:             join(',',@$array);
1.129     matthew  8314:     }
1.127     matthew  8315:     #
1.136     matthew  8316:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  8317:     if ($NumBars < 3) {
                   8318:         $width = 120+$NumBars*32;
1.220     matthew  8319:         $xskip = 1;
1.225     matthew  8320:         $bar_width = 30;
                   8321:     } elsif ($NumBars < 5) {
                   8322:         $width = 120+$NumBars*20;
                   8323:         $xskip = 1;
                   8324:         $bar_width = 20;
1.220     matthew  8325:     } elsif ($NumBars < 10) {
1.136     matthew  8326:         $width = 120+$NumBars*15;
                   8327:         $xskip = 1;
                   8328:         $bar_width = 15;
                   8329:     } elsif ($NumBars <= 25) {
                   8330:         $width = 120+$NumBars*11;
                   8331:         $xskip = 5;
                   8332:         $bar_width = 8;
                   8333:     } elsif ($NumBars <= 50) {
                   8334:         $width = 120+$NumBars*8;
                   8335:         $xskip = 5;
                   8336:         $bar_width = 4;
                   8337:     } else {
                   8338:         $width = 120+$NumBars*8;
                   8339:         $xskip = 5;
                   8340:         $bar_width = 4;
                   8341:     }
                   8342:     #
1.137     matthew  8343:     $Max = 1 if ($Max < 1);
                   8344:     if ( int($Max) < $Max ) {
                   8345:         $Max++;
                   8346:         $Max = int($Max);
                   8347:     }
1.127     matthew  8348:     $Title  = '' if (! defined($Title));
                   8349:     $xlabel = '' if (! defined($xlabel));
                   8350:     $ylabel = '' if (! defined($ylabel));
1.369     www      8351:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   8352:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   8353:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  8354:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  8355:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   8356:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   8357:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   8358:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   8359:     $ValuesHash{$id.'.height'}   = $height;
                   8360:     $ValuesHash{$id.'.width'}    = $width;
                   8361:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   8362:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   8363:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  8364:     #
1.228     matthew  8365:     # Deal with other parameters
                   8366:     while (my ($key,$value) = each(%$extra_settings)) {
                   8367:         $ValuesHash{$id.'.'.$key} = $value;
                   8368:     }
                   8369:     #
1.646     raeburn  8370:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  8371:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   8372: }
                   8373: 
                   8374: ############################################################
                   8375: ############################################################
                   8376: 
                   8377: =pod
                   8378: 
1.648     raeburn  8379: =item * &DrawXYGraph()
1.137     matthew  8380: 
1.138     matthew  8381: Facilitates the plotting of data in an XY graph.
                   8382: Puts plot definition data into the users environment in order for 
                   8383: graph.png to plot it.  Returns an <img> tag for the plot.
                   8384: 
                   8385: Inputs:
                   8386: 
                   8387: =over 4
                   8388: 
                   8389: =item $Title: string, the title of the plot
                   8390: 
                   8391: =item $xlabel: string, text describing the X-axis of the plot
                   8392: 
                   8393: =item $ylabel: string, text describing the Y-axis of the plot
                   8394: 
                   8395: =item $Max: scalar, the maximum Y value to use in the plot
                   8396: If $Max is < any data point, the graph will not be rendered.
                   8397: 
                   8398: =item $colors: Array ref containing the hex color codes for the data to be 
                   8399: plotted in.  If undefined, default values will be used.
                   8400: 
                   8401: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   8402: 
                   8403: =item $Ydata: Array ref containing Array refs.  
1.185     www      8404: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  8405: 
                   8406: =item %Values: hash indicating or overriding any default values which are 
                   8407: passed to graph.png.  
                   8408: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   8409: 
                   8410: =back
                   8411: 
                   8412: Returns:
                   8413: 
                   8414: An <img> tag which references graph.png and the appropriate identifying
                   8415: information for the plot.
                   8416: 
1.137     matthew  8417: =cut
                   8418: 
                   8419: ############################################################
                   8420: ############################################################
                   8421: sub DrawXYGraph {
                   8422:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   8423:     #
                   8424:     # Create the identifier for the graph
                   8425:     my $identifier = &get_cgi_id();
                   8426:     my $id = 'cgi.'.$identifier;
                   8427:     #
                   8428:     $Title  = '' if (! defined($Title));
                   8429:     $xlabel = '' if (! defined($xlabel));
                   8430:     $ylabel = '' if (! defined($ylabel));
                   8431:     my %ValuesHash = 
                   8432:         (
1.369     www      8433:          $id.'.title'  => &escape($Title),
                   8434:          $id.'.xlabel' => &escape($xlabel),
                   8435:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  8436:          $id.'.y_max_value'=> $Max,
                   8437:          $id.'.labels'     => join(',',@$Xlabels),
                   8438:          $id.'.PlotType'   => 'XY',
                   8439:          );
                   8440:     #
                   8441:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   8442:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   8443:     }
                   8444:     #
                   8445:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   8446:         return '';
                   8447:     }
                   8448:     my $NumSets=1;
1.138     matthew  8449:     foreach my $array (@{$Ydata}){
1.137     matthew  8450:         next if (! ref($array));
                   8451:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   8452:     }
1.138     matthew  8453:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  8454:     #
                   8455:     # Deal with other parameters
                   8456:     while (my ($key,$value) = each(%Values)) {
                   8457:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  8458:     }
                   8459:     #
1.646     raeburn  8460:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  8461:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   8462: }
                   8463: 
                   8464: ############################################################
                   8465: ############################################################
                   8466: 
                   8467: =pod
                   8468: 
1.648     raeburn  8469: =item * &DrawXYYGraph()
1.138     matthew  8470: 
                   8471: Facilitates the plotting of data in an XY graph with two Y axes.
                   8472: Puts plot definition data into the users environment in order for 
                   8473: graph.png to plot it.  Returns an <img> tag for the plot.
                   8474: 
                   8475: Inputs:
                   8476: 
                   8477: =over 4
                   8478: 
                   8479: =item $Title: string, the title of the plot
                   8480: 
                   8481: =item $xlabel: string, text describing the X-axis of the plot
                   8482: 
                   8483: =item $ylabel: string, text describing the Y-axis of the plot
                   8484: 
                   8485: =item $colors: Array ref containing the hex color codes for the data to be 
                   8486: plotted in.  If undefined, default values will be used.
                   8487: 
                   8488: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   8489: 
                   8490: =item $Ydata1: The first data set
                   8491: 
                   8492: =item $Min1: The minimum value of the left Y-axis
                   8493: 
                   8494: =item $Max1: The maximum value of the left Y-axis
                   8495: 
                   8496: =item $Ydata2: The second data set
                   8497: 
                   8498: =item $Min2: The minimum value of the right Y-axis
                   8499: 
                   8500: =item $Max2: The maximum value of the left Y-axis
                   8501: 
                   8502: =item %Values: hash indicating or overriding any default values which are 
                   8503: passed to graph.png.  
                   8504: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   8505: 
                   8506: =back
                   8507: 
                   8508: Returns:
                   8509: 
                   8510: An <img> tag which references graph.png and the appropriate identifying
                   8511: information for the plot.
1.136     matthew  8512: 
                   8513: =cut
                   8514: 
                   8515: ############################################################
                   8516: ############################################################
1.137     matthew  8517: sub DrawXYYGraph {
                   8518:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   8519:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  8520:     #
                   8521:     # Create the identifier for the graph
                   8522:     my $identifier = &get_cgi_id();
                   8523:     my $id = 'cgi.'.$identifier;
                   8524:     #
                   8525:     $Title  = '' if (! defined($Title));
                   8526:     $xlabel = '' if (! defined($xlabel));
                   8527:     $ylabel = '' if (! defined($ylabel));
                   8528:     my %ValuesHash = 
                   8529:         (
1.369     www      8530:          $id.'.title'  => &escape($Title),
                   8531:          $id.'.xlabel' => &escape($xlabel),
                   8532:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  8533:          $id.'.labels' => join(',',@$Xlabels),
                   8534:          $id.'.PlotType' => 'XY',
                   8535:          $id.'.NumSets' => 2,
1.137     matthew  8536:          $id.'.two_axes' => 1,
                   8537:          $id.'.y1_max_value' => $Max1,
                   8538:          $id.'.y1_min_value' => $Min1,
                   8539:          $id.'.y2_max_value' => $Max2,
                   8540:          $id.'.y2_min_value' => $Min2,
1.136     matthew  8541:          );
                   8542:     #
1.137     matthew  8543:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   8544:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   8545:     }
                   8546:     #
                   8547:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   8548:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  8549:         return '';
                   8550:     }
                   8551:     my $NumSets=1;
1.137     matthew  8552:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  8553:         next if (! ref($array));
                   8554:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  8555:     }
                   8556:     #
                   8557:     # Deal with other parameters
                   8558:     while (my ($key,$value) = each(%Values)) {
                   8559:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  8560:     }
                   8561:     #
1.646     raeburn  8562:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 8563:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  8564: }
                   8565: 
                   8566: ############################################################
                   8567: ############################################################
                   8568: 
                   8569: =pod
                   8570: 
1.157     matthew  8571: =back 
                   8572: 
1.139     matthew  8573: =head1 Statistics helper routines?  
                   8574: 
                   8575: Bad place for them but what the hell.
                   8576: 
1.157     matthew  8577: =over 4
                   8578: 
1.648     raeburn  8579: =item * &chartlink()
1.139     matthew  8580: 
                   8581: Returns a link to the chart for a specific student.  
                   8582: 
                   8583: Inputs:
                   8584: 
                   8585: =over 4
                   8586: 
                   8587: =item $linktext: The text of the link
                   8588: 
                   8589: =item $sname: The students username
                   8590: 
                   8591: =item $sdomain: The students domain
                   8592: 
                   8593: =back
                   8594: 
1.157     matthew  8595: =back
                   8596: 
1.139     matthew  8597: =cut
                   8598: 
                   8599: ############################################################
                   8600: ############################################################
                   8601: sub chartlink {
                   8602:     my ($linktext, $sname, $sdomain) = @_;
                   8603:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      8604:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 8605:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  8606:        '">'.$linktext.'</a>';
1.153     matthew  8607: }
                   8608: 
                   8609: #######################################################
                   8610: #######################################################
                   8611: 
                   8612: =pod
                   8613: 
                   8614: =head1 Course Environment Routines
1.157     matthew  8615: 
                   8616: =over 4
1.153     matthew  8617: 
1.648     raeburn  8618: =item * &restore_course_settings()
1.153     matthew  8619: 
1.648     raeburn  8620: =item * &store_course_settings()
1.153     matthew  8621: 
                   8622: Restores/Store indicated form parameters from the course environment.
                   8623: Will not overwrite existing values of the form parameters.
                   8624: 
                   8625: Inputs: 
                   8626: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   8627: 
                   8628: a hash ref describing the data to be stored.  For example:
                   8629:    
                   8630: %Save_Parameters = ('Status' => 'scalar',
                   8631:     'chartoutputmode' => 'scalar',
                   8632:     'chartoutputdata' => 'scalar',
                   8633:     'Section' => 'array',
1.373     raeburn  8634:     'Group' => 'array',
1.153     matthew  8635:     'StudentData' => 'array',
                   8636:     'Maps' => 'array');
                   8637: 
                   8638: Returns: both routines return nothing
                   8639: 
1.631     raeburn  8640: =back
                   8641: 
1.153     matthew  8642: =cut
                   8643: 
                   8644: #######################################################
                   8645: #######################################################
                   8646: sub store_course_settings {
1.496     albertel 8647:     return &store_settings($env{'request.course.id'},@_);
                   8648: }
                   8649: 
                   8650: sub store_settings {
1.153     matthew  8651:     # save to the environment
                   8652:     # appenv the same items, just to be safe
1.300     albertel 8653:     my $udom  = $env{'user.domain'};
                   8654:     my $uname = $env{'user.name'};
1.496     albertel 8655:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  8656:     my %SaveHash;
                   8657:     my %AppHash;
                   8658:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 8659:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 8660:         my $envname = 'environment.'.$basename;
1.258     albertel 8661:         if (exists($env{'form.'.$setting})) {
1.153     matthew  8662:             # Save this value away
                   8663:             if ($type eq 'scalar' &&
1.258     albertel 8664:                 (! exists($env{$envname}) || 
                   8665:                  $env{$envname} ne $env{'form.'.$setting})) {
                   8666:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   8667:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  8668:             } elsif ($type eq 'array') {
                   8669:                 my $stored_form;
1.258     albertel 8670:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  8671:                     $stored_form = join(',',
                   8672:                                         map {
1.369     www      8673:                                             &escape($_);
1.258     albertel 8674:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  8675:                 } else {
                   8676:                     $stored_form = 
1.369     www      8677:                         &escape($env{'form.'.$setting});
1.153     matthew  8678:                 }
                   8679:                 # Determine if the array contents are the same.
1.258     albertel 8680:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  8681:                     $SaveHash{$basename} = $stored_form;
                   8682:                     $AppHash{$envname}   = $stored_form;
                   8683:                 }
                   8684:             }
                   8685:         }
                   8686:     }
                   8687:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 8688:                                           $udom,$uname);
1.153     matthew  8689:     if ($put_result !~ /^(ok|delayed)/) {
                   8690:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   8691:                                  'got error:'.$put_result);
                   8692:     }
                   8693:     # Make sure these settings stick around in this session, too
1.646     raeburn  8694:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  8695:     return;
                   8696: }
                   8697: 
                   8698: sub restore_course_settings {
1.499     albertel 8699:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 8700: }
                   8701: 
                   8702: sub restore_settings {
                   8703:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  8704:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 8705:         next if (exists($env{'form.'.$setting}));
1.496     albertel 8706:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  8707:             '.'.$setting;
1.258     albertel 8708:         if (exists($env{$envname})) {
1.153     matthew  8709:             if ($type eq 'scalar') {
1.258     albertel 8710:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  8711:             } elsif ($type eq 'array') {
1.258     albertel 8712:                 $env{'form.'.$setting} = [ 
1.153     matthew  8713:                                            map { 
1.369     www      8714:                                                &unescape($_); 
1.258     albertel 8715:                                            } split(',',$env{$envname})
1.153     matthew  8716:                                            ];
                   8717:             }
                   8718:         }
                   8719:     }
1.127     matthew  8720: }
                   8721: 
1.618     raeburn  8722: #######################################################
                   8723: #######################################################
                   8724: 
                   8725: =pod
                   8726: 
                   8727: =head1 Domain E-mail Routines  
                   8728: 
                   8729: =over 4
                   8730: 
1.648     raeburn  8731: =item * &build_recipient_list()
1.618     raeburn  8732: 
                   8733: Build recipient lists for three types of e-mail:
                   8734: (a) Error Reports, (b) Package Updates, (c) Help requests, generated by
1.619     raeburn  8735: lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively.
1.618     raeburn  8736: 
                   8737: Inputs:
1.619     raeburn  8738: defmail (scalar - email address of default recipient), 
1.618     raeburn  8739: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  8740: defdom (domain for which to retrieve configuration settings),
                   8741: origmail (scalar - email address of recipient from loncapa.conf, 
                   8742: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  8743: 
1.655     raeburn  8744: Returns: comma separated list of addresses to which to send e-mail.
                   8745: 
                   8746: =back
1.618     raeburn  8747: 
                   8748: =cut
                   8749: 
                   8750: ############################################################
                   8751: ############################################################
                   8752: sub build_recipient_list {
1.619     raeburn  8753:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  8754:     my @recipients;
                   8755:     my $otheremails;
                   8756:     my %domconfig =
                   8757:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   8758:     if (ref($domconfig{'contacts'}) eq 'HASH') {
                   8759:         if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   8760:             my @contacts = ('adminemail','supportemail');
                   8761:             foreach my $item (@contacts) {
                   8762:                 if ($domconfig{'contacts'}{$mailing}{$item}) {
1.619     raeburn  8763:                     my $addr = $domconfig{'contacts'}{$item}; 
                   8764:                     if (!grep(/^\Q$addr\E$/,@recipients)) {
                   8765:                         push(@recipients,$addr);
                   8766:                     }
1.618     raeburn  8767:                 }
                   8768:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   8769:             }
                   8770:         }
1.619     raeburn  8771:     } elsif ($origmail ne '') {
                   8772:         push(@recipients,$origmail);
1.618     raeburn  8773:     }
1.688     raeburn  8774:     if (defined($defmail)) {
                   8775:         if ($defmail ne '') {
                   8776:             push(@recipients,$defmail);
                   8777:         }
1.618     raeburn  8778:     }
                   8779:     if ($otheremails) {
1.619     raeburn  8780:         my @others;
                   8781:         if ($otheremails =~ /,/) {
                   8782:             @others = split(/,/,$otheremails);
1.618     raeburn  8783:         } else {
1.619     raeburn  8784:             push(@others,$otheremails);
                   8785:         }
                   8786:         foreach my $addr (@others) {
                   8787:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   8788:                 push(@recipients,$addr);
                   8789:             }
1.618     raeburn  8790:         }
                   8791:     }
1.619     raeburn  8792:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  8793:     return $recipientlist;
                   8794: }
                   8795: 
1.127     matthew  8796: ############################################################
                   8797: ############################################################
1.154     albertel 8798: 
1.655     raeburn  8799: =pod
                   8800: 
                   8801: =head1 Course Catalog Routines
                   8802: 
                   8803: =over 4
                   8804: 
                   8805: =item * &gather_categories()
                   8806: 
                   8807: Converts category definitions - keys of categories hash stored in  
                   8808: coursecategories in configuration.db on the primary library server in a 
                   8809: domain - to an array.  Also generates javascript and idx hash used to 
                   8810: generate Domain Coordinator interface for editing Course Categories.
                   8811: 
                   8812: Inputs:
1.663     raeburn  8813: 
1.655     raeburn  8814: categories (reference to hash of category definitions).
1.663     raeburn  8815: 
1.655     raeburn  8816: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   8817:       categories and subcategories).
1.663     raeburn  8818: 
1.655     raeburn  8819: idx (reference to hash of counters used in Domain Coordinator interface for 
                   8820:       editing Course Categories).
1.663     raeburn  8821: 
1.655     raeburn  8822: jsarray (reference to array of categories used to create Javascript arrays for
                   8823:          Domain Coordinator interface for editing Course Categories).
                   8824: 
                   8825: Returns: nothing
                   8826: 
                   8827: Side effects: populates cats, idx and jsarray. 
                   8828: 
                   8829: =cut
                   8830: 
                   8831: sub gather_categories {
                   8832:     my ($categories,$cats,$idx,$jsarray) = @_;
                   8833:     my %counters;
                   8834:     my $num = 0;
                   8835:     foreach my $item (keys(%{$categories})) {
                   8836:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   8837:         if ($container eq '' && $depth == 0) {
                   8838:             $cats->[$depth][$categories->{$item}] = $cat;
                   8839:         } else {
                   8840:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   8841:         }
                   8842:         my ($escitem,$tail) = split(/:/,$item,2);
                   8843:         if ($counters{$tail} eq '') {
                   8844:             $counters{$tail} = $num;
                   8845:             $num ++;
                   8846:         }
                   8847:         if (ref($idx) eq 'HASH') {
                   8848:             $idx->{$item} = $counters{$tail};
                   8849:         }
                   8850:         if (ref($jsarray) eq 'ARRAY') {
                   8851:             push(@{$jsarray->[$counters{$tail}]},$item);
                   8852:         }
                   8853:     }
                   8854:     return;
                   8855: }
                   8856: 
                   8857: =pod
                   8858: 
                   8859: =item * &extract_categories()
                   8860: 
                   8861: Used to generate breadcrumb trails for course categories.
                   8862: 
                   8863: Inputs:
1.663     raeburn  8864: 
1.655     raeburn  8865: categories (reference to hash of category definitions).
1.663     raeburn  8866: 
1.655     raeburn  8867: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   8868:       categories and subcategories).
1.663     raeburn  8869: 
1.655     raeburn  8870: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  8871: 
1.655     raeburn  8872: allitems (reference to hash - key is category key 
                   8873:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  8874: 
1.655     raeburn  8875: idx (reference to hash of counters used in Domain Coordinator interface for
                   8876:       editing Course Categories).
1.663     raeburn  8877: 
1.655     raeburn  8878: jsarray (reference to array of categories used to create Javascript arrays for
                   8879:          Domain Coordinator interface for editing Course Categories).
                   8880: 
1.665     raeburn  8881: subcats (reference to hash of arrays containing all subcategories within each 
                   8882:          category, -recursive)
                   8883: 
1.655     raeburn  8884: Returns: nothing
                   8885: 
                   8886: Side effects: populates trails and allitems hash references.
                   8887: 
                   8888: =cut
                   8889: 
                   8890: sub extract_categories {
1.665     raeburn  8891:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  8892:     if (ref($categories) eq 'HASH') {
                   8893:         &gather_categories($categories,$cats,$idx,$jsarray);
                   8894:         if (ref($cats->[0]) eq 'ARRAY') {
                   8895:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   8896:                 my $name = $cats->[0][$i];
                   8897:                 my $item = &escape($name).'::0';
                   8898:                 my $trailstr;
                   8899:                 if ($name eq 'instcode') {
                   8900:                     $trailstr = &mt('Official courses (with institutional codes)');
                   8901:                 } else {
                   8902:                     $trailstr = $name;
                   8903:                 }
                   8904:                 if ($allitems->{$item} eq '') {
                   8905:                     push(@{$trails},$trailstr);
                   8906:                     $allitems->{$item} = scalar(@{$trails})-1;
                   8907:                 }
                   8908:                 my @parents = ($name);
                   8909:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   8910:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   8911:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  8912:                         if (ref($subcats) eq 'HASH') {
                   8913:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   8914:                         }
                   8915:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   8916:                     }
                   8917:                 } else {
                   8918:                     if (ref($subcats) eq 'HASH') {
                   8919:                         $subcats->{$item} = [];
1.655     raeburn  8920:                     }
                   8921:                 }
                   8922:             }
                   8923:         }
                   8924:     }
                   8925:     return;
                   8926: }
                   8927: 
                   8928: =pod
                   8929: 
                   8930: =item *&recurse_categories()
                   8931: 
                   8932: Recursively used to generate breadcrumb trails for course categories.
                   8933: 
                   8934: Inputs:
1.663     raeburn  8935: 
1.655     raeburn  8936: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   8937:       categories and subcategories).
1.663     raeburn  8938: 
1.655     raeburn  8939: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  8940: 
                   8941: category (current course category, for which breadcrumb trail is being generated).
                   8942: 
                   8943: trails (reference to array of breadcrumb trails for each category).
                   8944: 
1.655     raeburn  8945: allitems (reference to hash - key is category key
                   8946:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  8947: 
1.655     raeburn  8948: parents (array containing containers directories for current category, 
                   8949:          back to top level). 
                   8950: 
                   8951: Returns: nothing
                   8952: 
                   8953: Side effects: populates trails and allitems hash references
                   8954: 
                   8955: =cut
                   8956: 
                   8957: sub recurse_categories {
1.665     raeburn  8958:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  8959:     my $shallower = $depth - 1;
                   8960:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   8961:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   8962:             my $name = $cats->[$depth]{$category}[$k];
                   8963:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   8964:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   8965:             if ($allitems->{$item} eq '') {
                   8966:                 push(@{$trails},$trailstr);
                   8967:                 $allitems->{$item} = scalar(@{$trails})-1;
                   8968:             }
                   8969:             my $deeper = $depth+1;
                   8970:             push(@{$parents},$category);
1.665     raeburn  8971:             if (ref($subcats) eq 'HASH') {
                   8972:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   8973:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   8974:                     my $higher;
                   8975:                     if ($j > 0) {
                   8976:                         $higher = &escape($parents->[$j]).':'.
                   8977:                                   &escape($parents->[$j-1]).':'.$j;
                   8978:                     } else {
                   8979:                         $higher = &escape($parents->[$j]).'::'.$j;
                   8980:                     }
                   8981:                     push(@{$subcats->{$higher}},$subcat);
                   8982:                 }
                   8983:             }
                   8984:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   8985:                                 $subcats);
1.655     raeburn  8986:             pop(@{$parents});
                   8987:         }
                   8988:     } else {
                   8989:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   8990:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   8991:         if ($allitems->{$item} eq '') {
                   8992:             push(@{$trails},$trailstr);
                   8993:             $allitems->{$item} = scalar(@{$trails})-1;
                   8994:         }
                   8995:     }
                   8996:     return;
                   8997: }
                   8998: 
1.663     raeburn  8999: =pod
                   9000: 
                   9001: =item *&assign_categories_table()
                   9002: 
                   9003: Create a datatable for display of hierarchical categories in a domain,
                   9004: with checkboxes to allow a course to be categorized. 
                   9005: 
                   9006: Inputs:
                   9007: 
                   9008: cathash - reference to hash of categories defined for the domain (from
                   9009:           configuration.db)
                   9010: 
                   9011: currcat - scalar with an & separated list of categories assigned to a course. 
                   9012: 
                   9013: Returns: $output (markup to be displayed) 
                   9014: 
                   9015: =cut
                   9016: 
                   9017: sub assign_categories_table {
                   9018:     my ($cathash,$currcat) = @_;
                   9019:     my $output;
                   9020:     if (ref($cathash) eq 'HASH') {
                   9021:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   9022:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   9023:         $maxdepth = scalar(@cats);
                   9024:         if (@cats > 0) {
                   9025:             my $itemcount = 0;
                   9026:             if (ref($cats[0]) eq 'ARRAY') {
                   9027:                 $output = &Apache::loncommon::start_data_table();
                   9028:                 my @currcategories;
                   9029:                 if ($currcat ne '') {
                   9030:                     @currcategories = split('&',$currcat);
                   9031:                 }
                   9032:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   9033:                     my $parent = $cats[0][$i];
                   9034:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   9035:                     next if ($parent eq 'instcode');
                   9036:                     my $item = &escape($parent).'::0';
                   9037:                     my $checked = '';
                   9038:                     if (@currcategories > 0) {
                   9039:                         if (grep(/^\Q$item\E$/,@currcategories)) {
                   9040:                             $checked = ' checked="checked" ';
                   9041:                         }
                   9042:                     }
1.675     raeburn  9043:                     $output .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   9044:                                '<input type="checkbox" name="usecategory" value="'.
                   9045:                                $item.'"'.$checked.' />'.$parent.'</span>'.
                   9046:                                '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  9047:                     my $depth = 1;
                   9048:                     push(@path,$parent);
                   9049:                     $output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
                   9050:                     pop(@path);
                   9051:                     $output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
                   9052:                     $itemcount ++;
                   9053:                 }
                   9054:                 $output .= &Apache::loncommon::end_data_table();
                   9055:             }
                   9056:         }
                   9057:     }
                   9058:     return $output;
                   9059: }
                   9060: 
                   9061: =pod
                   9062: 
                   9063: =item *&assign_category_rows()
                   9064: 
                   9065: Create a datatable row for display of nested categories in a domain,
                   9066: with checkboxes to allow a course to be categorized,called recursively.
                   9067: 
                   9068: Inputs:
                   9069: 
                   9070: itemcount - track row number for alternating colors
                   9071: 
                   9072: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   9073:       categories and subcategories.
                   9074: 
                   9075: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   9076: 
                   9077: parent - parent of current category item
                   9078: 
                   9079: path - Array containing all categories back up through the hierarchy from the
                   9080:        current category to the top level.
                   9081: 
                   9082: currcategories - reference to array of current categories assigned to the course
                   9083: 
                   9084: Returns: $output (markup to be displayed).
                   9085: 
                   9086: =cut
                   9087: 
                   9088: sub assign_category_rows {
                   9089:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   9090:     my ($text,$name,$item,$chgstr);
                   9091:     if (ref($cats) eq 'ARRAY') {
                   9092:         my $maxdepth = scalar(@{$cats});
                   9093:         if (ref($cats->[$depth]) eq 'HASH') {
                   9094:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   9095:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   9096:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   9097:                 $text .= '<td><table class="LC_datatable">';
                   9098:                 for (my $j=0; $j<$numchildren; $j++) {
                   9099:                     $name = $cats->[$depth]{$parent}[$j];
                   9100:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   9101:                     my $deeper = $depth+1;
                   9102:                     my $checked = '';
                   9103:                     if (ref($currcategories) eq 'ARRAY') {
                   9104:                         if (@{$currcategories} > 0) {
                   9105:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
                   9106:                                 $checked = ' checked="checked" ';
                   9107:                             }
                   9108:                         }
                   9109:                     }
1.664     raeburn  9110:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   9111:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  9112:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   9113:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   9114:                              '</td><td>';
1.663     raeburn  9115:                     if (ref($path) eq 'ARRAY') {
                   9116:                         push(@{$path},$name);
                   9117:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   9118:                         pop(@{$path});
                   9119:                     }
                   9120:                     $text .= '</td></tr>';
                   9121:                 }
                   9122:                 $text .= '</table></td>';
                   9123:             }
                   9124:         }
                   9125:     }
                   9126:     return $text;
                   9127: }
                   9128: 
1.655     raeburn  9129: ############################################################
                   9130: ############################################################
                   9131: 
                   9132: 
1.443     albertel 9133: sub commit_customrole {
1.664     raeburn  9134:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  9135:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 9136:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   9137:                          ($end?', ending '.localtime($end):'').': <b>'.
                   9138:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  9139:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 9140:                  '</b><br />';
                   9141:     return $output;
                   9142: }
                   9143: 
                   9144: sub commit_standardrole {
1.541     raeburn  9145:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   9146:     my ($output,$logmsg,$linefeed);
                   9147:     if ($context eq 'auto') {
                   9148:         $linefeed = "\n";
                   9149:     } else {
                   9150:         $linefeed = "<br />\n";
                   9151:     }  
1.443     albertel 9152:     if ($three eq 'st') {
1.541     raeburn  9153:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   9154:                                          $one,$two,$sec,$context);
                   9155:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  9156:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   9157:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 9158:         } else {
1.541     raeburn  9159:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 9160:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  9161:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   9162:             if ($context eq 'auto') {
                   9163:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   9164:             } else {
                   9165:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   9166:                &mt('Add to classlist').': <b>ok</b>';
                   9167:             }
                   9168:             $output .= $linefeed;
1.443     albertel 9169:         }
                   9170:     } else {
                   9171:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   9172:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  9173:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  9174:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  9175:         if ($context eq 'auto') {
                   9176:             $output .= $result.$linefeed;
                   9177:         } else {
                   9178:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   9179:         }
1.443     albertel 9180:     }
                   9181:     return $output;
                   9182: }
                   9183: 
                   9184: sub commit_studentrole {
1.541     raeburn  9185:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  9186:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  9187:     if ($context eq 'auto') {
                   9188:         $linefeed = "\n";
                   9189:     } else {
                   9190:         $linefeed = '<br />'."\n";
                   9191:     }
1.443     albertel 9192:     if (defined($one) && defined($two)) {
                   9193:         my $cid=$one.'_'.$two;
                   9194:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   9195:         my $secchange = 0;
                   9196:         my $expire_role_result;
                   9197:         my $modify_section_result;
1.628     raeburn  9198:         if ($oldsec ne '-1') { 
                   9199:             if ($oldsec ne $sec) {
1.443     albertel 9200:                 $secchange = 1;
1.628     raeburn  9201:                 my $now = time;
1.443     albertel 9202:                 my $uurl='/'.$cid;
                   9203:                 $uurl=~s/\_/\//g;
                   9204:                 if ($oldsec) {
                   9205:                     $uurl.='/'.$oldsec;
                   9206:                 }
1.626     raeburn  9207:                 $oldsecurl = $uurl;
1.628     raeburn  9208:                 $expire_role_result = 
1.652     raeburn  9209:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  9210:                 if ($env{'request.course.sec'} ne '') { 
                   9211:                     if ($expire_role_result eq 'refused') {
                   9212:                         my @roles = ('st');
                   9213:                         my @statuses = ('previous');
                   9214:                         my @roledoms = ($one);
                   9215:                         my $withsec = 1;
                   9216:                         my %roleshash = 
                   9217:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   9218:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   9219:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   9220:                             my ($oldstart,$oldend) = 
                   9221:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   9222:                             if ($oldend > 0 && $oldend <= $now) {
                   9223:                                 $expire_role_result = 'ok';
                   9224:                             }
                   9225:                         }
                   9226:                     }
                   9227:                 }
1.443     albertel 9228:                 $result = $expire_role_result;
                   9229:             }
                   9230:         }
                   9231:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  9232:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 9233:             if ($modify_section_result =~ /^ok/) {
                   9234:                 if ($secchange == 1) {
1.628     raeburn  9235:                     if ($sec eq '') {
                   9236:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   9237:                     } else {
                   9238:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   9239:                     }
1.443     albertel 9240:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  9241:                     if ($sec eq '') {
                   9242:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   9243:                     } else {
                   9244:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   9245:                     }
1.443     albertel 9246:                 } else {
1.628     raeburn  9247:                     if ($sec eq '') {
                   9248:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   9249:                     } else {
                   9250:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   9251:                     }
1.443     albertel 9252:                 }
                   9253:             } else {
1.628     raeburn  9254:                 if ($secchange) {       
                   9255:                     $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
                   9256:                 } else {
                   9257:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   9258:                 }
1.443     albertel 9259:             }
                   9260:             $result = $modify_section_result;
                   9261:         } elsif ($secchange == 1) {
1.628     raeburn  9262:             if ($oldsec eq '') {
                   9263:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   9264:             } else {
                   9265:                 $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
                   9266:             }
1.626     raeburn  9267:             if ($expire_role_result eq 'refused') {
                   9268:                 my $newsecurl = '/'.$cid;
                   9269:                 $newsecurl =~ s/\_/\//g;
                   9270:                 if ($sec ne '') {
                   9271:                     $newsecurl.='/'.$sec;
                   9272:                 }
                   9273:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   9274:                     if ($sec eq '') {
                   9275:                         $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed;
                   9276:                     } else {
                   9277:                         $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed;
                   9278:                     }
                   9279:                 }
                   9280:             }
1.443     albertel 9281:         }
                   9282:     } else {
1.626     raeburn  9283:         $$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed;
1.443     albertel 9284:         $result = "error: incomplete course id\n";
                   9285:     }
                   9286:     return $result;
                   9287: }
                   9288: 
                   9289: ############################################################
                   9290: ############################################################
                   9291: 
1.566     albertel 9292: sub check_clone {
1.578     raeburn  9293:     my ($args,$linefeed) = @_;
1.566     albertel 9294:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   9295:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   9296:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   9297:     my $clonemsg;
                   9298:     my $can_clone = 0;
                   9299: 
                   9300:     if ($clonehome eq 'no_host') {
1.578     raeburn  9301:         $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});     
1.566     albertel 9302:     } else {
                   9303: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568     albertel 9304: 	if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566     albertel 9305: 	    $can_clone = 1;
                   9306: 	} else {
                   9307: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   9308: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   9309: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  9310:             if (grep(/^\*$/,@cloners)) {
                   9311:                 $can_clone = 1;
                   9312:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   9313:                 $can_clone = 1;
                   9314:             } else {
                   9315: 	        my %roleshash =
                   9316: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   9317: 					 $args->{'ccdomain'},
                   9318:                                          'userroles',['active'],['cc'],
                   9319: 					 [$args->{'clonedomain'}]);
                   9320: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
                   9321: 		    $can_clone = 1;
                   9322: 	        } else {
                   9323:                     $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                   9324: 	        }
1.566     albertel 9325: 	    }
1.578     raeburn  9326:         }
1.566     albertel 9327:     }
                   9328:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   9329: }
                   9330: 
1.444     albertel 9331: sub construct_course {
1.541     raeburn  9332:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444     albertel 9333:     my $outcome;
1.541     raeburn  9334:     my $linefeed =  '<br />'."\n";
                   9335:     if ($context eq 'auto') {
                   9336:         $linefeed = "\n";
                   9337:     }
1.566     albertel 9338: 
                   9339: #
                   9340: # Are we cloning?
                   9341: #
                   9342:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   9343:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  9344: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 9345: 	if ($context ne 'auto') {
1.578     raeburn  9346:             if ($clonemsg ne '') {
                   9347: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   9348:             }
1.566     albertel 9349: 	}
                   9350: 	$outcome .= $clonemsg.$linefeed;
                   9351: 
                   9352:         if (!$can_clone) {
                   9353: 	    return (0,$outcome);
                   9354: 	}
                   9355:     }
                   9356: 
1.444     albertel 9357: #
                   9358: # Open course
                   9359: #
                   9360:     my $crstype = lc($args->{'crstype'});
                   9361:     my %cenv=();
                   9362:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   9363:                                              $args->{'cdescr'},
                   9364:                                              $args->{'curl'},
                   9365:                                              $args->{'course_home'},
                   9366:                                              $args->{'nonstandard'},
                   9367:                                              $args->{'crscode'},
                   9368:                                              $args->{'ccuname'}.':'.
                   9369:                                              $args->{'ccdomain'},
                   9370:                                              $args->{'crstype'});
                   9371: 
                   9372:     # Note: The testing routines depend on this being output; see 
                   9373:     # Utils::Course. This needs to at least be output as a comment
                   9374:     # if anyone ever decides to not show this, and Utils::Course::new
                   9375:     # will need to be suitably modified.
1.541     raeburn  9376:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444     albertel 9377: #
                   9378: # Check if created correctly
                   9379: #
1.479     albertel 9380:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 9381:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541     raeburn  9382:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 9383: 
1.444     albertel 9384: #
1.566     albertel 9385: # Do the cloning
                   9386: #   
                   9387:     if ($can_clone && $cloneid) {
                   9388: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   9389: 	if ($context ne 'auto') {
                   9390: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   9391: 	}
                   9392: 	$outcome .= $clonemsg.$linefeed;
                   9393: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 9394: # Copy all files
1.637     www      9395: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 9396: # Restore URL
1.566     albertel 9397: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 9398: # Restore title
1.566     albertel 9399: 	$cenv{'description'}=$oldcenv{'description'};
1.444     albertel 9400: # Mark as cloned
1.566     albertel 9401: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      9402: # Need to clone grading mode
                   9403:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   9404:         $cenv{'grading'}=$newenv{'grading'};
                   9405: # Do not clone these environment entries
                   9406:         &Apache::lonnet::del('environment',
                   9407:                   ['default_enrollment_start_date',
                   9408:                    'default_enrollment_end_date',
                   9409:                    'question.email',
                   9410:                    'policy.email',
                   9411:                    'comment.email',
                   9412:                    'pch.users.denied',
1.725     raeburn  9413:                    'plc.users.denied',
                   9414:                    'hidefromcat',
                   9415:                    'categories'],
1.638     www      9416:                    $$crsudom,$$crsunum);
1.444     albertel 9417:     }
1.566     albertel 9418: 
1.444     albertel 9419: #
                   9420: # Set environment (will override cloned, if existing)
                   9421: #
                   9422:     my @sections = ();
                   9423:     my @xlists = ();
                   9424:     if ($args->{'crstype'}) {
                   9425:         $cenv{'type'}=$args->{'crstype'};
                   9426:     }
                   9427:     if ($args->{'crsid'}) {
                   9428:         $cenv{'courseid'}=$args->{'crsid'};
                   9429:     }
                   9430:     if ($args->{'crscode'}) {
                   9431:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   9432:     }
                   9433:     if ($args->{'crsquota'} ne '') {
                   9434:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   9435:     } else {
                   9436:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   9437:     }
                   9438:     if ($args->{'ccuname'}) {
                   9439:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   9440:                                         ':'.$args->{'ccdomain'};
                   9441:     } else {
                   9442:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   9443:     }
                   9444:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   9445:     if ($args->{'crssections'}) {
                   9446:         $cenv{'internal.sectionnums'} = '';
                   9447:         if ($args->{'crssections'} =~ m/,/) {
                   9448:             @sections = split/,/,$args->{'crssections'};
                   9449:         } else {
                   9450:             $sections[0] = $args->{'crssections'};
                   9451:         }
                   9452:         if (@sections > 0) {
                   9453:             foreach my $item (@sections) {
                   9454:                 my ($sec,$gp) = split/:/,$item;
                   9455:                 my $class = $args->{'crscode'}.$sec;
                   9456:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   9457:                 $cenv{'internal.sectionnums'} .= $item.',';
                   9458:                 unless ($addcheck eq 'ok') {
                   9459:                     push @badclasses, $class;
                   9460:                 }
                   9461:             }
                   9462:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   9463:         }
                   9464:     }
                   9465: # do not hide course coordinator from staff listing, 
                   9466: # even if privileged
                   9467:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   9468: # add crosslistings
                   9469:     if ($args->{'crsxlist'}) {
                   9470:         $cenv{'internal.crosslistings'}='';
                   9471:         if ($args->{'crsxlist'} =~ m/,/) {
                   9472:             @xlists = split/,/,$args->{'crsxlist'};
                   9473:         } else {
                   9474:             $xlists[0] = $args->{'crsxlist'};
                   9475:         }
                   9476:         if (@xlists > 0) {
                   9477:             foreach my $item (@xlists) {
                   9478:                 my ($xl,$gp) = split/:/,$item;
                   9479:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   9480:                 $cenv{'internal.crosslistings'} .= $item.',';
                   9481:                 unless ($addcheck eq 'ok') {
                   9482:                     push @badclasses, $xl;
                   9483:                 }
                   9484:             }
                   9485:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   9486:         }
                   9487:     }
                   9488:     if ($args->{'autoadds'}) {
                   9489:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   9490:     }
                   9491:     if ($args->{'autodrops'}) {
                   9492:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   9493:     }
                   9494: # check for notification of enrollment changes
                   9495:     my @notified = ();
                   9496:     if ($args->{'notify_owner'}) {
                   9497:         if ($args->{'ccuname'} ne '') {
                   9498:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   9499:         }
                   9500:     }
                   9501:     if ($args->{'notify_dc'}) {
                   9502:         if ($uname ne '') { 
1.630     raeburn  9503:             push(@notified,$uname.':'.$udom);
1.444     albertel 9504:         }
                   9505:     }
                   9506:     if (@notified > 0) {
                   9507:         my $notifylist;
                   9508:         if (@notified > 1) {
                   9509:             $notifylist = join(',',@notified);
                   9510:         } else {
                   9511:             $notifylist = $notified[0];
                   9512:         }
                   9513:         $cenv{'internal.notifylist'} = $notifylist;
                   9514:     }
                   9515:     if (@badclasses > 0) {
                   9516:         my %lt=&Apache::lonlocal::texthash(
                   9517:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
                   9518:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   9519:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   9520:         );
1.541     raeburn  9521:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   9522:                            ' ('.$lt{'adby'}.')';
                   9523:         if ($context eq 'auto') {
                   9524:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 9525:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  9526:             foreach my $item (@badclasses) {
                   9527:                 if ($context eq 'auto') {
                   9528:                     $outcome .= " - $item\n";
                   9529:                 } else {
                   9530:                     $outcome .= "<li>$item</li>\n";
                   9531:                 }
                   9532:             }
                   9533:             if ($context eq 'auto') {
                   9534:                 $outcome .= $linefeed;
                   9535:             } else {
1.566     albertel 9536:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  9537:             }
                   9538:         } 
1.444     albertel 9539:     }
                   9540:     if ($args->{'no_end_date'}) {
                   9541:         $args->{'endaccess'} = 0;
                   9542:     }
                   9543:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   9544:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   9545:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   9546:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   9547:     if ($args->{'showphotos'}) {
                   9548:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   9549:     }
                   9550:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   9551:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   9552:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   9553:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  9554:             my $krb_msg = &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student'); 
                   9555:             if ($context eq 'auto') {
                   9556:                 $outcome .= $krb_msg;
                   9557:             } else {
1.566     albertel 9558:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  9559:             }
                   9560:             $outcome .= $linefeed;
1.444     albertel 9561:         }
                   9562:     }
                   9563:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   9564:        if ($args->{'setpolicy'}) {
                   9565:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   9566:        }
                   9567:        if ($args->{'setcontent'}) {
                   9568:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   9569:        }
                   9570:     }
                   9571:     if ($args->{'reshome'}) {
                   9572: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   9573: 	$cenv{'reshome'}=~s/\/+$/\//;
                   9574:     }
                   9575: #
                   9576: # course has keyed access
                   9577: #
                   9578:     if ($args->{'setkeys'}) {
                   9579:        $cenv{'keyaccess'}='yes';
                   9580:     }
                   9581: # if specified, key authority is not course, but user
                   9582: # only active if keyaccess is yes
                   9583:     if ($args->{'keyauth'}) {
1.487     albertel 9584: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   9585: 	$user = &LONCAPA::clean_username($user);
                   9586: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     9587: 	if ($user ne '' && $domain ne '') {
1.487     albertel 9588: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 9589: 	}
                   9590:     }
                   9591: 
                   9592:     if ($args->{'disresdis'}) {
                   9593:         $cenv{'pch.roles.denied'}='st';
                   9594:     }
                   9595:     if ($args->{'disablechat'}) {
                   9596:         $cenv{'plc.roles.denied'}='st';
                   9597:     }
                   9598: 
                   9599:     # Record we've not yet viewed the Course Initialization Helper for this 
                   9600:     # course
                   9601:     $cenv{'course.helper.not.run'} = 1;
                   9602:     #
                   9603:     # Use new Randomseed
                   9604:     #
                   9605:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   9606:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   9607:     #
                   9608:     # The encryption code and receipt prefix for this course
                   9609:     #
                   9610:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   9611:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   9612:     #
                   9613:     # By default, use standard grading
                   9614:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   9615: 
1.541     raeburn  9616:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   9617:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 9618: #
                   9619: # Open all assignments
                   9620: #
                   9621:     if ($args->{'openall'}) {
                   9622:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   9623:        my %storecontent = ($storeunder         => time,
                   9624:                            $storeunder.'.type' => 'date_start');
                   9625:        
                   9626:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  9627:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 9628:    }
                   9629: #
                   9630: # Set first page
                   9631: #
                   9632:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   9633: 	    || ($cloneid)) {
1.445     albertel 9634: 	use LONCAPA::map;
1.444     albertel 9635: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 9636: 
                   9637: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   9638:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   9639: 
1.444     albertel 9640:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   9641:         my $title; my $url;
                   9642:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   9643: 	    $title=&mt('Syllabus');
1.444     albertel 9644:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   9645:         } else {
1.690     bisitz   9646:             $title=&mt('Navigate Contents');
1.444     albertel 9647:             $url='/adm/navmaps';
                   9648:         }
1.445     albertel 9649: 
                   9650:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   9651: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   9652: 
                   9653: 	if ($errtext) { $fatal=2; }
1.541     raeburn  9654:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 9655:     }
1.566     albertel 9656: 
                   9657:     return (1,$outcome);
1.444     albertel 9658: }
                   9659: 
                   9660: ############################################################
                   9661: ############################################################
                   9662: 
1.378     raeburn  9663: sub course_type {
                   9664:     my ($cid) = @_;
                   9665:     if (!defined($cid)) {
                   9666:         $cid = $env{'request.course.id'};
                   9667:     }
1.404     albertel 9668:     if (defined($env{'course.'.$cid.'.type'})) {
                   9669:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  9670:     } else {
                   9671:         return 'Course';
1.377     raeburn  9672:     }
                   9673: }
1.156     albertel 9674: 
1.406     raeburn  9675: sub group_term {
                   9676:     my $crstype = &course_type();
                   9677:     my %names = (
                   9678:                   'Course' => 'group',
                   9679:                   'Group' => 'team',
                   9680:                 );
                   9681:     return $names{$crstype};
                   9682: }
                   9683: 
1.156     albertel 9684: sub icon {
                   9685:     my ($file)=@_;
1.505     albertel 9686:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 9687:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 9688:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 9689:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   9690: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   9691: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   9692: 	            $curfext.".gif") {
                   9693: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   9694: 		$curfext.".gif";
                   9695: 	}
                   9696:     }
1.249     albertel 9697:     return &lonhttpdurl($iconname);
1.154     albertel 9698: } 
1.84      albertel 9699: 
1.575     albertel 9700: sub lonhttpdurl {
1.692     www      9701: #
                   9702: # Had been used for "small fry" static images on separate port 8080.
                   9703: # Modify here if lightweight http functionality desired again.
                   9704: # Currently eliminated due to increasing firewall issues.
                   9705: #
1.575     albertel 9706:     my ($url)=@_;
1.692     www      9707:     return $url;
1.215     albertel 9708: }
                   9709: 
1.213     albertel 9710: sub connection_aborted {
                   9711:     my ($r)=@_;
                   9712:     $r->print(" ");$r->rflush();
                   9713:     my $c = $r->connection;
                   9714:     return $c->aborted();
                   9715: }
                   9716: 
1.221     foxr     9717: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     9718: #    strings as 'strings'.
                   9719: sub escape_single {
1.221     foxr     9720:     my ($input) = @_;
1.223     albertel 9721:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     9722:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   9723:     return $input;
                   9724: }
1.223     albertel 9725: 
1.222     foxr     9726: #  Same as escape_single, but escape's "'s  This 
                   9727: #  can be used for  "strings"
                   9728: sub escape_double {
                   9729:     my ($input) = @_;
                   9730:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   9731:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   9732:     return $input;
                   9733: }
1.223     albertel 9734:  
1.222     foxr     9735: #   Escapes the last element of a full URL.
                   9736: sub escape_url {
                   9737:     my ($url)   = @_;
1.238     raeburn  9738:     my @urlslices = split(/\//, $url,-1);
1.369     www      9739:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 9740:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     9741: }
1.462     albertel 9742: 
                   9743: # -------------------------------------------------------- Initliaze user login
                   9744: sub init_user_environment {
1.463     albertel 9745:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 9746:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   9747: 
                   9748:     my $public=($username eq 'public' && $domain eq 'public');
                   9749: 
                   9750: # See if old ID present, if so, remove
                   9751: 
                   9752:     my ($filename,$cookie,$userroles);
                   9753:     my $now=time;
                   9754: 
                   9755:     if ($public) {
                   9756: 	my $max_public=100;
                   9757: 	my $oldest;
                   9758: 	my $oldest_time=0;
                   9759: 	for(my $next=1;$next<=$max_public;$next++) {
                   9760: 	    if (-e $lonids."/publicuser_$next.id") {
                   9761: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   9762: 		if ($mtime<$oldest_time || !$oldest_time) {
                   9763: 		    $oldest_time=$mtime;
                   9764: 		    $oldest=$next;
                   9765: 		}
                   9766: 	    } else {
                   9767: 		$cookie="publicuser_$next";
                   9768: 		last;
                   9769: 	    }
                   9770: 	}
                   9771: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   9772:     } else {
1.463     albertel 9773: 	# if this isn't a robot, kill any existing non-robot sessions
                   9774: 	if (!$args->{'robot'}) {
                   9775: 	    opendir(DIR,$lonids);
                   9776: 	    while ($filename=readdir(DIR)) {
                   9777: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   9778: 		    unlink($lonids.'/'.$filename);
                   9779: 		}
1.462     albertel 9780: 	    }
1.463     albertel 9781: 	    closedir(DIR);
1.462     albertel 9782: 	}
                   9783: # Give them a new cookie
1.463     albertel 9784: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      9785: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 9786: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 9787:     
                   9788: # Initialize roles
                   9789: 
                   9790: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   9791:     }
                   9792: # ------------------------------------ Check browser type and MathML capability
                   9793: 
                   9794:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   9795:         $clientunicode,$clientos) = &decode_user_agent($r);
                   9796: 
                   9797: # -------------------------------------- Any accessibility options to remember?
                   9798:     if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
                   9799: 	foreach my $option ('imagesuppress','appletsuppress',
                   9800: 			    'embedsuppress','fontenhance','blackwhite') {
                   9801: 	    if ($form->{$option} eq 'true') {
                   9802: 		&Apache::lonnet::put('environment',{$option => 'on'},
                   9803: 				     $domain,$username);
                   9804: 	    } else {
                   9805: 		&Apache::lonnet::del('environment',[$option],
                   9806: 				     $domain,$username);
                   9807: 	    }
                   9808: 	}
                   9809:     }
                   9810: # ------------------------------------------------------------- Get environment
                   9811: 
                   9812:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   9813:     my ($tmp) = keys(%userenv);
                   9814:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9815: 	# default remote control to off
                   9816: 	if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
                   9817:     } else {
                   9818: 	undef(%userenv);
                   9819:     }
                   9820:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   9821: 	$form->{'interface'}=$userenv{'interface'};
                   9822:     }
                   9823:     $env{'environment.remote'}=$userenv{'remote'};
                   9824:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   9825: 
                   9826: # --------------- Do not trust query string to be put directly into environment
                   9827:     foreach my $option ('imagesuppress','appletsuppress',
                   9828: 			'embedsuppress','fontenhance','blackwhite',
                   9829: 			'interface','localpath','localres') {
                   9830: 	$form->{$option}=~s/[\n\r\=]//gs;
                   9831:     }
                   9832: # --------------------------------------------------------- Write first profile
                   9833: 
                   9834:     {
                   9835: 	my %initial_env = 
                   9836: 	    ("user.name"          => $username,
                   9837: 	     "user.domain"        => $domain,
                   9838: 	     "user.home"          => $authhost,
                   9839: 	     "browser.type"       => $clientbrowser,
                   9840: 	     "browser.version"    => $clientversion,
                   9841: 	     "browser.mathml"     => $clientmathml,
                   9842: 	     "browser.unicode"    => $clientunicode,
                   9843: 	     "browser.os"         => $clientos,
                   9844: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   9845: 	     "request.course.fn"  => '',
                   9846: 	     "request.course.uri" => '',
                   9847: 	     "request.course.sec" => '',
                   9848: 	     "request.role"       => 'cm',
                   9849: 	     "request.role.adv"   => $env{'user.adv'},
                   9850: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   9851: 
                   9852:         if ($form->{'localpath'}) {
                   9853: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   9854: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   9855:         }
                   9856: 	
                   9857: 	if ($public) {
                   9858: 	    $initial_env{"environment.remote"} = "off";
                   9859: 	}
                   9860: 	if ($form->{'interface'}) {
                   9861: 	    $form->{'interface'}=~s/\W//gs;
                   9862: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   9863: 	    $env{'browser.interface'}=$form->{'interface'};
                   9864: 	    foreach my $option ('imagesuppress','appletsuppress',
                   9865: 				'embedsuppress','fontenhance','blackwhite') {
                   9866: 		if (($form->{$option} eq 'true') ||
                   9867: 		    ($userenv{$option} eq 'on')) {
                   9868: 		    $initial_env{"browser.$option"} = "on";
                   9869: 		}
                   9870: 	    }
                   9871: 	}
                   9872: 
1.724     raeburn  9873:         foreach my $tool ('aboutme','blog','portfolio') {
                   9874:             $userenv{'availabletools.'.$tool} = 
                   9875:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
                   9876:         }
                   9877: 
1.462     albertel 9878: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   9879: 	
                   9880: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   9881: 		 &GDBM_WRCREAT(),0640)) {
                   9882: 	    &_add_to_env(\%disk_env,\%initial_env);
                   9883: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   9884: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 9885: 	    if (ref($args->{'extra_env'})) {
                   9886: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   9887: 	    }
1.462     albertel 9888: 	    untie(%disk_env);
                   9889: 	} else {
1.705     tempelho 9890: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   9891: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 9892: 	    return 'error: '.$!;
                   9893: 	}
                   9894:     }
                   9895:     $env{'request.role'}='cm';
                   9896:     $env{'request.role.adv'}=$env{'user.adv'};
                   9897:     $env{'browser.type'}=$clientbrowser;
                   9898: 
                   9899:     return $cookie;
                   9900: 
                   9901: }
                   9902: 
                   9903: sub _add_to_env {
                   9904:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  9905:     if (ref($env_data) eq 'HASH') {
                   9906:         while (my ($key,$value) = each(%$env_data)) {
                   9907: 	    $idf->{$prefix.$key} = $value;
                   9908: 	    $env{$prefix.$key}   = $value;
                   9909:         }
1.462     albertel 9910:     }
                   9911: }
                   9912: 
1.685     tempelho 9913: # --- Get the symbolic name of a problem and the url
                   9914: sub get_symb {
                   9915:     my ($request,$silent) = @_;
1.726     raeburn  9916:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 9917:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   9918:     if ($symb eq '') {
                   9919:         if (!$silent) {
                   9920:             $request->print("Unable to handle ambiguous references:$url:.");
                   9921:             return ();
                   9922:         }
                   9923:     }
                   9924:     &Apache::lonenc::check_decrypt(\$symb);
                   9925:     return ($symb);
                   9926: }
                   9927: 
                   9928: # --------------------------------------------------------------Get annotation
                   9929: 
                   9930: sub get_annotation {
                   9931:     my ($symb,$enc) = @_;
                   9932: 
                   9933:     my $key = $symb;
                   9934:     if (!$enc) {
                   9935:         $key =
                   9936:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   9937:     }
                   9938:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   9939:     return $annotation{$key};
                   9940: }
                   9941: 
                   9942: sub clean_symb {
1.731     raeburn  9943:     my ($symb,$delete_enc) = @_;
1.685     tempelho 9944: 
                   9945:     &Apache::lonenc::check_decrypt(\$symb);
                   9946:     my $enc = $env{'request.enc'};
1.731     raeburn  9947:     if ($delete_enc) {
1.730     raeburn  9948:         delete($env{'request.enc'});
                   9949:     }
1.685     tempelho 9950: 
                   9951:     return ($symb,$enc);
                   9952: }
1.462     albertel 9953: 
1.41      ng       9954: =pod
                   9955: 
                   9956: =back
                   9957: 
1.112     bowersj2 9958: =cut
1.41      ng       9959: 
1.112     bowersj2 9960: 1;
                   9961: __END__;
1.41      ng       9962: 

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