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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.605   ! bisitz      4: # $Id: loncommon.pm,v 1.604 2007/10/31 18:01:47 albertel Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.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.139     matthew    64: use HTML::Entities;
1.334     albertel   65: use Apache::lonhtmlcommon();
                     66: use Apache::loncoursedata();
1.344     albertel   67: use Apache::lontexconvert();
1.444     albertel   68: use Apache::lonclonecourse();
1.479     albertel   69: use LONCAPA qw(:DEFAULT :match);
1.117     www        70: 
1.517     raeburn    71: # ---------------------------------------------- Designs
                     72: use vars qw(%defaultdesign);
                     73: 
1.22      www        74: my $readit;
                     75: 
1.517     raeburn    76: 
1.157     matthew    77: ##
                     78: ## Global Variables
                     79: ##
1.46      matthew    80: 
1.20      www        81: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41   82: my %language;
1.124     www        83: my %supported_language;
1.12      harris41   84: my %cprtag;
1.192     taceyjo1   85: my %scprtag;
1.351     www        86: my %fe; my %fd; my %fm;
1.41      ng         87: my %category_extensions;
1.12      harris41   88: 
1.46      matthew    89: # ---------------------------------------------- Thesaurus variables
1.144     matthew    90: #
                     91: # %Keywords:
                     92: #      A hash used by &keyword to determine if a word is considered a keyword.
                     93: # $thesaurus_db_file 
                     94: #      Scalar containing the full path to the thesaurus database.
1.46      matthew    95: 
                     96: my %Keywords;
                     97: my $thesaurus_db_file;
                     98: 
1.144     matthew    99: #
                    100: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    101: # thesaurus.tab, and filecategories.tab.
                    102: #
1.18      www       103: BEGIN {
1.46      matthew   104:     # Variable initialization
                    105:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    106:     #
1.22      www       107:     unless ($readit) {
1.12      harris41  108: # ------------------------------------------------------------------- languages
                    109:     {
1.158     raeburn   110:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    111:                                    '/language.tab';
                    112:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  113:             while (my $line = <$fh>) {
                    114:                 next if ($line=~/^\#/);
                    115:                 chomp($line);
                    116:                 my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158     raeburn   117:                 $language{$key}=$val.' - '.$enc;
                    118:                 if ($sup) {
                    119:                     $supported_language{$key}=$sup;
                    120:                 }
                    121:             }
                    122:             close($fh);
                    123:         }
1.12      harris41  124:     }
                    125: # ------------------------------------------------------------------ copyrights
                    126:     {
1.158     raeburn   127:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    128:                                   '/copyright.tab';
                    129:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  130:             while (my $line = <$fh>) {
                    131:                 next if ($line=~/^\#/);
                    132:                 chomp($line);
                    133:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   134:                 $cprtag{$key}=$val;
                    135:             }
                    136:             close($fh);
                    137:         }
1.12      harris41  138:     }
1.351     www       139: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  140:     {
                    141:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    142:                                   '/source_copyright.tab';
                    143:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  144:             while (my $line = <$fh>) {
                    145:                 next if ($line =~ /^\#/);
                    146:                 chomp($line);
                    147:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  148:                 $scprtag{$key}=$val;
                    149:             }
                    150:             close($fh);
                    151:         }
                    152:     }
1.63      www       153: 
1.517     raeburn   154: # -------------------------------------------------------------- default domain designs
1.63      www       155:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   156:     my $designfile = $designdir.'/default.tab';
                    157:     if ( open (my $fh,"<$designfile") ) {
                    158:         while (my $line = <$fh>) {
                    159:             next if ($line =~ /^\#/);
                    160:             chomp($line);
                    161:             my ($key,$val)=(split(/\=/,$line));
                    162:             if ($val) { $defaultdesign{$key}=$val; }
                    163:         }
                    164:         close($fh);
1.63      www       165:     }
                    166: 
1.15      harris41  167: # ------------------------------------------------------------- file categories
                    168:     {
1.158     raeburn   169:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    170:                                   '/filecategories.tab';
                    171:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  172: 	    while (my $line = <$fh>) {
                    173: 		next if ($line =~ /^\#/);
                    174: 		chomp($line);
                    175:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   176:                 push @{$category_extensions{lc($category)}},$extension;
                    177:             }
                    178:             close($fh);
                    179:         }
                    180: 
1.15      harris41  181:     }
1.12      harris41  182: # ------------------------------------------------------------------ file types
                    183:     {
1.158     raeburn   184:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    185:                '/filetypes.tab';
                    186:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  187:             while (my $line = <$fh>) {
                    188: 		next if ($line =~ /^\#/);
                    189: 		chomp($line);
                    190:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   191:                 if ($descr ne '') {
                    192:                     $fe{$ending}=lc($emb);
                    193:                     $fd{$ending}=$descr;
1.351     www       194:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   195:                 }
                    196:             }
                    197:             close($fh);
                    198:         }
1.12      harris41  199:     }
1.22      www       200:     &Apache::lonnet::logthis(
1.46      matthew   201:               "<font color=yellow>INFO: Read file types</font>");
1.22      www       202:     $readit=1;
1.46      matthew   203:     }  # end of unless($readit) 
1.32      matthew   204:     
                    205: }
1.112     bowersj2  206: 
1.42      matthew   207: ###############################################################
                    208: ##           HTML and Javascript Helper Functions            ##
                    209: ###############################################################
                    210: 
                    211: =pod 
                    212: 
1.112     bowersj2  213: =head1 HTML and Javascript Functions
1.42      matthew   214: 
1.112     bowersj2  215: =over 4
                    216: 
                    217: =item * browser_and_searcher_javascript ()
                    218: 
                    219: X<browsing, javascript>X<searching, javascript>Returns a string
                    220: containing javascript with two functions, C<openbrowser> and
                    221: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    222: tags.
1.42      matthew   223: 
1.112     bowersj2  224: =item * openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   225: 
                    226: inputs: formname, elementname, only, omit
                    227: 
                    228: formname and elementname indicate the name of the html form and name of
                    229: the element that the results of the browsing selection are to be placed in. 
                    230: 
                    231: Specifying 'only' will restrict the browser to displaying only files
1.185     www       232: with the given extension.  Can be a comma separated list.
1.42      matthew   233: 
                    234: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       235: with the given extension.  Can be a comma separated list.
1.42      matthew   236: 
1.112     bowersj2  237: =item * opensearcher(formname, elementname) [javascript]
1.42      matthew   238: 
                    239: Inputs: formname, elementname
                    240: 
                    241: formname and elementname specify the name of the html form and the name
                    242: of the element the selection from the search results will be placed in.
1.542     raeburn   243: 
1.42      matthew   244: =cut
                    245: 
                    246: sub browser_and_searcher_javascript {
1.199     albertel  247:     my ($mode)=@_;
                    248:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  249:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   250:     return <<END;
1.219     albertel  251: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   252:     var editbrowser = null;
1.135     albertel  253:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       254:         var url = '$resurl/?';
1.42      matthew   255:         if (editbrowser == null) {
                    256:             url += 'launch=1&';
                    257:         }
                    258:         url += 'catalogmode=interactive&';
1.199     albertel  259:         url += 'mode=$mode&';
1.42      matthew   260:         url += 'form=' + formname + '&';
                    261:         if (only != null) {
                    262:             url += 'only=' + only + '&';
1.217     albertel  263:         } else {
                    264:             url += 'only=&';
                    265: 	}
1.42      matthew   266:         if (omit != null) {
                    267:             url += 'omit=' + omit + '&';
1.217     albertel  268:         } else {
                    269:             url += 'omit=&';
                    270: 	}
1.135     albertel  271:         if (titleelement != null) {
                    272:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  273:         } else {
                    274: 	    url += 'titleelement=&';
                    275: 	}
1.42      matthew   276:         url += 'element=' + elementname + '';
                    277:         var title = 'Browser';
1.435     albertel  278:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   279:         options += ',width=700,height=600';
                    280:         editbrowser = open(url,title,options,'1');
                    281:         editbrowser.focus();
                    282:     }
                    283:     var editsearcher;
1.135     albertel  284:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   285:         var url = '/adm/searchcat?';
                    286:         if (editsearcher == null) {
                    287:             url += 'launch=1&';
                    288:         }
                    289:         url += 'catalogmode=interactive&';
1.199     albertel  290:         url += 'mode=$mode&';
1.42      matthew   291:         url += 'form=' + formname + '&';
1.135     albertel  292:         if (titleelement != null) {
                    293:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  294:         } else {
                    295: 	    url += 'titleelement=&';
                    296: 	}
1.42      matthew   297:         url += 'element=' + elementname + '';
                    298:         var title = 'Search';
1.435     albertel  299:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   300:         options += ',width=700,height=600';
                    301:         editsearcher = open(url,title,options,'1');
                    302:         editsearcher.focus();
                    303:     }
1.219     albertel  304: // END LON-CAPA Internal -->
1.42      matthew   305: END
1.170     www       306: }
                    307: 
                    308: sub lastresurl {
1.258     albertel  309:     if ($env{'environment.lastresurl'}) {
                    310: 	return $env{'environment.lastresurl'}
1.170     www       311:     } else {
                    312: 	return '/res';
                    313:     }
                    314: }
                    315: 
                    316: sub storeresurl {
                    317:     my $resurl=&Apache::lonnet::clutter(shift);
                    318:     unless ($resurl=~/^\/res/) { return 0; }
                    319:     $resurl=~s/\/$//;
                    320:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
                    321:     &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
                    322:     return 1;
1.42      matthew   323: }
                    324: 
1.74      www       325: sub studentbrowser_javascript {
1.111     www       326:    unless (
1.258     albertel  327:             (($env{'request.course.id'}) && 
1.302     albertel  328:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    329: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    330: 					  '/'.$env{'request.course.sec'})
                    331: 	      ))
1.258     albertel  332:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       333:           ) { return ''; }  
1.74      www       334:    return (<<'ENDSTDBRW');
                    335: <script type="text/javascript" language="Javascript" >
                    336:     var stdeditbrowser;
1.558     albertel  337:     function openstdbrowser(formname,uname,udom,roleflag,ignorefilter) {
1.74      www       338:         var url = '/adm/pickstudent?';
                    339:         var filter;
1.558     albertel  340: 	if (!ignorefilter) {
                    341: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    342: 	}
1.74      www       343:         if (filter != null) {
                    344:            if (filter != '') {
                    345:                url += 'filter='+filter+'&';
                    346: 	   }
                    347:         }
                    348:         url += 'form=' + formname + '&unameelement='+uname+
                    349:                                     '&udomelement='+udom;
1.111     www       350: 	if (roleflag) { url+="&roles=1"; }
1.102     www       351:         var title = 'Student_Browser';
1.74      www       352:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    353:         options += ',width=700,height=600';
                    354:         stdeditbrowser = open(url,title,options,'1');
                    355:         stdeditbrowser.focus();
                    356:     }
                    357: </script>
                    358: ENDSTDBRW
                    359: }
1.42      matthew   360: 
1.74      www       361: sub selectstudent_link {
1.111     www       362:    my ($form,$unameele,$udomele)=@_;
1.258     albertel  363:    if ($env{'request.course.id'}) {  
1.302     albertel  364:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    365: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    366: 					'/'.$env{'request.course.sec'})) {
1.111     www       367: 	   return '';
                    368:        }
                    369:        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.558     albertel  370:         '","'.$udomele.'","","1");'."'>".&mt('Select User')."</a>";
1.74      www       371:    }
1.258     albertel  372:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.111     www       373:        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.119     www       374:         '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
1.111     www       375:    }
                    376:    return '';
1.91      www       377: }
                    378: 
                    379: sub coursebrowser_javascript {
1.468     raeburn   380:     my ($domainfilter,$sec_element,$formname)=@_;
1.377     raeburn   381:     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   382:    my $output = '
1.538     albertel  383: <script type="text/javascript">
1.468     raeburn   384:     var stdeditbrowser;'."\n";
                    385:    $output .= <<"ENDSTDBRW";
1.377     raeburn   386:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91      www       387:         var url = '/adm/pickcourse?';
1.468     raeburn   388:         var domainfilter = '';
                    389:         var formid = getFormIdByName(formname);
                    390:         if (formid > -1) {
                    391:             var domid = getIndexByName(formid,udom);
                    392:             if (domid > -1) {
                    393:                 if (document.forms[formid].elements[domid].type == 'select-one') {
                    394:                     domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    395:                 }
                    396:                 if (document.forms[formid].elements[domid].type == 'hidden') {
                    397:                     domainfilter=document.forms[formid].elements[domid].value;
                    398:                 }
                    399:             }
1.91      www       400:         }
1.128     albertel  401:         if (domainfilter != null) {
                    402:            if (domainfilter != '') {
                    403:                url += 'domainfilter='+domainfilter+'&';
                    404: 	   }
                    405:         }
1.91      www       406:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  407: 	                            '&cdomelement='+udom+
                    408:                                     '&cnameelement='+desc;
1.468     raeburn   409:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   410:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   411:                 url += '&roleelement='+extra_element;
                    412:                 if (domainfilter == null || domainfilter == '') {
                    413:                     url += '&domainfilter='+extra_element;
                    414:                 }
1.234     raeburn   415:             }
1.468     raeburn   416:             else {
                    417:                 if (formname == 'portform') {
                    418:                     url += '&setroles='+extra_element;
                    419:                 }
                    420:             }     
1.230     raeburn   421:         }
1.293     raeburn   422:         if (multflag !=null && multflag != '') {
                    423:             url += '&multiple='+multflag;
                    424:         }
1.377     raeburn   425:         if (crstype == 'Course/Group') {
                    426:             if (formname == 'cu') {
                    427:                 crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; 
                    428:                 if (crstype == "") {
                    429:                     alert("$crs_or_grp_alert");
                    430:                     return;
                    431:                 }
                    432:             }
                    433:         }
                    434:         if (crstype !=null && crstype != '') {
                    435:             url += '&type='+crstype;
                    436:         }
1.102     www       437:         var title = 'Course_Browser';
1.91      www       438:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    439:         options += ',width=700,height=600';
                    440:         stdeditbrowser = open(url,title,options,'1');
                    441:         stdeditbrowser.focus();
                    442:     }
1.468     raeburn   443: 
                    444:     function getFormIdByName(formname) {
                    445:         for (var i=0;i<document.forms.length;i++) {
                    446:             if (document.forms[i].name == formname) {
                    447:                 return i;
                    448:             }
                    449:         }
                    450:         return -1; 
                    451:     }
                    452: 
                    453:     function getIndexByName(formid,item) {
                    454:         for (var i=0;i<document.forms[formid].elements.length;i++) {
                    455:             if (document.forms[formid].elements[i].name == item) {
                    456:                 return i;
                    457:             }
                    458:         }
                    459:         return -1;
                    460:     }
1.91      www       461: ENDSTDBRW
1.468     raeburn   462:     if ($sec_element ne '') {
                    463:         $output .= &setsec_javascript($sec_element,$formname);
                    464:     }
                    465:     $output .= '
                    466: </script>';
                    467:     return $output;
                    468: }
                    469: 
                    470: sub setsec_javascript {
                    471:     my ($sec_element,$formname) = @_;
                    472:     my $setsections = qq|
                    473: function setSect(sectionlist) {
                    474:     var sectionsArray = sectionlist.split(",");
                    475:     var numSections = sectionsArray.length;
                    476:     document.$formname.$sec_element.length = 0;
                    477:     if (numSections == 0) {
                    478:         document.$formname.$sec_element.multiple=false;
                    479:         document.$formname.$sec_element.size=1;
                    480:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    481:     } else {
                    482:         if (numSections == 1) {
                    483:             document.$formname.$sec_element.multiple=false;
                    484:             document.$formname.$sec_element.size=1;
                    485:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    486:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    487:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    488:         } else {
                    489:             for (var i=0; i<numSections; i++) {
                    490:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    491:             }
                    492:             document.$formname.$sec_element.multiple=true
                    493:             if (numSections < 3) {
                    494:                 document.$formname.$sec_element.size=numSections;
                    495:             } else {
                    496:                 document.$formname.$sec_element.size=3;
                    497:             }
                    498:             document.$formname.$sec_element.options[0].selected = false
                    499:         }
                    500:     }
1.91      www       501: }
1.468     raeburn   502: |;
                    503:     return $setsections;
                    504: }
                    505: 
1.91      www       506: 
                    507: sub selectcourse_link {
1.377     raeburn   508:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.492     albertel  509:    return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
                    510:         '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
1.74      www       511: }
1.42      matthew   512: 
1.273     raeburn   513: sub check_uncheck_jscript {
                    514:     my $jscript = <<"ENDSCRT";
                    515: function checkAll(field) {
                    516:     if (field.length > 0) {
                    517:         for (i = 0; i < field.length; i++) {
                    518:             field[i].checked = true ;
                    519:         }
                    520:     } else {
                    521:         field.checked = true
                    522:     }
                    523: }
                    524:  
                    525: function uncheckAll(field) {
                    526:     if (field.length > 0) {
                    527:         for (i = 0; i < field.length; i++) {
                    528:             field[i].checked = false ;
1.543     albertel  529:         }
                    530:     } else {
1.273     raeburn   531:         field.checked = false ;
                    532:     }
                    533: }
                    534: ENDSCRT
                    535:     return $jscript;
                    536: }
                    537: 
                    538: 
1.42      matthew   539: =pod
1.36      matthew   540: 
1.112     bowersj2  541: =item * linked_select_forms(...)
1.36      matthew   542: 
                    543: linked_select_forms returns a string containing a <script></script> block
                    544: and html for two <select> menus.  The select menus will be linked in that
                    545: changing the value of the first menu will result in new values being placed
                    546: in the second menu.  The values in the select menu will appear in alphabetical
                    547: order.
                    548: 
                    549: linked_select_forms takes the following ordered inputs:
                    550: 
                    551: =over 4
                    552: 
1.112     bowersj2  553: =item * $formname, the name of the <form> tag
1.36      matthew   554: 
1.112     bowersj2  555: =item * $middletext, the text which appears between the <select> tags
1.36      matthew   556: 
1.112     bowersj2  557: =item * $firstdefault, the default value for the first menu
1.36      matthew   558: 
1.112     bowersj2  559: =item * $firstselectname, the name of the first <select> tag
1.36      matthew   560: 
1.112     bowersj2  561: =item * $secondselectname, the name of the second <select> tag
1.36      matthew   562: 
1.112     bowersj2  563: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew   564: 
1.41      ng        565: =back 
                    566: 
1.36      matthew   567: Below is an example of such a hash.  Only the 'text', 'default', and 
                    568: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    569: values for the first select menu.  The text that coincides with the 
1.41      ng        570: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   571: and text for the second menu are given in the hash pointed to by 
                    572: $menu{$choice1}->{'select2'}.  
                    573: 
1.112     bowersj2  574:  my %menu = ( A1 => { text =>"Choice A1" ,
                    575:                        default => "B3",
                    576:                        select2 => { 
                    577:                            B1 => "Choice B1",
                    578:                            B2 => "Choice B2",
                    579:                            B3 => "Choice B3",
                    580:                            B4 => "Choice B4"
                    581:                            }
                    582:                    },
                    583:                A2 => { text =>"Choice A2" ,
                    584:                        default => "C2",
                    585:                        select2 => { 
                    586:                            C1 => "Choice C1",
                    587:                            C2 => "Choice C2",
                    588:                            C3 => "Choice C3"
                    589:                            }
                    590:                    },
                    591:                A3 => { text =>"Choice A3" ,
                    592:                        default => "D6",
                    593:                        select2 => { 
                    594:                            D1 => "Choice D1",
                    595:                            D2 => "Choice D2",
                    596:                            D3 => "Choice D3",
                    597:                            D4 => "Choice D4",
                    598:                            D5 => "Choice D5",
                    599:                            D6 => "Choice D6",
                    600:                            D7 => "Choice D7"
                    601:                            }
                    602:                    }
                    603:                );
1.36      matthew   604: 
                    605: =cut
                    606: 
                    607: sub linked_select_forms {
                    608:     my ($formname,
                    609:         $middletext,
                    610:         $firstdefault,
                    611:         $firstselectname,
                    612:         $secondselectname, 
                    613:         $hashref
                    614:         ) = @_;
                    615:     my $second = "document.$formname.$secondselectname";
                    616:     my $first = "document.$formname.$firstselectname";
                    617:     # output the javascript to do the changing
                    618:     my $result = '';
1.219     albertel  619:     $result.="<script type=\"text/javascript\">\n";
1.36      matthew   620:     $result.="var select2data = new Object();\n";
                    621:     $" = '","';
                    622:     my $debug = '';
                    623:     foreach my $s1 (sort(keys(%$hashref))) {
                    624:         $result.="select2data.d_$s1 = new Object();\n";        
                    625:         $result.="select2data.d_$s1.def = new String('".
                    626:             $hashref->{$s1}->{'default'}."');\n";
                    627:         $result.="select2data.d_$s1.values = new Array(";        
                    628:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
                    629:         $result.="\"@s2values\");\n";
                    630:         $result.="select2data.d_$s1.texts = new Array(";        
                    631:         my @s2texts;
                    632:         foreach my $value (@s2values) {
                    633:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                    634:         }
                    635:         $result.="\"@s2texts\");\n";
                    636:     }
                    637:     $"=' ';
                    638:     $result.= <<"END";
                    639: 
                    640: function select1_changed() {
                    641:     // Determine new choice
                    642:     var newvalue = "d_" + $first.value;
                    643:     // update select2
                    644:     var values     = select2data[newvalue].values;
                    645:     var texts      = select2data[newvalue].texts;
                    646:     var select2def = select2data[newvalue].def;
                    647:     var i;
                    648:     // out with the old
                    649:     for (i = 0; i < $second.options.length; i++) {
                    650:         $second.options[i] = null;
                    651:     }
                    652:     // in with the nuclear
                    653:     for (i=0;i<values.length; i++) {
                    654:         $second.options[i] = new Option(values[i]);
1.143     matthew   655:         $second.options[i].value = values[i];
1.36      matthew   656:         $second.options[i].text = texts[i];
                    657:         if (values[i] == select2def) {
                    658:             $second.options[i].selected = true;
                    659:         }
                    660:     }
                    661: }
                    662: </script>
                    663: END
                    664:     # output the initial values for the selection lists
                    665:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
                    666:     foreach my $value (sort(keys(%$hashref))) {
                    667:         $result.="    <option value=\"$value\" ";
1.253     albertel  668:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www       669:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew   670:     }
                    671:     $result .= "</select>\n";
                    672:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                    673:     $result .= $middletext;
                    674:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                    675:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
                    676:     foreach my $value (sort(keys(%select2))) {
                    677:         $result.="    <option value=\"$value\" ";        
1.253     albertel  678:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www       679:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew   680:     }
                    681:     $result .= "</select>\n";
                    682:     #    return $debug;
                    683:     return $result;
                    684: }   #  end of sub linked_select_forms {
                    685: 
1.45      matthew   686: =pod
1.44      bowersj2  687: 
1.112     bowersj2  688: =item * help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44      bowersj2  689: 
1.112     bowersj2  690: Returns a string corresponding to an HTML link to the given help
                    691: $topic, where $topic corresponds to the name of a .tex file in
                    692: /home/httpd/html/adm/help/tex, with underscores replaced by
                    693: spaces. 
                    694: 
                    695: $text will optionally be linked to the same topic, allowing you to
                    696: link text in addition to the graphic. If you do not want to link
                    697: text, but wish to specify one of the later parameters, pass an
                    698: empty string. 
                    699: 
                    700: $stayOnPage is a value that will be interpreted as a boolean. If true,
                    701: the link will not open a new window. If false, the link will open
                    702: a new window using Javascript. (Default is false.) 
                    703: 
                    704: $width and $height are optional numerical parameters that will
                    705: override the width and height of the popped up window, which may
                    706: be useful for certain help topics with big pictures included. 
1.44      bowersj2  707: 
                    708: =cut
                    709: 
                    710: sub help_open_topic {
1.48      bowersj2  711:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
                    712:     $text = "" if (not defined $text);
1.44      bowersj2  713:     $stayOnPage = 0 if (not defined $stayOnPage);
1.552     banghart  714:     if ($env{'browser.interface'} eq 'textual') {
1.79      www       715: 	$stayOnPage=1;
                    716:     }
1.44      bowersj2  717:     $width = 350 if (not defined $width);
                    718:     $height = 400 if (not defined $height);
                    719:     my $filename = $topic;
                    720:     $filename =~ s/ /_/g;
                    721: 
1.48      bowersj2  722:     my $template = "";
                    723:     my $link;
1.572     banghart  724:     
1.159     www       725:     $topic=~s/\W/\_/g;
1.44      bowersj2  726: 
1.572     banghart  727:     if (!$stayOnPage) {
1.72      bowersj2  728: 	$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  729:     } else {
1.48      bowersj2  730: 	$link = "/adm/help/${filename}.hlp";
                    731:     }
                    732: 
                    733:     # Add the text
1.572     banghart  734:     if ($text ne "") {
1.77      www       735: 	$template .= 
1.572     banghart  736:             "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
                    737:             "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48      bowersj2  738:     }
                    739: 
                    740:     # Add the graphic
1.179     matthew   741:     my $title = &mt('Online Help');
1.215     albertel  742:     my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
1.48      bowersj2  743:     $template .= <<"ENDTEMPLATE";
1.436     albertel  744:  <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
1.44      bowersj2  745: ENDTEMPLATE
1.78      www       746:     if ($text ne '') { $template.='</td></tr></table>' };
1.44      bowersj2  747:     return $template;
                    748: 
1.106     bowersj2  749: }
                    750: 
                    751: # This is a quicky function for Latex cheatsheet editing, since it 
                    752: # appears in at least four places
                    753: sub helpLatexCheatsheet {
                    754:     my $other = shift;
                    755:     my $addOther = '';
                    756:     if ($other) {
                    757: 	$addOther = Apache::loncommon::help_open_topic($other, shift,
                    758: 						       undef, undef, 600) .
                    759: 							   '</td><td>';
                    760:     }
                    761:     return '<table><tr><td>'.
                    762: 	$addOther .
                    763: 	&Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',
                    764: 					    undef,undef,600)
                    765: 	.'</td><td>'.
                    766: 	&Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',
                    767: 					    undef,undef,600)
                    768: 	.'</td></tr></table>';
1.172     www       769: }
                    770: 
1.430     albertel  771: sub general_help {
                    772:     my $helptopic='Student_Intro';
                    773:     if ($env{'request.role'}=~/^(ca|au)/) {
                    774: 	$helptopic='Authoring_Intro';
                    775:     } elsif ($env{'request.role'}=~/^cc/) {
                    776: 	$helptopic='Course_Coordination_Intro';
                    777:     }
                    778:     return $helptopic;
                    779: }
                    780: 
                    781: sub update_help_link {
                    782:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                    783:     my $origurl = $ENV{'REQUEST_URI'};
                    784:     $origurl=~s|^/~|/priv/|;
                    785:     my $timestamp = time;
                    786:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                    787:         $$datum = &escape($$datum);
                    788:     }
                    789: 
                    790:     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";
                    791:     my $output .= <<"ENDOUTPUT";
                    792: <script type="text/javascript">
                    793: banner_link = '$banner_link';
                    794: </script>
                    795: ENDOUTPUT
                    796:     return $output;
                    797: }
                    798: 
                    799: # now just updates the help link and generates a blue icon
1.193     raeburn   800: sub help_open_menu {
1.430     albertel  801:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart  802: 	= @_;    
1.430     albertel  803:     $stayOnPage = 0 if (not defined $stayOnPage);
1.572     banghart  804:     # only use pop-up help (stayOnPage == 0)
1.552     banghart  805:     # if environment.remote is on (using remote control UI)
1.572     banghart  806:     if ($env{'browser.interface'} eq 'textual' ||
                    807:     	$env{'environment.remote'} eq 'off' ) {
1.552     banghart  808:         $stayOnPage=1;
1.430     albertel  809:     }
                    810:     my $output;
                    811:     if ($component_help) {
                    812: 	if (!$text) {
                    813: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                    814: 				       $width,$height);
                    815: 	} else {
                    816: 	    my $help_text;
                    817: 	    $help_text=&unescape($topic);
                    818: 	    $output='<table><tr><td>'.
                    819: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                    820: 				 $width,$height).'</td></tr></table>';
                    821: 	}
                    822:     }
                    823:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                    824:     return $output.$banner_link;
                    825: }
                    826: 
                    827: sub top_nav_help {
                    828:     my ($text) = @_;
1.436     albertel  829:     $text = &mt($text);
1.572     banghart  830:     my $stay_on_page = 
1.436     albertel  831: 	($env{'browser.interface'}  eq 'textual' ||
                    832: 	 $env{'environment.remote'} eq 'off' );
1.572     banghart  833:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel  834: 	                     : "javascript:helpMenu('open')";
1.572     banghart  835:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel  836: 
1.201     raeburn   837:     my $title = &mt('Get help');
1.436     albertel  838: 
                    839:     return <<"END";
                    840: $banner_link
                    841:  <a href="$link" title="$title">$text</a>
                    842: END
                    843: }
                    844: 
                    845: sub help_menu_js {
                    846:     my ($text) = @_;
                    847: 
                    848:     my $stayOnPage = 
                    849: 	($env{'browser.interface'}  eq 'textual' ||
                    850: 	 $env{'environment.remote'} eq 'off' );
                    851: 
                    852:     my $width = 620;
                    853:     my $height = 600;
1.430     albertel  854:     my $helptopic=&general_help();
                    855:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel  856:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel  857:     my $start_page =
                    858:         &Apache::loncommon::start_page('Help Menu', undef,
                    859: 				       {'frameset'    => 1,
                    860: 					'js_ready'    => 1,
                    861: 					'add_entries' => {
                    862: 					    'border' => '0',
1.579     raeburn   863: 					    'rows'   => "110,*",},});
1.331     albertel  864:     my $end_page =
                    865:         &Apache::loncommon::end_page({'frameset' => 1,
                    866: 				      'js_ready' => 1,});
                    867: 
1.436     albertel  868:     my $template .= <<"ENDTEMPLATE";
                    869: <script type="text/javascript">
1.253     albertel  870: // <!-- BEGIN LON-CAPA Internal
                    871: // <![CDATA[
1.430     albertel  872: var banner_link = '';
1.243     raeburn   873: function helpMenu(target) {
                    874:     var caller = this;
                    875:     if (target == 'open') {
                    876:         var newWindow = null;
                    877:         try {
1.262     albertel  878:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn   879:         }
                    880:         catch(error) {
                    881:             writeHelp(caller);
                    882:             return;
                    883:         }
                    884:         if (newWindow) {
                    885:             caller = newWindow;
                    886:         }
1.193     raeburn   887:     }
1.243     raeburn   888:     writeHelp(caller);
                    889:     return;
                    890: }
                    891: function writeHelp(caller) {
1.430     albertel  892:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn   893:     caller.document.close()
                    894:     caller.focus()
1.193     raeburn   895: }
1.253     albertel  896: // ]]>
1.219     albertel  897: // END LON-CAPA Internal -->
1.436     albertel  898: </script>
1.193     raeburn   899: ENDTEMPLATE
                    900:     return $template;
                    901: }
                    902: 
1.172     www       903: sub help_open_bug {
                    904:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel  905:     unless ($env{'user.adv'}) { return ''; }
1.172     www       906:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                    907:     $text = "" if (not defined $text);
                    908:     $stayOnPage = 0 if (not defined $stayOnPage);
1.258     albertel  909:     if ($env{'browser.interface'} eq 'textual' ||
                    910: 	$env{'environment.remote'} eq 'off' ) {
1.172     www       911: 	$stayOnPage=1;
                    912:     }
1.184     albertel  913:     $width = 600 if (not defined $width);
                    914:     $height = 600 if (not defined $height);
1.172     www       915: 
                    916:     $topic=~s/\W+/\+/g;
                    917:     my $link='';
                    918:     my $template='';
1.379     albertel  919:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                    920: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www       921:     if (!$stayOnPage)
                    922:     {
                    923: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                    924:     }
                    925:     else
                    926:     {
                    927: 	$link = $url;
                    928:     }
                    929:     # Add the text
                    930:     if ($text ne "")
                    931:     {
                    932: 	$template .= 
                    933:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436     albertel  934:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172     www       935:     }
                    936: 
                    937:     # Add the graphic
1.179     matthew   938:     my $title = &mt('Report a Bug');
1.215     albertel  939:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www       940:     $template .= <<"ENDTEMPLATE";
1.436     albertel  941:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www       942: ENDTEMPLATE
                    943:     if ($text ne '') { $template.='</td></tr></table>' };
                    944:     return $template;
                    945: 
                    946: }
                    947: 
                    948: sub help_open_faq {
                    949:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel  950:     unless ($env{'user.adv'}) { return ''; }
1.172     www       951:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                    952:     $text = "" if (not defined $text);
                    953:     $stayOnPage = 0 if (not defined $stayOnPage);
1.258     albertel  954:     if ($env{'browser.interface'} eq 'textual' ||
                    955: 	$env{'environment.remote'} eq 'off' ) {
1.172     www       956: 	$stayOnPage=1;
                    957:     }
                    958:     $width = 350 if (not defined $width);
                    959:     $height = 400 if (not defined $height);
                    960: 
                    961:     $topic=~s/\W+/\+/g;
                    962:     my $link='';
                    963:     my $template='';
                    964:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                    965:     if (!$stayOnPage)
                    966:     {
                    967: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                    968:     }
                    969:     else
                    970:     {
                    971: 	$link = $url;
                    972:     }
                    973: 
                    974:     # Add the text
                    975:     if ($text ne "")
                    976:     {
                    977: 	$template .= 
1.173     www       978:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436     albertel  979:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172     www       980:     }
                    981: 
                    982:     # Add the graphic
1.179     matthew   983:     my $title = &mt('View the FAQ');
1.215     albertel  984:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www       985:     $template .= <<"ENDTEMPLATE";
1.436     albertel  986:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www       987: ENDTEMPLATE
                    988:     if ($text ne '') { $template.='</td></tr></table>' };
                    989:     return $template;
                    990: 
1.44      bowersj2  991: }
1.37      matthew   992: 
1.180     matthew   993: ###############################################################
                    994: ###############################################################
                    995: 
1.45      matthew   996: =pod
                    997: 
1.256     matthew   998: =item * change_content_javascript():
                    999: 
                   1000: This and the next function allow you to create small sections of an
                   1001: otherwise static HTML page that you can update on the fly with
                   1002: Javascript, even in Netscape 4.
                   1003: 
                   1004: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1005: must be written to the HTML page once. It will prove the Javascript
                   1006: function "change(name, content)". Calling the change function with the
                   1007: name of the section 
                   1008: you want to update, matching the name passed to C<changable_area>, and
                   1009: the new content you want to put in there, will put the content into
                   1010: that area.
                   1011: 
                   1012: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1013: to contain room for the original contents. You need to "make space"
                   1014: for whatever changes you wish to make, and be B<sure> to check your
                   1015: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1016: it's adequate for updating a one-line status display, but little more.
                   1017: This script will set the space to 100% width, so you only need to
                   1018: worry about height in Netscape 4.
                   1019: 
                   1020: Modern browsers are much less limiting, and if you can commit to the
                   1021: user not using Netscape 4, this feature may be used freely with
                   1022: pretty much any HTML.
                   1023: 
                   1024: =cut
                   1025: 
                   1026: sub change_content_javascript {
                   1027:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1028:     if ($env{'browser.type'} eq 'netscape' &&
                   1029: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1030: 	return (<<NETSCAPE4);
                   1031: 	function change(name, content) {
                   1032: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1033: 	    doc.open();
                   1034: 	    doc.write(content);
                   1035: 	    doc.close();
                   1036: 	}
                   1037: NETSCAPE4
                   1038:     } else {
                   1039: 	# Otherwise, we need to use semi-standards-compliant code
                   1040: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1041: 	# is really scary, and every useful browser supports it
                   1042: 	return (<<DOMBASED);
                   1043: 	function change(name, content) {
                   1044: 	    element = document.getElementById(name);
                   1045: 	    element.innerHTML = content;
                   1046: 	}
                   1047: DOMBASED
                   1048:     }
                   1049: }
                   1050: 
                   1051: =pod
                   1052: 
                   1053: =item * changable_area($name, $origContent):
                   1054: 
                   1055: This provides a "changable area" that can be modified on the fly via
                   1056: the Javascript code provided in C<change_content_javascript>. $name is
                   1057: the name you will use to reference the area later; do not repeat the
                   1058: same name on a given HTML page more then once. $origContent is what
                   1059: the area will originally contain, which can be left blank.
                   1060: 
                   1061: =cut
                   1062: 
                   1063: sub changable_area {
                   1064:     my ($name, $origContent) = @_;
                   1065: 
1.258     albertel 1066:     if ($env{'browser.type'} eq 'netscape' &&
                   1067: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1068: 	# If this is netscape 4, we need to use the Layer tag
                   1069: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1070:     } else {
                   1071: 	return "<span id='$name'>$origContent</span>";
                   1072:     }
                   1073: }
                   1074: 
                   1075: =pod
                   1076: 
1.590     raeburn  1077: =item * viewport_geometry_js {
                   1078: 
                   1079: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1080: 
                   1081: =cut
                   1082: 
                   1083: 
                   1084: sub viewport_geometry_js { 
                   1085:     return <<"GEOMETRY";
                   1086: var Geometry = {};
                   1087: function init_geometry() {
                   1088:     if (Geometry.init) { return };
                   1089:     Geometry.init=1;
                   1090:     if (window.innerHeight) {
                   1091:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1092:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1093:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1094:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1095:     }
                   1096:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1097:         Geometry.getViewportHeight =
                   1098:             function() { return document.documentElement.clientHeight; };
                   1099:         Geometry.getViewportWidth =
                   1100:             function() { return document.documentElement.clientWidth; };
                   1101: 
                   1102:         Geometry.getHorizontalScroll =
                   1103:             function() { return document.documentElement.scrollLeft; };
                   1104:         Geometry.getVerticalScroll =
                   1105:             function() { return document.documentElement.scrollTop; };
                   1106:     }
                   1107:     else if (document.body.clientHeight) {
                   1108:         Geometry.getViewportHeight =
                   1109:             function() { return document.body.clientHeight; };
                   1110:         Geometry.getViewportWidth =
                   1111:             function() { return document.body.clientWidth; };
                   1112:         Geometry.getHorizontalScroll =
                   1113:             function() { return document.body.scrollLeft; };
                   1114:         Geometry.getVerticalScroll =
                   1115:             function() { return document.body.scrollTop; };
                   1116:     }
                   1117: }
                   1118: 
                   1119: GEOMETRY
                   1120: }
                   1121: 
                   1122: =pod
                   1123: 
                   1124: =item * viewport_size_js {
                   1125: 
                   1126: 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. 
                   1127: 
                   1128: =cut
                   1129: 
                   1130: sub viewport_size_js {
                   1131:     my $geometry = &viewport_geometry_js();
                   1132:     return <<"DIMS";
                   1133: 
                   1134: $geometry
                   1135: 
                   1136: function getViewportDims(width,height) {
                   1137:     init_geometry();
                   1138:     width.value = Geometry.getViewportWidth();
                   1139:     height.value = Geometry.getViewportHeight();
                   1140:     return;
                   1141: }
                   1142: 
                   1143: DIMS
                   1144: }
                   1145: 
                   1146: =pod
                   1147: 
1.565     albertel 1148: =item * resize_textarea_js
                   1149: 
                   1150: emits the needed javascript to resize a textarea to be as big as possible
                   1151: 
                   1152: creates a function resize_textrea that takes two IDs first should be
                   1153: the id of the element to resize, second should be the id of a div that
                   1154: surrounds everything that comes after the textarea, this routine needs
                   1155: to be attached to the <body> for the onload and onresize events.
                   1156: 
                   1157: 
                   1158: =cut
                   1159: 
                   1160: sub resize_textarea_js {
1.590     raeburn  1161:     my $geometry = &viewport_geometry_js();
1.565     albertel 1162:     return <<"RESIZE";
                   1163:     <script type="text/javascript">
1.590     raeburn  1164: $geometry
1.565     albertel 1165: 
1.588     albertel 1166: function getX(element) {
                   1167:     var x = 0;
                   1168:     while (element) {
                   1169: 	x += element.offsetLeft;
                   1170: 	element = element.offsetParent;
                   1171:     }
                   1172:     return x;
                   1173: }
                   1174: function getY(element) {
                   1175:     var y = 0;
                   1176:     while (element) {
                   1177: 	y += element.offsetTop;
                   1178: 	element = element.offsetParent;
                   1179:     }
                   1180:     return y;
                   1181: }
                   1182: 
                   1183: 
1.565     albertel 1184: function resize_textarea(textarea_id,bottom_id) {
                   1185:     init_geometry();
                   1186:     var textarea        = document.getElementById(textarea_id);
                   1187:     //alert(textarea);
                   1188: 
1.588     albertel 1189:     var textarea_top    = getY(textarea);
1.565     albertel 1190:     var textarea_height = textarea.offsetHeight;
                   1191:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1192:     var bottom_top      = getY(bottom);
1.565     albertel 1193:     var bottom_height   = bottom.offsetHeight;
                   1194:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1195:     var fudge           = 23;
1.565     albertel 1196:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1197:     if (new_height < 300) {
                   1198: 	new_height = 300;
                   1199:     }
                   1200:     textarea.style.height=new_height+'px';
                   1201: }
                   1202: </script>
                   1203: RESIZE
                   1204: 
                   1205: }
                   1206: 
                   1207: =pod
                   1208: 
1.256     matthew  1209: =back
1.542     raeburn  1210:  
1.256     matthew  1211: =head1 Excel and CSV file utility routines
                   1212: 
                   1213: =over 4
                   1214: 
                   1215: =cut
                   1216: 
                   1217: ###############################################################
                   1218: ###############################################################
                   1219: 
                   1220: =pod
                   1221: 
1.112     bowersj2 1222: =item * csv_translate($text) 
1.37      matthew  1223: 
1.185     www      1224: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1225: format.
                   1226: 
                   1227: =cut
                   1228: 
1.180     matthew  1229: ###############################################################
                   1230: ###############################################################
1.37      matthew  1231: sub csv_translate {
                   1232:     my $text = shift;
                   1233:     $text =~ s/\"/\"\"/g;
1.209     albertel 1234:     $text =~ s/\n/ /g;
1.37      matthew  1235:     return $text;
                   1236: }
1.180     matthew  1237: 
                   1238: ###############################################################
                   1239: ###############################################################
                   1240: 
                   1241: =pod
                   1242: 
                   1243: =item * define_excel_formats
                   1244: 
                   1245: Define some commonly used Excel cell formats.
                   1246: 
                   1247: Currently supported formats:
                   1248: 
                   1249: =over 4
                   1250: 
                   1251: =item header
                   1252: 
                   1253: =item bold
                   1254: 
                   1255: =item h1
                   1256: 
                   1257: =item h2
                   1258: 
                   1259: =item h3
                   1260: 
1.256     matthew  1261: =item h4
                   1262: 
                   1263: =item i
                   1264: 
1.180     matthew  1265: =item date
                   1266: 
                   1267: =back
                   1268: 
                   1269: Inputs: $workbook
                   1270: 
                   1271: Returns: $format, a hash reference.
                   1272: 
                   1273: =cut
                   1274: 
                   1275: ###############################################################
                   1276: ###############################################################
                   1277: sub define_excel_formats {
                   1278:     my ($workbook) = @_;
                   1279:     my $format;
                   1280:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1281:                                                 bottom    => 1,
                   1282:                                                 align     => 'center');
                   1283:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1284:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1285:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1286:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1287:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1288:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1289:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1290:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1291:     return $format;
                   1292: }
                   1293: 
                   1294: ###############################################################
                   1295: ###############################################################
1.113     bowersj2 1296: 
                   1297: =pod
                   1298: 
1.256     matthew  1299: =item * create_workbook
1.255     matthew  1300: 
                   1301: Create an Excel worksheet.  If it fails, output message on the
                   1302: request object and return undefs.
                   1303: 
                   1304: Inputs: Apache request object
                   1305: 
                   1306: Returns (undef) on failure, 
                   1307:     Excel worksheet object, scalar with filename, and formats 
                   1308:     from &Apache::loncommon::define_excel_formats on success
                   1309: 
                   1310: =cut
                   1311: 
                   1312: ###############################################################
                   1313: ###############################################################
                   1314: sub create_workbook {
                   1315:     my ($r) = @_;
                   1316:         #
                   1317:     # Create the excel spreadsheet
                   1318:     my $filename = '/prtspool/'.
1.258     albertel 1319:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1320:         time.'_'.rand(1000000000).'.xls';
                   1321:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1322:     if (! defined($workbook)) {
                   1323:         $r->log_error("Error creating excel spreadsheet $filename: $!");
                   1324:         $r->print('<p>'.&mt("Unable to create new Excel file.  ".
                   1325:                             "This error has been logged.  ".
                   1326:                             "Please alert your LON-CAPA administrator").
                   1327:                   '</p>');
                   1328:         return (undef);
                   1329:     }
                   1330:     #
                   1331:     $workbook->set_tempdir('/home/httpd/perl/tmp');
                   1332:     #
                   1333:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1334:     return ($workbook,$filename,$format);
                   1335: }
                   1336: 
                   1337: ###############################################################
                   1338: ###############################################################
                   1339: 
                   1340: =pod
                   1341: 
1.256     matthew  1342: =item * create_text_file
1.113     bowersj2 1343: 
1.542     raeburn  1344: Create a file to write to and eventually make available to the user.
1.256     matthew  1345: If file creation fails, outputs an error message on the request object and 
                   1346: return undefs.
1.113     bowersj2 1347: 
1.256     matthew  1348: Inputs: Apache request object, and file suffix
1.113     bowersj2 1349: 
1.256     matthew  1350: Returns (undef) on failure, 
                   1351:     Filehandle and filename on success.
1.113     bowersj2 1352: 
                   1353: =cut
                   1354: 
1.256     matthew  1355: ###############################################################
                   1356: ###############################################################
                   1357: sub create_text_file {
                   1358:     my ($r,$suffix) = @_;
                   1359:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1360:     my $fh;
                   1361:     my $filename = '/prtspool/'.
1.258     albertel 1362:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1363:         time.'_'.rand(1000000000).'.'.$suffix;
                   1364:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1365:     if (! defined($fh)) {
                   1366:         $r->log_error("Couldn't open $filename for output $!");
                   1367:         $r->print("Problems occured in creating the output file.  ".
                   1368:                   "This error has been logged.  ".
                   1369:                   "Please alert your LON-CAPA administrator.");
1.113     bowersj2 1370:     }
1.256     matthew  1371:     return ($fh,$filename)
1.113     bowersj2 1372: }
                   1373: 
                   1374: 
1.256     matthew  1375: =pod 
1.113     bowersj2 1376: 
                   1377: =back
                   1378: 
                   1379: =cut
1.37      matthew  1380: 
                   1381: ###############################################################
1.33      matthew  1382: ##        Home server <option> list generating code          ##
                   1383: ###############################################################
1.35      matthew  1384: 
1.169     www      1385: # ------------------------------------------
                   1386: 
                   1387: sub domain_select {
                   1388:     my ($name,$value,$multiple)=@_;
                   1389:     my %domains=map { 
1.514     albertel 1390: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1391:     } &Apache::lonnet::all_domains();
1.169     www      1392:     if ($multiple) {
                   1393: 	$domains{''}=&mt('Any domain');
1.550     albertel 1394: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1395: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1396:     } else {
1.550     albertel 1397: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169     www      1398: 	return &select_form($name,$value,%domains);
                   1399:     }
                   1400: }
                   1401: 
1.282     albertel 1402: #-------------------------------------------
                   1403: 
                   1404: =pod
                   1405: 
1.519     raeburn  1406: =head1 Routines for form select boxes
                   1407: 
                   1408: =over 4
                   1409: 
1.287     albertel 1410: =item * multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1411: 
                   1412: Returns a string containing a <select> element int multiple mode
                   1413: 
                   1414: 
                   1415: Args:
                   1416:   $name - name of the <select> element
1.506     raeburn  1417:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1418:   $size - number of rows long the select element is
1.283     albertel 1419:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1420:           (shown text should already have been &mt())
1.506     raeburn  1421:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1422: 
1.282     albertel 1423: =cut
                   1424: 
                   1425: #-------------------------------------------
1.169     www      1426: sub multiple_select_form {
1.284     albertel 1427:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1428:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1429:     my $output='';
1.191     matthew  1430:     if (! defined($size)) {
                   1431:         $size = 4;
1.283     albertel 1432:         if (scalar(keys(%$hash))<4) {
                   1433:             $size = scalar(keys(%$hash));
1.191     matthew  1434:         }
                   1435:     }
1.169     www      1436:     $output.="\n<select name='$name' size='$size' multiple='1'>";
1.501     banghart 1437:     my @order;
1.506     raeburn  1438:     if (ref($order) eq 'ARRAY')  {
                   1439:         @order = @{$order};
                   1440:     } else {
                   1441:         @order = sort(keys(%$hash));
1.501     banghart 1442:     }
                   1443:     if (exists($$hash{'select_form_order'})) {
                   1444:         @order = @{$$hash{'select_form_order'}};
                   1445:     }
                   1446:         
1.284     albertel 1447:     foreach my $key (@order) {
1.356     albertel 1448:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1449:         $output.='selected="selected" ' if ($selected{$key});
                   1450:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1451:     }
                   1452:     $output.="</select>\n";
                   1453:     return $output;
                   1454: }
                   1455: 
1.88      www      1456: #-------------------------------------------
                   1457: 
                   1458: =pod
                   1459: 
1.112     bowersj2 1460: =item * select_form($defdom,$name,%hash)
1.88      www      1461: 
                   1462: Returns a string containing a <select name='$name' size='1'> form to 
                   1463: allow a user to select options from a hash option_name => displayed text.  
                   1464: See lonrights.pm for an example invocation and use.
                   1465: 
                   1466: =cut
                   1467: 
                   1468: #-------------------------------------------
                   1469: sub select_form {
                   1470:     my ($def,$name,%hash) = @_;
                   1471:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128     albertel 1472:     my @keys;
                   1473:     if (exists($hash{'select_form_order'})) {
                   1474: 	@keys=@{$hash{'select_form_order'}};
                   1475:     } else {
                   1476: 	@keys=sort(keys(%hash));
                   1477:     }
1.356     albertel 1478:     foreach my $key (@keys) {
                   1479:         $selectform.=
                   1480: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1481:             ($key eq $def ? 'selected="selected" ' : '').
                   1482:                 ">".&mt($hash{$key})."</option>\n";
1.88      www      1483:     }
                   1484:     $selectform.="</select>";
                   1485:     return $selectform;
                   1486: }
                   1487: 
1.475     www      1488: # For display filters
                   1489: 
                   1490: sub display_filter {
                   1491:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1492:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.475     www      1493:     return '<nobr><label>'.&mt('Records [_1]',
                   1494: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1495: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.478     www      1496: 	   '</label></nobr> <nobr>'.
1.475     www      1497:            &mt('Filter [_1]',
1.477     www      1498: 	   &select_form($env{'form.displayfilter'},
                   1499: 			'displayfilter',
                   1500: 			('currentfolder' => 'Current folder/page',
                   1501: 			 'containing' => 'Containing phrase',
                   1502: 			 'none' => 'None'))).
1.478     www      1503: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
1.475     www      1504: }
                   1505: 
1.167     www      1506: sub gradeleveldescription {
                   1507:     my $gradelevel=shift;
                   1508:     my %gradelevels=(0 => 'Not specified',
                   1509: 		     1 => 'Grade 1',
                   1510: 		     2 => 'Grade 2',
                   1511: 		     3 => 'Grade 3',
                   1512: 		     4 => 'Grade 4',
                   1513: 		     5 => 'Grade 5',
                   1514: 		     6 => 'Grade 6',
                   1515: 		     7 => 'Grade 7',
                   1516: 		     8 => 'Grade 8',
                   1517: 		     9 => 'Grade 9',
                   1518: 		     10 => 'Grade 10',
                   1519: 		     11 => 'Grade 11',
                   1520: 		     12 => 'Grade 12',
                   1521: 		     13 => 'Grade 13',
                   1522: 		     14 => '100 Level',
                   1523: 		     15 => '200 Level',
                   1524: 		     16 => '300 Level',
                   1525: 		     17 => '400 Level',
                   1526: 		     18 => 'Graduate Level');
                   1527:     return &mt($gradelevels{$gradelevel});
                   1528: }
                   1529: 
1.163     www      1530: sub select_level_form {
                   1531:     my ($deflevel,$name)=@_;
                   1532:     unless ($deflevel) { $deflevel=0; }
1.167     www      1533:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   1534:     for (my $i=0; $i<=18; $i++) {
                   1535:         $selectform.="<option value=\"$i\" ".
1.253     albertel 1536:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      1537:                 ">".&gradeleveldescription($i)."</option>\n";
                   1538:     }
                   1539:     $selectform.="</select>";
                   1540:     return $selectform;
1.163     www      1541: }
1.167     www      1542: 
1.35      matthew  1543: #-------------------------------------------
                   1544: 
1.45      matthew  1545: =pod
                   1546: 
1.563     raeburn  1547: =item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)
1.35      matthew  1548: 
                   1549: Returns a string containing a <select name='$name' size='1'> form to 
                   1550: allow a user to select the domain to preform an operation in.  
                   1551: See loncreateuser.pm for an example invocation and use.
                   1552: 
1.90      www      1553: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   1554: selected");
                   1555: 
1.563     raeburn  1556: If the $showdomdesc flag is set, the domain name is followed by the domain description. 
                   1557: 
1.35      matthew  1558: =cut
                   1559: 
                   1560: #-------------------------------------------
1.34      matthew  1561: sub select_dom_form {
1.563     raeburn  1562:     my ($defdom,$name,$includeempty,$showdomdesc) = @_;
1.550     albertel 1563:     my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90      www      1564:     if ($includeempty) { @domains=('',@domains); }
1.34      matthew  1565:     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
1.356     albertel 1566:     foreach my $dom (@domains) {
                   1567:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  1568:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   1569:         if ($showdomdesc) {
                   1570:             if ($dom ne '') {
                   1571:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   1572:                 if ($domdesc ne '') {
                   1573:                     $selectdomain .= ' ('.$domdesc.')';
                   1574:                 }
                   1575:             } 
                   1576:         }
                   1577:         $selectdomain .= "</option>\n";
1.34      matthew  1578:     }
                   1579:     $selectdomain.="</select>";
                   1580:     return $selectdomain;
                   1581: }
                   1582: 
1.35      matthew  1583: #-------------------------------------------
                   1584: 
1.45      matthew  1585: =pod
                   1586: 
1.586     raeburn  1587: =item * home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  1588: 
1.586     raeburn  1589: input: 4 arguments (two required, two optional) - 
                   1590:     $domain - domain of new user
                   1591:     $name - name of form element
                   1592:     $default - Value of 'default' causes a default item to be first 
                   1593:                             option, and selected by default. 
                   1594:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   1595:                             if 1 server found, or default, if 0 found.
1.594     raeburn  1596: output: returns 2 items: 
1.586     raeburn  1597: (a) form element which contains either:
                   1598:    (i) <select name="$name">
                   1599:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   1600:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   1601:        </select>
                   1602:        form item if there are multiple library servers in $domain, or
                   1603:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   1604:        if there is only one library server in $domain.
                   1605: 
                   1606: (b) number of library servers found.
                   1607: 
                   1608: See loncreateuser.pm for example of use.
1.35      matthew  1609: 
                   1610: =cut
                   1611: 
                   1612: #-------------------------------------------
1.586     raeburn  1613: sub home_server_form_item {
                   1614:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 1615:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  1616:     my $result;
                   1617:     my $numlib = keys(%servers);
                   1618:     if ($numlib > 1) {
                   1619:         $result .= '<select name="'.$name.'" />'."\n";
                   1620:         if ($default) {
                   1621:             $result .= '<option value="default" selected>'.&mt('default').
                   1622:                        '</option>'."\n";
                   1623:         }
                   1624:         foreach my $hostid (sort(keys(%servers))) {
                   1625:             $result.= '<option value="'.$hostid.'">'.
                   1626: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   1627:         }
                   1628:         $result .= '</select>'."\n";
                   1629:     } elsif ($numlib == 1) {
                   1630:         my $hostid;
                   1631:         foreach my $item (keys(%servers)) {
                   1632:             $hostid = $item;
                   1633:         }
                   1634:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   1635:                    $hostid.'" />';
                   1636:                    if (!$hide) {
                   1637:                        $result .= $hostid.' '.$servers{$hostid};
                   1638:                    }
                   1639:                    $result .= "\n";
                   1640:     } elsif ($default) {
                   1641:         $result .= '<input type="hidden" name="'.$name.
                   1642:                    '" value="default" />';
                   1643:                    if (!$hide) {
                   1644:                        $result .= &mt('default');
                   1645:                    }
                   1646:                    $result .= "\n";
1.33      matthew  1647:     }
1.586     raeburn  1648:     return ($result,$numlib);
1.33      matthew  1649: }
1.112     bowersj2 1650: 
                   1651: =pod
                   1652: 
1.534     albertel 1653: =back 
                   1654: 
1.112     bowersj2 1655: =cut
1.87      matthew  1656: 
                   1657: ###############################################################
1.112     bowersj2 1658: ##                  Decoding User Agent                      ##
1.87      matthew  1659: ###############################################################
                   1660: 
                   1661: =pod
                   1662: 
1.112     bowersj2 1663: =head1 Decoding the User Agent
                   1664: 
                   1665: =over 4
                   1666: 
                   1667: =item * &decode_user_agent()
1.87      matthew  1668: 
                   1669: Inputs: $r
                   1670: 
                   1671: Outputs:
                   1672: 
                   1673: =over 4
                   1674: 
1.112     bowersj2 1675: =item * $httpbrowser
1.87      matthew  1676: 
1.112     bowersj2 1677: =item * $clientbrowser
1.87      matthew  1678: 
1.112     bowersj2 1679: =item * $clientversion
1.87      matthew  1680: 
1.112     bowersj2 1681: =item * $clientmathml
1.87      matthew  1682: 
1.112     bowersj2 1683: =item * $clientunicode
1.87      matthew  1684: 
1.112     bowersj2 1685: =item * $clientos
1.87      matthew  1686: 
                   1687: =back
                   1688: 
1.157     matthew  1689: =back 
                   1690: 
1.87      matthew  1691: =cut
                   1692: 
                   1693: ###############################################################
                   1694: ###############################################################
                   1695: sub decode_user_agent {
1.247     albertel 1696:     my ($r)=@_;
1.87      matthew  1697:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   1698:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   1699:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 1700:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  1701:     my $clientbrowser='unknown';
                   1702:     my $clientversion='0';
                   1703:     my $clientmathml='';
                   1704:     my $clientunicode='0';
                   1705:     for (my $i=0;$i<=$#browsertype;$i++) {
                   1706:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   1707: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   1708: 	    $clientbrowser=$bname;
                   1709:             $httpbrowser=~/$vreg/i;
                   1710: 	    $clientversion=$1;
                   1711:             $clientmathml=($clientversion>=$minv);
                   1712:             $clientunicode=($clientversion>=$univ);
                   1713: 	}
                   1714:     }
                   1715:     my $clientos='unknown';
                   1716:     if (($httpbrowser=~/linux/i) ||
                   1717:         ($httpbrowser=~/unix/i) ||
                   1718:         ($httpbrowser=~/ux/i) ||
                   1719:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   1720:     if (($httpbrowser=~/vax/i) ||
                   1721:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   1722:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   1723:     if (($httpbrowser=~/mac/i) ||
                   1724:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   1725:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   1726:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   1727:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   1728:             $clientunicode,$clientos,);
                   1729: }
                   1730: 
1.32      matthew  1731: ###############################################################
                   1732: ##    Authentication changing form generation subroutines    ##
                   1733: ###############################################################
                   1734: ##
                   1735: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   1736: ## hash, and have reasonable default values.
                   1737: ##
                   1738: ##    formname = the name given in the <form> tag.
1.35      matthew  1739: #-------------------------------------------
                   1740: 
1.45      matthew  1741: =pod
                   1742: 
1.112     bowersj2 1743: =head1 Authentication Routines
                   1744: 
                   1745: =over 4
                   1746: 
                   1747: =item * authform_xxxxxx
1.35      matthew  1748: 
                   1749: The authform_xxxxxx subroutines provide javascript and html forms which 
                   1750: handle some of the conveniences required for authentication forms.  
                   1751: This is not an optimal method, but it works.  
                   1752: 
                   1753: See loncreateuser.pm for invocation and use examples.
                   1754: 
                   1755: =over 4
                   1756: 
1.112     bowersj2 1757: =item * authform_header
1.35      matthew  1758: 
1.112     bowersj2 1759: =item * authform_authorwarning
1.35      matthew  1760: 
1.112     bowersj2 1761: =item * authform_nochange
1.35      matthew  1762: 
1.112     bowersj2 1763: =item * authform_kerberos
1.35      matthew  1764: 
1.112     bowersj2 1765: =item * authform_internal
1.35      matthew  1766: 
1.112     bowersj2 1767: =item * authform_filesystem
1.35      matthew  1768: 
                   1769: =back
                   1770: 
1.157     matthew  1771: =back 
                   1772: 
1.35      matthew  1773: =cut
                   1774: 
                   1775: #-------------------------------------------
1.32      matthew  1776: sub authform_header{  
                   1777:     my %in = (
                   1778:         formname => 'cu',
1.80      albertel 1779:         kerb_def_dom => '',
1.32      matthew  1780:         @_,
                   1781:     );
                   1782:     $in{'formname'} = 'document.' . $in{'formname'};
                   1783:     my $result='';
1.80      albertel 1784: 
                   1785: #---------------------------------------------- Code for upper case translation
                   1786:     my $Javascript_toUpperCase;
                   1787:     unless ($in{kerb_def_dom}) {
                   1788:         $Javascript_toUpperCase =<<"END";
                   1789:         switch (choice) {
                   1790:            case 'krb': currentform.elements[choicearg].value =
                   1791:                currentform.elements[choicearg].value.toUpperCase();
                   1792:                break;
                   1793:            default:
                   1794:         }
                   1795: END
                   1796:     } else {
                   1797:         $Javascript_toUpperCase = "";
                   1798:     }
                   1799: 
1.165     raeburn  1800:     my $radioval = "'nochange'";
1.591     raeburn  1801:     if (defined($in{'curr_authtype'})) {
                   1802:         if ($in{'curr_authtype'} ne '') {
                   1803:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   1804:         }
1.174     matthew  1805:     }
1.165     raeburn  1806:     my $argfield = 'null';
1.591     raeburn  1807:     if (defined($in{'mode'})) {
1.165     raeburn  1808:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  1809:             if (defined($in{'curr_autharg'})) {
                   1810:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  1811:                     $argfield = "'$in{'curr_autharg'}'";
                   1812:                 }
                   1813:             }
                   1814:         }
                   1815:     }
                   1816: 
1.32      matthew  1817:     $result.=<<"END";
                   1818: var current = new Object();
1.165     raeburn  1819: current.radiovalue = $radioval;
                   1820: current.argfield = $argfield;
1.32      matthew  1821: 
                   1822: function changed_radio(choice,currentform) {
                   1823:     var choicearg = choice + 'arg';
                   1824:     // If a radio button in changed, we need to change the argfield
                   1825:     if (current.radiovalue != choice) {
                   1826:         current.radiovalue = choice;
                   1827:         if (current.argfield != null) {
                   1828:             currentform.elements[current.argfield].value = '';
                   1829:         }
                   1830:         if (choice == 'nochange') {
                   1831:             current.argfield = null;
                   1832:         } else {
                   1833:             current.argfield = choicearg;
                   1834:             switch(choice) {
                   1835:                 case 'krb': 
                   1836:                     currentform.elements[current.argfield].value = 
                   1837:                         "$in{'kerb_def_dom'}";
                   1838:                 break;
                   1839:               default:
                   1840:                 break;
                   1841:             }
                   1842:         }
                   1843:     }
                   1844:     return;
                   1845: }
1.22      www      1846: 
1.32      matthew  1847: function changed_text(choice,currentform) {
                   1848:     var choicearg = choice + 'arg';
                   1849:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 1850:         $Javascript_toUpperCase
1.32      matthew  1851:         // clear old field
                   1852:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   1853:             currentform.elements[current.argfield].value = '';
                   1854:         }
                   1855:         current.argfield = choicearg;
                   1856:     }
                   1857:     set_auth_radio_buttons(choice,currentform);
                   1858:     return;
1.20      www      1859: }
1.32      matthew  1860: 
                   1861: function set_auth_radio_buttons(newvalue,currentform) {
                   1862:     var i=0;
                   1863:     while (i < currentform.login.length) {
                   1864:         if (currentform.login[i].value == newvalue) { break; }
                   1865:         i++;
                   1866:     }
                   1867:     if (i == currentform.login.length) {
                   1868:         return;
                   1869:     }
                   1870:     current.radiovalue = newvalue;
                   1871:     currentform.login[i].checked = true;
                   1872:     return;
                   1873: }
                   1874: END
                   1875:     return $result;
                   1876: }
                   1877: 
                   1878: sub authform_authorwarning{
                   1879:     my $result='';
1.144     matthew  1880:     $result='<i>'.
                   1881:         &mt('As a general rule, only authors or co-authors should be '.
                   1882:             'filesystem authenticated '.
                   1883:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  1884:     return $result;
                   1885: }
                   1886: 
                   1887: sub authform_nochange{  
                   1888:     my %in = (
                   1889:               formname => 'document.cu',
                   1890:               kerb_def_dom => 'MSU.EDU',
                   1891:               @_,
                   1892:           );
1.586     raeburn  1893:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   1894:     my $result;
                   1895:     if (keys(%can_assign) == 0) {
                   1896:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   1897:     } else {
                   1898:         $result = '<label>'.&mt('[_1] Do not change login data',
                   1899:                   '<input type="radio" name="login" value="nochange" '.
                   1900:                   'checked="checked" onclick="'.
1.281     albertel 1901:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   1902: 	    '</label>';
1.586     raeburn  1903:     }
1.32      matthew  1904:     return $result;
                   1905: }
                   1906: 
1.591     raeburn  1907: sub authform_kerberos {
1.32      matthew  1908:     my %in = (
                   1909:               formname => 'document.cu',
                   1910:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 1911:               kerb_def_auth => 'krb4',
1.32      matthew  1912:               @_,
                   1913:               );
1.586     raeburn  1914:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   1915:         $autharg,$jscall);
                   1916:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 1917:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.586     raeburn  1918:        $check5 = ' checked="on"';
1.80      albertel 1919:     } else {
1.586     raeburn  1920:        $check4 = ' checked="on"';
1.80      albertel 1921:     }
1.165     raeburn  1922:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  1923:     if (defined($in{'curr_authtype'})) {
                   1924:         if ($in{'curr_authtype'} eq 'krb') {
1.586     raeburn  1925:             $krbcheck = ' checked="on"';
1.591     raeburn  1926:             if (defined($in{'curr_kerb_ver'})) {
                   1927:                 if ($in{'curr_krb_ver'} eq '5') {
                   1928:                     $check5 = ' checked="on"';
                   1929:                     $check4 = '';
                   1930:                 } else {
                   1931:                     $check4 = ' checked="on"';
                   1932:                     $check5 = '';
                   1933:                 }
1.586     raeburn  1934:             }
1.591     raeburn  1935:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  1936:                 $krbarg = $in{'curr_autharg'};
                   1937:             }
1.586     raeburn  1938:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  1939:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  1940:                     $result = 
                   1941:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   1942:         $in{'curr_autharg'},$krbver);
                   1943:                 } else {
                   1944:                     $result =
                   1945:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   1946:                 }
                   1947:                 return $result; 
                   1948:             }
                   1949:         }
                   1950:     } else {
                   1951:         if ($authnum == 1) {
                   1952:             $authtype = '<input type="hidden" name="login" value="krb">';
1.165     raeburn  1953:         }
                   1954:     }
1.586     raeburn  1955:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   1956:         return;
1.587     raeburn  1957:     } elsif ($authtype eq '') {
1.591     raeburn  1958:         if (defined($in{'mode'})) {
1.587     raeburn  1959:             if ($in{'mode'} eq 'modifycourse') {
                   1960:                 if ($authnum == 1) {
                   1961:                     $authtype = '<input type="hidden" name="login" value="krb">';
                   1962:                 }
                   1963:             }
                   1964:         }
1.586     raeburn  1965:     }
                   1966:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   1967:     if ($authtype eq '') {
                   1968:         $authtype = '<input type="radio" name="login" value="krb" '.
                   1969:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   1970:                     $krbcheck.' />';
                   1971:     }
                   1972:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   1973:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   1974:          $in{'curr_authtype'} eq 'krb5') ||
                   1975:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   1976:          $in{'curr_authtype'} eq 'krb4')) {
                   1977:         $result .= &mt
1.144     matthew  1978:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 1979:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  1980:          '<label>'.$authtype,
1.281     albertel 1981:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  1982:              'value="'.$krbarg.'" '.
1.144     matthew  1983:              'onchange="'.$jscall.'" />',
1.281     albertel 1984:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   1985:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   1986: 	 '</label>');
1.586     raeburn  1987:     } elsif ($can_assign{'krb4'}) {
                   1988:         $result .= &mt
                   1989:         ('[_1] Kerberos authenticated with domain [_2] '.
                   1990:          '[_3] Version 4 [_4]',
                   1991:          '<label>'.$authtype,
                   1992:          '</label><input type="text" size="10" name="krbarg" '.
                   1993:              'value="'.$krbarg.'" '.
                   1994:              'onchange="'.$jscall.'" />',
                   1995:          '<label><input type="hidden" name="krbver" value="4" />',
                   1996:          '</label>');
                   1997:     } elsif ($can_assign{'krb5'}) {
                   1998:         $result .= &mt
                   1999:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2000:          '[_3] Version 5 [_4]',
                   2001:          '<label>'.$authtype,
                   2002:          '</label><input type="text" size="10" name="krbarg" '.
                   2003:              'value="'.$krbarg.'" '.
                   2004:              'onchange="'.$jscall.'" />',
                   2005:          '<label><input type="hidden" name="krbver" value="5" />',
                   2006:          '</label>');
                   2007:     }
1.32      matthew  2008:     return $result;
                   2009: }
                   2010: 
                   2011: sub authform_internal{  
1.586     raeburn  2012:     my %in = (
1.32      matthew  2013:                 formname => 'document.cu',
                   2014:                 kerb_def_dom => 'MSU.EDU',
                   2015:                 @_,
                   2016:                 );
1.586     raeburn  2017:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2018:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2019:     if (defined($in{'curr_authtype'})) {
                   2020:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2021:             if ($can_assign{'int'}) {
                   2022:                 $intcheck = 'checked="on" ';
1.591     raeburn  2023:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2024:                     $intarg = $in{'curr_autharg'};
                   2025:                 }
                   2026:             } else {
                   2027:                 $result = &mt('Currently internally authenticated.');
                   2028:                 return $result;
1.165     raeburn  2029:             }
                   2030:         }
1.586     raeburn  2031:     } else {
                   2032:         if ($authnum == 1) {
                   2033:             $authtype = '<input type="hidden" name="login" value="int">';
                   2034:         }
                   2035:     }
                   2036:     if (!$can_assign{'int'}) {
                   2037:         return;
1.587     raeburn  2038:     } elsif ($authtype eq '') {
1.591     raeburn  2039:         if (defined($in{'mode'})) {
1.587     raeburn  2040:             if ($in{'mode'} eq 'modifycourse') {
                   2041:                 if ($authnum == 1) {
                   2042:                     $authtype = '<input type="hidden" name="login" value="int">';
                   2043:                 }
                   2044:             }
                   2045:         }
1.165     raeburn  2046:     }
1.586     raeburn  2047:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2048:     if ($authtype eq '') {
                   2049:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2050:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2051:     }
1.605   ! bisitz   2052:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2053:                $intarg.'" onchange="'.$jscall.'" />';
                   2054:     $result = &mt
1.144     matthew  2055:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2056:          '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2057:     return $result;
                   2058: }
                   2059: 
                   2060: sub authform_local{  
                   2061:     my %in = (
                   2062:               formname => 'document.cu',
                   2063:               kerb_def_dom => 'MSU.EDU',
                   2064:               @_,
                   2065:               );
1.586     raeburn  2066:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2067:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2068:     if (defined($in{'curr_authtype'})) {
                   2069:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2070:             if ($can_assign{'loc'}) {
                   2071:                 $loccheck = 'checked="on" ';
1.591     raeburn  2072:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2073:                     $locarg = $in{'curr_autharg'};
                   2074:                 }
                   2075:             } else {
                   2076:                 $result = &mt('Currently using local (institutional) authentication.');
                   2077:                 return $result;
1.165     raeburn  2078:             }
                   2079:         }
1.586     raeburn  2080:     } else {
                   2081:         if ($authnum == 1) {
                   2082:             $authtype = '<input type="hidden" name="login" value="loc">';
                   2083:         }
                   2084:     }
                   2085:     if (!$can_assign{'loc'}) {
                   2086:         return;
1.587     raeburn  2087:     } elsif ($authtype eq '') {
1.591     raeburn  2088:         if (defined($in{'mode'})) {
1.587     raeburn  2089:             if ($in{'mode'} eq 'modifycourse') {
                   2090:                 if ($authnum == 1) {
                   2091:                     $authtype = '<input type="hidden" name="login" value="loc">';
                   2092:                 }
                   2093:             }
                   2094:         }
1.165     raeburn  2095:     }
1.586     raeburn  2096:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2097:     if ($authtype eq '') {
                   2098:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2099:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2100:                     $jscall.'" />';
                   2101:     }
                   2102:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2103:                $locarg.'" onchange="'.$jscall.'" />';
                   2104:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2105:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2106:     return $result;
                   2107: }
                   2108: 
                   2109: sub authform_filesystem{  
                   2110:     my %in = (
                   2111:               formname => 'document.cu',
                   2112:               kerb_def_dom => 'MSU.EDU',
                   2113:               @_,
                   2114:               );
1.586     raeburn  2115:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2116:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2117:     if (defined($in{'curr_authtype'})) {
                   2118:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2119:             if ($can_assign{'fsys'}) {
                   2120:                 $fsyscheck = 'checked="on" ';
                   2121:             } else {
                   2122:                 $result = &mt('Currently Filesystem Authenticated.');
                   2123:                 return $result;
                   2124:             }           
                   2125:         }
                   2126:     } else {
                   2127:         if ($authnum == 1) {
                   2128:             $authtype = '<input type="hidden" name="login" value="fsys">';
                   2129:         }
                   2130:     }
                   2131:     if (!$can_assign{'fsys'}) {
                   2132:         return;
1.587     raeburn  2133:     } elsif ($authtype eq '') {
1.591     raeburn  2134:         if (defined($in{'mode'})) {
1.587     raeburn  2135:             if ($in{'mode'} eq 'modifycourse') {
                   2136:                 if ($authnum == 1) {
                   2137:                     $authtype = '<input type="hidden" name="login" value="fsys">';
                   2138:                 }
                   2139:             }
                   2140:         }
1.586     raeburn  2141:     }
                   2142:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2143:     if ($authtype eq '') {
                   2144:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2145:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2146:                     $jscall.'" />';
                   2147:     }
                   2148:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2149:                ' onchange="'.$jscall.'" />';
                   2150:     $result = &mt
1.144     matthew  2151:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2152:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2153:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605   ! bisitz   2154:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2155:                   'onchange="'.$jscall.'" />');
1.32      matthew  2156:     return $result;
                   2157: }
                   2158: 
1.586     raeburn  2159: sub get_assignable_auth {
                   2160:     my ($dom) = @_;
                   2161:     if ($dom eq '') {
                   2162:         $dom = $env{'request.role.domain'};
                   2163:     }
                   2164:     my %can_assign = (
                   2165:                           krb4 => 1,
                   2166:                           krb5 => 1,
                   2167:                           int  => 1,
                   2168:                           loc  => 1,
                   2169:                      );
                   2170:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2171:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2172:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2173:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2174:             my $context;
                   2175:             if ($env{'request.role'} =~ /^au/) {
                   2176:                 $context = 'author';
                   2177:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2178:                 $context = 'domain';
                   2179:             } elsif ($env{'request.course.id'}) {
                   2180:                 $context = 'course';
                   2181:             }
                   2182:             if ($context) {
                   2183:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2184:                    %can_assign = %{$authhash->{$context}}; 
                   2185:                 }
                   2186:             }
                   2187:         }
                   2188:     }
                   2189:     my $authnum = 0;
                   2190:     foreach my $key (keys(%can_assign)) {
                   2191:         if ($can_assign{$key}) {
                   2192:             $authnum ++;
                   2193:         }
                   2194:     }
                   2195:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2196:         $authnum --;
                   2197:     }
                   2198:     return ($authnum,%can_assign);
                   2199: }
                   2200: 
1.80      albertel 2201: ###############################################################
                   2202: ##    Get Authentication Defaults for Domain                 ##
                   2203: ###############################################################
                   2204: 
                   2205: =pod
                   2206: 
1.112     bowersj2 2207: =head1 Domains and Authentication
                   2208: 
                   2209: Returns default authentication type and an associated argument as
                   2210: listed in file 'domain.tab'.
                   2211: 
                   2212: =over 4
                   2213: 
                   2214: =item * get_auth_defaults
1.80      albertel 2215: 
                   2216: get_auth_defaults($target_domain) returns the default authentication
                   2217: type and an associated argument (initial password or a kerberos domain).
                   2218: These values are stored in lonTabs/domain.tab
                   2219: 
                   2220: ($def_auth, $def_arg) = &get_auth_defaults($target_domain);
                   2221: 
                   2222: If target_domain is not found in domain.tab, returns nothing ('').
                   2223: 
                   2224: =cut
                   2225: 
                   2226: #-------------------------------------------
                   2227: sub get_auth_defaults {
                   2228:     my $domain=shift;
1.514     albertel 2229:     return (&Apache::lonnet::domain($domain,'auth_def'),
                   2230: 	    &Apache::lonnet::domain($domain,'auth_arg_def'));
                   2231: 	    
1.80      albertel 2232: }
                   2233: ###############################################################
                   2234: ##   End Get Authentication Defaults for Domain              ##
                   2235: ###############################################################
                   2236: 
                   2237: ###############################################################
                   2238: ##    Get Kerberos Defaults for Domain                 ##
                   2239: ###############################################################
                   2240: ##
                   2241: ## Returns default kerberos version and an associated argument
                   2242: ## as listed in file domain.tab. If not listed, provides
                   2243: ## appropriate default domain and kerberos version.
                   2244: ##
                   2245: #-------------------------------------------
                   2246: 
                   2247: =pod
                   2248: 
1.112     bowersj2 2249: =item * get_kerberos_defaults
1.80      albertel 2250: 
                   2251: get_kerberos_defaults($target_domain) returns the default kerberos
                   2252: version and domain. If not found in domain.tabs, it defaults to
                   2253: version 4 and the domain of the server.
                   2254: 
                   2255: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2256: 
                   2257: =cut
                   2258: 
                   2259: #-------------------------------------------
                   2260: sub get_kerberos_defaults {
                   2261:     my $domain=shift;
                   2262:     my ($krbdef,$krbdefdom) =
                   2263:         &Apache::loncommon::get_auth_defaults($domain);
                   2264:     unless ($krbdef =~/^krb/ && $krbdefdom) {
                   2265:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2266:         my $krbdefdom=$1;
                   2267:         $krbdefdom=~tr/a-z/A-Z/;
                   2268:         $krbdef = "krb4";
                   2269:     }
                   2270:     return ($krbdef,$krbdefdom);
                   2271: }
1.112     bowersj2 2272: 
                   2273: =pod
                   2274: 
                   2275: =back
                   2276: 
                   2277: =cut
1.32      matthew  2278: 
1.46      matthew  2279: ###############################################################
                   2280: ##                Thesaurus Functions                        ##
                   2281: ###############################################################
1.20      www      2282: 
1.46      matthew  2283: =pod
1.20      www      2284: 
1.112     bowersj2 2285: =head1 Thesaurus Functions
                   2286: 
                   2287: =over 4
                   2288: 
                   2289: =item * initialize_keywords
1.46      matthew  2290: 
                   2291: Initializes the package variable %Keywords if it is empty.  Uses the
                   2292: package variable $thesaurus_db_file.
                   2293: 
                   2294: =cut
                   2295: 
                   2296: ###################################################
                   2297: 
                   2298: sub initialize_keywords {
                   2299:     return 1 if (scalar keys(%Keywords));
                   2300:     # If we are here, %Keywords is empty, so fill it up
                   2301:     #   Make sure the file we need exists...
                   2302:     if (! -e $thesaurus_db_file) {
                   2303:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2304:                                  " failed because it does not exist");
                   2305:         return 0;
                   2306:     }
                   2307:     #   Set up the hash as a database
                   2308:     my %thesaurus_db;
                   2309:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2310:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2311:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2312:                                  $thesaurus_db_file);
                   2313:         return 0;
                   2314:     } 
                   2315:     #  Get the average number of appearances of a word.
                   2316:     my $avecount = $thesaurus_db{'average.count'};
                   2317:     #  Put keywords (those that appear > average) into %Keywords
                   2318:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2319:         my ($count,undef) = split /:/,$data;
                   2320:         $Keywords{$word}++ if ($count > $avecount);
                   2321:     }
                   2322:     untie %thesaurus_db;
                   2323:     # Remove special values from %Keywords.
1.356     albertel 2324:     foreach my $value ('total.count','average.count') {
                   2325:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2326:   }
1.46      matthew  2327:     return 1;
                   2328: }
                   2329: 
                   2330: ###################################################
                   2331: 
                   2332: =pod
                   2333: 
1.112     bowersj2 2334: =item * keyword($word)
1.46      matthew  2335: 
                   2336: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2337: than the average number of times in the thesaurus database.  Calls 
                   2338: &initialize_keywords
                   2339: 
                   2340: =cut
                   2341: 
                   2342: ###################################################
1.20      www      2343: 
                   2344: sub keyword {
1.46      matthew  2345:     return if (!&initialize_keywords());
                   2346:     my $word=lc(shift());
                   2347:     $word=~s/\W//g;
                   2348:     return exists($Keywords{$word});
1.20      www      2349: }
1.46      matthew  2350: 
                   2351: ###############################################################
                   2352: 
                   2353: =pod 
1.20      www      2354: 
1.112     bowersj2 2355: =item * get_related_words
1.46      matthew  2356: 
1.160     matthew  2357: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2358: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2359: will be returned.  The order of the words returned is determined by the
                   2360: database which holds them.
                   2361: 
                   2362: Uses global $thesaurus_db_file.
                   2363: 
                   2364: =cut
                   2365: 
                   2366: ###############################################################
                   2367: sub get_related_words {
                   2368:     my $keyword = shift;
                   2369:     my %thesaurus_db;
                   2370:     if (! -e $thesaurus_db_file) {
                   2371:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2372:                                  "failed because the file does not exist");
                   2373:         return ();
                   2374:     }
                   2375:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2376:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2377:         return ();
                   2378:     } 
                   2379:     my @Words=();
1.429     www      2380:     my $count=0;
1.46      matthew  2381:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2382: 	# The first element is the number of times
                   2383: 	# the word appears.  We do not need it now.
1.429     www      2384: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2385: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2386: 	my $threshold=$mostfrequentcount/10;
                   2387:         foreach my $possibleword (@RelatedWords) {
                   2388:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2389:             if ($wordcount>$threshold) {
                   2390: 		push(@Words,$word);
                   2391:                 $count++;
                   2392:                 if ($count>10) { last; }
                   2393: 	    }
1.20      www      2394:         }
                   2395:     }
1.46      matthew  2396:     untie %thesaurus_db;
                   2397:     return @Words;
1.14      harris41 2398: }
1.46      matthew  2399: 
1.112     bowersj2 2400: =pod
                   2401: 
                   2402: =back
                   2403: 
                   2404: =cut
1.61      www      2405: 
                   2406: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2407: =pod
                   2408: 
1.112     bowersj2 2409: =head1 User Name Functions
                   2410: 
                   2411: =over 4
                   2412: 
1.226     albertel 2413: =item * plainname($uname,$udom,$first)
1.81      albertel 2414: 
1.112     bowersj2 2415: Takes a users logon name and returns it as a string in
1.226     albertel 2416: "first middle last generation" form 
                   2417: if $first is set to 'lastname' then it returns it as
                   2418: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2419: 
                   2420: =cut
1.61      www      2421: 
1.295     www      2422: 
1.81      albertel 2423: ###############################################################
1.61      www      2424: sub plainname {
1.226     albertel 2425:     my ($uname,$udom,$first)=@_;
1.537     albertel 2426:     return if (!defined($uname) || !defined($udom));
1.295     www      2427:     my %names=&getnames($uname,$udom);
1.226     albertel 2428:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2429: 					  $names{'middlename'},
                   2430: 					  $names{'lastname'},
                   2431: 					  $names{'generation'},$first);
                   2432:     $name=~s/^\s+//;
1.62      www      2433:     $name=~s/\s+$//;
                   2434:     $name=~s/\s+/ /g;
1.353     albertel 2435:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2436:     return $name;
1.61      www      2437: }
1.66      www      2438: 
                   2439: # -------------------------------------------------------------------- Nickname
1.81      albertel 2440: =pod
                   2441: 
1.112     bowersj2 2442: =item * nickname($uname,$udom)
1.81      albertel 2443: 
                   2444: Gets a users name and returns it as a string as
                   2445: 
                   2446: "&quot;nickname&quot;"
1.66      www      2447: 
1.81      albertel 2448: if the user has a nickname or
                   2449: 
                   2450: "first middle last generation"
                   2451: 
                   2452: if the user does not
                   2453: 
                   2454: =cut
1.66      www      2455: 
                   2456: sub nickname {
                   2457:     my ($uname,$udom)=@_;
1.537     albertel 2458:     return if (!defined($uname) || !defined($udom));
1.295     www      2459:     my %names=&getnames($uname,$udom);
1.68      albertel 2460:     my $name=$names{'nickname'};
1.66      www      2461:     if ($name) {
                   2462:        $name='&quot;'.$name.'&quot;'; 
                   2463:     } else {
                   2464:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2465: 	     $names{'lastname'}.' '.$names{'generation'};
                   2466:        $name=~s/\s+$//;
                   2467:        $name=~s/\s+/ /g;
                   2468:     }
                   2469:     return $name;
                   2470: }
                   2471: 
1.295     www      2472: sub getnames {
                   2473:     my ($uname,$udom)=@_;
1.537     albertel 2474:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2475:     if ($udom eq 'public' && $uname eq 'public') {
                   2476: 	return ('lastname' => &mt('Public'));
                   2477:     }
1.295     www      2478:     my $id=$uname.':'.$udom;
                   2479:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2480:     if ($cached) {
                   2481: 	return %{$names};
                   2482:     } else {
                   2483: 	my %loadnames=&Apache::lonnet::get('environment',
                   2484:                     ['firstname','middlename','lastname','generation','nickname'],
                   2485: 					 $udom,$uname);
                   2486: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2487: 	return %loadnames;
                   2488:     }
                   2489: }
1.61      www      2490: 
1.542     raeburn  2491: # -------------------------------------------------------------------- getemails
                   2492: =pod
                   2493: 
                   2494: =item * getemails($uname,$udom)
                   2495: 
                   2496: Gets a user's email information and returns it as a hash with keys:
                   2497: notification, critnotification, permanentemail
                   2498: 
                   2499: For notification and critnotification, values are comma-separated lists 
                   2500: of e-mail address(es); for permanentemail, value is a single e-mail address.
                   2501:  
                   2502: =cut
                   2503: 
1.466     albertel 2504: sub getemails {
                   2505:     my ($uname,$udom)=@_;
                   2506:     if ($udom eq 'public' && $uname eq 'public') {
                   2507: 	return;
                   2508:     }
1.467     www      2509:     if (!$udom) { $udom=$env{'user.domain'}; }
                   2510:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 2511:     my $id=$uname.':'.$udom;
                   2512:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   2513:     if ($cached) {
                   2514: 	return %{$names};
                   2515:     } else {
                   2516: 	my %loadnames=&Apache::lonnet::get('environment',
                   2517:                     			   ['notification','critnotification',
                   2518: 					    'permanentemail'],
                   2519: 					   $udom,$uname);
                   2520: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   2521: 	return %loadnames;
                   2522:     }
                   2523: }
                   2524: 
1.551     albertel 2525: sub flush_email_cache {
                   2526:     my ($uname,$udom)=@_;
                   2527:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2528:     if (!$uname) { $uname=$env{'user.name'};   }
                   2529:     return if ($udom eq 'public' && $uname eq 'public');
                   2530:     my $id=$uname.':'.$udom;
                   2531:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   2532: }
                   2533: 
1.61      www      2534: # ------------------------------------------------------------------ Screenname
1.81      albertel 2535: 
                   2536: =pod
                   2537: 
1.112     bowersj2 2538: =item * screenname($uname,$udom)
1.81      albertel 2539: 
                   2540: Gets a users screenname and returns it as a string
                   2541: 
                   2542: =cut
1.61      www      2543: 
                   2544: sub screenname {
                   2545:     my ($uname,$udom)=@_;
1.258     albertel 2546:     if ($uname eq $env{'user.name'} &&
                   2547: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 2548:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 2549:     return $names{'screenname'};
1.62      www      2550: }
                   2551: 
1.212     albertel 2552: 
1.62      www      2553: # ------------------------------------------------------------- Message Wrapper
                   2554: 
                   2555: sub messagewrapper {
1.369     www      2556:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      2557:     return 
1.441     albertel 2558:         '<a href="/adm/email?compose=individual&amp;'.
                   2559:         'recname='.$username.'&amp;recdom='.$domain.
                   2560: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  2561:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      2562: }
                   2563: # --------------------------------------------------------------- Notes Wrapper
                   2564: 
                   2565: sub noteswrapper {
                   2566:     my ($link,$un,$do)=@_;
                   2567:     return 
                   2568: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62      www      2569: }
                   2570: # ------------------------------------------------------------- Aboutme Wrapper
                   2571: 
                   2572: sub aboutmewrapper {
1.166     www      2573:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  2574:     if (!defined($username)  && !defined($domain)) {
                   2575:         return;
                   2576:     }
1.205     www      2577:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.454     banghart 2578: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';
1.62      www      2579: }
                   2580: 
                   2581: # ------------------------------------------------------------ Syllabus Wrapper
                   2582: 
                   2583: 
                   2584: sub syllabuswrapper {
1.109     matthew  2585:     my ($linktext,$coursedir,$domain,$fontcolor)=@_;
                   2586:     if ($fontcolor) { 
                   2587:         $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>'; 
                   2588:     }
1.208     matthew  2589:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      2590: }
1.14      harris41 2591: 
1.208     matthew  2592: sub track_student_link {
1.268     albertel 2593:     my ($linktext,$sname,$sdom,$target,$start) = @_;
                   2594:     my $link ="/adm/trackstudent?";
1.208     matthew  2595:     my $title = 'View recent activity';
                   2596:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   2597:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 2598:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  2599:         $title .= ' of this student';
1.268     albertel 2600:     } 
1.208     matthew  2601:     if (defined($target) && $target !~ /^\s*$/) {
                   2602:         $target = qq{target="$target"};
                   2603:     } else {
                   2604:         $target = '';
                   2605:     }
1.268     albertel 2606:     if ($start) { $link.='&amp;start='.$start; }
1.554     albertel 2607:     $title = &mt($title);
                   2608:     $linktext = &mt($linktext);
1.448     albertel 2609:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   2610: 	&help_open_topic('View_recent_activity');
1.208     matthew  2611: }
                   2612: 
1.508     www      2613: # ===================================================== Display a student photo
                   2614: 
                   2615: 
1.509     albertel 2616: sub student_image_tag {
1.508     www      2617:     my ($domain,$user)=@_;
                   2618:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   2619:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   2620: 	return '<img src="'.$imgsrc.'" align="right" />';
                   2621:     } else {
                   2622: 	return '';
                   2623:     }
                   2624: }
                   2625: 
1.112     bowersj2 2626: =pod
                   2627: 
                   2628: =back
                   2629: 
                   2630: =head1 Access .tab File Data
                   2631: 
                   2632: =over 4
                   2633: 
                   2634: =item * languageids() 
                   2635: 
                   2636: returns list of all language ids
                   2637: 
                   2638: =cut
                   2639: 
1.14      harris41 2640: sub languageids {
1.16      harris41 2641:     return sort(keys(%language));
1.14      harris41 2642: }
                   2643: 
1.112     bowersj2 2644: =pod
                   2645: 
                   2646: =item * languagedescription() 
                   2647: 
                   2648: returns description of a specified language id
                   2649: 
                   2650: =cut
                   2651: 
1.14      harris41 2652: sub languagedescription {
1.125     www      2653:     my $code=shift;
                   2654:     return  ($supported_language{$code}?'* ':'').
                   2655:             $language{$code}.
1.126     www      2656: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      2657: }
                   2658: 
                   2659: sub plainlanguagedescription {
                   2660:     my $code=shift;
                   2661:     return $language{$code};
                   2662: }
                   2663: 
                   2664: sub supportedlanguagecode {
                   2665:     my $code=shift;
                   2666:     return $supported_language{$code};
1.97      www      2667: }
                   2668: 
1.112     bowersj2 2669: =pod
                   2670: 
                   2671: =item * copyrightids() 
                   2672: 
                   2673: returns list of all copyrights
                   2674: 
                   2675: =cut
                   2676: 
                   2677: sub copyrightids {
                   2678:     return sort(keys(%cprtag));
                   2679: }
                   2680: 
                   2681: =pod
                   2682: 
                   2683: =item * copyrightdescription() 
                   2684: 
                   2685: returns description of a specified copyright id
                   2686: 
                   2687: =cut
                   2688: 
                   2689: sub copyrightdescription {
1.166     www      2690:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 2691: }
1.197     matthew  2692: 
                   2693: =pod
                   2694: 
1.192     taceyjo1 2695: =item * source_copyrightids() 
                   2696: 
                   2697: returns list of all source copyrights
                   2698: 
                   2699: =cut
                   2700: 
                   2701: sub source_copyrightids {
                   2702:     return sort(keys(%scprtag));
                   2703: }
                   2704: 
                   2705: =pod
                   2706: 
                   2707: =item * source_copyrightdescription() 
                   2708: 
                   2709: returns description of a specified source copyright id
                   2710: 
                   2711: =cut
                   2712: 
                   2713: sub source_copyrightdescription {
                   2714:     return &mt($scprtag{shift(@_)});
                   2715: }
1.112     bowersj2 2716: 
                   2717: =pod
                   2718: 
                   2719: =item * filecategories() 
                   2720: 
                   2721: returns list of all file categories
                   2722: 
                   2723: =cut
                   2724: 
                   2725: sub filecategories {
                   2726:     return sort(keys(%category_extensions));
                   2727: }
                   2728: 
                   2729: =pod
                   2730: 
                   2731: =item * filecategorytypes() 
                   2732: 
                   2733: returns list of file types belonging to a given file
                   2734: category
                   2735: 
                   2736: =cut
                   2737: 
                   2738: sub filecategorytypes {
1.356     albertel 2739:     my ($cat) = @_;
                   2740:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 2741: }
                   2742: 
                   2743: =pod
                   2744: 
                   2745: =item * fileembstyle() 
                   2746: 
                   2747: returns embedding style for a specified file type
                   2748: 
                   2749: =cut
                   2750: 
                   2751: sub fileembstyle {
                   2752:     return $fe{lc(shift(@_))};
1.169     www      2753: }
                   2754: 
1.351     www      2755: sub filemimetype {
                   2756:     return $fm{lc(shift(@_))};
                   2757: }
                   2758: 
1.169     www      2759: 
                   2760: sub filecategoryselect {
                   2761:     my ($name,$value)=@_;
1.189     matthew  2762:     return &select_form($value,$name,
1.169     www      2763: 			'' => &mt('Any category'),
                   2764: 			map { $_,$_ } sort(keys(%category_extensions)));
1.112     bowersj2 2765: }
                   2766: 
                   2767: =pod
                   2768: 
                   2769: =item * filedescription() 
                   2770: 
                   2771: returns description for a specified file type
                   2772: 
                   2773: =cut
                   2774: 
                   2775: sub filedescription {
1.188     matthew  2776:     my $file_description = $fd{lc(shift())};
                   2777:     $file_description =~ s:([\[\]]):~$1:g;
                   2778:     return &mt($file_description);
1.112     bowersj2 2779: }
                   2780: 
                   2781: =pod
                   2782: 
                   2783: =item * filedescriptionex() 
                   2784: 
                   2785: returns description for a specified file type with
                   2786: extra formatting
                   2787: 
                   2788: =cut
                   2789: 
                   2790: sub filedescriptionex {
                   2791:     my $ex=shift;
1.188     matthew  2792:     my $file_description = $fd{lc($ex)};
                   2793:     $file_description =~ s:([\[\]]):~$1:g;
                   2794:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 2795: }
                   2796: 
                   2797: # End of .tab access
                   2798: =pod
                   2799: 
                   2800: =back
                   2801: 
                   2802: =cut
                   2803: 
                   2804: # ------------------------------------------------------------------ File Types
                   2805: sub fileextensions {
                   2806:     return sort(keys(%fe));
                   2807: }
                   2808: 
1.97      www      2809: # ----------------------------------------------------------- Display Languages
                   2810: # returns a hash with all desired display languages
                   2811: #
                   2812: 
                   2813: sub display_languages {
                   2814:     my %languages=();
1.356     albertel 2815:     foreach my $lang (&preferred_languages()) {
                   2816: 	$languages{$lang}=1;
1.97      www      2817:     }
                   2818:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 2819:     if ($env{'form.displaylanguage'}) {
1.356     albertel 2820: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   2821: 	    $languages{$lang}=1;
1.97      www      2822:         }
                   2823:     }
                   2824:     return %languages;
1.14      harris41 2825: }
                   2826: 
1.117     www      2827: sub preferred_languages {
                   2828:     my @languages=();
1.258     albertel 2829:     if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
1.117     www      2830: 	@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
1.258     albertel 2831: 	         $env{'course.'.$env{'request.course.id'}.'.languages'}));
1.177     www      2832:     }
1.258     albertel 2833:     if ($env{'environment.languages'}) {
1.459     albertel 2834: 	@languages=(@languages,
                   2835: 		    split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
1.118     www      2836:     }
1.583     albertel 2837:     my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
1.162     www      2838:     if ($browser) {
1.583     albertel 2839: 	my @browser = 
                   2840: 	    map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
                   2841: 	push(@languages,@browser);
1.162     www      2842:     }
1.514     albertel 2843:     if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
1.118     www      2844: 	@languages=(@languages,
1.514     albertel 2845: 		    &Apache::lonnet::domain($env{'user.domain'},
                   2846: 					    'lang_def'));
1.118     www      2847:     }
1.514     albertel 2848:     if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
1.118     www      2849: 	@languages=(@languages,
1.514     albertel 2850: 		    &Apache::lonnet::domain($env{'request.role.domain'},
                   2851: 					    'lang_def'));
1.118     www      2852:     }
1.514     albertel 2853:     if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
                   2854: 				'lang_def')) {
1.118     www      2855: 	@languages=(@languages,
1.514     albertel 2856: 		    &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
                   2857: 					    'lang_def'));
1.118     www      2858:     }
                   2859: # turn "en-ca" into "en-ca,en"
                   2860:     my @genlanguages;
1.356     albertel 2861:     foreach my $lang (@languages) {
                   2862: 	unless ($lang=~/\w/) { next; }
1.583     albertel 2863: 	push(@genlanguages,$lang);
1.356     albertel 2864: 	if ($lang=~/(\-|\_)/) {
                   2865: 	    push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
1.118     www      2866: 	}
                   2867:     }
1.583     albertel 2868:     #uniqueify the languages list
                   2869:     my %count;
                   2870:     @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
1.118     www      2871:     return @genlanguages;
1.117     www      2872: }
                   2873: 
1.582     albertel 2874: sub languages {
                   2875:     my ($possible_langs) = @_;
                   2876:     my @preferred_langs = &preferred_languages();
                   2877:     if (!ref($possible_langs)) {
                   2878: 	if( wantarray ) {
                   2879: 	    return @preferred_langs;
                   2880: 	} else {
                   2881: 	    return $preferred_langs[0];
                   2882: 	}
                   2883:     }
                   2884:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   2885:     my @preferred_possibilities;
                   2886:     foreach my $preferred_lang (@preferred_langs) {
                   2887: 	if (exists($possibilities{$preferred_lang})) {
                   2888: 	    push(@preferred_possibilities, $preferred_lang);
                   2889: 	}
                   2890:     }
                   2891:     if( wantarray ) {
                   2892: 	return @preferred_possibilities;
                   2893:     }
                   2894:     return $preferred_possibilities[0];
                   2895: }
                   2896: 
1.112     bowersj2 2897: ###############################################################
                   2898: ##               Student Answer Attempts                     ##
                   2899: ###############################################################
                   2900: 
                   2901: =pod
                   2902: 
                   2903: =head1 Alternate Problem Views
                   2904: 
                   2905: =over 4
                   2906: 
                   2907: =item * get_previous_attempt($symb, $username, $domain, $course,
                   2908:     $getattempt, $regexp, $gradesub)
                   2909: 
                   2910: Return string with previous attempt on problem. Arguments:
                   2911: 
                   2912: =over 4
                   2913: 
                   2914: =item * $symb: Problem, including path
                   2915: 
                   2916: =item * $username: username of the desired student
                   2917: 
                   2918: =item * $domain: domain of the desired student
1.14      harris41 2919: 
1.112     bowersj2 2920: =item * $course: Course ID
1.14      harris41 2921: 
1.112     bowersj2 2922: =item * $getattempt: Leave blank for all attempts, otherwise put
                   2923:     something
1.14      harris41 2924: 
1.112     bowersj2 2925: =item * $regexp: if string matches this regexp, the string will be
                   2926:     sent to $gradesub
1.14      harris41 2927: 
1.112     bowersj2 2928: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 2929: 
1.112     bowersj2 2930: =back
1.14      harris41 2931: 
1.112     bowersj2 2932: The output string is a table containing all desired attempts, if any.
1.16      harris41 2933: 
1.112     bowersj2 2934: =cut
1.1       albertel 2935: 
                   2936: sub get_previous_attempt {
1.43      ng       2937:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 2938:   my $prevattempts='';
1.43      ng       2939:   no strict 'refs';
1.1       albertel 2940:   if ($symb) {
1.3       albertel 2941:     my (%returnhash)=
                   2942:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 2943:     if ($returnhash{'version'}) {
                   2944:       my %lasthash=();
                   2945:       my $version;
                   2946:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 2947:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   2948: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 2949:         }
1.1       albertel 2950:       }
1.596     albertel 2951:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   2952:       $prevattempts.='<th>'.&mt('History').'</th>';
1.356     albertel 2953:       foreach my $key (sort(keys(%lasthash))) {
                   2954: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       2955: 	if ($#parts > 0) {
1.31      albertel 2956: 	  my $data=$parts[-1];
                   2957: 	  pop(@parts);
1.596     albertel 2958: 	  $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.31      albertel 2959: 	} else {
1.41      ng       2960: 	  if ($#parts == 0) {
                   2961: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   2962: 	  } else {
                   2963: 	    $prevattempts.='<th>'.$ign.'</th>';
                   2964: 	  }
1.31      albertel 2965: 	}
1.16      harris41 2966:       }
1.596     albertel 2967:       $prevattempts.=&end_data_table_header_row();
1.40      ng       2968:       if ($getattempt eq '') {
                   2969: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596     albertel 2970: 	  $prevattempts.=&start_data_table_row().
                   2971: 	      '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356     albertel 2972: 	    foreach my $key (sort(keys(%lasthash))) {
1.581     albertel 2973: 		my $value = &format_previous_attempt_value($key,
                   2974: 							   $returnhash{$version.':'.$key});
                   2975: 		$prevattempts.='<td>'.$value.'&nbsp;</td>';   
1.40      ng       2976: 	    }
1.596     albertel 2977: 	  $prevattempts.=&end_data_table_row();
1.40      ng       2978: 	 }
1.1       albertel 2979:       }
1.596     albertel 2980:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 2981:       foreach my $key (sort(keys(%lasthash))) {
1.581     albertel 2982: 	my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356     albertel 2983: 	if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40      ng       2984: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 2985:       }
1.596     albertel 2986:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 2987:     } else {
1.596     albertel 2988:       $prevattempts=
                   2989: 	  &start_data_table().&start_data_table_row().
                   2990: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   2991: 	  &end_data_table_row().&end_data_table();
1.1       albertel 2992:     }
                   2993:   } else {
1.596     albertel 2994:     $prevattempts=
                   2995: 	  &start_data_table().&start_data_table_row().
                   2996: 	  '<td>'.&mt('No data.').'</td>'.
                   2997: 	  &end_data_table_row().&end_data_table();
1.1       albertel 2998:   }
1.10      albertel 2999: }
                   3000: 
1.581     albertel 3001: sub format_previous_attempt_value {
                   3002:     my ($key,$value) = @_;
                   3003:     if ($key =~ /timestamp/) {
                   3004: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3005:     } elsif (ref($value) eq 'ARRAY') {
                   3006: 	$value = '('.join(', ', @{ $value }).')';
                   3007:     } else {
                   3008: 	$value = &unescape($value);
                   3009:     }
                   3010:     return $value;
                   3011: }
                   3012: 
                   3013: 
1.107     albertel 3014: sub relative_to_absolute {
                   3015:     my ($url,$output)=@_;
                   3016:     my $parser=HTML::TokeParser->new(\$output);
                   3017:     my $token;
                   3018:     my $thisdir=$url;
                   3019:     my @rlinks=();
                   3020:     while ($token=$parser->get_token) {
                   3021: 	if ($token->[0] eq 'S') {
                   3022: 	    if ($token->[1] eq 'a') {
                   3023: 		if ($token->[2]->{'href'}) {
                   3024: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3025: 		}
                   3026: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3027: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3028: 	    } elsif ($token->[1] eq 'base') {
                   3029: 		$thisdir=$token->[2]->{'href'};
                   3030: 	    }
                   3031: 	}
                   3032:     }
                   3033:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3034:     foreach my $link (@rlinks) {
                   3035: 	unless (($link=~/^http:\/\//i) ||
                   3036: 		($link=~/^\//) ||
                   3037: 		($link=~/^javascript:/i) ||
                   3038: 		($link=~/^mailto:/i) ||
                   3039: 		($link=~/^\#/)) {
                   3040: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3041: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3042: 	}
                   3043:     }
                   3044: # -------------------------------------------------- Deal with Applet codebases
                   3045:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3046:     return $output;
                   3047: }
                   3048: 
1.112     bowersj2 3049: =pod
                   3050: 
                   3051: =item * get_student_view
                   3052: 
                   3053: show a snapshot of what student was looking at
                   3054: 
                   3055: =cut
                   3056: 
1.10      albertel 3057: sub get_student_view {
1.186     albertel 3058:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3059:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3060:   my (%form);
1.10      albertel 3061:   my @elements=('symb','courseid','domain','username');
                   3062:   foreach my $element (@elements) {
1.186     albertel 3063:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3064:   }
1.186     albertel 3065:   if (defined($moreenv)) {
                   3066:       %form=(%form,%{$moreenv});
                   3067:   }
1.236     albertel 3068:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3069:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.186     albertel 3070:   my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3071:   $userview=~s/\<body[^\>]*\>//gi;
                   3072:   $userview=~s/\<\/body\>//gi;
                   3073:   $userview=~s/\<html\>//gi;
                   3074:   $userview=~s/\<\/html\>//gi;
                   3075:   $userview=~s/\<head\>//gi;
                   3076:   $userview=~s/\<\/head\>//gi;
                   3077:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3078:   $userview=&relative_to_absolute($feedurl,$userview);
1.11      albertel 3079:   return $userview;
                   3080: }
                   3081: 
1.112     bowersj2 3082: =pod
                   3083: 
                   3084: =item * get_student_answers() 
                   3085: 
                   3086: show a snapshot of how student was answering problem
                   3087: 
                   3088: =cut
                   3089: 
1.11      albertel 3090: sub get_student_answers {
1.100     sakharuk 3091:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3092:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3093:   my (%moreenv);
1.11      albertel 3094:   my @elements=('symb','courseid','domain','username');
                   3095:   foreach my $element (@elements) {
1.186     albertel 3096:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3097:   }
1.186     albertel 3098:   $moreenv{'grade_target'}='answer';
                   3099:   %moreenv=(%form,%moreenv);
1.497     raeburn  3100:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3101:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3102:   return $userview;
1.1       albertel 3103: }
1.116     albertel 3104: 
                   3105: =pod
                   3106: 
                   3107: =item * &submlink()
                   3108: 
1.242     albertel 3109: Inputs: $text $uname $udom $symb $target
1.116     albertel 3110: 
                   3111: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3112: 
                   3113: =cut
                   3114: 
                   3115: ###############################################
                   3116: sub submlink {
1.242     albertel 3117:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3118:     if (!($uname && $udom)) {
                   3119: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3120: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3121: 	if (!$symb) { $symb=$cursymb; }
                   3122:     }
1.254     matthew  3123:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3124:     $symb=&escape($symb);
1.242     albertel 3125:     if ($target) { $target="target=\"$target\""; }
                   3126:     return '<a href="/adm/grades?&command=submission&'.
                   3127: 	'symb='.$symb.'&student='.$uname.
                   3128: 	'&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
                   3129: }
                   3130: ##############################################
                   3131: 
                   3132: =pod
                   3133: 
                   3134: =item * &pgrdlink()
                   3135: 
                   3136: Inputs: $text $uname $udom $symb $target
                   3137: 
                   3138: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3139: 
                   3140: =cut
                   3141: 
                   3142: ###############################################
                   3143: sub pgrdlink {
                   3144:     my $link=&submlink(@_);
                   3145:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3146:     return $link;
                   3147: }
                   3148: ##############################################
                   3149: 
                   3150: =pod
                   3151: 
                   3152: =item * &pprmlink()
                   3153: 
                   3154: Inputs: $text $uname $udom $symb $target
                   3155: 
                   3156: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3157: student and a specific resource
1.242     albertel 3158: 
                   3159: =cut
                   3160: 
                   3161: ###############################################
                   3162: sub pprmlink {
                   3163:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3164:     if (!($uname && $udom)) {
                   3165: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3166: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3167: 	if (!$symb) { $symb=$cursymb; }
                   3168:     }
1.254     matthew  3169:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3170:     $symb=&escape($symb);
1.242     albertel 3171:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3172:     return '<a href="/adm/parmset?command=set&amp;'.
                   3173: 	'symb='.$symb.'&amp;uname='.$uname.
                   3174: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3175: }
                   3176: ##############################################
1.37      matthew  3177: 
1.112     bowersj2 3178: =pod
                   3179: 
                   3180: =back
                   3181: 
                   3182: =cut
                   3183: 
1.37      matthew  3184: ###############################################
1.51      www      3185: 
                   3186: 
                   3187: sub timehash {
                   3188:     my @ltime=localtime(shift);
                   3189:     return ( 'seconds' => $ltime[0],
                   3190:              'minutes' => $ltime[1],
                   3191:              'hours'   => $ltime[2],
                   3192:              'day'     => $ltime[3],
                   3193:              'month'   => $ltime[4]+1,
                   3194:              'year'    => $ltime[5]+1900,
                   3195:              'weekday' => $ltime[6],
                   3196:              'dayyear' => $ltime[7]+1,
                   3197:              'dlsav'   => $ltime[8] );
                   3198: }
                   3199: 
1.370     www      3200: sub utc_string {
                   3201:     my ($date)=@_;
1.371     www      3202:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3203: }
                   3204: 
1.51      www      3205: sub maketime {
                   3206:     my %th=@_;
                   3207:     return POSIX::mktime(
                   3208:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3209:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3210: }
                   3211: 
                   3212: #########################################
1.51      www      3213: 
                   3214: sub findallcourses {
1.482     raeburn  3215:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3216:     my %roles;
                   3217:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3218:     my %courses;
1.51      www      3219:     my $now=time;
1.482     raeburn  3220:     if (!defined($uname)) {
                   3221:         $uname = $env{'user.name'};
                   3222:     }
                   3223:     if (!defined($udom)) {
                   3224:         $udom = $env{'user.domain'};
                   3225:     }
                   3226:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
                   3227:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
                   3228:         if (!%roles) {
                   3229:             %roles = (
                   3230:                        cc => 1,
                   3231:                        in => 1,
                   3232:                        ep => 1,
                   3233:                        ta => 1,
                   3234:                        cr => 1,
                   3235:                        st => 1,
                   3236:              );
                   3237:         }
                   3238:         foreach my $entry (keys(%roleshash)) {
                   3239:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3240:             if ($trole =~ /^cr/) { 
                   3241:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3242:             } else {
                   3243:                 next if (!exists($roles{$trole}));
                   3244:             }
                   3245:             if ($tend) {
                   3246:                 next if ($tend < $now);
                   3247:             }
                   3248:             if ($tstart) {
                   3249:                 next if ($tstart > $now);
                   3250:             }
                   3251:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3252:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3253:             if ($secpart eq '') {
                   3254:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3255:                 $sec = 'none';
                   3256:                 $realsec = '';
                   3257:             } else {
                   3258:                 $cnum = $cnumpart;
                   3259:                 ($sec,$role) = split(/_/,$secpart);
                   3260:                 $realsec = $sec;
1.490     raeburn  3261:             }
1.482     raeburn  3262:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3263:         }
                   3264:     } else {
                   3265:         foreach my $key (keys(%env)) {
1.483     albertel 3266: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3267:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3268: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3269: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3270: 	        next if (%roles && !exists($roles{$role}));
                   3271: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3272:                 my $active=1;
                   3273:                 if ($starttime) {
                   3274: 		    if ($now<$starttime) { $active=0; }
                   3275:                 }
                   3276:                 if ($endtime) {
                   3277:                     if ($now>$endtime) { $active=0; }
                   3278:                 }
                   3279:                 if ($active) {
                   3280:                     if ($sec eq '') {
                   3281:                         $sec = 'none';
                   3282:                     }
                   3283:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   3284:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  3285:                 }
                   3286:             }
1.51      www      3287:         }
                   3288:     }
1.474     raeburn  3289:     return %courses;
1.51      www      3290: }
1.37      matthew  3291: 
1.54      www      3292: ###############################################
1.474     raeburn  3293: 
                   3294: sub blockcheck {
1.482     raeburn  3295:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  3296: 
                   3297:     if (!defined($udom)) {
                   3298:         $udom = $env{'user.domain'};
                   3299:     }
                   3300:     if (!defined($uname)) {
                   3301:         $uname = $env{'user.name'};
                   3302:     }
                   3303: 
                   3304:     # If uname and udom are for a course, check for blocks in the course.
                   3305: 
                   3306:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   3307:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  3308:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  3309:         return ($startblock,$endblock);
                   3310:     }
1.474     raeburn  3311: 
1.502     raeburn  3312:     my $startblock = 0;
                   3313:     my $endblock = 0;
1.482     raeburn  3314:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  3315: 
1.490     raeburn  3316:     # If uname is for a user, and activity is course-specific, i.e.,
                   3317:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  3318: 
1.490     raeburn  3319:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   3320:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   3321:         foreach my $key (keys(%live_courses)) {
                   3322:             if ($key ne $env{'request.course.id'}) {
                   3323:                 delete($live_courses{$key});
                   3324:             }
                   3325:         }
                   3326:     }
                   3327: 
                   3328:     my $otheruser = 0;
                   3329:     my %own_courses;
                   3330:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   3331:         # Resource belongs to user other than current user.
                   3332:         $otheruser = 1;
                   3333:         # Gather courses for current user
                   3334:         %own_courses = 
                   3335:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   3336:     }
                   3337: 
                   3338:     # Gather active course roles - course coordinator, instructor, 
                   3339:     # exam proctor, ta, student, or custom role.
1.474     raeburn  3340: 
                   3341:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  3342:         my ($cdom,$cnum);
                   3343:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   3344:             $cdom = $env{'course.'.$course.'.domain'};
                   3345:             $cnum = $env{'course.'.$course.'.num'};
                   3346:         } else {
1.490     raeburn  3347:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  3348:         }
                   3349:         my $no_ownblock = 0;
                   3350:         my $no_userblock = 0;
1.533     raeburn  3351:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  3352:             # Check if current user has 'evb' priv for this
                   3353:             if (defined($own_courses{$course})) {
                   3354:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   3355:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   3356:                     if ($sec ne 'none') {
                   3357:                         $checkrole .= '/'.$sec;
                   3358:                     }
                   3359:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3360:                         $no_ownblock = 1;
                   3361:                         last;
                   3362:                     }
                   3363:                 }
                   3364:             }
                   3365:             # if they have 'evb' priv and are currently not playing student
                   3366:             next if (($no_ownblock) &&
                   3367:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   3368:         }
1.474     raeburn  3369:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  3370:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  3371:             if ($sec ne 'none') {
1.482     raeburn  3372:                 $checkrole .= '/'.$sec;
1.474     raeburn  3373:             }
1.490     raeburn  3374:             if ($otheruser) {
                   3375:                 # Resource belongs to user other than current user.
                   3376:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  3377:                 my ($trole,$tdom,$tnum,$tsec);
                   3378:                 my $entry = $live_courses{$course}{$sec};
                   3379:                 if ($entry =~ /^cr/) {
                   3380:                     ($trole,$tdom,$tnum,$tsec) = 
                   3381:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   3382:                 } else {
                   3383:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   3384:                 }
                   3385:                 my ($spec,$area,$trest,%allroles,%userroles);
                   3386:                 $area = '/'.$tdom.'/'.$tnum;
                   3387:                 $trest = $tnum;
                   3388:                 if ($tsec ne '') {
                   3389:                     $area .= '/'.$tsec;
                   3390:                     $trest .= '/'.$tsec;
                   3391:                 }
                   3392:                 $spec = $trole.'.'.$area;
                   3393:                 if ($trole =~ /^cr/) {
                   3394:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   3395:                                                       $tdom,$spec,$trest,$area);
                   3396:                 } else {
                   3397:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   3398:                                                        $tdom,$spec,$trest,$area);
                   3399:                 }
                   3400:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  3401:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   3402:                     if ($1) {
                   3403:                         $no_userblock = 1;
                   3404:                         last;
                   3405:                     }
                   3406:                 }
1.490     raeburn  3407:             } else {
                   3408:                 # Resource belongs to current user
                   3409:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  3410:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3411:                     $no_ownblock = 1;
                   3412:                     last;
                   3413:                 }
1.474     raeburn  3414:             }
                   3415:         }
                   3416:         # if they have the evb priv and are currently not playing student
1.482     raeburn  3417:         next if (($no_ownblock) &&
1.491     albertel 3418:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  3419:         next if ($no_userblock);
1.474     raeburn  3420: 
1.490     raeburn  3421:         # Retrieve blocking times and identity of blocker for course
                   3422:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  3423:         
                   3424:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   3425:         if (($start != 0) && 
                   3426:             (($startblock == 0) || ($startblock > $start))) {
                   3427:             $startblock = $start;
                   3428:         }
                   3429:         if (($end != 0)  &&
                   3430:             (($endblock == 0) || ($endblock < $end))) {
                   3431:             $endblock = $end;
                   3432:         }
1.490     raeburn  3433:     }
                   3434:     return ($startblock,$endblock);
                   3435: }
                   3436: 
                   3437: sub get_blocks {
                   3438:     my ($setters,$activity,$cdom,$cnum) = @_;
                   3439:     my $startblock = 0;
                   3440:     my $endblock = 0;
                   3441:     my $course = $cdom.'_'.$cnum;
                   3442:     $setters->{$course} = {};
                   3443:     $setters->{$course}{'staff'} = [];
                   3444:     $setters->{$course}{'times'} = [];
                   3445:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   3446:     foreach my $record (keys(%records)) {
                   3447:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   3448:         if ($start <= time && $end >= time) {
                   3449:             my ($staff_name,$staff_dom,$title,$blocks) =
                   3450:                 &parse_block_record($records{$record});
                   3451:             if ($blocks->{$activity} eq 'on') {
                   3452:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   3453:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 3454:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   3455:                     $startblock = $start;
1.490     raeburn  3456:                 }
1.491     albertel 3457:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   3458:                     $endblock = $end;
1.474     raeburn  3459:                 }
                   3460:             }
                   3461:         }
                   3462:     }
                   3463:     return ($startblock,$endblock);
                   3464: }
                   3465: 
                   3466: sub parse_block_record {
                   3467:     my ($record) = @_;
                   3468:     my ($setuname,$setudom,$title,$blocks);
                   3469:     if (ref($record) eq 'HASH') {
                   3470:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   3471:         $title = &unescape($record->{'event'});
                   3472:         $blocks = $record->{'blocks'};
                   3473:     } else {
                   3474:         my @data = split(/:/,$record,3);
                   3475:         if (scalar(@data) eq 2) {
                   3476:             $title = $data[1];
                   3477:             ($setuname,$setudom) = split(/@/,$data[0]);
                   3478:         } else {
                   3479:             ($setuname,$setudom,$title) = @data;
                   3480:         }
                   3481:         $blocks = { 'com' => 'on' };
                   3482:     }
                   3483:     return ($setuname,$setudom,$title,$blocks);
                   3484: }
                   3485: 
                   3486: sub build_block_table {
                   3487:     my ($startblock,$endblock,$setters) = @_;
                   3488:     my %lt = &Apache::lonlocal::texthash(
                   3489:         'cacb' => 'Currently active communication blocks',
                   3490:         'cour' => 'Course',
                   3491:         'dura' => 'Duration',
                   3492:         'blse' => 'Block set by'
                   3493:     );
                   3494:     my $output;
1.476     raeburn  3495:     $output = '<br />'.$lt{'cacb'}.':<br />';
1.474     raeburn  3496:     $output .= &start_data_table();
                   3497:     $output .= '
                   3498: <tr>
                   3499:  <th>'.$lt{'cour'}.'</th>
                   3500:  <th>'.$lt{'dura'}.'</th>
                   3501:  <th>'.$lt{'blse'}.'</th>
                   3502: </tr>
                   3503: ';
                   3504:     foreach my $course (keys(%{$setters})) {
                   3505:         my %courseinfo=&Apache::lonnet::coursedescription($course);
                   3506:         for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
                   3507:             my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490     raeburn  3508:             my $fullname = &plainname($uname,$udom);
                   3509:             if (defined($env{'user.name'}) && defined($env{'user.domain'})
                   3510:                 && $env{'user.name'} ne 'public' 
                   3511:                 && $env{'user.domain'} ne 'public') {
                   3512:                 $fullname = &aboutmewrapper($fullname,$uname,$udom);
                   3513:             }
1.474     raeburn  3514:             my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
                   3515:             $openblock = &Apache::lonlocal::locallocaltime($openblock);
                   3516:             $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
                   3517:             $output .= &Apache::loncommon::start_data_table_row().
                   3518:                        '<td>'.$courseinfo{'description'}.'</td>'.
                   3519:                        '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490     raeburn  3520:                        '<td>'.$fullname.'</td>'.
1.474     raeburn  3521:                         &Apache::loncommon::end_data_table_row();
                   3522:         }
                   3523:     }
                   3524:     $output .= &end_data_table();
                   3525: }
                   3526: 
1.490     raeburn  3527: sub blocking_status {
                   3528:     my ($activity,$uname,$udom) = @_;
                   3529:     my %setters;
                   3530:     my ($blocked,$output,$ownitem,$is_course);
                   3531:     my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
                   3532:     if ($startblock && $endblock) {
                   3533:         $blocked = 1;
                   3534:         if (wantarray) {
                   3535:             my $category;
                   3536:             if ($activity eq 'boards') {
                   3537:                 $category = 'Discussion posts in this course';
                   3538:             } elsif ($activity eq 'blogs') {
                   3539:                 $category = 'Blogs';
                   3540:             } elsif ($activity eq 'port') {
                   3541:                 if (defined($uname) && defined($udom)) {
                   3542:                     if ($uname eq $env{'user.name'} &&
                   3543:                         $udom eq $env{'user.domain'}) {
                   3544:                         $ownitem = 1;
                   3545:                     }
                   3546:                 }
                   3547:                 $is_course = &Apache::lonnet::is_course($udom,$uname);
                   3548:                 if ($ownitem) { 
                   3549:                     $category = 'Your portfolio files';  
                   3550:                 } elsif ($is_course) {
                   3551:                     my $coursedesc;
                   3552:                     foreach my $course (keys(%setters)) {
                   3553:                         my %courseinfo =
                   3554:                              &Apache::lonnet::coursedescription($course);
                   3555:                         $coursedesc = $courseinfo{'description'};
                   3556:                     }
                   3557:                     $category = "Group files in the course '$coursedesc'";
                   3558:                 } else {
                   3559:                     $category = 'Portfolio files belonging to ';
                   3560:                     if ($env{'user.name'} eq 'public' && 
                   3561:                         $env{'user.domain'} eq 'public') {
                   3562:                         $category .= &plainname($uname,$udom);
                   3563:                     } else {
                   3564:                         $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);  
                   3565:                     }
                   3566:                 }
                   3567:             } elsif ($activity eq 'groups') {
                   3568:                 $category = 'Groups in this course';
                   3569:             }
                   3570:             my $showstart = &Apache::lonlocal::locallocaltime($startblock);
                   3571:             my $showend = &Apache::lonlocal::locallocaltime($endblock);
                   3572:             $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
                   3573:             if (!($activity eq 'port' && !($ownitem) && !($is_course))) { 
                   3574:                 $output .= &build_block_table($startblock,$endblock,\%setters);
                   3575:             }
                   3576:         }
                   3577:     }
                   3578:     if (wantarray) {
                   3579:         return ($blocked,$output);
                   3580:     } else {
                   3581:         return $blocked;
                   3582:     }
                   3583: }
                   3584: 
1.60      matthew  3585: ###############################################
                   3586: 
                   3587: =pod
                   3588: 
1.112     bowersj2 3589: =head1 Domain Template Functions
                   3590: 
                   3591: =over 4
                   3592: 
                   3593: =item * &determinedomain()
1.60      matthew  3594: 
                   3595: Inputs: $domain (usually will be undef)
                   3596: 
1.63      www      3597: Returns: Determines which domain should be used for designs
1.60      matthew  3598: 
                   3599: =cut
1.54      www      3600: 
1.60      matthew  3601: ###############################################
1.63      www      3602: sub determinedomain {
                   3603:     my $domain=shift;
1.531     albertel 3604:     if (! $domain) {
1.60      matthew  3605:         # Determine domain if we have not been given one
                   3606:         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258     albertel 3607:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   3608:         if ($env{'request.role.domain'}) { 
                   3609:             $domain=$env{'request.role.domain'}; 
1.60      matthew  3610:         }
                   3611:     }
1.63      www      3612:     return $domain;
                   3613: }
                   3614: ###############################################
1.517     raeburn  3615: 
1.518     albertel 3616: sub devalidate_domconfig_cache {
                   3617:     my ($udom)=@_;
                   3618:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   3619: }
                   3620: 
                   3621: # ---------------------- Get domain configuration for a domain
                   3622: sub get_domainconf {
                   3623:     my ($udom) = @_;
                   3624:     my $cachetime=1800;
                   3625:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   3626:     if (defined($cached)) { return %{$result}; }
                   3627: 
                   3628:     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   3629: 					     ['login','rolecolors'],$udom);
                   3630:     my %designhash;
                   3631:     if (keys(%domconfig) > 0) {
                   3632:         if (ref($domconfig{'login'}) eq 'HASH') {
                   3633:             foreach my $key (keys(%{$domconfig{'login'}})) {
                   3634:                 $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   3635:             }
                   3636:         }
                   3637:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
                   3638:             foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   3639:                 if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   3640:                     foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   3641:                         $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   3642:                     }
                   3643:                 }
                   3644:             }
                   3645:         }
                   3646:     } else {
                   3647:         my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   3648:         my $designfile =  $designdir.'/'.$udom.'.tab';
                   3649:         if (-e $designfile) {
                   3650:             if ( open (my $fh,"<$designfile") ) {
                   3651:                 while (my $line = <$fh>) {
                   3652:                     next if ($line =~ /^\#/);
                   3653:                     chomp($line);
                   3654:                     my ($key,$val)=(split(/\=/,$line));
                   3655:                     if ($val) { $designhash{$udom.'.'.$key}=$val; }
                   3656:                 }
                   3657:                 close($fh);
                   3658:             }
                   3659:         }
                   3660:         if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
1.519     raeburn  3661:             $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
1.518     albertel 3662:         }
                   3663:     }
                   3664:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   3665: 				  $cachetime);
                   3666:     return %designhash;
                   3667: }
                   3668: 
1.63      www      3669: =pod
                   3670: 
1.112     bowersj2 3671: =item * &domainlogo()
1.63      www      3672: 
                   3673: Inputs: $domain (usually will be undef)
                   3674: 
                   3675: Returns: A link to a domain logo, if the domain logo exists.
                   3676: If the domain logo does not exist, a description of the domain.
                   3677: 
                   3678: =cut
1.112     bowersj2 3679: 
1.63      www      3680: ###############################################
                   3681: sub domainlogo {
1.517     raeburn  3682:     my $domain = &determinedomain(shift);
1.518     albertel 3683:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  3684:     # See if there is a logo
                   3685:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  3686:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 3687:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   3688: 	    if ($imgsrc =~ m{^/res/}) {
                   3689: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   3690: 		&Apache::lonnet::repcopy($local_name);
                   3691: 	    }
                   3692: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  3693:         } 
                   3694:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 3695:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   3696:         return &Apache::lonnet::domain($domain,'description');
1.59      www      3697:     } else {
1.60      matthew  3698:         return '';
1.59      www      3699:     }
                   3700: }
1.63      www      3701: ##############################################
                   3702: 
                   3703: =pod
                   3704: 
1.112     bowersj2 3705: =item * &designparm()
1.63      www      3706: 
                   3707: Inputs: $which parameter; $domain (usually will be undef)
                   3708: 
                   3709: Returns: value of designparamter $which
                   3710: 
                   3711: =cut
1.112     bowersj2 3712: 
1.397     albertel 3713: 
1.400     albertel 3714: ##############################################
1.397     albertel 3715: sub designparm {
                   3716:     my ($which,$domain)=@_;
1.258     albertel 3717:     if ($env{'browser.blackwhite'} eq 'on') {
1.110     www      3718: 	if ($which=~/\.(font|alink|vlink|link)$/) {
                   3719: 	    return '#000000';
                   3720: 	}
                   3721: 	if ($which=~/\.(pgbg|sidebg)$/) {
                   3722: 	    return '#FFFFFF';
                   3723: 	}
                   3724: 	if ($which=~/\.tabbg$/) {
                   3725: 	    return '#CCCCCC';
                   3726: 	}
                   3727:     }
1.397     albertel 3728:     if (exists($env{'environment.color.'.$which})) {
1.258     albertel 3729: 	return $env{'environment.color.'.$which};
1.96      www      3730:     }
1.63      www      3731:     $domain=&determinedomain($domain);
1.518     albertel 3732:     my %domdesign = &get_domainconf($domain);
1.520     raeburn  3733:     my $output;
1.517     raeburn  3734:     if ($domdesign{$domain.'.'.$which} ne '') {
1.520     raeburn  3735: 	$output = $domdesign{$domain.'.'.$which};
1.63      www      3736:     } else {
1.520     raeburn  3737:         $output = $defaultdesign{$which};
                   3738:     }
                   3739:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
                   3740:         ($which =~ /login\.(img|logo|domlogo)/)) {
1.538     albertel 3741:         if ($output =~ m{^/(adm|res)/}) {
                   3742: 	    if ($output =~ m{^/res/}) {
                   3743: 		my $local_name = &Apache::lonnet::filelocation('',$output);
                   3744: 		&Apache::lonnet::repcopy($local_name);
                   3745: 	    }
1.520     raeburn  3746:             $output = &lonhttpdurl($output);
                   3747:         }
1.63      www      3748:     }
1.520     raeburn  3749:     return $output;
1.63      www      3750: }
1.59      www      3751: 
1.60      matthew  3752: ###############################################
                   3753: ###############################################
                   3754: 
                   3755: =pod
                   3756: 
1.112     bowersj2 3757: =back
                   3758: 
1.549     albertel 3759: =head1 HTML Helpers
1.112     bowersj2 3760: 
                   3761: =over 4
                   3762: 
                   3763: =item * &bodytag()
1.60      matthew  3764: 
                   3765: Returns a uniform header for LON-CAPA web pages.
                   3766: 
                   3767: Inputs: 
                   3768: 
1.112     bowersj2 3769: =over 4
                   3770: 
                   3771: =item * $title, A title to be displayed on the page.
                   3772: 
                   3773: =item * $function, the current role (can be undef).
                   3774: 
                   3775: =item * $addentries, extra parameters for the <body> tag.
                   3776: 
                   3777: =item * $bodyonly, if defined, only return the <body> tag.
                   3778: 
                   3779: =item * $domain, if defined, force a given domain.
                   3780: 
                   3781: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      3782:             text interface only)
1.60      matthew  3783: 
1.326     albertel 3784: =item * $customtitle, alternate text to use instead of $title
                   3785:                       in the title box that appears, this text
                   3786:                       is not auto translated like the $title is
1.309     albertel 3787: 
                   3788: =item * $notopbar, if true, keep the 'what is this' info but remove the
                   3789:                    navigational links
1.317     albertel 3790: 
1.338     albertel 3791: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   3792: 
                   3793: =item * $notitle, if true keep the nav controls, but remove the title bar
                   3794: 
1.361     albertel 3795: =item * $no_inline_link, if true and in remote mode, don't show the 
                   3796:          'Switch To Inline Menu' link
                   3797: 
1.460     albertel 3798: =item * $args, optional argument valid values are
                   3799:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 3800:             inherit_jsmath -> when creating popup window in a page,
                   3801:                               should it have jsmath forced on by the
                   3802:                               current page
1.460     albertel 3803: 
1.112     bowersj2 3804: =back
                   3805: 
1.60      matthew  3806: Returns: A uniform header for LON-CAPA web pages.  
                   3807: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   3808: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   3809: other decorations will be returned.
                   3810: 
                   3811: =cut
                   3812: 
1.54      www      3813: sub bodytag {
1.309     albertel 3814:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460     albertel 3815: 	$notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339     albertel 3816: 
1.460     albertel 3817:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 3818: 
1.183     matthew  3819:     $function = &get_users_function() if (!$function);
1.339     albertel 3820:     my $img =    &designparm($function.'.img',$domain);
                   3821:     my $font =   &designparm($function.'.font',$domain);
                   3822:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   3823: 
                   3824:     my %design = ( 'style'   => 'margin-top: 0px',
1.535     albertel 3825: 		   'bgcolor' => $pgbg,
1.339     albertel 3826: 		   'text'    => $font,
                   3827:                    'alink'   => &designparm($function.'.alink',$domain),
                   3828: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   3829: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 3830:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 3831: 
1.63      www      3832:  # role and realm
1.378     raeburn  3833:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   3834:     if ($role  eq 'ca') {
1.479     albertel 3835:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 3836:         $realm = &plainname($rname,$rdom);
1.378     raeburn  3837:     } 
1.55      www      3838: # realm
1.258     albertel 3839:     if ($env{'request.course.id'}) {
1.378     raeburn  3840:         if ($env{'request.role'} !~ /^cr/) {
                   3841:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   3842:         }
1.359     albertel 3843: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  3844:     } else {
                   3845:         $role = &Apache::lonnet::plaintext($role);
1.54      www      3846:     }
1.433     albertel 3847: 
1.359     albertel 3848:     if (!$realm) { $realm='&nbsp;'; }
1.55      www      3849: # Set messages
1.60      matthew  3850:     my $messages=&domainlogo($domain);
1.330     albertel 3851: 
1.438     albertel 3852:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 3853: 
1.101     www      3854: # construct main body tag
1.359     albertel 3855:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 3856: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 3857: 
1.530     albertel 3858:     if ($bodyonly) {
1.60      matthew  3859:         return $bodytag;
1.258     albertel 3860:     } elsif ($env{'browser.interface'} eq 'textual') {
1.95      www      3861: # Accessibility
1.224     raeburn  3862:           
1.337     albertel 3863: 	$bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338     albertel 3864: 	if (!$notitle) {
1.337     albertel 3865: 	    $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
                   3866: 	}
                   3867: 	return $bodytag;
1.359     albertel 3868:     }
                   3869: 
1.410     albertel 3870:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433     albertel 3871:     if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
                   3872: 	undef($role);
1.434     albertel 3873:     } else {
                   3874: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 3875:     }
1.359     albertel 3876:     
                   3877:     my $roleinfo=(<<ENDROLE);
                   3878: <td class="LC_title_bar_who">
                   3879: <div class="LC_title_bar_name">
1.410     albertel 3880:     $name
1.361     albertel 3881:     &nbsp;
1.359     albertel 3882: </div>
                   3883: <div class="LC_title_bar_role">
1.361     albertel 3884: $role&nbsp;
1.359     albertel 3885: </div>
                   3886: <div class="LC_title_bar_realm">
1.361     albertel 3887: $realm&nbsp;
1.359     albertel 3888: </div>
1.206     albertel 3889: </td>
                   3890: ENDROLE
1.235     raeburn  3891: 
1.359     albertel 3892:     my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
                   3893:     if ($customtitle) {
                   3894:         $titleinfo = $customtitle;
                   3895:     }
                   3896:     #
                   3897:     # Extra info if you are the DC
                   3898:     my $dc_info = '';
                   3899:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   3900:                         $env{'course.'.$env{'request.course.id'}.
                   3901:                                  '.domain'}.'/'})) {
                   3902:         my $cid = $env{'request.course.id'};
                   3903:         $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      3904:         $dc_info =~ s/\s+$//;
1.359     albertel 3905:         $dc_info = '('.$dc_info.')';
                   3906:     }
                   3907: 
                   3908:     if ($env{'environment.remote'} eq 'off') {
                   3909:         # No Remote
1.258     albertel 3910: 	if ($env{'request.state'} eq 'construct') {
1.359     albertel 3911: 	    $forcereg=1;
                   3912: 	}
                   3913: 
                   3914: 	if (!$customtitle && $env{'request.state'} eq 'construct') {
                   3915: 	    # this is for resources; directories have customtitle, and crumbs
                   3916:             # and select recent are created in lonpubdir.pm  
1.229     albertel 3917: 	    my ($uname,$thisdisfn)=
1.258     albertel 3918: 		($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229     albertel 3919: 	    my $formaction='/priv/'.$uname.'/'.$thisdisfn;
                   3920: 	    $formaction=~s/\/+/\//g;
                   3921: 
1.359     albertel 3922: 	    my $parentpath = '';
                   3923: 	    my $lastitem = '';
                   3924: 	    if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   3925: 		$parentpath = $1;
                   3926: 		$lastitem = $2;
                   3927: 	    } else {
                   3928: 		$lastitem = $thisdisfn;
                   3929: 	    }
                   3930: 	    $titleinfo = 
1.401     albertel 3931: 		&Apache::loncommon::help_open_menu('','',3,'Authoring').
1.359     albertel 3932: 		'<b>Construction Space</b>:&nbsp;'. 
                   3933: 		'<form name="dirs" method="post" action="'.$formaction
                   3934: 		.'" target="_top"><tt><b>'
                   3935: 		.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
                   3936: 		.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   3937: 		.'</form>'
                   3938: 		.&Apache::lonmenu::constspaceform();
1.235     raeburn  3939:         }
1.359     albertel 3940: 
1.337     albertel 3941:         my $titletable;
1.338     albertel 3942: 	if (!$notitle) {
1.337     albertel 3943: 	    $titletable =
1.359     albertel 3944: 		'<table id="LC_title_bar">'.
                   3945:                          "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
                   3946: 			 '</tr></table>';
1.337     albertel 3947: 	}
1.359     albertel 3948: 	if ($notopbar) {
                   3949: 	    $bodytag .= $titletable;
                   3950: 	} else {
                   3951: 	    if ($env{'request.state'} eq 'construct') {
1.337     albertel 3952:                 $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
                   3953: 							  $titletable);
1.272     raeburn  3954:             } else {
1.336     albertel 3955:                 $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359     albertel 3956: 		    $titletable;
1.272     raeburn  3957:             }
1.235     raeburn  3958:         }
                   3959:         return $bodytag;
1.94      www      3960:     }
1.95      www      3961: 
1.93      www      3962: #
1.95      www      3963: # Top frame rendering, Remote is up
1.93      www      3964: #
1.359     albertel 3965: 
1.517     raeburn  3966:     my $imgsrc = $img;
                   3967:     if ($img =~ /^\/adm/) {
1.575     albertel 3968:         $imgsrc = &lonhttpdurl($img);
1.517     raeburn  3969:     }
                   3970:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359     albertel 3971: 
1.305     www      3972:     # Explicit link to get inline menu
1.361     albertel 3973:     my $menu= ($no_inline_link?''
                   3974: 	       :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245     matthew  3975:     #
1.338     albertel 3976:     if ($notitle) {
1.337     albertel 3977: 	return $bodytag;
                   3978:     }
1.94      www      3979:     return(<<ENDBODY);
1.60      matthew  3980: $bodytag
1.359     albertel 3981: <table id="LC_title_bar" class="LC_with_remote">
1.368     albertel 3982: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359     albertel 3983:     <td class="LC_title_bar_domain_logo">$messages&nbsp;</td>
1.54      www      3984: </tr>
1.359     albertel 3985: <tr><td>$titleinfo $dc_info $menu</td>
                   3986: $roleinfo
1.368     albertel 3987: </tr>
1.356     albertel 3988: </table>
1.54      www      3989: ENDBODY
1.182     matthew  3990: }
                   3991: 
1.330     albertel 3992: sub make_attr_string {
                   3993:     my ($register,$attr_ref) = @_;
                   3994: 
                   3995:     if ($attr_ref && !ref($attr_ref)) {
                   3996: 	die("addentries Must be a hash ref ".
                   3997: 	    join(':',caller(1))." ".
                   3998: 	    join(':',caller(0))." ");
                   3999:     }
                   4000: 
                   4001:     if ($register) {
1.339     albertel 4002: 	my ($on_load,$on_unload);
                   4003: 	foreach my $key (keys(%{$attr_ref})) {
                   4004: 	    if      (lc($key) eq 'onload') {
                   4005: 		$on_load.=$attr_ref->{$key}.';';
                   4006: 		delete($attr_ref->{$key});
                   4007: 
                   4008: 	    } elsif (lc($key) eq 'onunload') {
                   4009: 		$on_unload.=$attr_ref->{$key}.';';
                   4010: 		delete($attr_ref->{$key});
                   4011: 	    }
                   4012: 	}
                   4013: 	$attr_ref->{'onload'}  =
                   4014: 	    &Apache::lonmenu::loadevents().  $on_load;
                   4015: 	$attr_ref->{'onunload'}=
                   4016: 	    &Apache::lonmenu::unloadevents().$on_unload;
                   4017:     }
                   4018: 
                   4019: # Accessibility font enhance
                   4020:     if ($env{'browser.fontenhance'} eq 'on') {
                   4021: 	my $style;
                   4022: 	foreach my $key (keys(%{$attr_ref})) {
                   4023: 	    if (lc($key) eq 'style') {
                   4024: 		$style.=$attr_ref->{$key}.';';
                   4025: 		delete($attr_ref->{$key});
                   4026: 	    }
                   4027: 	}
                   4028: 	$attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330     albertel 4029:     }
1.339     albertel 4030: 
                   4031:     if ($env{'browser.blackwhite'} eq 'on') {
                   4032: 	delete($attr_ref->{'font'});
                   4033: 	delete($attr_ref->{'link'});
                   4034: 	delete($attr_ref->{'alink'});
                   4035: 	delete($attr_ref->{'vlink'});
                   4036: 	delete($attr_ref->{'bgcolor'});
                   4037: 	delete($attr_ref->{'background'});
                   4038:     }
                   4039: 
1.330     albertel 4040:     my $attr_string;
                   4041:     foreach my $attr (keys(%$attr_ref)) {
                   4042: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4043:     }
                   4044:     return $attr_string;
                   4045: }
                   4046: 
                   4047: 
1.182     matthew  4048: ###############################################
1.251     albertel 4049: ###############################################
                   4050: 
                   4051: =pod
                   4052: 
                   4053: =item * &endbodytag()
                   4054: 
                   4055: Returns a uniform footer for LON-CAPA web pages.
                   4056: 
1.306     albertel 4057: Inputs: none
1.251     albertel 4058: 
                   4059: =cut
                   4060: 
                   4061: sub endbodytag {
                   4062:     my $endbodytag='</body>';
1.269     albertel 4063:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4064:     if ( exists( $env{'internal.head.redirect'} ) ) {
                   4065: 	$endbodytag=
                   4066: 	    "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4067: 	    &mt('Continue').'</a>'.
                   4068: 	    $endbodytag;
                   4069:     }
1.251     albertel 4070:     return $endbodytag;
                   4071: }
                   4072: 
1.352     albertel 4073: =pod
                   4074: 
                   4075: =item * &standard_css()
                   4076: 
                   4077: Returns a style sheet
                   4078: 
                   4079: Inputs: (all optional)
                   4080:             domain         -> force to color decorate a page for a specific
                   4081:                                domain
                   4082:             function       -> force usage of a specific rolish color scheme
                   4083:             bgcolor        -> override the default page bgcolor
                   4084: 
                   4085: =cut
                   4086: 
1.343     albertel 4087: sub standard_css {
1.345     albertel 4088:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4089:     $function  = &get_users_function() if (!$function);
                   4090:     my $img    = &designparm($function.'.img',   $domain);
                   4091:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4092:     my $font   = &designparm($function.'.font',  $domain);
1.345     albertel 4093:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4094:     my $pgbg_or_bgcolor =
                   4095: 	         $bgcolor ||
1.352     albertel 4096: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4097:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4098:     my $alink  = &designparm($function.'.alink', $domain);
                   4099:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4100:     my $link   = &designparm($function.'.link',  $domain);
                   4101: 
1.602     albertel 4102:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4103:     my $mono                 = 'monospace';
1.352     albertel 4104:     my $data_table_head      = $tabbg;
                   4105:     my $data_table_light     = '#EEEEEE';
1.470     banghart 4106:     my $data_table_dark      = '#DDDDDD';
                   4107:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4108:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4109:     my $mail_new             = '#FFBB77';
                   4110:     my $mail_new_hover       = '#DD9955';
                   4111:     my $mail_read            = '#BBBB77';
                   4112:     my $mail_read_hover      = '#999944';
                   4113:     my $mail_replied         = '#AAAA88';
                   4114:     my $mail_replied_hover   = '#888855';
                   4115:     my $mail_other           = '#99BBBB';
                   4116:     my $mail_other_hover     = '#669999';
1.391     albertel 4117:     my $table_header         = '#DDDDDD';
1.489     raeburn  4118:     my $feedback_link_bg     = '#BBBBBB';
1.392     albertel 4119: 
                   4120:     my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
                   4121: 	                                              : '0px 3px 0px 4px';
1.448     albertel 4122: 
1.523     albertel 4123: 
1.343     albertel 4124:     return <<END;
1.345     albertel 4125: h1, h2, h3, th { font-family: $sans }
1.343     albertel 4126: a:focus { color: red; background: yellow } 
1.510     albertel 4127: table.thinborder,
1.523     albertel 4128: 
1.510     albertel 4129: table.thinborder tr th {
                   4130:   border-style: solid;
                   4131:   border-width: 1px;
                   4132:   background: $tabbg;
                   4133: }
1.523     albertel 4134: table.thinborder tr td {
1.510     albertel 4135:   border-style: solid;
                   4136:   border-width: 1px
                   4137: }
1.426     albertel 4138: 
1.343     albertel 4139: form, .inline { display: inline; }
                   4140: .center { text-align: center; }
1.593     albertel 4141: .LC_filename {font-family: $mono; white-space:pre;}
1.350     albertel 4142: .LC_error {
                   4143:   color: red;
                   4144:   font-size: larger;
                   4145: }
1.457     albertel 4146: .LC_warning,
                   4147: .LC_diff_removed {
1.394     albertel 4148:   color: red;
                   4149: }
1.532     albertel 4150: 
                   4151: .LC_info,
1.457     albertel 4152: .LC_success,
                   4153: .LC_diff_added {
1.350     albertel 4154:   color: green;
                   4155: }
1.543     albertel 4156: .LC_unknown {
                   4157:   color: yellow;
                   4158: }
                   4159: 
1.440     albertel 4160: .LC_icon {
                   4161:   border: 0px;
                   4162: }
1.539     albertel 4163: .LC_indexer_icon {
                   4164:   border: 0px;
                   4165:   height: 22px;
                   4166: }
1.543     albertel 4167: .LC_docs_spacer {
                   4168:   width: 25px;
                   4169:   height: 1px;
                   4170:   border: 0px;
                   4171: }
1.346     albertel 4172: 
1.532     albertel 4173: .LC_internal_info {
                   4174:   color: #999;
                   4175: }
                   4176: 
1.458     albertel 4177: table.LC_pastsubmission {
                   4178:   border: 1px solid black;
                   4179:   margin: 2px;
                   4180: }
                   4181: 
1.392     albertel 4182: table#LC_top_nav, table#LC_menubuttons {
1.345     albertel 4183:   width: 100%;
                   4184:   background: $pgbg;
1.392     albertel 4185:   border: 2px;
1.402     albertel 4186:   border-collapse: separate;
1.403     albertel 4187:   padding: 0px;
1.345     albertel 4188: }
1.392     albertel 4189: 
1.409     albertel 4190: table#LC_title_bar, table.LC_breadcrumbs, table#LC_nav_location,
1.393     albertel 4191: table#LC_title_bar.LC_with_remote {
1.359     albertel 4192:   width: 100%;
1.392     albertel 4193:   border-color: $pgbg;
                   4194:   border-style: solid;
                   4195:   border-width: $border;
                   4196: 
1.379     albertel 4197:   background: $pgbg;
                   4198:   font-family: $sans;
1.392     albertel 4199:   border-collapse: collapse;
1.403     albertel 4200:   padding: 0px;
1.359     albertel 4201: }
1.392     albertel 4202: 
1.409     albertel 4203: table.LC_docs_path {
                   4204:   width: 100%;
                   4205:   border: 0;
                   4206:   background: $pgbg;
                   4207:   font-family: $sans;
                   4208:   border-collapse: collapse;
                   4209:   padding: 0px;
                   4210: }
                   4211: 
1.359     albertel 4212: table#LC_title_bar td {
                   4213:   background: $tabbg;
                   4214: }
                   4215: table#LC_title_bar td.LC_title_bar_who {
                   4216:   background: $tabbg;
                   4217:   color: $font;
1.427     albertel 4218:   font: small $sans;
1.359     albertel 4219:   text-align: right;
                   4220: }
1.469     banghart 4221: span.LC_metadata {
                   4222:     font-family: $sans;
                   4223: }
1.359     albertel 4224: span.LC_title_bar_title {
1.416     albertel 4225:   font: bold x-large $sans;
1.359     albertel 4226: }
                   4227: table#LC_title_bar td.LC_title_bar_domain_logo {
                   4228:   background: $sidebg;
                   4229:   text-align: right;
1.368     albertel 4230:   padding: 0px;
                   4231: }
                   4232: table#LC_title_bar td.LC_title_bar_role_logo {
                   4233:   background: $sidebg;
                   4234:   padding: 0px;
1.359     albertel 4235: }
                   4236: 
1.346     albertel 4237: table#LC_menubuttons_mainmenu {
1.526     www      4238:   width: 100%;
1.346     albertel 4239:   border: 0px;
                   4240:   border-spacing: 1px;
1.372     albertel 4241:   padding: 0px 1px;
1.346     albertel 4242:   margin: 0px;
                   4243:   border-collapse: separate;
                   4244: }
                   4245: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
                   4246:   border: 0px;
                   4247: }
1.345     albertel 4248: table#LC_top_nav td {
                   4249:   background: $tabbg;
1.392     albertel 4250:   border: 0px;
1.407     albertel 4251:   font-size: small;
1.345     albertel 4252: }
                   4253: table#LC_top_nav td a, div#LC_top_nav a {
                   4254:   color: $font;
                   4255:   font-family: $sans;
                   4256: }
1.364     albertel 4257: table#LC_top_nav td.LC_top_nav_logo {
                   4258:   background: $tabbg;
1.432     albertel 4259:   text-align: left;
1.408     albertel 4260:   white-space: nowrap;
1.432     albertel 4261:   width: 31px;
1.408     albertel 4262: }
                   4263: table#LC_top_nav td.LC_top_nav_logo img {
1.432     albertel 4264:   border: 0px;
1.408     albertel 4265:   vertical-align: bottom;
1.364     albertel 4266: }
1.432     albertel 4267: table#LC_top_nav td.LC_top_nav_exit,
                   4268: table#LC_top_nav td.LC_top_nav_help {
                   4269:   width: 2.0em;
                   4270: }
1.442     albertel 4271: table#LC_top_nav td.LC_top_nav_login {
                   4272:   width: 4.0em;
                   4273:   text-align: center;
                   4274: }
1.409     albertel 4275: table.LC_breadcrumbs td, table.LC_docs_path td  {
1.357     albertel 4276:   background: $tabbg;
                   4277:   color: $font;
                   4278:   font-family: $sans;
1.358     albertel 4279:   font-size: smaller;
1.357     albertel 4280: }
1.411     albertel 4281: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409     albertel 4282: table.LC_docs_path td.LC_docs_path_component {
1.357     albertel 4283:   background: $tabbg;
                   4284:   color: $font;
                   4285:   font-family: $sans;
                   4286:   font-size: larger;
                   4287:   text-align: right;
                   4288: }
1.383     albertel 4289: td.LC_table_cell_checkbox {
                   4290:   text-align: center;
                   4291: }
                   4292: 
1.522     albertel 4293: table#LC_mainmenu td.LC_mainmenu_column {
                   4294:     vertical-align: top;
                   4295: }
                   4296: 
1.346     albertel 4297: .LC_menubuttons_inline_text {
                   4298:   color: $font;
                   4299:   font-family: $sans;
                   4300:   font-size: smaller;
                   4301: }
                   4302: 
1.526     www      4303: .LC_menubuttons_link {
                   4304:   text-decoration: none;
                   4305: }
                   4306: 
1.522     albertel 4307: .LC_menubuttons_category {
1.521     www      4308:   color: $font;
1.526     www      4309:   background: $pgbg;
1.521     www      4310:   font-family: $sans;
                   4311:   font-size: larger;
                   4312:   font-weight: bold;
                   4313: }
                   4314: 
1.346     albertel 4315: td.LC_menubuttons_text {
1.526     www      4316:   width: 90%;
1.346     albertel 4317:   color: $font;
                   4318:   font-family: $sans;
                   4319: }
1.526     www      4320: 
1.346     albertel 4321: td.LC_menubuttons_img {
                   4322: }
1.526     www      4323: 
1.346     albertel 4324: .LC_current_location {
                   4325:   font-family: $sans;
                   4326:   background: $tabbg;
                   4327: }
                   4328: .LC_new_mail {
                   4329:   font-family: $sans;
                   4330:   font-weight: bold;
                   4331: }
1.347     albertel 4332: 
1.526     www      4333: .LC_rolesmenu_is {
                   4334:   font-family: $sans;
                   4335: }
                   4336: 
                   4337: .LC_rolesmenu_selected {
                   4338:   font-family: $sans;
                   4339: }
                   4340: 
                   4341: .LC_rolesmenu_future {
                   4342:   font-family: $sans;
                   4343: }
                   4344: 
                   4345: 
                   4346: .LC_rolesmenu_will {
                   4347:   font-family: $sans;
                   4348: }
                   4349: 
                   4350: .LC_rolesmenu_will_not {
                   4351:   font-family: $sans;
                   4352: }
                   4353: 
                   4354: .LC_rolesmenu_expired {
                   4355:   font-family: $sans;
                   4356: }
                   4357: 
                   4358: .LC_rolesinfo {
                   4359:   font-family: $sans;
                   4360: }
                   4361: 
1.527     www      4362: .LC_dropadd_labeltext {
                   4363:   font-family: $sans;
                   4364:   text-align: right;
                   4365: }
                   4366: 
                   4367: .LC_preferences_labeltext {
                   4368:   font-family: $sans;
                   4369:   text-align: right;
                   4370: }
                   4371: 
1.440     albertel 4372: table.LC_aboutme_port {
                   4373:   border: 0px;
                   4374:   border-collapse: collapse;
                   4375:   border-spacing: 0px;
                   4376: }
1.349     albertel 4377: table.LC_data_table, table.LC_mail_list {
1.347     albertel 4378:   border: 1px solid #000000;
1.402     albertel 4379:   border-collapse: separate;
1.426     albertel 4380:   border-spacing: 1px;
1.347     albertel 4381: }
1.422     albertel 4382: .LC_data_table_dense {
                   4383:   font-size: small;
                   4384: }
1.507     raeburn  4385: table.LC_nested_outer {
                   4386:   border: 1px solid #000000;
1.589     raeburn  4387:   border-collapse: collapse;
1.507     raeburn  4388:   border-spacing: 0px;
                   4389:   width: 100%;
                   4390: }
                   4391: table.LC_nested {
                   4392:   border: 0px;
1.589     raeburn  4393:   border-collapse: collapse;
1.507     raeburn  4394:   border-spacing: 0px;
                   4395:   width: 100%;
                   4396: }
1.523     albertel 4397: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
                   4398: table.LC_prior_tries tr th {
1.349     albertel 4399:   font-weight: bold;
                   4400:   background-color: $data_table_head;
1.421     albertel 4401:   font-size: smaller;
1.347     albertel 4402: }
1.440     albertel 4403: table.LC_data_table tr td, 
                   4404: table.LC_aboutme_port tr td {
1.349     albertel 4405:   background-color: $data_table_light;
1.425     albertel 4406:   padding: 2px;
1.347     albertel 4407: }
1.440     albertel 4408: table.LC_data_table tr.LC_even_row td,
                   4409: table.LC_aboutme_port tr.LC_even_row td {
1.349     albertel 4410:   background-color: $data_table_dark;
1.347     albertel 4411: }
1.425     albertel 4412: table.LC_data_table tr.LC_data_table_highlight td {
                   4413:   background-color: $data_table_darker;
                   4414: }
1.451     albertel 4415: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  4416: table.LC_nested tr.LC_empty_row td {
1.347     albertel 4417:   background-color: #FFFFFF;
1.421     albertel 4418:   font-weight: bold;
                   4419:   font-style: italic;
                   4420:   text-align: center;
                   4421:   padding: 8px;
1.347     albertel 4422: }
1.507     raeburn  4423: table.LC_nested tr.LC_empty_row td {
1.465     albertel 4424:   padding: 4ex
                   4425: }
1.507     raeburn  4426: table.LC_nested_outer tr th {
                   4427:   font-weight: bold;
                   4428:   background-color: $data_table_head;
                   4429:   font-size: smaller;
                   4430:   border-bottom: 1px solid #000000;
                   4431: }
                   4432: table.LC_nested_outer tr td.LC_subheader {
                   4433:   background-color: $data_table_head;
                   4434:   font-weight: bold;
                   4435:   font-size: small;
                   4436:   border-bottom: 1px solid #000000;
                   4437:   text-align: right;
1.451     albertel 4438: }
1.507     raeburn  4439: table.LC_nested tr.LC_info_row td {
1.451     albertel 4440:   background-color: #CCC;
                   4441:   font-weight: bold;
                   4442:   font-size: small;
1.507     raeburn  4443:   text-align: center;
                   4444: }
1.589     raeburn  4445: table.LC_nested tr.LC_info_row td.LC_left_item,
                   4446: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  4447:   text-align: left;
1.451     albertel 4448: }
1.507     raeburn  4449: table.LC_nested td {
1.451     albertel 4450:   background-color: #FFF;
                   4451:   font-size: small;
1.507     raeburn  4452: }
                   4453: table.LC_nested_outer tr th.LC_right_item,
                   4454: table.LC_nested tr.LC_info_row td.LC_right_item,
                   4455: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   4456: table.LC_nested tr td.LC_right_item {
1.451     albertel 4457:   text-align: right;
                   4458: }
                   4459: 
1.507     raeburn  4460: table.LC_nested tr.LC_odd_row td {
1.451     albertel 4461:   background-color: #EEE;
                   4462: }
                   4463: 
1.473     raeburn  4464: table.LC_createuser {
                   4465: }
                   4466: 
                   4467: table.LC_createuser tr.LC_section_row td {
                   4468:   font-size: smaller;
                   4469: }
                   4470: 
                   4471: table.LC_createuser tr.LC_info_row td  {
                   4472:   background-color: #CCC;
                   4473:   font-weight: bold;
                   4474:   text-align: center;
                   4475: }
                   4476: 
1.349     albertel 4477: table.LC_calendar {
                   4478:   border: 1px solid #000000;
                   4479:   border-collapse: collapse;
                   4480: }
                   4481: table.LC_calendar_pickdate {
                   4482:   font-size: xx-small;
                   4483: }
                   4484: table.LC_calendar tr td {
                   4485:   border: 1px solid #000000;
                   4486:   vertical-align: top;
                   4487: }
                   4488: table.LC_calendar tr td.LC_calendar_day_empty {
                   4489:   background-color: $data_table_dark;
                   4490: }
                   4491: table.LC_calendar tr td.LC_calendar_day_current {
                   4492:   background-color: $data_table_highlight;
                   4493: }
                   4494: 
                   4495: table.LC_mail_list tr.LC_mail_new {
                   4496:   background-color: $mail_new;
                   4497: }
                   4498: table.LC_mail_list tr.LC_mail_new:hover {
                   4499:   background-color: $mail_new_hover;
                   4500: }
                   4501: table.LC_mail_list tr.LC_mail_read {
                   4502:   background-color: $mail_read;
                   4503: }
                   4504: table.LC_mail_list tr.LC_mail_read:hover {
                   4505:   background-color: $mail_read_hover;
                   4506: }
                   4507: table.LC_mail_list tr.LC_mail_replied {
                   4508:   background-color: $mail_replied;
                   4509: }
                   4510: table.LC_mail_list tr.LC_mail_replied:hover {
                   4511:   background-color: $mail_replied_hover;
                   4512: }
                   4513: table.LC_mail_list tr.LC_mail_other {
                   4514:   background-color: $mail_other;
                   4515: }
                   4516: table.LC_mail_list tr.LC_mail_other:hover {
                   4517:   background-color: $mail_other_hover;
                   4518: }
1.494     raeburn  4519: table.LC_mail_list tr.LC_mail_even {
                   4520: }
                   4521: table.LC_mail_list tr.LC_mail_odd {
                   4522: }
                   4523: 
1.385     albertel 4524: 
1.386     albertel 4525: table#LC_portfolio_actions {
                   4526:   width: auto;
                   4527:   background: $pgbg;
                   4528:   border: 0px;
                   4529:   border-spacing: 2px 2px;
                   4530:   padding: 0px;
                   4531:   margin: 0px;
                   4532:   border-collapse: separate;
                   4533: }
                   4534: table#LC_portfolio_actions td.LC_label {
                   4535:   background: $tabbg;
                   4536:   text-align: right;
                   4537: }
                   4538: table#LC_portfolio_actions td.LC_value {
                   4539:   background: $tabbg;
                   4540: }
1.385     albertel 4541: 
1.391     albertel 4542: table#LC_cstr_controls {
                   4543:   width: 100%;
                   4544:   border-collapse: collapse;
                   4545: }
                   4546: table#LC_cstr_controls tr td {
                   4547:   border: 4px solid $pgbg;
                   4548:   padding: 4px;
                   4549:   text-align: center;
                   4550:   background: $tabbg;
                   4551: }
                   4552: table#LC_cstr_controls tr th {
                   4553:   border: 4px solid $pgbg;
                   4554:   background: $table_header;
                   4555:   text-align: center;
                   4556:   font-family: $sans;
                   4557:   font-size: smaller;
                   4558: }
                   4559: 
1.389     albertel 4560: table#LC_browser {
                   4561:  
                   4562: }
                   4563: table#LC_browser tr th {
1.391     albertel 4564:   background: $table_header;
1.389     albertel 4565: }
1.390     albertel 4566: table#LC_browser tr td {
                   4567:   padding: 2px;
                   4568: }
1.389     albertel 4569: table#LC_browser tr.LC_browser_file,
                   4570: table#LC_browser tr.LC_browser_file_published {
                   4571:   background: #CCFF88;
                   4572: }
                   4573: table#LC_browser tr.LC_browser_file_locked,
                   4574: table#LC_browser tr.LC_browser_file_unpublished {
                   4575:   background: #FFAA99;
1.387     albertel 4576: }
1.389     albertel 4577: table#LC_browser tr.LC_browser_file_obsolete {
                   4578:   background: #AAAAAA;
1.387     albertel 4579: }
1.455     albertel 4580: table#LC_browser tr.LC_browser_file_modified,
                   4581: table#LC_browser tr.LC_browser_file_metamodified {
1.389     albertel 4582:   background: #FFFF77;
1.387     albertel 4583: }
1.389     albertel 4584: table#LC_browser tr.LC_browser_folder {
                   4585:   background: #CCCCFF;
1.387     albertel 4586: }
1.388     albertel 4587: span.LC_current_location {
                   4588:   font-size: x-large;
                   4589:   background: $pgbg;
                   4590: }
1.387     albertel 4591: 
1.395     albertel 4592: span.LC_parm_menu_item {
                   4593:   font-size: larger;
                   4594:   font-family: $sans;
                   4595: }
                   4596: span.LC_parm_scope_all {
                   4597:   color: red;
                   4598: }
                   4599: span.LC_parm_scope_folder {
                   4600:   color: green;
                   4601: }
                   4602: span.LC_parm_scope_resource {
                   4603:   color: orange;
                   4604: }
                   4605: span.LC_parm_part {
                   4606:   color: blue;
                   4607: }
                   4608: span.LC_parm_folder, span.LC_parm_symb {
                   4609:   font-size: x-small;
                   4610:   font-family: $mono;
                   4611:   color: #AAAAAA;
                   4612: }
                   4613: 
1.396     albertel 4614: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
                   4615: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
                   4616:   border: 1px solid black;
                   4617:   border-collapse: collapse;
                   4618: }
                   4619: table.LC_parm_overview_restrictions td {
                   4620:   border-width: 1px 4px 1px 4px;
                   4621:   border-style: solid;
                   4622:   border-color: $pgbg;
                   4623:   text-align: center;
                   4624: }
                   4625: table.LC_parm_overview_restrictions th {
                   4626:   background: $tabbg;
                   4627:   border-width: 1px 4px 1px 4px;
                   4628:   border-style: solid;
                   4629:   border-color: $pgbg;
                   4630: }
1.398     albertel 4631: table#LC_helpmenu {
                   4632:   border: 0px;
                   4633:   height: 55px;
                   4634:   border-spacing: 0px;
                   4635: }
                   4636: 
                   4637: table#LC_helpmenu fieldset legend {
                   4638:   font-size: larger;
                   4639:   font-weight: bold;
                   4640: }
1.397     albertel 4641: table#LC_helpmenu_links {
                   4642:   width: 100%;
                   4643:   border: 1px solid black;
                   4644:   background: $pgbg;
                   4645:   padding: 0px;
                   4646:   border-spacing: 1px;
                   4647: }
                   4648: table#LC_helpmenu_links tr td {
                   4649:   padding: 1px;
                   4650:   background: $tabbg;
1.399     albertel 4651:   text-align: center;
                   4652:   font-weight: bold;
1.397     albertel 4653: }
1.396     albertel 4654: 
1.397     albertel 4655: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
                   4656: table#LC_helpmenu_links a:active {
                   4657:   text-decoration: none;
                   4658:   color: $font;
                   4659: }
                   4660: table#LC_helpmenu_links a:hover {
                   4661:   text-decoration: underline;
                   4662:   color: $vlink;
                   4663: }
1.396     albertel 4664: 
1.417     albertel 4665: .LC_chrt_popup_exists {
                   4666:   border: 1px solid #339933;
                   4667:   margin: -1px;
                   4668: }
                   4669: .LC_chrt_popup_up {
                   4670:   border: 1px solid yellow;
                   4671:   margin: -1px;
                   4672: }
                   4673: .LC_chrt_popup {
                   4674:   border: 1px solid #8888FF;
                   4675:   background: #CCCCFF;
                   4676: }
1.421     albertel 4677: table.LC_pick_box {
                   4678:   border-collapse: separate;
                   4679:   background: white;
                   4680:   border: 1px solid black;
                   4681:   border-spacing: 1px;
                   4682: }
                   4683: table.LC_pick_box td.LC_pick_box_title {
                   4684:   background: $tabbg;
                   4685:   font-weight: bold;
                   4686:   text-align: right;
                   4687:   width: 184px;
                   4688:   padding: 8px;
                   4689: }
1.579     raeburn  4690: table.LC_pick_box td.LC_pick_box_value {
                   4691:   text-align: left;
                   4692:   padding: 8px;
                   4693: }
                   4694: table.LC_pick_box td.LC_pick_box_select {
                   4695:   text-align: left;
                   4696:   padding: 8px;
                   4697: }
1.424     albertel 4698: table.LC_pick_box td.LC_pick_box_separator {
1.421     albertel 4699:   padding: 0px;
                   4700:   height: 1px;
                   4701:   background: black;
                   4702: }
                   4703: table.LC_pick_box td.LC_pick_box_submit {
                   4704:   text-align: right;
                   4705: }
1.579     raeburn  4706: table.LC_pick_box td.LC_evenrow_value {
                   4707:   text-align: left;
                   4708:   padding: 8px;
                   4709:   background-color: $data_table_light;
                   4710: }
                   4711: table.LC_pick_box td.LC_oddrow_value {
                   4712:   text-align: left;
                   4713:   padding: 8px;
                   4714:   background-color: $data_table_light;
                   4715: }
                   4716: table.LC_helpform_receipt {
                   4717:   width: 620px;
                   4718:   border-collapse: separate;
                   4719:   background: white;
                   4720:   border: 1px solid black;
                   4721:   border-spacing: 1px;
                   4722: }
                   4723: table.LC_helpform_receipt td.LC_pick_box_title {
                   4724:   background: $tabbg;
                   4725:   font-weight: bold;
                   4726:   text-align: right;
                   4727:   width: 184px;
                   4728:   padding: 8px;
                   4729: }
                   4730: table.LC_helpform_receipt td.LC_evenrow_value {
                   4731:   text-align: left;
                   4732:   padding: 8px;
                   4733:   background-color: $data_table_light;
                   4734: }
                   4735: table.LC_helpform_receipt td.LC_oddrow_value {
                   4736:   text-align: left;
                   4737:   padding: 8px;
                   4738:   background-color: $data_table_light;
                   4739: }
                   4740: table.LC_helpform_receipt td.LC_pick_box_separator {
                   4741:   padding: 0px;
                   4742:   height: 1px;
                   4743:   background: black;
                   4744: }
                   4745: span.LC_helpform_receipt_cat {
                   4746:   font-weight: bold;
                   4747: }
1.424     albertel 4748: table.LC_group_priv_box {
                   4749:   background: white;
                   4750:   border: 1px solid black;
                   4751:   border-spacing: 1px;
                   4752: }
                   4753: table.LC_group_priv_box td.LC_pick_box_title {
                   4754:   background: $tabbg;
                   4755:   font-weight: bold;
                   4756:   text-align: right;
                   4757:   width: 184px;
                   4758: }
                   4759: table.LC_group_priv_box td.LC_groups_fixed {
                   4760:   background: $data_table_light;
                   4761:   text-align: center;
                   4762: }
                   4763: table.LC_group_priv_box td.LC_groups_optional {
                   4764:   background: $data_table_dark;
                   4765:   text-align: center;
                   4766: }
                   4767: table.LC_group_priv_box td.LC_groups_functionality {
                   4768:   background: $data_table_darker;
                   4769:   text-align: center;
                   4770:   font-weight: bold;
                   4771: }
                   4772: table.LC_group_priv td {
                   4773:   text-align: left;
                   4774:   padding: 0px;
                   4775: }
                   4776: 
1.421     albertel 4777: table.LC_notify_front_page {
                   4778:   background: white;
                   4779:   border: 1px solid black;
                   4780:   padding: 8px;
                   4781: }
                   4782: table.LC_notify_front_page td {
                   4783:   padding: 8px;
                   4784: }
1.424     albertel 4785: .LC_navbuttons {
                   4786:   margin: 2ex 0ex 2ex 0ex;
                   4787: }
1.423     albertel 4788: .LC_topic_bar {
                   4789:   font-family: $sans;
                   4790:   font-weight: bold;
                   4791:   width: 100%;
                   4792:   background: $tabbg;
                   4793:   vertical-align: middle;
                   4794:   margin: 2ex 0ex 2ex 0ex;
                   4795: }
                   4796: .LC_topic_bar span {
                   4797:   vertical-align: middle;
                   4798: }
                   4799: .LC_topic_bar img {
                   4800:   vertical-align: bottom;
                   4801: }
                   4802: table.LC_course_group_status {
                   4803:   margin: 20px;
                   4804: }
                   4805: table.LC_status_selector td {
                   4806:   vertical-align: top;
                   4807:   text-align: center;
1.424     albertel 4808:   padding: 4px;
                   4809: }
                   4810: table.LC_descriptive_input td.LC_description {
                   4811:   vertical-align: top;
                   4812:   text-align: right;
                   4813:   font-weight: bold;
1.423     albertel 4814: }
1.599     albertel 4815: div.LC_feedback_link {
                   4816:   background: white;
                   4817:   width: 100%;  
1.489     raeburn  4818: }
                   4819: span.LC_feedback_link {
1.599     albertel 4820:   background: $feedback_link_bg;
                   4821:   font-size: larger;
                   4822: }
                   4823: span.LC_message_link {
                   4824:   background: $feedback_link_bg;
                   4825:   font-size: larger;
                   4826:   position: absolute;
                   4827:   right: 1em;
1.489     raeburn  4828: }
1.421     albertel 4829: 
1.515     albertel 4830: table.LC_prior_tries {
1.524     albertel 4831:   border: 1px solid #000000;
                   4832:   border-collapse: separate;
                   4833:   border-spacing: 1px;
1.515     albertel 4834: }
1.523     albertel 4835: 
1.515     albertel 4836: table.LC_prior_tries td {
1.524     albertel 4837:   padding: 2px;
1.515     albertel 4838: }
1.523     albertel 4839: 
                   4840: .LC_answer_correct {
                   4841:   background: #AAFFAA;
                   4842:   color: black;
                   4843: }
                   4844: .LC_answer_charged_try {
                   4845:   background: #FFAAAA ! important;
                   4846:   color: black;
                   4847: }
                   4848: .LC_answer_not_charged_try, 
                   4849: .LC_answer_no_grade,
                   4850: .LC_answer_late {
                   4851:   background: #FFFFAA;
                   4852:   color: black;
                   4853: }
                   4854: .LC_answer_previous {
                   4855:   background: #AAAAFF;
                   4856:   color: black;
                   4857: }
                   4858: .LC_answer_no_message {
                   4859:   background: #FFFFFF;
                   4860:   color: black;
                   4861: }
                   4862: .LC_answer_unknown {
                   4863:   background: orange;
                   4864:   color: black;
                   4865: }
                   4866: 
                   4867: 
1.529     albertel 4868: span.LC_prior_numerical,
                   4869: span.LC_prior_string,
                   4870: span.LC_prior_custom,
                   4871: span.LC_prior_reaction,
                   4872: span.LC_prior_math {
1.523     albertel 4873:   font-family: monospace;
                   4874:   white-space: pre;
                   4875: }
                   4876: 
1.525     albertel 4877: span.LC_prior_string {
                   4878:   font-family: monospace;
                   4879:   white-space: pre;
                   4880: }
                   4881: 
1.523     albertel 4882: table.LC_prior_option {
                   4883:   width: 100%;
                   4884:   border-collapse: collapse;
                   4885: }
1.528     albertel 4886: table.LC_prior_rank, table.LC_prior_match {
                   4887:   border-collapse: collapse;
                   4888: }
                   4889: table.LC_prior_option tr td,
                   4890: table.LC_prior_rank tr td,
                   4891: table.LC_prior_match tr td {
1.524     albertel 4892:   border: 1px solid #000000;
1.515     albertel 4893: }
                   4894: 
1.519     raeburn  4895: span.LC_nobreak {
1.544     albertel 4896:   white-space: nowrap;
1.519     raeburn  4897: }
                   4898: 
1.576     raeburn  4899: span.LC_cusr_emph {
                   4900:   font-style: italic;
                   4901: }
                   4902: 
1.545     albertel 4903: table.LC_docs_documents {
                   4904:   background: #BBBBBB;
1.547     albertel 4905:   border-width: 0px;
1.545     albertel 4906:   border-collapse: collapse;
                   4907: }
                   4908: 
                   4909: table.LC_docs_documents td.LC_docs_document {
                   4910:   border: 2px solid black;
                   4911:   padding: 4px;
                   4912: }
                   4913: 
                   4914: .LC_docs_course_commands div {
                   4915:   float: left;
                   4916:   border: 4px solid #AAAAAA;
                   4917:   padding: 4px;
                   4918:   background: #DDDDCC;
                   4919: }
                   4920: 
                   4921: .LC_docs_entry_move {
                   4922:   border: 0px;
                   4923:   border-collapse: collapse;
1.544     albertel 4924: }
                   4925: 
1.545     albertel 4926: .LC_docs_entry_move td {
                   4927:   border: 2px solid #BBBBBB;
                   4928:   background: #DDDDDD;
                   4929: }
                   4930: 
                   4931: .LC_docs_editor td.LC_docs_entry_commands {
                   4932:   background: #DDDDDD;
                   4933:   font-size: x-small;
                   4934: }
1.544     albertel 4935: .LC_docs_copy {
1.545     albertel 4936:   color: #000099;
1.544     albertel 4937: }
                   4938: .LC_docs_cut {
1.545     albertel 4939:   color: #550044;
1.544     albertel 4940: }
                   4941: .LC_docs_rename {
1.545     albertel 4942:   color: #009900;
1.544     albertel 4943: }
                   4944: .LC_docs_remove {
1.545     albertel 4945:   color: #990000;
                   4946: }
                   4947: 
1.547     albertel 4948: .LC_docs_reinit_warn,
                   4949: .LC_docs_ext_edit {
                   4950:   font-size: x-small;
                   4951: }
                   4952: 
1.545     albertel 4953: .LC_docs_editor td.LC_docs_entry_title,
                   4954: .LC_docs_editor td.LC_docs_entry_icon {
                   4955:   background: #FFFFBB;
                   4956: }
                   4957: .LC_docs_editor td.LC_docs_entry_parameter {
                   4958:   background: #BBBBFF;
                   4959:   font-size: x-small;
                   4960:   white-space: nowrap;
                   4961: }
                   4962: 
                   4963: table.LC_docs_adddocs td,
                   4964: table.LC_docs_adddocs th {
                   4965:   border: 1px solid #BBBBBB;
                   4966:   padding: 4px;
                   4967:   background: #DDDDDD;
1.543     albertel 4968: }
                   4969: 
1.584     albertel 4970: table.LC_sty_begin {
                   4971:   background: #BBFFBB;
                   4972: }
                   4973: table.LC_sty_end {
                   4974:   background: #FFBBBB;
                   4975: }
                   4976: 
1.589     raeburn  4977: table.LC_double_column {
                   4978:   border-width: 0px;
                   4979:   border-collapse: collapse;
                   4980:   width: 100%;
                   4981:   padding: 2px;
                   4982: }
                   4983: 
                   4984: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  4985:   top: 2px;
1.589     raeburn  4986:   left: 2px;
                   4987:   width: 47%;
                   4988:   vertical-align: top;
                   4989: }
                   4990: 
                   4991: table.LC_double_column tr td.LC_right_col {
                   4992:   top: 2px;
                   4993:   right: 2px; 
                   4994:   width: 47%;
                   4995:   vertical-align: top;
                   4996: }
                   4997: 
1.594     raeburn  4998: span.LC_role_level {
                   4999:   font-weight: bold;
                   5000: }
                   5001: 
1.591     raeburn  5002: div.LC_left_float {
                   5003:   float: left;
                   5004:   padding-right: 5%;
1.597     albertel 5005:   padding-bottom: 4px;
1.591     raeburn  5006: }
                   5007: 
                   5008: div.LC_clear_float_header {
1.597     albertel 5009:   padding-bottom: 2px;
1.591     raeburn  5010: }
                   5011: 
                   5012: div.LC_clear_float_footer {
1.597     albertel 5013:   padding-top: 10px;
1.591     raeburn  5014:   clear: both;
                   5015: }
                   5016: 
1.597     albertel 5017: 
1.601     albertel 5018: div.LC_grade_select_mode {
                   5019:   float: left;
1.604     albertel 5020:   font-family: $sans;
1.601     albertel 5021: }
                   5022: div.LC_grade_select_mode div div {
                   5023:   margin: 5px;
                   5024: }
                   5025: div.LC_grade_select_mode_selector {
                   5026:   margin: 5px;
                   5027:   float: left;
                   5028: }
                   5029: div.LC_grade_select_mode_selector_header {
                   5030:   font: bold medium $sans;
                   5031: }
                   5032: div.LC_grade_select_mode_type {
                   5033:   clear: left;
                   5034: }
                   5035: 
1.597     albertel 5036: div.LC_grade_show_user {
                   5037:   margin-top: 20px;
                   5038:   border: 1px solid black;
                   5039: }
                   5040: div.LC_grade_user_name {
                   5041:   background: #DDDDEE;
                   5042:   border-bottom: 1px solid black;
                   5043:   font: bold large $sans;
                   5044: }
                   5045: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
                   5046:   background: #DDEEDD;
                   5047: }
                   5048: 
                   5049: div.LC_grade_show_problem,
                   5050: div.LC_grade_submissions,
                   5051: div.LC_grade_message_center,
                   5052: div.LC_grade_info_links,
                   5053: div.LC_grade_assign {
                   5054:   margin: 5px;
                   5055:   width: 99%;
                   5056:   background: #FFFFFF;
                   5057: }
                   5058: div.LC_grade_show_problem_header,
                   5059: div.LC_grade_submissions_header,
                   5060: div.LC_grade_message_center_header,
                   5061: div.LC_grade_assign_header {
                   5062:   font: bold large $sans;
                   5063: }
                   5064: div.LC_grade_show_problem_problem,
                   5065: div.LC_grade_submissions_body,
                   5066: div.LC_grade_message_center_body,
                   5067: div.LC_grade_assign_body {
                   5068:   border: 1px solid black;
                   5069:   width: 99%;
                   5070:   background: #FFFFFF;
                   5071: }
1.598     albertel 5072: span.LC_grade_check_note {
                   5073:   font: normal medium $sans;
                   5074:   display: inline;
                   5075:   position: absolute;
                   5076:   right: 1em;
                   5077: }
1.597     albertel 5078: 
1.600     albertel 5079: 
                   5080: div.LC_edit_problem_header {
                   5081:   font: normal medium $sans;
1.602     albertel 5082:   margin: 2px;
1.600     albertel 5083: }
                   5084: div.LC_edit_problem_header,
1.602     albertel 5085: div.LC_edit_problem_header div,
                   5086: div.LC_edit_problem_editxml_header,
                   5087: div.LC_edit_problem_editxml_header div {
1.600     albertel 5088:   margin-top: 5px;
                   5089: }
1.602     albertel 5090: div.LC_edit_problem_header_edit_row {
                   5091:   background: $tabbg;
                   5092:   padding: 3px;
                   5093:   margin-bottom: 5px;
                   5094: }
1.600     albertel 5095: div.LC_edit_problem_header_title {
1.602     albertel 5096:   font: larger bold $sans;
                   5097:   background: $tabbg;
                   5098:   padding: 3px;
                   5099: }
                   5100: table.LC_edit_problem_header_title {
                   5101:   font: larger bold $sans;
                   5102:   width: 100%;
                   5103:   border-color: $pgbg;
                   5104:   border-style: solid;
                   5105:   border-width: $border;
                   5106: 
1.600     albertel 5107:   background: $tabbg;
1.602     albertel 5108:   border-collapse: collapse;
                   5109:   padding: 0px
                   5110: }
                   5111: 
                   5112: div.LC_edit_problem_discards {
                   5113:   float: left;
                   5114:   padding-bottom: 5px;
                   5115: }
                   5116: div.LC_edit_problem_saves {
                   5117:   float: right;
                   5118:   padding-bottom: 5px;
1.600     albertel 5119: }
                   5120: hr.LC_edit_problem_divide {
1.602     albertel 5121:   clear: both;
1.600     albertel 5122:   color: $tabbg;
                   5123:   background-color: $tabbg;
                   5124:   height: 3px;
                   5125:   border: 0px;
                   5126: }
1.343     albertel 5127: END
                   5128: }
                   5129: 
1.306     albertel 5130: =pod
                   5131: 
                   5132: =item * &headtag()
                   5133: 
                   5134: Returns a uniform footer for LON-CAPA web pages.
                   5135: 
1.307     albertel 5136: Inputs: $title - optional title for the head
                   5137:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 5138:         $args - optional arguments
1.319     albertel 5139:             force_register - if is true call registerurl so the remote is 
                   5140:                              informed
1.415     albertel 5141:             redirect       -> array ref of
                   5142:                                    1- seconds before redirect occurs
                   5143:                                    2- url to redirect to
                   5144:                                    3- whether the side effect should occur
1.315     albertel 5145:                            (side effect of setting 
                   5146:                                $env{'internal.head.redirect'} to the url 
                   5147:                                redirected too)
1.352     albertel 5148:             domain         -> force to color decorate a page for a specific
                   5149:                                domain
                   5150:             function       -> force usage of a specific rolish color scheme
                   5151:             bgcolor        -> override the default page bgcolor
1.460     albertel 5152:             no_auto_mt_title
                   5153:                            -> prevent &mt()ing the title arg
1.464     albertel 5154: 
1.306     albertel 5155: =cut
                   5156: 
                   5157: sub headtag {
1.313     albertel 5158:     my ($title,$head_extra,$args) = @_;
1.306     albertel 5159:     
1.363     albertel 5160:     my $function = $args->{'function'} || &get_users_function();
                   5161:     my $domain   = $args->{'domain'}   || &determinedomain();
                   5162:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 5163:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 5164: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 5165: 		   #time(),
1.418     albertel 5166: 		   $env{'environment.color.timestamp'},
1.363     albertel 5167: 		   $function,$domain,$bgcolor);
                   5168: 
1.369     www      5169:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 5170: 
1.308     albertel 5171:     my $result =
                   5172: 	'<head>'.
1.461     albertel 5173: 	&font_settings();
1.319     albertel 5174: 
1.461     albertel 5175:     if (!$args->{'frameset'}) {
                   5176: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   5177:     }
1.319     albertel 5178:     if ($args->{'force_register'}) {
                   5179: 	$result .= &Apache::lonmenu::registerurl(1);
                   5180:     }
1.436     albertel 5181:     if (!$args->{'no_nav_bar'} 
                   5182: 	&& !$args->{'only_body'}
                   5183: 	&& !$args->{'frameset'}) {
                   5184: 	$result .= &help_menu_js();
                   5185:     }
1.319     albertel 5186: 
1.314     albertel 5187:     if (ref($args->{'redirect'})) {
1.414     albertel 5188: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 5189: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 5190: 	if (!$inhibit_continue) {
                   5191: 	    $env{'internal.head.redirect'} = $url;
                   5192: 	}
1.313     albertel 5193: 	$result.=<<ADDMETA
                   5194: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 5195: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 5196: ADDMETA
                   5197:     }
1.306     albertel 5198:     if (!defined($title)) {
                   5199: 	$title = 'The LearningOnline Network with CAPA';
                   5200:     }
1.460     albertel 5201:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   5202:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 5203: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   5204: 	.$head_extra;
1.306     albertel 5205:     return $result;
                   5206: }
                   5207: 
                   5208: =pod
                   5209: 
1.340     albertel 5210: =item * &font_settings()
                   5211: 
                   5212: Returns neccessary <meta> to set the proper encoding
                   5213: 
                   5214: Inputs: none
                   5215: 
                   5216: =cut
                   5217: 
                   5218: sub font_settings {
                   5219:     my $headerstring='';
                   5220:     if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) { 
                   5221: 	$headerstring.=
                   5222: 	    '<meta Content-Type="text/html; charset=x-mac-roman" />';
                   5223:     } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
                   5224: 	$headerstring.=
                   5225: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   5226:     }
                   5227:     return $headerstring;
                   5228: }
                   5229: 
1.341     albertel 5230: =pod
                   5231: 
                   5232: =item * &xml_begin()
                   5233: 
                   5234: Returns the needed doctype and <html>
                   5235: 
                   5236: Inputs: none
                   5237: 
                   5238: =cut
                   5239: 
                   5240: sub xml_begin {
                   5241:     my $output='';
                   5242: 
1.592     albertel 5243:     if ($env{'internal.start_page'}==1) {
                   5244: 	&Apache::lonhtmlcommon::init_htmlareafields();
                   5245:     }
1.342     albertel 5246: 
1.341     albertel 5247:     if ($env{'browser.mathml'}) {
                   5248: 	$output='<?xml version="1.0"?>'
                   5249:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   5250: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   5251:             
                   5252: #	    .'<!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">] >'
                   5253: 	    .'<!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">'
                   5254:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   5255: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   5256:     } else {
                   5257: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
                   5258:     }
                   5259:     return $output;
                   5260: }
1.340     albertel 5261: 
                   5262: =pod
                   5263: 
1.306     albertel 5264: =item * &endheadtag()
                   5265: 
                   5266: Returns a uniform </head> for LON-CAPA web pages.
                   5267: 
                   5268: Inputs: none
                   5269: 
                   5270: =cut
                   5271: 
                   5272: sub endheadtag {
                   5273:     return '</head>';
                   5274: }
                   5275: 
                   5276: =pod
                   5277: 
                   5278: =item * &head()
                   5279: 
                   5280: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
                   5281: 
                   5282: Inputs: $title - optional title for the page
1.307     albertel 5283:         $head_extra - optional extra HTML to put inside the <head>
1.405     albertel 5284: 
1.306     albertel 5285: =cut
                   5286: 
                   5287: sub head {
1.325     albertel 5288:     my ($title,$head_extra,$args) = @_;
                   5289:     return &headtag($title,$head_extra,$args).&endheadtag();
1.306     albertel 5290: }
                   5291: 
                   5292: =pod
                   5293: 
                   5294: =item * &start_page()
                   5295: 
                   5296: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   5297: 
                   5298: Inputs: $title - optional title for the page
                   5299:         $head_extra - optional extra HTML to incude inside the <head>
1.315     albertel 5300:         $args - additional optional args supported are:
1.317     albertel 5301:                   only_body      -> is true will set &bodytag() onlybodytag
                   5302:                                     arg on
                   5303:                   no_nav_bar     -> is true will set &bodytag() notopbar arg on
                   5304:                   add_entries    -> additional attributes to add to the  <body>
                   5305:                   domain         -> force to color decorate a page for a 
                   5306:                                     specific domain
                   5307:                   function       -> force usage of a specific rolish color
                   5308:                                     scheme
                   5309:                   redirect       -> see &headtag()
                   5310:                   bgcolor        -> override the default page bg color
                   5311:                   js_ready       -> return a string ready for being used in 
                   5312:                                     a javascript writeln
1.320     albertel 5313:                   html_encode    -> return a string ready for being used in 
                   5314:                                     a html attribute
1.317     albertel 5315:                   force_register -> if is true will turn on the &bodytag()
                   5316:                                     $forcereg arg
1.326     albertel 5317:                   body_title     -> alternate text to use instead of $title
                   5318:                                     in the title box that appears, this text
                   5319:                                     is not auto translated like the $title is
1.330     albertel 5320:                   frameset       -> if true will start with a <frameset>
                   5321:                                     rather than <body>
1.338     albertel 5322:                   no_title       -> if true the title bar won't be shown
                   5323:                   skip_phases    -> hash ref of 
                   5324:                                     head -> skip the <html><head> generation
                   5325:                                     body -> skip all <body> generation
1.337     albertel 5326: 
1.361     albertel 5327:                   no_inline_link -> if true and in remote mode, don't show the 
                   5328:                                     'Switch To Inline Menu' link
                   5329: 
1.460     albertel 5330:                   no_auto_mt_title -> prevent &mt()ing the title arg
                   5331: 
1.562     albertel 5332:                   inherit_jsmath -> when creating popup window in a page,
                   5333:                                     should it have jsmath forced on by the
                   5334:                                     current page
                   5335: 
1.306     albertel 5336: =cut
                   5337: 
                   5338: sub start_page {
1.309     albertel 5339:     my ($title,$head_extra,$args) = @_;
1.318     albertel 5340:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313     albertel 5341:     my %head_args;
1.352     albertel 5342:     foreach my $arg ('redirect','force_register','domain','function',
1.460     albertel 5343: 		     'bgcolor','frameset','no_nav_bar','only_body',
                   5344: 		     'no_auto_mt_title') {
1.319     albertel 5345: 	if (defined($args->{$arg})) {
1.324     raeburn  5346: 	    $head_args{$arg} = $args->{$arg};
1.319     albertel 5347: 	}
1.313     albertel 5348:     }
1.319     albertel 5349: 
1.315     albertel 5350:     $env{'internal.start_page'}++;
1.338     albertel 5351:     my $result;
                   5352:     if (! exists($args->{'skip_phases'}{'head'}) ) {
                   5353: 	$result.=
1.341     albertel 5354: 	    &xml_begin().
1.338     albertel 5355: 	    &headtag($title,$head_extra,\%head_args).&endheadtag();
                   5356:     }
                   5357:     
                   5358:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   5359: 	if ($args->{'frameset'}) {
                   5360: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   5361: 						$args->{'add_entries'});
                   5362: 	    $result .= "\n<frameset $attr_string>\n";
                   5363: 	} else {
                   5364: 	    $result .=
                   5365: 		&bodytag($title, 
                   5366: 			 $args->{'function'},       $args->{'add_entries'},
                   5367: 			 $args->{'only_body'},      $args->{'domain'},
                   5368: 			 $args->{'force_register'}, $args->{'body_title'},
                   5369: 			 $args->{'no_nav_bar'},     $args->{'bgcolor'},
1.460     albertel 5370: 			 $args->{'no_title'},       $args->{'no_inline_link'},
                   5371: 			 $args);
1.338     albertel 5372: 	}
1.330     albertel 5373:     }
1.338     albertel 5374: 
1.315     albertel 5375:     if ($args->{'js_ready'}) {
1.317     albertel 5376: 	$result = &js_ready($result);
1.315     albertel 5377:     }
1.320     albertel 5378:     if ($args->{'html_encode'}) {
                   5379: 	$result = &html_encode($result);
                   5380:     }
1.315     albertel 5381:     return $result;
1.306     albertel 5382: }
                   5383: 
1.330     albertel 5384: 
1.306     albertel 5385: =pod
                   5386: 
                   5387: =item * &head()
                   5388: 
                   5389: Returns a complete </body></html> section for LON-CAPA web pages.
                   5390: 
1.315     albertel 5391: Inputs:         $args - additional optional args supported are:
                   5392:                  js_ready     -> return a string ready for being used in 
                   5393:                                  a javascript writeln
1.320     albertel 5394:                  html_encode  -> return a string ready for being used in 
                   5395:                                  a html attribute
1.330     albertel 5396:                  frameset     -> if true will start with a <frameset>
                   5397:                                  rather than <body>
1.493     albertel 5398:                  dicsussion   -> if true will get discussion from
                   5399:                                   lonxml::xmlend
                   5400:                                  (you can pass the target and parser arguments
                   5401:                                   through optional 'target' and 'parser' args
                   5402:                                   to this routine)
1.306     albertel 5403: 
                   5404: =cut
                   5405: 
                   5406: sub end_page {
1.315     albertel 5407:     my ($args) = @_;
                   5408:     $env{'internal.end_page'}++;
1.330     albertel 5409:     my $result;
1.335     albertel 5410:     if ($args->{'discussion'}) {
                   5411: 	my ($target,$parser);
                   5412: 	if (ref($args->{'discussion'})) {
                   5413: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   5414: 				$args->{'discussion'}{'parser'});
                   5415: 	}
                   5416: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   5417:     }
                   5418: 
1.330     albertel 5419:     if ($args->{'frameset'}) {
                   5420: 	$result .= '</frameset>';
                   5421:     } else {
                   5422: 	$result .= &endbodytag();
                   5423:     }
                   5424:     $result .= "\n</html>";
                   5425: 
1.315     albertel 5426:     if ($args->{'js_ready'}) {
1.317     albertel 5427: 	$result = &js_ready($result);
1.315     albertel 5428:     }
1.335     albertel 5429: 
1.320     albertel 5430:     if ($args->{'html_encode'}) {
                   5431: 	$result = &html_encode($result);
                   5432:     }
1.335     albertel 5433: 
1.315     albertel 5434:     return $result;
                   5435: }
                   5436: 
1.320     albertel 5437: sub html_encode {
                   5438:     my ($result) = @_;
                   5439: 
1.322     albertel 5440:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 5441:     
                   5442:     return $result;
                   5443: }
1.317     albertel 5444: sub js_ready {
                   5445:     my ($result) = @_;
                   5446: 
1.323     albertel 5447:     $result =~ s/[\n\r]/ /xmsg;
                   5448:     $result =~ s/\\/\\\\/xmsg;
                   5449:     $result =~ s/'/\\'/xmsg;
1.372     albertel 5450:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 5451:     
                   5452:     return $result;
                   5453: }
                   5454: 
1.315     albertel 5455: sub validate_page {
                   5456:     if (  exists($env{'internal.start_page'})
1.316     albertel 5457: 	  &&     $env{'internal.start_page'} > 1) {
                   5458: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 5459: 				 $env{'internal.start_page'}.' '.
1.316     albertel 5460: 				 $ENV{'request.filename'});
1.315     albertel 5461:     }
                   5462:     if (  exists($env{'internal.end_page'})
1.316     albertel 5463: 	  &&     $env{'internal.end_page'} > 1) {
                   5464: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 5465: 				 $env{'internal.end_page'}.' '.
1.316     albertel 5466: 				 $env{'request.filename'});
1.315     albertel 5467:     }
                   5468:     if (     exists($env{'internal.start_page'})
                   5469: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 5470: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   5471: 				 $env{'request.filename'});
1.315     albertel 5472:     }
                   5473:     if (   ! exists($env{'internal.start_page'})
                   5474: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 5475: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   5476: 				 $env{'request.filename'});
1.315     albertel 5477:     }
1.306     albertel 5478: }
1.315     albertel 5479: 
1.318     albertel 5480: sub simple_error_page {
                   5481:     my ($r,$title,$msg) = @_;
                   5482:     my $page =
                   5483: 	&Apache::loncommon::start_page($title).
                   5484: 	&mt($msg).
                   5485: 	&Apache::loncommon::end_page();
                   5486:     if (ref($r)) {
                   5487: 	$r->print($page);
1.327     albertel 5488: 	return;
1.318     albertel 5489:     }
                   5490:     return $page;
                   5491: }
1.347     albertel 5492: 
                   5493: {
                   5494:     my $row_count;
                   5495:     sub start_data_table {
1.422     albertel 5496: 	my ($add_class) = @_;
                   5497: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.347     albertel 5498: 	undef($row_count);
1.422     albertel 5499: 	return '<table class="'.$css_class.'">'."\n";
1.347     albertel 5500:     }
                   5501: 
                   5502:     sub end_data_table {
                   5503: 	undef($row_count);
1.389     albertel 5504: 	return '</table>'."\n";;
1.347     albertel 5505:     }
                   5506: 
                   5507:     sub start_data_table_row {
1.422     albertel 5508: 	my ($add_class) = @_;
1.347     albertel 5509: 	$row_count++;
1.422     albertel 5510: 	my $css_class = ($row_count % 2)?'':'LC_even_row';
1.428     albertel 5511: 	$css_class = (join(' ',$css_class,$add_class));
1.422     albertel 5512: 	return  '<tr class="'.$css_class.'">'."\n";;
1.347     albertel 5513:     }
1.471     banghart 5514:     
                   5515:     sub continue_data_table_row {
                   5516: 	my ($add_class) = @_;
                   5517: 	my $css_class = ($row_count % 2)?'':'LC_even_row';
                   5518: 	$css_class = (join(' ',$css_class,$add_class));
                   5519: 	return  '<tr class="'.$css_class.'">'."\n";;
                   5520:     }
1.347     albertel 5521: 
                   5522:     sub end_data_table_row {
1.389     albertel 5523: 	return '</tr>'."\n";;
1.347     albertel 5524:     }
1.367     www      5525: 
1.421     albertel 5526:     sub start_data_table_empty_row {
                   5527: 	$row_count++;
                   5528: 	return  '<tr class="LC_empty_row" >'."\n";;
                   5529:     }
                   5530: 
                   5531:     sub end_data_table_empty_row {
                   5532: 	return '</tr>'."\n";;
                   5533:     }
                   5534: 
1.367     www      5535:     sub start_data_table_header_row {
1.389     albertel 5536: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      5537:     }
                   5538: 
                   5539:     sub end_data_table_header_row {
1.389     albertel 5540: 	return '</tr>'."\n";;
1.367     www      5541:     }
1.347     albertel 5542: }
                   5543: 
1.548     albertel 5544: =pod
                   5545: 
                   5546: =item * &inhibit_menu_check($arg)
                   5547: 
                   5548: Checks for a inhibitmenu state and generates output to preserve it
                   5549: 
                   5550: Inputs:         $arg - can be any of
                   5551:                      - undef - in which case the return value is a string 
                   5552:                                to add  into arguments list of a uri
                   5553:                      - 'input' - in which case the return value is a HTML
                   5554:                                  <form> <input> field of type hidden to
                   5555:                                  preserve the value
                   5556:                      - a url - in which case the return value is the url with
                   5557:                                the neccesary cgi args added to preserve the
                   5558:                                inhibitmenu state
                   5559:                      - a ref to a url - no return value, but the string is
                   5560:                                         updated to include the neccessary cgi
                   5561:                                         args to preserve the inhibitmenu state
                   5562: 
                   5563: =cut
                   5564: 
                   5565: sub inhibit_menu_check {
                   5566:     my ($arg) = @_;
                   5567:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5568:     if ($arg eq 'input') {
                   5569: 	if ($env{'form.inhibitmenu'}) {
                   5570: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   5571: 	} else {
                   5572: 	    return
                   5573: 	}
                   5574:     }
                   5575:     if ($env{'form.inhibitmenu'}) {
                   5576: 	if (ref($arg)) {
                   5577: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   5578: 	} elsif ($arg eq '') {
                   5579: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   5580: 	} else {
                   5581: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   5582: 	}
                   5583:     }
                   5584:     if (!ref($arg)) {
                   5585: 	return $arg;
                   5586:     }
                   5587: }
                   5588: 
1.251     albertel 5589: ###############################################
1.182     matthew  5590: 
                   5591: =pod
                   5592: 
1.549     albertel 5593: =back
                   5594: 
                   5595: =head1 User Information Routines
                   5596: 
                   5597: =over 4
                   5598: 
1.405     albertel 5599: =item * &get_users_function()
1.182     matthew  5600: 
                   5601: Used by &bodytag to determine the current users primary role.
                   5602: Returns either 'student','coordinator','admin', or 'author'.
                   5603: 
                   5604: =cut
                   5605: 
                   5606: ###############################################
                   5607: sub get_users_function {
                   5608:     my $function = 'student';
1.258     albertel 5609:     if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182     matthew  5610:         $function='coordinator';
                   5611:     }
1.258     albertel 5612:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  5613:         $function='admin';
                   5614:     }
1.258     albertel 5615:     if (($env{'request.role'}=~/^(au|ca)/) ||
1.182     matthew  5616:         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   5617:         $function='author';
                   5618:     }
                   5619:     return $function;
1.54      www      5620: }
1.99      www      5621: 
                   5622: ###############################################
                   5623: 
1.233     raeburn  5624: =pod
                   5625: 
1.542     raeburn  5626: =item * &check_user_status()
1.274     raeburn  5627: 
                   5628: Determines current status of supplied role for a
                   5629: specific user. Roles can be active, previous or future.
                   5630: 
                   5631: Inputs: 
                   5632: user's domain, user's username, course's domain,
1.375     raeburn  5633: course's number, optional section ID.
1.274     raeburn  5634: 
                   5635: Outputs:
                   5636: role status: active, previous or future. 
                   5637: 
                   5638: =cut
                   5639: 
                   5640: sub check_user_status {
1.412     raeburn  5641:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274     raeburn  5642:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
                   5643:     my @uroles = keys %userinfo;
                   5644:     my $srchstr;
                   5645:     my $active_chk = 'none';
1.412     raeburn  5646:     my $now = time;
1.274     raeburn  5647:     if (@uroles > 0) {
1.412     raeburn  5648:         if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  5649:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   5650:         } else {
1.412     raeburn  5651:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   5652:         }
                   5653:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  5654:             my $role_end = 0;
                   5655:             my $role_start = 0;
                   5656:             $active_chk = 'active';
1.412     raeburn  5657:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   5658:                 $role_end = $1;
                   5659:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   5660:                     $role_start = $1;
1.274     raeburn  5661:                 }
                   5662:             }
                   5663:             if ($role_start > 0) {
1.412     raeburn  5664:                 if ($now < $role_start) {
1.274     raeburn  5665:                     $active_chk = 'future';
                   5666:                 }
                   5667:             }
                   5668:             if ($role_end > 0) {
1.412     raeburn  5669:                 if ($now > $role_end) {
1.274     raeburn  5670:                     $active_chk = 'previous';
                   5671:                 }
                   5672:             }
                   5673:         }
                   5674:     }
                   5675:     return $active_chk;
                   5676: }
                   5677: 
                   5678: ###############################################
                   5679: 
                   5680: =pod
                   5681: 
1.405     albertel 5682: =item * &get_sections()
1.233     raeburn  5683: 
                   5684: Determines all the sections for a course including
                   5685: sections with students and sections containing other roles.
1.419     raeburn  5686: Incoming parameters: 
                   5687: 
                   5688: 1. domain
                   5689: 2. course number 
                   5690: 3. reference to array containing roles for which sections should 
                   5691: be gathered (optional).
                   5692: 4. reference to array containing status types for which sections 
                   5693: should be gathered (optional).
                   5694: 
                   5695: If the third argument is undefined, sections are gathered for any role. 
                   5696: If the fourth argument is undefined, sections are gathered for any status.
                   5697: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  5698:  
1.374     raeburn  5699: Returns section hash (keys are section IDs, values are
                   5700: number of users in each section), subject to the
1.419     raeburn  5701: optional roles filter, optional status filter 
1.233     raeburn  5702: 
                   5703: =cut
                   5704: 
                   5705: ###############################################
                   5706: sub get_sections {
1.419     raeburn  5707:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 5708:     if (!defined($cdom) || !defined($cnum)) {
                   5709:         my $cid =  $env{'request.course.id'};
                   5710: 
                   5711: 	return if (!defined($cid));
                   5712: 
                   5713:         $cdom = $env{'course.'.$cid.'.domain'};
                   5714:         $cnum = $env{'course.'.$cid.'.num'};
                   5715:     }
                   5716: 
                   5717:     my %sectioncount;
1.419     raeburn  5718:     my $now = time;
1.240     albertel 5719: 
1.366     albertel 5720:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 5721: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 5722: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   5723: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  5724:         my $start_index = &Apache::loncoursedata::CL_START();
                   5725:         my $end_index = &Apache::loncoursedata::CL_END();
                   5726:         my $status;
1.366     albertel 5727: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  5728: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   5729: 				                     $data->[$status_index],
                   5730:                                                      $data->[$start_index],
                   5731:                                                      $data->[$end_index]);
                   5732:             if ($stu_status eq 'Active') {
                   5733:                 $status = 'active';
                   5734:             } elsif ($end < $now) {
                   5735:                 $status = 'previous';
                   5736:             } elsif ($start > $now) {
                   5737:                 $status = 'future';
                   5738:             } 
                   5739: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   5740:                 if ((!defined($possible_status)) || (($status ne '') && 
                   5741:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   5742: 		    $sectioncount{$section}++;
                   5743:                 }
1.240     albertel 5744: 	    }
                   5745: 	}
                   5746:     }
                   5747:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   5748:     foreach my $user (sort(keys(%courseroles))) {
                   5749: 	if ($user !~ /^(\w{2})/) { next; }
                   5750: 	my ($role) = ($user =~ /^(\w{2})/);
                   5751: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  5752: 	my ($section,$status);
1.240     albertel 5753: 	if ($role eq 'cr' &&
                   5754: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   5755: 	    $section=$1;
                   5756: 	}
                   5757: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   5758: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  5759:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   5760:         if ($end == -1 && $start == -1) {
                   5761:             next; #deleted role
                   5762:         }
                   5763:         if (!defined($possible_status)) { 
                   5764:             $sectioncount{$section}++;
                   5765:         } else {
                   5766:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   5767:                 $status = 'active';
                   5768:             } elsif ($end < $now) {
                   5769:                 $status = 'future';
                   5770:             } elsif ($start > $now) {
                   5771:                 $status = 'previous';
                   5772:             }
                   5773:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   5774:                 $sectioncount{$section}++;
                   5775:             }
                   5776:         }
1.233     raeburn  5777:     }
1.366     albertel 5778:     return %sectioncount;
1.233     raeburn  5779: }
                   5780: 
1.274     raeburn  5781: ###############################################
1.294     raeburn  5782: 
                   5783: =pod
1.405     albertel 5784: 
                   5785: =item * &get_course_users()
                   5786: 
1.275     raeburn  5787: Retrieves usernames:domains for users in the specified course
                   5788: with specific role(s), and access status. 
                   5789: 
                   5790: Incoming parameters:
1.277     albertel 5791: 1. course domain
                   5792: 2. course number
                   5793: 3. access status: users must have - either active, 
1.275     raeburn  5794: previous, future, or all.
1.277     albertel 5795: 4. reference to array of permissible roles
1.288     raeburn  5796: 5. reference to array of section restrictions (optional)
                   5797: 6. reference to results object (hash of hashes).
                   5798: 7. reference to optional userdata hash
1.275     raeburn  5799: Keys of top level hash are roles.
                   5800: Keys of inner hashes are username:domain, with 
                   5801: values set to access type.
1.288     raeburn  5802: Optional userdata hash returns an array with arguments in the 
                   5803: same order as loncoursedata::get_classlist() for student data.
                   5804: 
                   5805: Entries for end, start, section and status are blank because
                   5806: of the possibility of multiple values for non-student roles.
                   5807: 
1.275     raeburn  5808: =cut
1.405     albertel 5809: 
1.275     raeburn  5810: ###############################################
1.405     albertel 5811: 
1.275     raeburn  5812: sub get_course_users {
1.288     raeburn  5813:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
                   5814:     my %idx = ();
1.419     raeburn  5815:     my %seclists;
1.288     raeburn  5816: 
                   5817:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   5818:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   5819:     $idx{end} = &Apache::loncoursedata::CL_END();
                   5820:     $idx{start} = &Apache::loncoursedata::CL_START();
                   5821:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   5822:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   5823:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   5824:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   5825: 
1.290     albertel 5826:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 5827:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  5828:         my $now = time;
1.277     albertel 5829:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  5830:             my $match = 0;
1.412     raeburn  5831:             my $secmatch = 0;
1.419     raeburn  5832:             my $section = $$classlist{$student}[$idx{section}];
                   5833:             if ($section eq '') {
                   5834:                 $section = 'none';
                   5835:             }
1.291     albertel 5836:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 5837:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  5838:                     $secmatch = 1;
                   5839:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 5840:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  5841:                         $secmatch = 1;
                   5842:                     }
                   5843:                 } else {  
1.419     raeburn  5844: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  5845: 		        $secmatch = 1;
                   5846:                     }
1.290     albertel 5847: 		}
1.412     raeburn  5848:                 if (!$secmatch) {
                   5849:                     next;
                   5850:                 }
1.419     raeburn  5851:             }
1.420     albertel 5852:             push(@{$seclists{$student}},$section); 
1.275     raeburn  5853:             if (defined($$types{'active'})) {
1.288     raeburn  5854:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  5855:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  5856:                     $match = 1;
1.275     raeburn  5857:                 }
                   5858:             }
                   5859:             if (defined($$types{'previous'})) {
1.288     raeburn  5860:                 if ($$classlist{$student}[$idx{end}] <= $now) {
1.275     raeburn  5861:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  5862:                     $match = 1;
1.275     raeburn  5863:                 }
                   5864:             }
                   5865:             if (defined($$types{'future'})) {
1.288     raeburn  5866:                 if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) {
1.275     raeburn  5867:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  5868:                     $match = 1;
1.275     raeburn  5869:                 }
                   5870:             }
1.412     raeburn  5871:             if ($match && ref($userdata) eq 'HASH') {
1.288     raeburn  5872:                 $$userdata{$student} = $$classlist{$student};
                   5873:             }
1.275     raeburn  5874:         }
                   5875:     }
1.412     raeburn  5876:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  5877:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   5878:         my $now = time;
                   5879:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  5880:             my $match = 0;
1.412     raeburn  5881:             my $secmatch = 0;
1.439     raeburn  5882:             my $status;
1.412     raeburn  5883:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  5884:             $user =~ s/:$//;
1.439     raeburn  5885:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   5886:             if ($end == -1 || $start == -1) {
                   5887:                 next;
                   5888:             }
                   5889:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   5890:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  5891:                 my ($uname,$udom) = split(/:/,$user);
                   5892:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 5893:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  5894:                         $secmatch = 1;
                   5895:                     } elsif ($usec eq '') {
1.420     albertel 5896:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  5897:                             $secmatch = 1;
                   5898:                         }
                   5899:                     } else {
                   5900:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   5901:                             $secmatch = 1;
                   5902:                         }
                   5903:                     }
                   5904:                     if (!$secmatch) {
                   5905:                         next;
                   5906:                     }
1.288     raeburn  5907:                 }
1.419     raeburn  5908:                 if ($usec eq '') {
                   5909:                     $usec = 'none';
                   5910:                 }
1.275     raeburn  5911:                 if ($uname ne '' && $udom ne '') {
1.503     raeburn  5912:                     if ($end > 0 && $end < $now) {
1.439     raeburn  5913:                         $status = 'previous';
                   5914:                     } elsif ($start > $now) {
                   5915:                         $status = 'future';
                   5916:                     } else {
                   5917:                         $status = 'active';
                   5918:                     }
1.277     albertel 5919:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  5920:                         if ($status eq $type) {
1.420     albertel 5921:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  5922:                                 push(@{$$users{$role}{$user}},$type);
                   5923:                             }
1.288     raeburn  5924:                             $match = 1;
                   5925:                         }
                   5926:                     }
1.419     raeburn  5927:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   5928:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   5929: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   5930:                         }
1.420     albertel 5931:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  5932:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   5933:                         }
1.275     raeburn  5934:                     }
                   5935:                 }
                   5936:             }
                   5937:         }
1.290     albertel 5938:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  5939:             if ((defined($cdom)) && (defined($cnum))) {
                   5940:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   5941:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   5942:                     my $owner = $csettings{'internal.courseowner'};
1.439     raeburn  5943:                     if ($owner !~ /^[^:]+:[^:]+$/) {
                   5944:                         $owner = $owner.':'.$cdom;
                   5945:                     }
                   5946:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 5947:                     if (defined($userdata) && 
                   5948: 			!exists($$userdata{$owner.':'.$cdom})) {
                   5949: 			&get_user_info($cdom,$owner,\%idx,$userdata);
1.420     albertel 5950:                         if (!grep(/^none$/,@{$seclists{$owner.':'.$cdom}})) {
1.419     raeburn  5951:                             push(@{$seclists{$owner.':'.$cdom}},'none');
                   5952:                         }
1.290     albertel 5953: 		    }
1.279     raeburn  5954:                 }
                   5955:             }
                   5956:         }
1.419     raeburn  5957:         foreach my $user (keys(%seclists)) {
                   5958:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   5959:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   5960:         }
1.275     raeburn  5961:     }
                   5962:     return;
                   5963: }
                   5964: 
1.288     raeburn  5965: sub get_user_info {
                   5966:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 5967:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   5968: 	&plainname($uname,$udom,'lastname');
1.291     albertel 5969:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  5970:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.288     raeburn  5971:     return;
                   5972: }
1.275     raeburn  5973: 
1.472     raeburn  5974: ###############################################
                   5975: 
                   5976: =pod
                   5977: 
                   5978: =item * &get_user_quota()
                   5979: 
                   5980: Retrieves quota assigned for storage of portfolio files for a user  
                   5981: 
                   5982: Incoming parameters:
                   5983: 1. user's username
                   5984: 2. user's domain
                   5985: 
                   5986: Returns:
1.536     raeburn  5987: 1. Disk quota (in Mb) assigned to student.
                   5988: 2. (Optional) Type of setting: custom or default
                   5989:    (individually assigned or default for user's 
                   5990:    institutional status).
                   5991: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   5992:    or student - types as defined in localenroll::inst_usertypes 
                   5993:    for user's domain, which determines default quota for user.
                   5994: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  5995: 
                   5996: If a value has been stored in the user's environment, 
1.536     raeburn  5997: it will return that, otherwise it returns the maximal default
                   5998: defined for the user's instituional status(es) in the domain.
1.472     raeburn  5999: 
                   6000: =cut
                   6001: 
                   6002: ###############################################
                   6003: 
                   6004: 
                   6005: sub get_user_quota {
                   6006:     my ($uname,$udom) = @_;
1.536     raeburn  6007:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  6008:     if (!defined($udom)) {
                   6009:         $udom = $env{'user.domain'};
                   6010:     }
                   6011:     if (!defined($uname)) {
                   6012:         $uname = $env{'user.name'};
                   6013:     }
                   6014:     if (($udom eq '' || $uname eq '') ||
                   6015:         ($udom eq 'public') && ($uname eq 'public')) {
                   6016:         $quota = 0;
1.536     raeburn  6017:         $quotatype = 'default';
                   6018:         $defquota = 0; 
1.472     raeburn  6019:     } else {
1.536     raeburn  6020:         my $inststatus;
1.472     raeburn  6021:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   6022:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  6023:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  6024:         } else {
1.536     raeburn  6025:             my %userenv = 
                   6026:                 &Apache::lonnet::get('environment',['portfolioquota',
                   6027:                                      'inststatus'],$udom,$uname);
1.472     raeburn  6028:             my ($tmp) = keys(%userenv);
                   6029:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   6030:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  6031:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  6032:             } else {
                   6033:                 undef(%userenv);
                   6034:             }
                   6035:         }
1.536     raeburn  6036:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  6037:         if ($quota eq '') {
1.536     raeburn  6038:             $quota = $defquota;
                   6039:             $quotatype = 'default';
                   6040:         } else {
                   6041:             $quotatype = 'custom';
1.472     raeburn  6042:         }
                   6043:     }
1.536     raeburn  6044:     if (wantarray) {
                   6045:         return ($quota,$quotatype,$settingstatus,$defquota);
                   6046:     } else {
                   6047:         return $quota;
                   6048:     }
1.472     raeburn  6049: }
                   6050: 
                   6051: ###############################################
                   6052: 
                   6053: =pod
                   6054: 
                   6055: =item * &default_quota()
                   6056: 
1.536     raeburn  6057: Retrieves default quota assigned for storage of user portfolio files,
                   6058: given an (optional) user's institutional status.
1.472     raeburn  6059: 
                   6060: Incoming parameters:
                   6061: 1. domain
1.536     raeburn  6062: 2. (Optional) institutional status(es).  This is a : separated list of 
                   6063:    status types (e.g., faculty, staff, student etc.)
                   6064:    which apply to the user for whom the default is being retrieved.
                   6065:    If the institutional status string in undefined, the domain
                   6066:    default quota will be returned. 
1.472     raeburn  6067: 
                   6068: Returns:
                   6069: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  6070: 2. (Optional) institutional type which determined the value of the
                   6071:    default quota.
1.472     raeburn  6072: 
                   6073: If a value has been stored in the domain's configuration db,
                   6074: it will return that, otherwise it returns 20 (for backwards 
                   6075: compatibility with domains which have not set up a configuration
                   6076: db file; the original statically defined portfolio quota was 20 Mb). 
                   6077: 
1.536     raeburn  6078: If the user's status includes multiple types (e.g., staff and student),
                   6079: the largest default quota which applies to the user determines the
                   6080: default quota returned.
                   6081: 
1.472     raeburn  6082: =cut
                   6083: 
                   6084: ###############################################
                   6085: 
                   6086: 
                   6087: sub default_quota {
1.536     raeburn  6088:     my ($udom,$inststatus) = @_;
                   6089:     my ($defquota,$settingstatus);
                   6090:     my %quotahash = &Apache::lonnet::get_dom('configuration',
                   6091:                                             ['quota'],$udom);
                   6092:     if (ref($quotahash{'quota'}) eq 'HASH') {
                   6093:         if ($inststatus ne '') {
                   6094:             my @statuses = split(/:/,$inststatus);
                   6095:             foreach my $item (@statuses) {
                   6096:                 if ($quotahash{'quota'}{$item} ne '') {
                   6097:                     if ($defquota eq '') {
                   6098:                         $defquota = $quotahash{'quota'}{$item};
                   6099:                         $settingstatus = $item;
                   6100:                     } elsif ($quotahash{'quota'}{$item} > $defquota) {
                   6101:                         $defquota = $quotahash{'quota'}{$item};
                   6102:                         $settingstatus = $item;
                   6103:                     }
                   6104:                 }
                   6105:             }
                   6106:         }
                   6107:         if ($defquota eq '') {
                   6108:             $defquota = $quotahash{'quota'}{'default'};
                   6109:             $settingstatus = 'default';
                   6110:         }
                   6111:     } else {
                   6112:         $settingstatus = 'default';
                   6113:         $defquota = 20;
                   6114:     }
                   6115:     if (wantarray) {
                   6116:         return ($defquota,$settingstatus);
1.472     raeburn  6117:     } else {
1.536     raeburn  6118:         return $defquota;
1.472     raeburn  6119:     }
                   6120: }
                   6121: 
1.384     raeburn  6122: sub get_secgrprole_info {
                   6123:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   6124:     my %sections_count = &get_sections($cdom,$cnum);
                   6125:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   6126:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   6127:     my @groups = sort(keys(%curr_groups));
                   6128:     my $allroles = [];
                   6129:     my $rolehash;
                   6130:     my $accesshash = {
                   6131:                      active => 'Currently has access',
                   6132:                      future => 'Will have future access',
                   6133:                      previous => 'Previously had access',
                   6134:                   };
                   6135:     if ($needroles) {
                   6136:         $rolehash = {'all' => 'all'};
1.385     albertel 6137:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   6138: 	if (&Apache::lonnet::error(%user_roles)) {
                   6139: 	    undef(%user_roles);
                   6140: 	}
                   6141:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  6142:             my ($role)=split(/\:/,$item,2);
                   6143:             if ($role eq 'cr') { next; }
                   6144:             if ($role =~ /^cr/) {
                   6145:                 $$rolehash{$role} = (split('/',$role))[3];
                   6146:             } else {
                   6147:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   6148:             }
                   6149:         }
                   6150:         foreach my $key (sort(keys(%{$rolehash}))) {
                   6151:             push(@{$allroles},$key);
                   6152:         }
                   6153:         push (@{$allroles},'st');
                   6154:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   6155:     }
                   6156:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   6157: }
                   6158: 
1.555     raeburn  6159: sub user_picker {
1.570     raeburn  6160:     my ($dom,$srch,$forcenewuser,$caller) = @_;
1.555     raeburn  6161:     my $currdom = $dom;
                   6162:     my %curr_selected = (
                   6163:                         srchin => 'dom',
1.580     raeburn  6164:                         srchby => 'lastname',
1.555     raeburn  6165:                       );
                   6166:     my $srchterm;
                   6167:     if (ref($srch) eq 'HASH') {
                   6168:         if ($srch->{'srchby'} ne '') {
                   6169:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   6170:         }
                   6171:         if ($srch->{'srchin'} ne '') {
                   6172:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   6173:         }
                   6174:         if ($srch->{'srchtype'} ne '') {
                   6175:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   6176:         }
                   6177:         if ($srch->{'srchdomain'} ne '') {
                   6178:             $currdom = $srch->{'srchdomain'};
                   6179:         }
                   6180:         $srchterm = $srch->{'srchterm'};
                   6181:     }
                   6182:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  6183:                     'usr'       => 'Search criteria',
1.563     raeburn  6184:                     'doma'      => 'Domain/institution to search',
1.558     albertel 6185:                     'uname'     => 'username',
                   6186:                     'lastname'  => 'last name',
1.555     raeburn  6187:                     'lastfirst' => 'last name, first name',
1.558     albertel 6188:                     'crs'       => 'in this course',
1.576     raeburn  6189:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 6190:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  6191:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 6192:                     'exact'     => 'is',
                   6193:                     'contains'  => 'contains',
1.569     raeburn  6194:                     'begins'    => 'begins with',
1.571     raeburn  6195:                     'youm'      => "You must include some text to search for.",
                   6196:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   6197:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   6198:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   6199:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   6200:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   6201:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   6202:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  6203:                                        );
1.563     raeburn  6204:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   6205:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  6206: 
                   6207:     my @srchins = ('crs','dom','alc','instd');
                   6208: 
                   6209:     foreach my $option (@srchins) {
                   6210:         # FIXME 'alc' option unavailable until 
                   6211:         #       loncreateuser::print_user_query_page()
                   6212:         #       has been completed.
                   6213:         next if ($option eq 'alc');
                   6214:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  6215:         if ($curr_selected{'srchin'} eq $option) {
                   6216:             $srchinsel .= ' 
                   6217:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   6218:         } else {
                   6219:             $srchinsel .= '
                   6220:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   6221:         }
1.555     raeburn  6222:     }
1.563     raeburn  6223:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  6224: 
                   6225:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  6226:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  6227:         if ($curr_selected{'srchby'} eq $option) {
                   6228:             $srchbysel .= '
                   6229:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   6230:         } else {
                   6231:             $srchbysel .= '
                   6232:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   6233:          }
                   6234:     }
                   6235:     $srchbysel .= "\n  </select>\n";
                   6236: 
                   6237:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  6238:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  6239:         if ($curr_selected{'srchtype'} eq $option) {
                   6240:             $srchtypesel .= '
                   6241:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   6242:         } else {
                   6243:             $srchtypesel .= '
                   6244:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   6245:         }
                   6246:     }
                   6247:     $srchtypesel .= "\n  </select>\n";
                   6248: 
1.558     albertel 6249:     my ($newuserscript,$new_user_create);
1.556     raeburn  6250: 
                   6251:     if ($forcenewuser) {
1.576     raeburn  6252:         if (ref($srch) eq 'HASH') {
                   6253:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
                   6254: 	        $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>';
                   6255:             }
                   6256:         }
                   6257: 
1.556     raeburn  6258:         $newuserscript = <<"ENDSCRIPT";
                   6259: 
1.570     raeburn  6260: function setSearch(createnew,callingForm) {
1.556     raeburn  6261:     if (createnew == 1) {
1.570     raeburn  6262:         for (var i=0; i<callingForm.srchby.length; i++) {
                   6263:             if (callingForm.srchby.options[i].value == 'uname') {
                   6264:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  6265:             }
                   6266:         }
1.570     raeburn  6267:         for (var i=0; i<callingForm.srchin.length; i++) {
                   6268:             if ( callingForm.srchin.options[i].value == 'dom') {
                   6269: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  6270:             }
                   6271:         }
1.570     raeburn  6272:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   6273:             if (callingForm.srchtype.options[i].value == 'exact') {
                   6274:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  6275:             }
                   6276:         }
1.570     raeburn  6277:         for (var i=0; i<callingForm.srchdomain.length; i++) {
                   6278:             if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
                   6279:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  6280:             }
                   6281:         }
                   6282:     }
                   6283: }
                   6284: ENDSCRIPT
1.558     albertel 6285: 
1.556     raeburn  6286:     }
                   6287: 
1.555     raeburn  6288:     my $output = <<"END_BLOCK";
1.556     raeburn  6289: <script type="text/javascript">
1.570     raeburn  6290: function validateEntry(callingForm) {
1.558     albertel 6291: 
1.556     raeburn  6292:     var checkok = 1;
1.558     albertel 6293:     var srchin;
1.570     raeburn  6294:     for (var i=0; i<callingForm.srchin.length; i++) {
                   6295: 	if ( callingForm.srchin[i].checked ) {
                   6296: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 6297: 	}
                   6298:     }
                   6299: 
1.570     raeburn  6300:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   6301:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   6302:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   6303:     var srchterm =  callingForm.srchterm.value;
                   6304:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  6305:     var msg = "";
                   6306: 
                   6307:     if (srchterm == "") {
                   6308:         checkok = 0;
1.571     raeburn  6309:         msg += "$lt{'youm'}\\n";
1.556     raeburn  6310:     }
                   6311: 
1.569     raeburn  6312:     if (srchtype== 'begins') {
                   6313:         if (srchterm.length < 2) {
                   6314:             checkok = 0;
1.571     raeburn  6315:             msg += "$lt{'thte'}\\n";
1.569     raeburn  6316:         }
                   6317:     }
                   6318: 
1.556     raeburn  6319:     if (srchtype== 'contains') {
                   6320:         if (srchterm.length < 3) {
                   6321:             checkok = 0;
1.571     raeburn  6322:             msg += "$lt{'thet'}\\n";
1.556     raeburn  6323:         }
                   6324:     }
                   6325:     if (srchin == 'instd') {
                   6326:         if (srchdomain == '') {
                   6327:             checkok = 0;
1.571     raeburn  6328:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  6329:         }
                   6330:     }
                   6331:     if (srchin == 'dom') {
                   6332:         if (srchdomain == '') {
                   6333:             checkok = 0;
1.571     raeburn  6334:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  6335:         }
                   6336:     }
                   6337:     if (srchby == 'lastfirst') {
                   6338:         if (srchterm.indexOf(",") == -1) {
                   6339:             checkok = 0;
1.571     raeburn  6340:             msg += "$lt{'whus'}\\n";
1.556     raeburn  6341:         }
                   6342:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   6343:             checkok = 0;
1.571     raeburn  6344:             msg += "$lt{'whse'}\\n";
1.556     raeburn  6345:         }
                   6346:     }
                   6347:     if (checkok == 0) {
1.571     raeburn  6348:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  6349:         return;
                   6350:     }
                   6351:     if (checkok == 1) {
1.570     raeburn  6352:         callingForm.submit();
1.556     raeburn  6353:     }
                   6354: }
                   6355: 
                   6356: $newuserscript
                   6357: 
                   6358: </script>
1.558     albertel 6359: 
                   6360: $new_user_create
                   6361: 
1.555     raeburn  6362: <table>
1.558     albertel 6363:  <tr>
1.573     raeburn  6364:   <td>$lt{'doma'}:</td>
                   6365:   <td>$domform</td>
                   6366:   </td>
                   6367:  </tr>
                   6368:  <tr>
                   6369:   <td>$lt{'usr'}:</td>
1.563     raeburn  6370:   <td>$srchbysel
                   6371:       $srchtypesel 
                   6372:       <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564     albertel 6373:       $srchinsel 
1.563     raeburn  6374:   </td>
                   6375:  </tr>
1.555     raeburn  6376: </table>
                   6377: <br />
                   6378: END_BLOCK
1.558     albertel 6379: 
1.555     raeburn  6380:     return $output;
                   6381: }
                   6382: 
1.585     raeburn  6383: sub username_rule_check {
                   6384:     my ($srch,$caller) = @_;
                   6385:     my ($response,@curr_rules,%inst_results,$rulematch);
                   6386:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'});
                   6387:     if (ref($srch) eq 'HASH') {
                   6388:         (my $inst_response,%inst_results) = 
                   6389:             &Apache::lonnet::get_instuser($srch->{'srchdomain'},
                   6390:                                           $srch->{'srchterm'});
                   6391:         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   6392:                               ['usercreation'],$srch->{'srchdomain'});
                   6393:         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   6394:             if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') {
                   6395:                 @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}};
                   6396:             }
                   6397:         }
                   6398:         if (@curr_rules > 0) {
                   6399:             my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description');
                   6400:             my $instuser_reqd;
                   6401:             my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules);
                   6402:             foreach my $rule (@curr_rules) {
                   6403:                 if ($rule_check{$rule}) {
                   6404:                     $rulematch = $rule;
                   6405:                     if ($inst_response eq 'ok') {
                   6406:                         if (keys(%inst_results) == 0) {
                   6407:                             if ($caller eq 'new') {
                   6408:                                 $response = &mt('The username you chose matches the format of usernames defined for <span class="LC_cusr_emph">[_1]</span>, but the user does not exist in the institutional directory.',$domdesc).'<br />'.&mt("You must choose a username with a different format -- one that will not conflict with 'official' institutional usernames.");
                   6409:                             }
                   6410:                         }
                   6411:                     }
                   6412:                     last;
                   6413:                 }
                   6414:             }
                   6415:             if ($response) {
                   6416:                 if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   6417:                     if (@{$ruleorder} > 0) {
                   6418:                         $response .= '<br />'.&mt('Usernames with the following format(s) may <span class="LC_cusr_emph">only</span> be used for verified users at [_1]:',$domdesc).' <ul>';
                   6419:                         foreach my $rule (@{$ruleorder}) {
                   6420:                             if (grep(/^\Q$rule\E$/,@curr_rules)) {
                   6421:                                 if (ref($rules->{$rule}) eq 'HASH') {
                   6422:                                     $response .= '<li>'.$rules->{$rule}{'name'}.': '.
                   6423:                                                  $rules->{$rule}{'desc'}.'</li>';
                   6424:                                 }
                   6425:                             }
                   6426:                         }
                   6427:                     }
                   6428:                     $response .= '</ul>';
                   6429:                 }
                   6430:             }
                   6431:         }
                   6432:     }
                   6433:     return ($response,$rulematch,$rules,%inst_results);
                   6434: }
                   6435: 
1.112     bowersj2 6436: =pod
                   6437: 
1.549     albertel 6438: =back
                   6439: 
                   6440: =head1 HTTP Helpers
                   6441: 
                   6442: =over 4
                   6443: 
1.112     bowersj2 6444: =item * get_unprocessed_cgi($query,$possible_names)
                   6445: 
1.258     albertel 6446: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 6447: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 6448: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 6449: 
                   6450: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   6451: $possible_names is an ref to an array of form element names.  As an example:
                   6452: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 6453: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 6454: 
                   6455: =cut
1.1       albertel 6456: 
1.6       albertel 6457: sub get_unprocessed_cgi {
1.25      albertel 6458:   my ($query,$possible_names)= @_;
1.26      matthew  6459:   # $Apache::lonxml::debug=1;
1.356     albertel 6460:   foreach my $pair (split(/&/,$query)) {
                   6461:     my ($name, $value) = split(/=/,$pair);
1.369     www      6462:     $name = &unescape($name);
1.25      albertel 6463:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   6464:       $value =~ tr/+/ /;
                   6465:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 6466:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 6467:     }
1.16      harris41 6468:   }
1.6       albertel 6469: }
                   6470: 
1.112     bowersj2 6471: =pod
                   6472: 
                   6473: =item * cacheheader() 
                   6474: 
                   6475: returns cache-controlling header code
                   6476: 
                   6477: =cut
                   6478: 
1.7       albertel 6479: sub cacheheader {
1.258     albertel 6480:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 6481:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   6482:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 6483:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   6484:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 6485:     return $output;
1.7       albertel 6486: }
                   6487: 
1.112     bowersj2 6488: =pod
                   6489: 
                   6490: =item * no_cache($r) 
                   6491: 
                   6492: specifies header code to not have cache
                   6493: 
                   6494: =cut
                   6495: 
1.9       albertel 6496: sub no_cache {
1.216     albertel 6497:     my ($r) = @_;
                   6498:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 6499: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 6500:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   6501:     $r->no_cache(1);
                   6502:     $r->header_out("Expires" => $date);
                   6503:     $r->header_out("Pragma" => "no-cache");
1.123     www      6504: }
                   6505: 
                   6506: sub content_type {
1.181     albertel 6507:     my ($r,$type,$charset) = @_;
1.299     foxr     6508:     if ($r) {
                   6509: 	#  Note that printout.pl calls this with undef for $r.
                   6510: 	&no_cache($r);
                   6511:     }
1.258     albertel 6512:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 6513:     unless ($charset) {
                   6514: 	$charset=&Apache::lonlocal::current_encoding;
                   6515:     }
                   6516:     if ($charset) { $type.='; charset='.$charset; }
                   6517:     if ($r) {
                   6518: 	$r->content_type($type);
                   6519:     } else {
                   6520: 	print("Content-type: $type\n\n");
                   6521:     }
1.9       albertel 6522: }
1.25      albertel 6523: 
1.112     bowersj2 6524: =pod
                   6525: 
                   6526: =item * add_to_env($name,$value) 
                   6527: 
1.258     albertel 6528: adds $name to the %env hash with value
1.112     bowersj2 6529: $value, if $name already exists, the entry is converted to an array
                   6530: reference and $value is added to the array.
                   6531: 
                   6532: =cut
                   6533: 
1.25      albertel 6534: sub add_to_env {
                   6535:   my ($name,$value)=@_;
1.258     albertel 6536:   if (defined($env{$name})) {
                   6537:     if (ref($env{$name})) {
1.25      albertel 6538:       #already have multiple values
1.258     albertel 6539:       push(@{ $env{$name} },$value);
1.25      albertel 6540:     } else {
                   6541:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 6542:       my $first=$env{$name};
                   6543:       undef($env{$name});
                   6544:       push(@{ $env{$name} },$first,$value);
1.25      albertel 6545:     }
                   6546:   } else {
1.258     albertel 6547:     $env{$name}=$value;
1.25      albertel 6548:   }
1.31      albertel 6549: }
1.149     albertel 6550: 
                   6551: =pod
                   6552: 
                   6553: =item * get_env_multiple($name) 
                   6554: 
1.258     albertel 6555: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 6556: values may be defined and end up as an array ref.
                   6557: 
                   6558: returns an array of values
                   6559: 
                   6560: =cut
                   6561: 
                   6562: sub get_env_multiple {
                   6563:     my ($name) = @_;
                   6564:     my @values;
1.258     albertel 6565:     if (defined($env{$name})) {
1.149     albertel 6566:         # exists is it an array
1.258     albertel 6567:         if (ref($env{$name})) {
                   6568:             @values=@{ $env{$name} };
1.149     albertel 6569:         } else {
1.258     albertel 6570:             $values[0]=$env{$name};
1.149     albertel 6571:         }
                   6572:     }
                   6573:     return(@values);
                   6574: }
                   6575: 
1.31      albertel 6576: 
1.41      ng       6577: =pod
1.45      matthew  6578: 
1.464     albertel 6579: =back
1.41      ng       6580: 
1.112     bowersj2 6581: =head1 CSV Upload/Handling functions
1.38      albertel 6582: 
1.41      ng       6583: =over 4
                   6584: 
1.112     bowersj2 6585: =item * upfile_store($r)
1.41      ng       6586: 
                   6587: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 6588: needs $env{'form.upfile'}
1.41      ng       6589: returns $datatoken to be put into hidden field
                   6590: 
                   6591: =cut
1.31      albertel 6592: 
                   6593: sub upfile_store {
                   6594:     my $r=shift;
1.258     albertel 6595:     $env{'form.upfile'}=~s/\r/\n/gs;
                   6596:     $env{'form.upfile'}=~s/\f/\n/gs;
                   6597:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   6598:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 6599: 
1.258     albertel 6600:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   6601: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 6602:     {
1.158     raeburn  6603:         my $datafile = $r->dir_config('lonDaemons').
                   6604:                            '/tmp/'.$datatoken.'.tmp';
                   6605:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 6606:             print $fh $env{'form.upfile'};
1.158     raeburn  6607:             close($fh);
                   6608:         }
1.31      albertel 6609:     }
                   6610:     return $datatoken;
                   6611: }
                   6612: 
1.56      matthew  6613: =pod
                   6614: 
1.112     bowersj2 6615: =item * load_tmp_file($r)
1.41      ng       6616: 
                   6617: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 6618: needs $env{'form.datatoken'},
                   6619: sets $env{'form.upfile'} to the contents of the file
1.41      ng       6620: 
                   6621: =cut
1.31      albertel 6622: 
                   6623: sub load_tmp_file {
                   6624:     my $r=shift;
                   6625:     my @studentdata=();
                   6626:     {
1.158     raeburn  6627:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 6628:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  6629:         if ( open(my $fh,"<$studentfile") ) {
                   6630:             @studentdata=<$fh>;
                   6631:             close($fh);
                   6632:         }
1.31      albertel 6633:     }
1.258     albertel 6634:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 6635: }
                   6636: 
1.56      matthew  6637: =pod
                   6638: 
1.112     bowersj2 6639: =item * upfile_record_sep()
1.41      ng       6640: 
                   6641: Separate uploaded file into records
                   6642: returns array of records,
1.258     albertel 6643: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       6644: 
                   6645: =cut
1.31      albertel 6646: 
                   6647: sub upfile_record_sep {
1.258     albertel 6648:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 6649:     } else {
1.248     albertel 6650: 	my @records;
1.258     albertel 6651: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 6652: 	    if ($line=~/^\s*$/) { next; }
                   6653: 	    push(@records,$line);
                   6654: 	}
                   6655: 	return @records;
1.31      albertel 6656:     }
                   6657: }
                   6658: 
1.56      matthew  6659: =pod
                   6660: 
1.112     bowersj2 6661: =item * record_sep($record)
1.41      ng       6662: 
1.258     albertel 6663: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       6664: 
                   6665: =cut
                   6666: 
1.263     www      6667: sub takeleft {
                   6668:     my $index=shift;
                   6669:     return substr('0000'.$index,-4,4);
                   6670: }
                   6671: 
1.31      albertel 6672: sub record_sep {
                   6673:     my $record=shift;
                   6674:     my %components=();
1.258     albertel 6675:     if ($env{'form.upfiletype'} eq 'xml') {
                   6676:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 6677:         my $i=0;
1.356     albertel 6678:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 6679:             $field=~s/^(\"|\')//;
                   6680:             $field=~s/(\"|\')$//;
1.263     www      6681:             $components{&takeleft($i)}=$field;
1.31      albertel 6682:             $i++;
                   6683:         }
1.258     albertel 6684:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 6685:         my $i=0;
1.356     albertel 6686:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 6687:             $field=~s/^(\"|\')//;
                   6688:             $field=~s/(\"|\')$//;
1.263     www      6689:             $components{&takeleft($i)}=$field;
1.31      albertel 6690:             $i++;
                   6691:         }
                   6692:     } else {
1.561     www      6693:         my $separator=',';
1.480     banghart 6694:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      6695:             $separator=';';
1.480     banghart 6696:         }
1.31      albertel 6697:         my $i=0;
1.561     www      6698: # the character we are looking for to indicate the end of a quote or a record 
                   6699:         my $looking_for=$separator;
                   6700: # do not add the characters to the fields
                   6701:         my $ignore=0;
                   6702: # we just encountered a separator (or the beginning of the record)
                   6703:         my $just_found_separator=1;
                   6704: # store the field we are working on here
                   6705:         my $field='';
                   6706: # work our way through all characters in record
                   6707:         foreach my $character ($record=~/(.)/g) {
                   6708:             if ($character eq $looking_for) {
                   6709:                if ($character ne $separator) {
                   6710: # Found the end of a quote, again looking for separator
                   6711:                   $looking_for=$separator;
                   6712:                   $ignore=1;
                   6713:                } else {
                   6714: # Found a separator, store away what we got
                   6715:                   $components{&takeleft($i)}=$field;
                   6716: 	          $i++;
                   6717:                   $just_found_separator=1;
                   6718:                   $ignore=0;
                   6719:                   $field='';
                   6720:                }
                   6721:                next;
                   6722:             }
                   6723: # single or double quotation marks after a separator indicate beginning of a quote
                   6724: # we are now looking for the end of the quote and need to ignore separators
                   6725:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   6726:                $looking_for=$character;
                   6727:                next;
                   6728:             }
                   6729: # ignore would be true after we reached the end of a quote
                   6730:             if ($ignore) { next; }
                   6731:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   6732:             $field.=$character;
                   6733:             $just_found_separator=0; 
1.31      albertel 6734:         }
1.561     www      6735: # catch the very last entry, since we never encountered the separator
                   6736:         $components{&takeleft($i)}=$field;
1.31      albertel 6737:     }
                   6738:     return %components;
                   6739: }
                   6740: 
1.144     matthew  6741: ######################################################
                   6742: ######################################################
                   6743: 
1.56      matthew  6744: =pod
                   6745: 
1.112     bowersj2 6746: =item * upfile_select_html()
1.41      ng       6747: 
1.144     matthew  6748: Return HTML code to select a file from the users machine and specify 
                   6749: the file type.
1.41      ng       6750: 
                   6751: =cut
                   6752: 
1.144     matthew  6753: ######################################################
                   6754: ######################################################
1.31      albertel 6755: sub upfile_select_html {
1.144     matthew  6756:     my %Types = (
                   6757:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 6758:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  6759:                  space => &mt('Space separated'),
                   6760:                  tab   => &mt('Tabulator separated'),
                   6761: #                 xml   => &mt('HTML/XML'),
                   6762:                  );
                   6763:     my $Str = '<input type="file" name="upfile" size="50" />'.
                   6764:         '<br />Type: <select name="upfiletype">';
                   6765:     foreach my $type (sort(keys(%Types))) {
                   6766:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   6767:     }
                   6768:     $Str .= "</select>\n";
                   6769:     return $Str;
1.31      albertel 6770: }
                   6771: 
1.301     albertel 6772: sub get_samples {
                   6773:     my ($records,$toget) = @_;
                   6774:     my @samples=({});
                   6775:     my $got=0;
                   6776:     foreach my $rec (@$records) {
                   6777: 	my %temp = &record_sep($rec);
                   6778: 	if (! grep(/\S/, values(%temp))) { next; }
                   6779: 	if (%temp) {
                   6780: 	    $samples[$got]=\%temp;
                   6781: 	    $got++;
                   6782: 	    if ($got == $toget) { last; }
                   6783: 	}
                   6784:     }
                   6785:     return \@samples;
                   6786: }
                   6787: 
1.144     matthew  6788: ######################################################
                   6789: ######################################################
                   6790: 
1.56      matthew  6791: =pod
                   6792: 
1.112     bowersj2 6793: =item * csv_print_samples($r,$records)
1.41      ng       6794: 
                   6795: Prints a table of sample values from each column uploaded $r is an
                   6796: Apache Request ref, $records is an arrayref from
                   6797: &Apache::loncommon::upfile_record_sep
                   6798: 
                   6799: =cut
                   6800: 
1.144     matthew  6801: ######################################################
                   6802: ######################################################
1.31      albertel 6803: sub csv_print_samples {
                   6804:     my ($r,$records) = @_;
1.301     albertel 6805:     my $samples = &get_samples($records,3);
                   6806: 
1.594     raeburn  6807:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   6808:               &start_data_table_header_row());
1.356     albertel 6809:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
                   6810:         $r->print('<th>'.&mt('Column&nbsp;[_1]',($sample+1)).'</th>'); }
1.594     raeburn  6811:     $r->print(&end_data_table_header_row());
1.301     albertel 6812:     foreach my $hash (@$samples) {
1.594     raeburn  6813: 	$r->print(&start_data_table_row());
1.356     albertel 6814: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 6815: 	    $r->print('<td>');
1.356     albertel 6816: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 6817: 	    $r->print('</td>');
                   6818: 	}
1.594     raeburn  6819: 	$r->print(&end_data_table_row());
1.31      albertel 6820:     }
1.594     raeburn  6821:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 6822: }
                   6823: 
1.144     matthew  6824: ######################################################
                   6825: ######################################################
                   6826: 
1.56      matthew  6827: =pod
                   6828: 
1.112     bowersj2 6829: =item * csv_print_select_table($r,$records,$d)
1.41      ng       6830: 
                   6831: Prints a table to create associations between values and table columns.
1.144     matthew  6832: 
1.41      ng       6833: $r is an Apache Request ref,
                   6834: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  6835: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       6836: 
                   6837: =cut
                   6838: 
1.144     matthew  6839: ######################################################
                   6840: ######################################################
1.31      albertel 6841: sub csv_print_select_table {
                   6842:     my ($r,$records,$d) = @_;
1.301     albertel 6843:     my $i=0;
                   6844:     my $samples = &get_samples($records,1);
1.144     matthew  6845:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  6846: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  6847:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  6848:               '<th>'.&mt('Column').'</th>'.
                   6849:               &end_data_table_header_row()."\n");
1.356     albertel 6850:     foreach my $array_ref (@$d) {
                   6851: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.594     raeburn  6852: 	$r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');
1.31      albertel 6853: 
                   6854: 	$r->print('<td><select name=f'.$i.
1.32      matthew  6855: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 6856: 	$r->print('<option value="none"></option>');
1.356     albertel 6857: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   6858: 	    $r->print('<option value="'.$sample.'"'.
                   6859:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
                   6860:                       '>Column '.($sample+1).'</option>');
1.31      albertel 6861: 	}
1.594     raeburn  6862: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 6863: 	$i++;
                   6864:     }
1.594     raeburn  6865:     $r->print(&end_data_table());
1.31      albertel 6866:     $i--;
                   6867:     return $i;
                   6868: }
1.56      matthew  6869: 
1.144     matthew  6870: ######################################################
                   6871: ######################################################
                   6872: 
1.56      matthew  6873: =pod
1.31      albertel 6874: 
1.112     bowersj2 6875: =item * csv_samples_select_table($r,$records,$d)
1.41      ng       6876: 
                   6877: Prints a table of sample values from the upload and can make associate samples to internal names.
                   6878: 
                   6879: $r is an Apache Request ref,
                   6880: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   6881: $d is an array of 2 element arrays (internal name, displayed name)
                   6882: 
                   6883: =cut
                   6884: 
1.144     matthew  6885: ######################################################
                   6886: ######################################################
1.31      albertel 6887: sub csv_samples_select_table {
                   6888:     my ($r,$records,$d) = @_;
                   6889:     my $i=0;
1.144     matthew  6890:     #
1.301     albertel 6891:     my $samples = &get_samples($records,3);
1.594     raeburn  6892:     $r->print(&start_data_table().
                   6893:               &start_data_table_header_row().'<th>'.
                   6894:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   6895:               &end_data_table_header_row());
1.301     albertel 6896: 
                   6897:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  6898: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  6899: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 6900: 	foreach my $option (@$d) {
                   6901: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  6902: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 6903:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  6904:                       $display.'</option>');
1.31      albertel 6905: 	}
                   6906: 	$r->print('</select></td><td>');
1.301     albertel 6907: 	foreach my $line (0..2) {
                   6908: 	    if (defined($samples->[$line]{$key})) { 
                   6909: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   6910: 	    }
                   6911: 	}
1.594     raeburn  6912: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 6913: 	$i++;
                   6914:     }
1.594     raeburn  6915:     $r->print(&end_data_table());
1.31      albertel 6916:     $i--;
                   6917:     return($i);
1.115     matthew  6918: }
                   6919: 
1.144     matthew  6920: ######################################################
                   6921: ######################################################
                   6922: 
1.115     matthew  6923: =pod
                   6924: 
                   6925: =item clean_excel_name($name)
                   6926: 
                   6927: Returns a replacement for $name which does not contain any illegal characters.
                   6928: 
                   6929: =cut
                   6930: 
1.144     matthew  6931: ######################################################
                   6932: ######################################################
1.115     matthew  6933: sub clean_excel_name {
                   6934:     my ($name) = @_;
                   6935:     $name =~ s/[:\*\?\/\\]//g;
                   6936:     if (length($name) > 31) {
                   6937:         $name = substr($name,0,31);
                   6938:     }
                   6939:     return $name;
1.25      albertel 6940: }
1.84      albertel 6941: 
1.85      albertel 6942: =pod
                   6943: 
1.112     bowersj2 6944: =item * check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 6945: 
                   6946: Returns either 1 or undef
                   6947: 
                   6948: 1 if the part is to be hidden, undef if it is to be shown
                   6949: 
                   6950: Arguments are:
                   6951: 
                   6952: $id the id of the part to be checked
                   6953: $symb, optional the symb of the resource to check
                   6954: $udom, optional the domain of the user to check for
                   6955: $uname, optional the username of the user to check for
                   6956: 
                   6957: =cut
1.84      albertel 6958: 
                   6959: sub check_if_partid_hidden {
                   6960:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 6961:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 6962: 					 $symb,$udom,$uname);
1.141     albertel 6963:     my $truth=1;
                   6964:     #if the string starts with !, then the list is the list to show not hide
                   6965:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 6966:     my @hiddenlist=split(/,/,$hiddenparts);
                   6967:     foreach my $checkid (@hiddenlist) {
1.141     albertel 6968: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 6969:     }
1.141     albertel 6970:     return !$truth;
1.84      albertel 6971: }
1.127     matthew  6972: 
1.138     matthew  6973: 
                   6974: ############################################################
                   6975: ############################################################
                   6976: 
                   6977: =pod
                   6978: 
1.157     matthew  6979: =back 
                   6980: 
1.138     matthew  6981: =head1 cgi-bin script and graphing routines
                   6982: 
1.157     matthew  6983: =over 4
                   6984: 
1.138     matthew  6985: =item get_cgi_id
                   6986: 
                   6987: Inputs: none
                   6988: 
                   6989: Returns an id which can be used to pass environment variables
                   6990: to various cgi-bin scripts.  These environment variables will
                   6991: be removed from the users environment after a given time by
                   6992: the routine &Apache::lonnet::transfer_profile_to_env.
                   6993: 
                   6994: =cut
                   6995: 
                   6996: ############################################################
                   6997: ############################################################
1.152     albertel 6998: my $uniq=0;
1.136     matthew  6999: sub get_cgi_id {
1.154     albertel 7000:     $uniq=($uniq+1)%100000;
1.280     albertel 7001:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  7002: }
                   7003: 
1.127     matthew  7004: ############################################################
                   7005: ############################################################
                   7006: 
                   7007: =pod
                   7008: 
1.134     matthew  7009: =item DrawBarGraph
1.127     matthew  7010: 
1.138     matthew  7011: Facilitates the plotting of data in a (stacked) bar graph.
                   7012: Puts plot definition data into the users environment in order for 
                   7013: graph.png to plot it.  Returns an <img> tag for the plot.
                   7014: The bars on the plot are labeled '1','2',...,'n'.
                   7015: 
                   7016: Inputs:
                   7017: 
                   7018: =over 4
                   7019: 
                   7020: =item $Title: string, the title of the plot
                   7021: 
                   7022: =item $xlabel: string, text describing the X-axis of the plot
                   7023: 
                   7024: =item $ylabel: string, text describing the Y-axis of the plot
                   7025: 
                   7026: =item $Max: scalar, the maximum Y value to use in the plot
                   7027: If $Max is < any data point, the graph will not be rendered.
                   7028: 
1.140     matthew  7029: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  7030: they are plotted.  If undefined, default values will be used.
                   7031: 
1.178     matthew  7032: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   7033: 
1.138     matthew  7034: =item @Values: An array of array references.  Each array reference holds data
                   7035: to be plotted in a stacked bar chart.
                   7036: 
1.239     matthew  7037: =item If the final element of @Values is a hash reference the key/value
                   7038: pairs will be added to the graph definition.
                   7039: 
1.138     matthew  7040: =back
                   7041: 
                   7042: Returns:
                   7043: 
                   7044: An <img> tag which references graph.png and the appropriate identifying
                   7045: information for the plot.
                   7046: 
1.127     matthew  7047: =cut
                   7048: 
                   7049: ############################################################
                   7050: ############################################################
1.134     matthew  7051: sub DrawBarGraph {
1.178     matthew  7052:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  7053:     #
                   7054:     if (! defined($colors)) {
                   7055:         $colors = ['#33ff00', 
                   7056:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   7057:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   7058:                   ]; 
                   7059:     }
1.228     matthew  7060:     my $extra_settings = {};
                   7061:     if (ref($Values[-1]) eq 'HASH') {
                   7062:         $extra_settings = pop(@Values);
                   7063:     }
1.127     matthew  7064:     #
1.136     matthew  7065:     my $identifier = &get_cgi_id();
                   7066:     my $id = 'cgi.'.$identifier;        
1.129     matthew  7067:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  7068:         return '';
                   7069:     }
1.225     matthew  7070:     #
                   7071:     my @Labels;
                   7072:     if (defined($labels)) {
                   7073:         @Labels = @$labels;
                   7074:     } else {
                   7075:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   7076:             push (@Labels,$i+1);
                   7077:         }
                   7078:     }
                   7079:     #
1.129     matthew  7080:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  7081:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  7082:     my %ValuesHash;
                   7083:     my $NumSets=1;
                   7084:     foreach my $array (@Values) {
                   7085:         next if (! ref($array));
1.136     matthew  7086:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  7087:             join(',',@$array);
1.129     matthew  7088:     }
1.127     matthew  7089:     #
1.136     matthew  7090:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  7091:     if ($NumBars < 3) {
                   7092:         $width = 120+$NumBars*32;
1.220     matthew  7093:         $xskip = 1;
1.225     matthew  7094:         $bar_width = 30;
                   7095:     } elsif ($NumBars < 5) {
                   7096:         $width = 120+$NumBars*20;
                   7097:         $xskip = 1;
                   7098:         $bar_width = 20;
1.220     matthew  7099:     } elsif ($NumBars < 10) {
1.136     matthew  7100:         $width = 120+$NumBars*15;
                   7101:         $xskip = 1;
                   7102:         $bar_width = 15;
                   7103:     } elsif ($NumBars <= 25) {
                   7104:         $width = 120+$NumBars*11;
                   7105:         $xskip = 5;
                   7106:         $bar_width = 8;
                   7107:     } elsif ($NumBars <= 50) {
                   7108:         $width = 120+$NumBars*8;
                   7109:         $xskip = 5;
                   7110:         $bar_width = 4;
                   7111:     } else {
                   7112:         $width = 120+$NumBars*8;
                   7113:         $xskip = 5;
                   7114:         $bar_width = 4;
                   7115:     }
                   7116:     #
1.137     matthew  7117:     $Max = 1 if ($Max < 1);
                   7118:     if ( int($Max) < $Max ) {
                   7119:         $Max++;
                   7120:         $Max = int($Max);
                   7121:     }
1.127     matthew  7122:     $Title  = '' if (! defined($Title));
                   7123:     $xlabel = '' if (! defined($xlabel));
                   7124:     $ylabel = '' if (! defined($ylabel));
1.369     www      7125:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   7126:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   7127:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  7128:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  7129:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   7130:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   7131:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   7132:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   7133:     $ValuesHash{$id.'.height'}   = $height;
                   7134:     $ValuesHash{$id.'.width'}    = $width;
                   7135:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   7136:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   7137:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  7138:     #
1.228     matthew  7139:     # Deal with other parameters
                   7140:     while (my ($key,$value) = each(%$extra_settings)) {
                   7141:         $ValuesHash{$id.'.'.$key} = $value;
                   7142:     }
                   7143:     #
1.137     matthew  7144:     &Apache::lonnet::appenv(%ValuesHash);
                   7145:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   7146: }
                   7147: 
                   7148: ############################################################
                   7149: ############################################################
                   7150: 
                   7151: =pod
                   7152: 
                   7153: =item DrawXYGraph
                   7154: 
1.138     matthew  7155: Facilitates the plotting of data in an XY graph.
                   7156: Puts plot definition data into the users environment in order for 
                   7157: graph.png to plot it.  Returns an <img> tag for the plot.
                   7158: 
                   7159: Inputs:
                   7160: 
                   7161: =over 4
                   7162: 
                   7163: =item $Title: string, the title of the plot
                   7164: 
                   7165: =item $xlabel: string, text describing the X-axis of the plot
                   7166: 
                   7167: =item $ylabel: string, text describing the Y-axis of the plot
                   7168: 
                   7169: =item $Max: scalar, the maximum Y value to use in the plot
                   7170: If $Max is < any data point, the graph will not be rendered.
                   7171: 
                   7172: =item $colors: Array ref containing the hex color codes for the data to be 
                   7173: plotted in.  If undefined, default values will be used.
                   7174: 
                   7175: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   7176: 
                   7177: =item $Ydata: Array ref containing Array refs.  
1.185     www      7178: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  7179: 
                   7180: =item %Values: hash indicating or overriding any default values which are 
                   7181: passed to graph.png.  
                   7182: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   7183: 
                   7184: =back
                   7185: 
                   7186: Returns:
                   7187: 
                   7188: An <img> tag which references graph.png and the appropriate identifying
                   7189: information for the plot.
                   7190: 
1.137     matthew  7191: =cut
                   7192: 
                   7193: ############################################################
                   7194: ############################################################
                   7195: sub DrawXYGraph {
                   7196:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   7197:     #
                   7198:     # Create the identifier for the graph
                   7199:     my $identifier = &get_cgi_id();
                   7200:     my $id = 'cgi.'.$identifier;
                   7201:     #
                   7202:     $Title  = '' if (! defined($Title));
                   7203:     $xlabel = '' if (! defined($xlabel));
                   7204:     $ylabel = '' if (! defined($ylabel));
                   7205:     my %ValuesHash = 
                   7206:         (
1.369     www      7207:          $id.'.title'  => &escape($Title),
                   7208:          $id.'.xlabel' => &escape($xlabel),
                   7209:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  7210:          $id.'.y_max_value'=> $Max,
                   7211:          $id.'.labels'     => join(',',@$Xlabels),
                   7212:          $id.'.PlotType'   => 'XY',
                   7213:          );
                   7214:     #
                   7215:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   7216:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   7217:     }
                   7218:     #
                   7219:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   7220:         return '';
                   7221:     }
                   7222:     my $NumSets=1;
1.138     matthew  7223:     foreach my $array (@{$Ydata}){
1.137     matthew  7224:         next if (! ref($array));
                   7225:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   7226:     }
1.138     matthew  7227:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  7228:     #
                   7229:     # Deal with other parameters
                   7230:     while (my ($key,$value) = each(%Values)) {
                   7231:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  7232:     }
                   7233:     #
1.136     matthew  7234:     &Apache::lonnet::appenv(%ValuesHash);
                   7235:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   7236: }
                   7237: 
                   7238: ############################################################
                   7239: ############################################################
                   7240: 
                   7241: =pod
                   7242: 
1.138     matthew  7243: =item DrawXYYGraph
                   7244: 
                   7245: Facilitates the plotting of data in an XY graph with two Y axes.
                   7246: Puts plot definition data into the users environment in order for 
                   7247: graph.png to plot it.  Returns an <img> tag for the plot.
                   7248: 
                   7249: Inputs:
                   7250: 
                   7251: =over 4
                   7252: 
                   7253: =item $Title: string, the title of the plot
                   7254: 
                   7255: =item $xlabel: string, text describing the X-axis of the plot
                   7256: 
                   7257: =item $ylabel: string, text describing the Y-axis of the plot
                   7258: 
                   7259: =item $colors: Array ref containing the hex color codes for the data to be 
                   7260: plotted in.  If undefined, default values will be used.
                   7261: 
                   7262: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   7263: 
                   7264: =item $Ydata1: The first data set
                   7265: 
                   7266: =item $Min1: The minimum value of the left Y-axis
                   7267: 
                   7268: =item $Max1: The maximum value of the left Y-axis
                   7269: 
                   7270: =item $Ydata2: The second data set
                   7271: 
                   7272: =item $Min2: The minimum value of the right Y-axis
                   7273: 
                   7274: =item $Max2: The maximum value of the left Y-axis
                   7275: 
                   7276: =item %Values: hash indicating or overriding any default values which are 
                   7277: passed to graph.png.  
                   7278: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   7279: 
                   7280: =back
                   7281: 
                   7282: Returns:
                   7283: 
                   7284: An <img> tag which references graph.png and the appropriate identifying
                   7285: information for the plot.
1.136     matthew  7286: 
                   7287: =cut
                   7288: 
                   7289: ############################################################
                   7290: ############################################################
1.137     matthew  7291: sub DrawXYYGraph {
                   7292:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   7293:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  7294:     #
                   7295:     # Create the identifier for the graph
                   7296:     my $identifier = &get_cgi_id();
                   7297:     my $id = 'cgi.'.$identifier;
                   7298:     #
                   7299:     $Title  = '' if (! defined($Title));
                   7300:     $xlabel = '' if (! defined($xlabel));
                   7301:     $ylabel = '' if (! defined($ylabel));
                   7302:     my %ValuesHash = 
                   7303:         (
1.369     www      7304:          $id.'.title'  => &escape($Title),
                   7305:          $id.'.xlabel' => &escape($xlabel),
                   7306:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  7307:          $id.'.labels' => join(',',@$Xlabels),
                   7308:          $id.'.PlotType' => 'XY',
                   7309:          $id.'.NumSets' => 2,
1.137     matthew  7310:          $id.'.two_axes' => 1,
                   7311:          $id.'.y1_max_value' => $Max1,
                   7312:          $id.'.y1_min_value' => $Min1,
                   7313:          $id.'.y2_max_value' => $Max2,
                   7314:          $id.'.y2_min_value' => $Min2,
1.136     matthew  7315:          );
                   7316:     #
1.137     matthew  7317:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   7318:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   7319:     }
                   7320:     #
                   7321:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   7322:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  7323:         return '';
                   7324:     }
                   7325:     my $NumSets=1;
1.137     matthew  7326:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  7327:         next if (! ref($array));
                   7328:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  7329:     }
                   7330:     #
                   7331:     # Deal with other parameters
                   7332:     while (my ($key,$value) = each(%Values)) {
                   7333:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  7334:     }
                   7335:     #
                   7336:     &Apache::lonnet::appenv(%ValuesHash);
1.130     albertel 7337:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  7338: }
                   7339: 
                   7340: ############################################################
                   7341: ############################################################
                   7342: 
                   7343: =pod
                   7344: 
1.157     matthew  7345: =back 
                   7346: 
1.139     matthew  7347: =head1 Statistics helper routines?  
                   7348: 
                   7349: Bad place for them but what the hell.
                   7350: 
1.157     matthew  7351: =over 4
                   7352: 
1.139     matthew  7353: =item &chartlink
                   7354: 
                   7355: Returns a link to the chart for a specific student.  
                   7356: 
                   7357: Inputs:
                   7358: 
                   7359: =over 4
                   7360: 
                   7361: =item $linktext: The text of the link
                   7362: 
                   7363: =item $sname: The students username
                   7364: 
                   7365: =item $sdomain: The students domain
                   7366: 
                   7367: =back
                   7368: 
1.157     matthew  7369: =back
                   7370: 
1.139     matthew  7371: =cut
                   7372: 
                   7373: ############################################################
                   7374: ############################################################
                   7375: sub chartlink {
                   7376:     my ($linktext, $sname, $sdomain) = @_;
                   7377:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      7378:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 7379:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  7380:        '">'.$linktext.'</a>';
1.153     matthew  7381: }
                   7382: 
                   7383: #######################################################
                   7384: #######################################################
                   7385: 
                   7386: =pod
                   7387: 
                   7388: =head1 Course Environment Routines
1.157     matthew  7389: 
                   7390: =over 4
1.153     matthew  7391: 
                   7392: =item &restore_course_settings 
                   7393: 
                   7394: =item &store_course_settings
                   7395: 
                   7396: Restores/Store indicated form parameters from the course environment.
                   7397: Will not overwrite existing values of the form parameters.
                   7398: 
                   7399: Inputs: 
                   7400: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   7401: 
                   7402: a hash ref describing the data to be stored.  For example:
                   7403:    
                   7404: %Save_Parameters = ('Status' => 'scalar',
                   7405:     'chartoutputmode' => 'scalar',
                   7406:     'chartoutputdata' => 'scalar',
                   7407:     'Section' => 'array',
1.373     raeburn  7408:     'Group' => 'array',
1.153     matthew  7409:     'StudentData' => 'array',
                   7410:     'Maps' => 'array');
                   7411: 
                   7412: Returns: both routines return nothing
                   7413: 
                   7414: =cut
                   7415: 
                   7416: #######################################################
                   7417: #######################################################
                   7418: sub store_course_settings {
1.496     albertel 7419:     return &store_settings($env{'request.course.id'},@_);
                   7420: }
                   7421: 
                   7422: sub store_settings {
1.153     matthew  7423:     # save to the environment
                   7424:     # appenv the same items, just to be safe
1.300     albertel 7425:     my $udom  = $env{'user.domain'};
                   7426:     my $uname = $env{'user.name'};
1.496     albertel 7427:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  7428:     my %SaveHash;
                   7429:     my %AppHash;
                   7430:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 7431:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 7432:         my $envname = 'environment.'.$basename;
1.258     albertel 7433:         if (exists($env{'form.'.$setting})) {
1.153     matthew  7434:             # Save this value away
                   7435:             if ($type eq 'scalar' &&
1.258     albertel 7436:                 (! exists($env{$envname}) || 
                   7437:                  $env{$envname} ne $env{'form.'.$setting})) {
                   7438:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   7439:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  7440:             } elsif ($type eq 'array') {
                   7441:                 my $stored_form;
1.258     albertel 7442:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  7443:                     $stored_form = join(',',
                   7444:                                         map {
1.369     www      7445:                                             &escape($_);
1.258     albertel 7446:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  7447:                 } else {
                   7448:                     $stored_form = 
1.369     www      7449:                         &escape($env{'form.'.$setting});
1.153     matthew  7450:                 }
                   7451:                 # Determine if the array contents are the same.
1.258     albertel 7452:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  7453:                     $SaveHash{$basename} = $stored_form;
                   7454:                     $AppHash{$envname}   = $stored_form;
                   7455:                 }
                   7456:             }
                   7457:         }
                   7458:     }
                   7459:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 7460:                                           $udom,$uname);
1.153     matthew  7461:     if ($put_result !~ /^(ok|delayed)/) {
                   7462:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   7463:                                  'got error:'.$put_result);
                   7464:     }
                   7465:     # Make sure these settings stick around in this session, too
                   7466:     &Apache::lonnet::appenv(%AppHash);
                   7467:     return;
                   7468: }
                   7469: 
                   7470: sub restore_course_settings {
1.499     albertel 7471:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 7472: }
                   7473: 
                   7474: sub restore_settings {
                   7475:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  7476:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 7477:         next if (exists($env{'form.'.$setting}));
1.496     albertel 7478:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  7479:             '.'.$setting;
1.258     albertel 7480:         if (exists($env{$envname})) {
1.153     matthew  7481:             if ($type eq 'scalar') {
1.258     albertel 7482:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  7483:             } elsif ($type eq 'array') {
1.258     albertel 7484:                 $env{'form.'.$setting} = [ 
1.153     matthew  7485:                                            map { 
1.369     www      7486:                                                &unescape($_); 
1.258     albertel 7487:                                            } split(',',$env{$envname})
1.153     matthew  7488:                                            ];
                   7489:             }
                   7490:         }
                   7491:     }
1.127     matthew  7492: }
                   7493: 
                   7494: ############################################################
                   7495: ############################################################
1.154     albertel 7496: 
1.443     albertel 7497: sub commit_customrole {
                   7498:     my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
                   7499:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
                   7500:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   7501:                          ($end?', ending '.localtime($end):'').': <b>'.
                   7502:               &Apache::lonnet::assigncustomrole(
                   7503:                  $udom,$uname,$url,$three,$four,$five,$end,$start).
                   7504:                  '</b><br />';
                   7505:     return $output;
                   7506: }
                   7507: 
                   7508: sub commit_standardrole {
1.541     raeburn  7509:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   7510:     my ($output,$logmsg,$linefeed);
                   7511:     if ($context eq 'auto') {
                   7512:         $linefeed = "\n";
                   7513:     } else {
                   7514:         $linefeed = "<br />\n";
                   7515:     }  
1.443     albertel 7516:     if ($three eq 'st') {
1.541     raeburn  7517:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   7518:                                          $one,$two,$sec,$context);
                   7519:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
                   7520:             ($result eq 'unknown_course')) {
1.443     albertel 7521:             $output = "Error: $result\n"; 
                   7522:         } else {
1.541     raeburn  7523:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 7524:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  7525:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   7526:             if ($context eq 'auto') {
                   7527:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   7528:             } else {
                   7529:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   7530:                &mt('Add to classlist').': <b>ok</b>';
                   7531:             }
                   7532:             $output .= $linefeed;
1.443     albertel 7533:         }
                   7534:     } else {
                   7535:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   7536:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  7537:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   7538:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);
                   7539:         if ($context eq 'auto') {
                   7540:             $output .= $result.$linefeed;
                   7541:         } else {
                   7542:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   7543:         }
1.443     albertel 7544:     }
                   7545:     return $output;
                   7546: }
                   7547: 
                   7548: sub commit_studentrole {
1.541     raeburn  7549:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   7550:     my ($result,$linefeed);
                   7551:     if ($context eq 'auto') {
                   7552:         $linefeed = "\n";
                   7553:     } else {
                   7554:         $linefeed = '<br />'."\n";
                   7555:     }
1.443     albertel 7556:     if (defined($one) && defined($two)) {
                   7557:         my $cid=$one.'_'.$two;
                   7558:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   7559:         my $secchange = 0;
                   7560:         my $expire_role_result;
                   7561:         my $modify_section_result;
                   7562:         unless ($oldsec eq '-1') {
                   7563:             unless ($sec eq $oldsec) {
                   7564:                 $secchange = 1;
                   7565:                 my $uurl='/'.$cid;
                   7566:                 $uurl=~s/\_/\//g;
                   7567:                 if ($oldsec) {
                   7568:                     $uurl.='/'.$oldsec;
                   7569:                 }
                   7570:                 $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);
                   7571:                 $result = $expire_role_result;
                   7572:             }
                   7573:         }
                   7574:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
                   7575:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
                   7576:             if ($modify_section_result =~ /^ok/) {
                   7577:                 if ($secchange == 1) {
                   7578:                     $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;
                   7579:                 } elsif ($oldsec eq '-1') {
                   7580:                     $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;
                   7581:                 } else {
                   7582:                     $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;
                   7583:                 }
                   7584:             } else {
                   7585:                 $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;
                   7586:             }
                   7587:             $result = $modify_section_result;
                   7588:         } elsif ($secchange == 1) {
                   7589:             $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;
                   7590:         }
                   7591:     } else {
                   7592:         $$logmsg .= "Incomplete course id defined.  Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";
                   7593:         $result = "error: incomplete course id\n";
                   7594:     }
                   7595:     return $result;
                   7596: }
                   7597: 
                   7598: ############################################################
                   7599: ############################################################
                   7600: 
1.566     albertel 7601: sub check_clone {
1.578     raeburn  7602:     my ($args,$linefeed) = @_;
1.566     albertel 7603:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   7604:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   7605:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   7606:     my $clonemsg;
                   7607:     my $can_clone = 0;
                   7608: 
                   7609:     if ($clonehome eq 'no_host') {
1.578     raeburn  7610:         $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 7611:     } else {
                   7612: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568     albertel 7613: 	if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566     albertel 7614: 	    $can_clone = 1;
                   7615: 	} else {
                   7616: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   7617: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   7618: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  7619:             if (grep(/^\*$/,@cloners)) {
                   7620:                 $can_clone = 1;
                   7621:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   7622:                 $can_clone = 1;
                   7623:             } else {
                   7624: 	        my %roleshash =
                   7625: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   7626: 					 $args->{'ccdomain'},
                   7627:                                          'userroles',['active'],['cc'],
                   7628: 					 [$args->{'clonedomain'}]);
                   7629: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
                   7630: 		    $can_clone = 1;
                   7631: 	        } else {
                   7632:                     $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'});
                   7633: 	        }
1.566     albertel 7634: 	    }
1.578     raeburn  7635:         }
1.566     albertel 7636:     }
                   7637:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   7638: }
                   7639: 
1.444     albertel 7640: sub construct_course {
1.541     raeburn  7641:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444     albertel 7642:     my $outcome;
1.541     raeburn  7643:     my $linefeed =  '<br />'."\n";
                   7644:     if ($context eq 'auto') {
                   7645:         $linefeed = "\n";
                   7646:     }
1.566     albertel 7647: 
                   7648: #
                   7649: # Are we cloning?
                   7650: #
                   7651:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   7652:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  7653: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 7654: 	if ($context ne 'auto') {
1.578     raeburn  7655:             if ($clonemsg ne '') {
                   7656: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   7657:             }
1.566     albertel 7658: 	}
                   7659: 	$outcome .= $clonemsg.$linefeed;
                   7660: 
                   7661:         if (!$can_clone) {
                   7662: 	    return (0,$outcome);
                   7663: 	}
                   7664:     }
                   7665: 
1.444     albertel 7666: #
                   7667: # Open course
                   7668: #
                   7669:     my $crstype = lc($args->{'crstype'});
                   7670:     my %cenv=();
                   7671:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   7672:                                              $args->{'cdescr'},
                   7673:                                              $args->{'curl'},
                   7674:                                              $args->{'course_home'},
                   7675:                                              $args->{'nonstandard'},
                   7676:                                              $args->{'crscode'},
                   7677:                                              $args->{'ccuname'}.':'.
                   7678:                                              $args->{'ccdomain'},
                   7679:                                              $args->{'crstype'});
                   7680: 
                   7681:     # Note: The testing routines depend on this being output; see 
                   7682:     # Utils::Course. This needs to at least be output as a comment
                   7683:     # if anyone ever decides to not show this, and Utils::Course::new
                   7684:     # will need to be suitably modified.
1.541     raeburn  7685:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444     albertel 7686: #
                   7687: # Check if created correctly
                   7688: #
1.479     albertel 7689:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 7690:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541     raeburn  7691:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 7692: 
1.444     albertel 7693: #
1.566     albertel 7694: # Do the cloning
                   7695: #   
                   7696:     if ($can_clone && $cloneid) {
                   7697: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   7698: 	if ($context ne 'auto') {
                   7699: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   7700: 	}
                   7701: 	$outcome .= $clonemsg.$linefeed;
                   7702: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 7703: # Copy all files
1.566     albertel 7704: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
1.444     albertel 7705: # Restore URL
1.566     albertel 7706: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 7707: # Restore title
1.566     albertel 7708: 	$cenv{'description'}=$oldcenv{'description'};
1.444     albertel 7709: # restore grading mode
1.566     albertel 7710: 	if (defined($oldcenv{'grading'})) {
                   7711: 	    $cenv{'grading'}=$oldcenv{'grading'};
                   7712: 	}
1.444     albertel 7713: # Mark as cloned
1.566     albertel 7714: 	$cenv{'clonedfrom'}=$cloneid;
                   7715: 	delete($cenv{'default_enrollment_start_date'});
                   7716: 	delete($cenv{'default_enrollment_end_date'});
1.444     albertel 7717:     }
1.566     albertel 7718: 
1.444     albertel 7719: #
                   7720: # Set environment (will override cloned, if existing)
                   7721: #
                   7722:     my @sections = ();
                   7723:     my @xlists = ();
                   7724:     if ($args->{'crstype'}) {
                   7725:         $cenv{'type'}=$args->{'crstype'};
                   7726:     }
                   7727:     if ($args->{'crsid'}) {
                   7728:         $cenv{'courseid'}=$args->{'crsid'};
                   7729:     }
                   7730:     if ($args->{'crscode'}) {
                   7731:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   7732:     }
                   7733:     if ($args->{'crsquota'} ne '') {
                   7734:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   7735:     } else {
                   7736:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   7737:     }
                   7738:     if ($args->{'ccuname'}) {
                   7739:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   7740:                                         ':'.$args->{'ccdomain'};
                   7741:     } else {
                   7742:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   7743:     }
                   7744: 
                   7745:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   7746:     if ($args->{'crssections'}) {
                   7747:         $cenv{'internal.sectionnums'} = '';
                   7748:         if ($args->{'crssections'} =~ m/,/) {
                   7749:             @sections = split/,/,$args->{'crssections'};
                   7750:         } else {
                   7751:             $sections[0] = $args->{'crssections'};
                   7752:         }
                   7753:         if (@sections > 0) {
                   7754:             foreach my $item (@sections) {
                   7755:                 my ($sec,$gp) = split/:/,$item;
                   7756:                 my $class = $args->{'crscode'}.$sec;
                   7757:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   7758:                 $cenv{'internal.sectionnums'} .= $item.',';
                   7759:                 unless ($addcheck eq 'ok') {
                   7760:                     push @badclasses, $class;
                   7761:                 }
                   7762:             }
                   7763:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   7764:         }
                   7765:     }
                   7766: # do not hide course coordinator from staff listing, 
                   7767: # even if privileged
                   7768:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   7769: # add crosslistings
                   7770:     if ($args->{'crsxlist'}) {
                   7771:         $cenv{'internal.crosslistings'}='';
                   7772:         if ($args->{'crsxlist'} =~ m/,/) {
                   7773:             @xlists = split/,/,$args->{'crsxlist'};
                   7774:         } else {
                   7775:             $xlists[0] = $args->{'crsxlist'};
                   7776:         }
                   7777:         if (@xlists > 0) {
                   7778:             foreach my $item (@xlists) {
                   7779:                 my ($xl,$gp) = split/:/,$item;
                   7780:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   7781:                 $cenv{'internal.crosslistings'} .= $item.',';
                   7782:                 unless ($addcheck eq 'ok') {
                   7783:                     push @badclasses, $xl;
                   7784:                 }
                   7785:             }
                   7786:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   7787:         }
                   7788:     }
                   7789:     if ($args->{'autoadds'}) {
                   7790:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   7791:     }
                   7792:     if ($args->{'autodrops'}) {
                   7793:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   7794:     }
                   7795: # check for notification of enrollment changes
                   7796:     my @notified = ();
                   7797:     if ($args->{'notify_owner'}) {
                   7798:         if ($args->{'ccuname'} ne '') {
                   7799:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   7800:         }
                   7801:     }
                   7802:     if ($args->{'notify_dc'}) {
                   7803:         if ($uname ne '') { 
                   7804:             push(@notified,$uname.'@'.$udom);
                   7805:         }
                   7806:     }
                   7807:     if (@notified > 0) {
                   7808:         my $notifylist;
                   7809:         if (@notified > 1) {
                   7810:             $notifylist = join(',',@notified);
                   7811:         } else {
                   7812:             $notifylist = $notified[0];
                   7813:         }
                   7814:         $cenv{'internal.notifylist'} = $notifylist;
                   7815:     }
                   7816:     if (@badclasses > 0) {
                   7817:         my %lt=&Apache::lonlocal::texthash(
                   7818:                 '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',
                   7819:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   7820:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   7821:         );
1.541     raeburn  7822:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   7823:                            ' ('.$lt{'adby'}.')';
                   7824:         if ($context eq 'auto') {
                   7825:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 7826:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  7827:             foreach my $item (@badclasses) {
                   7828:                 if ($context eq 'auto') {
                   7829:                     $outcome .= " - $item\n";
                   7830:                 } else {
                   7831:                     $outcome .= "<li>$item</li>\n";
                   7832:                 }
                   7833:             }
                   7834:             if ($context eq 'auto') {
                   7835:                 $outcome .= $linefeed;
                   7836:             } else {
1.566     albertel 7837:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  7838:             }
                   7839:         } 
1.444     albertel 7840:     }
                   7841:     if ($args->{'no_end_date'}) {
                   7842:         $args->{'endaccess'} = 0;
                   7843:     }
                   7844:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   7845:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   7846:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   7847:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   7848:     if ($args->{'showphotos'}) {
                   7849:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   7850:     }
                   7851:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   7852:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   7853:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   7854:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  7855:             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'); 
                   7856:             if ($context eq 'auto') {
                   7857:                 $outcome .= $krb_msg;
                   7858:             } else {
1.566     albertel 7859:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  7860:             }
                   7861:             $outcome .= $linefeed;
1.444     albertel 7862:         }
                   7863:     }
                   7864:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   7865:        if ($args->{'setpolicy'}) {
                   7866:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   7867:        }
                   7868:        if ($args->{'setcontent'}) {
                   7869:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   7870:        }
                   7871:     }
                   7872:     if ($args->{'reshome'}) {
                   7873: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   7874: 	$cenv{'reshome'}=~s/\/+$/\//;
                   7875:     }
                   7876: #
                   7877: # course has keyed access
                   7878: #
                   7879:     if ($args->{'setkeys'}) {
                   7880:        $cenv{'keyaccess'}='yes';
                   7881:     }
                   7882: # if specified, key authority is not course, but user
                   7883: # only active if keyaccess is yes
                   7884:     if ($args->{'keyauth'}) {
1.487     albertel 7885: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   7886: 	$user = &LONCAPA::clean_username($user);
                   7887: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     7888: 	if ($user ne '' && $domain ne '') {
1.487     albertel 7889: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 7890: 	}
                   7891:     }
                   7892: 
                   7893:     if ($args->{'disresdis'}) {
                   7894:         $cenv{'pch.roles.denied'}='st';
                   7895:     }
                   7896:     if ($args->{'disablechat'}) {
                   7897:         $cenv{'plc.roles.denied'}='st';
                   7898:     }
                   7899: 
                   7900:     # Record we've not yet viewed the Course Initialization Helper for this 
                   7901:     # course
                   7902:     $cenv{'course.helper.not.run'} = 1;
                   7903:     #
                   7904:     # Use new Randomseed
                   7905:     #
                   7906:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   7907:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   7908:     #
                   7909:     # The encryption code and receipt prefix for this course
                   7910:     #
                   7911:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   7912:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   7913:     #
                   7914:     # By default, use standard grading
                   7915:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   7916: 
1.541     raeburn  7917:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   7918:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 7919: #
                   7920: # Open all assignments
                   7921: #
                   7922:     if ($args->{'openall'}) {
                   7923:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   7924:        my %storecontent = ($storeunder         => time,
                   7925:                            $storeunder.'.type' => 'date_start');
                   7926:        
                   7927:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  7928:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 7929:    }
                   7930: #
                   7931: # Set first page
                   7932: #
                   7933:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   7934: 	    || ($cloneid)) {
1.445     albertel 7935: 	use LONCAPA::map;
1.444     albertel 7936: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 7937: 
                   7938: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   7939:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   7940: 
1.444     albertel 7941:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   7942:         my $title; my $url;
                   7943:         if ($args->{'firstres'} eq 'syl') {
                   7944: 	    $title='Syllabus';
                   7945:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   7946:         } else {
                   7947:             $title='Navigate Contents';
                   7948:             $url='/adm/navmaps';
                   7949:         }
1.445     albertel 7950: 
                   7951:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   7952: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   7953: 
                   7954: 	if ($errtext) { $fatal=2; }
1.541     raeburn  7955:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 7956:     }
1.566     albertel 7957: 
                   7958:     return (1,$outcome);
1.444     albertel 7959: }
                   7960: 
                   7961: ############################################################
                   7962: ############################################################
                   7963: 
1.378     raeburn  7964: sub course_type {
                   7965:     my ($cid) = @_;
                   7966:     if (!defined($cid)) {
                   7967:         $cid = $env{'request.course.id'};
                   7968:     }
1.404     albertel 7969:     if (defined($env{'course.'.$cid.'.type'})) {
                   7970:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  7971:     } else {
                   7972:         return 'Course';
1.377     raeburn  7973:     }
                   7974: }
1.156     albertel 7975: 
1.406     raeburn  7976: sub group_term {
                   7977:     my $crstype = &course_type();
                   7978:     my %names = (
                   7979:                   'Course' => 'group',
                   7980:                   'Group' => 'team',
                   7981:                 );
                   7982:     return $names{$crstype};
                   7983: }
                   7984: 
1.156     albertel 7985: sub icon {
                   7986:     my ($file)=@_;
1.505     albertel 7987:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 7988:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 7989:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 7990:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   7991: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   7992: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   7993: 	            $curfext.".gif") {
                   7994: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   7995: 		$curfext.".gif";
                   7996: 	}
                   7997:     }
1.249     albertel 7998:     return &lonhttpdurl($iconname);
1.154     albertel 7999: } 
1.84      albertel 8000: 
1.575     albertel 8001: sub lonhttpd_port {
1.215     albertel 8002:     my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
                   8003:     if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
1.574     albertel 8004:     # IE doesn't like a secure page getting images from a non-secure
                   8005:     # port (when logging we haven't parsed the browser type so default
                   8006:     # back to secure
                   8007:     if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
                   8008: 	&& $ENV{'SERVER_PORT'} == 443) {
1.575     albertel 8009: 	return 443;
                   8010:     }
                   8011:     return $lonhttpd_port;
                   8012: 
                   8013: }
                   8014: 
                   8015: sub lonhttpdurl {
                   8016:     my ($url)=@_;
                   8017: 
                   8018:     my $lonhttpd_port = &lonhttpd_port();
                   8019:     if ($lonhttpd_port == 443) {
1.574     albertel 8020: 	return 'https://'.$ENV{'SERVER_NAME'}.$url;
                   8021:     }
1.215     albertel 8022:     return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
                   8023: }
                   8024: 
1.213     albertel 8025: sub connection_aborted {
                   8026:     my ($r)=@_;
                   8027:     $r->print(" ");$r->rflush();
                   8028:     my $c = $r->connection;
                   8029:     return $c->aborted();
                   8030: }
                   8031: 
1.221     foxr     8032: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     8033: #    strings as 'strings'.
                   8034: sub escape_single {
1.221     foxr     8035:     my ($input) = @_;
1.223     albertel 8036:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     8037:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   8038:     return $input;
                   8039: }
1.223     albertel 8040: 
1.222     foxr     8041: #  Same as escape_single, but escape's "'s  This 
                   8042: #  can be used for  "strings"
                   8043: sub escape_double {
                   8044:     my ($input) = @_;
                   8045:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   8046:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   8047:     return $input;
                   8048: }
1.223     albertel 8049:  
1.222     foxr     8050: #   Escapes the last element of a full URL.
                   8051: sub escape_url {
                   8052:     my ($url)   = @_;
1.238     raeburn  8053:     my @urlslices = split(/\//, $url,-1);
1.369     www      8054:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 8055:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     8056: }
1.462     albertel 8057: 
                   8058: # -------------------------------------------------------- Initliaze user login
                   8059: sub init_user_environment {
1.463     albertel 8060:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 8061:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   8062: 
                   8063:     my $public=($username eq 'public' && $domain eq 'public');
                   8064: 
                   8065: # See if old ID present, if so, remove
                   8066: 
                   8067:     my ($filename,$cookie,$userroles);
                   8068:     my $now=time;
                   8069: 
                   8070:     if ($public) {
                   8071: 	my $max_public=100;
                   8072: 	my $oldest;
                   8073: 	my $oldest_time=0;
                   8074: 	for(my $next=1;$next<=$max_public;$next++) {
                   8075: 	    if (-e $lonids."/publicuser_$next.id") {
                   8076: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   8077: 		if ($mtime<$oldest_time || !$oldest_time) {
                   8078: 		    $oldest_time=$mtime;
                   8079: 		    $oldest=$next;
                   8080: 		}
                   8081: 	    } else {
                   8082: 		$cookie="publicuser_$next";
                   8083: 		last;
                   8084: 	    }
                   8085: 	}
                   8086: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   8087:     } else {
1.463     albertel 8088: 	# if this isn't a robot, kill any existing non-robot sessions
                   8089: 	if (!$args->{'robot'}) {
                   8090: 	    opendir(DIR,$lonids);
                   8091: 	    while ($filename=readdir(DIR)) {
                   8092: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   8093: 		    unlink($lonids.'/'.$filename);
                   8094: 		}
1.462     albertel 8095: 	    }
1.463     albertel 8096: 	    closedir(DIR);
1.462     albertel 8097: 	}
                   8098: # Give them a new cookie
1.463     albertel 8099: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
                   8100: 		                   : $now);
                   8101: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 8102:     
                   8103: # Initialize roles
                   8104: 
                   8105: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   8106:     }
                   8107: # ------------------------------------ Check browser type and MathML capability
                   8108: 
                   8109:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   8110:         $clientunicode,$clientos) = &decode_user_agent($r);
                   8111: 
                   8112: # -------------------------------------- Any accessibility options to remember?
                   8113:     if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
                   8114: 	foreach my $option ('imagesuppress','appletsuppress',
                   8115: 			    'embedsuppress','fontenhance','blackwhite') {
                   8116: 	    if ($form->{$option} eq 'true') {
                   8117: 		&Apache::lonnet::put('environment',{$option => 'on'},
                   8118: 				     $domain,$username);
                   8119: 	    } else {
                   8120: 		&Apache::lonnet::del('environment',[$option],
                   8121: 				     $domain,$username);
                   8122: 	    }
                   8123: 	}
                   8124:     }
                   8125: # ------------------------------------------------------------- Get environment
                   8126: 
                   8127:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   8128:     my ($tmp) = keys(%userenv);
                   8129:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8130: 	# default remote control to off
                   8131: 	if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
                   8132:     } else {
                   8133: 	undef(%userenv);
                   8134:     }
                   8135:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   8136: 	$form->{'interface'}=$userenv{'interface'};
                   8137:     }
                   8138:     $env{'environment.remote'}=$userenv{'remote'};
                   8139:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   8140: 
                   8141: # --------------- Do not trust query string to be put directly into environment
                   8142:     foreach my $option ('imagesuppress','appletsuppress',
                   8143: 			'embedsuppress','fontenhance','blackwhite',
                   8144: 			'interface','localpath','localres') {
                   8145: 	$form->{$option}=~s/[\n\r\=]//gs;
                   8146:     }
                   8147: # --------------------------------------------------------- Write first profile
                   8148: 
                   8149:     {
                   8150: 	my %initial_env = 
                   8151: 	    ("user.name"          => $username,
                   8152: 	     "user.domain"        => $domain,
                   8153: 	     "user.home"          => $authhost,
                   8154: 	     "browser.type"       => $clientbrowser,
                   8155: 	     "browser.version"    => $clientversion,
                   8156: 	     "browser.mathml"     => $clientmathml,
                   8157: 	     "browser.unicode"    => $clientunicode,
                   8158: 	     "browser.os"         => $clientos,
                   8159: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   8160: 	     "request.course.fn"  => '',
                   8161: 	     "request.course.uri" => '',
                   8162: 	     "request.course.sec" => '',
                   8163: 	     "request.role"       => 'cm',
                   8164: 	     "request.role.adv"   => $env{'user.adv'},
                   8165: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   8166: 
                   8167:         if ($form->{'localpath'}) {
                   8168: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   8169: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   8170:         }
                   8171: 	
                   8172: 	if ($public) {
                   8173: 	    $initial_env{"environment.remote"} = "off";
                   8174: 	}
                   8175: 	if ($form->{'interface'}) {
                   8176: 	    $form->{'interface'}=~s/\W//gs;
                   8177: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   8178: 	    $env{'browser.interface'}=$form->{'interface'};
                   8179: 	    foreach my $option ('imagesuppress','appletsuppress',
                   8180: 				'embedsuppress','fontenhance','blackwhite') {
                   8181: 		if (($form->{$option} eq 'true') ||
                   8182: 		    ($userenv{$option} eq 'on')) {
                   8183: 		    $initial_env{"browser.$option"} = "on";
                   8184: 		}
                   8185: 	    }
                   8186: 	}
                   8187: 
                   8188: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   8189: 	
                   8190: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   8191: 		 &GDBM_WRCREAT(),0640)) {
                   8192: 	    &_add_to_env(\%disk_env,\%initial_env);
                   8193: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   8194: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 8195: 	    if (ref($args->{'extra_env'})) {
                   8196: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   8197: 	    }
1.462     albertel 8198: 	    untie(%disk_env);
                   8199: 	} else {
                   8200: 	    &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
                   8201: 			   'Could not create environment storage in lonauth: '.$!.'</font>');
                   8202: 	    return 'error: '.$!;
                   8203: 	}
                   8204:     }
                   8205:     $env{'request.role'}='cm';
                   8206:     $env{'request.role.adv'}=$env{'user.adv'};
                   8207:     $env{'browser.type'}=$clientbrowser;
                   8208: 
                   8209:     return $cookie;
                   8210: 
                   8211: }
                   8212: 
                   8213: sub _add_to_env {
                   8214:     my ($idf,$env_data,$prefix) = @_;
                   8215:     while (my ($key,$value) = each(%$env_data)) {
                   8216: 	$idf->{$prefix.$key} = $value;
                   8217: 	$env{$prefix.$key}   = $value;
                   8218:     }
                   8219: }
                   8220: 
                   8221: 
1.41      ng       8222: =pod
                   8223: 
                   8224: =back
                   8225: 
1.112     bowersj2 8226: =cut
1.41      ng       8227: 
1.112     bowersj2 8228: 1;
                   8229: __END__;
1.41      ng       8230: 

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