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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.922   ! bisitz      4: # $Id: loncommon.pm,v 1.921 2009/12/01 18:07:50 bisitz Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.479     albertel   70: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    71: use DateTime::TimeZone;
1.687     raeburn    72: use DateTime::Locale::Catalog;
1.117     www        73: 
1.517     raeburn    74: # ---------------------------------------------- Designs
                     75: use vars qw(%defaultdesign);
                     76: 
1.22      www        77: my $readit;
                     78: 
1.517     raeburn    79: 
1.157     matthew    80: ##
                     81: ## Global Variables
                     82: ##
1.46      matthew    83: 
1.643     foxr       84: 
                     85: # ----------------------------------------------- SSI with retries:
                     86: #
                     87: 
                     88: =pod
                     89: 
1.648     raeburn    90: =head1 Server Side include with retries:
1.643     foxr       91: 
                     92: =over 4
                     93: 
1.648     raeburn    94: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       95: 
                     96: Performs an ssi with some number of retries.  Retries continue either
                     97: until the result is ok or until the retry count supplied by the
                     98: caller is exhausted.  
                     99: 
                    100: Inputs:
1.648     raeburn   101: 
                    102: =over 4
                    103: 
1.643     foxr      104: resource   - Identifies the resource to insert.
1.648     raeburn   105: 
1.643     foxr      106: retries    - Count of the number of retries allowed.
1.648     raeburn   107: 
1.643     foxr      108: form       - Hash that identifies the rendering options.
                    109: 
1.648     raeburn   110: =back
                    111: 
                    112: Returns:
                    113: 
                    114: =over 4
                    115: 
1.643     foxr      116: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   117: 
1.643     foxr      118: response   - The response from the last attempt (which may or may not have been successful.
                    119: 
1.648     raeburn   120: =back
                    121: 
                    122: =back
                    123: 
1.643     foxr      124: =cut
                    125: 
                    126: sub ssi_with_retries {
                    127:     my ($resource, $retries, %form) = @_;
                    128: 
                    129: 
                    130:     my $ok = 0;			# True if we got a good response.
                    131:     my $content;
                    132:     my $response;
                    133: 
                    134:     # Try to get the ssi done. within the retries count:
                    135: 
                    136:     do {
                    137: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    138: 	$ok      = $response->is_success;
1.650     www       139:         if (!$ok) {
                    140:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    141:         }
1.643     foxr      142: 	$retries--;
                    143:     } while (!$ok && ($retries > 0));
                    144: 
                    145:     if (!$ok) {
                    146: 	$content = '';		# On error return an empty content.
                    147:     }
                    148:     return ($content, $response);
                    149: 
                    150: }
                    151: 
                    152: 
                    153: 
1.20      www       154: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  155: my %language;
1.124     www       156: my %supported_language;
1.12      harris41  157: my %cprtag;
1.192     taceyjo1  158: my %scprtag;
1.351     www       159: my %fe; my %fd; my %fm;
1.41      ng        160: my %category_extensions;
1.12      harris41  161: 
1.46      matthew   162: # ---------------------------------------------- Thesaurus variables
1.144     matthew   163: #
                    164: # %Keywords:
                    165: #      A hash used by &keyword to determine if a word is considered a keyword.
                    166: # $thesaurus_db_file 
                    167: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   168: 
                    169: my %Keywords;
                    170: my $thesaurus_db_file;
                    171: 
1.144     matthew   172: #
                    173: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    174: # thesaurus.tab, and filecategories.tab.
                    175: #
1.18      www       176: BEGIN {
1.46      matthew   177:     # Variable initialization
                    178:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    179:     #
1.22      www       180:     unless ($readit) {
1.12      harris41  181: # ------------------------------------------------------------------- languages
                    182:     {
1.158     raeburn   183:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    184:                                    '/language.tab';
                    185:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  186:             while (my $line = <$fh>) {
                    187:                 next if ($line=~/^\#/);
                    188:                 chomp($line);
                    189:                 my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158     raeburn   190:                 $language{$key}=$val.' - '.$enc;
                    191:                 if ($sup) {
                    192:                     $supported_language{$key}=$sup;
                    193:                 }
                    194:             }
                    195:             close($fh);
                    196:         }
1.12      harris41  197:     }
                    198: # ------------------------------------------------------------------ copyrights
                    199:     {
1.158     raeburn   200:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    201:                                   '/copyright.tab';
                    202:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  203:             while (my $line = <$fh>) {
                    204:                 next if ($line=~/^\#/);
                    205:                 chomp($line);
                    206:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   207:                 $cprtag{$key}=$val;
                    208:             }
                    209:             close($fh);
                    210:         }
1.12      harris41  211:     }
1.351     www       212: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  213:     {
                    214:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    215:                                   '/source_copyright.tab';
                    216:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  217:             while (my $line = <$fh>) {
                    218:                 next if ($line =~ /^\#/);
                    219:                 chomp($line);
                    220:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  221:                 $scprtag{$key}=$val;
                    222:             }
                    223:             close($fh);
                    224:         }
                    225:     }
1.63      www       226: 
1.517     raeburn   227: # -------------------------------------------------------------- default domain designs
1.63      www       228:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   229:     my $designfile = $designdir.'/default.tab';
                    230:     if ( open (my $fh,"<$designfile") ) {
                    231:         while (my $line = <$fh>) {
                    232:             next if ($line =~ /^\#/);
                    233:             chomp($line);
                    234:             my ($key,$val)=(split(/\=/,$line));
                    235:             if ($val) { $defaultdesign{$key}=$val; }
                    236:         }
                    237:         close($fh);
1.63      www       238:     }
                    239: 
1.15      harris41  240: # ------------------------------------------------------------- file categories
                    241:     {
1.158     raeburn   242:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    243:                                   '/filecategories.tab';
                    244:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  245: 	    while (my $line = <$fh>) {
                    246: 		next if ($line =~ /^\#/);
                    247: 		chomp($line);
                    248:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   249:                 push @{$category_extensions{lc($category)}},$extension;
                    250:             }
                    251:             close($fh);
                    252:         }
                    253: 
1.15      harris41  254:     }
1.12      harris41  255: # ------------------------------------------------------------------ file types
                    256:     {
1.158     raeburn   257:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    258:                '/filetypes.tab';
                    259:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  260:             while (my $line = <$fh>) {
                    261: 		next if ($line =~ /^\#/);
                    262: 		chomp($line);
                    263:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   264:                 if ($descr ne '') {
                    265:                     $fe{$ending}=lc($emb);
                    266:                     $fd{$ending}=$descr;
1.351     www       267:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   268:                 }
                    269:             }
                    270:             close($fh);
                    271:         }
1.12      harris41  272:     }
1.22      www       273:     &Apache::lonnet::logthis(
1.705     tempelho  274:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       275:     $readit=1;
1.46      matthew   276:     }  # end of unless($readit) 
1.32      matthew   277:     
                    278: }
1.112     bowersj2  279: 
1.42      matthew   280: ###############################################################
                    281: ##           HTML and Javascript Helper Functions            ##
                    282: ###############################################################
                    283: 
                    284: =pod 
                    285: 
1.112     bowersj2  286: =head1 HTML and Javascript Functions
1.42      matthew   287: 
1.112     bowersj2  288: =over 4
                    289: 
1.648     raeburn   290: =item * &browser_and_searcher_javascript()
1.112     bowersj2  291: 
                    292: X<browsing, javascript>X<searching, javascript>Returns a string
                    293: containing javascript with two functions, C<openbrowser> and
                    294: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    295: tags.
1.42      matthew   296: 
1.648     raeburn   297: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   298: 
                    299: inputs: formname, elementname, only, omit
                    300: 
                    301: formname and elementname indicate the name of the html form and name of
                    302: the element that the results of the browsing selection are to be placed in. 
                    303: 
                    304: Specifying 'only' will restrict the browser to displaying only files
1.185     www       305: with the given extension.  Can be a comma separated list.
1.42      matthew   306: 
                    307: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       308: with the given extension.  Can be a comma separated list.
1.42      matthew   309: 
1.648     raeburn   310: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   311: 
                    312: Inputs: formname, elementname
                    313: 
                    314: formname and elementname specify the name of the html form and the name
                    315: of the element the selection from the search results will be placed in.
1.542     raeburn   316: 
1.42      matthew   317: =cut
                    318: 
                    319: sub browser_and_searcher_javascript {
1.199     albertel  320:     my ($mode)=@_;
                    321:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  322:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   323:     return <<END;
1.219     albertel  324: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   325:     var editbrowser = null;
1.135     albertel  326:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       327:         var url = '$resurl/?';
1.42      matthew   328:         if (editbrowser == null) {
                    329:             url += 'launch=1&';
                    330:         }
                    331:         url += 'catalogmode=interactive&';
1.199     albertel  332:         url += 'mode=$mode&';
1.611     albertel  333:         url += 'inhibitmenu=yes&';
1.42      matthew   334:         url += 'form=' + formname + '&';
                    335:         if (only != null) {
                    336:             url += 'only=' + only + '&';
1.217     albertel  337:         } else {
                    338:             url += 'only=&';
                    339: 	}
1.42      matthew   340:         if (omit != null) {
                    341:             url += 'omit=' + omit + '&';
1.217     albertel  342:         } else {
                    343:             url += 'omit=&';
                    344: 	}
1.135     albertel  345:         if (titleelement != null) {
                    346:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  347:         } else {
                    348: 	    url += 'titleelement=&';
                    349: 	}
1.42      matthew   350:         url += 'element=' + elementname + '';
                    351:         var title = 'Browser';
1.435     albertel  352:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   353:         options += ',width=700,height=600';
                    354:         editbrowser = open(url,title,options,'1');
                    355:         editbrowser.focus();
                    356:     }
                    357:     var editsearcher;
1.135     albertel  358:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   359:         var url = '/adm/searchcat?';
                    360:         if (editsearcher == null) {
                    361:             url += 'launch=1&';
                    362:         }
                    363:         url += 'catalogmode=interactive&';
1.199     albertel  364:         url += 'mode=$mode&';
1.42      matthew   365:         url += 'form=' + formname + '&';
1.135     albertel  366:         if (titleelement != null) {
                    367:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  368:         } else {
                    369: 	    url += 'titleelement=&';
                    370: 	}
1.42      matthew   371:         url += 'element=' + elementname + '';
                    372:         var title = 'Search';
1.435     albertel  373:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   374:         options += ',width=700,height=600';
                    375:         editsearcher = open(url,title,options,'1');
                    376:         editsearcher.focus();
                    377:     }
1.219     albertel  378: // END LON-CAPA Internal -->
1.42      matthew   379: END
1.170     www       380: }
                    381: 
                    382: sub lastresurl {
1.258     albertel  383:     if ($env{'environment.lastresurl'}) {
                    384: 	return $env{'environment.lastresurl'}
1.170     www       385:     } else {
                    386: 	return '/res';
                    387:     }
                    388: }
                    389: 
                    390: sub storeresurl {
                    391:     my $resurl=&Apache::lonnet::clutter(shift);
                    392:     unless ($resurl=~/^\/res/) { return 0; }
                    393:     $resurl=~s/\/$//;
                    394:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   395:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       396:     return 1;
1.42      matthew   397: }
                    398: 
1.74      www       399: sub studentbrowser_javascript {
1.111     www       400:    unless (
1.258     albertel  401:             (($env{'request.course.id'}) && 
1.302     albertel  402:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    403: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    404: 					  '/'.$env{'request.course.sec'})
                    405: 	      ))
1.258     albertel  406:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       407:           ) { return ''; }  
1.74      www       408:    return (<<'ENDSTDBRW');
1.776     bisitz    409: <script type="text/javascript" language="Javascript">
1.824     bisitz    410: // <![CDATA[
1.74      www       411:     var stdeditbrowser;
1.793     raeburn   412:     function openstdbrowser(formname,uname,udom,roleflag,ignorefilter,courseadvonly) {
1.74      www       413:         var url = '/adm/pickstudent?';
                    414:         var filter;
1.558     albertel  415: 	if (!ignorefilter) {
                    416: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    417: 	}
1.74      www       418:         if (filter != null) {
                    419:            if (filter != '') {
                    420:                url += 'filter='+filter+'&';
                    421: 	   }
                    422:         }
                    423:         url += 'form=' + formname + '&unameelement='+uname+
                    424:                                     '&udomelement='+udom;
1.111     www       425: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   426:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       427:         var title = 'Student_Browser';
1.74      www       428:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    429:         options += ',width=700,height=600';
                    430:         stdeditbrowser = open(url,title,options,'1');
                    431:         stdeditbrowser.focus();
                    432:     }
1.824     bisitz    433: // ]]>
1.74      www       434: </script>
                    435: ENDSTDBRW
                    436: }
1.42      matthew   437: 
1.74      www       438: sub selectstudent_link {
1.793     raeburn   439:    my ($form,$unameele,$udomele,$courseadvonly)=@_;
                    440:    my $callargs = "'".$form."','".$unameele."','".$udomele."'";
1.258     albertel  441:    if ($env{'request.course.id'}) {  
1.302     albertel  442:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    443: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    444: 					'/'.$env{'request.course.sec'})) {
1.111     www       445: 	   return '';
                    446:        }
1.793     raeburn   447:        if ($courseadvonly)  {
                    448:            $callargs .= ",'',1,1";
                    449:        }
                    450:        return '<span class="LC_nobreak">'.
                    451:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    452:               &mt('Select User').'</a></span>';
1.74      www       453:    }
1.258     albertel  454:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.793     raeburn   455:        $callargs .= ",1"; 
                    456:        return '<span class="LC_nobreak">'.
                    457:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    458:               &mt('Select User').'</a></span>';
1.111     www       459:    }
                    460:    return '';
1.91      www       461: }
                    462: 
1.653     raeburn   463: sub authorbrowser_javascript {
                    464:     return <<"ENDAUTHORBRW";
1.776     bisitz    465: <script type="text/javascript" language="JavaScript">
1.824     bisitz    466: // <![CDATA[
1.653     raeburn   467: var stdeditbrowser;
                    468: 
                    469: function openauthorbrowser(formname,udom) {
                    470:     var url = '/adm/pickauthor?';
                    471:     url += 'form='+formname+'&roledom='+udom;
                    472:     var title = 'Author_Browser';
                    473:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    474:     options += ',width=700,height=600';
                    475:     stdeditbrowser = open(url,title,options,'1');
                    476:     stdeditbrowser.focus();
                    477: }
                    478: 
1.824     bisitz    479: // ]]>
1.653     raeburn   480: </script>
                    481: ENDAUTHORBRW
                    482: }
                    483: 
1.91      www       484: sub coursebrowser_javascript {
1.909     raeburn   485:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
                    486:     my $wintitle = &mt('Course Browser');
                    487:     if ($crstype ne '') {
                    488:         $wintitle = &mt($crstype);
                    489:     }
1.876     raeburn   490:     my $id_functions = &javascript_index_functions();
                    491:     my $output = '
1.776     bisitz    492: <script type="text/javascript" language="JavaScript">
1.824     bisitz    493: // <![CDATA[
1.468     raeburn   494:     var stdeditbrowser;'."\n";
1.876     raeburn   495: 
                    496:     $output .= <<"ENDSTDBRW";
1.909     raeburn   497:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       498:         var url = '/adm/pickcourse?';
1.895     raeburn   499:         var formid = getFormIdByName(formname);
1.876     raeburn   500:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  501:         if (domainfilter != null) {
                    502:            if (domainfilter != '') {
                    503:                url += 'domainfilter='+domainfilter+'&';
                    504: 	   }
                    505:         }
1.91      www       506:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  507: 	                            '&cdomelement='+udom+
                    508:                                     '&cnameelement='+desc;
1.468     raeburn   509:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   510:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   511:                 url += '&roleelement='+extra_element;
                    512:                 if (domainfilter == null || domainfilter == '') {
                    513:                     url += '&domainfilter='+extra_element;
                    514:                 }
1.234     raeburn   515:             }
1.468     raeburn   516:             else {
                    517:                 if (formname == 'portform') {
                    518:                     url += '&setroles='+extra_element;
1.800     raeburn   519:                 } else {
                    520:                     if (formname == 'rules') {
                    521:                         url += '&fixeddom='+extra_element; 
                    522:                     }
1.468     raeburn   523:                 }
                    524:             }     
1.230     raeburn   525:         }
1.909     raeburn   526:         if (type != null && type != '') {
                    527:             url += '&type='+type;
                    528:         }
                    529:         if (type_elem != null && type_elem != '') {
                    530:             url += '&typeelement='+type_elem;
                    531:         }
1.872     raeburn   532:         if (formname == 'ccrs') {
                    533:             var ownername = document.forms[formid].ccuname.value;
                    534:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    535:             url += '&cloner='+ownername+':'+ownerdom;
                    536:         }
1.293     raeburn   537:         if (multflag !=null && multflag != '') {
                    538:             url += '&multiple='+multflag;
                    539:         }
1.909     raeburn   540:         var title = '$wintitle';
1.91      www       541:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    542:         options += ',width=700,height=600';
                    543:         stdeditbrowser = open(url,title,options,'1');
                    544:         stdeditbrowser.focus();
                    545:     }
1.876     raeburn   546: $id_functions
                    547: ENDSTDBRW
1.905     raeburn   548:     if (($sec_element ne '') || ($role_element ne '')) {
                    549:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   550:     }
                    551:     $output .= '
                    552: // ]]>
                    553: </script>';
                    554:     return $output;
                    555: }
                    556: 
                    557: sub javascript_index_functions {
                    558:     return <<"ENDJS";
                    559: 
                    560: function getFormIdByName(formname) {
                    561:     for (var i=0;i<document.forms.length;i++) {
                    562:         if (document.forms[i].name == formname) {
                    563:             return i;
                    564:         }
                    565:     }
                    566:     return -1;
                    567: }
                    568: 
                    569: function getIndexByName(formid,item) {
                    570:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    571:         if (document.forms[formid].elements[i].name == item) {
                    572:             return i;
                    573:         }
                    574:     }
                    575:     return -1;
                    576: }
1.468     raeburn   577: 
1.876     raeburn   578: function getDomainFromSelectbox(formname,udom) {
                    579:     var userdom;
                    580:     var formid = getFormIdByName(formname);
                    581:     if (formid > -1) {
                    582:         var domid = getIndexByName(formid,udom);
                    583:         if (domid > -1) {
                    584:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    585:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    586:             }
                    587:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    588:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   589:             }
                    590:         }
                    591:     }
1.876     raeburn   592:     return userdom;
                    593: }
                    594: 
                    595: ENDJS
1.468     raeburn   596: 
1.876     raeburn   597: }
                    598: 
                    599: sub userbrowser_javascript {
                    600:     my $id_functions = &javascript_index_functions();
                    601:     return <<"ENDUSERBRW";
                    602: 
1.888     raeburn   603: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   604:     var url = '/adm/pickuser?';
                    605:     var userdom = getDomainFromSelectbox(formname,udom);
                    606:     if (userdom != null) {
                    607:        if (userdom != '') {
                    608:            url += 'srchdom='+userdom+'&';
                    609:        }
                    610:     }
                    611:     url += 'form=' + formname + '&unameelement='+uname+
                    612:                                 '&udomelement='+udom+
                    613:                                 '&ulastelement='+ulast+
                    614:                                 '&ufirstelement='+ufirst+
                    615:                                 '&uemailelement='+uemail+
1.881     raeburn   616:                                 '&hideudomelement='+hideudom+
                    617:                                 '&coursedom='+crsdom;
1.888     raeburn   618:     if ((caller != null) && (caller != undefined)) {
                    619:         url += '&caller='+caller;
                    620:     }
1.876     raeburn   621:     var title = 'User_Browser';
                    622:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    623:     options += ',width=700,height=600';
                    624:     var stdeditbrowser = open(url,title,options,'1');
                    625:     stdeditbrowser.focus();
                    626: }
                    627: 
1.888     raeburn   628: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   629:     var formid = getFormIdByName(formname);
                    630:     if (formid > -1) {
1.888     raeburn   631:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   632:         var domid = getIndexByName(formid,udom);
                    633:         var hidedomid = getIndexByName(formid,origdom);
                    634:         if (hidedomid > -1) {
                    635:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   636:             var unameval = document.forms[formid].elements[unameid].value;
                    637:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    638:                 if (domid > -1) {
                    639:                     var slct = document.forms[formid].elements[domid];
                    640:                     if (slct.type == 'select-one') {
                    641:                         var i;
                    642:                         for (i=0;i<slct.length;i++) {
                    643:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    644:                         }
                    645:                     }
                    646:                     if (slct.type == 'hidden') {
                    647:                         slct.value = fixeddom;
1.876     raeburn   648:                     }
                    649:                 }
1.468     raeburn   650:             }
                    651:         }
                    652:     }
1.876     raeburn   653:     return;
                    654: }
                    655: 
                    656: $id_functions
                    657: ENDUSERBRW
1.468     raeburn   658: }
                    659: 
                    660: sub setsec_javascript {
1.905     raeburn   661:     my ($sec_element,$formname,$role_element) = @_;
                    662:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    663:         $communityrolestr);
                    664:     if ($role_element ne '') {
                    665:         my @allroles = ('st','ta','ep','in','ad');
                    666:         foreach my $crstype ('Course','Community') {
                    667:             if ($crstype eq 'Community') {
                    668:                 foreach my $role (@allroles) {
                    669:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    670:                 }
                    671:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    672:             } else {
                    673:                 foreach my $role (@allroles) {
                    674:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    675:                 }
                    676:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    677:             }
                    678:         }
                    679:         $rolestr = '"'.join('","',@allroles).'"';
                    680:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    681:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    682:     }
1.468     raeburn   683:     my $setsections = qq|
                    684: function setSect(sectionlist) {
1.629     raeburn   685:     var sectionsArray = new Array();
                    686:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    687:         sectionsArray = sectionlist.split(",");
                    688:     }
1.468     raeburn   689:     var numSections = sectionsArray.length;
                    690:     document.$formname.$sec_element.length = 0;
                    691:     if (numSections == 0) {
                    692:         document.$formname.$sec_element.multiple=false;
                    693:         document.$formname.$sec_element.size=1;
                    694:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    695:     } else {
                    696:         if (numSections == 1) {
                    697:             document.$formname.$sec_element.multiple=false;
                    698:             document.$formname.$sec_element.size=1;
                    699:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    700:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    701:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    702:         } else {
                    703:             for (var i=0; i<numSections; i++) {
                    704:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    705:             }
                    706:             document.$formname.$sec_element.multiple=true
                    707:             if (numSections < 3) {
                    708:                 document.$formname.$sec_element.size=numSections;
                    709:             } else {
                    710:                 document.$formname.$sec_element.size=3;
                    711:             }
                    712:             document.$formname.$sec_element.options[0].selected = false
                    713:         }
                    714:     }
1.91      www       715: }
1.905     raeburn   716: 
                    717: function setRole(crstype) {
1.468     raeburn   718: |;
1.905     raeburn   719:     if ($role_element eq '') {
                    720:         $setsections .= '    return;
                    721: }
                    722: ';
                    723:     } else {
                    724:         $setsections .= qq|
                    725:     var elementLength = document.$formname.$role_element.length;
                    726:     var allroles = Array($rolestr);
                    727:     var courserolenames = Array($courserolestr);
                    728:     var communityrolenames = Array($communityrolestr);
                    729:     if (elementLength != undefined) {
                    730:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    731:             if (crstype == 'Course') {
                    732:                 return;
                    733:             } else {
                    734:                 allroles[5] = 'co';
                    735:                 for (var i=0; i<6; i++) {
                    736:                     document.$formname.$role_element.options[i].value = allroles[i];
                    737:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    738:                 }
                    739:             }
                    740:         } else {
                    741:             if (crstype == 'Community') {
                    742:                 return;
                    743:             } else {
                    744:                 allroles[5] = 'cc';
                    745:                 for (var i=0; i<6; i++) {
                    746:                     document.$formname.$role_element.options[i].value = allroles[i];
                    747:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    748:                 }
                    749:             }
                    750:         }
                    751:     }
                    752:     return;
                    753: }
                    754: |;
                    755:     }
1.468     raeburn   756:     return $setsections;
                    757: }
                    758: 
1.91      www       759: sub selectcourse_link {
1.909     raeburn   760:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    761:        $typeelement) = @_;
                    762:    my $type = $selecttype;
1.871     raeburn   763:    my $linktext = &mt('Select Course');
                    764:    if ($selecttype eq 'Community') {
1.909     raeburn   765:        $linktext = &mt('Select Community');
1.906     raeburn   766:    } elsif ($selecttype eq 'Course/Community') {
                    767:        $linktext = &mt('Select Course/Community');
1.909     raeburn   768:        $type = '';
1.871     raeburn   769:    }
1.787     bisitz    770:    return '<span class="LC_nobreak">'
                    771:          ."<a href='"
                    772:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    773:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   774:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   775:          ."'>".$linktext.'</a>'
1.787     bisitz    776:          .'</span>';
1.74      www       777: }
1.42      matthew   778: 
1.653     raeburn   779: sub selectauthor_link {
                    780:    my ($form,$udom)=@_;
                    781:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    782:           &mt('Select Author').'</a>';
                    783: }
                    784: 
1.876     raeburn   785: sub selectuser_link {
1.881     raeburn   786:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   787:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   788:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   789:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   790:            ');">'.$linktext.'</a>';
1.876     raeburn   791: }
                    792: 
1.273     raeburn   793: sub check_uncheck_jscript {
                    794:     my $jscript = <<"ENDSCRT";
                    795: function checkAll(field) {
                    796:     if (field.length > 0) {
                    797:         for (i = 0; i < field.length; i++) {
                    798:             field[i].checked = true ;
                    799:         }
                    800:     } else {
                    801:         field.checked = true
                    802:     }
                    803: }
                    804:  
                    805: function uncheckAll(field) {
                    806:     if (field.length > 0) {
                    807:         for (i = 0; i < field.length; i++) {
                    808:             field[i].checked = false ;
1.543     albertel  809:         }
                    810:     } else {
1.273     raeburn   811:         field.checked = false ;
                    812:     }
                    813: }
                    814: ENDSCRT
                    815:     return $jscript;
                    816: }
                    817: 
1.656     www       818: sub select_timezone {
1.659     raeburn   819:    my ($name,$selected,$onchange,$includeempty)=@_;
                    820:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    821:    if ($includeempty) {
                    822:        $output .= '<option value=""';
                    823:        if (($selected eq '') || ($selected eq 'local')) {
                    824:            $output .= ' selected="selected" ';
                    825:        }
                    826:        $output .= '> </option>';
                    827:    }
1.657     raeburn   828:    my @timezones = DateTime::TimeZone->all_names;
                    829:    foreach my $tzone (@timezones) {
                    830:        $output.= '<option value="'.$tzone.'"';
                    831:        if ($tzone eq $selected) {
                    832:            $output.=' selected="selected"';
                    833:        }
                    834:        $output.=">$tzone</option>\n";
1.656     www       835:    }
                    836:    $output.="</select>";
                    837:    return $output;
                    838: }
1.273     raeburn   839: 
1.687     raeburn   840: sub select_datelocale {
                    841:     my ($name,$selected,$onchange,$includeempty)=@_;
                    842:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    843:     if ($includeempty) {
                    844:         $output .= '<option value=""';
                    845:         if ($selected eq '') {
                    846:             $output .= ' selected="selected" ';
                    847:         }
                    848:         $output .= '> </option>';
                    849:     }
                    850:     my (@possibles,%locale_names);
                    851:     my @locales = DateTime::Locale::Catalog::Locales;
                    852:     foreach my $locale (@locales) {
                    853:         if (ref($locale) eq 'HASH') {
                    854:             my $id = $locale->{'id'};
                    855:             if ($id ne '') {
                    856:                 my $en_terr = $locale->{'en_territory'};
                    857:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   858:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   859:                 if (grep(/^en$/,@languages) || !@languages) {
                    860:                     if ($en_terr ne '') {
                    861:                         $locale_names{$id} = '('.$en_terr.')';
                    862:                     } elsif ($native_terr ne '') {
                    863:                         $locale_names{$id} = $native_terr;
                    864:                     }
                    865:                 } else {
                    866:                     if ($native_terr ne '') {
                    867:                         $locale_names{$id} = $native_terr.' ';
                    868:                     } elsif ($en_terr ne '') {
                    869:                         $locale_names{$id} = '('.$en_terr.')';
                    870:                     }
                    871:                 }
                    872:                 push (@possibles,$id);
                    873:             }
                    874:         }
                    875:     }
                    876:     foreach my $item (sort(@possibles)) {
                    877:         $output.= '<option value="'.$item.'"';
                    878:         if ($item eq $selected) {
                    879:             $output.=' selected="selected"';
                    880:         }
                    881:         $output.=">$item";
                    882:         if ($locale_names{$item} ne '') {
                    883:             $output.="  $locale_names{$item}</option>\n";
                    884:         }
                    885:         $output.="</option>\n";
                    886:     }
                    887:     $output.="</select>";
                    888:     return $output;
                    889: }
                    890: 
1.792     raeburn   891: sub select_language {
                    892:     my ($name,$selected,$includeempty) = @_;
                    893:     my %langchoices;
                    894:     if ($includeempty) {
                    895:         %langchoices = ('' => 'No language preference');
                    896:     }
                    897:     foreach my $id (&languageids()) {
                    898:         my $code = &supportedlanguagecode($id);
                    899:         if ($code) {
                    900:             $langchoices{$code} = &plainlanguagedescription($id);
                    901:         }
                    902:     }
                    903:     return &select_form($selected,$name,%langchoices);
                    904: }
                    905: 
1.42      matthew   906: =pod
1.36      matthew   907: 
1.648     raeburn   908: =item * &linked_select_forms(...)
1.36      matthew   909: 
                    910: linked_select_forms returns a string containing a <script></script> block
                    911: and html for two <select> menus.  The select menus will be linked in that
                    912: changing the value of the first menu will result in new values being placed
                    913: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn   914: order unless a defined order is provided.
1.36      matthew   915: 
                    916: linked_select_forms takes the following ordered inputs:
                    917: 
                    918: =over 4
                    919: 
1.112     bowersj2  920: =item * $formname, the name of the <form> tag
1.36      matthew   921: 
1.112     bowersj2  922: =item * $middletext, the text which appears between the <select> tags
1.36      matthew   923: 
1.112     bowersj2  924: =item * $firstdefault, the default value for the first menu
1.36      matthew   925: 
1.112     bowersj2  926: =item * $firstselectname, the name of the first <select> tag
1.36      matthew   927: 
1.112     bowersj2  928: =item * $secondselectname, the name of the second <select> tag
1.36      matthew   929: 
1.112     bowersj2  930: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew   931: 
1.609     raeburn   932: =item * $menuorder, the order of values in the first menu
                    933: 
1.41      ng        934: =back 
                    935: 
1.36      matthew   936: Below is an example of such a hash.  Only the 'text', 'default', and 
                    937: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    938: values for the first select menu.  The text that coincides with the 
1.41      ng        939: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   940: and text for the second menu are given in the hash pointed to by 
                    941: $menu{$choice1}->{'select2'}.  
                    942: 
1.112     bowersj2  943:  my %menu = ( A1 => { text =>"Choice A1" ,
                    944:                        default => "B3",
                    945:                        select2 => { 
                    946:                            B1 => "Choice B1",
                    947:                            B2 => "Choice B2",
                    948:                            B3 => "Choice B3",
                    949:                            B4 => "Choice B4"
1.609     raeburn   950:                            },
                    951:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2  952:                    },
                    953:                A2 => { text =>"Choice A2" ,
                    954:                        default => "C2",
                    955:                        select2 => { 
                    956:                            C1 => "Choice C1",
                    957:                            C2 => "Choice C2",
                    958:                            C3 => "Choice C3"
1.609     raeburn   959:                            },
                    960:                        order => ['C2','C1','C3'],
1.112     bowersj2  961:                    },
                    962:                A3 => { text =>"Choice A3" ,
                    963:                        default => "D6",
                    964:                        select2 => { 
                    965:                            D1 => "Choice D1",
                    966:                            D2 => "Choice D2",
                    967:                            D3 => "Choice D3",
                    968:                            D4 => "Choice D4",
                    969:                            D5 => "Choice D5",
                    970:                            D6 => "Choice D6",
                    971:                            D7 => "Choice D7"
1.609     raeburn   972:                            },
                    973:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2  974:                    }
                    975:                );
1.36      matthew   976: 
                    977: =cut
                    978: 
                    979: sub linked_select_forms {
                    980:     my ($formname,
                    981:         $middletext,
                    982:         $firstdefault,
                    983:         $firstselectname,
                    984:         $secondselectname, 
1.609     raeburn   985:         $hashref,
                    986:         $menuorder,
1.36      matthew   987:         ) = @_;
                    988:     my $second = "document.$formname.$secondselectname";
                    989:     my $first = "document.$formname.$firstselectname";
                    990:     # output the javascript to do the changing
                    991:     my $result = '';
1.776     bisitz    992:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz    993:     $result.="// <![CDATA[\n";
1.36      matthew   994:     $result.="var select2data = new Object();\n";
                    995:     $" = '","';
                    996:     my $debug = '';
                    997:     foreach my $s1 (sort(keys(%$hashref))) {
                    998:         $result.="select2data.d_$s1 = new Object();\n";        
                    999:         $result.="select2data.d_$s1.def = new String('".
                   1000:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1001:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1002:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1003:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1004:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1005:         }
1.36      matthew  1006:         $result.="\"@s2values\");\n";
                   1007:         $result.="select2data.d_$s1.texts = new Array(";        
                   1008:         my @s2texts;
                   1009:         foreach my $value (@s2values) {
                   1010:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1011:         }
                   1012:         $result.="\"@s2texts\");\n";
                   1013:     }
                   1014:     $"=' ';
                   1015:     $result.= <<"END";
                   1016: 
                   1017: function select1_changed() {
                   1018:     // Determine new choice
                   1019:     var newvalue = "d_" + $first.value;
                   1020:     // update select2
                   1021:     var values     = select2data[newvalue].values;
                   1022:     var texts      = select2data[newvalue].texts;
                   1023:     var select2def = select2data[newvalue].def;
                   1024:     var i;
                   1025:     // out with the old
                   1026:     for (i = 0; i < $second.options.length; i++) {
                   1027:         $second.options[i] = null;
                   1028:     }
                   1029:     // in with the nuclear
                   1030:     for (i=0;i<values.length; i++) {
                   1031:         $second.options[i] = new Option(values[i]);
1.143     matthew  1032:         $second.options[i].value = values[i];
1.36      matthew  1033:         $second.options[i].text = texts[i];
                   1034:         if (values[i] == select2def) {
                   1035:             $second.options[i].selected = true;
                   1036:         }
                   1037:     }
                   1038: }
1.824     bisitz   1039: // ]]>
1.36      matthew  1040: </script>
                   1041: END
                   1042:     # output the initial values for the selection lists
                   1043:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1044:     my @order = sort(keys(%{$hashref}));
                   1045:     if (ref($menuorder) eq 'ARRAY') {
                   1046:         @order = @{$menuorder};
                   1047:     }
                   1048:     foreach my $value (@order) {
1.36      matthew  1049:         $result.="    <option value=\"$value\" ";
1.253     albertel 1050:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1051:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1052:     }
                   1053:     $result .= "</select>\n";
                   1054:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1055:     $result .= $middletext;
                   1056:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1057:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1058:     
                   1059:     my @secondorder = sort(keys(%select2));
                   1060:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1061:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1062:     }
                   1063:     foreach my $value (@secondorder) {
1.36      matthew  1064:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1065:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1066:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1067:     }
                   1068:     $result .= "</select>\n";
                   1069:     #    return $debug;
                   1070:     return $result;
                   1071: }   #  end of sub linked_select_forms {
                   1072: 
1.45      matthew  1073: =pod
1.44      bowersj2 1074: 
1.648     raeburn  1075: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44      bowersj2 1076: 
1.112     bowersj2 1077: Returns a string corresponding to an HTML link to the given help
                   1078: $topic, where $topic corresponds to the name of a .tex file in
                   1079: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1080: spaces. 
                   1081: 
                   1082: $text will optionally be linked to the same topic, allowing you to
                   1083: link text in addition to the graphic. If you do not want to link
                   1084: text, but wish to specify one of the later parameters, pass an
                   1085: empty string. 
                   1086: 
                   1087: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1088: the link will not open a new window. If false, the link will open
                   1089: a new window using Javascript. (Default is false.) 
                   1090: 
                   1091: $width and $height are optional numerical parameters that will
                   1092: override the width and height of the popped up window, which may
                   1093: be useful for certain help topics with big pictures included. 
1.44      bowersj2 1094: 
                   1095: =cut
                   1096: 
                   1097: sub help_open_topic {
1.48      bowersj2 1098:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
                   1099:     $text = "" if (not defined $text);
1.44      bowersj2 1100:     $stayOnPage = 0 if (not defined $stayOnPage);
                   1101:     $width = 350 if (not defined $width);
                   1102:     $height = 400 if (not defined $height);
                   1103:     my $filename = $topic;
                   1104:     $filename =~ s/ /_/g;
                   1105: 
1.48      bowersj2 1106:     my $template = "";
                   1107:     my $link;
1.572     banghart 1108:     
1.159     www      1109:     $topic=~s/\W/\_/g;
1.44      bowersj2 1110: 
1.572     banghart 1111:     if (!$stayOnPage) {
1.72      bowersj2 1112: 	$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 1113:     } else {
1.48      bowersj2 1114: 	$link = "/adm/help/${filename}.hlp";
                   1115:     }
                   1116: 
                   1117:     # Add the text
1.755     neumanie 1118:     if ($text ne "") {	
1.763     bisitz   1119: 	$template.='<span class="LC_help_open_topic">'
                   1120:                   .'<a target="_top" href="'.$link.'">'
                   1121:                   .$text.'</a>';
1.48      bowersj2 1122:     }
                   1123: 
1.763     bisitz   1124:     # (Always) Add the graphic
1.179     matthew  1125:     my $title = &mt('Online Help');
1.667     raeburn  1126:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.763     bisitz   1127:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1128:               .'<img src="'.$helpicon.'" border="0"'
                   1129:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.783     amueller 1130:               .' title="'.$title.'"' 
1.763     bisitz   1131:               .' /></a>';
                   1132:     if ($text ne "") {	
                   1133:         $template.='</span>';
                   1134:     }
1.44      bowersj2 1135:     return $template;
                   1136: 
1.106     bowersj2 1137: }
                   1138: 
                   1139: # This is a quicky function for Latex cheatsheet editing, since it 
                   1140: # appears in at least four places
                   1141: sub helpLatexCheatsheet {
1.732     raeburn  1142:     my ($topic,$text,$not_author) = @_;
                   1143:     my $out;
1.106     bowersj2 1144:     my $addOther = '';
1.732     raeburn  1145:     if ($topic) {
1.763     bisitz   1146: 	$addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),
                   1147: 							       undef, undef, 600).
                   1148: 								   '</span> ';
                   1149:     }
                   1150:     $out = '<span>' # Start cheatsheet
                   1151: 	  .$addOther
                   1152:           .'<span>'
                   1153: 	  .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
                   1154: 					       undef,undef,600)
                   1155: 	  .'</span> <span>'
                   1156: 	  .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
                   1157: 					       undef,undef,600)
                   1158: 	  .'</span>';
1.732     raeburn  1159:     unless ($not_author) {
1.763     bisitz   1160:         $out .= ' <span>'
                   1161: 	       .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
                   1162: 	                                            undef,undef,600)
                   1163: 	       .'</span>';
1.732     raeburn  1164:     }
1.763     bisitz   1165:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1166:     return $out;
1.172     www      1167: }
                   1168: 
1.430     albertel 1169: sub general_help {
                   1170:     my $helptopic='Student_Intro';
                   1171:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1172: 	$helptopic='Authoring_Intro';
1.907     raeburn  1173:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1174: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1175:     } elsif ($env{'request.role'}=~/^dc/) {
                   1176:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1177:     }
                   1178:     return $helptopic;
                   1179: }
                   1180: 
                   1181: sub update_help_link {
                   1182:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1183:     my $origurl = $ENV{'REQUEST_URI'};
                   1184:     $origurl=~s|^/~|/priv/|;
                   1185:     my $timestamp = time;
                   1186:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1187:         $$datum = &escape($$datum);
                   1188:     }
                   1189: 
                   1190:     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";
                   1191:     my $output .= <<"ENDOUTPUT";
                   1192: <script type="text/javascript">
1.824     bisitz   1193: // <![CDATA[
1.430     albertel 1194: banner_link = '$banner_link';
1.824     bisitz   1195: // ]]>
1.430     albertel 1196: </script>
                   1197: ENDOUTPUT
                   1198:     return $output;
                   1199: }
                   1200: 
                   1201: # now just updates the help link and generates a blue icon
1.193     raeburn  1202: sub help_open_menu {
1.430     albertel 1203:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1204: 	= @_;    
1.430     albertel 1205:     $stayOnPage = 0 if (not defined $stayOnPage);
1.572     banghart 1206:     # only use pop-up help (stayOnPage == 0)
1.552     banghart 1207:     # if environment.remote is on (using remote control UI)
1.798     tempelho 1208:     if ($env{'environment.remote'} eq 'off' ) {
1.552     banghart 1209:         $stayOnPage=1;
1.430     albertel 1210:     }
                   1211:     my $output;
                   1212:     if ($component_help) {
                   1213: 	if (!$text) {
                   1214: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1215: 				       $width,$height);
                   1216: 	} else {
                   1217: 	    my $help_text;
                   1218: 	    $help_text=&unescape($topic);
                   1219: 	    $output='<table><tr><td>'.
                   1220: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1221: 				 $width,$height).'</td></tr></table>';
                   1222: 	}
                   1223:     }
                   1224:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1225:     return $output.$banner_link;
                   1226: }
                   1227: 
                   1228: sub top_nav_help {
                   1229:     my ($text) = @_;
1.436     albertel 1230:     $text = &mt($text);
1.572     banghart 1231:     my $stay_on_page = 
1.798     tempelho 1232: 	($env{'environment.remote'} eq 'off' );
1.572     banghart 1233:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1234: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1235:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1236: 
1.201     raeburn  1237:     my $title = &mt('Get help');
1.436     albertel 1238: 
                   1239:     return <<"END";
                   1240: $banner_link
                   1241:  <a href="$link" title="$title">$text</a>
                   1242: END
                   1243: }
                   1244: 
                   1245: sub help_menu_js {
                   1246:     my ($text) = @_;
                   1247: 
                   1248:     my $stayOnPage = 
1.798     tempelho 1249: 	($env{'environment.remote'} eq 'off' );
1.436     albertel 1250: 
                   1251:     my $width = 620;
                   1252:     my $height = 600;
1.430     albertel 1253:     my $helptopic=&general_help();
                   1254:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1255:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1256:     my $start_page =
                   1257:         &Apache::loncommon::start_page('Help Menu', undef,
                   1258: 				       {'frameset'    => 1,
                   1259: 					'js_ready'    => 1,
                   1260: 					'add_entries' => {
                   1261: 					    'border' => '0',
1.579     raeburn  1262: 					    'rows'   => "110,*",},});
1.331     albertel 1263:     my $end_page =
                   1264:         &Apache::loncommon::end_page({'frameset' => 1,
                   1265: 				      'js_ready' => 1,});
                   1266: 
1.436     albertel 1267:     my $template .= <<"ENDTEMPLATE";
                   1268: <script type="text/javascript">
1.877     bisitz   1269: // <![CDATA[
1.253     albertel 1270: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1271: var banner_link = '';
1.243     raeburn  1272: function helpMenu(target) {
                   1273:     var caller = this;
                   1274:     if (target == 'open') {
                   1275:         var newWindow = null;
                   1276:         try {
1.262     albertel 1277:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1278:         }
                   1279:         catch(error) {
                   1280:             writeHelp(caller);
                   1281:             return;
                   1282:         }
                   1283:         if (newWindow) {
                   1284:             caller = newWindow;
                   1285:         }
1.193     raeburn  1286:     }
1.243     raeburn  1287:     writeHelp(caller);
                   1288:     return;
                   1289: }
                   1290: function writeHelp(caller) {
1.430     albertel 1291:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn  1292:     caller.document.close()
                   1293:     caller.focus()
1.193     raeburn  1294: }
1.877     bisitz   1295: // END LON-CAPA Internal -->
1.253     albertel 1296: // ]]>
1.436     albertel 1297: </script>
1.193     raeburn  1298: ENDTEMPLATE
                   1299:     return $template;
                   1300: }
                   1301: 
1.172     www      1302: sub help_open_bug {
                   1303:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1304:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1305:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1306:     $text = "" if (not defined $text);
                   1307:     $stayOnPage = 0 if (not defined $stayOnPage);
1.798     tempelho 1308:     if ($env{'environment.remote'} eq 'off' ) {
1.172     www      1309: 	$stayOnPage=1;
                   1310:     }
1.184     albertel 1311:     $width = 600 if (not defined $width);
                   1312:     $height = 600 if (not defined $height);
1.172     www      1313: 
                   1314:     $topic=~s/\W+/\+/g;
                   1315:     my $link='';
                   1316:     my $template='';
1.379     albertel 1317:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1318: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1319:     if (!$stayOnPage)
                   1320:     {
                   1321: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1322:     }
                   1323:     else
                   1324:     {
                   1325: 	$link = $url;
                   1326:     }
                   1327:     # Add the text
                   1328:     if ($text ne "")
                   1329:     {
                   1330: 	$template .= 
                   1331:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1332:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1333:     }
                   1334: 
                   1335:     # Add the graphic
1.179     matthew  1336:     my $title = &mt('Report a Bug');
1.215     albertel 1337:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1338:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1339:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1340: ENDTEMPLATE
                   1341:     if ($text ne '') { $template.='</td></tr></table>' };
                   1342:     return $template;
                   1343: 
                   1344: }
                   1345: 
                   1346: sub help_open_faq {
                   1347:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1348:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1349:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1350:     $text = "" if (not defined $text);
                   1351:     $stayOnPage = 0 if (not defined $stayOnPage);
1.798     tempelho 1352:     if ($env{'environment.remote'} eq 'off' ) {
1.172     www      1353: 	$stayOnPage=1;
                   1354:     }
                   1355:     $width = 350 if (not defined $width);
                   1356:     $height = 400 if (not defined $height);
                   1357: 
                   1358:     $topic=~s/\W+/\+/g;
                   1359:     my $link='';
                   1360:     my $template='';
                   1361:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1362:     if (!$stayOnPage)
                   1363:     {
                   1364: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1365:     }
                   1366:     else
                   1367:     {
                   1368: 	$link = $url;
                   1369:     }
                   1370: 
                   1371:     # Add the text
                   1372:     if ($text ne "")
                   1373:     {
                   1374: 	$template .= 
1.173     www      1375:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1376:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1377:     }
                   1378: 
                   1379:     # Add the graphic
1.179     matthew  1380:     my $title = &mt('View the FAQ');
1.215     albertel 1381:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1382:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1383:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1384: ENDTEMPLATE
                   1385:     if ($text ne '') { $template.='</td></tr></table>' };
                   1386:     return $template;
                   1387: 
1.44      bowersj2 1388: }
1.37      matthew  1389: 
1.180     matthew  1390: ###############################################################
                   1391: ###############################################################
                   1392: 
1.45      matthew  1393: =pod
                   1394: 
1.648     raeburn  1395: =item * &change_content_javascript():
1.256     matthew  1396: 
                   1397: This and the next function allow you to create small sections of an
                   1398: otherwise static HTML page that you can update on the fly with
                   1399: Javascript, even in Netscape 4.
                   1400: 
                   1401: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1402: must be written to the HTML page once. It will prove the Javascript
                   1403: function "change(name, content)". Calling the change function with the
                   1404: name of the section 
                   1405: you want to update, matching the name passed to C<changable_area>, and
                   1406: the new content you want to put in there, will put the content into
                   1407: that area.
                   1408: 
                   1409: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1410: to contain room for the original contents. You need to "make space"
                   1411: for whatever changes you wish to make, and be B<sure> to check your
                   1412: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1413: it's adequate for updating a one-line status display, but little more.
                   1414: This script will set the space to 100% width, so you only need to
                   1415: worry about height in Netscape 4.
                   1416: 
                   1417: Modern browsers are much less limiting, and if you can commit to the
                   1418: user not using Netscape 4, this feature may be used freely with
                   1419: pretty much any HTML.
                   1420: 
                   1421: =cut
                   1422: 
                   1423: sub change_content_javascript {
                   1424:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1425:     if ($env{'browser.type'} eq 'netscape' &&
                   1426: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1427: 	return (<<NETSCAPE4);
                   1428: 	function change(name, content) {
                   1429: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1430: 	    doc.open();
                   1431: 	    doc.write(content);
                   1432: 	    doc.close();
                   1433: 	}
                   1434: NETSCAPE4
                   1435:     } else {
                   1436: 	# Otherwise, we need to use semi-standards-compliant code
                   1437: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1438: 	# is really scary, and every useful browser supports it
                   1439: 	return (<<DOMBASED);
                   1440: 	function change(name, content) {
                   1441: 	    element = document.getElementById(name);
                   1442: 	    element.innerHTML = content;
                   1443: 	}
                   1444: DOMBASED
                   1445:     }
                   1446: }
                   1447: 
                   1448: =pod
                   1449: 
1.648     raeburn  1450: =item * &changable_area($name,$origContent):
1.256     matthew  1451: 
                   1452: This provides a "changable area" that can be modified on the fly via
                   1453: the Javascript code provided in C<change_content_javascript>. $name is
                   1454: the name you will use to reference the area later; do not repeat the
                   1455: same name on a given HTML page more then once. $origContent is what
                   1456: the area will originally contain, which can be left blank.
                   1457: 
                   1458: =cut
                   1459: 
                   1460: sub changable_area {
                   1461:     my ($name, $origContent) = @_;
                   1462: 
1.258     albertel 1463:     if ($env{'browser.type'} eq 'netscape' &&
                   1464: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1465: 	# If this is netscape 4, we need to use the Layer tag
                   1466: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1467:     } else {
                   1468: 	return "<span id='$name'>$origContent</span>";
                   1469:     }
                   1470: }
                   1471: 
                   1472: =pod
                   1473: 
1.648     raeburn  1474: =item * &viewport_geometry_js 
1.590     raeburn  1475: 
                   1476: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1477: 
                   1478: =cut
                   1479: 
                   1480: 
                   1481: sub viewport_geometry_js { 
                   1482:     return <<"GEOMETRY";
                   1483: var Geometry = {};
                   1484: function init_geometry() {
                   1485:     if (Geometry.init) { return };
                   1486:     Geometry.init=1;
                   1487:     if (window.innerHeight) {
                   1488:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1489:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1490:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1491:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1492:     }
                   1493:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1494:         Geometry.getViewportHeight =
                   1495:             function() { return document.documentElement.clientHeight; };
                   1496:         Geometry.getViewportWidth =
                   1497:             function() { return document.documentElement.clientWidth; };
                   1498: 
                   1499:         Geometry.getHorizontalScroll =
                   1500:             function() { return document.documentElement.scrollLeft; };
                   1501:         Geometry.getVerticalScroll =
                   1502:             function() { return document.documentElement.scrollTop; };
                   1503:     }
                   1504:     else if (document.body.clientHeight) {
                   1505:         Geometry.getViewportHeight =
                   1506:             function() { return document.body.clientHeight; };
                   1507:         Geometry.getViewportWidth =
                   1508:             function() { return document.body.clientWidth; };
                   1509:         Geometry.getHorizontalScroll =
                   1510:             function() { return document.body.scrollLeft; };
                   1511:         Geometry.getVerticalScroll =
                   1512:             function() { return document.body.scrollTop; };
                   1513:     }
                   1514: }
                   1515: 
                   1516: GEOMETRY
                   1517: }
                   1518: 
                   1519: =pod
                   1520: 
1.648     raeburn  1521: =item * &viewport_size_js()
1.590     raeburn  1522: 
                   1523: 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. 
                   1524: 
                   1525: =cut
                   1526: 
                   1527: sub viewport_size_js {
                   1528:     my $geometry = &viewport_geometry_js();
                   1529:     return <<"DIMS";
                   1530: 
                   1531: $geometry
                   1532: 
                   1533: function getViewportDims(width,height) {
                   1534:     init_geometry();
                   1535:     width.value = Geometry.getViewportWidth();
                   1536:     height.value = Geometry.getViewportHeight();
                   1537:     return;
                   1538: }
                   1539: 
                   1540: DIMS
                   1541: }
                   1542: 
                   1543: =pod
                   1544: 
1.648     raeburn  1545: =item * &resize_textarea_js()
1.565     albertel 1546: 
                   1547: emits the needed javascript to resize a textarea to be as big as possible
                   1548: 
                   1549: creates a function resize_textrea that takes two IDs first should be
                   1550: the id of the element to resize, second should be the id of a div that
                   1551: surrounds everything that comes after the textarea, this routine needs
                   1552: to be attached to the <body> for the onload and onresize events.
                   1553: 
1.648     raeburn  1554: =back
1.565     albertel 1555: 
                   1556: =cut
                   1557: 
                   1558: sub resize_textarea_js {
1.590     raeburn  1559:     my $geometry = &viewport_geometry_js();
1.565     albertel 1560:     return <<"RESIZE";
                   1561:     <script type="text/javascript">
1.824     bisitz   1562: // <![CDATA[
1.590     raeburn  1563: $geometry
1.565     albertel 1564: 
1.588     albertel 1565: function getX(element) {
                   1566:     var x = 0;
                   1567:     while (element) {
                   1568: 	x += element.offsetLeft;
                   1569: 	element = element.offsetParent;
                   1570:     }
                   1571:     return x;
                   1572: }
                   1573: function getY(element) {
                   1574:     var y = 0;
                   1575:     while (element) {
                   1576: 	y += element.offsetTop;
                   1577: 	element = element.offsetParent;
                   1578:     }
                   1579:     return y;
                   1580: }
                   1581: 
                   1582: 
1.565     albertel 1583: function resize_textarea(textarea_id,bottom_id) {
                   1584:     init_geometry();
                   1585:     var textarea        = document.getElementById(textarea_id);
                   1586:     //alert(textarea);
                   1587: 
1.588     albertel 1588:     var textarea_top    = getY(textarea);
1.565     albertel 1589:     var textarea_height = textarea.offsetHeight;
                   1590:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1591:     var bottom_top      = getY(bottom);
1.565     albertel 1592:     var bottom_height   = bottom.offsetHeight;
                   1593:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1594:     var fudge           = 23;
1.565     albertel 1595:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1596:     if (new_height < 300) {
                   1597: 	new_height = 300;
                   1598:     }
                   1599:     textarea.style.height=new_height+'px';
                   1600: }
1.824     bisitz   1601: // ]]>
1.565     albertel 1602: </script>
                   1603: RESIZE
                   1604: 
                   1605: }
                   1606: 
                   1607: =pod
                   1608: 
1.256     matthew  1609: =head1 Excel and CSV file utility routines
                   1610: 
                   1611: =over 4
                   1612: 
                   1613: =cut
                   1614: 
                   1615: ###############################################################
                   1616: ###############################################################
                   1617: 
                   1618: =pod
                   1619: 
1.648     raeburn  1620: =item * &csv_translate($text) 
1.37      matthew  1621: 
1.185     www      1622: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1623: format.
                   1624: 
                   1625: =cut
                   1626: 
1.180     matthew  1627: ###############################################################
                   1628: ###############################################################
1.37      matthew  1629: sub csv_translate {
                   1630:     my $text = shift;
                   1631:     $text =~ s/\"/\"\"/g;
1.209     albertel 1632:     $text =~ s/\n/ /g;
1.37      matthew  1633:     return $text;
                   1634: }
1.180     matthew  1635: 
                   1636: ###############################################################
                   1637: ###############################################################
                   1638: 
                   1639: =pod
                   1640: 
1.648     raeburn  1641: =item * &define_excel_formats()
1.180     matthew  1642: 
                   1643: Define some commonly used Excel cell formats.
                   1644: 
                   1645: Currently supported formats:
                   1646: 
                   1647: =over 4
                   1648: 
                   1649: =item header
                   1650: 
                   1651: =item bold
                   1652: 
                   1653: =item h1
                   1654: 
                   1655: =item h2
                   1656: 
                   1657: =item h3
                   1658: 
1.256     matthew  1659: =item h4
                   1660: 
                   1661: =item i
                   1662: 
1.180     matthew  1663: =item date
                   1664: 
                   1665: =back
                   1666: 
                   1667: Inputs: $workbook
                   1668: 
                   1669: Returns: $format, a hash reference.
                   1670: 
                   1671: =cut
                   1672: 
                   1673: ###############################################################
                   1674: ###############################################################
                   1675: sub define_excel_formats {
                   1676:     my ($workbook) = @_;
                   1677:     my $format;
                   1678:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1679:                                                 bottom    => 1,
                   1680:                                                 align     => 'center');
                   1681:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1682:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1683:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1684:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1685:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1686:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1687:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1688:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1689:     return $format;
                   1690: }
                   1691: 
                   1692: ###############################################################
                   1693: ###############################################################
1.113     bowersj2 1694: 
                   1695: =pod
                   1696: 
1.648     raeburn  1697: =item * &create_workbook()
1.255     matthew  1698: 
                   1699: Create an Excel worksheet.  If it fails, output message on the
                   1700: request object and return undefs.
                   1701: 
                   1702: Inputs: Apache request object
                   1703: 
                   1704: Returns (undef) on failure, 
                   1705:     Excel worksheet object, scalar with filename, and formats 
                   1706:     from &Apache::loncommon::define_excel_formats on success
                   1707: 
                   1708: =cut
                   1709: 
                   1710: ###############################################################
                   1711: ###############################################################
                   1712: sub create_workbook {
                   1713:     my ($r) = @_;
                   1714:         #
                   1715:     # Create the excel spreadsheet
                   1716:     my $filename = '/prtspool/'.
1.258     albertel 1717:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1718:         time.'_'.rand(1000000000).'.xls';
                   1719:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1720:     if (! defined($workbook)) {
                   1721:         $r->log_error("Error creating excel spreadsheet $filename: $!");
                   1722:         $r->print('<p>'.&mt("Unable to create new Excel file.  ".
                   1723:                             "This error has been logged.  ".
                   1724:                             "Please alert your LON-CAPA administrator").
                   1725:                   '</p>');
                   1726:         return (undef);
                   1727:     }
                   1728:     #
                   1729:     $workbook->set_tempdir('/home/httpd/perl/tmp');
                   1730:     #
                   1731:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1732:     return ($workbook,$filename,$format);
                   1733: }
                   1734: 
                   1735: ###############################################################
                   1736: ###############################################################
                   1737: 
                   1738: =pod
                   1739: 
1.648     raeburn  1740: =item * &create_text_file()
1.113     bowersj2 1741: 
1.542     raeburn  1742: Create a file to write to and eventually make available to the user.
1.256     matthew  1743: If file creation fails, outputs an error message on the request object and 
                   1744: return undefs.
1.113     bowersj2 1745: 
1.256     matthew  1746: Inputs: Apache request object, and file suffix
1.113     bowersj2 1747: 
1.256     matthew  1748: Returns (undef) on failure, 
                   1749:     Filehandle and filename on success.
1.113     bowersj2 1750: 
                   1751: =cut
                   1752: 
1.256     matthew  1753: ###############################################################
                   1754: ###############################################################
                   1755: sub create_text_file {
                   1756:     my ($r,$suffix) = @_;
                   1757:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1758:     my $fh;
                   1759:     my $filename = '/prtspool/'.
1.258     albertel 1760:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1761:         time.'_'.rand(1000000000).'.'.$suffix;
                   1762:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1763:     if (! defined($fh)) {
                   1764:         $r->log_error("Couldn't open $filename for output $!");
1.683     bisitz   1765:         $r->print(&mt('Problems occurred in creating the output file. '
                   1766:                      .'This error has been logged. '
                   1767:                      .'Please alert your LON-CAPA administrator.'));
1.113     bowersj2 1768:     }
1.256     matthew  1769:     return ($fh,$filename)
1.113     bowersj2 1770: }
                   1771: 
                   1772: 
1.256     matthew  1773: =pod 
1.113     bowersj2 1774: 
                   1775: =back
                   1776: 
                   1777: =cut
1.37      matthew  1778: 
                   1779: ###############################################################
1.33      matthew  1780: ##        Home server <option> list generating code          ##
                   1781: ###############################################################
1.35      matthew  1782: 
1.169     www      1783: # ------------------------------------------
                   1784: 
                   1785: sub domain_select {
                   1786:     my ($name,$value,$multiple)=@_;
                   1787:     my %domains=map { 
1.514     albertel 1788: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1789:     } &Apache::lonnet::all_domains();
1.169     www      1790:     if ($multiple) {
                   1791: 	$domains{''}=&mt('Any domain');
1.550     albertel 1792: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1793: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1794:     } else {
1.550     albertel 1795: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169     www      1796: 	return &select_form($name,$value,%domains);
                   1797:     }
                   1798: }
                   1799: 
1.282     albertel 1800: #-------------------------------------------
                   1801: 
                   1802: =pod
                   1803: 
1.519     raeburn  1804: =head1 Routines for form select boxes
                   1805: 
                   1806: =over 4
                   1807: 
1.648     raeburn  1808: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1809: 
                   1810: Returns a string containing a <select> element int multiple mode
                   1811: 
                   1812: 
                   1813: Args:
                   1814:   $name - name of the <select> element
1.506     raeburn  1815:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1816:   $size - number of rows long the select element is
1.283     albertel 1817:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1818:           (shown text should already have been &mt())
1.506     raeburn  1819:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1820: 
1.282     albertel 1821: =cut
                   1822: 
                   1823: #-------------------------------------------
1.169     www      1824: sub multiple_select_form {
1.284     albertel 1825:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1826:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1827:     my $output='';
1.191     matthew  1828:     if (! defined($size)) {
                   1829:         $size = 4;
1.283     albertel 1830:         if (scalar(keys(%$hash))<4) {
                   1831:             $size = scalar(keys(%$hash));
1.191     matthew  1832:         }
                   1833:     }
1.734     bisitz   1834:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1835:     my @order;
1.506     raeburn  1836:     if (ref($order) eq 'ARRAY')  {
                   1837:         @order = @{$order};
                   1838:     } else {
                   1839:         @order = sort(keys(%$hash));
1.501     banghart 1840:     }
                   1841:     if (exists($$hash{'select_form_order'})) {
                   1842:         @order = @{$$hash{'select_form_order'}};
                   1843:     }
                   1844:         
1.284     albertel 1845:     foreach my $key (@order) {
1.356     albertel 1846:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1847:         $output.='selected="selected" ' if ($selected{$key});
                   1848:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1849:     }
                   1850:     $output.="</select>\n";
                   1851:     return $output;
                   1852: }
                   1853: 
1.88      www      1854: #-------------------------------------------
                   1855: 
                   1856: =pod
                   1857: 
1.648     raeburn  1858: =item * &select_form($defdom,$name,%hash)
1.88      www      1859: 
                   1860: Returns a string containing a <select name='$name' size='1'> form to 
                   1861: allow a user to select options from a hash option_name => displayed text.  
                   1862: See lonrights.pm for an example invocation and use.
                   1863: 
                   1864: =cut
                   1865: 
                   1866: #-------------------------------------------
                   1867: sub select_form {
                   1868:     my ($def,$name,%hash) = @_;
                   1869:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128     albertel 1870:     my @keys;
                   1871:     if (exists($hash{'select_form_order'})) {
                   1872: 	@keys=@{$hash{'select_form_order'}};
                   1873:     } else {
                   1874: 	@keys=sort(keys(%hash));
                   1875:     }
1.356     albertel 1876:     foreach my $key (@keys) {
                   1877:         $selectform.=
                   1878: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1879:             ($key eq $def ? 'selected="selected" ' : '').
1.922   ! bisitz   1880:                 ">".$hash{$key}."</option>\n";
1.88      www      1881:     }
                   1882:     $selectform.="</select>";
                   1883:     return $selectform;
                   1884: }
                   1885: 
1.475     www      1886: # For display filters
                   1887: 
                   1888: sub display_filter {
                   1889:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1890:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1891:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1892: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1893: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1894: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1895:            &mt('Filter [_1]',
1.477     www      1896: 	   &select_form($env{'form.displayfilter'},
                   1897: 			'displayfilter',
                   1898: 			('currentfolder' => 'Current folder/page',
                   1899: 			 'containing' => 'Containing phrase',
                   1900: 			 'none' => 'None'))).
1.714     bisitz   1901: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1902: }
                   1903: 
1.167     www      1904: sub gradeleveldescription {
                   1905:     my $gradelevel=shift;
                   1906:     my %gradelevels=(0 => 'Not specified',
                   1907: 		     1 => 'Grade 1',
                   1908: 		     2 => 'Grade 2',
                   1909: 		     3 => 'Grade 3',
                   1910: 		     4 => 'Grade 4',
                   1911: 		     5 => 'Grade 5',
                   1912: 		     6 => 'Grade 6',
                   1913: 		     7 => 'Grade 7',
                   1914: 		     8 => 'Grade 8',
                   1915: 		     9 => 'Grade 9',
                   1916: 		     10 => 'Grade 10',
                   1917: 		     11 => 'Grade 11',
                   1918: 		     12 => 'Grade 12',
                   1919: 		     13 => 'Grade 13',
                   1920: 		     14 => '100 Level',
                   1921: 		     15 => '200 Level',
                   1922: 		     16 => '300 Level',
                   1923: 		     17 => '400 Level',
                   1924: 		     18 => 'Graduate Level');
                   1925:     return &mt($gradelevels{$gradelevel});
                   1926: }
                   1927: 
1.163     www      1928: sub select_level_form {
                   1929:     my ($deflevel,$name)=@_;
                   1930:     unless ($deflevel) { $deflevel=0; }
1.167     www      1931:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   1932:     for (my $i=0; $i<=18; $i++) {
                   1933:         $selectform.="<option value=\"$i\" ".
1.253     albertel 1934:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      1935:                 ">".&gradeleveldescription($i)."</option>\n";
                   1936:     }
                   1937:     $selectform.="</select>";
                   1938:     return $selectform;
1.163     www      1939: }
1.167     www      1940: 
1.35      matthew  1941: #-------------------------------------------
                   1942: 
1.45      matthew  1943: =pod
                   1944: 
1.910     raeburn  1945: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  1946: 
                   1947: Returns a string containing a <select name='$name' size='1'> form to 
                   1948: allow a user to select the domain to preform an operation in.  
                   1949: See loncreateuser.pm for an example invocation and use.
                   1950: 
1.90      www      1951: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   1952: selected");
                   1953: 
1.743     raeburn  1954: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   1955: 
1.910     raeburn  1956: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
                   1957: 
                   1958: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  1959: 
1.35      matthew  1960: =cut
                   1961: 
                   1962: #-------------------------------------------
1.34      matthew  1963: sub select_dom_form {
1.910     raeburn  1964:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  1965:     if ($onchange) {
1.874     raeburn  1966:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  1967:     }
1.910     raeburn  1968:     my @domains;
                   1969:     if (ref($incdoms) eq 'ARRAY') {
                   1970:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   1971:     } else {
                   1972:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   1973:     }
1.90      www      1974:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  1975:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 1976:     foreach my $dom (@domains) {
                   1977:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  1978:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   1979:         if ($showdomdesc) {
                   1980:             if ($dom ne '') {
                   1981:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   1982:                 if ($domdesc ne '') {
                   1983:                     $selectdomain .= ' ('.$domdesc.')';
                   1984:                 }
                   1985:             } 
                   1986:         }
                   1987:         $selectdomain .= "</option>\n";
1.34      matthew  1988:     }
                   1989:     $selectdomain.="</select>";
                   1990:     return $selectdomain;
                   1991: }
                   1992: 
1.35      matthew  1993: #-------------------------------------------
                   1994: 
1.45      matthew  1995: =pod
                   1996: 
1.648     raeburn  1997: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  1998: 
1.586     raeburn  1999: input: 4 arguments (two required, two optional) - 
                   2000:     $domain - domain of new user
                   2001:     $name - name of form element
                   2002:     $default - Value of 'default' causes a default item to be first 
                   2003:                             option, and selected by default. 
                   2004:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2005:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2006: output: returns 2 items: 
1.586     raeburn  2007: (a) form element which contains either:
                   2008:    (i) <select name="$name">
                   2009:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2010:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2011:        </select>
                   2012:        form item if there are multiple library servers in $domain, or
                   2013:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2014:        if there is only one library server in $domain.
                   2015: 
                   2016: (b) number of library servers found.
                   2017: 
                   2018: See loncreateuser.pm for example of use.
1.35      matthew  2019: 
                   2020: =cut
                   2021: 
                   2022: #-------------------------------------------
1.586     raeburn  2023: sub home_server_form_item {
                   2024:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2025:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2026:     my $result;
                   2027:     my $numlib = keys(%servers);
                   2028:     if ($numlib > 1) {
                   2029:         $result .= '<select name="'.$name.'" />'."\n";
                   2030:         if ($default) {
1.804     bisitz   2031:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2032:                        '</option>'."\n";
                   2033:         }
                   2034:         foreach my $hostid (sort(keys(%servers))) {
                   2035:             $result.= '<option value="'.$hostid.'">'.
                   2036: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2037:         }
                   2038:         $result .= '</select>'."\n";
                   2039:     } elsif ($numlib == 1) {
                   2040:         my $hostid;
                   2041:         foreach my $item (keys(%servers)) {
                   2042:             $hostid = $item;
                   2043:         }
                   2044:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2045:                    $hostid.'" />';
                   2046:                    if (!$hide) {
                   2047:                        $result .= $hostid.' '.$servers{$hostid};
                   2048:                    }
                   2049:                    $result .= "\n";
                   2050:     } elsif ($default) {
                   2051:         $result .= '<input type="hidden" name="'.$name.
                   2052:                    '" value="default" />';
                   2053:                    if (!$hide) {
                   2054:                        $result .= &mt('default');
                   2055:                    }
                   2056:                    $result .= "\n";
1.33      matthew  2057:     }
1.586     raeburn  2058:     return ($result,$numlib);
1.33      matthew  2059: }
1.112     bowersj2 2060: 
                   2061: =pod
                   2062: 
1.534     albertel 2063: =back 
                   2064: 
1.112     bowersj2 2065: =cut
1.87      matthew  2066: 
                   2067: ###############################################################
1.112     bowersj2 2068: ##                  Decoding User Agent                      ##
1.87      matthew  2069: ###############################################################
                   2070: 
                   2071: =pod
                   2072: 
1.112     bowersj2 2073: =head1 Decoding the User Agent
                   2074: 
                   2075: =over 4
                   2076: 
                   2077: =item * &decode_user_agent()
1.87      matthew  2078: 
                   2079: Inputs: $r
                   2080: 
                   2081: Outputs:
                   2082: 
                   2083: =over 4
                   2084: 
1.112     bowersj2 2085: =item * $httpbrowser
1.87      matthew  2086: 
1.112     bowersj2 2087: =item * $clientbrowser
1.87      matthew  2088: 
1.112     bowersj2 2089: =item * $clientversion
1.87      matthew  2090: 
1.112     bowersj2 2091: =item * $clientmathml
1.87      matthew  2092: 
1.112     bowersj2 2093: =item * $clientunicode
1.87      matthew  2094: 
1.112     bowersj2 2095: =item * $clientos
1.87      matthew  2096: 
                   2097: =back
                   2098: 
1.157     matthew  2099: =back 
                   2100: 
1.87      matthew  2101: =cut
                   2102: 
                   2103: ###############################################################
                   2104: ###############################################################
                   2105: sub decode_user_agent {
1.247     albertel 2106:     my ($r)=@_;
1.87      matthew  2107:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2108:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2109:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2110:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2111:     my $clientbrowser='unknown';
                   2112:     my $clientversion='0';
                   2113:     my $clientmathml='';
                   2114:     my $clientunicode='0';
                   2115:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2116:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2117: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2118: 	    $clientbrowser=$bname;
                   2119:             $httpbrowser=~/$vreg/i;
                   2120: 	    $clientversion=$1;
                   2121:             $clientmathml=($clientversion>=$minv);
                   2122:             $clientunicode=($clientversion>=$univ);
                   2123: 	}
                   2124:     }
                   2125:     my $clientos='unknown';
                   2126:     if (($httpbrowser=~/linux/i) ||
                   2127:         ($httpbrowser=~/unix/i) ||
                   2128:         ($httpbrowser=~/ux/i) ||
                   2129:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2130:     if (($httpbrowser=~/vax/i) ||
                   2131:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2132:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2133:     if (($httpbrowser=~/mac/i) ||
                   2134:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2135:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2136:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2137:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2138:             $clientunicode,$clientos,);
                   2139: }
                   2140: 
1.32      matthew  2141: ###############################################################
                   2142: ##    Authentication changing form generation subroutines    ##
                   2143: ###############################################################
                   2144: ##
                   2145: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2146: ## hash, and have reasonable default values.
                   2147: ##
                   2148: ##    formname = the name given in the <form> tag.
1.35      matthew  2149: #-------------------------------------------
                   2150: 
1.45      matthew  2151: =pod
                   2152: 
1.112     bowersj2 2153: =head1 Authentication Routines
                   2154: 
                   2155: =over 4
                   2156: 
1.648     raeburn  2157: =item * &authform_xxxxxx()
1.35      matthew  2158: 
                   2159: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2160: handle some of the conveniences required for authentication forms.  
                   2161: This is not an optimal method, but it works.  
                   2162: 
                   2163: =over 4
                   2164: 
1.112     bowersj2 2165: =item * authform_header
1.35      matthew  2166: 
1.112     bowersj2 2167: =item * authform_authorwarning
1.35      matthew  2168: 
1.112     bowersj2 2169: =item * authform_nochange
1.35      matthew  2170: 
1.112     bowersj2 2171: =item * authform_kerberos
1.35      matthew  2172: 
1.112     bowersj2 2173: =item * authform_internal
1.35      matthew  2174: 
1.112     bowersj2 2175: =item * authform_filesystem
1.35      matthew  2176: 
                   2177: =back
                   2178: 
1.648     raeburn  2179: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2180: 
1.35      matthew  2181: =cut
                   2182: 
                   2183: #-------------------------------------------
1.32      matthew  2184: sub authform_header{  
                   2185:     my %in = (
                   2186:         formname => 'cu',
1.80      albertel 2187:         kerb_def_dom => '',
1.32      matthew  2188:         @_,
                   2189:     );
                   2190:     $in{'formname'} = 'document.' . $in{'formname'};
                   2191:     my $result='';
1.80      albertel 2192: 
                   2193: #---------------------------------------------- Code for upper case translation
                   2194:     my $Javascript_toUpperCase;
                   2195:     unless ($in{kerb_def_dom}) {
                   2196:         $Javascript_toUpperCase =<<"END";
                   2197:         switch (choice) {
                   2198:            case 'krb': currentform.elements[choicearg].value =
                   2199:                currentform.elements[choicearg].value.toUpperCase();
                   2200:                break;
                   2201:            default:
                   2202:         }
                   2203: END
                   2204:     } else {
                   2205:         $Javascript_toUpperCase = "";
                   2206:     }
                   2207: 
1.165     raeburn  2208:     my $radioval = "'nochange'";
1.591     raeburn  2209:     if (defined($in{'curr_authtype'})) {
                   2210:         if ($in{'curr_authtype'} ne '') {
                   2211:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2212:         }
1.174     matthew  2213:     }
1.165     raeburn  2214:     my $argfield = 'null';
1.591     raeburn  2215:     if (defined($in{'mode'})) {
1.165     raeburn  2216:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2217:             if (defined($in{'curr_autharg'})) {
                   2218:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2219:                     $argfield = "'$in{'curr_autharg'}'";
                   2220:                 }
                   2221:             }
                   2222:         }
                   2223:     }
                   2224: 
1.32      matthew  2225:     $result.=<<"END";
                   2226: var current = new Object();
1.165     raeburn  2227: current.radiovalue = $radioval;
                   2228: current.argfield = $argfield;
1.32      matthew  2229: 
                   2230: function changed_radio(choice,currentform) {
                   2231:     var choicearg = choice + 'arg';
                   2232:     // If a radio button in changed, we need to change the argfield
                   2233:     if (current.radiovalue != choice) {
                   2234:         current.radiovalue = choice;
                   2235:         if (current.argfield != null) {
                   2236:             currentform.elements[current.argfield].value = '';
                   2237:         }
                   2238:         if (choice == 'nochange') {
                   2239:             current.argfield = null;
                   2240:         } else {
                   2241:             current.argfield = choicearg;
                   2242:             switch(choice) {
                   2243:                 case 'krb': 
                   2244:                     currentform.elements[current.argfield].value = 
                   2245:                         "$in{'kerb_def_dom'}";
                   2246:                 break;
                   2247:               default:
                   2248:                 break;
                   2249:             }
                   2250:         }
                   2251:     }
                   2252:     return;
                   2253: }
1.22      www      2254: 
1.32      matthew  2255: function changed_text(choice,currentform) {
                   2256:     var choicearg = choice + 'arg';
                   2257:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2258:         $Javascript_toUpperCase
1.32      matthew  2259:         // clear old field
                   2260:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2261:             currentform.elements[current.argfield].value = '';
                   2262:         }
                   2263:         current.argfield = choicearg;
                   2264:     }
                   2265:     set_auth_radio_buttons(choice,currentform);
                   2266:     return;
1.20      www      2267: }
1.32      matthew  2268: 
                   2269: function set_auth_radio_buttons(newvalue,currentform) {
                   2270:     var i=0;
                   2271:     while (i < currentform.login.length) {
                   2272:         if (currentform.login[i].value == newvalue) { break; }
                   2273:         i++;
                   2274:     }
                   2275:     if (i == currentform.login.length) {
                   2276:         return;
                   2277:     }
                   2278:     current.radiovalue = newvalue;
                   2279:     currentform.login[i].checked = true;
                   2280:     return;
                   2281: }
                   2282: END
                   2283:     return $result;
                   2284: }
                   2285: 
                   2286: sub authform_authorwarning{
                   2287:     my $result='';
1.144     matthew  2288:     $result='<i>'.
                   2289:         &mt('As a general rule, only authors or co-authors should be '.
                   2290:             'filesystem authenticated '.
                   2291:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2292:     return $result;
                   2293: }
                   2294: 
                   2295: sub authform_nochange{  
                   2296:     my %in = (
                   2297:               formname => 'document.cu',
                   2298:               kerb_def_dom => 'MSU.EDU',
                   2299:               @_,
                   2300:           );
1.586     raeburn  2301:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2302:     my $result;
                   2303:     if (keys(%can_assign) == 0) {
                   2304:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2305:     } else {
                   2306:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2307:                   '<input type="radio" name="login" value="nochange" '.
                   2308:                   'checked="checked" onclick="'.
1.281     albertel 2309:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2310: 	    '</label>';
1.586     raeburn  2311:     }
1.32      matthew  2312:     return $result;
                   2313: }
                   2314: 
1.591     raeburn  2315: sub authform_kerberos {
1.32      matthew  2316:     my %in = (
                   2317:               formname => 'document.cu',
                   2318:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2319:               kerb_def_auth => 'krb4',
1.32      matthew  2320:               @_,
                   2321:               );
1.586     raeburn  2322:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2323:         $autharg,$jscall);
                   2324:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2325:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2326:        $check5 = ' checked="checked"';
1.80      albertel 2327:     } else {
1.772     bisitz   2328:        $check4 = ' checked="checked"';
1.80      albertel 2329:     }
1.165     raeburn  2330:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2331:     if (defined($in{'curr_authtype'})) {
                   2332:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2333:             $krbcheck = ' checked="checked"';
1.623     raeburn  2334:             if (defined($in{'mode'})) {
                   2335:                 if ($in{'mode'} eq 'modifyuser') {
                   2336:                     $krbcheck = '';
                   2337:                 }
                   2338:             }
1.591     raeburn  2339:             if (defined($in{'curr_kerb_ver'})) {
                   2340:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2341:                     $check5 = ' checked="checked"';
1.591     raeburn  2342:                     $check4 = '';
                   2343:                 } else {
1.772     bisitz   2344:                     $check4 = ' checked="checked"';
1.591     raeburn  2345:                     $check5 = '';
                   2346:                 }
1.586     raeburn  2347:             }
1.591     raeburn  2348:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2349:                 $krbarg = $in{'curr_autharg'};
                   2350:             }
1.586     raeburn  2351:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2352:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2353:                     $result = 
                   2354:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2355:         $in{'curr_autharg'},$krbver);
                   2356:                 } else {
                   2357:                     $result =
                   2358:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2359:                 }
                   2360:                 return $result; 
                   2361:             }
                   2362:         }
                   2363:     } else {
                   2364:         if ($authnum == 1) {
1.784     bisitz   2365:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2366:         }
                   2367:     }
1.586     raeburn  2368:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2369:         return;
1.587     raeburn  2370:     } elsif ($authtype eq '') {
1.591     raeburn  2371:         if (defined($in{'mode'})) {
1.587     raeburn  2372:             if ($in{'mode'} eq 'modifycourse') {
                   2373:                 if ($authnum == 1) {
1.784     bisitz   2374:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2375:                 }
                   2376:             }
                   2377:         }
1.586     raeburn  2378:     }
                   2379:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2380:     if ($authtype eq '') {
                   2381:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2382:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2383:                     $krbcheck.' />';
                   2384:     }
                   2385:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2386:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2387:          $in{'curr_authtype'} eq 'krb5') ||
                   2388:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2389:          $in{'curr_authtype'} eq 'krb4')) {
                   2390:         $result .= &mt
1.144     matthew  2391:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2392:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2393:          '<label>'.$authtype,
1.281     albertel 2394:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2395:              'value="'.$krbarg.'" '.
1.144     matthew  2396:              'onchange="'.$jscall.'" />',
1.281     albertel 2397:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2398:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2399: 	 '</label>');
1.586     raeburn  2400:     } elsif ($can_assign{'krb4'}) {
                   2401:         $result .= &mt
                   2402:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2403:          '[_3] Version 4 [_4]',
                   2404:          '<label>'.$authtype,
                   2405:          '</label><input type="text" size="10" name="krbarg" '.
                   2406:              'value="'.$krbarg.'" '.
                   2407:              'onchange="'.$jscall.'" />',
                   2408:          '<label><input type="hidden" name="krbver" value="4" />',
                   2409:          '</label>');
                   2410:     } elsif ($can_assign{'krb5'}) {
                   2411:         $result .= &mt
                   2412:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2413:          '[_3] Version 5 [_4]',
                   2414:          '<label>'.$authtype,
                   2415:          '</label><input type="text" size="10" name="krbarg" '.
                   2416:              'value="'.$krbarg.'" '.
                   2417:              'onchange="'.$jscall.'" />',
                   2418:          '<label><input type="hidden" name="krbver" value="5" />',
                   2419:          '</label>');
                   2420:     }
1.32      matthew  2421:     return $result;
                   2422: }
                   2423: 
                   2424: sub authform_internal{  
1.586     raeburn  2425:     my %in = (
1.32      matthew  2426:                 formname => 'document.cu',
                   2427:                 kerb_def_dom => 'MSU.EDU',
                   2428:                 @_,
                   2429:                 );
1.586     raeburn  2430:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2431:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2432:     if (defined($in{'curr_authtype'})) {
                   2433:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2434:             if ($can_assign{'int'}) {
1.772     bisitz   2435:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2436:                 if (defined($in{'mode'})) {
                   2437:                     if ($in{'mode'} eq 'modifyuser') {
                   2438:                         $intcheck = '';
                   2439:                     }
                   2440:                 }
1.591     raeburn  2441:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2442:                     $intarg = $in{'curr_autharg'};
                   2443:                 }
                   2444:             } else {
                   2445:                 $result = &mt('Currently internally authenticated.');
                   2446:                 return $result;
1.165     raeburn  2447:             }
                   2448:         }
1.586     raeburn  2449:     } else {
                   2450:         if ($authnum == 1) {
1.784     bisitz   2451:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2452:         }
                   2453:     }
                   2454:     if (!$can_assign{'int'}) {
                   2455:         return;
1.587     raeburn  2456:     } elsif ($authtype eq '') {
1.591     raeburn  2457:         if (defined($in{'mode'})) {
1.587     raeburn  2458:             if ($in{'mode'} eq 'modifycourse') {
                   2459:                 if ($authnum == 1) {
1.784     bisitz   2460:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2461:                 }
                   2462:             }
                   2463:         }
1.165     raeburn  2464:     }
1.586     raeburn  2465:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2466:     if ($authtype eq '') {
                   2467:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2468:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2469:     }
1.605     bisitz   2470:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2471:                $intarg.'" onchange="'.$jscall.'" />';
                   2472:     $result = &mt
1.144     matthew  2473:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2474:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2475:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  2476:     return $result;
                   2477: }
                   2478: 
                   2479: sub authform_local{  
                   2480:     my %in = (
                   2481:               formname => 'document.cu',
                   2482:               kerb_def_dom => 'MSU.EDU',
                   2483:               @_,
                   2484:               );
1.586     raeburn  2485:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2486:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2487:     if (defined($in{'curr_authtype'})) {
                   2488:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2489:             if ($can_assign{'loc'}) {
1.772     bisitz   2490:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2491:                 if (defined($in{'mode'})) {
                   2492:                     if ($in{'mode'} eq 'modifyuser') {
                   2493:                         $loccheck = '';
                   2494:                     }
                   2495:                 }
1.591     raeburn  2496:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2497:                     $locarg = $in{'curr_autharg'};
                   2498:                 }
                   2499:             } else {
                   2500:                 $result = &mt('Currently using local (institutional) authentication.');
                   2501:                 return $result;
1.165     raeburn  2502:             }
                   2503:         }
1.586     raeburn  2504:     } else {
                   2505:         if ($authnum == 1) {
1.784     bisitz   2506:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2507:         }
                   2508:     }
                   2509:     if (!$can_assign{'loc'}) {
                   2510:         return;
1.587     raeburn  2511:     } elsif ($authtype eq '') {
1.591     raeburn  2512:         if (defined($in{'mode'})) {
1.587     raeburn  2513:             if ($in{'mode'} eq 'modifycourse') {
                   2514:                 if ($authnum == 1) {
1.784     bisitz   2515:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2516:                 }
                   2517:             }
                   2518:         }
1.165     raeburn  2519:     }
1.586     raeburn  2520:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2521:     if ($authtype eq '') {
                   2522:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2523:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2524:                     $jscall.'" />';
                   2525:     }
                   2526:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2527:                $locarg.'" onchange="'.$jscall.'" />';
                   2528:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2529:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2530:     return $result;
                   2531: }
                   2532: 
                   2533: sub authform_filesystem{  
                   2534:     my %in = (
                   2535:               formname => 'document.cu',
                   2536:               kerb_def_dom => 'MSU.EDU',
                   2537:               @_,
                   2538:               );
1.586     raeburn  2539:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2540:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2541:     if (defined($in{'curr_authtype'})) {
                   2542:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2543:             if ($can_assign{'fsys'}) {
1.772     bisitz   2544:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2545:                 if (defined($in{'mode'})) {
                   2546:                     if ($in{'mode'} eq 'modifyuser') {
                   2547:                         $fsyscheck = '';
                   2548:                     }
                   2549:                 }
1.586     raeburn  2550:             } else {
                   2551:                 $result = &mt('Currently Filesystem Authenticated.');
                   2552:                 return $result;
                   2553:             }           
                   2554:         }
                   2555:     } else {
                   2556:         if ($authnum == 1) {
1.784     bisitz   2557:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2558:         }
                   2559:     }
                   2560:     if (!$can_assign{'fsys'}) {
                   2561:         return;
1.587     raeburn  2562:     } elsif ($authtype eq '') {
1.591     raeburn  2563:         if (defined($in{'mode'})) {
1.587     raeburn  2564:             if ($in{'mode'} eq 'modifycourse') {
                   2565:                 if ($authnum == 1) {
1.784     bisitz   2566:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2567:                 }
                   2568:             }
                   2569:         }
1.586     raeburn  2570:     }
                   2571:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2572:     if ($authtype eq '') {
                   2573:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2574:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2575:                     $jscall.'" />';
                   2576:     }
                   2577:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2578:                ' onchange="'.$jscall.'" />';
                   2579:     $result = &mt
1.144     matthew  2580:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2581:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2582:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2583:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2584:                   'onchange="'.$jscall.'" />');
1.32      matthew  2585:     return $result;
                   2586: }
                   2587: 
1.586     raeburn  2588: sub get_assignable_auth {
                   2589:     my ($dom) = @_;
                   2590:     if ($dom eq '') {
                   2591:         $dom = $env{'request.role.domain'};
                   2592:     }
                   2593:     my %can_assign = (
                   2594:                           krb4 => 1,
                   2595:                           krb5 => 1,
                   2596:                           int  => 1,
                   2597:                           loc  => 1,
                   2598:                      );
                   2599:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2600:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2601:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2602:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2603:             my $context;
                   2604:             if ($env{'request.role'} =~ /^au/) {
                   2605:                 $context = 'author';
                   2606:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2607:                 $context = 'domain';
                   2608:             } elsif ($env{'request.course.id'}) {
                   2609:                 $context = 'course';
                   2610:             }
                   2611:             if ($context) {
                   2612:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2613:                    %can_assign = %{$authhash->{$context}}; 
                   2614:                 }
                   2615:             }
                   2616:         }
                   2617:     }
                   2618:     my $authnum = 0;
                   2619:     foreach my $key (keys(%can_assign)) {
                   2620:         if ($can_assign{$key}) {
                   2621:             $authnum ++;
                   2622:         }
                   2623:     }
                   2624:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2625:         $authnum --;
                   2626:     }
                   2627:     return ($authnum,%can_assign);
                   2628: }
                   2629: 
1.80      albertel 2630: ###############################################################
                   2631: ##    Get Kerberos Defaults for Domain                 ##
                   2632: ###############################################################
                   2633: ##
                   2634: ## Returns default kerberos version and an associated argument
                   2635: ## as listed in file domain.tab. If not listed, provides
                   2636: ## appropriate default domain and kerberos version.
                   2637: ##
                   2638: #-------------------------------------------
                   2639: 
                   2640: =pod
                   2641: 
1.648     raeburn  2642: =item * &get_kerberos_defaults()
1.80      albertel 2643: 
                   2644: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2645: version and domain. If not found, it defaults to version 4 and the 
                   2646: domain of the server.
1.80      albertel 2647: 
1.648     raeburn  2648: =over 4
                   2649: 
1.80      albertel 2650: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2651: 
1.648     raeburn  2652: =back
                   2653: 
                   2654: =back
                   2655: 
1.80      albertel 2656: =cut
                   2657: 
                   2658: #-------------------------------------------
                   2659: sub get_kerberos_defaults {
                   2660:     my $domain=shift;
1.641     raeburn  2661:     my ($krbdef,$krbdefdom);
                   2662:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2663:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2664:         $krbdef = $domdefaults{'auth_def'};
                   2665:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2666:     } else {
1.80      albertel 2667:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2668:         my $krbdefdom=$1;
                   2669:         $krbdefdom=~tr/a-z/A-Z/;
                   2670:         $krbdef = "krb4";
                   2671:     }
                   2672:     return ($krbdef,$krbdefdom);
                   2673: }
1.112     bowersj2 2674: 
1.32      matthew  2675: 
1.46      matthew  2676: ###############################################################
                   2677: ##                Thesaurus Functions                        ##
                   2678: ###############################################################
1.20      www      2679: 
1.46      matthew  2680: =pod
1.20      www      2681: 
1.112     bowersj2 2682: =head1 Thesaurus Functions
                   2683: 
                   2684: =over 4
                   2685: 
1.648     raeburn  2686: =item * &initialize_keywords()
1.46      matthew  2687: 
                   2688: Initializes the package variable %Keywords if it is empty.  Uses the
                   2689: package variable $thesaurus_db_file.
                   2690: 
                   2691: =cut
                   2692: 
                   2693: ###################################################
                   2694: 
                   2695: sub initialize_keywords {
                   2696:     return 1 if (scalar keys(%Keywords));
                   2697:     # If we are here, %Keywords is empty, so fill it up
                   2698:     #   Make sure the file we need exists...
                   2699:     if (! -e $thesaurus_db_file) {
                   2700:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2701:                                  " failed because it does not exist");
                   2702:         return 0;
                   2703:     }
                   2704:     #   Set up the hash as a database
                   2705:     my %thesaurus_db;
                   2706:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2707:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2708:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2709:                                  $thesaurus_db_file);
                   2710:         return 0;
                   2711:     } 
                   2712:     #  Get the average number of appearances of a word.
                   2713:     my $avecount = $thesaurus_db{'average.count'};
                   2714:     #  Put keywords (those that appear > average) into %Keywords
                   2715:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2716:         my ($count,undef) = split /:/,$data;
                   2717:         $Keywords{$word}++ if ($count > $avecount);
                   2718:     }
                   2719:     untie %thesaurus_db;
                   2720:     # Remove special values from %Keywords.
1.356     albertel 2721:     foreach my $value ('total.count','average.count') {
                   2722:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2723:   }
1.46      matthew  2724:     return 1;
                   2725: }
                   2726: 
                   2727: ###################################################
                   2728: 
                   2729: =pod
                   2730: 
1.648     raeburn  2731: =item * &keyword($word)
1.46      matthew  2732: 
                   2733: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2734: than the average number of times in the thesaurus database.  Calls 
                   2735: &initialize_keywords
                   2736: 
                   2737: =cut
                   2738: 
                   2739: ###################################################
1.20      www      2740: 
                   2741: sub keyword {
1.46      matthew  2742:     return if (!&initialize_keywords());
                   2743:     my $word=lc(shift());
                   2744:     $word=~s/\W//g;
                   2745:     return exists($Keywords{$word});
1.20      www      2746: }
1.46      matthew  2747: 
                   2748: ###############################################################
                   2749: 
                   2750: =pod 
1.20      www      2751: 
1.648     raeburn  2752: =item * &get_related_words()
1.46      matthew  2753: 
1.160     matthew  2754: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2755: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2756: will be returned.  The order of the words returned is determined by the
                   2757: database which holds them.
                   2758: 
                   2759: Uses global $thesaurus_db_file.
                   2760: 
                   2761: =cut
                   2762: 
                   2763: ###############################################################
                   2764: sub get_related_words {
                   2765:     my $keyword = shift;
                   2766:     my %thesaurus_db;
                   2767:     if (! -e $thesaurus_db_file) {
                   2768:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2769:                                  "failed because the file does not exist");
                   2770:         return ();
                   2771:     }
                   2772:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2773:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2774:         return ();
                   2775:     } 
                   2776:     my @Words=();
1.429     www      2777:     my $count=0;
1.46      matthew  2778:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2779: 	# The first element is the number of times
                   2780: 	# the word appears.  We do not need it now.
1.429     www      2781: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2782: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2783: 	my $threshold=$mostfrequentcount/10;
                   2784:         foreach my $possibleword (@RelatedWords) {
                   2785:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2786:             if ($wordcount>$threshold) {
                   2787: 		push(@Words,$word);
                   2788:                 $count++;
                   2789:                 if ($count>10) { last; }
                   2790: 	    }
1.20      www      2791:         }
                   2792:     }
1.46      matthew  2793:     untie %thesaurus_db;
                   2794:     return @Words;
1.14      harris41 2795: }
1.46      matthew  2796: 
1.112     bowersj2 2797: =pod
                   2798: 
                   2799: =back
                   2800: 
                   2801: =cut
1.61      www      2802: 
                   2803: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2804: =pod
                   2805: 
1.112     bowersj2 2806: =head1 User Name Functions
                   2807: 
                   2808: =over 4
                   2809: 
1.648     raeburn  2810: =item * &plainname($uname,$udom,$first)
1.81      albertel 2811: 
1.112     bowersj2 2812: Takes a users logon name and returns it as a string in
1.226     albertel 2813: "first middle last generation" form 
                   2814: if $first is set to 'lastname' then it returns it as
                   2815: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2816: 
                   2817: =cut
1.61      www      2818: 
1.295     www      2819: 
1.81      albertel 2820: ###############################################################
1.61      www      2821: sub plainname {
1.226     albertel 2822:     my ($uname,$udom,$first)=@_;
1.537     albertel 2823:     return if (!defined($uname) || !defined($udom));
1.295     www      2824:     my %names=&getnames($uname,$udom);
1.226     albertel 2825:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2826: 					  $names{'middlename'},
                   2827: 					  $names{'lastname'},
                   2828: 					  $names{'generation'},$first);
                   2829:     $name=~s/^\s+//;
1.62      www      2830:     $name=~s/\s+$//;
                   2831:     $name=~s/\s+/ /g;
1.353     albertel 2832:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2833:     return $name;
1.61      www      2834: }
1.66      www      2835: 
                   2836: # -------------------------------------------------------------------- Nickname
1.81      albertel 2837: =pod
                   2838: 
1.648     raeburn  2839: =item * &nickname($uname,$udom)
1.81      albertel 2840: 
                   2841: Gets a users name and returns it as a string as
                   2842: 
                   2843: "&quot;nickname&quot;"
1.66      www      2844: 
1.81      albertel 2845: if the user has a nickname or
                   2846: 
                   2847: "first middle last generation"
                   2848: 
                   2849: if the user does not
                   2850: 
                   2851: =cut
1.66      www      2852: 
                   2853: sub nickname {
                   2854:     my ($uname,$udom)=@_;
1.537     albertel 2855:     return if (!defined($uname) || !defined($udom));
1.295     www      2856:     my %names=&getnames($uname,$udom);
1.68      albertel 2857:     my $name=$names{'nickname'};
1.66      www      2858:     if ($name) {
                   2859:        $name='&quot;'.$name.'&quot;'; 
                   2860:     } else {
                   2861:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2862: 	     $names{'lastname'}.' '.$names{'generation'};
                   2863:        $name=~s/\s+$//;
                   2864:        $name=~s/\s+/ /g;
                   2865:     }
                   2866:     return $name;
                   2867: }
                   2868: 
1.295     www      2869: sub getnames {
                   2870:     my ($uname,$udom)=@_;
1.537     albertel 2871:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2872:     if ($udom eq 'public' && $uname eq 'public') {
                   2873: 	return ('lastname' => &mt('Public'));
                   2874:     }
1.295     www      2875:     my $id=$uname.':'.$udom;
                   2876:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2877:     if ($cached) {
                   2878: 	return %{$names};
                   2879:     } else {
                   2880: 	my %loadnames=&Apache::lonnet::get('environment',
                   2881:                     ['firstname','middlename','lastname','generation','nickname'],
                   2882: 					 $udom,$uname);
                   2883: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2884: 	return %loadnames;
                   2885:     }
                   2886: }
1.61      www      2887: 
1.542     raeburn  2888: # -------------------------------------------------------------------- getemails
1.648     raeburn  2889: 
1.542     raeburn  2890: =pod
                   2891: 
1.648     raeburn  2892: =item * &getemails($uname,$udom)
1.542     raeburn  2893: 
                   2894: Gets a user's email information and returns it as a hash with keys:
                   2895: notification, critnotification, permanentemail
                   2896: 
                   2897: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2898: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2899:  
1.648     raeburn  2900: 
1.542     raeburn  2901: =cut
                   2902: 
1.648     raeburn  2903: 
1.466     albertel 2904: sub getemails {
                   2905:     my ($uname,$udom)=@_;
                   2906:     if ($udom eq 'public' && $uname eq 'public') {
                   2907: 	return;
                   2908:     }
1.467     www      2909:     if (!$udom) { $udom=$env{'user.domain'}; }
                   2910:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 2911:     my $id=$uname.':'.$udom;
                   2912:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   2913:     if ($cached) {
                   2914: 	return %{$names};
                   2915:     } else {
                   2916: 	my %loadnames=&Apache::lonnet::get('environment',
                   2917:                     			   ['notification','critnotification',
                   2918: 					    'permanentemail'],
                   2919: 					   $udom,$uname);
                   2920: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   2921: 	return %loadnames;
                   2922:     }
                   2923: }
                   2924: 
1.551     albertel 2925: sub flush_email_cache {
                   2926:     my ($uname,$udom)=@_;
                   2927:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2928:     if (!$uname) { $uname=$env{'user.name'};   }
                   2929:     return if ($udom eq 'public' && $uname eq 'public');
                   2930:     my $id=$uname.':'.$udom;
                   2931:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   2932: }
                   2933: 
1.728     raeburn  2934: # -------------------------------------------------------------------- getlangs
                   2935: 
                   2936: =pod
                   2937: 
                   2938: =item * &getlangs($uname,$udom)
                   2939: 
                   2940: Gets a user's language preference and returns it as a hash with key:
                   2941: language.
                   2942: 
                   2943: =cut
                   2944: 
                   2945: 
                   2946: sub getlangs {
                   2947:     my ($uname,$udom) = @_;
                   2948:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2949:     if (!$uname) { $uname=$env{'user.name'};   }
                   2950:     my $id=$uname.':'.$udom;
                   2951:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   2952:     if ($cached) {
                   2953:         return %{$langs};
                   2954:     } else {
                   2955:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   2956:                                            $udom,$uname);
                   2957:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   2958:         return %loadlangs;
                   2959:     }
                   2960: }
                   2961: 
                   2962: sub flush_langs_cache {
                   2963:     my ($uname,$udom)=@_;
                   2964:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2965:     if (!$uname) { $uname=$env{'user.name'};   }
                   2966:     return if ($udom eq 'public' && $uname eq 'public');
                   2967:     my $id=$uname.':'.$udom;
                   2968:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   2969: }
                   2970: 
1.61      www      2971: # ------------------------------------------------------------------ Screenname
1.81      albertel 2972: 
                   2973: =pod
                   2974: 
1.648     raeburn  2975: =item * &screenname($uname,$udom)
1.81      albertel 2976: 
                   2977: Gets a users screenname and returns it as a string
                   2978: 
                   2979: =cut
1.61      www      2980: 
                   2981: sub screenname {
                   2982:     my ($uname,$udom)=@_;
1.258     albertel 2983:     if ($uname eq $env{'user.name'} &&
                   2984: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 2985:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 2986:     return $names{'screenname'};
1.62      www      2987: }
                   2988: 
1.212     albertel 2989: 
1.802     bisitz   2990: # ------------------------------------------------------------- Confirm Wrapper
                   2991: =pod
                   2992: 
                   2993: =item confirmwrapper
                   2994: 
                   2995: Wrap messages about completion of operation in box
                   2996: 
                   2997: =cut
                   2998: 
                   2999: sub confirmwrapper {
                   3000:     my ($message)=@_;
                   3001:     if ($message) {
                   3002:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3003:                .$message."\n"
                   3004:                .'</div>'."\n";
                   3005:     } else {
                   3006:         return $message;
                   3007:     }
                   3008: }
                   3009: 
1.62      www      3010: # ------------------------------------------------------------- Message Wrapper
                   3011: 
                   3012: sub messagewrapper {
1.369     www      3013:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3014:     return 
1.441     albertel 3015:         '<a href="/adm/email?compose=individual&amp;'.
                   3016:         'recname='.$username.'&amp;recdom='.$domain.
                   3017: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3018:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3019: }
1.802     bisitz   3020: 
1.74      www      3021: # --------------------------------------------------------------- Notes Wrapper
                   3022: 
                   3023: sub noteswrapper {
                   3024:     my ($link,$un,$do)=@_;
                   3025:     return 
1.896     amueller 3026: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3027: }
1.802     bisitz   3028: 
1.62      www      3029: # ------------------------------------------------------------- Aboutme Wrapper
                   3030: 
                   3031: sub aboutmewrapper {
1.166     www      3032:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  3033:     if (!defined($username)  && !defined($domain)) {
                   3034:         return;
                   3035:     }
1.892     amueller 3036:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756     weissno  3037: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3038: }
                   3039: 
                   3040: # ------------------------------------------------------------ Syllabus Wrapper
                   3041: 
                   3042: sub syllabuswrapper {
1.707     bisitz   3043:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3044:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3045: }
1.14      harris41 3046: 
1.802     bisitz   3047: # -----------------------------------------------------------------------------
                   3048: 
1.208     matthew  3049: sub track_student_link {
1.887     raeburn  3050:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3051:     my $link ="/adm/trackstudent?";
1.208     matthew  3052:     my $title = 'View recent activity';
                   3053:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3054:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3055:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3056:         $title .= ' of this student';
1.268     albertel 3057:     } 
1.208     matthew  3058:     if (defined($target) && $target !~ /^\s*$/) {
                   3059:         $target = qq{target="$target"};
                   3060:     } else {
                   3061:         $target = '';
                   3062:     }
1.268     albertel 3063:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3064:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3065:     $title = &mt($title);
                   3066:     $linktext = &mt($linktext);
1.448     albertel 3067:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3068: 	&help_open_topic('View_recent_activity');
1.208     matthew  3069: }
                   3070: 
1.781     raeburn  3071: sub slot_reservations_link {
                   3072:     my ($linktext,$sname,$sdom,$target) = @_;
                   3073:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3074:     my $title = 'View slot reservation history';
                   3075:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3076:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3077:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3078:         $title .= ' of this student';
                   3079:     }
                   3080:     if (defined($target) && $target !~ /^\s*$/) {
                   3081:         $target = qq{target="$target"};
                   3082:     } else {
                   3083:         $target = '';
                   3084:     }
                   3085:     $title = &mt($title);
                   3086:     $linktext = &mt($linktext);
                   3087:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3088: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3089: 
                   3090: }
                   3091: 
1.508     www      3092: # ===================================================== Display a student photo
                   3093: 
                   3094: 
1.509     albertel 3095: sub student_image_tag {
1.508     www      3096:     my ($domain,$user)=@_;
                   3097:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3098:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3099: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3100:     } else {
                   3101: 	return '';
                   3102:     }
                   3103: }
                   3104: 
1.112     bowersj2 3105: =pod
                   3106: 
                   3107: =back
                   3108: 
                   3109: =head1 Access .tab File Data
                   3110: 
                   3111: =over 4
                   3112: 
1.648     raeburn  3113: =item * &languageids() 
1.112     bowersj2 3114: 
                   3115: returns list of all language ids
                   3116: 
                   3117: =cut
                   3118: 
1.14      harris41 3119: sub languageids {
1.16      harris41 3120:     return sort(keys(%language));
1.14      harris41 3121: }
                   3122: 
1.112     bowersj2 3123: =pod
                   3124: 
1.648     raeburn  3125: =item * &languagedescription() 
1.112     bowersj2 3126: 
                   3127: returns description of a specified language id
                   3128: 
                   3129: =cut
                   3130: 
1.14      harris41 3131: sub languagedescription {
1.125     www      3132:     my $code=shift;
                   3133:     return  ($supported_language{$code}?'* ':'').
                   3134:             $language{$code}.
1.126     www      3135: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3136: }
                   3137: 
                   3138: sub plainlanguagedescription {
                   3139:     my $code=shift;
                   3140:     return $language{$code};
                   3141: }
                   3142: 
                   3143: sub supportedlanguagecode {
                   3144:     my $code=shift;
                   3145:     return $supported_language{$code};
1.97      www      3146: }
                   3147: 
1.112     bowersj2 3148: =pod
                   3149: 
1.648     raeburn  3150: =item * &copyrightids() 
1.112     bowersj2 3151: 
                   3152: returns list of all copyrights
                   3153: 
                   3154: =cut
                   3155: 
                   3156: sub copyrightids {
                   3157:     return sort(keys(%cprtag));
                   3158: }
                   3159: 
                   3160: =pod
                   3161: 
1.648     raeburn  3162: =item * &copyrightdescription() 
1.112     bowersj2 3163: 
                   3164: returns description of a specified copyright id
                   3165: 
                   3166: =cut
                   3167: 
                   3168: sub copyrightdescription {
1.166     www      3169:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3170: }
1.197     matthew  3171: 
                   3172: =pod
                   3173: 
1.648     raeburn  3174: =item * &source_copyrightids() 
1.192     taceyjo1 3175: 
                   3176: returns list of all source copyrights
                   3177: 
                   3178: =cut
                   3179: 
                   3180: sub source_copyrightids {
                   3181:     return sort(keys(%scprtag));
                   3182: }
                   3183: 
                   3184: =pod
                   3185: 
1.648     raeburn  3186: =item * &source_copyrightdescription() 
1.192     taceyjo1 3187: 
                   3188: returns description of a specified source copyright id
                   3189: 
                   3190: =cut
                   3191: 
                   3192: sub source_copyrightdescription {
                   3193:     return &mt($scprtag{shift(@_)});
                   3194: }
1.112     bowersj2 3195: 
                   3196: =pod
                   3197: 
1.648     raeburn  3198: =item * &filecategories() 
1.112     bowersj2 3199: 
                   3200: returns list of all file categories
                   3201: 
                   3202: =cut
                   3203: 
                   3204: sub filecategories {
                   3205:     return sort(keys(%category_extensions));
                   3206: }
                   3207: 
                   3208: =pod
                   3209: 
1.648     raeburn  3210: =item * &filecategorytypes() 
1.112     bowersj2 3211: 
                   3212: returns list of file types belonging to a given file
                   3213: category
                   3214: 
                   3215: =cut
                   3216: 
                   3217: sub filecategorytypes {
1.356     albertel 3218:     my ($cat) = @_;
                   3219:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3220: }
                   3221: 
                   3222: =pod
                   3223: 
1.648     raeburn  3224: =item * &fileembstyle() 
1.112     bowersj2 3225: 
                   3226: returns embedding style for a specified file type
                   3227: 
                   3228: =cut
                   3229: 
                   3230: sub fileembstyle {
                   3231:     return $fe{lc(shift(@_))};
1.169     www      3232: }
                   3233: 
1.351     www      3234: sub filemimetype {
                   3235:     return $fm{lc(shift(@_))};
                   3236: }
                   3237: 
1.169     www      3238: 
                   3239: sub filecategoryselect {
                   3240:     my ($name,$value)=@_;
1.189     matthew  3241:     return &select_form($value,$name,
1.169     www      3242: 			'' => &mt('Any category'),
                   3243: 			map { $_,$_ } sort(keys(%category_extensions)));
1.112     bowersj2 3244: }
                   3245: 
                   3246: =pod
                   3247: 
1.648     raeburn  3248: =item * &filedescription() 
1.112     bowersj2 3249: 
                   3250: returns description for a specified file type
                   3251: 
                   3252: =cut
                   3253: 
                   3254: sub filedescription {
1.188     matthew  3255:     my $file_description = $fd{lc(shift())};
                   3256:     $file_description =~ s:([\[\]]):~$1:g;
                   3257:     return &mt($file_description);
1.112     bowersj2 3258: }
                   3259: 
                   3260: =pod
                   3261: 
1.648     raeburn  3262: =item * &filedescriptionex() 
1.112     bowersj2 3263: 
                   3264: returns description for a specified file type with
                   3265: extra formatting
                   3266: 
                   3267: =cut
                   3268: 
                   3269: sub filedescriptionex {
                   3270:     my $ex=shift;
1.188     matthew  3271:     my $file_description = $fd{lc($ex)};
                   3272:     $file_description =~ s:([\[\]]):~$1:g;
                   3273:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3274: }
                   3275: 
                   3276: # End of .tab access
                   3277: =pod
                   3278: 
                   3279: =back
                   3280: 
                   3281: =cut
                   3282: 
                   3283: # ------------------------------------------------------------------ File Types
                   3284: sub fileextensions {
                   3285:     return sort(keys(%fe));
                   3286: }
                   3287: 
1.97      www      3288: # ----------------------------------------------------------- Display Languages
                   3289: # returns a hash with all desired display languages
                   3290: #
                   3291: 
                   3292: sub display_languages {
                   3293:     my %languages=();
1.695     raeburn  3294:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3295: 	$languages{$lang}=1;
1.97      www      3296:     }
                   3297:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3298:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3299: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3300: 	    $languages{$lang}=1;
1.97      www      3301:         }
                   3302:     }
                   3303:     return %languages;
1.14      harris41 3304: }
                   3305: 
1.582     albertel 3306: sub languages {
                   3307:     my ($possible_langs) = @_;
1.695     raeburn  3308:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3309:     if (!ref($possible_langs)) {
                   3310: 	if( wantarray ) {
                   3311: 	    return @preferred_langs;
                   3312: 	} else {
                   3313: 	    return $preferred_langs[0];
                   3314: 	}
                   3315:     }
                   3316:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3317:     my @preferred_possibilities;
                   3318:     foreach my $preferred_lang (@preferred_langs) {
                   3319: 	if (exists($possibilities{$preferred_lang})) {
                   3320: 	    push(@preferred_possibilities, $preferred_lang);
                   3321: 	}
                   3322:     }
                   3323:     if( wantarray ) {
                   3324: 	return @preferred_possibilities;
                   3325:     }
                   3326:     return $preferred_possibilities[0];
                   3327: }
                   3328: 
1.742     raeburn  3329: sub user_lang {
                   3330:     my ($touname,$toudom,$fromcid) = @_;
                   3331:     my @userlangs;
                   3332:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3333:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3334:                     $env{'course.'.$fromcid.'.languages'}));
                   3335:     } else {
                   3336:         my %langhash = &getlangs($touname,$toudom);
                   3337:         if ($langhash{'languages'} ne '') {
                   3338:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3339:         } else {
                   3340:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3341:             if ($domdefs{'lang_def'} ne '') {
                   3342:                 @userlangs = ($domdefs{'lang_def'});
                   3343:             }
                   3344:         }
                   3345:     }
                   3346:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3347:     my $user_lh = Apache::localize->get_handle(@languages);
                   3348:     return $user_lh;
                   3349: }
                   3350: 
                   3351: 
1.112     bowersj2 3352: ###############################################################
                   3353: ##               Student Answer Attempts                     ##
                   3354: ###############################################################
                   3355: 
                   3356: =pod
                   3357: 
                   3358: =head1 Alternate Problem Views
                   3359: 
                   3360: =over 4
                   3361: 
1.648     raeburn  3362: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3363:     $getattempt, $regexp, $gradesub)
                   3364: 
                   3365: Return string with previous attempt on problem. Arguments:
                   3366: 
                   3367: =over 4
                   3368: 
                   3369: =item * $symb: Problem, including path
                   3370: 
                   3371: =item * $username: username of the desired student
                   3372: 
                   3373: =item * $domain: domain of the desired student
1.14      harris41 3374: 
1.112     bowersj2 3375: =item * $course: Course ID
1.14      harris41 3376: 
1.112     bowersj2 3377: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3378:     something
1.14      harris41 3379: 
1.112     bowersj2 3380: =item * $regexp: if string matches this regexp, the string will be
                   3381:     sent to $gradesub
1.14      harris41 3382: 
1.112     bowersj2 3383: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3384: 
1.112     bowersj2 3385: =back
1.14      harris41 3386: 
1.112     bowersj2 3387: The output string is a table containing all desired attempts, if any.
1.16      harris41 3388: 
1.112     bowersj2 3389: =cut
1.1       albertel 3390: 
                   3391: sub get_previous_attempt {
1.43      ng       3392:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3393:   my $prevattempts='';
1.43      ng       3394:   no strict 'refs';
1.1       albertel 3395:   if ($symb) {
1.3       albertel 3396:     my (%returnhash)=
                   3397:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3398:     if ($returnhash{'version'}) {
                   3399:       my %lasthash=();
                   3400:       my $version;
                   3401:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3402:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3403: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3404:         }
1.1       albertel 3405:       }
1.596     albertel 3406:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3407:       $prevattempts.='<th>'.&mt('History').'</th>';
1.356     albertel 3408:       foreach my $key (sort(keys(%lasthash))) {
                   3409: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3410: 	if ($#parts > 0) {
1.31      albertel 3411: 	  my $data=$parts[-1];
                   3412: 	  pop(@parts);
1.596     albertel 3413: 	  $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.31      albertel 3414: 	} else {
1.41      ng       3415: 	  if ($#parts == 0) {
                   3416: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3417: 	  } else {
                   3418: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3419: 	  }
1.31      albertel 3420: 	}
1.16      harris41 3421:       }
1.596     albertel 3422:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3423:       if ($getattempt eq '') {
                   3424: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596     albertel 3425: 	  $prevattempts.=&start_data_table_row().
                   3426: 	      '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356     albertel 3427: 	    foreach my $key (sort(keys(%lasthash))) {
1.581     albertel 3428: 		my $value = &format_previous_attempt_value($key,
                   3429: 							   $returnhash{$version.':'.$key});
                   3430: 		$prevattempts.='<td>'.$value.'&nbsp;</td>';   
1.40      ng       3431: 	    }
1.596     albertel 3432: 	  $prevattempts.=&end_data_table_row();
1.40      ng       3433: 	 }
1.1       albertel 3434:       }
1.596     albertel 3435:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3436:       foreach my $key (sort(keys(%lasthash))) {
1.581     albertel 3437: 	my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356     albertel 3438: 	if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40      ng       3439: 	$prevattempts.='<td>'.$value.'&nbsp;</td>';
1.16      harris41 3440:       }
1.596     albertel 3441:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3442:     } else {
1.596     albertel 3443:       $prevattempts=
                   3444: 	  &start_data_table().&start_data_table_row().
                   3445: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3446: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3447:     }
                   3448:   } else {
1.596     albertel 3449:     $prevattempts=
                   3450: 	  &start_data_table().&start_data_table_row().
                   3451: 	  '<td>'.&mt('No data.').'</td>'.
                   3452: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3453:   }
1.10      albertel 3454: }
                   3455: 
1.581     albertel 3456: sub format_previous_attempt_value {
                   3457:     my ($key,$value) = @_;
                   3458:     if ($key =~ /timestamp/) {
                   3459: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3460:     } elsif (ref($value) eq 'ARRAY') {
                   3461: 	$value = '('.join(', ', @{ $value }).')';
                   3462:     } else {
                   3463: 	$value = &unescape($value);
                   3464:     }
                   3465:     return $value;
                   3466: }
                   3467: 
                   3468: 
1.107     albertel 3469: sub relative_to_absolute {
                   3470:     my ($url,$output)=@_;
                   3471:     my $parser=HTML::TokeParser->new(\$output);
                   3472:     my $token;
                   3473:     my $thisdir=$url;
                   3474:     my @rlinks=();
                   3475:     while ($token=$parser->get_token) {
                   3476: 	if ($token->[0] eq 'S') {
                   3477: 	    if ($token->[1] eq 'a') {
                   3478: 		if ($token->[2]->{'href'}) {
                   3479: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3480: 		}
                   3481: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3482: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3483: 	    } elsif ($token->[1] eq 'base') {
                   3484: 		$thisdir=$token->[2]->{'href'};
                   3485: 	    }
                   3486: 	}
                   3487:     }
                   3488:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3489:     foreach my $link (@rlinks) {
1.726     raeburn  3490: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3491: 		($link=~/^\//) ||
                   3492: 		($link=~/^javascript:/i) ||
                   3493: 		($link=~/^mailto:/i) ||
                   3494: 		($link=~/^\#/)) {
                   3495: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3496: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3497: 	}
                   3498:     }
                   3499: # -------------------------------------------------- Deal with Applet codebases
                   3500:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3501:     return $output;
                   3502: }
                   3503: 
1.112     bowersj2 3504: =pod
                   3505: 
1.648     raeburn  3506: =item * &get_student_view()
1.112     bowersj2 3507: 
                   3508: show a snapshot of what student was looking at
                   3509: 
                   3510: =cut
                   3511: 
1.10      albertel 3512: sub get_student_view {
1.186     albertel 3513:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3514:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3515:   my (%form);
1.10      albertel 3516:   my @elements=('symb','courseid','domain','username');
                   3517:   foreach my $element (@elements) {
1.186     albertel 3518:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3519:   }
1.186     albertel 3520:   if (defined($moreenv)) {
                   3521:       %form=(%form,%{$moreenv});
                   3522:   }
1.236     albertel 3523:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3524:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3525:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3526:   $userview=~s/\<body[^\>]*\>//gi;
                   3527:   $userview=~s/\<\/body\>//gi;
                   3528:   $userview=~s/\<html\>//gi;
                   3529:   $userview=~s/\<\/html\>//gi;
                   3530:   $userview=~s/\<head\>//gi;
                   3531:   $userview=~s/\<\/head\>//gi;
                   3532:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3533:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3534:   if (wantarray) {
                   3535:      return ($userview,$response);
                   3536:   } else {
                   3537:      return $userview;
                   3538:   }
                   3539: }
                   3540: 
                   3541: sub get_student_view_with_retries {
                   3542:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3543: 
                   3544:     my $ok = 0;                 # True if we got a good response.
                   3545:     my $content;
                   3546:     my $response;
                   3547: 
                   3548:     # Try to get the student_view done. within the retries count:
                   3549:     
                   3550:     do {
                   3551:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3552:          $ok      = $response->is_success;
                   3553:          if (!$ok) {
                   3554:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3555:          }
                   3556:          $retries--;
                   3557:     } while (!$ok && ($retries > 0));
                   3558:     
                   3559:     if (!$ok) {
                   3560:        $content = '';          # On error return an empty content.
                   3561:     }
1.651     www      3562:     if (wantarray) {
                   3563:        return ($content, $response);
                   3564:     } else {
                   3565:        return $content;
                   3566:     }
1.11      albertel 3567: }
                   3568: 
1.112     bowersj2 3569: =pod
                   3570: 
1.648     raeburn  3571: =item * &get_student_answers() 
1.112     bowersj2 3572: 
                   3573: show a snapshot of how student was answering problem
                   3574: 
                   3575: =cut
                   3576: 
1.11      albertel 3577: sub get_student_answers {
1.100     sakharuk 3578:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3579:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3580:   my (%moreenv);
1.11      albertel 3581:   my @elements=('symb','courseid','domain','username');
                   3582:   foreach my $element (@elements) {
1.186     albertel 3583:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3584:   }
1.186     albertel 3585:   $moreenv{'grade_target'}='answer';
                   3586:   %moreenv=(%form,%moreenv);
1.497     raeburn  3587:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3588:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3589:   return $userview;
1.1       albertel 3590: }
1.116     albertel 3591: 
                   3592: =pod
                   3593: 
                   3594: =item * &submlink()
                   3595: 
1.242     albertel 3596: Inputs: $text $uname $udom $symb $target
1.116     albertel 3597: 
                   3598: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3599: 
                   3600: =cut
                   3601: 
                   3602: ###############################################
                   3603: sub submlink {
1.242     albertel 3604:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3605:     if (!($uname && $udom)) {
                   3606: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3607: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3608: 	if (!$symb) { $symb=$cursymb; }
                   3609:     }
1.254     matthew  3610:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3611:     $symb=&escape($symb);
1.242     albertel 3612:     if ($target) { $target="target=\"$target\""; }
                   3613:     return '<a href="/adm/grades?&command=submission&'.
                   3614: 	'symb='.$symb.'&student='.$uname.
                   3615: 	'&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
                   3616: }
                   3617: ##############################################
                   3618: 
                   3619: =pod
                   3620: 
                   3621: =item * &pgrdlink()
                   3622: 
                   3623: Inputs: $text $uname $udom $symb $target
                   3624: 
                   3625: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3626: 
                   3627: =cut
                   3628: 
                   3629: ###############################################
                   3630: sub pgrdlink {
                   3631:     my $link=&submlink(@_);
                   3632:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3633:     return $link;
                   3634: }
                   3635: ##############################################
                   3636: 
                   3637: =pod
                   3638: 
                   3639: =item * &pprmlink()
                   3640: 
                   3641: Inputs: $text $uname $udom $symb $target
                   3642: 
                   3643: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3644: student and a specific resource
1.242     albertel 3645: 
                   3646: =cut
                   3647: 
                   3648: ###############################################
                   3649: sub pprmlink {
                   3650:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3651:     if (!($uname && $udom)) {
                   3652: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3653: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3654: 	if (!$symb) { $symb=$cursymb; }
                   3655:     }
1.254     matthew  3656:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3657:     $symb=&escape($symb);
1.242     albertel 3658:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3659:     return '<a href="/adm/parmset?command=set&amp;'.
                   3660: 	'symb='.$symb.'&amp;uname='.$uname.
                   3661: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3662: }
                   3663: ##############################################
1.37      matthew  3664: 
1.112     bowersj2 3665: =pod
                   3666: 
                   3667: =back
                   3668: 
                   3669: =cut
                   3670: 
1.37      matthew  3671: ###############################################
1.51      www      3672: 
                   3673: 
                   3674: sub timehash {
1.687     raeburn  3675:     my ($thistime) = @_;
                   3676:     my $timezone = &Apache::lonlocal::gettimezone();
                   3677:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3678:                      ->set_time_zone($timezone);
                   3679:     my $wday = $dt->day_of_week();
                   3680:     if ($wday == 7) { $wday = 0; }
                   3681:     return ( 'second' => $dt->second(),
                   3682:              'minute' => $dt->minute(),
                   3683:              'hour'   => $dt->hour(),
                   3684:              'day'     => $dt->day_of_month(),
                   3685:              'month'   => $dt->month(),
                   3686:              'year'    => $dt->year(),
                   3687:              'weekday' => $wday,
                   3688:              'dayyear' => $dt->day_of_year(),
                   3689:              'dlsav'   => $dt->is_dst() );
1.51      www      3690: }
                   3691: 
1.370     www      3692: sub utc_string {
                   3693:     my ($date)=@_;
1.371     www      3694:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3695: }
                   3696: 
1.51      www      3697: sub maketime {
                   3698:     my %th=@_;
1.687     raeburn  3699:     my ($epoch_time,$timezone,$dt);
                   3700:     $timezone = &Apache::lonlocal::gettimezone();
                   3701:     eval {
                   3702:         $dt = DateTime->new( year   => $th{'year'},
                   3703:                              month  => $th{'month'},
                   3704:                              day    => $th{'day'},
                   3705:                              hour   => $th{'hour'},
                   3706:                              minute => $th{'minute'},
                   3707:                              second => $th{'second'},
                   3708:                              time_zone => $timezone,
                   3709:                          );
                   3710:     };
                   3711:     if (!$@) {
                   3712:         $epoch_time = $dt->epoch;
                   3713:         if ($epoch_time) {
                   3714:             return $epoch_time;
                   3715:         }
                   3716:     }
1.51      www      3717:     return POSIX::mktime(
                   3718:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3719:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3720: }
                   3721: 
                   3722: #########################################
1.51      www      3723: 
                   3724: sub findallcourses {
1.482     raeburn  3725:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3726:     my %roles;
                   3727:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3728:     my %courses;
1.51      www      3729:     my $now=time;
1.482     raeburn  3730:     if (!defined($uname)) {
                   3731:         $uname = $env{'user.name'};
                   3732:     }
                   3733:     if (!defined($udom)) {
                   3734:         $udom = $env{'user.domain'};
                   3735:     }
                   3736:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
                   3737:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
                   3738:         if (!%roles) {
                   3739:             %roles = (
                   3740:                        cc => 1,
1.907     raeburn  3741:                        co => 1,
1.482     raeburn  3742:                        in => 1,
                   3743:                        ep => 1,
                   3744:                        ta => 1,
                   3745:                        cr => 1,
                   3746:                        st => 1,
                   3747:              );
                   3748:         }
                   3749:         foreach my $entry (keys(%roleshash)) {
                   3750:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3751:             if ($trole =~ /^cr/) { 
                   3752:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3753:             } else {
                   3754:                 next if (!exists($roles{$trole}));
                   3755:             }
                   3756:             if ($tend) {
                   3757:                 next if ($tend < $now);
                   3758:             }
                   3759:             if ($tstart) {
                   3760:                 next if ($tstart > $now);
                   3761:             }
                   3762:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3763:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3764:             if ($secpart eq '') {
                   3765:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3766:                 $sec = 'none';
                   3767:                 $realsec = '';
                   3768:             } else {
                   3769:                 $cnum = $cnumpart;
                   3770:                 ($sec,$role) = split(/_/,$secpart);
                   3771:                 $realsec = $sec;
1.490     raeburn  3772:             }
1.482     raeburn  3773:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3774:         }
                   3775:     } else {
                   3776:         foreach my $key (keys(%env)) {
1.483     albertel 3777: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3778:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3779: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3780: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3781: 	        next if (%roles && !exists($roles{$role}));
                   3782: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3783:                 my $active=1;
                   3784:                 if ($starttime) {
                   3785: 		    if ($now<$starttime) { $active=0; }
                   3786:                 }
                   3787:                 if ($endtime) {
                   3788:                     if ($now>$endtime) { $active=0; }
                   3789:                 }
                   3790:                 if ($active) {
                   3791:                     if ($sec eq '') {
                   3792:                         $sec = 'none';
                   3793:                     }
                   3794:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   3795:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  3796:                 }
                   3797:             }
1.51      www      3798:         }
                   3799:     }
1.474     raeburn  3800:     return %courses;
1.51      www      3801: }
1.37      matthew  3802: 
1.54      www      3803: ###############################################
1.474     raeburn  3804: 
                   3805: sub blockcheck {
1.482     raeburn  3806:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  3807: 
                   3808:     if (!defined($udom)) {
                   3809:         $udom = $env{'user.domain'};
                   3810:     }
                   3811:     if (!defined($uname)) {
                   3812:         $uname = $env{'user.name'};
                   3813:     }
                   3814: 
                   3815:     # If uname and udom are for a course, check for blocks in the course.
                   3816: 
                   3817:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   3818:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  3819:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  3820:         return ($startblock,$endblock);
                   3821:     }
1.474     raeburn  3822: 
1.502     raeburn  3823:     my $startblock = 0;
                   3824:     my $endblock = 0;
1.482     raeburn  3825:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  3826: 
1.490     raeburn  3827:     # If uname is for a user, and activity is course-specific, i.e.,
                   3828:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  3829: 
1.490     raeburn  3830:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   3831:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   3832:         foreach my $key (keys(%live_courses)) {
                   3833:             if ($key ne $env{'request.course.id'}) {
                   3834:                 delete($live_courses{$key});
                   3835:             }
                   3836:         }
                   3837:     }
                   3838: 
                   3839:     my $otheruser = 0;
                   3840:     my %own_courses;
                   3841:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   3842:         # Resource belongs to user other than current user.
                   3843:         $otheruser = 1;
                   3844:         # Gather courses for current user
                   3845:         %own_courses = 
                   3846:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   3847:     }
                   3848: 
                   3849:     # Gather active course roles - course coordinator, instructor, 
                   3850:     # exam proctor, ta, student, or custom role.
1.474     raeburn  3851: 
                   3852:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  3853:         my ($cdom,$cnum);
                   3854:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   3855:             $cdom = $env{'course.'.$course.'.domain'};
                   3856:             $cnum = $env{'course.'.$course.'.num'};
                   3857:         } else {
1.490     raeburn  3858:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  3859:         }
                   3860:         my $no_ownblock = 0;
                   3861:         my $no_userblock = 0;
1.533     raeburn  3862:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  3863:             # Check if current user has 'evb' priv for this
                   3864:             if (defined($own_courses{$course})) {
                   3865:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   3866:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   3867:                     if ($sec ne 'none') {
                   3868:                         $checkrole .= '/'.$sec;
                   3869:                     }
                   3870:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3871:                         $no_ownblock = 1;
                   3872:                         last;
                   3873:                     }
                   3874:                 }
                   3875:             }
                   3876:             # if they have 'evb' priv and are currently not playing student
                   3877:             next if (($no_ownblock) &&
                   3878:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   3879:         }
1.474     raeburn  3880:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  3881:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  3882:             if ($sec ne 'none') {
1.482     raeburn  3883:                 $checkrole .= '/'.$sec;
1.474     raeburn  3884:             }
1.490     raeburn  3885:             if ($otheruser) {
                   3886:                 # Resource belongs to user other than current user.
                   3887:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  3888:                 my ($trole,$tdom,$tnum,$tsec);
                   3889:                 my $entry = $live_courses{$course}{$sec};
                   3890:                 if ($entry =~ /^cr/) {
                   3891:                     ($trole,$tdom,$tnum,$tsec) = 
                   3892:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   3893:                 } else {
                   3894:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   3895:                 }
                   3896:                 my ($spec,$area,$trest,%allroles,%userroles);
                   3897:                 $area = '/'.$tdom.'/'.$tnum;
                   3898:                 $trest = $tnum;
                   3899:                 if ($tsec ne '') {
                   3900:                     $area .= '/'.$tsec;
                   3901:                     $trest .= '/'.$tsec;
                   3902:                 }
                   3903:                 $spec = $trole.'.'.$area;
                   3904:                 if ($trole =~ /^cr/) {
                   3905:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   3906:                                                       $tdom,$spec,$trest,$area);
                   3907:                 } else {
                   3908:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   3909:                                                        $tdom,$spec,$trest,$area);
                   3910:                 }
                   3911:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  3912:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   3913:                     if ($1) {
                   3914:                         $no_userblock = 1;
                   3915:                         last;
                   3916:                     }
                   3917:                 }
1.490     raeburn  3918:             } else {
                   3919:                 # Resource belongs to current user
                   3920:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  3921:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3922:                     $no_ownblock = 1;
                   3923:                     last;
                   3924:                 }
1.474     raeburn  3925:             }
                   3926:         }
                   3927:         # if they have the evb priv and are currently not playing student
1.482     raeburn  3928:         next if (($no_ownblock) &&
1.491     albertel 3929:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  3930:         next if ($no_userblock);
1.474     raeburn  3931: 
1.866     kalberla 3932:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  3933:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  3934:         
                   3935:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   3936:         if (($start != 0) && 
                   3937:             (($startblock == 0) || ($startblock > $start))) {
                   3938:             $startblock = $start;
                   3939:         }
                   3940:         if (($end != 0)  &&
                   3941:             (($endblock == 0) || ($endblock < $end))) {
                   3942:             $endblock = $end;
                   3943:         }
1.490     raeburn  3944:     }
                   3945:     return ($startblock,$endblock);
                   3946: }
                   3947: 
                   3948: sub get_blocks {
                   3949:     my ($setters,$activity,$cdom,$cnum) = @_;
                   3950:     my $startblock = 0;
                   3951:     my $endblock = 0;
                   3952:     my $course = $cdom.'_'.$cnum;
                   3953:     $setters->{$course} = {};
                   3954:     $setters->{$course}{'staff'} = [];
                   3955:     $setters->{$course}{'times'} = [];
                   3956:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   3957:     foreach my $record (keys(%records)) {
                   3958:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   3959:         if ($start <= time && $end >= time) {
                   3960:             my ($staff_name,$staff_dom,$title,$blocks) =
                   3961:                 &parse_block_record($records{$record});
                   3962:             if ($blocks->{$activity} eq 'on') {
                   3963:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   3964:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 3965:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   3966:                     $startblock = $start;
1.490     raeburn  3967:                 }
1.491     albertel 3968:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   3969:                     $endblock = $end;
1.474     raeburn  3970:                 }
                   3971:             }
                   3972:         }
                   3973:     }
                   3974:     return ($startblock,$endblock);
                   3975: }
                   3976: 
                   3977: sub parse_block_record {
                   3978:     my ($record) = @_;
                   3979:     my ($setuname,$setudom,$title,$blocks);
                   3980:     if (ref($record) eq 'HASH') {
                   3981:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   3982:         $title = &unescape($record->{'event'});
                   3983:         $blocks = $record->{'blocks'};
                   3984:     } else {
                   3985:         my @data = split(/:/,$record,3);
                   3986:         if (scalar(@data) eq 2) {
                   3987:             $title = $data[1];
                   3988:             ($setuname,$setudom) = split(/@/,$data[0]);
                   3989:         } else {
                   3990:             ($setuname,$setudom,$title) = @data;
                   3991:         }
                   3992:         $blocks = { 'com' => 'on' };
                   3993:     }
                   3994:     return ($setuname,$setudom,$title,$blocks);
                   3995: }
                   3996: 
1.854     kalberla 3997: sub blocking_status {
                   3998:   my ($activity,$uname,$udom) = @_;
1.867     kalberla 3999:   my %setters;
1.890     droeschl 4000: 
                   4001:   # check for active blocking
1.867     kalberla 4002:   my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854     kalberla 4003: 
1.890     droeschl 4004:   my $blocked = $startblock && $endblock ? 1 : 0;
                   4005: 
                   4006:   # caller just wants to know whether a block is active
                   4007:   if (!wantarray) { return $blocked; }
                   4008: 
                   4009:   # build a link to a popup window containing the details
                   4010:   my $querystring  = "?activity=$activity";
                   4011:   # $uname and $udom decide whose portfolio the user is trying to look at
                   4012:      $querystring .= "&amp;udom=$udom"      if $udom;
                   4013:      $querystring .= "&amp;uname=$uname"    if $uname;
                   4014: 
                   4015:   my $output .= <<'END_MYBLOCK';
1.854     kalberla 4016:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4017:         var options = "width=" + w + ",height=" + h + ",";
                   4018:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4019:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4020:         var newWin = window.open(url, wdwName, options);
                   4021:         newWin.focus();
                   4022:     }
1.890     droeschl 4023: END_MYBLOCK
1.854     kalberla 4024: 
1.890     droeschl 4025:   $output = Apache::lonhtmlcommon::scripttag($output);
                   4026:   
1.854     kalberla 4027:   my $popupUrl = "/adm/blockingstatus/$querystring";
1.890     droeschl 4028:   my $text = mt('Communication Blocked');
                   4029: 
1.867     kalberla 4030:   $output .= <<"END_BLOCK";
                   4031: <div class='LC_comblock'>
1.869     kalberla 4032:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4033:   title='$text'>
                   4034:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4035:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4036:   title='$text'>$text</a>
1.867     kalberla 4037: </div>
                   4038: 
                   4039: END_BLOCK
1.474     raeburn  4040: 
1.854     kalberla 4041:   return ($blocked, $output);
                   4042: }
1.490     raeburn  4043: 
1.60      matthew  4044: ###############################################
                   4045: 
1.682     raeburn  4046: sub check_ip_acc {
                   4047:     my ($acc)=@_;
                   4048:     &Apache::lonxml::debug("acc is $acc");
                   4049:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4050:         return 1;
                   4051:     }
                   4052:     my $allowed=0;
                   4053:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4054: 
                   4055:     my $name;
                   4056:     foreach my $pattern (split(',',$acc)) {
                   4057:         $pattern =~ s/^\s*//;
                   4058:         $pattern =~ s/\s*$//;
                   4059:         if ($pattern =~ /\*$/) {
                   4060:             #35.8.*
                   4061:             $pattern=~s/\*//;
                   4062:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4063:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4064:             #35.8.3.[34-56]
                   4065:             my $low=$2;
                   4066:             my $high=$3;
                   4067:             $pattern=$1;
                   4068:             if ($ip =~ /^\Q$pattern\E/) {
                   4069:                 my $last=(split(/\./,$ip))[3];
                   4070:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4071:             }
                   4072:         } elsif ($pattern =~ /^\*/) {
                   4073:             #*.msu.edu
                   4074:             $pattern=~s/\*//;
                   4075:             if (!defined($name)) {
                   4076:                 use Socket;
                   4077:                 my $netaddr=inet_aton($ip);
                   4078:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4079:             }
                   4080:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4081:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4082:             #127.0.0.1
                   4083:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4084:         } else {
                   4085:             #some.name.com
                   4086:             if (!defined($name)) {
                   4087:                 use Socket;
                   4088:                 my $netaddr=inet_aton($ip);
                   4089:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4090:             }
                   4091:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4092:         }
                   4093:         if ($allowed) { last; }
                   4094:     }
                   4095:     return $allowed;
                   4096: }
                   4097: 
                   4098: ###############################################
                   4099: 
1.60      matthew  4100: =pod
                   4101: 
1.112     bowersj2 4102: =head1 Domain Template Functions
                   4103: 
                   4104: =over 4
                   4105: 
                   4106: =item * &determinedomain()
1.60      matthew  4107: 
                   4108: Inputs: $domain (usually will be undef)
                   4109: 
1.63      www      4110: Returns: Determines which domain should be used for designs
1.60      matthew  4111: 
                   4112: =cut
1.54      www      4113: 
1.60      matthew  4114: ###############################################
1.63      www      4115: sub determinedomain {
                   4116:     my $domain=shift;
1.531     albertel 4117:     if (! $domain) {
1.60      matthew  4118:         # Determine domain if we have not been given one
1.893     raeburn  4119:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4120:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4121:         if ($env{'request.role.domain'}) { 
                   4122:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4123:         }
                   4124:     }
1.63      www      4125:     return $domain;
                   4126: }
                   4127: ###############################################
1.517     raeburn  4128: 
1.518     albertel 4129: sub devalidate_domconfig_cache {
                   4130:     my ($udom)=@_;
                   4131:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4132: }
                   4133: 
                   4134: # ---------------------- Get domain configuration for a domain
                   4135: sub get_domainconf {
                   4136:     my ($udom) = @_;
                   4137:     my $cachetime=1800;
                   4138:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4139:     if (defined($cached)) { return %{$result}; }
                   4140: 
                   4141:     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   4142: 					     ['login','rolecolors'],$udom);
1.632     raeburn  4143:     my (%designhash,%legacy);
1.518     albertel 4144:     if (keys(%domconfig) > 0) {
                   4145:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4146:             if (keys(%{$domconfig{'login'}})) {
                   4147:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4148:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   4149:                         foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4150:                             $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4151:                                 $domconfig{'login'}{$key}{$img};
                   4152:                         }
                   4153:                     } else {
                   4154:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4155:                     }
1.632     raeburn  4156:                 }
                   4157:             } else {
                   4158:                 $legacy{'login'} = 1;
1.518     albertel 4159:             }
1.632     raeburn  4160:         } else {
                   4161:             $legacy{'login'} = 1;
1.518     albertel 4162:         }
                   4163:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4164:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4165:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4166:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4167:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4168:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4169:                         }
1.518     albertel 4170:                     }
                   4171:                 }
1.632     raeburn  4172:             } else {
                   4173:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4174:             }
1.632     raeburn  4175:         } else {
                   4176:             $legacy{'rolecolors'} = 1;
1.518     albertel 4177:         }
1.632     raeburn  4178:         if (keys(%legacy) > 0) {
                   4179:             my %legacyhash = &get_legacy_domconf($udom);
                   4180:             foreach my $item (keys(%legacyhash)) {
                   4181:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4182:                     if ($legacy{'login'}) { 
                   4183:                         $designhash{$item} = $legacyhash{$item};
                   4184:                     }
                   4185:                 } else {
                   4186:                     if ($legacy{'rolecolors'}) {
                   4187:                         $designhash{$item} = $legacyhash{$item};
                   4188:                     }
1.518     albertel 4189:                 }
                   4190:             }
                   4191:         }
1.632     raeburn  4192:     } else {
                   4193:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4194:     }
                   4195:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4196: 				  $cachetime);
                   4197:     return %designhash;
                   4198: }
                   4199: 
1.632     raeburn  4200: sub get_legacy_domconf {
                   4201:     my ($udom) = @_;
                   4202:     my %legacyhash;
                   4203:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4204:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4205:     if (-e $designfile) {
                   4206:         if ( open (my $fh,"<$designfile") ) {
                   4207:             while (my $line = <$fh>) {
                   4208:                 next if ($line =~ /^\#/);
                   4209:                 chomp($line);
                   4210:                 my ($key,$val)=(split(/\=/,$line));
                   4211:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4212:             }
                   4213:             close($fh);
                   4214:         }
                   4215:     }
                   4216:     if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
                   4217:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4218:     }
                   4219:     return %legacyhash;
                   4220: }
                   4221: 
1.63      www      4222: =pod
                   4223: 
1.112     bowersj2 4224: =item * &domainlogo()
1.63      www      4225: 
                   4226: Inputs: $domain (usually will be undef)
                   4227: 
                   4228: Returns: A link to a domain logo, if the domain logo exists.
                   4229: If the domain logo does not exist, a description of the domain.
                   4230: 
                   4231: =cut
1.112     bowersj2 4232: 
1.63      www      4233: ###############################################
                   4234: sub domainlogo {
1.517     raeburn  4235:     my $domain = &determinedomain(shift);
1.518     albertel 4236:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4237:     # See if there is a logo
                   4238:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4239:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4240:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4241: 	    if ($imgsrc =~ m{^/res/}) {
                   4242: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4243: 		&Apache::lonnet::repcopy($local_name);
                   4244: 	    }
                   4245: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4246:         } 
                   4247:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4248:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4249:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4250:     } else {
1.60      matthew  4251:         return '';
1.59      www      4252:     }
                   4253: }
1.63      www      4254: ##############################################
                   4255: 
                   4256: =pod
                   4257: 
1.112     bowersj2 4258: =item * &designparm()
1.63      www      4259: 
                   4260: Inputs: $which parameter; $domain (usually will be undef)
                   4261: 
                   4262: Returns: value of designparamter $which
                   4263: 
                   4264: =cut
1.112     bowersj2 4265: 
1.397     albertel 4266: 
1.400     albertel 4267: ##############################################
1.397     albertel 4268: sub designparm {
                   4269:     my ($which,$domain)=@_;
                   4270:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4271:         return $env{'environment.color.'.$which};
1.96      www      4272:     }
1.63      www      4273:     $domain=&determinedomain($domain);
1.518     albertel 4274:     my %domdesign = &get_domainconf($domain);
1.520     raeburn  4275:     my $output;
1.517     raeburn  4276:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4277:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4278:     } else {
1.520     raeburn  4279:         $output = $defaultdesign{$which};
                   4280:     }
                   4281:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4282:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4283:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4284:             if ($output =~ m{^/res/}) {
                   4285:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4286:                 &Apache::lonnet::repcopy($local_name);
                   4287:             }
1.520     raeburn  4288:             $output = &lonhttpdurl($output);
                   4289:         }
1.63      www      4290:     }
1.520     raeburn  4291:     return $output;
1.63      www      4292: }
1.59      www      4293: 
1.822     bisitz   4294: ##############################################
                   4295: =pod
                   4296: 
1.832     bisitz   4297: =item * &authorspace()
                   4298: 
                   4299: Inputs: ./.
                   4300: 
                   4301: Returns: Path to the Construction Space of the current user's
                   4302:          accessed author space
                   4303:          The author space will be that of the current user
                   4304:          when accessing the own author space
                   4305:          and that of the co-author/assistent co-author
                   4306:          when accessing the co-author's/assistent co-author's
                   4307:          space
                   4308: 
                   4309: =cut
                   4310: 
                   4311: sub authorspace {
                   4312:     my $caname = '';
                   4313:     if ($env{'request.role'} =~ /^ca|^aa/) {
                   4314:         (undef,$caname) =
                   4315:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
                   4316:     } else {
                   4317:         $caname = $env{'user.name'};
                   4318:     }
                   4319:     return '/priv/'.$caname.'/';
                   4320: }
                   4321: 
                   4322: ##############################################
                   4323: =pod
                   4324: 
1.822     bisitz   4325: =item * &head_subbox()
                   4326: 
                   4327: Inputs: $content (contains HTML code with page functions, etc.)
                   4328: 
                   4329: Returns: HTML div with $content
                   4330:          To be included in page header
                   4331: 
                   4332: =cut
                   4333: 
                   4334: sub head_subbox {
                   4335:     my ($content)=@_;
                   4336:     my $output =
1.844     bisitz   4337:         '<div id="LC_head_subbox">'
1.822     bisitz   4338:        .$content
                   4339:        .'</div>'
                   4340: }
                   4341: 
                   4342: ##############################################
                   4343: =pod
                   4344: 
                   4345: =item * &CSTR_pageheader()
                   4346: 
                   4347: Inputs: ./.
                   4348: 
                   4349: Returns: HTML div with CSTR path and recent box
                   4350:          To be included on Construction Space pages
                   4351: 
                   4352: =cut
                   4353: 
                   4354: sub CSTR_pageheader {
                   4355:     # this is for resources; directories have customtitle, and crumbs
                   4356:             # and select recent are created in lonpubdir.pm  
                   4357:     my ($uname,$thisdisfn)=
                   4358:         ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
                   4359:     my $formaction='/priv/'.$uname.'/'.$thisdisfn;
                   4360:     $formaction=~s/\/+/\//g;
                   4361: 
                   4362:     my $parentpath = '';
                   4363:     my $lastitem = '';
                   4364:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4365:         $parentpath = $1;
                   4366:         $lastitem = $2;
                   4367:     } else {
                   4368:         $lastitem = $thisdisfn;
                   4369:     }
1.921     bisitz   4370: 
                   4371:     my $output =
1.822     bisitz   4372:          '<div>'
                   4373:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4374:         .'<b>'.&mt('Construction Space:').'</b> '
                   4375:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4376:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
                   4377:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef);
                   4378: 
                   4379:     if ($lastitem) {
                   4380:         $output .=
                   4381:              '<span class="LC_filename">'
                   4382:             .$lastitem
                   4383:             .'</span>';
                   4384:     }
                   4385:     $output .=
                   4386:          '<br />'
1.822     bisitz   4387:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4388:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4389:         .'</form>'
                   4390:         .&Apache::lonmenu::constspaceform()
                   4391:         .'</div>';
1.921     bisitz   4392: 
                   4393:     return $output;
1.822     bisitz   4394: }
                   4395: 
1.60      matthew  4396: ###############################################
                   4397: ###############################################
                   4398: 
                   4399: =pod
                   4400: 
1.112     bowersj2 4401: =back
                   4402: 
1.549     albertel 4403: =head1 HTML Helpers
1.112     bowersj2 4404: 
                   4405: =over 4
                   4406: 
                   4407: =item * &bodytag()
1.60      matthew  4408: 
                   4409: Returns a uniform header for LON-CAPA web pages.
                   4410: 
                   4411: Inputs: 
                   4412: 
1.112     bowersj2 4413: =over 4
                   4414: 
                   4415: =item * $title, A title to be displayed on the page.
                   4416: 
                   4417: =item * $function, the current role (can be undef).
                   4418: 
                   4419: =item * $addentries, extra parameters for the <body> tag.
                   4420: 
                   4421: =item * $bodyonly, if defined, only return the <body> tag.
                   4422: 
                   4423: =item * $domain, if defined, force a given domain.
                   4424: 
                   4425: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4426:             text interface only)
1.60      matthew  4427: 
1.814     bisitz   4428: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4429:                      navigational links
1.317     albertel 4430: 
1.338     albertel 4431: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4432: 
1.361     albertel 4433: =item * $no_inline_link, if true and in remote mode, don't show the 
                   4434:          'Switch To Inline Menu' link
                   4435: 
1.460     albertel 4436: =item * $args, optional argument valid values are
                   4437:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4438:             inherit_jsmath -> when creating popup window in a page,
                   4439:                               should it have jsmath forced on by the
                   4440:                               current page
1.460     albertel 4441: 
1.112     bowersj2 4442: =back
                   4443: 
1.60      matthew  4444: Returns: A uniform header for LON-CAPA web pages.  
                   4445: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4446: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4447: other decorations will be returned.
                   4448: 
                   4449: =cut
                   4450: 
1.54      www      4451: sub bodytag {
1.831     bisitz   4452:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.816     bisitz   4453:         $no_nav_bar,$bgcolor,$no_inline_link,$args)=@_;
1.339     albertel 4454: 
1.460     albertel 4455:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4456: 
1.183     matthew  4457:     $function = &get_users_function() if (!$function);
1.339     albertel 4458:     my $img =    &designparm($function.'.img',$domain);
                   4459:     my $font =   &designparm($function.'.font',$domain);
                   4460:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4461: 
1.803     bisitz   4462:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 4463: 		   'bgcolor' => $pgbg,
1.339     albertel 4464: 		   'text'    => $font,
                   4465:                    'alink'   => &designparm($function.'.alink',$domain),
                   4466: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4467: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4468:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4469: 
1.63      www      4470:  # role and realm
1.378     raeburn  4471:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4472:     if ($role  eq 'ca') {
1.479     albertel 4473:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4474:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4475:     } 
1.55      www      4476: # realm
1.258     albertel 4477:     if ($env{'request.course.id'}) {
1.378     raeburn  4478:         if ($env{'request.role'} !~ /^cr/) {
                   4479:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4480:         }
1.898     raeburn  4481:         if ($env{'request.course.sec'}) {
                   4482:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   4483:         }   
1.359     albertel 4484: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4485:     } else {
                   4486:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4487:     }
1.433     albertel 4488: 
1.359     albertel 4489:     if (!$realm) { $realm='&nbsp;'; }
1.55      www      4490: # Set messages
1.60      matthew  4491:     my $messages=&domainlogo($domain);
1.330     albertel 4492: 
1.438     albertel 4493:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4494: 
1.101     www      4495: # construct main body tag
1.359     albertel 4496:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4497: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4498: 
1.530     albertel 4499:     if ($bodyonly) {
1.60      matthew  4500:         return $bodytag;
1.798     tempelho 4501:     } 
1.359     albertel 4502: 
1.410     albertel 4503:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433     albertel 4504:     if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
                   4505: 	undef($role);
1.434     albertel 4506:     } else {
                   4507: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 4508:     }
1.359     albertel 4509:     
1.762     bisitz   4510:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 4511:     #
                   4512:     # Extra info if you are the DC
                   4513:     my $dc_info = '';
                   4514:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4515:                         $env{'course.'.$env{'request.course.id'}.
                   4516:                                  '.domain'}.'/'})) {
                   4517:         my $cid = $env{'request.course.id'};
1.917     raeburn  4518:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4519:         $dc_info =~ s/\s+$//;
1.359     albertel 4520:     }
                   4521: 
1.898     raeburn  4522:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 4523:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   4524: 
1.837     bisitz   4525:     if ($env{'environment.remote'} eq 'off') {
1.359     albertel 4526:         # No Remote
1.916     droeschl 4527:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   4528:             return $bodytag; 
                   4529:         } 
1.903     droeschl 4530: 
                   4531:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   4532: 
                   4533:         #    if ($env{'request.state'} eq 'construct') {
                   4534:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   4535:         #    }
                   4536: 
1.359     albertel 4537: 
                   4538: 
1.916     droeschl 4539:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  4540:              if ($dc_info) {
                   4541:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   4542:              }
1.916     droeschl 4543:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   4544:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 4545:             return $bodytag;
                   4546:         }
1.894     droeschl 4547: 
1.916     droeschl 4548:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   4549: 
1.903     droeschl 4550:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   4551:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   4552: 
1.903     droeschl 4553:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 4554: 
1.917     raeburn  4555:         if ($dc_info) {
                   4556:             $dc_info = &dc_courseid_toggle($dc_info);
                   4557:         }
                   4558:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 4559: 
1.903     droeschl 4560:         #don't show menus for public users
                   4561:         if($env{'user.name'} ne 'public' && $env{'user.domain'} ne 'public'){
                   4562:             $bodytag .= Apache::lonmenu::secondary_menu();
                   4563:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  4564:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   4565:             if ($env{'request.state'} eq 'construct') {
                   4566:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,'',
                   4567:                                 $args->{'bread_crumbs'});
                   4568:             } elsif ($forcereg) { 
                   4569:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   4570:             }
1.903     droeschl 4571:         }else{
                   4572:             # this is to seperate menu from content when there's no secondary
                   4573:             # menu. Especially needed for public accessible ressources.
                   4574:             $bodytag .= '<hr style="clear:both" />';
                   4575:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  4576:         }
1.903     droeschl 4577: 
                   4578:         #SD testing
                   4579:         #$bodytag .= Apache::lonmenu::menubuttons($forcereg);
1.235     raeburn  4580:         return $bodytag;
1.94      www      4581:     }
1.95      www      4582: 
1.93      www      4583: #
1.95      www      4584: # Top frame rendering, Remote is up
1.93      www      4585: #
1.359     albertel 4586: 
1.517     raeburn  4587:     my $imgsrc = $img;
                   4588:     if ($img =~ /^\/adm/) {
1.575     albertel 4589:         $imgsrc = &lonhttpdurl($img);
1.517     raeburn  4590:     }
                   4591:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359     albertel 4592: 
1.305     www      4593:     # Explicit link to get inline menu
1.361     albertel 4594:     my $menu= ($no_inline_link?''
1.883     droeschl 4595: 	       :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
1.917     raeburn  4596: 
                   4597:     if ($dc_info) {
                   4598:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   4599:     }
                   4600: 
1.916     droeschl 4601:     $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.897     wenzelju 4602:             <ol class="LC_primary_menu LC_right">
1.853     droeschl 4603:                 <li>$menu</li>
1.917     raeburn  4604:             </ol><div id="LC_realm"> $realm $dc_info</div>| unless $env{'form.inhibitmenu'};
1.94      www      4605:     return(<<ENDBODY);
1.60      matthew  4606: $bodytag
1.359     albertel 4607: <table id="LC_title_bar" class="LC_with_remote">
1.791     tempelho 4608: <tr><td>$upperleft</td>
                   4609:     <td>$messages&nbsp;</td>
1.54      www      4610: </tr>
1.359     albertel 4611: <tr><td>$titleinfo $dc_info $menu</td>
1.368     albertel 4612: </tr>
1.356     albertel 4613: </table>
1.54      www      4614: ENDBODY
1.182     matthew  4615: }
                   4616: 
1.917     raeburn  4617: sub dc_courseid_toggle {
                   4618:     my ($dc_info) = @_;
                   4619:     return ' <span id="dccidtext" class="LC_cusr_subheading">'.
                   4620:            '<a href="javascript:showCourseID();">'.
                   4621:            &mt('(More ...)').'</a></span>'.
                   4622:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   4623: }
                   4624: 
1.330     albertel 4625: sub make_attr_string {
                   4626:     my ($register,$attr_ref) = @_;
                   4627: 
                   4628:     if ($attr_ref && !ref($attr_ref)) {
                   4629: 	die("addentries Must be a hash ref ".
                   4630: 	    join(':',caller(1))." ".
                   4631: 	    join(':',caller(0))." ");
                   4632:     }
                   4633: 
                   4634:     if ($register) {
1.339     albertel 4635: 	my ($on_load,$on_unload);
                   4636: 	foreach my $key (keys(%{$attr_ref})) {
                   4637: 	    if      (lc($key) eq 'onload') {
                   4638: 		$on_load.=$attr_ref->{$key}.';';
                   4639: 		delete($attr_ref->{$key});
                   4640: 
                   4641: 	    } elsif (lc($key) eq 'onunload') {
                   4642: 		$on_unload.=$attr_ref->{$key}.';';
                   4643: 		delete($attr_ref->{$key});
                   4644: 	    }
                   4645: 	}
                   4646: 	$attr_ref->{'onload'}  =
                   4647: 	    &Apache::lonmenu::loadevents().  $on_load;
                   4648: 	$attr_ref->{'onunload'}=
                   4649: 	    &Apache::lonmenu::unloadevents().$on_unload;
                   4650:     }
                   4651: 
                   4652: # Accessibility font enhance
                   4653:     if ($env{'browser.fontenhance'} eq 'on') {
                   4654: 	my $style;
                   4655: 	foreach my $key (keys(%{$attr_ref})) {
                   4656: 	    if (lc($key) eq 'style') {
                   4657: 		$style.=$attr_ref->{$key}.';';
                   4658: 		delete($attr_ref->{$key});
                   4659: 	    }
                   4660: 	}
                   4661: 	$attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330     albertel 4662:     }
1.339     albertel 4663: 
1.330     albertel 4664:     my $attr_string;
                   4665:     foreach my $attr (keys(%$attr_ref)) {
                   4666: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4667:     }
                   4668:     return $attr_string;
                   4669: }
                   4670: 
                   4671: 
1.182     matthew  4672: ###############################################
1.251     albertel 4673: ###############################################
                   4674: 
                   4675: =pod
                   4676: 
                   4677: =item * &endbodytag()
                   4678: 
                   4679: Returns a uniform footer for LON-CAPA web pages.
                   4680: 
1.635     raeburn  4681: Inputs: 1 - optional reference to an args hash
                   4682: If in the hash, key for noredirectlink has a value which evaluates to true,
                   4683: a 'Continue' link is not displayed if the page contains an
                   4684: internal redirect in the <head></head> section,
                   4685: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 4686: 
                   4687: =cut
                   4688: 
                   4689: sub endbodytag {
1.635     raeburn  4690:     my ($args) = @_;
1.251     albertel 4691:     my $endbodytag='</body>';
1.269     albertel 4692:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4693:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  4694:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   4695: 	    $endbodytag=
                   4696: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4697: 	        &mt('Continue').'</a>'.
                   4698: 	        $endbodytag;
                   4699:         }
1.315     albertel 4700:     }
1.251     albertel 4701:     return $endbodytag;
                   4702: }
                   4703: 
1.352     albertel 4704: =pod
                   4705: 
                   4706: =item * &standard_css()
                   4707: 
                   4708: Returns a style sheet
                   4709: 
                   4710: Inputs: (all optional)
                   4711:             domain         -> force to color decorate a page for a specific
                   4712:                                domain
                   4713:             function       -> force usage of a specific rolish color scheme
                   4714:             bgcolor        -> override the default page bgcolor
                   4715: 
                   4716: =cut
                   4717: 
1.343     albertel 4718: sub standard_css {
1.345     albertel 4719:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4720:     $function  = &get_users_function() if (!$function);
                   4721:     my $img    = &designparm($function.'.img',   $domain);
                   4722:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4723:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 4724:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 4725: #second colour for later usage
1.345     albertel 4726:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4727:     my $pgbg_or_bgcolor =
                   4728: 	         $bgcolor ||
1.352     albertel 4729: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4730:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4731:     my $alink  = &designparm($function.'.alink', $domain);
                   4732:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4733:     my $link   = &designparm($function.'.link',  $domain);
                   4734: 
1.704     muellerd 4735:     my $loginbg = &designparm('login.sidebg',$domain);
1.712     muellerd 4736:     my $bgcol = &designparm('login.bgcol',$domain);
                   4737:     my $textcol = &designparm('login.textcol',$domain);
1.704     muellerd 4738: 
1.602     albertel 4739:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4740:     my $mono                 = 'monospace';
1.850     bisitz   4741:     my $data_table_head      = $sidebg;
                   4742:     my $data_table_light     = '#FAFAFA';
                   4743:     my $data_table_dark      = '#F0F0F0';
1.470     banghart 4744:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4745:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4746:     my $mail_new             = '#FFBB77';
                   4747:     my $mail_new_hover       = '#DD9955';
                   4748:     my $mail_read            = '#BBBB77';
                   4749:     my $mail_read_hover      = '#999944';
                   4750:     my $mail_replied         = '#AAAA88';
                   4751:     my $mail_replied_hover   = '#888855';
                   4752:     my $mail_other           = '#99BBBB';
                   4753:     my $mail_other_hover     = '#669999';
1.391     albertel 4754:     my $table_header         = '#DDDDDD';
1.489     raeburn  4755:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   4756:     my $lg_border_color      = '#C8C8C8';
1.392     albertel 4757: 
1.608     albertel 4758:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   4759:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   4760:                                              : '0 3px 0 4px';
1.448     albertel 4761: 
1.523     albertel 4762: 
1.343     albertel 4763:     return <<END;
1.795     www      4764: body {
1.911     bisitz   4765:   font-family: $sans;
                   4766:   line-height:130%;
                   4767:   font-size:0.83em;
                   4768:   color:$font;
1.795     www      4769: }
                   4770: 
1.911     bisitz   4771: a:focus {
1.795     www      4772:   color: red;
1.911     bisitz   4773:   background: yellow;
1.795     www      4774: }
1.698     harmsja  4775: 
1.911     bisitz   4776: form, .inline {
                   4777:   display: inline;
1.795     www      4778: }
1.721     harmsja  4779: 
1.795     www      4780: .LC_right {
1.911     bisitz   4781:   text-align:right;
1.795     www      4782: }
                   4783: 
                   4784: .LC_middle {
1.911     bisitz   4785:   vertical-align:middle;
1.795     www      4786: }
1.721     harmsja  4787: 
                   4788: /* just for tests */
1.911     bisitz   4789: .LC_400Box {
                   4790:   width:400px;
                   4791: }
1.721     harmsja  4792: /* end */
                   4793: 
1.778     bisitz   4794: .LC_filename {
                   4795:   font-family: $mono;
                   4796:   white-space:pre;
1.921     bisitz   4797:   font-size: 120%;
1.778     bisitz   4798: }
                   4799: 
                   4800: .LC_fileicon {
                   4801:   border: none;
                   4802:   height: 1.3em;
                   4803:   vertical-align: text-bottom;
                   4804:   margin-right: 0.3em;
                   4805:   text-decoration:none;
                   4806: }
                   4807: 
1.350     albertel 4808: .LC_error {
                   4809:   color: red;
                   4810:   font-size: larger;
                   4811: }
1.795     www      4812: 
1.457     albertel 4813: .LC_warning,
                   4814: .LC_diff_removed {
1.733     bisitz   4815:   color: red;
1.394     albertel 4816: }
1.532     albertel 4817: 
                   4818: .LC_info,
1.457     albertel 4819: .LC_success,
                   4820: .LC_diff_added {
1.350     albertel 4821:   color: green;
                   4822: }
1.795     www      4823: 
1.802     bisitz   4824: div.LC_confirm_box {
                   4825:   background-color: #FAFAFA;
                   4826:   border: 1px solid $lg_border_color;
                   4827:   margin-right: 0;
                   4828:   padding: 5px;
                   4829: }
                   4830: 
                   4831: div.LC_confirm_box .LC_error img,
                   4832: div.LC_confirm_box .LC_success img {
                   4833:   vertical-align: middle;
                   4834: }
                   4835: 
1.440     albertel 4836: .LC_icon {
1.771     droeschl 4837:   border: none;
1.790     droeschl 4838:   vertical-align: middle;
1.771     droeschl 4839: }
                   4840: 
1.543     albertel 4841: .LC_docs_spacer {
                   4842:   width: 25px;
                   4843:   height: 1px;
1.771     droeschl 4844:   border: none;
1.543     albertel 4845: }
1.346     albertel 4846: 
1.532     albertel 4847: .LC_internal_info {
1.735     bisitz   4848:   color: #999999;
1.532     albertel 4849: }
                   4850: 
1.794     www      4851: .LC_discussion {
1.911     bisitz   4852:   background: $tabbg;
                   4853:   border: 1px solid black;
                   4854:   margin: 2px;
1.794     www      4855: }
                   4856: 
                   4857: .LC_disc_action_links_bar {
1.911     bisitz   4858:   background: $tabbg;
                   4859:   border: none;
                   4860:   margin: 4px;
1.794     www      4861: }
                   4862: 
                   4863: .LC_disc_action_left {
1.911     bisitz   4864:   text-align: left;
1.794     www      4865: }
                   4866: 
                   4867: .LC_disc_action_right {
1.911     bisitz   4868:   text-align: right;
1.794     www      4869: }
                   4870: 
                   4871: .LC_disc_new_item {
1.911     bisitz   4872:   background: white;
                   4873:   border: 2px solid red;
                   4874:   margin: 2px;
1.794     www      4875: }
                   4876: 
                   4877: .LC_disc_old_item {
1.911     bisitz   4878:   background: white;
                   4879:   border: 1px solid black;
                   4880:   margin: 2px;
1.794     www      4881: }
                   4882: 
1.458     albertel 4883: table.LC_pastsubmission {
                   4884:   border: 1px solid black;
                   4885:   margin: 2px;
                   4886: }
                   4887: 
1.795     www      4888: table#LC_top_nav,
                   4889: table#LC_menubuttons,
                   4890: table#LC_nav_location {
1.345     albertel 4891:   width: 100%;
                   4892:   background: $pgbg;
1.392     albertel 4893:   border: 2px;
1.402     albertel 4894:   border-collapse: separate;
1.803     bisitz   4895:   padding: 0;
1.345     albertel 4896: }
1.392     albertel 4897: 
1.801     tempelho 4898: table#LC_title_bar a {
                   4899:   color: $fontmenu;
                   4900: }
1.836     bisitz   4901: 
1.807     droeschl 4902: table#LC_title_bar {
1.819     tempelho 4903:   clear: both;
1.836     bisitz   4904:   display: none;
1.807     droeschl 4905: }
                   4906: 
1.795     www      4907: table#LC_title_bar,
                   4908: table.LC_breadcrumbs,
1.393     albertel 4909: table#LC_title_bar.LC_with_remote {
1.359     albertel 4910:   width: 100%;
1.392     albertel 4911:   border-color: $pgbg;
                   4912:   border-style: solid;
                   4913:   border-width: $border;
1.379     albertel 4914:   background: $pgbg;
1.801     tempelho 4915:   color: $fontmenu;
1.392     albertel 4916:   border-collapse: collapse;
1.803     bisitz   4917:   padding: 0;
1.819     tempelho 4918:   margin: 0;
1.359     albertel 4919: }
1.795     www      4920: 
1.913     droeschl 4921: /* #SD START (work in progress)*/
                   4922: 
                   4923: ul.LC_bct {
                   4924:     margin: 0;
                   4925:     padding: 0;
                   4926: }
                   4927: ul.LC_bct ol {
                   4928:     display: inline;
                   4929: }
                   4930: ul.LC_bct ul {
                   4931:     display: inline;
                   4932:     padding: 0;
                   4933: }
                   4934: ul.LC_bct li {
                   4935:     list-style-type: none;
                   4936:     display: inline;
                   4937: }
                   4938: 
                   4939: 
                   4940: ul.LC_breadcrumb_tools {
                   4941: }
                   4942: 
                   4943: li.LC_breadcrumb_tools {
                   4944: }
                   4945: li.LC_breadcrumb_tools img{
                   4946:     vertical-align: middle;
                   4947: }
                   4948: 
                   4949: .LC_breadcrumb_tools_A {
                   4950:     margin: 0 0 0 1em;
                   4951: }
                   4952: .LC_breadcrumb_tools_B {
                   4953:     float: right;
                   4954:     margin-top: 0.4em;
                   4955: }
                   4956: .LC_breadcrumb_tools_C {
                   4957:     margin: 0 1em 0 0;
                   4958:     float: right;
                   4959: }
                   4960: /* #SD END */
                   4961: 
1.359     albertel 4962: table#LC_title_bar td {
                   4963:   background: $tabbg;
                   4964: }
1.795     www      4965: 
1.911     bisitz   4966: table#LC_menubuttons img {
1.803     bisitz   4967:   border: none;
1.346     albertel 4968: }
1.795     www      4969: 
1.345     albertel 4970: table#LC_top_nav td {
                   4971:   background: $tabbg;
1.803     bisitz   4972:   border: none;
1.407     albertel 4973:   font-size: small;
1.706     harmsja  4974:   vertical-align:top;
                   4975:   padding:2px 5px 2px 5px;
1.345     albertel 4976: }
1.795     www      4977: 
                   4978: table#LC_top_nav td a,
                   4979: div#LC_top_nav a {
1.345     albertel 4980:   color: $font;
                   4981: }
1.795     www      4982: 
1.364     albertel 4983: table#LC_top_nav td.LC_top_nav_logo {
                   4984:   background: $tabbg;
1.432     albertel 4985:   text-align: left;
1.408     albertel 4986:   white-space: nowrap;
1.432     albertel 4987:   width: 31px;
1.408     albertel 4988: }
1.795     www      4989: 
1.408     albertel 4990: table#LC_top_nav td.LC_top_nav_logo img {
1.803     bisitz   4991:   border: none;
1.408     albertel 4992:   vertical-align: bottom;
1.364     albertel 4993: }
1.795     www      4994: 
1.777     tempelho 4995: table#LC_top_nav td.LC_top_nav_exit,
1.779     bisitz   4996: table#LC_top_nav td.LC_top_nav_help {
1.777     tempelho 4997:   width: 2.0em;
                   4998: }
1.795     www      4999: 
1.442     albertel 5000: table#LC_top_nav td.LC_top_nav_login {
                   5001:   width: 4.0em;
                   5002:   text-align: center;
                   5003: }
1.795     www      5004: 
1.842     droeschl 5005: .LC_breadcrumbs_component {
1.911     bisitz   5006:   float: right;
                   5007:   margin: 0 1em;
1.357     albertel 5008: }
1.842     droeschl 5009: .LC_breadcrumbs_component img {
1.911     bisitz   5010:   vertical-align: middle;
1.777     tempelho 5011: }
1.795     www      5012: 
1.383     albertel 5013: td.LC_table_cell_checkbox {
                   5014:   text-align: center;
                   5015: }
1.795     www      5016: 
1.779     bisitz   5017: table#LC_mainmenu td.LC_mainmenu_column {
1.911     bisitz   5018:   vertical-align: top;
1.777     tempelho 5019: }
1.522     albertel 5020: 
1.795     www      5021: .LC_fontsize_small {
1.911     bisitz   5022:   font-size: 70%;
1.705     tempelho 5023: }
                   5024: 
1.844     bisitz   5025: #LC_breadcrumbs {
1.911     bisitz   5026:   clear:both;
                   5027:   background: $sidebg;
                   5028:   border-bottom: 1px solid $lg_border_color;
                   5029:   line-height: 2.5em;
1.915     droeschl 5030:      /* SD working here 
                   5031:      height: 2.5em;
                   5032:      overflow: hidden; */
1.911     bisitz   5033:   margin: 0;
                   5034:   padding: 0;
1.819     tempelho 5035: }
1.862     bisitz   5036: 
1.839     droeschl 5037: /* Preliminary fix to hide breadcrumbs inside remote control window */
1.844     bisitz   5038: #LC_remote #LC_breadcrumbs {
1.911     bisitz   5039:   display:none;
1.839     droeschl 5040: }
1.819     tempelho 5041: 
1.844     bisitz   5042: #LC_head_subbox {
1.911     bisitz   5043:   clear:both;
                   5044:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5045:   border: 1px solid $sidebg;
                   5046:   margin: 0 0 10px 0;      
1.822     bisitz   5047: }
                   5048: 
1.795     www      5049: .LC_fontsize_medium {
1.911     bisitz   5050:   font-size: 85%;
1.705     tempelho 5051: }
                   5052: 
1.795     www      5053: .LC_fontsize_large {
1.911     bisitz   5054:   font-size: 120%;
1.705     tempelho 5055: }
                   5056: 
1.346     albertel 5057: .LC_menubuttons_inline_text {
                   5058:   color: $font;
1.698     harmsja  5059:   font-size: 90%;
1.701     harmsja  5060:   padding-left:3px;
1.346     albertel 5061: }
                   5062: 
1.526     www      5063: .LC_menubuttons_link {
                   5064:   text-decoration: none;
                   5065: }
1.795     www      5066: 
1.522     albertel 5067: .LC_menubuttons_category {
1.521     www      5068:   color: $font;
1.526     www      5069:   background: $pgbg;
1.521     www      5070:   font-size: larger;
                   5071:   font-weight: bold;
                   5072: }
                   5073: 
1.346     albertel 5074: td.LC_menubuttons_text {
1.911     bisitz   5075:   color: $font;
1.346     albertel 5076: }
1.706     harmsja  5077: 
1.346     albertel 5078: .LC_current_location {
                   5079:   background: $tabbg;
                   5080: }
1.795     www      5081: 
1.346     albertel 5082: .LC_new_mail {
1.634     www      5083:   background: $tabbg;
1.346     albertel 5084:   font-weight: bold;
                   5085: }
1.347     albertel 5086: 
1.795     www      5087: table.LC_data_table,
                   5088: table.LC_mail_list {
1.347     albertel 5089:   border: 1px solid #000000;
1.402     albertel 5090:   border-collapse: separate;
1.426     albertel 5091:   border-spacing: 1px;
1.610     albertel 5092:   background: $pgbg;
1.347     albertel 5093: }
1.795     www      5094: 
1.422     albertel 5095: .LC_data_table_dense {
                   5096:   font-size: small;
                   5097: }
1.795     www      5098: 
1.507     raeburn  5099: table.LC_nested_outer {
                   5100:   border: 1px solid #000000;
1.589     raeburn  5101:   border-collapse: collapse;
1.803     bisitz   5102:   border-spacing: 0;
1.507     raeburn  5103:   width: 100%;
                   5104: }
1.795     www      5105: 
1.879     raeburn  5106: table.LC_innerpickbox,
1.507     raeburn  5107: table.LC_nested {
1.803     bisitz   5108:   border: none;
1.589     raeburn  5109:   border-collapse: collapse;
1.803     bisitz   5110:   border-spacing: 0;
1.507     raeburn  5111:   width: 100%;
                   5112: }
1.795     www      5113: 
1.911     bisitz   5114: table.LC_data_table tr th,
                   5115: table.LC_calendar tr th,
1.795     www      5116: table.LC_mail_list tr th,
1.879     raeburn  5117: table.LC_prior_tries tr th,
                   5118: table.LC_innerpickbox tr th {
1.349     albertel 5119:   font-weight: bold;
                   5120:   background-color: $data_table_head;
1.801     tempelho 5121:   color:$fontmenu;
1.701     harmsja  5122:   font-size:90%;
1.347     albertel 5123: }
1.795     www      5124: 
1.879     raeburn  5125: table.LC_innerpickbox tr th,
                   5126: table.LC_innerpickbox tr td {
                   5127:   vertical-align: top;
                   5128: }
                   5129: 
1.711     raeburn  5130: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5131:   background-color: #CCCCCC;
1.711     raeburn  5132:   font-weight: bold;
                   5133:   text-align: left;
                   5134: }
1.795     www      5135: 
1.912     bisitz   5136: table.LC_data_table tr.LC_odd_row > td {
                   5137:   background-color: $data_table_light;
                   5138:   padding: 2px;
                   5139:   vertical-align: top;
                   5140: }
                   5141: 
1.809     bisitz   5142: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5143:   background-color: $data_table_light;
1.912     bisitz   5144:   vertical-align: top;
                   5145: }
                   5146: 
                   5147: table.LC_data_table tr.LC_even_row > td {
                   5148:   background-color: $data_table_dark;
1.425     albertel 5149:   padding: 2px;
1.900     bisitz   5150:   vertical-align: top;
1.347     albertel 5151: }
1.795     www      5152: 
1.809     bisitz   5153: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5154:   background-color: $data_table_dark;
1.900     bisitz   5155:   vertical-align: top;
1.347     albertel 5156: }
1.795     www      5157: 
1.425     albertel 5158: table.LC_data_table tr.LC_data_table_highlight td {
                   5159:   background-color: $data_table_darker;
                   5160: }
1.795     www      5161: 
1.639     raeburn  5162: table.LC_data_table tr td.LC_leftcol_header {
                   5163:   background-color: $data_table_head;
                   5164:   font-weight: bold;
                   5165: }
1.795     www      5166: 
1.451     albertel 5167: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5168: table.LC_nested tr.LC_empty_row td {
1.347     albertel 5169:   background-color: #FFFFFF;
1.421     albertel 5170:   font-weight: bold;
                   5171:   font-style: italic;
                   5172:   text-align: center;
                   5173:   padding: 8px;
1.347     albertel 5174: }
1.795     www      5175: 
1.890     droeschl 5176: table.LC_caption {
                   5177: }
                   5178: 
1.507     raeburn  5179: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5180:   padding: 4ex
                   5181: }
1.795     www      5182: 
1.507     raeburn  5183: table.LC_nested_outer tr th {
                   5184:   font-weight: bold;
1.801     tempelho 5185:   color:$fontmenu;
1.507     raeburn  5186:   background-color: $data_table_head;
1.701     harmsja  5187:   font-size: small;
1.507     raeburn  5188:   border-bottom: 1px solid #000000;
                   5189: }
1.795     www      5190: 
1.507     raeburn  5191: table.LC_nested_outer tr td.LC_subheader {
                   5192:   background-color: $data_table_head;
                   5193:   font-weight: bold;
                   5194:   font-size: small;
                   5195:   border-bottom: 1px solid #000000;
                   5196:   text-align: right;
1.451     albertel 5197: }
1.795     www      5198: 
1.507     raeburn  5199: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5200:   background-color: #CCCCCC;
1.451     albertel 5201:   font-weight: bold;
                   5202:   font-size: small;
1.507     raeburn  5203:   text-align: center;
                   5204: }
1.795     www      5205: 
1.589     raeburn  5206: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5207: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5208:   text-align: left;
1.451     albertel 5209: }
1.795     www      5210: 
1.507     raeburn  5211: table.LC_nested td {
1.735     bisitz   5212:   background-color: #FFFFFF;
1.451     albertel 5213:   font-size: small;
1.507     raeburn  5214: }
1.795     www      5215: 
1.507     raeburn  5216: table.LC_nested_outer tr th.LC_right_item,
                   5217: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5218: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5219: table.LC_nested tr td.LC_right_item {
1.451     albertel 5220:   text-align: right;
                   5221: }
                   5222: 
1.507     raeburn  5223: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5224:   background-color: #EEEEEE;
1.451     albertel 5225: }
                   5226: 
1.473     raeburn  5227: table.LC_createuser {
                   5228: }
                   5229: 
                   5230: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5231:   font-size: small;
1.473     raeburn  5232: }
                   5233: 
                   5234: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5235:   background-color: #CCCCCC;
1.473     raeburn  5236:   font-weight: bold;
                   5237:   text-align: center;
                   5238: }
                   5239: 
1.349     albertel 5240: table.LC_calendar {
                   5241:   border: 1px solid #000000;
                   5242:   border-collapse: collapse;
1.917     raeburn  5243:   width: 98%;
1.349     albertel 5244: }
1.795     www      5245: 
1.349     albertel 5246: table.LC_calendar_pickdate {
                   5247:   font-size: xx-small;
                   5248: }
1.795     www      5249: 
1.349     albertel 5250: table.LC_calendar tr td {
                   5251:   border: 1px solid #000000;
                   5252:   vertical-align: top;
1.917     raeburn  5253:   width: 14%;
1.349     albertel 5254: }
1.795     www      5255: 
1.349     albertel 5256: table.LC_calendar tr td.LC_calendar_day_empty {
                   5257:   background-color: $data_table_dark;
                   5258: }
1.795     www      5259: 
1.779     bisitz   5260: table.LC_calendar tr td.LC_calendar_day_current {
                   5261:   background-color: $data_table_highlight;
1.777     tempelho 5262: }
1.795     www      5263: 
1.349     albertel 5264: table.LC_mail_list tr.LC_mail_new {
                   5265:   background-color: $mail_new;
                   5266: }
1.795     www      5267: 
1.349     albertel 5268: table.LC_mail_list tr.LC_mail_new:hover {
                   5269:   background-color: $mail_new_hover;
                   5270: }
1.795     www      5271: 
                   5272: table.LC_mail_list tr.LC_mail_even {
1.777     tempelho 5273: }
1.795     www      5274: 
                   5275: table.LC_mail_list tr.LC_mail_odd {
1.777     tempelho 5276: }
1.795     www      5277: 
1.349     albertel 5278: table.LC_mail_list tr.LC_mail_read {
                   5279:   background-color: $mail_read;
                   5280: }
1.795     www      5281: 
1.349     albertel 5282: table.LC_mail_list tr.LC_mail_read:hover {
                   5283:   background-color: $mail_read_hover;
                   5284: }
1.795     www      5285: 
1.349     albertel 5286: table.LC_mail_list tr.LC_mail_replied {
                   5287:   background-color: $mail_replied;
                   5288: }
1.795     www      5289: 
1.349     albertel 5290: table.LC_mail_list tr.LC_mail_replied:hover {
                   5291:   background-color: $mail_replied_hover;
                   5292: }
1.795     www      5293: 
1.349     albertel 5294: table.LC_mail_list tr.LC_mail_other {
                   5295:   background-color: $mail_other;
                   5296: }
1.795     www      5297: 
1.349     albertel 5298: table.LC_mail_list tr.LC_mail_other:hover {
                   5299:   background-color: $mail_other_hover;
                   5300: }
1.494     raeburn  5301: 
1.777     tempelho 5302: table.LC_data_table tr > td.LC_browser_file,
                   5303: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5304:   background: #AAEE77;
1.389     albertel 5305: }
1.795     www      5306: 
1.777     tempelho 5307: table.LC_data_table tr > td.LC_browser_file_locked,
                   5308: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5309:   background: #FFAA99;
1.387     albertel 5310: }
1.795     www      5311: 
1.777     tempelho 5312: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5313:   background: #888888;
1.779     bisitz   5314: }
1.795     www      5315: 
1.777     tempelho 5316: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5317: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5318:   background: #F8F866;
1.777     tempelho 5319: }
1.795     www      5320: 
1.696     bisitz   5321: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5322:   background: #E0E8FF;
1.387     albertel 5323: }
1.696     bisitz   5324: 
1.707     bisitz   5325: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5326:   /* background: #77FF77; */
1.707     bisitz   5327: }
1.795     www      5328: 
1.707     bisitz   5329: table.LC_data_table tr > td.LC_roles_future {
                   5330:   background: #FFFF77;
                   5331: }
1.795     www      5332: 
1.707     bisitz   5333: table.LC_data_table tr > td.LC_roles_will {
                   5334:   background: #FFAA77;
                   5335: }
1.795     www      5336: 
1.707     bisitz   5337: table.LC_data_table tr > td.LC_roles_expired {
                   5338:   background: #FF7777;
                   5339: }
1.795     www      5340: 
1.707     bisitz   5341: table.LC_data_table tr > td.LC_roles_will_not {
                   5342:   background: #AAFF77;
                   5343: }
1.795     www      5344: 
1.707     bisitz   5345: table.LC_data_table tr > td.LC_roles_selected {
                   5346:   background: #11CC55;
                   5347: }
                   5348: 
1.388     albertel 5349: span.LC_current_location {
1.701     harmsja  5350:   font-size:larger;
1.388     albertel 5351:   background: $pgbg;
                   5352: }
1.387     albertel 5353: 
1.395     albertel 5354: span.LC_parm_menu_item {
                   5355:   font-size: larger;
                   5356: }
1.795     www      5357: 
1.395     albertel 5358: span.LC_parm_scope_all {
                   5359:   color: red;
                   5360: }
1.795     www      5361: 
1.395     albertel 5362: span.LC_parm_scope_folder {
                   5363:   color: green;
                   5364: }
1.795     www      5365: 
1.395     albertel 5366: span.LC_parm_scope_resource {
                   5367:   color: orange;
                   5368: }
1.795     www      5369: 
1.395     albertel 5370: span.LC_parm_part {
                   5371:   color: blue;
                   5372: }
1.795     www      5373: 
1.911     bisitz   5374: span.LC_parm_folder,
                   5375: span.LC_parm_symb {
1.395     albertel 5376:   font-size: x-small;
                   5377:   font-family: $mono;
                   5378:   color: #AAAAAA;
                   5379: }
                   5380: 
1.795     www      5381: td.LC_parm_overview_level_menu,
                   5382: td.LC_parm_overview_map_menu,
                   5383: td.LC_parm_overview_parm_selectors,
                   5384: td.LC_parm_overview_restrictions  {
1.396     albertel 5385:   border: 1px solid black;
                   5386:   border-collapse: collapse;
                   5387: }
1.795     www      5388: 
1.396     albertel 5389: table.LC_parm_overview_restrictions td {
                   5390:   border-width: 1px 4px 1px 4px;
                   5391:   border-style: solid;
                   5392:   border-color: $pgbg;
                   5393:   text-align: center;
                   5394: }
1.795     www      5395: 
1.396     albertel 5396: table.LC_parm_overview_restrictions th {
                   5397:   background: $tabbg;
                   5398:   border-width: 1px 4px 1px 4px;
                   5399:   border-style: solid;
                   5400:   border-color: $pgbg;
                   5401: }
1.795     www      5402: 
1.398     albertel 5403: table#LC_helpmenu {
1.803     bisitz   5404:   border: none;
1.398     albertel 5405:   height: 55px;
1.803     bisitz   5406:   border-spacing: 0;
1.398     albertel 5407: }
                   5408: 
                   5409: table#LC_helpmenu fieldset legend {
                   5410:   font-size: larger;
                   5411: }
1.795     www      5412: 
1.397     albertel 5413: table#LC_helpmenu_links {
                   5414:   width: 100%;
                   5415:   border: 1px solid black;
                   5416:   background: $pgbg;
1.803     bisitz   5417:   padding: 0;
1.397     albertel 5418:   border-spacing: 1px;
                   5419: }
1.795     www      5420: 
1.397     albertel 5421: table#LC_helpmenu_links tr td {
                   5422:   padding: 1px;
                   5423:   background: $tabbg;
1.399     albertel 5424:   text-align: center;
                   5425:   font-weight: bold;
1.397     albertel 5426: }
1.396     albertel 5427: 
1.795     www      5428: table#LC_helpmenu_links a:link,
                   5429: table#LC_helpmenu_links a:visited,
1.397     albertel 5430: table#LC_helpmenu_links a:active {
                   5431:   text-decoration: none;
                   5432:   color: $font;
                   5433: }
1.795     www      5434: 
1.397     albertel 5435: table#LC_helpmenu_links a:hover {
                   5436:   text-decoration: underline;
                   5437:   color: $vlink;
                   5438: }
1.396     albertel 5439: 
1.417     albertel 5440: .LC_chrt_popup_exists {
                   5441:   border: 1px solid #339933;
                   5442:   margin: -1px;
                   5443: }
1.795     www      5444: 
1.417     albertel 5445: .LC_chrt_popup_up {
                   5446:   border: 1px solid yellow;
                   5447:   margin: -1px;
                   5448: }
1.795     www      5449: 
1.417     albertel 5450: .LC_chrt_popup {
                   5451:   border: 1px solid #8888FF;
                   5452:   background: #CCCCFF;
                   5453: }
1.795     www      5454: 
1.421     albertel 5455: table.LC_pick_box {
                   5456:   border-collapse: separate;
                   5457:   background: white;
                   5458:   border: 1px solid black;
                   5459:   border-spacing: 1px;
                   5460: }
1.795     www      5461: 
1.421     albertel 5462: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   5463:   background: $sidebg;
1.421     albertel 5464:   font-weight: bold;
1.900     bisitz   5465:   text-align: left;
1.740     bisitz   5466:   vertical-align: top;
1.421     albertel 5467:   width: 184px;
                   5468:   padding: 8px;
                   5469: }
1.795     www      5470: 
1.579     raeburn  5471: table.LC_pick_box td.LC_pick_box_value {
                   5472:   text-align: left;
                   5473:   padding: 8px;
                   5474: }
1.795     www      5475: 
1.579     raeburn  5476: table.LC_pick_box td.LC_pick_box_select {
                   5477:   text-align: left;
                   5478:   padding: 8px;
                   5479: }
1.795     www      5480: 
1.424     albertel 5481: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   5482:   padding: 0;
1.421     albertel 5483:   height: 1px;
                   5484:   background: black;
                   5485: }
1.795     www      5486: 
1.421     albertel 5487: table.LC_pick_box td.LC_pick_box_submit {
                   5488:   text-align: right;
                   5489: }
1.795     www      5490: 
1.579     raeburn  5491: table.LC_pick_box td.LC_evenrow_value {
                   5492:   text-align: left;
                   5493:   padding: 8px;
                   5494:   background-color: $data_table_light;
                   5495: }
1.795     www      5496: 
1.579     raeburn  5497: table.LC_pick_box td.LC_oddrow_value {
                   5498:   text-align: left;
                   5499:   padding: 8px;
                   5500:   background-color: $data_table_light;
                   5501: }
1.795     www      5502: 
1.579     raeburn  5503: span.LC_helpform_receipt_cat {
                   5504:   font-weight: bold;
                   5505: }
1.795     www      5506: 
1.424     albertel 5507: table.LC_group_priv_box {
                   5508:   background: white;
                   5509:   border: 1px solid black;
                   5510:   border-spacing: 1px;
                   5511: }
1.795     www      5512: 
1.424     albertel 5513: table.LC_group_priv_box td.LC_pick_box_title {
                   5514:   background: $tabbg;
                   5515:   font-weight: bold;
                   5516:   text-align: right;
                   5517:   width: 184px;
                   5518: }
1.795     www      5519: 
1.424     albertel 5520: table.LC_group_priv_box td.LC_groups_fixed {
                   5521:   background: $data_table_light;
                   5522:   text-align: center;
                   5523: }
1.795     www      5524: 
1.424     albertel 5525: table.LC_group_priv_box td.LC_groups_optional {
                   5526:   background: $data_table_dark;
                   5527:   text-align: center;
                   5528: }
1.795     www      5529: 
1.424     albertel 5530: table.LC_group_priv_box td.LC_groups_functionality {
                   5531:   background: $data_table_darker;
                   5532:   text-align: center;
                   5533:   font-weight: bold;
                   5534: }
1.795     www      5535: 
1.424     albertel 5536: table.LC_group_priv td {
                   5537:   text-align: left;
1.803     bisitz   5538:   padding: 0;
1.424     albertel 5539: }
                   5540: 
1.421     albertel 5541: table.LC_notify_front_page {
                   5542:   background: white;
                   5543:   border: 1px solid black;
                   5544:   padding: 8px;
                   5545: }
1.795     www      5546: 
1.421     albertel 5547: table.LC_notify_front_page td {
                   5548:   padding: 8px;
                   5549: }
1.795     www      5550: 
1.424     albertel 5551: .LC_navbuttons {
                   5552:   margin: 2ex 0ex 2ex 0ex;
                   5553: }
1.795     www      5554: 
1.423     albertel 5555: .LC_topic_bar {
                   5556:   font-weight: bold;
                   5557:   background: $tabbg;
1.918     wenzelju 5558:   margin: 1em 0em 1em 2em;
1.805     bisitz   5559:   padding: 3px;
1.918     wenzelju 5560:   font-size: 1.2em;
1.423     albertel 5561: }
1.795     www      5562: 
1.423     albertel 5563: .LC_topic_bar span {
1.918     wenzelju 5564:   left: 0.5em;
                   5565:   position: absolute;
1.423     albertel 5566:   vertical-align: middle;
1.918     wenzelju 5567:   font-size: 1.2em;
1.423     albertel 5568: }
1.795     www      5569: 
1.423     albertel 5570: .LC_topic_bar img {
                   5571:   vertical-align: bottom;
                   5572: }
1.795     www      5573: 
1.423     albertel 5574: table.LC_course_group_status {
                   5575:   margin: 20px;
                   5576: }
1.795     www      5577: 
1.423     albertel 5578: table.LC_status_selector td {
                   5579:   vertical-align: top;
                   5580:   text-align: center;
1.424     albertel 5581:   padding: 4px;
                   5582: }
1.795     www      5583: 
1.599     albertel 5584: div.LC_feedback_link {
1.616     albertel 5585:   clear: both;
1.829     kalberla 5586:   background: $sidebg;
1.779     bisitz   5587:   width: 100%;
1.829     kalberla 5588:   padding-bottom: 10px;
                   5589:   border: 1px $tabbg solid;
1.833     kalberla 5590:   height: 22px;
                   5591:   line-height: 22px;
                   5592:   padding-top: 5px;
                   5593: }
                   5594: 
                   5595: div.LC_feedback_link img {
                   5596:   height: 22px;
1.867     kalberla 5597:   vertical-align:middle;
1.829     kalberla 5598: }
                   5599: 
1.911     bisitz   5600: div.LC_feedback_link a {
1.829     kalberla 5601:   text-decoration: none;
1.489     raeburn  5602: }
1.795     www      5603: 
1.867     kalberla 5604: div.LC_comblock {
1.911     bisitz   5605:   display:inline;
1.867     kalberla 5606:   color:$font;
                   5607:   font-size:90%;
                   5608: }
                   5609: 
                   5610: div.LC_feedback_link div.LC_comblock {
                   5611:   padding-left:5px;
                   5612: }
                   5613: 
                   5614: div.LC_feedback_link div.LC_comblock a {
                   5615:   color:$font;
                   5616: }
                   5617: 
1.489     raeburn  5618: span.LC_feedback_link {
1.858     bisitz   5619:   /* background: $feedback_link_bg; */
1.599     albertel 5620:   font-size: larger;
                   5621: }
1.795     www      5622: 
1.599     albertel 5623: span.LC_message_link {
1.858     bisitz   5624:   /* background: $feedback_link_bg; */
1.599     albertel 5625:   font-size: larger;
                   5626:   position: absolute;
                   5627:   right: 1em;
1.489     raeburn  5628: }
1.421     albertel 5629: 
1.515     albertel 5630: table.LC_prior_tries {
1.524     albertel 5631:   border: 1px solid #000000;
                   5632:   border-collapse: separate;
                   5633:   border-spacing: 1px;
1.515     albertel 5634: }
1.523     albertel 5635: 
1.515     albertel 5636: table.LC_prior_tries td {
1.524     albertel 5637:   padding: 2px;
1.515     albertel 5638: }
1.523     albertel 5639: 
                   5640: .LC_answer_correct {
1.795     www      5641:   background: lightgreen;
                   5642:   color: darkgreen;
                   5643:   padding: 6px;
1.523     albertel 5644: }
1.795     www      5645: 
1.523     albertel 5646: .LC_answer_charged_try {
1.797     www      5647:   background: #FFAAAA;
1.795     www      5648:   color: darkred;
                   5649:   padding: 6px;
1.523     albertel 5650: }
1.795     www      5651: 
1.779     bisitz   5652: .LC_answer_not_charged_try,
1.523     albertel 5653: .LC_answer_no_grade,
                   5654: .LC_answer_late {
1.795     www      5655:   background: lightyellow;
1.523     albertel 5656:   color: black;
1.795     www      5657:   padding: 6px;
1.523     albertel 5658: }
1.795     www      5659: 
1.523     albertel 5660: .LC_answer_previous {
1.795     www      5661:   background: lightblue;
                   5662:   color: darkblue;
                   5663:   padding: 6px;
1.523     albertel 5664: }
1.795     www      5665: 
1.779     bisitz   5666: .LC_answer_no_message {
1.777     tempelho 5667:   background: #FFFFFF;
                   5668:   color: black;
1.795     www      5669:   padding: 6px;
1.779     bisitz   5670: }
1.795     www      5671: 
1.779     bisitz   5672: .LC_answer_unknown {
                   5673:   background: orange;
                   5674:   color: black;
1.795     www      5675:   padding: 6px;
1.777     tempelho 5676: }
1.795     www      5677: 
1.529     albertel 5678: span.LC_prior_numerical,
                   5679: span.LC_prior_string,
                   5680: span.LC_prior_custom,
                   5681: span.LC_prior_reaction,
                   5682: span.LC_prior_math {
1.523     albertel 5683:   font-family: monospace;
                   5684:   white-space: pre;
                   5685: }
                   5686: 
1.525     albertel 5687: span.LC_prior_string {
                   5688:   font-family: monospace;
                   5689:   white-space: pre;
                   5690: }
                   5691: 
1.523     albertel 5692: table.LC_prior_option {
                   5693:   width: 100%;
                   5694:   border-collapse: collapse;
                   5695: }
1.795     www      5696: 
1.911     bisitz   5697: table.LC_prior_rank,
1.795     www      5698: table.LC_prior_match {
1.528     albertel 5699:   border-collapse: collapse;
                   5700: }
1.795     www      5701: 
1.528     albertel 5702: table.LC_prior_option tr td,
                   5703: table.LC_prior_rank tr td,
                   5704: table.LC_prior_match tr td {
1.524     albertel 5705:   border: 1px solid #000000;
1.515     albertel 5706: }
                   5707: 
1.855     bisitz   5708: .LC_nobreak {
1.544     albertel 5709:   white-space: nowrap;
1.519     raeburn  5710: }
                   5711: 
1.576     raeburn  5712: span.LC_cusr_emph {
                   5713:   font-style: italic;
                   5714: }
                   5715: 
1.633     raeburn  5716: span.LC_cusr_subheading {
                   5717:   font-weight: normal;
                   5718:   font-size: 85%;
                   5719: }
                   5720: 
1.545     albertel 5721: table.LC_docs_documents {
                   5722:   background: #BBBBBB;
1.803     bisitz   5723:   border-width: 0;
1.545     albertel 5724:   border-collapse: collapse;
                   5725: }
1.795     www      5726: 
1.777     tempelho 5727: table.LC_docs_documents td.LC_docs_document {
1.779     bisitz   5728:   border: 2px solid black;
                   5729:   padding: 4px;
1.777     tempelho 5730: }
1.795     www      5731: 
1.861     bisitz   5732: div.LC_docs_entry_move {
1.859     bisitz   5733:   border: 1px solid #BBBBBB;
1.545     albertel 5734:   background: #DDDDDD;
1.861     bisitz   5735:   width: 22px;
1.859     bisitz   5736:   padding: 1px;
                   5737:   margin: 0;
1.545     albertel 5738: }
                   5739: 
1.861     bisitz   5740: table.LC_data_table tr > td.LC_docs_entry_commands,
                   5741: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 5742:   background: #DDDDDD;
                   5743:   font-size: x-small;
                   5744: }
1.795     www      5745: 
1.861     bisitz   5746: .LC_docs_entry_parameter {
                   5747:   white-space: nowrap;
                   5748: }
                   5749: 
1.544     albertel 5750: .LC_docs_copy {
1.545     albertel 5751:   color: #000099;
1.544     albertel 5752: }
1.795     www      5753: 
1.544     albertel 5754: .LC_docs_cut {
1.545     albertel 5755:   color: #550044;
1.544     albertel 5756: }
1.795     www      5757: 
1.544     albertel 5758: .LC_docs_rename {
1.545     albertel 5759:   color: #009900;
1.544     albertel 5760: }
1.795     www      5761: 
1.544     albertel 5762: .LC_docs_remove {
1.545     albertel 5763:   color: #990000;
                   5764: }
                   5765: 
1.547     albertel 5766: .LC_docs_reinit_warn,
                   5767: .LC_docs_ext_edit {
                   5768:   font-size: x-small;
                   5769: }
                   5770: 
1.545     albertel 5771: table.LC_docs_adddocs td,
                   5772: table.LC_docs_adddocs th {
                   5773:   border: 1px solid #BBBBBB;
                   5774:   padding: 4px;
                   5775:   background: #DDDDDD;
1.543     albertel 5776: }
                   5777: 
1.584     albertel 5778: table.LC_sty_begin {
                   5779:   background: #BBFFBB;
                   5780: }
1.795     www      5781: 
1.584     albertel 5782: table.LC_sty_end {
                   5783:   background: #FFBBBB;
                   5784: }
                   5785: 
1.589     raeburn  5786: table.LC_double_column {
1.803     bisitz   5787:   border-width: 0;
1.589     raeburn  5788:   border-collapse: collapse;
                   5789:   width: 100%;
                   5790:   padding: 2px;
                   5791: }
                   5792: 
                   5793: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  5794:   top: 2px;
1.589     raeburn  5795:   left: 2px;
                   5796:   width: 47%;
                   5797:   vertical-align: top;
                   5798: }
                   5799: 
                   5800: table.LC_double_column tr td.LC_right_col {
                   5801:   top: 2px;
1.779     bisitz   5802:   right: 2px;
1.589     raeburn  5803:   width: 47%;
                   5804:   vertical-align: top;
                   5805: }
                   5806: 
1.591     raeburn  5807: div.LC_left_float {
                   5808:   float: left;
                   5809:   padding-right: 5%;
1.597     albertel 5810:   padding-bottom: 4px;
1.591     raeburn  5811: }
                   5812: 
                   5813: div.LC_clear_float_header {
1.597     albertel 5814:   padding-bottom: 2px;
1.591     raeburn  5815: }
                   5816: 
                   5817: div.LC_clear_float_footer {
1.597     albertel 5818:   padding-top: 10px;
1.591     raeburn  5819:   clear: both;
                   5820: }
                   5821: 
1.597     albertel 5822: div.LC_grade_show_user {
                   5823:   margin-top: 20px;
                   5824:   border: 1px solid black;
                   5825: }
1.795     www      5826: 
1.597     albertel 5827: div.LC_grade_user_name {
                   5828:   background: #DDDDEE;
                   5829:   border-bottom: 1px solid black;
1.705     tempelho 5830:   font-weight: bold;
                   5831:   font-size: large;
1.597     albertel 5832: }
1.795     www      5833: 
1.597     albertel 5834: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
                   5835:   background: #DDEEDD;
                   5836: }
                   5837: 
                   5838: div.LC_grade_show_problem,
                   5839: div.LC_grade_submissions,
                   5840: div.LC_grade_message_center,
                   5841: div.LC_grade_info_links,
                   5842: div.LC_grade_assign {
                   5843:   margin: 5px;
                   5844:   width: 99%;
                   5845:   background: #FFFFFF;
                   5846: }
1.795     www      5847: 
1.597     albertel 5848: div.LC_grade_show_problem_header,
                   5849: div.LC_grade_submissions_header,
                   5850: div.LC_grade_message_center_header,
                   5851: div.LC_grade_assign_header {
1.705     tempelho 5852:   font-weight: bold;
                   5853:   font-size: large;
1.597     albertel 5854: }
1.795     www      5855: 
1.597     albertel 5856: div.LC_grade_show_problem_problem,
                   5857: div.LC_grade_submissions_body,
                   5858: div.LC_grade_message_center_body,
                   5859: div.LC_grade_assign_body {
                   5860:   border: 1px solid black;
                   5861:   width: 99%;
                   5862:   background: #FFFFFF;
                   5863: }
1.795     www      5864: 
1.598     albertel 5865: span.LC_grade_check_note {
1.705     tempelho 5866:   font-weight: normal;
                   5867:   font-size: medium;
1.598     albertel 5868:   display: inline;
                   5869:   position: absolute;
                   5870:   right: 1em;
                   5871: }
1.597     albertel 5872: 
1.613     albertel 5873: table.LC_scantron_action {
                   5874:   width: 100%;
                   5875: }
1.795     www      5876: 
1.613     albertel 5877: table.LC_scantron_action tr th {
1.698     harmsja  5878:   font-weight:bold;
                   5879:   font-style:normal;
1.613     albertel 5880: }
1.795     www      5881: 
1.779     bisitz   5882: .LC_edit_problem_header,
1.614     albertel 5883: div.LC_edit_problem_footer {
1.705     tempelho 5884:   font-weight: normal;
                   5885:   font-size:  medium;
1.602     albertel 5886:   margin: 2px;
1.600     albertel 5887: }
1.795     www      5888: 
1.600     albertel 5889: div.LC_edit_problem_header,
1.602     albertel 5890: div.LC_edit_problem_header div,
1.614     albertel 5891: div.LC_edit_problem_footer,
                   5892: div.LC_edit_problem_footer div,
1.602     albertel 5893: div.LC_edit_problem_editxml_header,
                   5894: div.LC_edit_problem_editxml_header div {
1.600     albertel 5895:   margin-top: 5px;
                   5896: }
1.795     www      5897: 
1.600     albertel 5898: div.LC_edit_problem_header_title {
1.705     tempelho 5899:   font-weight: bold;
                   5900:   font-size: larger;
1.602     albertel 5901:   background: $tabbg;
                   5902:   padding: 3px;
                   5903: }
1.795     www      5904: 
1.602     albertel 5905: table.LC_edit_problem_header_title {
1.705     tempelho 5906:   font-size: larger;
                   5907:   font-weight:  bold;
1.602     albertel 5908:   width: 100%;
                   5909:   border-color: $pgbg;
                   5910:   border-style: solid;
                   5911:   border-width: $border;
1.600     albertel 5912:   background: $tabbg;
1.602     albertel 5913:   border-collapse: collapse;
1.803     bisitz   5914:   padding: 0;
1.602     albertel 5915: }
                   5916: 
                   5917: div.LC_edit_problem_discards {
                   5918:   float: left;
                   5919:   padding-bottom: 5px;
                   5920: }
1.795     www      5921: 
1.602     albertel 5922: div.LC_edit_problem_saves {
                   5923:   float: right;
                   5924:   padding-bottom: 5px;
1.600     albertel 5925: }
1.795     www      5926: 
1.911     bisitz   5927: img.stift {
1.803     bisitz   5928:   border-width: 0;
                   5929:   vertical-align: middle;
1.677     riegler  5930: }
1.680     riegler  5931: 
1.911     bisitz   5932: table#LC_mainmenu {
                   5933:   margin-top:10px;
                   5934:   width:80%;
1.681     riegler  5935: }
                   5936: 
1.911     bisitz   5937: table#LC_mainmenu td.LC_mainmenu_col_fieldset {
1.680     riegler  5938:   vertical-align: top;
                   5939:   width: 45%;
                   5940: }
1.795     www      5941: 
1.779     bisitz   5942: .LC_mainmenu_fieldset_category {
                   5943:   color: $font;
                   5944:   background: $pgbg;
                   5945:   font-size: small;
                   5946:   font-weight: bold;
1.777     tempelho 5947: }
1.795     www      5948: 
1.716     raeburn  5949: div.LC_createcourse {
1.911     bisitz   5950:   margin: 10px 10px 10px 10px;
1.716     raeburn  5951: }
                   5952: 
1.917     raeburn  5953: .LC_dccid {
                   5954:   margin: 0.2em 0 0 0;
                   5955:   padding: 0;
                   5956:   font-size: 90%;
                   5957:   display:none;
                   5958: }
                   5959: 
1.693     droeschl 5960: /* ---- Remove when done ----
                   5961: # The following styles is part of the redesign of LON-CAPA and are
                   5962: # subject to change during this project.
                   5963: # Don't rely on their current functionality as they might be 
                   5964: # changed or removed.
                   5965: # --------------------------*/
                   5966: 
1.698     harmsja  5967: a:hover,
1.897     wenzelju 5968: ol.LC_primary_menu a:hover,
1.721     harmsja  5969: ol#LC_MenuBreadcrumbs a:hover,
                   5970: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 5971: ul#LC_secondary_menu a:hover,
1.721     harmsja  5972: .LC_FormSectionClearButton input:hover
1.795     www      5973: ul.LC_TabContent   li:hover a {
1.911     bisitz   5974:   color:#BF2317;
                   5975:   text-decoration:none;
1.693     droeschl 5976: }
                   5977: 
1.779     bisitz   5978: h1 {
1.911     bisitz   5979:   padding: 0;
                   5980:   line-height:130%;
1.693     droeschl 5981: }
1.698     harmsja  5982: 
1.911     bisitz   5983: h2,
                   5984: h3,
                   5985: h4,
                   5986: h5,
                   5987: h6 {
                   5988:   margin: 5px 0 5px 0;
                   5989:   padding: 0;
                   5990:   line-height:130%;
1.693     droeschl 5991: }
1.795     www      5992: 
                   5993: .LC_hcell {
1.911     bisitz   5994:   padding:3px 15px 3px 15px;
                   5995:   margin: 0;
                   5996:   background-color:$tabbg;
                   5997:   color:$fontmenu;
                   5998:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 5999: }
1.795     www      6000: 
1.840     bisitz   6001: .LC_Box > .LC_hcell {
1.911     bisitz   6002:   margin: 0 -10px 10px -10px;
1.835     bisitz   6003: }
                   6004: 
1.721     harmsja  6005: .LC_noBorder {
1.911     bisitz   6006:   border: 0;
1.698     harmsja  6007: }
1.693     droeschl 6008: 
1.761     tempelho 6009: .LC_Right {
1.911     bisitz   6010:   float: right;
                   6011:   margin: 0;
                   6012:   padding: 0;
1.761     tempelho 6013: }
                   6014: 
1.721     harmsja  6015: .LC_FormSectionClearButton input {
1.911     bisitz   6016:   background-color:transparent;
                   6017:   border: none;
                   6018:   cursor:pointer;
                   6019:   text-decoration:underline;
1.693     droeschl 6020: }
1.763     bisitz   6021: 
                   6022: .LC_help_open_topic {
1.911     bisitz   6023:   color: #FFFFFF;
                   6024:   background-color: #EEEEFF;
                   6025:   margin: 1px;
                   6026:   padding: 4px;
                   6027:   border: 1px solid #000033;
                   6028:   white-space: nowrap;
                   6029:   /* vertical-align: middle; */
1.759     neumanie 6030: }
1.693     droeschl 6031: 
1.911     bisitz   6032: dl,
                   6033: ul,
                   6034: div,
                   6035: fieldset {
                   6036:   margin: 10px 10px 10px 0;
                   6037:   /* overflow: hidden; */
1.693     droeschl 6038: }
1.795     www      6039: 
1.838     bisitz   6040: fieldset > legend {
1.911     bisitz   6041:   font-weight: bold;
                   6042:   padding: 0 5px 0 5px;
1.838     bisitz   6043: }
                   6044: 
1.813     bisitz   6045: #LC_nav_bar {
1.911     bisitz   6046:   float: left;
                   6047:   margin: 0.2em 0 0 0;
1.807     droeschl 6048: }
                   6049: 
1.916     droeschl 6050: #LC_realm {
                   6051:   margin: 0.2em 0 0 0;
                   6052:   padding: 0;
                   6053:   font-weight: bold;
                   6054:   text-align: center;
                   6055: }
                   6056: 
1.911     bisitz   6057: #LC_nav_bar em {
                   6058:   font-weight: bold;
                   6059:   font-style: normal;
1.807     droeschl 6060: }
                   6061: 
1.897     wenzelju 6062: ol.LC_primary_menu {
1.911     bisitz   6063:   float: right;
                   6064:   margin: 0.2em 0 0 0;
1.807     droeschl 6065: }
                   6066: 
1.852     droeschl 6067: ol#LC_PathBreadcrumbs {
1.911     bisitz   6068:   margin: 0;
1.693     droeschl 6069: }
                   6070: 
1.897     wenzelju 6071: ol.LC_primary_menu li {
1.911     bisitz   6072:   display: inline;
                   6073:   padding: 5px 5px 0 10px;
                   6074:   vertical-align: top;
1.693     droeschl 6075: }
                   6076: 
1.897     wenzelju 6077: ol.LC_primary_menu li img {
1.911     bisitz   6078:   vertical-align: bottom;
1.693     droeschl 6079: }
                   6080: 
1.897     wenzelju 6081: ol.LC_primary_menu a {
1.911     bisitz   6082:   font-size: 90%;
                   6083:   color: RGB(80, 80, 80);
                   6084:   text-decoration: none;
1.693     droeschl 6085: }
1.795     www      6086: 
1.897     wenzelju 6087: ul#LC_secondary_menu {
1.911     bisitz   6088:   clear: both;
                   6089:   color: $fontmenu;
                   6090:   background: $tabbg;
                   6091:   list-style: none;
                   6092:   padding: 0;
                   6093:   margin: 0;
                   6094:   width: 100%;
1.808     droeschl 6095: }
                   6096: 
1.897     wenzelju 6097: ul#LC_secondary_menu li {
1.911     bisitz   6098:   font-weight: bold;
                   6099:   line-height: 1.8em;
                   6100:   padding: 0 0.8em;
                   6101:   border-right: 1px solid black;
                   6102:   display: inline;
                   6103:   vertical-align: middle;
1.807     droeschl 6104: }
                   6105: 
1.847     tempelho 6106: ul.LC_TabContent {
1.911     bisitz   6107:   display:block;
                   6108:   background: $sidebg;
                   6109:   border-bottom: solid 1px $lg_border_color;
                   6110:   list-style:none;
                   6111:   margin: 0 -10px;
                   6112:   padding: 0;
1.693     droeschl 6113: }
                   6114: 
1.795     www      6115: ul.LC_TabContent li,
                   6116: ul.LC_TabContentBigger li {
1.911     bisitz   6117:   float:left;
1.741     harmsja  6118: }
1.795     www      6119: 
1.897     wenzelju 6120: ul#LC_secondary_menu li a {
1.911     bisitz   6121:   color: $fontmenu;
                   6122:   text-decoration: none;
1.693     droeschl 6123: }
1.795     www      6124: 
1.721     harmsja  6125: ul.LC_TabContent {
1.911     bisitz   6126:   min-height:1.5em;
1.721     harmsja  6127: }
1.795     www      6128: 
                   6129: ul.LC_TabContent li {
1.911     bisitz   6130:   vertical-align:middle;
                   6131:   padding: 0 10px 0 10px;
                   6132:   background-color:$tabbg;
                   6133:   border-bottom:solid 1px $lg_border_color;
1.721     harmsja  6134: }
1.795     www      6135: 
1.847     tempelho 6136: ul.LC_TabContent .right {
1.911     bisitz   6137:   float:right;
1.847     tempelho 6138: }
                   6139: 
1.911     bisitz   6140: ul.LC_TabContent li a,
                   6141: ul.LC_TabContent li {
                   6142:   color:rgb(47,47,47);
                   6143:   text-decoration:none;
                   6144:   font-size:95%;
                   6145:   font-weight:bold;
                   6146:   padding-right: 16px;
1.721     harmsja  6147: }
1.795     www      6148: 
1.911     bisitz   6149: ul.LC_TabContent li:hover,
                   6150: ul.LC_TabContent li.active {
                   6151:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
                   6152:   border-bottom:solid 2px #FFFFFF;
                   6153:   padding-right: 16px;
1.744     ehlerst  6154: }
1.795     www      6155: 
1.870     tempelho 6156: #maincoursedoc {
1.911     bisitz   6157:   clear:both;
1.870     tempelho 6158: }
                   6159: 
                   6160: ul.LC_TabContentBigger {
1.911     bisitz   6161:   display:block;
                   6162:   list-style:none;
                   6163:   padding: 0;
1.870     tempelho 6164: }
                   6165: 
1.795     www      6166: ul.LC_TabContentBigger li {
1.911     bisitz   6167:   vertical-align:bottom;
                   6168:   height: 30px;
                   6169:   font-size:110%;
                   6170:   font-weight:bold;
                   6171:   color: #737373;
1.841     tempelho 6172: }
                   6173: 
1.870     tempelho 6174: 
                   6175: ul.LC_TabContentBigger li a {
1.911     bisitz   6176:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6177:   height: 30px;
                   6178:   line-height: 30px;
                   6179:   text-align: center;
                   6180:   display: block;
                   6181:   text-decoration: none;
1.741     harmsja  6182: }
1.795     www      6183: 
1.911     bisitz   6184: ul.LC_TabContentBigger li:hover a,
1.870     tempelho 6185: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6186:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6187:   color:$font;
                   6188:   text-decoration: underline;
1.744     ehlerst  6189: }
1.795     www      6190: 
1.870     tempelho 6191: 
                   6192: ul.LC_TabContentBigger li b {
1.911     bisitz   6193:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6194:   display: block;
                   6195:   float: left;
                   6196:   padding: 0 30px;
1.870     tempelho 6197: }
                   6198: 
                   6199: ul.LC_TabContentBigger li:hover b,
                   6200: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6201:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6202:   color:$font;
                   6203:   border-bottom: 1px solid #FFFFFF;
1.741     harmsja  6204: }
1.693     droeschl 6205: 
1.870     tempelho 6206: 
1.862     bisitz   6207: ul.LC_CourseBreadcrumbs {
                   6208:   background: $sidebg;
                   6209:   line-height: 32px;
                   6210:   padding-left: 10px;
                   6211:   margin: 0 0 10px 0;
                   6212:   list-style-position: inside;
                   6213: 
                   6214: }
                   6215: 
1.911     bisitz   6216: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6217: ol#LC_PathBreadcrumbs {
1.911     bisitz   6218:   padding-left: 10px;
                   6219:   margin: 0;
                   6220:   list-style-position: inside;
1.915     droeschl 6221:     /* SD working here 
1.904     droeschl 6222:     white-space: nowrap; */
1.693     droeschl 6223: }
                   6224: 
1.911     bisitz   6225: ol#LC_MenuBreadcrumbs li,
                   6226: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6227: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6228:   display: inline;
                   6229:   white-space: nowrap;
1.915     droeschl 6230:     /* SD working here  
                   6231:     white-space: normal; */ 
1.693     droeschl 6232: }
                   6233: 
1.823     bisitz   6234: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6235: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6236:   text-decoration: none;
                   6237:   font-size:90%;
1.693     droeschl 6238: }
1.795     www      6239: 
                   6240: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6241:   text-decoration:none;
                   6242:   font-size:100%;
                   6243:   font-weight:bold;
1.693     droeschl 6244: }
1.795     www      6245: 
1.840     bisitz   6246: .LC_Box {
1.911     bisitz   6247:   border: solid 1px $lg_border_color;
                   6248:   padding: 0 10px 10px 10px;
1.746     neumanie 6249: }
1.795     www      6250: 
                   6251: .LC_AboutMe_Image {
1.911     bisitz   6252:   float:left;
                   6253:   margin-right:10px;
1.747     neumanie 6254: }
1.795     www      6255: 
                   6256: .LC_Clear_AboutMe_Image {
1.911     bisitz   6257:   clear:left;
1.747     neumanie 6258: }
1.795     www      6259: 
1.721     harmsja  6260: dl.LC_ListStyleClean dt {
1.911     bisitz   6261:   padding-right: 5px;
                   6262:   display: table-header-group;
1.693     droeschl 6263: }
                   6264: 
1.721     harmsja  6265: dl.LC_ListStyleClean dd {
1.911     bisitz   6266:   display: table-row;
1.693     droeschl 6267: }
                   6268: 
1.721     harmsja  6269: .LC_ListStyleClean,
                   6270: .LC_ListStyleSimple,
                   6271: .LC_ListStyleNormal,
1.777     tempelho 6272: .LC_ListStyle_Border,
1.795     www      6273: .LC_ListStyleSpecial {
1.911     bisitz   6274:   /* display:block; */
                   6275:   list-style-position: inside;
                   6276:   list-style-type: none;
                   6277:   overflow: hidden;
                   6278:   padding: 0;
1.693     droeschl 6279: }
                   6280: 
1.721     harmsja  6281: .LC_ListStyleSimple li,
                   6282: .LC_ListStyleSimple dd,
                   6283: .LC_ListStyleNormal li,
                   6284: .LC_ListStyleNormal dd,
                   6285: .LC_ListStyleSpecial li,
1.795     www      6286: .LC_ListStyleSpecial dd {
1.911     bisitz   6287:   margin: 0;
                   6288:   padding: 5px 5px 5px 10px;
                   6289:   clear: both;
1.693     droeschl 6290: }
                   6291: 
1.721     harmsja  6292: .LC_ListStyleClean li,
                   6293: .LC_ListStyleClean dd {
1.911     bisitz   6294:   padding-top: 0;
                   6295:   padding-bottom: 0;
1.693     droeschl 6296: }
                   6297: 
1.721     harmsja  6298: .LC_ListStyleSimple dd,
1.795     www      6299: .LC_ListStyleSimple li {
1.911     bisitz   6300:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6301: }
                   6302: 
1.721     harmsja  6303: .LC_ListStyleSpecial li,
                   6304: .LC_ListStyleSpecial dd {
1.911     bisitz   6305:   list-style-type: none;
                   6306:   background-color: RGB(220, 220, 220);
                   6307:   margin-bottom: 4px;
1.693     droeschl 6308: }
                   6309: 
1.721     harmsja  6310: table.LC_SimpleTable {
1.911     bisitz   6311:   margin:5px;
                   6312:   border:solid 1px $lg_border_color;
1.795     www      6313: }
1.693     droeschl 6314: 
1.721     harmsja  6315: table.LC_SimpleTable tr {
1.911     bisitz   6316:   padding: 0;
                   6317:   border:solid 1px $lg_border_color;
1.693     droeschl 6318: }
1.795     www      6319: 
                   6320: table.LC_SimpleTable thead {
1.911     bisitz   6321:   background:rgb(220,220,220);
1.693     droeschl 6322: }
                   6323: 
1.721     harmsja  6324: div.LC_columnSection {
1.911     bisitz   6325:   display: block;
                   6326:   clear: both;
                   6327:   overflow: hidden;
                   6328:   margin: 0;
1.693     droeschl 6329: }
                   6330: 
1.721     harmsja  6331: div.LC_columnSection>* {
1.911     bisitz   6332:   float: left;
                   6333:   margin: 10px 20px 10px 0;
                   6334:   overflow:hidden;
1.693     droeschl 6335: }
1.721     harmsja  6336: 
1.694     tempelho 6337: .LC_loginpage_container {
1.911     bisitz   6338:   text-align:left;
                   6339:   margin : 0 auto;
                   6340:   width:90%;
                   6341:   padding: 10px;
                   6342:   height: auto;
                   6343:   background-color:#FFFFFF;
                   6344:   border:1px solid #CCCCCC;
1.694     tempelho 6345: }
                   6346: 
                   6347: 
                   6348: .LC_loginpage_loginContainer {
1.911     bisitz   6349:   float:left;
                   6350:   width: 182px;
                   6351:   padding: 2px;
                   6352:   border:1px solid #CCCCCC;
                   6353:   background-color:$loginbg;
1.694     tempelho 6354: }
                   6355: 
1.795     www      6356: .LC_loginpage_loginContainer h2 {
1.911     bisitz   6357:   margin-top: 0;
                   6358:   display:block;
                   6359:   background:$bgcol;
                   6360:   color:$textcol;
                   6361:   padding-left:5px;
1.712     muellerd 6362: }
1.785     tempelho 6363: 
1.694     tempelho 6364: .LC_loginpage_loginInfo {
1.911     bisitz   6365:   float:left;
                   6366:   width:182px;
                   6367:   border:1px solid #CCCCCC;
                   6368:   padding:2px;
1.712     muellerd 6369: }
                   6370: 
1.694     tempelho 6371: .LC_loginpage_space {
1.911     bisitz   6372:   clear: both;
                   6373:   margin-bottom: 20px;
                   6374:   border-bottom: 1px solid #CCCCCC;
1.694     tempelho 6375: }
                   6376: 
1.785     tempelho 6377: .LC_loginpage_floatLeft {
1.911     bisitz   6378:   float: left;
                   6379:   width: 200px;
                   6380:   margin: 0;
1.785     tempelho 6381: }
                   6382: 
1.795     www      6383: table em {
1.911     bisitz   6384:   font-weight: bold;
                   6385:   font-style: normal;
1.748     schulted 6386: }
1.795     www      6387: 
1.779     bisitz   6388: table.LC_tableBrowseRes,
1.795     www      6389: table.LC_tableOfContent {
1.911     bisitz   6390:   border:none;
                   6391:   border-spacing: 1px;
                   6392:   padding: 3px;
                   6393:   background-color: #FFFFFF;
                   6394:   font-size: 90%;
1.753     droeschl 6395: }
1.789     droeschl 6396: 
1.911     bisitz   6397: table.LC_tableOfContent {
                   6398:   border-collapse: collapse;
1.789     droeschl 6399: }
                   6400: 
1.771     droeschl 6401: table.LC_tableBrowseRes a,
1.768     schulted 6402: table.LC_tableOfContent a {
1.911     bisitz   6403:   background-color: transparent;
                   6404:   text-decoration: none;
1.753     droeschl 6405: }
                   6406: 
1.771     droeschl 6407: table.LC_tableBrowseRes tr.LC_trOdd,
1.911     bisitz   6408: table.LC_tableOfContent tr.LC_trOdd {
                   6409:   background-color: #EEEEEE;
1.753     droeschl 6410: }
                   6411: 
1.795     www      6412: table.LC_tableOfContent img {
1.911     bisitz   6413:   border: none;
                   6414:   height: 1.3em;
                   6415:   vertical-align: text-bottom;
                   6416:   margin-right: 0.3em;
1.753     droeschl 6417: }
1.757     schulted 6418: 
1.795     www      6419: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6420:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6421: }
                   6422: 
1.795     www      6423: a#LC_content_toolbar_launchnav {
1.911     bisitz   6424:   background-image:url(/res/adm/pages/start-navigation.gif);
1.774     ehlerst  6425: }
                   6426: 
1.795     www      6427: a#LC_content_toolbar_closenav {
1.911     bisitz   6428:   background-image:url(/res/adm/pages/close-navigation.gif);
1.774     ehlerst  6429: }
                   6430: 
1.795     www      6431: a#LC_content_toolbar_everything {
1.911     bisitz   6432:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6433: }
                   6434: 
1.795     www      6435: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6436:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6437: }
                   6438: 
1.795     www      6439: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6440:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6441: }
                   6442: 
1.795     www      6443: a#LC_content_toolbar_changefolder {
1.911     bisitz   6444:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6445: }
                   6446: 
1.795     www      6447: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6448:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6449: }
                   6450: 
1.795     www      6451: ul#LC_toolbar li a:hover {
1.911     bisitz   6452:   background-position: bottom center;
1.757     schulted 6453: }
                   6454: 
1.795     www      6455: ul#LC_toolbar {
1.911     bisitz   6456:   padding: 0;
                   6457:   margin: 2px;
                   6458:   list-style:none;
                   6459:   position:relative;
                   6460:   background-color:white;
1.757     schulted 6461: }
                   6462: 
1.795     www      6463: ul#LC_toolbar li {
1.911     bisitz   6464:   border:1px solid white;
                   6465:   padding: 0;
                   6466:   margin: 0;
                   6467:   float: left;
                   6468:   display:inline;
                   6469:   vertical-align:middle;
                   6470: }
1.757     schulted 6471: 
1.783     amueller 6472: 
1.795     www      6473: a.LC_toolbarItem {
1.911     bisitz   6474:   display:block;
                   6475:   padding: 0;
                   6476:   margin: 0;
                   6477:   height: 32px;
                   6478:   width: 32px;
                   6479:   color:white;
                   6480:   border: none;
                   6481:   background-repeat:no-repeat;
                   6482:   background-color:transparent;
1.757     schulted 6483: }
                   6484: 
1.915     droeschl 6485: ul.LC_funclist {
                   6486:     margin: 0;
                   6487:     padding: 0.5em 1em 0.5em 0;
                   6488: }
                   6489: 
                   6490: ul.LC_funclist + ul.LC_funclist {
                   6491:     /* 
                   6492:        left border as a seperator if we have more than
                   6493:        one list 
                   6494:     */
                   6495:     border-left: 1px solid $sidebg;
                   6496:     /* 
                   6497:        this hides the left border behind the border of the 
                   6498:        outer box if element is wrapped to the next 'line' 
                   6499:     */
                   6500:     margin-left: -1px;
                   6501: }
                   6502: 
1.843     bisitz   6503: ul.LC_funclist li {
1.915     droeschl 6504:   display: inline;
1.782     bisitz   6505:   white-space: nowrap;
1.915     droeschl 6506:   margin: 0 0 0 25px;
                   6507:   line-height: 150%;
1.782     bisitz   6508: }
                   6509: 
1.757     schulted 6510: 
1.343     albertel 6511: END
                   6512: }
                   6513: 
1.306     albertel 6514: =pod
                   6515: 
                   6516: =item * &headtag()
                   6517: 
                   6518: Returns a uniform footer for LON-CAPA web pages.
                   6519: 
1.307     albertel 6520: Inputs: $title - optional title for the head
                   6521:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 6522:         $args - optional arguments
1.319     albertel 6523:             force_register - if is true call registerurl so the remote is 
                   6524:                              informed
1.415     albertel 6525:             redirect       -> array ref of
                   6526:                                    1- seconds before redirect occurs
                   6527:                                    2- url to redirect to
                   6528:                                    3- whether the side effect should occur
1.315     albertel 6529:                            (side effect of setting 
                   6530:                                $env{'internal.head.redirect'} to the url 
                   6531:                                redirected too)
1.352     albertel 6532:             domain         -> force to color decorate a page for a specific
                   6533:                                domain
                   6534:             function       -> force usage of a specific rolish color scheme
                   6535:             bgcolor        -> override the default page bgcolor
1.460     albertel 6536:             no_auto_mt_title
                   6537:                            -> prevent &mt()ing the title arg
1.464     albertel 6538: 
1.306     albertel 6539: =cut
                   6540: 
                   6541: sub headtag {
1.313     albertel 6542:     my ($title,$head_extra,$args) = @_;
1.306     albertel 6543:     
1.363     albertel 6544:     my $function = $args->{'function'} || &get_users_function();
                   6545:     my $domain   = $args->{'domain'}   || &determinedomain();
                   6546:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 6547:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 6548: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 6549: 		   #time(),
1.418     albertel 6550: 		   $env{'environment.color.timestamp'},
1.363     albertel 6551: 		   $function,$domain,$bgcolor);
                   6552: 
1.369     www      6553:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 6554: 
1.308     albertel 6555:     my $result =
                   6556: 	'<head>'.
1.461     albertel 6557: 	&font_settings();
1.319     albertel 6558: 
1.461     albertel 6559:     if (!$args->{'frameset'}) {
                   6560: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   6561:     }
1.319     albertel 6562:     if ($args->{'force_register'}) {
                   6563: 	$result .= &Apache::lonmenu::registerurl(1);
                   6564:     }
1.436     albertel 6565:     if (!$args->{'no_nav_bar'} 
                   6566: 	&& !$args->{'only_body'}
                   6567: 	&& !$args->{'frameset'}) {
                   6568: 	$result .= &help_menu_js();
                   6569:     }
1.319     albertel 6570: 
1.314     albertel 6571:     if (ref($args->{'redirect'})) {
1.414     albertel 6572: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6573: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6574: 	if (!$inhibit_continue) {
                   6575: 	    $env{'internal.head.redirect'} = $url;
                   6576: 	}
1.313     albertel 6577: 	$result.=<<ADDMETA
                   6578: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6579: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6580: ADDMETA
                   6581:     }
1.306     albertel 6582:     if (!defined($title)) {
                   6583: 	$title = 'The LearningOnline Network with CAPA';
                   6584:     }
1.460     albertel 6585:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6586:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6587: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   6588: 	.$head_extra;
1.306     albertel 6589:     return $result;
                   6590: }
                   6591: 
                   6592: =pod
                   6593: 
1.340     albertel 6594: =item * &font_settings()
                   6595: 
                   6596: Returns neccessary <meta> to set the proper encoding
                   6597: 
                   6598: Inputs: none
                   6599: 
                   6600: =cut
                   6601: 
                   6602: sub font_settings {
                   6603:     my $headerstring='';
1.647     www      6604:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6605: 	$headerstring.=
                   6606: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6607:     }
                   6608:     return $headerstring;
                   6609: }
                   6610: 
1.341     albertel 6611: =pod
                   6612: 
                   6613: =item * &xml_begin()
                   6614: 
                   6615: Returns the needed doctype and <html>
                   6616: 
                   6617: Inputs: none
                   6618: 
                   6619: =cut
                   6620: 
                   6621: sub xml_begin {
                   6622:     my $output='';
                   6623: 
1.592     albertel 6624:     if ($env{'internal.start_page'}==1) {
                   6625: 	&Apache::lonhtmlcommon::init_htmlareafields();
                   6626:     }
1.342     albertel 6627: 
1.341     albertel 6628:     if ($env{'browser.mathml'}) {
                   6629: 	$output='<?xml version="1.0"?>'
                   6630:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   6631: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   6632:             
                   6633: #	    .'<!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">] >'
                   6634: 	    .'<!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">'
                   6635:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   6636: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   6637:     } else {
1.849     bisitz   6638: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   6639:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 6640:     }
                   6641:     return $output;
                   6642: }
1.340     albertel 6643: 
                   6644: =pod
                   6645: 
1.306     albertel 6646: =item * &endheadtag()
                   6647: 
                   6648: Returns a uniform </head> for LON-CAPA web pages.
                   6649: 
                   6650: Inputs: none
                   6651: 
                   6652: =cut
                   6653: 
                   6654: sub endheadtag {
                   6655:     return '</head>';
                   6656: }
                   6657: 
                   6658: =pod
                   6659: 
                   6660: =item * &head()
                   6661: 
                   6662: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
                   6663: 
1.648     raeburn  6664: Inputs:
                   6665: 
                   6666: =over 4
                   6667: 
                   6668: $title - optional title for the page
                   6669: 
                   6670: $head_extra - optional extra HTML to put inside the <head>
                   6671: 
                   6672: =back
1.405     albertel 6673: 
1.306     albertel 6674: =cut
                   6675: 
                   6676: sub head {
1.325     albertel 6677:     my ($title,$head_extra,$args) = @_;
                   6678:     return &headtag($title,$head_extra,$args).&endheadtag();
1.306     albertel 6679: }
                   6680: 
                   6681: =pod
                   6682: 
                   6683: =item * &start_page()
                   6684: 
                   6685: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6686: 
1.648     raeburn  6687: Inputs:
                   6688: 
                   6689: =over 4
                   6690: 
                   6691: $title - optional title for the page
                   6692: 
                   6693: $head_extra - optional extra HTML to incude inside the <head>
                   6694: 
                   6695: $args - additional optional args supported are:
                   6696: 
                   6697: =over 8
                   6698: 
                   6699:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6700:                                     arg on
1.814     bisitz   6701:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  6702:              add_entries    -> additional attributes to add to the  <body>
                   6703:              domain         -> force to color decorate a page for a 
1.317     albertel 6704:                                     specific domain
1.648     raeburn  6705:              function       -> force usage of a specific rolish color
1.317     albertel 6706:                                     scheme
1.648     raeburn  6707:              redirect       -> see &headtag()
                   6708:              bgcolor        -> override the default page bg color
                   6709:              js_ready       -> return a string ready for being used in 
1.317     albertel 6710:                                     a javascript writeln
1.648     raeburn  6711:              html_encode    -> return a string ready for being used in 
1.320     albertel 6712:                                     a html attribute
1.648     raeburn  6713:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6714:                                     $forcereg arg
1.648     raeburn  6715:              frameset       -> if true will start with a <frameset>
1.330     albertel 6716:                                     rather than <body>
1.648     raeburn  6717:              skip_phases    -> hash ref of 
1.338     albertel 6718:                                     head -> skip the <html><head> generation
                   6719:                                     body -> skip all <body> generation
1.648     raeburn  6720:              no_inline_link -> if true and in remote mode, don't show the 
1.361     albertel 6721:                                     'Switch To Inline Menu' link
1.648     raeburn  6722:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6723:              inherit_jsmath -> when creating popup window in a page,
                   6724:                                     should it have jsmath forced on by the
                   6725:                                     current page
1.867     kalberla 6726:              bread_crumbs ->             Array containing breadcrumbs
                   6727:              bread_crumbs_components ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 6728: 
1.648     raeburn  6729: =back
1.460     albertel 6730: 
1.648     raeburn  6731: =back
1.562     albertel 6732: 
1.306     albertel 6733: =cut
                   6734: 
                   6735: sub start_page {
1.309     albertel 6736:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6737:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313     albertel 6738:     my %head_args;
1.352     albertel 6739:     foreach my $arg ('redirect','force_register','domain','function',
1.460     albertel 6740: 		     'bgcolor','frameset','no_nav_bar','only_body',
                   6741: 		     'no_auto_mt_title') {
1.319     albertel 6742: 	if (defined($args->{$arg})) {
1.324     raeburn  6743: 	    $head_args{$arg} = $args->{$arg};
1.319     albertel 6744: 	}
1.313     albertel 6745:     }
1.319     albertel 6746: 
1.315     albertel 6747:     $env{'internal.start_page'}++;
1.338     albertel 6748:     my $result;
                   6749:     if (! exists($args->{'skip_phases'}{'head'}) ) {
                   6750: 	$result.=
1.341     albertel 6751: 	    &xml_begin().
1.338     albertel 6752: 	    &headtag($title,$head_extra,\%head_args).&endheadtag();
                   6753:     }
                   6754:     
                   6755:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6756: 	if ($args->{'frameset'}) {
                   6757: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6758: 						$args->{'add_entries'});
                   6759: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   6760:         } else {
                   6761:             $result .=
                   6762:                 &bodytag($title, 
                   6763:                          $args->{'function'},       $args->{'add_entries'},
                   6764:                          $args->{'only_body'},      $args->{'domain'},
                   6765:                          $args->{'force_register'}, $args->{'no_nav_bar'},
                   6766:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
                   6767:                          $args);
                   6768:         }
1.330     albertel 6769:     }
1.338     albertel 6770: 
1.315     albertel 6771:     if ($args->{'js_ready'}) {
1.713     kaisler  6772: 		$result = &js_ready($result);
1.315     albertel 6773:     }
1.320     albertel 6774:     if ($args->{'html_encode'}) {
1.713     kaisler  6775: 		$result = &html_encode($result);
                   6776:     }
                   6777: 
1.813     bisitz   6778:     # Preparation for new and consistent functionlist at top of screen
                   6779:     # if ($args->{'functionlist'}) {
                   6780:     #            $result .= &build_functionlist();
                   6781:     #}
                   6782: 
                   6783:     # Don't add anything more if only_body wanted
                   6784:     return $result if $args->{'only_body'};
                   6785: 
1.920     raeburn  6786:     #Breadcrumbs for Construction Space provided by &bodytag. 
                   6787:     if (($env{'environment.remote'} eq 'off') && ($env{'request.state'} eq 'construct')) {
                   6788:         return $result;
                   6789:     }
                   6790:  
1.813     bisitz   6791:     #Breadcrumbs
1.758     kaisler  6792:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   6793: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   6794: 		#if any br links exists, add them to the breadcrumbs
                   6795: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6796: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6797: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6798: 			}
                   6799: 		}
                   6800: 
                   6801: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   6802: 		if(exists($args->{'bread_crumbs_component'})){
                   6803: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   6804: 		}else{
                   6805: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   6806: 		}
1.320     albertel 6807:     }
1.315     albertel 6808:     return $result;
1.306     albertel 6809: }
                   6810: 
1.330     albertel 6811: 
1.306     albertel 6812: =pod
                   6813: 
                   6814: =item * &head()
                   6815: 
                   6816: Returns a complete </body></html> section for LON-CAPA web pages.
                   6817: 
1.315     albertel 6818: Inputs:         $args - additional optional args supported are:
                   6819:                  js_ready     -> return a string ready for being used in 
                   6820:                                  a javascript writeln
1.320     albertel 6821:                  html_encode  -> return a string ready for being used in 
                   6822:                                  a html attribute
1.330     albertel 6823:                  frameset     -> if true will start with a <frameset>
                   6824:                                  rather than <body>
1.493     albertel 6825:                  dicsussion   -> if true will get discussion from
                   6826:                                   lonxml::xmlend
                   6827:                                  (you can pass the target and parser arguments
                   6828:                                   through optional 'target' and 'parser' args
                   6829:                                   to this routine)
1.306     albertel 6830: 
                   6831: =cut
                   6832: 
                   6833: sub end_page {
1.315     albertel 6834:     my ($args) = @_;
                   6835:     $env{'internal.end_page'}++;
1.330     albertel 6836:     my $result;
1.335     albertel 6837:     if ($args->{'discussion'}) {
                   6838: 	my ($target,$parser);
                   6839: 	if (ref($args->{'discussion'})) {
                   6840: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6841: 				$args->{'discussion'}{'parser'});
                   6842: 	}
                   6843: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6844:     }
                   6845: 
1.330     albertel 6846:     if ($args->{'frameset'}) {
                   6847: 	$result .= '</frameset>';
                   6848:     } else {
1.635     raeburn  6849: 	$result .= &endbodytag($args);
1.330     albertel 6850:     }
                   6851:     $result .= "\n</html>";
                   6852: 
1.315     albertel 6853:     if ($args->{'js_ready'}) {
1.317     albertel 6854: 	$result = &js_ready($result);
1.315     albertel 6855:     }
1.335     albertel 6856: 
1.320     albertel 6857:     if ($args->{'html_encode'}) {
                   6858: 	$result = &html_encode($result);
                   6859:     }
1.335     albertel 6860: 
1.315     albertel 6861:     return $result;
                   6862: }
                   6863: 
1.320     albertel 6864: sub html_encode {
                   6865:     my ($result) = @_;
                   6866: 
1.322     albertel 6867:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 6868:     
                   6869:     return $result;
                   6870: }
1.317     albertel 6871: sub js_ready {
                   6872:     my ($result) = @_;
                   6873: 
1.323     albertel 6874:     $result =~ s/[\n\r]/ /xmsg;
                   6875:     $result =~ s/\\/\\\\/xmsg;
                   6876:     $result =~ s/'/\\'/xmsg;
1.372     albertel 6877:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 6878:     
                   6879:     return $result;
                   6880: }
                   6881: 
1.315     albertel 6882: sub validate_page {
                   6883:     if (  exists($env{'internal.start_page'})
1.316     albertel 6884: 	  &&     $env{'internal.start_page'} > 1) {
                   6885: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 6886: 				 $env{'internal.start_page'}.' '.
1.316     albertel 6887: 				 $ENV{'request.filename'});
1.315     albertel 6888:     }
                   6889:     if (  exists($env{'internal.end_page'})
1.316     albertel 6890: 	  &&     $env{'internal.end_page'} > 1) {
                   6891: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 6892: 				 $env{'internal.end_page'}.' '.
1.316     albertel 6893: 				 $env{'request.filename'});
1.315     albertel 6894:     }
                   6895:     if (     exists($env{'internal.start_page'})
                   6896: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 6897: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   6898: 				 $env{'request.filename'});
1.315     albertel 6899:     }
                   6900:     if (   ! exists($env{'internal.start_page'})
                   6901: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 6902: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   6903: 				 $env{'request.filename'});
1.315     albertel 6904:     }
1.306     albertel 6905: }
1.315     albertel 6906: 
1.318     albertel 6907: sub simple_error_page {
                   6908:     my ($r,$title,$msg) = @_;
                   6909:     my $page =
                   6910: 	&Apache::loncommon::start_page($title).
                   6911: 	&mt($msg).
                   6912: 	&Apache::loncommon::end_page();
                   6913:     if (ref($r)) {
                   6914: 	$r->print($page);
1.327     albertel 6915: 	return;
1.318     albertel 6916:     }
                   6917:     return $page;
                   6918: }
1.347     albertel 6919: 
                   6920: {
1.610     albertel 6921:     my @row_count;
1.347     albertel 6922:     sub start_data_table {
1.422     albertel 6923: 	my ($add_class) = @_;
                   6924: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.610     albertel 6925: 	unshift(@row_count,0);
1.422     albertel 6926: 	return '<table class="'.$css_class.'">'."\n";
1.347     albertel 6927:     }
                   6928: 
                   6929:     sub end_data_table {
1.610     albertel 6930: 	shift(@row_count);
1.389     albertel 6931: 	return '</table>'."\n";;
1.347     albertel 6932:     }
                   6933: 
                   6934:     sub start_data_table_row {
1.422     albertel 6935: 	my ($add_class) = @_;
1.610     albertel 6936: 	$row_count[0]++;
                   6937: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   6938: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.422     albertel 6939: 	return  '<tr class="'.$css_class.'">'."\n";;
1.347     albertel 6940:     }
1.471     banghart 6941:     
                   6942:     sub continue_data_table_row {
                   6943: 	my ($add_class) = @_;
1.610     albertel 6944: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   6945: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');;
1.471     banghart 6946: 	return  '<tr class="'.$css_class.'">'."\n";;
                   6947:     }
1.347     albertel 6948: 
                   6949:     sub end_data_table_row {
1.389     albertel 6950: 	return '</tr>'."\n";;
1.347     albertel 6951:     }
1.367     www      6952: 
1.421     albertel 6953:     sub start_data_table_empty_row {
1.707     bisitz   6954: #	$row_count[0]++;
1.421     albertel 6955: 	return  '<tr class="LC_empty_row" >'."\n";;
                   6956:     }
                   6957: 
                   6958:     sub end_data_table_empty_row {
                   6959: 	return '</tr>'."\n";;
                   6960:     }
                   6961: 
1.367     www      6962:     sub start_data_table_header_row {
1.389     albertel 6963: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      6964:     }
                   6965: 
                   6966:     sub end_data_table_header_row {
1.389     albertel 6967: 	return '</tr>'."\n";;
1.367     www      6968:     }
1.890     droeschl 6969: 
                   6970:     sub data_table_caption {
                   6971:         my $caption = shift;
                   6972:         return "<caption class=\"LC_caption\">$caption</caption>";
                   6973:     }
1.347     albertel 6974: }
                   6975: 
1.548     albertel 6976: =pod
                   6977: 
                   6978: =item * &inhibit_menu_check($arg)
                   6979: 
                   6980: Checks for a inhibitmenu state and generates output to preserve it
                   6981: 
                   6982: Inputs:         $arg - can be any of
                   6983:                      - undef - in which case the return value is a string 
                   6984:                                to add  into arguments list of a uri
                   6985:                      - 'input' - in which case the return value is a HTML
                   6986:                                  <form> <input> field of type hidden to
                   6987:                                  preserve the value
                   6988:                      - a url - in which case the return value is the url with
                   6989:                                the neccesary cgi args added to preserve the
                   6990:                                inhibitmenu state
                   6991:                      - a ref to a url - no return value, but the string is
                   6992:                                         updated to include the neccessary cgi
                   6993:                                         args to preserve the inhibitmenu state
                   6994: 
                   6995: =cut
                   6996: 
                   6997: sub inhibit_menu_check {
                   6998:     my ($arg) = @_;
                   6999:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7000:     if ($arg eq 'input') {
                   7001: 	if ($env{'form.inhibitmenu'}) {
                   7002: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7003: 	} else {
                   7004: 	    return
                   7005: 	}
                   7006:     }
                   7007:     if ($env{'form.inhibitmenu'}) {
                   7008: 	if (ref($arg)) {
                   7009: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7010: 	} elsif ($arg eq '') {
                   7011: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7012: 	} else {
                   7013: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7014: 	}
                   7015:     }
                   7016:     if (!ref($arg)) {
                   7017: 	return $arg;
                   7018:     }
                   7019: }
                   7020: 
1.251     albertel 7021: ###############################################
1.182     matthew  7022: 
                   7023: =pod
                   7024: 
1.549     albertel 7025: =back
                   7026: 
                   7027: =head1 User Information Routines
                   7028: 
                   7029: =over 4
                   7030: 
1.405     albertel 7031: =item * &get_users_function()
1.182     matthew  7032: 
                   7033: Used by &bodytag to determine the current users primary role.
                   7034: Returns either 'student','coordinator','admin', or 'author'.
                   7035: 
                   7036: =cut
                   7037: 
                   7038: ###############################################
                   7039: sub get_users_function {
1.815     tempelho 7040:     my $function = 'norole';
1.818     tempelho 7041:     if ($env{'request.role'}=~/^(st)/) {
                   7042:         $function='student';
                   7043:     }
1.907     raeburn  7044:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7045:         $function='coordinator';
                   7046:     }
1.258     albertel 7047:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7048:         $function='admin';
                   7049:     }
1.826     bisitz   7050:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182     matthew  7051:         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   7052:         $function='author';
                   7053:     }
                   7054:     return $function;
1.54      www      7055: }
1.99      www      7056: 
                   7057: ###############################################
                   7058: 
1.233     raeburn  7059: =pod
                   7060: 
1.821     raeburn  7061: =item * &show_course()
                   7062: 
                   7063: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7064: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7065: 
                   7066: Inputs:
                   7067: None
                   7068: 
                   7069: Outputs:
                   7070: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7071: 
                   7072: =cut
                   7073: 
                   7074: ###############################################
                   7075: sub show_course {
                   7076:     my $course = !$env{'user.adv'};
                   7077:     if (!$env{'user.adv'}) {
                   7078:         foreach my $env (keys(%env)) {
                   7079:             next if ($env !~ m/^user\.priv\./);
                   7080:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7081:                 $course = 0;
                   7082:                 last;
                   7083:             }
                   7084:         }
                   7085:     }
                   7086:     return $course;
                   7087: }
                   7088: 
                   7089: ###############################################
                   7090: 
                   7091: =pod
                   7092: 
1.542     raeburn  7093: =item * &check_user_status()
1.274     raeburn  7094: 
                   7095: Determines current status of supplied role for a
                   7096: specific user. Roles can be active, previous or future.
                   7097: 
                   7098: Inputs: 
                   7099: user's domain, user's username, course's domain,
1.375     raeburn  7100: course's number, optional section ID.
1.274     raeburn  7101: 
                   7102: Outputs:
                   7103: role status: active, previous or future. 
                   7104: 
                   7105: =cut
                   7106: 
                   7107: sub check_user_status {
1.412     raeburn  7108:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274     raeburn  7109:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
                   7110:     my @uroles = keys %userinfo;
                   7111:     my $srchstr;
                   7112:     my $active_chk = 'none';
1.412     raeburn  7113:     my $now = time;
1.274     raeburn  7114:     if (@uroles > 0) {
1.908     raeburn  7115:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7116:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7117:         } else {
1.412     raeburn  7118:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7119:         }
                   7120:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7121:             my $role_end = 0;
                   7122:             my $role_start = 0;
                   7123:             $active_chk = 'active';
1.412     raeburn  7124:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7125:                 $role_end = $1;
                   7126:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7127:                     $role_start = $1;
1.274     raeburn  7128:                 }
                   7129:             }
                   7130:             if ($role_start > 0) {
1.412     raeburn  7131:                 if ($now < $role_start) {
1.274     raeburn  7132:                     $active_chk = 'future';
                   7133:                 }
                   7134:             }
                   7135:             if ($role_end > 0) {
1.412     raeburn  7136:                 if ($now > $role_end) {
1.274     raeburn  7137:                     $active_chk = 'previous';
                   7138:                 }
                   7139:             }
                   7140:         }
                   7141:     }
                   7142:     return $active_chk;
                   7143: }
                   7144: 
                   7145: ###############################################
                   7146: 
                   7147: =pod
                   7148: 
1.405     albertel 7149: =item * &get_sections()
1.233     raeburn  7150: 
                   7151: Determines all the sections for a course including
                   7152: sections with students and sections containing other roles.
1.419     raeburn  7153: Incoming parameters: 
                   7154: 
                   7155: 1. domain
                   7156: 2. course number 
                   7157: 3. reference to array containing roles for which sections should 
                   7158: be gathered (optional).
                   7159: 4. reference to array containing status types for which sections 
                   7160: should be gathered (optional).
                   7161: 
                   7162: If the third argument is undefined, sections are gathered for any role. 
                   7163: If the fourth argument is undefined, sections are gathered for any status.
                   7164: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7165:  
1.374     raeburn  7166: Returns section hash (keys are section IDs, values are
                   7167: number of users in each section), subject to the
1.419     raeburn  7168: optional roles filter, optional status filter 
1.233     raeburn  7169: 
                   7170: =cut
                   7171: 
                   7172: ###############################################
                   7173: sub get_sections {
1.419     raeburn  7174:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7175:     if (!defined($cdom) || !defined($cnum)) {
                   7176:         my $cid =  $env{'request.course.id'};
                   7177: 
                   7178: 	return if (!defined($cid));
                   7179: 
                   7180:         $cdom = $env{'course.'.$cid.'.domain'};
                   7181:         $cnum = $env{'course.'.$cid.'.num'};
                   7182:     }
                   7183: 
                   7184:     my %sectioncount;
1.419     raeburn  7185:     my $now = time;
1.240     albertel 7186: 
1.366     albertel 7187:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7188: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7189: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7190: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7191:         my $start_index = &Apache::loncoursedata::CL_START();
                   7192:         my $end_index = &Apache::loncoursedata::CL_END();
                   7193:         my $status;
1.366     albertel 7194: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7195: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7196: 				                     $data->[$status_index],
                   7197:                                                      $data->[$start_index],
                   7198:                                                      $data->[$end_index]);
                   7199:             if ($stu_status eq 'Active') {
                   7200:                 $status = 'active';
                   7201:             } elsif ($end < $now) {
                   7202:                 $status = 'previous';
                   7203:             } elsif ($start > $now) {
                   7204:                 $status = 'future';
                   7205:             } 
                   7206: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7207:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7208:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7209: 		    $sectioncount{$section}++;
                   7210:                 }
1.240     albertel 7211: 	    }
                   7212: 	}
                   7213:     }
                   7214:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7215:     foreach my $user (sort(keys(%courseroles))) {
                   7216: 	if ($user !~ /^(\w{2})/) { next; }
                   7217: 	my ($role) = ($user =~ /^(\w{2})/);
                   7218: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7219: 	my ($section,$status);
1.240     albertel 7220: 	if ($role eq 'cr' &&
                   7221: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7222: 	    $section=$1;
                   7223: 	}
                   7224: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7225: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7226:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7227:         if ($end == -1 && $start == -1) {
                   7228:             next; #deleted role
                   7229:         }
                   7230:         if (!defined($possible_status)) { 
                   7231:             $sectioncount{$section}++;
                   7232:         } else {
                   7233:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7234:                 $status = 'active';
                   7235:             } elsif ($end < $now) {
                   7236:                 $status = 'future';
                   7237:             } elsif ($start > $now) {
                   7238:                 $status = 'previous';
                   7239:             }
                   7240:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7241:                 $sectioncount{$section}++;
                   7242:             }
                   7243:         }
1.233     raeburn  7244:     }
1.366     albertel 7245:     return %sectioncount;
1.233     raeburn  7246: }
                   7247: 
1.274     raeburn  7248: ###############################################
1.294     raeburn  7249: 
                   7250: =pod
1.405     albertel 7251: 
                   7252: =item * &get_course_users()
                   7253: 
1.275     raeburn  7254: Retrieves usernames:domains for users in the specified course
                   7255: with specific role(s), and access status. 
                   7256: 
                   7257: Incoming parameters:
1.277     albertel 7258: 1. course domain
                   7259: 2. course number
                   7260: 3. access status: users must have - either active, 
1.275     raeburn  7261: previous, future, or all.
1.277     albertel 7262: 4. reference to array of permissible roles
1.288     raeburn  7263: 5. reference to array of section restrictions (optional)
                   7264: 6. reference to results object (hash of hashes).
                   7265: 7. reference to optional userdata hash
1.609     raeburn  7266: 8. reference to optional statushash
1.630     raeburn  7267: 9. flag if privileged users (except those set to unhide in
                   7268:    course settings) should be excluded    
1.609     raeburn  7269: Keys of top level results hash are roles.
1.275     raeburn  7270: Keys of inner hashes are username:domain, with 
                   7271: values set to access type.
1.288     raeburn  7272: Optional userdata hash returns an array with arguments in the 
                   7273: same order as loncoursedata::get_classlist() for student data.
                   7274: 
1.609     raeburn  7275: Optional statushash returns
                   7276: 
1.288     raeburn  7277: Entries for end, start, section and status are blank because
                   7278: of the possibility of multiple values for non-student roles.
                   7279: 
1.275     raeburn  7280: =cut
1.405     albertel 7281: 
1.275     raeburn  7282: ###############################################
1.405     albertel 7283: 
1.275     raeburn  7284: sub get_course_users {
1.630     raeburn  7285:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7286:     my %idx = ();
1.419     raeburn  7287:     my %seclists;
1.288     raeburn  7288: 
                   7289:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7290:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7291:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7292:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7293:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7294:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7295:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7296:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7297: 
1.290     albertel 7298:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7299:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7300:         my $now = time;
1.277     albertel 7301:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7302:             my $match = 0;
1.412     raeburn  7303:             my $secmatch = 0;
1.419     raeburn  7304:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7305:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7306:             if ($section eq '') {
                   7307:                 $section = 'none';
                   7308:             }
1.291     albertel 7309:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7310:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7311:                     $secmatch = 1;
                   7312:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 7313:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7314:                         $secmatch = 1;
                   7315:                     }
                   7316:                 } else {  
1.419     raeburn  7317: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  7318: 		        $secmatch = 1;
                   7319:                     }
1.290     albertel 7320: 		}
1.412     raeburn  7321:                 if (!$secmatch) {
                   7322:                     next;
                   7323:                 }
1.419     raeburn  7324:             }
1.275     raeburn  7325:             if (defined($$types{'active'})) {
1.288     raeburn  7326:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  7327:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  7328:                     $match = 1;
1.275     raeburn  7329:                 }
                   7330:             }
                   7331:             if (defined($$types{'previous'})) {
1.609     raeburn  7332:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  7333:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  7334:                     $match = 1;
1.275     raeburn  7335:                 }
                   7336:             }
                   7337:             if (defined($$types{'future'})) {
1.609     raeburn  7338:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  7339:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  7340:                     $match = 1;
1.275     raeburn  7341:                 }
                   7342:             }
1.609     raeburn  7343:             if ($match) {
                   7344:                 push(@{$seclists{$student}},$section);
                   7345:                 if (ref($userdata) eq 'HASH') {
                   7346:                     $$userdata{$student} = $$classlist{$student};
                   7347:                 }
                   7348:                 if (ref($statushash) eq 'HASH') {
                   7349:                     $statushash->{$student}{'st'}{$section} = $status;
                   7350:                 }
1.288     raeburn  7351:             }
1.275     raeburn  7352:         }
                   7353:     }
1.412     raeburn  7354:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  7355:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7356:         my $now = time;
1.609     raeburn  7357:         my %displaystatus = ( previous => 'Expired',
                   7358:                               active   => 'Active',
                   7359:                               future   => 'Future',
                   7360:                             );
1.630     raeburn  7361:         my %nothide;
                   7362:         if ($hidepriv) {
                   7363:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   7364:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   7365:                 if ($user !~ /:/) {
                   7366:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   7367:                 } else {
                   7368:                     $nothide{$user} = 1;
                   7369:                 }
                   7370:             }
                   7371:         }
1.439     raeburn  7372:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  7373:             my $match = 0;
1.412     raeburn  7374:             my $secmatch = 0;
1.439     raeburn  7375:             my $status;
1.412     raeburn  7376:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  7377:             $user =~ s/:$//;
1.439     raeburn  7378:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   7379:             if ($end == -1 || $start == -1) {
                   7380:                 next;
                   7381:             }
                   7382:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   7383:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  7384:                 my ($uname,$udom) = split(/:/,$user);
                   7385:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7386:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7387:                         $secmatch = 1;
                   7388:                     } elsif ($usec eq '') {
1.420     albertel 7389:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7390:                             $secmatch = 1;
                   7391:                         }
                   7392:                     } else {
                   7393:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   7394:                             $secmatch = 1;
                   7395:                         }
                   7396:                     }
                   7397:                     if (!$secmatch) {
                   7398:                         next;
                   7399:                     }
1.288     raeburn  7400:                 }
1.419     raeburn  7401:                 if ($usec eq '') {
                   7402:                     $usec = 'none';
                   7403:                 }
1.275     raeburn  7404:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  7405:                     if ($hidepriv) {
                   7406:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   7407:                             (!$nothide{$uname.':'.$udom})) {
                   7408:                             next;
                   7409:                         }
                   7410:                     }
1.503     raeburn  7411:                     if ($end > 0 && $end < $now) {
1.439     raeburn  7412:                         $status = 'previous';
                   7413:                     } elsif ($start > $now) {
                   7414:                         $status = 'future';
                   7415:                     } else {
                   7416:                         $status = 'active';
                   7417:                     }
1.277     albertel 7418:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  7419:                         if ($status eq $type) {
1.420     albertel 7420:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  7421:                                 push(@{$$users{$role}{$user}},$type);
                   7422:                             }
1.288     raeburn  7423:                             $match = 1;
                   7424:                         }
                   7425:                     }
1.419     raeburn  7426:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   7427:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   7428: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   7429:                         }
1.420     albertel 7430:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  7431:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   7432:                         }
1.609     raeburn  7433:                         if (ref($statushash) eq 'HASH') {
                   7434:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   7435:                         }
1.275     raeburn  7436:                     }
                   7437:                 }
                   7438:             }
                   7439:         }
1.290     albertel 7440:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  7441:             if ((defined($cdom)) && (defined($cnum))) {
                   7442:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   7443:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   7444:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  7445:                     next if ($owner eq '');
                   7446:                     my ($ownername,$ownerdom);
                   7447:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   7448:                         $ownername = $1;
                   7449:                         $ownerdom = $2;
                   7450:                     } else {
                   7451:                         $ownername = $owner;
                   7452:                         $ownerdom = $cdom;
                   7453:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  7454:                     }
                   7455:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 7456:                     if (defined($userdata) && 
1.609     raeburn  7457: 			!exists($$userdata{$owner})) {
                   7458: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   7459:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   7460:                             push(@{$seclists{$owner}},'none');
                   7461:                         }
                   7462:                         if (ref($statushash) eq 'HASH') {
                   7463:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  7464:                         }
1.290     albertel 7465: 		    }
1.279     raeburn  7466:                 }
                   7467:             }
                   7468:         }
1.419     raeburn  7469:         foreach my $user (keys(%seclists)) {
                   7470:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   7471:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   7472:         }
1.275     raeburn  7473:     }
                   7474:     return;
                   7475: }
                   7476: 
1.288     raeburn  7477: sub get_user_info {
                   7478:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 7479:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   7480: 	&plainname($uname,$udom,'lastname');
1.291     albertel 7481:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  7482:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  7483:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   7484:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  7485:     return;
                   7486: }
1.275     raeburn  7487: 
1.472     raeburn  7488: ###############################################
                   7489: 
                   7490: =pod
                   7491: 
                   7492: =item * &get_user_quota()
                   7493: 
                   7494: Retrieves quota assigned for storage of portfolio files for a user  
                   7495: 
                   7496: Incoming parameters:
                   7497: 1. user's username
                   7498: 2. user's domain
                   7499: 
                   7500: Returns:
1.536     raeburn  7501: 1. Disk quota (in Mb) assigned to student.
                   7502: 2. (Optional) Type of setting: custom or default
                   7503:    (individually assigned or default for user's 
                   7504:    institutional status).
                   7505: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   7506:    or student - types as defined in localenroll::inst_usertypes 
                   7507:    for user's domain, which determines default quota for user.
                   7508: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  7509: 
                   7510: If a value has been stored in the user's environment, 
1.536     raeburn  7511: it will return that, otherwise it returns the maximal default
                   7512: defined for the user's instituional status(es) in the domain.
1.472     raeburn  7513: 
                   7514: =cut
                   7515: 
                   7516: ###############################################
                   7517: 
                   7518: 
                   7519: sub get_user_quota {
                   7520:     my ($uname,$udom) = @_;
1.536     raeburn  7521:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  7522:     if (!defined($udom)) {
                   7523:         $udom = $env{'user.domain'};
                   7524:     }
                   7525:     if (!defined($uname)) {
                   7526:         $uname = $env{'user.name'};
                   7527:     }
                   7528:     if (($udom eq '' || $uname eq '') ||
                   7529:         ($udom eq 'public') && ($uname eq 'public')) {
                   7530:         $quota = 0;
1.536     raeburn  7531:         $quotatype = 'default';
                   7532:         $defquota = 0; 
1.472     raeburn  7533:     } else {
1.536     raeburn  7534:         my $inststatus;
1.472     raeburn  7535:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   7536:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  7537:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  7538:         } else {
1.536     raeburn  7539:             my %userenv = 
                   7540:                 &Apache::lonnet::get('environment',['portfolioquota',
                   7541:                                      'inststatus'],$udom,$uname);
1.472     raeburn  7542:             my ($tmp) = keys(%userenv);
                   7543:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   7544:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  7545:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  7546:             } else {
                   7547:                 undef(%userenv);
                   7548:             }
                   7549:         }
1.536     raeburn  7550:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  7551:         if ($quota eq '') {
1.536     raeburn  7552:             $quota = $defquota;
                   7553:             $quotatype = 'default';
                   7554:         } else {
                   7555:             $quotatype = 'custom';
1.472     raeburn  7556:         }
                   7557:     }
1.536     raeburn  7558:     if (wantarray) {
                   7559:         return ($quota,$quotatype,$settingstatus,$defquota);
                   7560:     } else {
                   7561:         return $quota;
                   7562:     }
1.472     raeburn  7563: }
                   7564: 
                   7565: ###############################################
                   7566: 
                   7567: =pod
                   7568: 
                   7569: =item * &default_quota()
                   7570: 
1.536     raeburn  7571: Retrieves default quota assigned for storage of user portfolio files,
                   7572: given an (optional) user's institutional status.
1.472     raeburn  7573: 
                   7574: Incoming parameters:
                   7575: 1. domain
1.536     raeburn  7576: 2. (Optional) institutional status(es).  This is a : separated list of 
                   7577:    status types (e.g., faculty, staff, student etc.)
                   7578:    which apply to the user for whom the default is being retrieved.
                   7579:    If the institutional status string in undefined, the domain
                   7580:    default quota will be returned. 
1.472     raeburn  7581: 
                   7582: Returns:
                   7583: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  7584: 2. (Optional) institutional type which determined the value of the
                   7585:    default quota.
1.472     raeburn  7586: 
                   7587: If a value has been stored in the domain's configuration db,
                   7588: it will return that, otherwise it returns 20 (for backwards 
                   7589: compatibility with domains which have not set up a configuration
                   7590: db file; the original statically defined portfolio quota was 20 Mb). 
                   7591: 
1.536     raeburn  7592: If the user's status includes multiple types (e.g., staff and student),
                   7593: the largest default quota which applies to the user determines the
                   7594: default quota returned.
                   7595: 
1.780     raeburn  7596: =back
                   7597: 
1.472     raeburn  7598: =cut
                   7599: 
                   7600: ###############################################
                   7601: 
                   7602: 
                   7603: sub default_quota {
1.536     raeburn  7604:     my ($udom,$inststatus) = @_;
                   7605:     my ($defquota,$settingstatus);
                   7606:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  7607:                                             ['quotas'],$udom);
                   7608:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  7609:         if ($inststatus ne '') {
1.765     raeburn  7610:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  7611:             foreach my $item (@statuses) {
1.711     raeburn  7612:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7613:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   7614:                         if ($defquota eq '') {
                   7615:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7616:                             $settingstatus = $item;
                   7617:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   7618:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7619:                             $settingstatus = $item;
                   7620:                         }
                   7621:                     }
                   7622:                 } else {
                   7623:                     if ($quotahash{'quotas'}{$item} ne '') {
                   7624:                         if ($defquota eq '') {
                   7625:                             $defquota = $quotahash{'quotas'}{$item};
                   7626:                             $settingstatus = $item;
                   7627:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   7628:                             $defquota = $quotahash{'quotas'}{$item};
                   7629:                             $settingstatus = $item;
                   7630:                         }
1.536     raeburn  7631:                     }
                   7632:                 }
                   7633:             }
                   7634:         }
                   7635:         if ($defquota eq '') {
1.711     raeburn  7636:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7637:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   7638:             } else {
                   7639:                 $defquota = $quotahash{'quotas'}{'default'};
                   7640:             }
1.536     raeburn  7641:             $settingstatus = 'default';
                   7642:         }
                   7643:     } else {
                   7644:         $settingstatus = 'default';
                   7645:         $defquota = 20;
                   7646:     }
                   7647:     if (wantarray) {
                   7648:         return ($defquota,$settingstatus);
1.472     raeburn  7649:     } else {
1.536     raeburn  7650:         return $defquota;
1.472     raeburn  7651:     }
                   7652: }
                   7653: 
1.384     raeburn  7654: sub get_secgrprole_info {
                   7655:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   7656:     my %sections_count = &get_sections($cdom,$cnum);
                   7657:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   7658:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   7659:     my @groups = sort(keys(%curr_groups));
                   7660:     my $allroles = [];
                   7661:     my $rolehash;
                   7662:     my $accesshash = {
                   7663:                      active => 'Currently has access',
                   7664:                      future => 'Will have future access',
                   7665:                      previous => 'Previously had access',
                   7666:                   };
                   7667:     if ($needroles) {
                   7668:         $rolehash = {'all' => 'all'};
1.385     albertel 7669:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7670: 	if (&Apache::lonnet::error(%user_roles)) {
                   7671: 	    undef(%user_roles);
                   7672: 	}
                   7673:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  7674:             my ($role)=split(/\:/,$item,2);
                   7675:             if ($role eq 'cr') { next; }
                   7676:             if ($role =~ /^cr/) {
                   7677:                 $$rolehash{$role} = (split('/',$role))[3];
                   7678:             } else {
                   7679:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   7680:             }
                   7681:         }
                   7682:         foreach my $key (sort(keys(%{$rolehash}))) {
                   7683:             push(@{$allroles},$key);
                   7684:         }
                   7685:         push (@{$allroles},'st');
                   7686:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   7687:     }
                   7688:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   7689: }
                   7690: 
1.555     raeburn  7691: sub user_picker {
1.627     raeburn  7692:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555     raeburn  7693:     my $currdom = $dom;
                   7694:     my %curr_selected = (
                   7695:                         srchin => 'dom',
1.580     raeburn  7696:                         srchby => 'lastname',
1.555     raeburn  7697:                       );
                   7698:     my $srchterm;
1.625     raeburn  7699:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  7700:         if ($srch->{'srchby'} ne '') {
                   7701:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   7702:         }
                   7703:         if ($srch->{'srchin'} ne '') {
                   7704:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   7705:         }
                   7706:         if ($srch->{'srchtype'} ne '') {
                   7707:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   7708:         }
                   7709:         if ($srch->{'srchdomain'} ne '') {
                   7710:             $currdom = $srch->{'srchdomain'};
                   7711:         }
                   7712:         $srchterm = $srch->{'srchterm'};
                   7713:     }
                   7714:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  7715:                     'usr'       => 'Search criteria',
1.563     raeburn  7716:                     'doma'      => 'Domain/institution to search',
1.558     albertel 7717:                     'uname'     => 'username',
                   7718:                     'lastname'  => 'last name',
1.555     raeburn  7719:                     'lastfirst' => 'last name, first name',
1.558     albertel 7720:                     'crs'       => 'in this course',
1.576     raeburn  7721:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 7722:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  7723:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 7724:                     'exact'     => 'is',
                   7725:                     'contains'  => 'contains',
1.569     raeburn  7726:                     'begins'    => 'begins with',
1.571     raeburn  7727:                     'youm'      => "You must include some text to search for.",
                   7728:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   7729:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   7730:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   7731:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   7732:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   7733:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   7734:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  7735:                                        );
1.563     raeburn  7736:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   7737:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  7738: 
                   7739:     my @srchins = ('crs','dom','alc','instd');
                   7740: 
                   7741:     foreach my $option (@srchins) {
                   7742:         # FIXME 'alc' option unavailable until 
                   7743:         #       loncreateuser::print_user_query_page()
                   7744:         #       has been completed.
                   7745:         next if ($option eq 'alc');
1.880     raeburn  7746:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  7747:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  7748:         if ($curr_selected{'srchin'} eq $option) {
                   7749:             $srchinsel .= ' 
                   7750:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7751:         } else {
                   7752:             $srchinsel .= '
                   7753:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7754:         }
1.555     raeburn  7755:     }
1.563     raeburn  7756:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  7757: 
                   7758:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  7759:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  7760:         if ($curr_selected{'srchby'} eq $option) {
                   7761:             $srchbysel .= '
                   7762:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7763:         } else {
                   7764:             $srchbysel .= '
                   7765:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7766:          }
                   7767:     }
                   7768:     $srchbysel .= "\n  </select>\n";
                   7769: 
                   7770:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  7771:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  7772:         if ($curr_selected{'srchtype'} eq $option) {
                   7773:             $srchtypesel .= '
                   7774:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7775:         } else {
                   7776:             $srchtypesel .= '
                   7777:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7778:         }
                   7779:     }
                   7780:     $srchtypesel .= "\n  </select>\n";
                   7781: 
1.558     albertel 7782:     my ($newuserscript,$new_user_create);
1.556     raeburn  7783: 
                   7784:     if ($forcenewuser) {
1.576     raeburn  7785:         if (ref($srch) eq 'HASH') {
                   7786:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627     raeburn  7787:                 if ($cancreate) {
                   7788:                     $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>';
                   7789:                 } else {
1.799     bisitz   7790:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  7791:                     my %usertypetext = (
                   7792:                         official   => 'institutional',
                   7793:                         unofficial => 'non-institutional',
                   7794:                     );
1.799     bisitz   7795:                     $new_user_create = '<p class="LC_warning">'
                   7796:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   7797:                                       .' '
                   7798:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   7799:                                           ,'<a href="'.$helplink.'">','</a>')
                   7800:                                       .'</p><br />';
1.627     raeburn  7801:                 }
1.576     raeburn  7802:             }
                   7803:         }
                   7804: 
1.556     raeburn  7805:         $newuserscript = <<"ENDSCRIPT";
                   7806: 
1.570     raeburn  7807: function setSearch(createnew,callingForm) {
1.556     raeburn  7808:     if (createnew == 1) {
1.570     raeburn  7809:         for (var i=0; i<callingForm.srchby.length; i++) {
                   7810:             if (callingForm.srchby.options[i].value == 'uname') {
                   7811:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  7812:             }
                   7813:         }
1.570     raeburn  7814:         for (var i=0; i<callingForm.srchin.length; i++) {
                   7815:             if ( callingForm.srchin.options[i].value == 'dom') {
                   7816: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  7817:             }
                   7818:         }
1.570     raeburn  7819:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   7820:             if (callingForm.srchtype.options[i].value == 'exact') {
                   7821:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  7822:             }
                   7823:         }
1.570     raeburn  7824:         for (var i=0; i<callingForm.srchdomain.length; i++) {
                   7825:             if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
                   7826:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  7827:             }
                   7828:         }
                   7829:     }
                   7830: }
                   7831: ENDSCRIPT
1.558     albertel 7832: 
1.556     raeburn  7833:     }
                   7834: 
1.555     raeburn  7835:     my $output = <<"END_BLOCK";
1.556     raeburn  7836: <script type="text/javascript">
1.824     bisitz   7837: // <![CDATA[
1.570     raeburn  7838: function validateEntry(callingForm) {
1.558     albertel 7839: 
1.556     raeburn  7840:     var checkok = 1;
1.558     albertel 7841:     var srchin;
1.570     raeburn  7842:     for (var i=0; i<callingForm.srchin.length; i++) {
                   7843: 	if ( callingForm.srchin[i].checked ) {
                   7844: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 7845: 	}
                   7846:     }
                   7847: 
1.570     raeburn  7848:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   7849:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   7850:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   7851:     var srchterm =  callingForm.srchterm.value;
                   7852:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  7853:     var msg = "";
                   7854: 
                   7855:     if (srchterm == "") {
                   7856:         checkok = 0;
1.571     raeburn  7857:         msg += "$lt{'youm'}\\n";
1.556     raeburn  7858:     }
                   7859: 
1.569     raeburn  7860:     if (srchtype== 'begins') {
                   7861:         if (srchterm.length < 2) {
                   7862:             checkok = 0;
1.571     raeburn  7863:             msg += "$lt{'thte'}\\n";
1.569     raeburn  7864:         }
                   7865:     }
                   7866: 
1.556     raeburn  7867:     if (srchtype== 'contains') {
                   7868:         if (srchterm.length < 3) {
                   7869:             checkok = 0;
1.571     raeburn  7870:             msg += "$lt{'thet'}\\n";
1.556     raeburn  7871:         }
                   7872:     }
                   7873:     if (srchin == 'instd') {
                   7874:         if (srchdomain == '') {
                   7875:             checkok = 0;
1.571     raeburn  7876:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  7877:         }
                   7878:     }
                   7879:     if (srchin == 'dom') {
                   7880:         if (srchdomain == '') {
                   7881:             checkok = 0;
1.571     raeburn  7882:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  7883:         }
                   7884:     }
                   7885:     if (srchby == 'lastfirst') {
                   7886:         if (srchterm.indexOf(",") == -1) {
                   7887:             checkok = 0;
1.571     raeburn  7888:             msg += "$lt{'whus'}\\n";
1.556     raeburn  7889:         }
                   7890:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   7891:             checkok = 0;
1.571     raeburn  7892:             msg += "$lt{'whse'}\\n";
1.556     raeburn  7893:         }
                   7894:     }
                   7895:     if (checkok == 0) {
1.571     raeburn  7896:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  7897:         return;
                   7898:     }
                   7899:     if (checkok == 1) {
1.570     raeburn  7900:         callingForm.submit();
1.556     raeburn  7901:     }
                   7902: }
                   7903: 
                   7904: $newuserscript
                   7905: 
1.824     bisitz   7906: // ]]>
1.556     raeburn  7907: </script>
1.558     albertel 7908: 
                   7909: $new_user_create
                   7910: 
1.555     raeburn  7911: END_BLOCK
1.558     albertel 7912: 
1.876     raeburn  7913:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   7914:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   7915:                $domform.
                   7916:                &Apache::lonhtmlcommon::row_closure().
                   7917:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   7918:                $srchbysel.
                   7919:                $srchtypesel. 
                   7920:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   7921:                $srchinsel.
                   7922:                &Apache::lonhtmlcommon::row_closure(1). 
                   7923:                &Apache::lonhtmlcommon::end_pick_box().
                   7924:                '<br />';
1.555     raeburn  7925:     return $output;
                   7926: }
                   7927: 
1.612     raeburn  7928: sub user_rule_check {
1.615     raeburn  7929:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  7930:     my $response;
                   7931:     if (ref($usershash) eq 'HASH') {
                   7932:         foreach my $user (keys(%{$usershash})) {
                   7933:             my ($uname,$udom) = split(/:/,$user);
                   7934:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  7935:             my ($id,$newuser);
1.612     raeburn  7936:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  7937:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  7938:                 $id = $usershash->{$user}->{'id'};
                   7939:             }
                   7940:             my $inst_response;
                   7941:             if (ref($checks) eq 'HASH') {
                   7942:                 if (defined($checks->{'username'})) {
1.615     raeburn  7943:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  7944:                         &Apache::lonnet::get_instuser($udom,$uname);
                   7945:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  7946:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  7947:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   7948:                 }
1.615     raeburn  7949:             } else {
                   7950:                 ($inst_response,%{$inst_results->{$user}}) =
                   7951:                     &Apache::lonnet::get_instuser($udom,$uname);
                   7952:                 return;
1.612     raeburn  7953:             }
1.615     raeburn  7954:             if (!$got_rules->{$udom}) {
1.612     raeburn  7955:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   7956:                                                   ['usercreation'],$udom);
                   7957:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  7958:                     foreach my $item ('username','id') {
1.612     raeburn  7959:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   7960:                             $$curr_rules{$udom}{$item} = 
                   7961:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  7962:                         }
                   7963:                     }
                   7964:                 }
1.615     raeburn  7965:                 $got_rules->{$udom} = 1;  
1.585     raeburn  7966:             }
1.612     raeburn  7967:             foreach my $item (keys(%{$checks})) {
                   7968:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   7969:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   7970:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   7971:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   7972:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   7973:                                 if ($rule_check{$rule}) {
                   7974:                                     $$rulematch{$user}{$item} = $rule;
                   7975:                                     if ($inst_response eq 'ok') {
1.615     raeburn  7976:                                         if (ref($inst_results) eq 'HASH') {
                   7977:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   7978:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   7979:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   7980:                                                 }
1.612     raeburn  7981:                                             }
                   7982:                                         }
1.615     raeburn  7983:                                     }
                   7984:                                     last;
1.585     raeburn  7985:                                 }
                   7986:                             }
                   7987:                         }
                   7988:                     }
                   7989:                 }
                   7990:             }
                   7991:         }
                   7992:     }
1.612     raeburn  7993:     return;
                   7994: }
                   7995: 
                   7996: sub user_rule_formats {
                   7997:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   7998:     my %text = ( 
                   7999:                  'username' => 'Usernames',
                   8000:                  'id'       => 'IDs',
                   8001:                );
                   8002:     my $output;
                   8003:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8004:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8005:         if (@{$ruleorder} > 0) {
                   8006:             $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
                   8007:             foreach my $rule (@{$ruleorder}) {
                   8008:                 if (ref($curr_rules) eq 'ARRAY') {
                   8009:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8010:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8011:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8012:                                         $rules->{$rule}{'desc'}.'</li>';
                   8013:                         }
                   8014:                     }
                   8015:                 }
                   8016:             }
                   8017:             $output .= '</ul>';
                   8018:         }
                   8019:     }
                   8020:     return $output;
                   8021: }
                   8022: 
                   8023: sub instrule_disallow_msg {
1.615     raeburn  8024:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8025:     my $response;
                   8026:     my %text = (
                   8027:                   item   => 'username',
                   8028:                   items  => 'usernames',
                   8029:                   match  => 'matches',
                   8030:                   do     => 'does',
                   8031:                   action => 'a username',
                   8032:                   one    => 'one',
                   8033:                );
                   8034:     if ($count > 1) {
                   8035:         $text{'item'} = 'usernames';
                   8036:         $text{'match'} ='match';
                   8037:         $text{'do'} = 'do';
                   8038:         $text{'action'} = 'usernames',
                   8039:         $text{'one'} = 'ones';
                   8040:     }
                   8041:     if ($checkitem eq 'id') {
                   8042:         $text{'items'} = 'IDs';
                   8043:         $text{'item'} = 'ID';
                   8044:         $text{'action'} = 'an ID';
1.615     raeburn  8045:         if ($count > 1) {
                   8046:             $text{'item'} = 'IDs';
                   8047:             $text{'action'} = 'IDs';
                   8048:         }
1.612     raeburn  8049:     }
1.674     bisitz   8050:     $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",'<span class="LC_cusr_emph">'.$domdesc.'</span>').'<br />';
1.615     raeburn  8051:     if ($mode eq 'upload') {
                   8052:         if ($checkitem eq 'username') {
                   8053:             $response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8054:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8055:             $response .= &mt("Either upload a file which includes $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the Student/Employee ID field.");
1.615     raeburn  8056:         }
1.669     raeburn  8057:     } elsif ($mode eq 'selfcreate') {
                   8058:         if ($checkitem eq 'id') {
                   8059:             $response .= &mt("You must either choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
                   8060:         }
1.615     raeburn  8061:     } else {
                   8062:         if ($checkitem eq 'username') {
                   8063:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8064:         } elsif ($checkitem eq 'id') {
                   8065:             $response .= &mt("You must either choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
                   8066:         }
1.612     raeburn  8067:     }
                   8068:     return $response;
1.585     raeburn  8069: }
                   8070: 
1.624     raeburn  8071: sub personal_data_fieldtitles {
                   8072:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8073:                         id => 'Student/Employee ID',
                   8074:                         permanentemail => 'E-mail address',
                   8075:                         lastname => 'Last Name',
                   8076:                         firstname => 'First Name',
                   8077:                         middlename => 'Middle Name',
                   8078:                         generation => 'Generation',
                   8079:                         gen => 'Generation',
1.765     raeburn  8080:                         inststatus => 'Affiliation',
1.624     raeburn  8081:                    );
                   8082:     return %fieldtitles;
                   8083: }
                   8084: 
1.642     raeburn  8085: sub sorted_inst_types {
                   8086:     my ($dom) = @_;
                   8087:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8088:     my $othertitle = &mt('All users');
                   8089:     if ($env{'request.course.id'}) {
1.668     raeburn  8090:         $othertitle  = &mt('Any users');
1.642     raeburn  8091:     }
                   8092:     my @types;
                   8093:     if (ref($order) eq 'ARRAY') {
                   8094:         @types = @{$order};
                   8095:     }
                   8096:     if (@types == 0) {
                   8097:         if (ref($usertypes) eq 'HASH') {
                   8098:             @types = sort(keys(%{$usertypes}));
                   8099:         }
                   8100:     }
                   8101:     if (keys(%{$usertypes}) > 0) {
                   8102:         $othertitle = &mt('Other users');
                   8103:     }
                   8104:     return ($othertitle,$usertypes,\@types);
                   8105: }
                   8106: 
1.645     raeburn  8107: sub get_institutional_codes {
                   8108:     my ($settings,$allcourses,$LC_code) = @_;
                   8109: # Get complete list of course sections to update
                   8110:     my @currsections = ();
                   8111:     my @currxlists = ();
                   8112:     my $coursecode = $$settings{'internal.coursecode'};
                   8113: 
                   8114:     if ($$settings{'internal.sectionnums'} ne '') {
                   8115:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8116:     }
                   8117: 
                   8118:     if ($$settings{'internal.crosslistings'} ne '') {
                   8119:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8120:     }
                   8121: 
                   8122:     if (@currxlists > 0) {
                   8123:         foreach (@currxlists) {
                   8124:             if (m/^([^:]+):(\w*)$/) {
                   8125:                 unless (grep/^$1$/,@{$allcourses}) {
                   8126:                     push @{$allcourses},$1;
                   8127:                     $$LC_code{$1} = $2;
                   8128:                 }
                   8129:             }
                   8130:         }
                   8131:     }
                   8132:  
                   8133:     if (@currsections > 0) {
                   8134:         foreach (@currsections) {
                   8135:             if (m/^(\w+):(\w*)$/) {
                   8136:                 my $sec = $coursecode.$1;
                   8137:                 my $lc_sec = $2;
                   8138:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8139:                     push @{$allcourses},$sec;
                   8140:                     $$LC_code{$sec} = $lc_sec;
                   8141:                 }
                   8142:             }
                   8143:         }
                   8144:     }
                   8145:     return;
                   8146: }
                   8147: 
1.112     bowersj2 8148: =pod
                   8149: 
1.780     raeburn  8150: =head1 Slot Helpers
                   8151: 
                   8152: =over 4
                   8153: 
                   8154: =item * sorted_slots()
                   8155: 
                   8156: Sorts an array of slot names in order of slot start time (earliest first). 
                   8157: 
                   8158: Inputs:
                   8159: 
                   8160: =over 4
                   8161: 
                   8162: slotsarr  - Reference to array of unsorted slot names.
                   8163: 
                   8164: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8165: 
1.549     albertel 8166: =back
                   8167: 
1.780     raeburn  8168: Returns:
                   8169: 
                   8170: =over 4
                   8171: 
                   8172: sorted   - An array of slot names sorted by the start time of the slot.
                   8173: 
                   8174: =back
                   8175: 
                   8176: =back
                   8177: 
                   8178: =cut
                   8179: 
                   8180: 
                   8181: sub sorted_slots {
                   8182:     my ($slotsarr,$slots) = @_;
                   8183:     my @sorted;
                   8184:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8185:         @sorted =
                   8186:             sort {
                   8187:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
                   8188:                          return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
                   8189:                      }
                   8190:                      if (ref($slots->{$a})) { return -1;}
                   8191:                      if (ref($slots->{$b})) { return 1;}
                   8192:                      return 0;
                   8193:                  } @{$slotsarr};
                   8194:     }
                   8195:     return @sorted;
                   8196: }
                   8197: 
                   8198: 
                   8199: =pod
                   8200: 
1.549     albertel 8201: =head1 HTTP Helpers
                   8202: 
                   8203: =over 4
                   8204: 
1.648     raeburn  8205: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 8206: 
1.258     albertel 8207: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 8208: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 8209: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 8210: 
                   8211: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   8212: $possible_names is an ref to an array of form element names.  As an example:
                   8213: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 8214: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 8215: 
                   8216: =cut
1.1       albertel 8217: 
1.6       albertel 8218: sub get_unprocessed_cgi {
1.25      albertel 8219:   my ($query,$possible_names)= @_;
1.26      matthew  8220:   # $Apache::lonxml::debug=1;
1.356     albertel 8221:   foreach my $pair (split(/&/,$query)) {
                   8222:     my ($name, $value) = split(/=/,$pair);
1.369     www      8223:     $name = &unescape($name);
1.25      albertel 8224:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   8225:       $value =~ tr/+/ /;
                   8226:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 8227:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 8228:     }
1.16      harris41 8229:   }
1.6       albertel 8230: }
                   8231: 
1.112     bowersj2 8232: =pod
                   8233: 
1.648     raeburn  8234: =item * &cacheheader() 
1.112     bowersj2 8235: 
                   8236: returns cache-controlling header code
                   8237: 
                   8238: =cut
                   8239: 
1.7       albertel 8240: sub cacheheader {
1.258     albertel 8241:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 8242:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   8243:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 8244:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   8245:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 8246:     return $output;
1.7       albertel 8247: }
                   8248: 
1.112     bowersj2 8249: =pod
                   8250: 
1.648     raeburn  8251: =item * &no_cache($r) 
1.112     bowersj2 8252: 
                   8253: specifies header code to not have cache
                   8254: 
                   8255: =cut
                   8256: 
1.9       albertel 8257: sub no_cache {
1.216     albertel 8258:     my ($r) = @_;
                   8259:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 8260: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 8261:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   8262:     $r->no_cache(1);
                   8263:     $r->header_out("Expires" => $date);
                   8264:     $r->header_out("Pragma" => "no-cache");
1.123     www      8265: }
                   8266: 
                   8267: sub content_type {
1.181     albertel 8268:     my ($r,$type,$charset) = @_;
1.299     foxr     8269:     if ($r) {
                   8270: 	#  Note that printout.pl calls this with undef for $r.
                   8271: 	&no_cache($r);
                   8272:     }
1.258     albertel 8273:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 8274:     unless ($charset) {
                   8275: 	$charset=&Apache::lonlocal::current_encoding;
                   8276:     }
                   8277:     if ($charset) { $type.='; charset='.$charset; }
                   8278:     if ($r) {
                   8279: 	$r->content_type($type);
                   8280:     } else {
                   8281: 	print("Content-type: $type\n\n");
                   8282:     }
1.9       albertel 8283: }
1.25      albertel 8284: 
1.112     bowersj2 8285: =pod
                   8286: 
1.648     raeburn  8287: =item * &add_to_env($name,$value) 
1.112     bowersj2 8288: 
1.258     albertel 8289: adds $name to the %env hash with value
1.112     bowersj2 8290: $value, if $name already exists, the entry is converted to an array
                   8291: reference and $value is added to the array.
                   8292: 
                   8293: =cut
                   8294: 
1.25      albertel 8295: sub add_to_env {
                   8296:   my ($name,$value)=@_;
1.258     albertel 8297:   if (defined($env{$name})) {
                   8298:     if (ref($env{$name})) {
1.25      albertel 8299:       #already have multiple values
1.258     albertel 8300:       push(@{ $env{$name} },$value);
1.25      albertel 8301:     } else {
                   8302:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 8303:       my $first=$env{$name};
                   8304:       undef($env{$name});
                   8305:       push(@{ $env{$name} },$first,$value);
1.25      albertel 8306:     }
                   8307:   } else {
1.258     albertel 8308:     $env{$name}=$value;
1.25      albertel 8309:   }
1.31      albertel 8310: }
1.149     albertel 8311: 
                   8312: =pod
                   8313: 
1.648     raeburn  8314: =item * &get_env_multiple($name) 
1.149     albertel 8315: 
1.258     albertel 8316: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 8317: values may be defined and end up as an array ref.
                   8318: 
                   8319: returns an array of values
                   8320: 
                   8321: =cut
                   8322: 
                   8323: sub get_env_multiple {
                   8324:     my ($name) = @_;
                   8325:     my @values;
1.258     albertel 8326:     if (defined($env{$name})) {
1.149     albertel 8327:         # exists is it an array
1.258     albertel 8328:         if (ref($env{$name})) {
                   8329:             @values=@{ $env{$name} };
1.149     albertel 8330:         } else {
1.258     albertel 8331:             $values[0]=$env{$name};
1.149     albertel 8332:         }
                   8333:     }
                   8334:     return(@values);
                   8335: }
                   8336: 
1.660     raeburn  8337: sub ask_for_embedded_content {
                   8338:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
                   8339:     my $upload_output = '
                   8340:    <form name="upload_embedded" action="'.$actionurl.'"
                   8341:                   method="post" enctype="multipart/form-data">';
                   8342:     $upload_output .= $state;
1.661     raeburn  8343:     $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660     raeburn  8344: 
                   8345:     my $num = 0;
                   8346:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
                   8347:         $upload_output .= &start_data_table_row().
                   8348:             '<td>'.$embed_file.'</td><td>';
                   8349:         if ($args->{'ignore_remote_references'}
                   8350:             && $embed_file =~ m{^\w+://}) {
                   8351:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
                   8352:         } elsif ($args->{'error_on_invalid_names'}
                   8353:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   8354: 
                   8355:             $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
                   8356: 
                   8357:         } else {
                   8358:             $upload_output .='
1.661     raeburn  8359:            <input name="embedded_item_'.$num.'" type="file" value="" />
1.660     raeburn  8360:            <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
                   8361:             my $attrib = join(':',@{$$allfiles{$embed_file}});
                   8362:             $upload_output .=
                   8363:                 "\n\t\t".
                   8364:                 '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   8365:                 $attrib.'" />';
                   8366:             if (exists($$codebase{$embed_file})) {
                   8367:                 $upload_output .=
                   8368:                     "\n\t\t".
                   8369:                     '<input name="codebase_'.$num.'" type="hidden" value="'.
                   8370:                     &escape($$codebase{$embed_file}).'" />';
                   8371:             }
                   8372:         }
                   8373:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
                   8374:         $num++;
                   8375:     }
                   8376:     $upload_output .= &Apache::loncommon::end_data_table().'<br />
                   8377:    <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
                   8378:    <input type ="submit" value="'.&mt('Upload Listed Files').'" />
                   8379:    '.&mt('(only files for which a location has been provided will be uploaded)').'
                   8380:    </form>';
                   8381:     return $upload_output;
                   8382: }
                   8383: 
1.661     raeburn  8384: sub upload_embedded {
                   8385:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
                   8386:         $current_disk_usage) = @_;
                   8387:     my $output;
                   8388:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   8389:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   8390:         my $orig_uploaded_filename =
                   8391:             $env{'form.embedded_item_'.$i.'.filename'};
                   8392: 
                   8393:         $env{'form.embedded_orig_'.$i} =
                   8394:             &unescape($env{'form.embedded_orig_'.$i});
                   8395:         my ($path,$fname) =
                   8396:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   8397:         # no path, whole string is fname
                   8398:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   8399: 
                   8400:         $path = $env{'form.currentpath'}.$path;
                   8401:         $fname = &Apache::lonnet::clean_filename($fname);
                   8402:         # See if there is anything left
                   8403:         next if ($fname eq '');
                   8404: 
                   8405:         # Check if file already exists as a file or directory.
                   8406:         my ($state,$msg);
                   8407:         if ($context eq 'portfolio') {
                   8408:             my $port_path = $dirpath;
                   8409:             if ($group ne '') {
                   8410:                 $port_path = "groups/$group/$port_path";
                   8411:             }
                   8412:             ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
                   8413:                                               $dir_root,$port_path,$disk_quota,
                   8414:                                               $current_disk_usage,$uname,$udom);
                   8415:             if ($state eq 'will_exceed_quota'
                   8416:                 || $state eq 'file_locked'
                   8417:                 || $state eq 'file_exists' ) {
                   8418:                 $output .= $msg;
                   8419:                 next;
                   8420:             }
                   8421:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   8422:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   8423:             if ($state eq 'exists') {
                   8424:                 $output .= $msg;
                   8425:                 next;
                   8426:             }
                   8427:         }
                   8428:         # Check if extension is valid
                   8429:         if (($fname =~ /\.(\w+)$/) &&
                   8430:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
                   8431:             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
                   8432:             next;
                   8433:         } elsif (($fname =~ /\.(\w+)$/) &&
                   8434:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
                   8435:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
                   8436:             next;
                   8437:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
                   8438:             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
                   8439:             next;
                   8440:         }
                   8441: 
                   8442:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   8443:         if ($context eq 'portfolio') {
                   8444:             my $result=
                   8445:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
                   8446:                                                 $dirpath.$path);
                   8447:             if ($result !~ m|^/uploaded/|) {
                   8448:                 $output .= '<span class="LC_error">'
                   8449:                       .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8450:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8451:                       .'</span><br />';
                   8452:                 next;
                   8453:             } else {
                   8454:                 $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
                   8455:                            $path.$fname.'</span>').'</p>';     
                   8456:             }
                   8457:         } else {
                   8458: # Save the file
                   8459:             my $target = $env{'form.embedded_item_'.$i};
                   8460:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   8461:             my $dest = $fullpath.$fname;
                   8462:             my $url = $url_root.$dirpath.'/'.$path.$fname;
                   8463:             my @parts=split(/\//,$fullpath);
                   8464:             my $count;
                   8465:             my $filepath = $dir_root;
                   8466:             for ($count=4;$count<=$#parts;$count++) {
                   8467:                 $filepath .= "/$parts[$count]";
                   8468:                 if ((-e $filepath)!=1) {
                   8469:                     mkdir($filepath,0770);
                   8470:                 }
                   8471:             }
                   8472:             my $fh;
                   8473:             if (!open($fh,'>'.$dest)) {
                   8474:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   8475:                 $output .= '<span class="LC_error">'.
                   8476:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8477:                            '</span><br />';
                   8478:             } else {
                   8479:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   8480:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   8481:                     $output .= '<span class="LC_error">'.
                   8482:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8483:                               '</span><br />';
                   8484:                 } else {
                   8485:                     if ($context eq 'testbank') {
                   8486:                         $output .= &mt('Embedded file uploaded successfully:').
                   8487:                                    '&nbsp;<a href="'.$url.'">'.
                   8488:                                    $orig_uploaded_filename.'</a><br />';
                   8489:                     } else {
1.705     tempelho 8490:                         $output .= '<span class=\"LC_fontsize_large\">'.
1.661     raeburn  8491:                                    &mt('View embedded file: [_1]','<a href="'.$url.'">'.
1.705     tempelho 8492:                                    $orig_uploaded_filename.'</a>').'</span><br />';
1.661     raeburn  8493:                     }
                   8494:                 }
                   8495:                 close($fh);
                   8496:             }
                   8497:         }
                   8498:     }
                   8499:     return $output;
                   8500: }
                   8501: 
                   8502: sub check_for_existing {
                   8503:     my ($path,$fname,$element) = @_;
                   8504:     my ($state,$msg);
                   8505:     if (-d $path.'/'.$fname) {
                   8506:         $state = 'exists';
                   8507:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   8508:     } elsif (-e $path.'/'.$fname) {
                   8509:         $state = 'exists';
                   8510:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   8511:     }
                   8512:     if ($state eq 'exists') {
                   8513:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   8514:     }
                   8515:     return ($state,$msg);
                   8516: }
                   8517: 
                   8518: sub check_for_upload {
                   8519:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   8520:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
                   8521:     my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
                   8522:     my $getpropath = 1;
                   8523:     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
                   8524:                                             $getpropath);
                   8525:     my $found_file = 0;
                   8526:     my $locked_file = 0;
                   8527:     foreach my $line (@dir_list) {
                   8528:         my ($file_name)=split(/\&/,$line,2);
                   8529:         if ($file_name eq $fname){
                   8530:             $file_name = $path.$file_name;
                   8531:             if ($group ne '') {
                   8532:                 $file_name = $group.$file_name;
                   8533:             }
                   8534:             $found_file = 1;
                   8535:             if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
                   8536:                 $locked_file = 1;
                   8537:             }
                   8538:         }
                   8539:     }
                   8540:     if (($current_disk_usage + $filesize) > $disk_quota){
                   8541:         my $msg = '<span class="LC_error">'.
                   8542:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   8543:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   8544:         return ('will_exceed_quota',$msg);
                   8545:     } elsif ($found_file) {
                   8546:         if ($locked_file) {
                   8547:             my $msg = '<span class="LC_error">';
                   8548:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
                   8549:             $msg .= '</span><br />';
                   8550:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   8551:             return ('file_locked',$msg);
                   8552:         } else {
                   8553:             my $msg = '<span class="LC_error">';
                   8554:             $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
                   8555:             $msg .= '</span>';
                   8556:             $msg .= '<br />';
                   8557:             $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
                   8558:             return ('file_exists',$msg);
                   8559:         }
                   8560:     }
                   8561: }
                   8562: 
1.31      albertel 8563: 
1.41      ng       8564: =pod
1.45      matthew  8565: 
1.464     albertel 8566: =back
1.41      ng       8567: 
1.112     bowersj2 8568: =head1 CSV Upload/Handling functions
1.38      albertel 8569: 
1.41      ng       8570: =over 4
                   8571: 
1.648     raeburn  8572: =item * &upfile_store($r)
1.41      ng       8573: 
                   8574: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 8575: needs $env{'form.upfile'}
1.41      ng       8576: returns $datatoken to be put into hidden field
                   8577: 
                   8578: =cut
1.31      albertel 8579: 
                   8580: sub upfile_store {
                   8581:     my $r=shift;
1.258     albertel 8582:     $env{'form.upfile'}=~s/\r/\n/gs;
                   8583:     $env{'form.upfile'}=~s/\f/\n/gs;
                   8584:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   8585:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 8586: 
1.258     albertel 8587:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   8588: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 8589:     {
1.158     raeburn  8590:         my $datafile = $r->dir_config('lonDaemons').
                   8591:                            '/tmp/'.$datatoken.'.tmp';
                   8592:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 8593:             print $fh $env{'form.upfile'};
1.158     raeburn  8594:             close($fh);
                   8595:         }
1.31      albertel 8596:     }
                   8597:     return $datatoken;
                   8598: }
                   8599: 
1.56      matthew  8600: =pod
                   8601: 
1.648     raeburn  8602: =item * &load_tmp_file($r)
1.41      ng       8603: 
                   8604: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 8605: needs $env{'form.datatoken'},
                   8606: sets $env{'form.upfile'} to the contents of the file
1.41      ng       8607: 
                   8608: =cut
1.31      albertel 8609: 
                   8610: sub load_tmp_file {
                   8611:     my $r=shift;
                   8612:     my @studentdata=();
                   8613:     {
1.158     raeburn  8614:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 8615:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  8616:         if ( open(my $fh,"<$studentfile") ) {
                   8617:             @studentdata=<$fh>;
                   8618:             close($fh);
                   8619:         }
1.31      albertel 8620:     }
1.258     albertel 8621:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 8622: }
                   8623: 
1.56      matthew  8624: =pod
                   8625: 
1.648     raeburn  8626: =item * &upfile_record_sep()
1.41      ng       8627: 
                   8628: Separate uploaded file into records
                   8629: returns array of records,
1.258     albertel 8630: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       8631: 
                   8632: =cut
1.31      albertel 8633: 
                   8634: sub upfile_record_sep {
1.258     albertel 8635:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 8636:     } else {
1.248     albertel 8637: 	my @records;
1.258     albertel 8638: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 8639: 	    if ($line=~/^\s*$/) { next; }
                   8640: 	    push(@records,$line);
                   8641: 	}
                   8642: 	return @records;
1.31      albertel 8643:     }
                   8644: }
                   8645: 
1.56      matthew  8646: =pod
                   8647: 
1.648     raeburn  8648: =item * &record_sep($record)
1.41      ng       8649: 
1.258     albertel 8650: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       8651: 
                   8652: =cut
                   8653: 
1.263     www      8654: sub takeleft {
                   8655:     my $index=shift;
                   8656:     return substr('0000'.$index,-4,4);
                   8657: }
                   8658: 
1.31      albertel 8659: sub record_sep {
                   8660:     my $record=shift;
                   8661:     my %components=();
1.258     albertel 8662:     if ($env{'form.upfiletype'} eq 'xml') {
                   8663:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 8664:         my $i=0;
1.356     albertel 8665:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 8666:             $field=~s/^(\"|\')//;
                   8667:             $field=~s/(\"|\')$//;
1.263     www      8668:             $components{&takeleft($i)}=$field;
1.31      albertel 8669:             $i++;
                   8670:         }
1.258     albertel 8671:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 8672:         my $i=0;
1.356     albertel 8673:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 8674:             $field=~s/^(\"|\')//;
                   8675:             $field=~s/(\"|\')$//;
1.263     www      8676:             $components{&takeleft($i)}=$field;
1.31      albertel 8677:             $i++;
                   8678:         }
                   8679:     } else {
1.561     www      8680:         my $separator=',';
1.480     banghart 8681:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      8682:             $separator=';';
1.480     banghart 8683:         }
1.31      albertel 8684:         my $i=0;
1.561     www      8685: # the character we are looking for to indicate the end of a quote or a record 
                   8686:         my $looking_for=$separator;
                   8687: # do not add the characters to the fields
                   8688:         my $ignore=0;
                   8689: # we just encountered a separator (or the beginning of the record)
                   8690:         my $just_found_separator=1;
                   8691: # store the field we are working on here
                   8692:         my $field='';
                   8693: # work our way through all characters in record
                   8694:         foreach my $character ($record=~/(.)/g) {
                   8695:             if ($character eq $looking_for) {
                   8696:                if ($character ne $separator) {
                   8697: # Found the end of a quote, again looking for separator
                   8698:                   $looking_for=$separator;
                   8699:                   $ignore=1;
                   8700:                } else {
                   8701: # Found a separator, store away what we got
                   8702:                   $components{&takeleft($i)}=$field;
                   8703: 	          $i++;
                   8704:                   $just_found_separator=1;
                   8705:                   $ignore=0;
                   8706:                   $field='';
                   8707:                }
                   8708:                next;
                   8709:             }
                   8710: # single or double quotation marks after a separator indicate beginning of a quote
                   8711: # we are now looking for the end of the quote and need to ignore separators
                   8712:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   8713:                $looking_for=$character;
                   8714:                next;
                   8715:             }
                   8716: # ignore would be true after we reached the end of a quote
                   8717:             if ($ignore) { next; }
                   8718:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   8719:             $field.=$character;
                   8720:             $just_found_separator=0; 
1.31      albertel 8721:         }
1.561     www      8722: # catch the very last entry, since we never encountered the separator
                   8723:         $components{&takeleft($i)}=$field;
1.31      albertel 8724:     }
                   8725:     return %components;
                   8726: }
                   8727: 
1.144     matthew  8728: ######################################################
                   8729: ######################################################
                   8730: 
1.56      matthew  8731: =pod
                   8732: 
1.648     raeburn  8733: =item * &upfile_select_html()
1.41      ng       8734: 
1.144     matthew  8735: Return HTML code to select a file from the users machine and specify 
                   8736: the file type.
1.41      ng       8737: 
                   8738: =cut
                   8739: 
1.144     matthew  8740: ######################################################
                   8741: ######################################################
1.31      albertel 8742: sub upfile_select_html {
1.144     matthew  8743:     my %Types = (
                   8744:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 8745:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  8746:                  space => &mt('Space separated'),
                   8747:                  tab   => &mt('Tabulator separated'),
                   8748: #                 xml   => &mt('HTML/XML'),
                   8749:                  );
                   8750:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  8751:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  8752:     foreach my $type (sort(keys(%Types))) {
                   8753:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   8754:     }
                   8755:     $Str .= "</select>\n";
                   8756:     return $Str;
1.31      albertel 8757: }
                   8758: 
1.301     albertel 8759: sub get_samples {
                   8760:     my ($records,$toget) = @_;
                   8761:     my @samples=({});
                   8762:     my $got=0;
                   8763:     foreach my $rec (@$records) {
                   8764: 	my %temp = &record_sep($rec);
                   8765: 	if (! grep(/\S/, values(%temp))) { next; }
                   8766: 	if (%temp) {
                   8767: 	    $samples[$got]=\%temp;
                   8768: 	    $got++;
                   8769: 	    if ($got == $toget) { last; }
                   8770: 	}
                   8771:     }
                   8772:     return \@samples;
                   8773: }
                   8774: 
1.144     matthew  8775: ######################################################
                   8776: ######################################################
                   8777: 
1.56      matthew  8778: =pod
                   8779: 
1.648     raeburn  8780: =item * &csv_print_samples($r,$records)
1.41      ng       8781: 
                   8782: Prints a table of sample values from each column uploaded $r is an
                   8783: Apache Request ref, $records is an arrayref from
                   8784: &Apache::loncommon::upfile_record_sep
                   8785: 
                   8786: =cut
                   8787: 
1.144     matthew  8788: ######################################################
                   8789: ######################################################
1.31      albertel 8790: sub csv_print_samples {
                   8791:     my ($r,$records) = @_;
1.662     bisitz   8792:     my $samples = &get_samples($records,5);
1.301     albertel 8793: 
1.594     raeburn  8794:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   8795:               &start_data_table_header_row());
1.356     albertel 8796:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   8797:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  8798:     $r->print(&end_data_table_header_row());
1.301     albertel 8799:     foreach my $hash (@$samples) {
1.594     raeburn  8800: 	$r->print(&start_data_table_row());
1.356     albertel 8801: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 8802: 	    $r->print('<td>');
1.356     albertel 8803: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 8804: 	    $r->print('</td>');
                   8805: 	}
1.594     raeburn  8806: 	$r->print(&end_data_table_row());
1.31      albertel 8807:     }
1.594     raeburn  8808:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 8809: }
                   8810: 
1.144     matthew  8811: ######################################################
                   8812: ######################################################
                   8813: 
1.56      matthew  8814: =pod
                   8815: 
1.648     raeburn  8816: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       8817: 
                   8818: Prints a table to create associations between values and table columns.
1.144     matthew  8819: 
1.41      ng       8820: $r is an Apache Request ref,
                   8821: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  8822: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       8823: 
                   8824: =cut
                   8825: 
1.144     matthew  8826: ######################################################
                   8827: ######################################################
1.31      albertel 8828: sub csv_print_select_table {
                   8829:     my ($r,$records,$d) = @_;
1.301     albertel 8830:     my $i=0;
                   8831:     my $samples = &get_samples($records,1);
1.144     matthew  8832:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  8833: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  8834:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  8835:               '<th>'.&mt('Column').'</th>'.
                   8836:               &end_data_table_header_row()."\n");
1.356     albertel 8837:     foreach my $array_ref (@$d) {
                   8838: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  8839: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 8840: 
1.875     bisitz   8841: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  8842: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 8843: 	$r->print('<option value="none"></option>');
1.356     albertel 8844: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   8845: 	    $r->print('<option value="'.$sample.'"'.
                   8846:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   8847:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 8848: 	}
1.594     raeburn  8849: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 8850: 	$i++;
                   8851:     }
1.594     raeburn  8852:     $r->print(&end_data_table());
1.31      albertel 8853:     $i--;
                   8854:     return $i;
                   8855: }
1.56      matthew  8856: 
1.144     matthew  8857: ######################################################
                   8858: ######################################################
                   8859: 
1.56      matthew  8860: =pod
1.31      albertel 8861: 
1.648     raeburn  8862: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       8863: 
                   8864: Prints a table of sample values from the upload and can make associate samples to internal names.
                   8865: 
                   8866: $r is an Apache Request ref,
                   8867: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   8868: $d is an array of 2 element arrays (internal name, displayed name)
                   8869: 
                   8870: =cut
                   8871: 
1.144     matthew  8872: ######################################################
                   8873: ######################################################
1.31      albertel 8874: sub csv_samples_select_table {
                   8875:     my ($r,$records,$d) = @_;
                   8876:     my $i=0;
1.144     matthew  8877:     #
1.662     bisitz   8878:     my $max_samples = 5;
                   8879:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  8880:     $r->print(&start_data_table().
                   8881:               &start_data_table_header_row().'<th>'.
                   8882:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   8883:               &end_data_table_header_row());
1.301     albertel 8884: 
                   8885:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  8886: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  8887: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 8888: 	foreach my $option (@$d) {
                   8889: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  8890: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 8891:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  8892:                       $display.'</option>');
1.31      albertel 8893: 	}
                   8894: 	$r->print('</select></td><td>');
1.662     bisitz   8895: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 8896: 	    if (defined($samples->[$line]{$key})) { 
                   8897: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   8898: 	    }
                   8899: 	}
1.594     raeburn  8900: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 8901: 	$i++;
                   8902:     }
1.594     raeburn  8903:     $r->print(&end_data_table());
1.31      albertel 8904:     $i--;
                   8905:     return($i);
1.115     matthew  8906: }
                   8907: 
1.144     matthew  8908: ######################################################
                   8909: ######################################################
                   8910: 
1.115     matthew  8911: =pod
                   8912: 
1.648     raeburn  8913: =item * &clean_excel_name($name)
1.115     matthew  8914: 
                   8915: Returns a replacement for $name which does not contain any illegal characters.
                   8916: 
                   8917: =cut
                   8918: 
1.144     matthew  8919: ######################################################
                   8920: ######################################################
1.115     matthew  8921: sub clean_excel_name {
                   8922:     my ($name) = @_;
                   8923:     $name =~ s/[:\*\?\/\\]//g;
                   8924:     if (length($name) > 31) {
                   8925:         $name = substr($name,0,31);
                   8926:     }
                   8927:     return $name;
1.25      albertel 8928: }
1.84      albertel 8929: 
1.85      albertel 8930: =pod
                   8931: 
1.648     raeburn  8932: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 8933: 
                   8934: Returns either 1 or undef
                   8935: 
                   8936: 1 if the part is to be hidden, undef if it is to be shown
                   8937: 
                   8938: Arguments are:
                   8939: 
                   8940: $id the id of the part to be checked
                   8941: $symb, optional the symb of the resource to check
                   8942: $udom, optional the domain of the user to check for
                   8943: $uname, optional the username of the user to check for
                   8944: 
                   8945: =cut
1.84      albertel 8946: 
                   8947: sub check_if_partid_hidden {
                   8948:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 8949:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 8950: 					 $symb,$udom,$uname);
1.141     albertel 8951:     my $truth=1;
                   8952:     #if the string starts with !, then the list is the list to show not hide
                   8953:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 8954:     my @hiddenlist=split(/,/,$hiddenparts);
                   8955:     foreach my $checkid (@hiddenlist) {
1.141     albertel 8956: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 8957:     }
1.141     albertel 8958:     return !$truth;
1.84      albertel 8959: }
1.127     matthew  8960: 
1.138     matthew  8961: 
                   8962: ############################################################
                   8963: ############################################################
                   8964: 
                   8965: =pod
                   8966: 
1.157     matthew  8967: =back 
                   8968: 
1.138     matthew  8969: =head1 cgi-bin script and graphing routines
                   8970: 
1.157     matthew  8971: =over 4
                   8972: 
1.648     raeburn  8973: =item * &get_cgi_id()
1.138     matthew  8974: 
                   8975: Inputs: none
                   8976: 
                   8977: Returns an id which can be used to pass environment variables
                   8978: to various cgi-bin scripts.  These environment variables will
                   8979: be removed from the users environment after a given time by
                   8980: the routine &Apache::lonnet::transfer_profile_to_env.
                   8981: 
                   8982: =cut
                   8983: 
                   8984: ############################################################
                   8985: ############################################################
1.152     albertel 8986: my $uniq=0;
1.136     matthew  8987: sub get_cgi_id {
1.154     albertel 8988:     $uniq=($uniq+1)%100000;
1.280     albertel 8989:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  8990: }
                   8991: 
1.127     matthew  8992: ############################################################
                   8993: ############################################################
                   8994: 
                   8995: =pod
                   8996: 
1.648     raeburn  8997: =item * &DrawBarGraph()
1.127     matthew  8998: 
1.138     matthew  8999: Facilitates the plotting of data in a (stacked) bar graph.
                   9000: Puts plot definition data into the users environment in order for 
                   9001: graph.png to plot it.  Returns an <img> tag for the plot.
                   9002: The bars on the plot are labeled '1','2',...,'n'.
                   9003: 
                   9004: Inputs:
                   9005: 
                   9006: =over 4
                   9007: 
                   9008: =item $Title: string, the title of the plot
                   9009: 
                   9010: =item $xlabel: string, text describing the X-axis of the plot
                   9011: 
                   9012: =item $ylabel: string, text describing the Y-axis of the plot
                   9013: 
                   9014: =item $Max: scalar, the maximum Y value to use in the plot
                   9015: If $Max is < any data point, the graph will not be rendered.
                   9016: 
1.140     matthew  9017: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  9018: they are plotted.  If undefined, default values will be used.
                   9019: 
1.178     matthew  9020: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   9021: 
1.138     matthew  9022: =item @Values: An array of array references.  Each array reference holds data
                   9023: to be plotted in a stacked bar chart.
                   9024: 
1.239     matthew  9025: =item If the final element of @Values is a hash reference the key/value
                   9026: pairs will be added to the graph definition.
                   9027: 
1.138     matthew  9028: =back
                   9029: 
                   9030: Returns:
                   9031: 
                   9032: An <img> tag which references graph.png and the appropriate identifying
                   9033: information for the plot.
                   9034: 
1.127     matthew  9035: =cut
                   9036: 
                   9037: ############################################################
                   9038: ############################################################
1.134     matthew  9039: sub DrawBarGraph {
1.178     matthew  9040:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  9041:     #
                   9042:     if (! defined($colors)) {
                   9043:         $colors = ['#33ff00', 
                   9044:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   9045:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   9046:                   ]; 
                   9047:     }
1.228     matthew  9048:     my $extra_settings = {};
                   9049:     if (ref($Values[-1]) eq 'HASH') {
                   9050:         $extra_settings = pop(@Values);
                   9051:     }
1.127     matthew  9052:     #
1.136     matthew  9053:     my $identifier = &get_cgi_id();
                   9054:     my $id = 'cgi.'.$identifier;        
1.129     matthew  9055:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  9056:         return '';
                   9057:     }
1.225     matthew  9058:     #
                   9059:     my @Labels;
                   9060:     if (defined($labels)) {
                   9061:         @Labels = @$labels;
                   9062:     } else {
                   9063:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   9064:             push (@Labels,$i+1);
                   9065:         }
                   9066:     }
                   9067:     #
1.129     matthew  9068:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  9069:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  9070:     my %ValuesHash;
                   9071:     my $NumSets=1;
                   9072:     foreach my $array (@Values) {
                   9073:         next if (! ref($array));
1.136     matthew  9074:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  9075:             join(',',@$array);
1.129     matthew  9076:     }
1.127     matthew  9077:     #
1.136     matthew  9078:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  9079:     if ($NumBars < 3) {
                   9080:         $width = 120+$NumBars*32;
1.220     matthew  9081:         $xskip = 1;
1.225     matthew  9082:         $bar_width = 30;
                   9083:     } elsif ($NumBars < 5) {
                   9084:         $width = 120+$NumBars*20;
                   9085:         $xskip = 1;
                   9086:         $bar_width = 20;
1.220     matthew  9087:     } elsif ($NumBars < 10) {
1.136     matthew  9088:         $width = 120+$NumBars*15;
                   9089:         $xskip = 1;
                   9090:         $bar_width = 15;
                   9091:     } elsif ($NumBars <= 25) {
                   9092:         $width = 120+$NumBars*11;
                   9093:         $xskip = 5;
                   9094:         $bar_width = 8;
                   9095:     } elsif ($NumBars <= 50) {
                   9096:         $width = 120+$NumBars*8;
                   9097:         $xskip = 5;
                   9098:         $bar_width = 4;
                   9099:     } else {
                   9100:         $width = 120+$NumBars*8;
                   9101:         $xskip = 5;
                   9102:         $bar_width = 4;
                   9103:     }
                   9104:     #
1.137     matthew  9105:     $Max = 1 if ($Max < 1);
                   9106:     if ( int($Max) < $Max ) {
                   9107:         $Max++;
                   9108:         $Max = int($Max);
                   9109:     }
1.127     matthew  9110:     $Title  = '' if (! defined($Title));
                   9111:     $xlabel = '' if (! defined($xlabel));
                   9112:     $ylabel = '' if (! defined($ylabel));
1.369     www      9113:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   9114:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   9115:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  9116:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  9117:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   9118:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   9119:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   9120:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9121:     $ValuesHash{$id.'.height'}   = $height;
                   9122:     $ValuesHash{$id.'.width'}    = $width;
                   9123:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   9124:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   9125:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  9126:     #
1.228     matthew  9127:     # Deal with other parameters
                   9128:     while (my ($key,$value) = each(%$extra_settings)) {
                   9129:         $ValuesHash{$id.'.'.$key} = $value;
                   9130:     }
                   9131:     #
1.646     raeburn  9132:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  9133:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9134: }
                   9135: 
                   9136: ############################################################
                   9137: ############################################################
                   9138: 
                   9139: =pod
                   9140: 
1.648     raeburn  9141: =item * &DrawXYGraph()
1.137     matthew  9142: 
1.138     matthew  9143: Facilitates the plotting of data in an XY graph.
                   9144: Puts plot definition data into the users environment in order for 
                   9145: graph.png to plot it.  Returns an <img> tag for the plot.
                   9146: 
                   9147: Inputs:
                   9148: 
                   9149: =over 4
                   9150: 
                   9151: =item $Title: string, the title of the plot
                   9152: 
                   9153: =item $xlabel: string, text describing the X-axis of the plot
                   9154: 
                   9155: =item $ylabel: string, text describing the Y-axis of the plot
                   9156: 
                   9157: =item $Max: scalar, the maximum Y value to use in the plot
                   9158: If $Max is < any data point, the graph will not be rendered.
                   9159: 
                   9160: =item $colors: Array ref containing the hex color codes for the data to be 
                   9161: plotted in.  If undefined, default values will be used.
                   9162: 
                   9163: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9164: 
                   9165: =item $Ydata: Array ref containing Array refs.  
1.185     www      9166: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  9167: 
                   9168: =item %Values: hash indicating or overriding any default values which are 
                   9169: passed to graph.png.  
                   9170: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9171: 
                   9172: =back
                   9173: 
                   9174: Returns:
                   9175: 
                   9176: An <img> tag which references graph.png and the appropriate identifying
                   9177: information for the plot.
                   9178: 
1.137     matthew  9179: =cut
                   9180: 
                   9181: ############################################################
                   9182: ############################################################
                   9183: sub DrawXYGraph {
                   9184:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   9185:     #
                   9186:     # Create the identifier for the graph
                   9187:     my $identifier = &get_cgi_id();
                   9188:     my $id = 'cgi.'.$identifier;
                   9189:     #
                   9190:     $Title  = '' if (! defined($Title));
                   9191:     $xlabel = '' if (! defined($xlabel));
                   9192:     $ylabel = '' if (! defined($ylabel));
                   9193:     my %ValuesHash = 
                   9194:         (
1.369     www      9195:          $id.'.title'  => &escape($Title),
                   9196:          $id.'.xlabel' => &escape($xlabel),
                   9197:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  9198:          $id.'.y_max_value'=> $Max,
                   9199:          $id.'.labels'     => join(',',@$Xlabels),
                   9200:          $id.'.PlotType'   => 'XY',
                   9201:          );
                   9202:     #
                   9203:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   9204:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9205:     }
                   9206:     #
                   9207:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   9208:         return '';
                   9209:     }
                   9210:     my $NumSets=1;
1.138     matthew  9211:     foreach my $array (@{$Ydata}){
1.137     matthew  9212:         next if (! ref($array));
                   9213:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   9214:     }
1.138     matthew  9215:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  9216:     #
                   9217:     # Deal with other parameters
                   9218:     while (my ($key,$value) = each(%Values)) {
                   9219:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  9220:     }
                   9221:     #
1.646     raeburn  9222:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  9223:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9224: }
                   9225: 
                   9226: ############################################################
                   9227: ############################################################
                   9228: 
                   9229: =pod
                   9230: 
1.648     raeburn  9231: =item * &DrawXYYGraph()
1.138     matthew  9232: 
                   9233: Facilitates the plotting of data in an XY graph with two Y axes.
                   9234: Puts plot definition data into the users environment in order for 
                   9235: graph.png to plot it.  Returns an <img> tag for the plot.
                   9236: 
                   9237: Inputs:
                   9238: 
                   9239: =over 4
                   9240: 
                   9241: =item $Title: string, the title of the plot
                   9242: 
                   9243: =item $xlabel: string, text describing the X-axis of the plot
                   9244: 
                   9245: =item $ylabel: string, text describing the Y-axis of the plot
                   9246: 
                   9247: =item $colors: Array ref containing the hex color codes for the data to be 
                   9248: plotted in.  If undefined, default values will be used.
                   9249: 
                   9250: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9251: 
                   9252: =item $Ydata1: The first data set
                   9253: 
                   9254: =item $Min1: The minimum value of the left Y-axis
                   9255: 
                   9256: =item $Max1: The maximum value of the left Y-axis
                   9257: 
                   9258: =item $Ydata2: The second data set
                   9259: 
                   9260: =item $Min2: The minimum value of the right Y-axis
                   9261: 
                   9262: =item $Max2: The maximum value of the left Y-axis
                   9263: 
                   9264: =item %Values: hash indicating or overriding any default values which are 
                   9265: passed to graph.png.  
                   9266: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9267: 
                   9268: =back
                   9269: 
                   9270: Returns:
                   9271: 
                   9272: An <img> tag which references graph.png and the appropriate identifying
                   9273: information for the plot.
1.136     matthew  9274: 
                   9275: =cut
                   9276: 
                   9277: ############################################################
                   9278: ############################################################
1.137     matthew  9279: sub DrawXYYGraph {
                   9280:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   9281:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  9282:     #
                   9283:     # Create the identifier for the graph
                   9284:     my $identifier = &get_cgi_id();
                   9285:     my $id = 'cgi.'.$identifier;
                   9286:     #
                   9287:     $Title  = '' if (! defined($Title));
                   9288:     $xlabel = '' if (! defined($xlabel));
                   9289:     $ylabel = '' if (! defined($ylabel));
                   9290:     my %ValuesHash = 
                   9291:         (
1.369     www      9292:          $id.'.title'  => &escape($Title),
                   9293:          $id.'.xlabel' => &escape($xlabel),
                   9294:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  9295:          $id.'.labels' => join(',',@$Xlabels),
                   9296:          $id.'.PlotType' => 'XY',
                   9297:          $id.'.NumSets' => 2,
1.137     matthew  9298:          $id.'.two_axes' => 1,
                   9299:          $id.'.y1_max_value' => $Max1,
                   9300:          $id.'.y1_min_value' => $Min1,
                   9301:          $id.'.y2_max_value' => $Max2,
                   9302:          $id.'.y2_min_value' => $Min2,
1.136     matthew  9303:          );
                   9304:     #
1.137     matthew  9305:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   9306:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9307:     }
                   9308:     #
                   9309:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   9310:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  9311:         return '';
                   9312:     }
                   9313:     my $NumSets=1;
1.137     matthew  9314:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  9315:         next if (! ref($array));
                   9316:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  9317:     }
                   9318:     #
                   9319:     # Deal with other parameters
                   9320:     while (my ($key,$value) = each(%Values)) {
                   9321:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  9322:     }
                   9323:     #
1.646     raeburn  9324:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 9325:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  9326: }
                   9327: 
                   9328: ############################################################
                   9329: ############################################################
                   9330: 
                   9331: =pod
                   9332: 
1.157     matthew  9333: =back 
                   9334: 
1.139     matthew  9335: =head1 Statistics helper routines?  
                   9336: 
                   9337: Bad place for them but what the hell.
                   9338: 
1.157     matthew  9339: =over 4
                   9340: 
1.648     raeburn  9341: =item * &chartlink()
1.139     matthew  9342: 
                   9343: Returns a link to the chart for a specific student.  
                   9344: 
                   9345: Inputs:
                   9346: 
                   9347: =over 4
                   9348: 
                   9349: =item $linktext: The text of the link
                   9350: 
                   9351: =item $sname: The students username
                   9352: 
                   9353: =item $sdomain: The students domain
                   9354: 
                   9355: =back
                   9356: 
1.157     matthew  9357: =back
                   9358: 
1.139     matthew  9359: =cut
                   9360: 
                   9361: ############################################################
                   9362: ############################################################
                   9363: sub chartlink {
                   9364:     my ($linktext, $sname, $sdomain) = @_;
                   9365:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      9366:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 9367:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  9368:        '">'.$linktext.'</a>';
1.153     matthew  9369: }
                   9370: 
                   9371: #######################################################
                   9372: #######################################################
                   9373: 
                   9374: =pod
                   9375: 
                   9376: =head1 Course Environment Routines
1.157     matthew  9377: 
                   9378: =over 4
1.153     matthew  9379: 
1.648     raeburn  9380: =item * &restore_course_settings()
1.153     matthew  9381: 
1.648     raeburn  9382: =item * &store_course_settings()
1.153     matthew  9383: 
                   9384: Restores/Store indicated form parameters from the course environment.
                   9385: Will not overwrite existing values of the form parameters.
                   9386: 
                   9387: Inputs: 
                   9388: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   9389: 
                   9390: a hash ref describing the data to be stored.  For example:
                   9391:    
                   9392: %Save_Parameters = ('Status' => 'scalar',
                   9393:     'chartoutputmode' => 'scalar',
                   9394:     'chartoutputdata' => 'scalar',
                   9395:     'Section' => 'array',
1.373     raeburn  9396:     'Group' => 'array',
1.153     matthew  9397:     'StudentData' => 'array',
                   9398:     'Maps' => 'array');
                   9399: 
                   9400: Returns: both routines return nothing
                   9401: 
1.631     raeburn  9402: =back
                   9403: 
1.153     matthew  9404: =cut
                   9405: 
                   9406: #######################################################
                   9407: #######################################################
                   9408: sub store_course_settings {
1.496     albertel 9409:     return &store_settings($env{'request.course.id'},@_);
                   9410: }
                   9411: 
                   9412: sub store_settings {
1.153     matthew  9413:     # save to the environment
                   9414:     # appenv the same items, just to be safe
1.300     albertel 9415:     my $udom  = $env{'user.domain'};
                   9416:     my $uname = $env{'user.name'};
1.496     albertel 9417:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  9418:     my %SaveHash;
                   9419:     my %AppHash;
                   9420:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 9421:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 9422:         my $envname = 'environment.'.$basename;
1.258     albertel 9423:         if (exists($env{'form.'.$setting})) {
1.153     matthew  9424:             # Save this value away
                   9425:             if ($type eq 'scalar' &&
1.258     albertel 9426:                 (! exists($env{$envname}) || 
                   9427:                  $env{$envname} ne $env{'form.'.$setting})) {
                   9428:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   9429:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  9430:             } elsif ($type eq 'array') {
                   9431:                 my $stored_form;
1.258     albertel 9432:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  9433:                     $stored_form = join(',',
                   9434:                                         map {
1.369     www      9435:                                             &escape($_);
1.258     albertel 9436:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  9437:                 } else {
                   9438:                     $stored_form = 
1.369     www      9439:                         &escape($env{'form.'.$setting});
1.153     matthew  9440:                 }
                   9441:                 # Determine if the array contents are the same.
1.258     albertel 9442:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  9443:                     $SaveHash{$basename} = $stored_form;
                   9444:                     $AppHash{$envname}   = $stored_form;
                   9445:                 }
                   9446:             }
                   9447:         }
                   9448:     }
                   9449:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 9450:                                           $udom,$uname);
1.153     matthew  9451:     if ($put_result !~ /^(ok|delayed)/) {
                   9452:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   9453:                                  'got error:'.$put_result);
                   9454:     }
                   9455:     # Make sure these settings stick around in this session, too
1.646     raeburn  9456:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  9457:     return;
                   9458: }
                   9459: 
                   9460: sub restore_course_settings {
1.499     albertel 9461:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 9462: }
                   9463: 
                   9464: sub restore_settings {
                   9465:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  9466:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 9467:         next if (exists($env{'form.'.$setting}));
1.496     albertel 9468:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  9469:             '.'.$setting;
1.258     albertel 9470:         if (exists($env{$envname})) {
1.153     matthew  9471:             if ($type eq 'scalar') {
1.258     albertel 9472:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  9473:             } elsif ($type eq 'array') {
1.258     albertel 9474:                 $env{'form.'.$setting} = [ 
1.153     matthew  9475:                                            map { 
1.369     www      9476:                                                &unescape($_); 
1.258     albertel 9477:                                            } split(',',$env{$envname})
1.153     matthew  9478:                                            ];
                   9479:             }
                   9480:         }
                   9481:     }
1.127     matthew  9482: }
                   9483: 
1.618     raeburn  9484: #######################################################
                   9485: #######################################################
                   9486: 
                   9487: =pod
                   9488: 
                   9489: =head1 Domain E-mail Routines  
                   9490: 
                   9491: =over 4
                   9492: 
1.648     raeburn  9493: =item * &build_recipient_list()
1.618     raeburn  9494: 
1.884     raeburn  9495: Build recipient lists for five types of e-mail:
1.766     raeburn  9496: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  9497: (d) Help requests, (e) Course requests needing approval,  generated by
                   9498: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   9499: loncoursequeueadmin.pm respectively.
1.618     raeburn  9500: 
                   9501: Inputs:
1.619     raeburn  9502: defmail (scalar - email address of default recipient), 
1.618     raeburn  9503: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  9504: defdom (domain for which to retrieve configuration settings),
                   9505: origmail (scalar - email address of recipient from loncapa.conf, 
                   9506: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  9507: 
1.655     raeburn  9508: Returns: comma separated list of addresses to which to send e-mail.
                   9509: 
                   9510: =back
1.618     raeburn  9511: 
                   9512: =cut
                   9513: 
                   9514: ############################################################
                   9515: ############################################################
                   9516: sub build_recipient_list {
1.619     raeburn  9517:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  9518:     my @recipients;
                   9519:     my $otheremails;
                   9520:     my %domconfig =
                   9521:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   9522:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  9523:         if (exists($domconfig{'contacts'}{$mailing})) {
                   9524:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   9525:                 my @contacts = ('adminemail','supportemail');
                   9526:                 foreach my $item (@contacts) {
                   9527:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   9528:                         my $addr = $domconfig{'contacts'}{$item}; 
                   9529:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   9530:                             push(@recipients,$addr);
                   9531:                         }
1.619     raeburn  9532:                     }
1.766     raeburn  9533:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  9534:                 }
                   9535:             }
1.766     raeburn  9536:         } elsif ($origmail ne '') {
                   9537:             push(@recipients,$origmail);
1.618     raeburn  9538:         }
1.619     raeburn  9539:     } elsif ($origmail ne '') {
                   9540:         push(@recipients,$origmail);
1.618     raeburn  9541:     }
1.688     raeburn  9542:     if (defined($defmail)) {
                   9543:         if ($defmail ne '') {
                   9544:             push(@recipients,$defmail);
                   9545:         }
1.618     raeburn  9546:     }
                   9547:     if ($otheremails) {
1.619     raeburn  9548:         my @others;
                   9549:         if ($otheremails =~ /,/) {
                   9550:             @others = split(/,/,$otheremails);
1.618     raeburn  9551:         } else {
1.619     raeburn  9552:             push(@others,$otheremails);
                   9553:         }
                   9554:         foreach my $addr (@others) {
                   9555:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   9556:                 push(@recipients,$addr);
                   9557:             }
1.618     raeburn  9558:         }
                   9559:     }
1.619     raeburn  9560:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  9561:     return $recipientlist;
                   9562: }
                   9563: 
1.127     matthew  9564: ############################################################
                   9565: ############################################################
1.154     albertel 9566: 
1.655     raeburn  9567: =pod
                   9568: 
                   9569: =head1 Course Catalog Routines
                   9570: 
                   9571: =over 4
                   9572: 
                   9573: =item * &gather_categories()
                   9574: 
                   9575: Converts category definitions - keys of categories hash stored in  
                   9576: coursecategories in configuration.db on the primary library server in a 
                   9577: domain - to an array.  Also generates javascript and idx hash used to 
                   9578: generate Domain Coordinator interface for editing Course Categories.
                   9579: 
                   9580: Inputs:
1.663     raeburn  9581: 
1.655     raeburn  9582: categories (reference to hash of category definitions).
1.663     raeburn  9583: 
1.655     raeburn  9584: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   9585:       categories and subcategories).
1.663     raeburn  9586: 
1.655     raeburn  9587: idx (reference to hash of counters used in Domain Coordinator interface for 
                   9588:       editing Course Categories).
1.663     raeburn  9589: 
1.655     raeburn  9590: jsarray (reference to array of categories used to create Javascript arrays for
                   9591:          Domain Coordinator interface for editing Course Categories).
                   9592: 
                   9593: Returns: nothing
                   9594: 
                   9595: Side effects: populates cats, idx and jsarray. 
                   9596: 
                   9597: =cut
                   9598: 
                   9599: sub gather_categories {
                   9600:     my ($categories,$cats,$idx,$jsarray) = @_;
                   9601:     my %counters;
                   9602:     my $num = 0;
                   9603:     foreach my $item (keys(%{$categories})) {
                   9604:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   9605:         if ($container eq '' && $depth == 0) {
                   9606:             $cats->[$depth][$categories->{$item}] = $cat;
                   9607:         } else {
                   9608:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   9609:         }
                   9610:         my ($escitem,$tail) = split(/:/,$item,2);
                   9611:         if ($counters{$tail} eq '') {
                   9612:             $counters{$tail} = $num;
                   9613:             $num ++;
                   9614:         }
                   9615:         if (ref($idx) eq 'HASH') {
                   9616:             $idx->{$item} = $counters{$tail};
                   9617:         }
                   9618:         if (ref($jsarray) eq 'ARRAY') {
                   9619:             push(@{$jsarray->[$counters{$tail}]},$item);
                   9620:         }
                   9621:     }
                   9622:     return;
                   9623: }
                   9624: 
                   9625: =pod
                   9626: 
                   9627: =item * &extract_categories()
                   9628: 
                   9629: Used to generate breadcrumb trails for course categories.
                   9630: 
                   9631: Inputs:
1.663     raeburn  9632: 
1.655     raeburn  9633: categories (reference to hash of category definitions).
1.663     raeburn  9634: 
1.655     raeburn  9635: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   9636:       categories and subcategories).
1.663     raeburn  9637: 
1.655     raeburn  9638: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  9639: 
1.655     raeburn  9640: allitems (reference to hash - key is category key 
                   9641:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  9642: 
1.655     raeburn  9643: idx (reference to hash of counters used in Domain Coordinator interface for
                   9644:       editing Course Categories).
1.663     raeburn  9645: 
1.655     raeburn  9646: jsarray (reference to array of categories used to create Javascript arrays for
                   9647:          Domain Coordinator interface for editing Course Categories).
                   9648: 
1.665     raeburn  9649: subcats (reference to hash of arrays containing all subcategories within each 
                   9650:          category, -recursive)
                   9651: 
1.655     raeburn  9652: Returns: nothing
                   9653: 
                   9654: Side effects: populates trails and allitems hash references.
                   9655: 
                   9656: =cut
                   9657: 
                   9658: sub extract_categories {
1.665     raeburn  9659:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  9660:     if (ref($categories) eq 'HASH') {
                   9661:         &gather_categories($categories,$cats,$idx,$jsarray);
                   9662:         if (ref($cats->[0]) eq 'ARRAY') {
                   9663:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   9664:                 my $name = $cats->[0][$i];
                   9665:                 my $item = &escape($name).'::0';
                   9666:                 my $trailstr;
                   9667:                 if ($name eq 'instcode') {
                   9668:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  9669:                 } elsif ($name eq 'communities') {
                   9670:                     $trailstr = &mt('Communities');
1.655     raeburn  9671:                 } else {
                   9672:                     $trailstr = $name;
                   9673:                 }
                   9674:                 if ($allitems->{$item} eq '') {
                   9675:                     push(@{$trails},$trailstr);
                   9676:                     $allitems->{$item} = scalar(@{$trails})-1;
                   9677:                 }
                   9678:                 my @parents = ($name);
                   9679:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   9680:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   9681:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  9682:                         if (ref($subcats) eq 'HASH') {
                   9683:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   9684:                         }
                   9685:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   9686:                     }
                   9687:                 } else {
                   9688:                     if (ref($subcats) eq 'HASH') {
                   9689:                         $subcats->{$item} = [];
1.655     raeburn  9690:                     }
                   9691:                 }
                   9692:             }
                   9693:         }
                   9694:     }
                   9695:     return;
                   9696: }
                   9697: 
                   9698: =pod
                   9699: 
                   9700: =item *&recurse_categories()
                   9701: 
                   9702: Recursively used to generate breadcrumb trails for course categories.
                   9703: 
                   9704: Inputs:
1.663     raeburn  9705: 
1.655     raeburn  9706: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   9707:       categories and subcategories).
1.663     raeburn  9708: 
1.655     raeburn  9709: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  9710: 
                   9711: category (current course category, for which breadcrumb trail is being generated).
                   9712: 
                   9713: trails (reference to array of breadcrumb trails for each category).
                   9714: 
1.655     raeburn  9715: allitems (reference to hash - key is category key
                   9716:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  9717: 
1.655     raeburn  9718: parents (array containing containers directories for current category, 
                   9719:          back to top level). 
                   9720: 
                   9721: Returns: nothing
                   9722: 
                   9723: Side effects: populates trails and allitems hash references
                   9724: 
                   9725: =cut
                   9726: 
                   9727: sub recurse_categories {
1.665     raeburn  9728:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  9729:     my $shallower = $depth - 1;
                   9730:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   9731:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   9732:             my $name = $cats->[$depth]{$category}[$k];
                   9733:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   9734:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   9735:             if ($allitems->{$item} eq '') {
                   9736:                 push(@{$trails},$trailstr);
                   9737:                 $allitems->{$item} = scalar(@{$trails})-1;
                   9738:             }
                   9739:             my $deeper = $depth+1;
                   9740:             push(@{$parents},$category);
1.665     raeburn  9741:             if (ref($subcats) eq 'HASH') {
                   9742:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   9743:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   9744:                     my $higher;
                   9745:                     if ($j > 0) {
                   9746:                         $higher = &escape($parents->[$j]).':'.
                   9747:                                   &escape($parents->[$j-1]).':'.$j;
                   9748:                     } else {
                   9749:                         $higher = &escape($parents->[$j]).'::'.$j;
                   9750:                     }
                   9751:                     push(@{$subcats->{$higher}},$subcat);
                   9752:                 }
                   9753:             }
                   9754:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   9755:                                 $subcats);
1.655     raeburn  9756:             pop(@{$parents});
                   9757:         }
                   9758:     } else {
                   9759:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   9760:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   9761:         if ($allitems->{$item} eq '') {
                   9762:             push(@{$trails},$trailstr);
                   9763:             $allitems->{$item} = scalar(@{$trails})-1;
                   9764:         }
                   9765:     }
                   9766:     return;
                   9767: }
                   9768: 
1.663     raeburn  9769: =pod
                   9770: 
                   9771: =item *&assign_categories_table()
                   9772: 
                   9773: Create a datatable for display of hierarchical categories in a domain,
                   9774: with checkboxes to allow a course to be categorized. 
                   9775: 
                   9776: Inputs:
                   9777: 
                   9778: cathash - reference to hash of categories defined for the domain (from
                   9779:           configuration.db)
                   9780: 
                   9781: currcat - scalar with an & separated list of categories assigned to a course. 
                   9782: 
1.919     raeburn  9783: type    - scalar contains course type (Course or Community).
                   9784: 
1.663     raeburn  9785: Returns: $output (markup to be displayed) 
                   9786: 
                   9787: =cut
                   9788: 
                   9789: sub assign_categories_table {
1.919     raeburn  9790:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  9791:     my $output;
                   9792:     if (ref($cathash) eq 'HASH') {
                   9793:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   9794:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   9795:         $maxdepth = scalar(@cats);
                   9796:         if (@cats > 0) {
                   9797:             my $itemcount = 0;
                   9798:             if (ref($cats[0]) eq 'ARRAY') {
                   9799:                 my @currcategories;
                   9800:                 if ($currcat ne '') {
                   9801:                     @currcategories = split('&',$currcat);
                   9802:                 }
1.919     raeburn  9803:                 my $table;
1.663     raeburn  9804:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   9805:                     my $parent = $cats[0][$i];
1.919     raeburn  9806:                     next if ($parent eq 'instcode');
                   9807:                     if ($type eq 'Community') {
                   9808:                         next unless ($parent eq 'communities');
                   9809:                     } else {
                   9810:                         next if ($parent eq 'communities');
                   9811:                     }
1.663     raeburn  9812:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   9813:                     my $item = &escape($parent).'::0';
                   9814:                     my $checked = '';
                   9815:                     if (@currcategories > 0) {
                   9816:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   9817:                             $checked = ' checked="checked"';
1.663     raeburn  9818:                         }
                   9819:                     }
1.919     raeburn  9820:                     my $parent_title = $parent;
                   9821:                     if ($parent eq 'communities') {
                   9822:                         $parent_title = &mt('Communities');
                   9823:                     }
                   9824:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   9825:                               '<input type="checkbox" name="usecategory" value="'.
                   9826:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   9827:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  9828:                     my $depth = 1;
                   9829:                     push(@path,$parent);
1.919     raeburn  9830:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  9831:                     pop(@path);
1.919     raeburn  9832:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  9833:                     $itemcount ++;
                   9834:                 }
1.919     raeburn  9835:                 if ($itemcount) {
                   9836:                     $output = &Apache::loncommon::start_data_table().
                   9837:                               $table.
                   9838:                               &Apache::loncommon::end_data_table();
                   9839:                 }
1.663     raeburn  9840:             }
                   9841:         }
                   9842:     }
                   9843:     return $output;
                   9844: }
                   9845: 
                   9846: =pod
                   9847: 
                   9848: =item *&assign_category_rows()
                   9849: 
                   9850: Create a datatable row for display of nested categories in a domain,
                   9851: with checkboxes to allow a course to be categorized,called recursively.
                   9852: 
                   9853: Inputs:
                   9854: 
                   9855: itemcount - track row number for alternating colors
                   9856: 
                   9857: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   9858:       categories and subcategories.
                   9859: 
                   9860: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   9861: 
                   9862: parent - parent of current category item
                   9863: 
                   9864: path - Array containing all categories back up through the hierarchy from the
                   9865:        current category to the top level.
                   9866: 
                   9867: currcategories - reference to array of current categories assigned to the course
                   9868: 
                   9869: Returns: $output (markup to be displayed).
                   9870: 
                   9871: =cut
                   9872: 
                   9873: sub assign_category_rows {
                   9874:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   9875:     my ($text,$name,$item,$chgstr);
                   9876:     if (ref($cats) eq 'ARRAY') {
                   9877:         my $maxdepth = scalar(@{$cats});
                   9878:         if (ref($cats->[$depth]) eq 'HASH') {
                   9879:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   9880:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   9881:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   9882:                 $text .= '<td><table class="LC_datatable">';
                   9883:                 for (my $j=0; $j<$numchildren; $j++) {
                   9884:                     $name = $cats->[$depth]{$parent}[$j];
                   9885:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   9886:                     my $deeper = $depth+1;
                   9887:                     my $checked = '';
                   9888:                     if (ref($currcategories) eq 'ARRAY') {
                   9889:                         if (@{$currcategories} > 0) {
                   9890:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   9891:                                 $checked = ' checked="checked"';
1.663     raeburn  9892:                             }
                   9893:                         }
                   9894:                     }
1.664     raeburn  9895:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   9896:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  9897:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   9898:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   9899:                              '</td><td>';
1.663     raeburn  9900:                     if (ref($path) eq 'ARRAY') {
                   9901:                         push(@{$path},$name);
                   9902:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   9903:                         pop(@{$path});
                   9904:                     }
                   9905:                     $text .= '</td></tr>';
                   9906:                 }
                   9907:                 $text .= '</table></td>';
                   9908:             }
                   9909:         }
                   9910:     }
                   9911:     return $text;
                   9912: }
                   9913: 
1.655     raeburn  9914: ############################################################
                   9915: ############################################################
                   9916: 
                   9917: 
1.443     albertel 9918: sub commit_customrole {
1.664     raeburn  9919:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  9920:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 9921:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   9922:                          ($end?', ending '.localtime($end):'').': <b>'.
                   9923:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  9924:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 9925:                  '</b><br />';
                   9926:     return $output;
                   9927: }
                   9928: 
                   9929: sub commit_standardrole {
1.541     raeburn  9930:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   9931:     my ($output,$logmsg,$linefeed);
                   9932:     if ($context eq 'auto') {
                   9933:         $linefeed = "\n";
                   9934:     } else {
                   9935:         $linefeed = "<br />\n";
                   9936:     }  
1.443     albertel 9937:     if ($three eq 'st') {
1.541     raeburn  9938:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   9939:                                          $one,$two,$sec,$context);
                   9940:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  9941:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   9942:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 9943:         } else {
1.541     raeburn  9944:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 9945:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  9946:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   9947:             if ($context eq 'auto') {
                   9948:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   9949:             } else {
                   9950:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   9951:                &mt('Add to classlist').': <b>ok</b>';
                   9952:             }
                   9953:             $output .= $linefeed;
1.443     albertel 9954:         }
                   9955:     } else {
                   9956:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   9957:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  9958:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  9959:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  9960:         if ($context eq 'auto') {
                   9961:             $output .= $result.$linefeed;
                   9962:         } else {
                   9963:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   9964:         }
1.443     albertel 9965:     }
                   9966:     return $output;
                   9967: }
                   9968: 
                   9969: sub commit_studentrole {
1.541     raeburn  9970:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  9971:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  9972:     if ($context eq 'auto') {
                   9973:         $linefeed = "\n";
                   9974:     } else {
                   9975:         $linefeed = '<br />'."\n";
                   9976:     }
1.443     albertel 9977:     if (defined($one) && defined($two)) {
                   9978:         my $cid=$one.'_'.$two;
                   9979:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   9980:         my $secchange = 0;
                   9981:         my $expire_role_result;
                   9982:         my $modify_section_result;
1.628     raeburn  9983:         if ($oldsec ne '-1') { 
                   9984:             if ($oldsec ne $sec) {
1.443     albertel 9985:                 $secchange = 1;
1.628     raeburn  9986:                 my $now = time;
1.443     albertel 9987:                 my $uurl='/'.$cid;
                   9988:                 $uurl=~s/\_/\//g;
                   9989:                 if ($oldsec) {
                   9990:                     $uurl.='/'.$oldsec;
                   9991:                 }
1.626     raeburn  9992:                 $oldsecurl = $uurl;
1.628     raeburn  9993:                 $expire_role_result = 
1.652     raeburn  9994:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  9995:                 if ($env{'request.course.sec'} ne '') { 
                   9996:                     if ($expire_role_result eq 'refused') {
                   9997:                         my @roles = ('st');
                   9998:                         my @statuses = ('previous');
                   9999:                         my @roledoms = ($one);
                   10000:                         my $withsec = 1;
                   10001:                         my %roleshash = 
                   10002:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   10003:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   10004:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   10005:                             my ($oldstart,$oldend) = 
                   10006:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   10007:                             if ($oldend > 0 && $oldend <= $now) {
                   10008:                                 $expire_role_result = 'ok';
                   10009:                             }
                   10010:                         }
                   10011:                     }
                   10012:                 }
1.443     albertel 10013:                 $result = $expire_role_result;
                   10014:             }
                   10015:         }
                   10016:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  10017:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 10018:             if ($modify_section_result =~ /^ok/) {
                   10019:                 if ($secchange == 1) {
1.628     raeburn  10020:                     if ($sec eq '') {
                   10021:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   10022:                     } else {
                   10023:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   10024:                     }
1.443     albertel 10025:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  10026:                     if ($sec eq '') {
                   10027:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   10028:                     } else {
                   10029:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10030:                     }
1.443     albertel 10031:                 } else {
1.628     raeburn  10032:                     if ($sec eq '') {
                   10033:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   10034:                     } else {
                   10035:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10036:                     }
1.443     albertel 10037:                 }
                   10038:             } else {
1.628     raeburn  10039:                 if ($secchange) {       
                   10040:                     $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
                   10041:                 } else {
                   10042:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   10043:                 }
1.443     albertel 10044:             }
                   10045:             $result = $modify_section_result;
                   10046:         } elsif ($secchange == 1) {
1.628     raeburn  10047:             if ($oldsec eq '') {
                   10048:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   10049:             } else {
                   10050:                 $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
                   10051:             }
1.626     raeburn  10052:             if ($expire_role_result eq 'refused') {
                   10053:                 my $newsecurl = '/'.$cid;
                   10054:                 $newsecurl =~ s/\_/\//g;
                   10055:                 if ($sec ne '') {
                   10056:                     $newsecurl.='/'.$sec;
                   10057:                 }
                   10058:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   10059:                     if ($sec eq '') {
                   10060:                         $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed;
                   10061:                     } else {
                   10062:                         $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed;
                   10063:                     }
                   10064:                 }
                   10065:             }
1.443     albertel 10066:         }
                   10067:     } else {
1.626     raeburn  10068:         $$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed;
1.443     albertel 10069:         $result = "error: incomplete course id\n";
                   10070:     }
                   10071:     return $result;
                   10072: }
                   10073: 
                   10074: ############################################################
                   10075: ############################################################
                   10076: 
1.566     albertel 10077: sub check_clone {
1.578     raeburn  10078:     my ($args,$linefeed) = @_;
1.566     albertel 10079:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   10080:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   10081:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   10082:     my $clonemsg;
                   10083:     my $can_clone = 0;
1.908     raeburn  10084:     my $lctype = lc($args->{'type'});
                   10085:     if ($lctype ne 'community') {
                   10086:         $lctype = 'course';
                   10087:     }
1.566     albertel 10088:     if ($clonehome eq 'no_host') {
1.908     raeburn  10089:         if ($args->{'type'} eq 'Community') {
                   10090:             $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   10091:         } else {
                   10092:             $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'});
                   10093:         }     
1.566     albertel 10094:     } else {
                   10095: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.908     raeburn  10096:         if ($args->{'type'} eq 'Community') {
                   10097:             if ($clonedesc{'type'} ne 'Community') {
                   10098:                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   10099:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10100:             }
                   10101:         }
1.882     raeburn  10102: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   10103:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 10104: 	    $can_clone = 1;
                   10105: 	} else {
                   10106: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   10107: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   10108: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  10109:             if (grep(/^\*$/,@cloners)) {
                   10110:                 $can_clone = 1;
                   10111:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   10112:                 $can_clone = 1;
                   10113:             } else {
1.908     raeburn  10114:                 my $ccrole = 'cc';
                   10115:                 if ($args->{'type'} eq 'Community') {
                   10116:                     $ccrole = 'co';
                   10117:                 }
1.578     raeburn  10118: 	        my %roleshash =
                   10119: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   10120: 					 $args->{'ccdomain'},
1.908     raeburn  10121:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  10122: 					 [$args->{'clonedomain'}]);
1.908     raeburn  10123: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.578     raeburn  10124: 		    $can_clone = 1;
                   10125: 	        } else {
1.908     raeburn  10126:                     if ($args->{'type'} eq 'Community') {
                   10127:                         $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                   10128:                     } else {
                   10129:                         $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'});
                   10130:                     }
1.578     raeburn  10131: 	        }
1.566     albertel 10132: 	    }
1.578     raeburn  10133:         }
1.566     albertel 10134:     }
                   10135:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10136: }
                   10137: 
1.444     albertel 10138: sub construct_course {
1.885     raeburn  10139:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 10140:     my $outcome;
1.541     raeburn  10141:     my $linefeed =  '<br />'."\n";
                   10142:     if ($context eq 'auto') {
                   10143:         $linefeed = "\n";
                   10144:     }
1.566     albertel 10145: 
                   10146: #
                   10147: # Are we cloning?
                   10148: #
                   10149:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10150:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  10151: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 10152: 	if ($context ne 'auto') {
1.578     raeburn  10153:             if ($clonemsg ne '') {
                   10154: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   10155:             }
1.566     albertel 10156: 	}
                   10157: 	$outcome .= $clonemsg.$linefeed;
                   10158: 
                   10159:         if (!$can_clone) {
                   10160: 	    return (0,$outcome);
                   10161: 	}
                   10162:     }
                   10163: 
1.444     albertel 10164: #
                   10165: # Open course
                   10166: #
                   10167:     my $crstype = lc($args->{'crstype'});
                   10168:     my %cenv=();
                   10169:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   10170:                                              $args->{'cdescr'},
                   10171:                                              $args->{'curl'},
                   10172:                                              $args->{'course_home'},
                   10173:                                              $args->{'nonstandard'},
                   10174:                                              $args->{'crscode'},
                   10175:                                              $args->{'ccuname'}.':'.
                   10176:                                              $args->{'ccdomain'},
1.882     raeburn  10177:                                              $args->{'crstype'},
1.885     raeburn  10178:                                              $cnum,$context,$category);
1.444     albertel 10179: 
                   10180:     # Note: The testing routines depend on this being output; see 
                   10181:     # Utils::Course. This needs to at least be output as a comment
                   10182:     # if anyone ever decides to not show this, and Utils::Course::new
                   10183:     # will need to be suitably modified.
1.541     raeburn  10184:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444     albertel 10185: #
                   10186: # Check if created correctly
                   10187: #
1.479     albertel 10188:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 10189:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541     raeburn  10190:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 10191: 
1.444     albertel 10192: #
1.566     albertel 10193: # Do the cloning
                   10194: #   
                   10195:     if ($can_clone && $cloneid) {
                   10196: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   10197: 	if ($context ne 'auto') {
                   10198: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   10199: 	}
                   10200: 	$outcome .= $clonemsg.$linefeed;
                   10201: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 10202: # Copy all files
1.637     www      10203: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 10204: # Restore URL
1.566     albertel 10205: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 10206: # Restore title
1.566     albertel 10207: 	$cenv{'description'}=$oldcenv{'description'};
1.444     albertel 10208: # Mark as cloned
1.566     albertel 10209: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      10210: # Need to clone grading mode
                   10211:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   10212:         $cenv{'grading'}=$newenv{'grading'};
                   10213: # Do not clone these environment entries
                   10214:         &Apache::lonnet::del('environment',
                   10215:                   ['default_enrollment_start_date',
                   10216:                    'default_enrollment_end_date',
                   10217:                    'question.email',
                   10218:                    'policy.email',
                   10219:                    'comment.email',
                   10220:                    'pch.users.denied',
1.725     raeburn  10221:                    'plc.users.denied',
                   10222:                    'hidefromcat',
                   10223:                    'categories'],
1.638     www      10224:                    $$crsudom,$$crsunum);
1.444     albertel 10225:     }
1.566     albertel 10226: 
1.444     albertel 10227: #
                   10228: # Set environment (will override cloned, if existing)
                   10229: #
                   10230:     my @sections = ();
                   10231:     my @xlists = ();
                   10232:     if ($args->{'crstype'}) {
                   10233:         $cenv{'type'}=$args->{'crstype'};
                   10234:     }
                   10235:     if ($args->{'crsid'}) {
                   10236:         $cenv{'courseid'}=$args->{'crsid'};
                   10237:     }
                   10238:     if ($args->{'crscode'}) {
                   10239:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   10240:     }
                   10241:     if ($args->{'crsquota'} ne '') {
                   10242:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   10243:     } else {
                   10244:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   10245:     }
                   10246:     if ($args->{'ccuname'}) {
                   10247:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   10248:                                         ':'.$args->{'ccdomain'};
                   10249:     } else {
                   10250:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   10251:     }
                   10252:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   10253:     if ($args->{'crssections'}) {
                   10254:         $cenv{'internal.sectionnums'} = '';
                   10255:         if ($args->{'crssections'} =~ m/,/) {
                   10256:             @sections = split/,/,$args->{'crssections'};
                   10257:         } else {
                   10258:             $sections[0] = $args->{'crssections'};
                   10259:         }
                   10260:         if (@sections > 0) {
                   10261:             foreach my $item (@sections) {
                   10262:                 my ($sec,$gp) = split/:/,$item;
                   10263:                 my $class = $args->{'crscode'}.$sec;
                   10264:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   10265:                 $cenv{'internal.sectionnums'} .= $item.',';
                   10266:                 unless ($addcheck eq 'ok') {
                   10267:                     push @badclasses, $class;
                   10268:                 }
                   10269:             }
                   10270:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   10271:         }
                   10272:     }
                   10273: # do not hide course coordinator from staff listing, 
                   10274: # even if privileged
                   10275:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10276: # add crosslistings
                   10277:     if ($args->{'crsxlist'}) {
                   10278:         $cenv{'internal.crosslistings'}='';
                   10279:         if ($args->{'crsxlist'} =~ m/,/) {
                   10280:             @xlists = split/,/,$args->{'crsxlist'};
                   10281:         } else {
                   10282:             $xlists[0] = $args->{'crsxlist'};
                   10283:         }
                   10284:         if (@xlists > 0) {
                   10285:             foreach my $item (@xlists) {
                   10286:                 my ($xl,$gp) = split/:/,$item;
                   10287:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   10288:                 $cenv{'internal.crosslistings'} .= $item.',';
                   10289:                 unless ($addcheck eq 'ok') {
                   10290:                     push @badclasses, $xl;
                   10291:                 }
                   10292:             }
                   10293:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   10294:         }
                   10295:     }
                   10296:     if ($args->{'autoadds'}) {
                   10297:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   10298:     }
                   10299:     if ($args->{'autodrops'}) {
                   10300:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   10301:     }
                   10302: # check for notification of enrollment changes
                   10303:     my @notified = ();
                   10304:     if ($args->{'notify_owner'}) {
                   10305:         if ($args->{'ccuname'} ne '') {
                   10306:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   10307:         }
                   10308:     }
                   10309:     if ($args->{'notify_dc'}) {
                   10310:         if ($uname ne '') { 
1.630     raeburn  10311:             push(@notified,$uname.':'.$udom);
1.444     albertel 10312:         }
                   10313:     }
                   10314:     if (@notified > 0) {
                   10315:         my $notifylist;
                   10316:         if (@notified > 1) {
                   10317:             $notifylist = join(',',@notified);
                   10318:         } else {
                   10319:             $notifylist = $notified[0];
                   10320:         }
                   10321:         $cenv{'internal.notifylist'} = $notifylist;
                   10322:     }
                   10323:     if (@badclasses > 0) {
                   10324:         my %lt=&Apache::lonlocal::texthash(
                   10325:                 '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',
                   10326:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   10327:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   10328:         );
1.541     raeburn  10329:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   10330:                            ' ('.$lt{'adby'}.')';
                   10331:         if ($context eq 'auto') {
                   10332:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 10333:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  10334:             foreach my $item (@badclasses) {
                   10335:                 if ($context eq 'auto') {
                   10336:                     $outcome .= " - $item\n";
                   10337:                 } else {
                   10338:                     $outcome .= "<li>$item</li>\n";
                   10339:                 }
                   10340:             }
                   10341:             if ($context eq 'auto') {
                   10342:                 $outcome .= $linefeed;
                   10343:             } else {
1.566     albertel 10344:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  10345:             }
                   10346:         } 
1.444     albertel 10347:     }
                   10348:     if ($args->{'no_end_date'}) {
                   10349:         $args->{'endaccess'} = 0;
                   10350:     }
                   10351:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   10352:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   10353:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   10354:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   10355:     if ($args->{'showphotos'}) {
                   10356:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   10357:     }
                   10358:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   10359:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   10360:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   10361:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  10362:             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'); 
                   10363:             if ($context eq 'auto') {
                   10364:                 $outcome .= $krb_msg;
                   10365:             } else {
1.566     albertel 10366:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  10367:             }
                   10368:             $outcome .= $linefeed;
1.444     albertel 10369:         }
                   10370:     }
                   10371:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   10372:        if ($args->{'setpolicy'}) {
                   10373:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10374:        }
                   10375:        if ($args->{'setcontent'}) {
                   10376:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10377:        }
                   10378:     }
                   10379:     if ($args->{'reshome'}) {
                   10380: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   10381: 	$cenv{'reshome'}=~s/\/+$/\//;
                   10382:     }
                   10383: #
                   10384: # course has keyed access
                   10385: #
                   10386:     if ($args->{'setkeys'}) {
                   10387:        $cenv{'keyaccess'}='yes';
                   10388:     }
                   10389: # if specified, key authority is not course, but user
                   10390: # only active if keyaccess is yes
                   10391:     if ($args->{'keyauth'}) {
1.487     albertel 10392: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   10393: 	$user = &LONCAPA::clean_username($user);
                   10394: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     10395: 	if ($user ne '' && $domain ne '') {
1.487     albertel 10396: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 10397: 	}
                   10398:     }
                   10399: 
                   10400:     if ($args->{'disresdis'}) {
                   10401:         $cenv{'pch.roles.denied'}='st';
                   10402:     }
                   10403:     if ($args->{'disablechat'}) {
                   10404:         $cenv{'plc.roles.denied'}='st';
                   10405:     }
                   10406: 
                   10407:     # Record we've not yet viewed the Course Initialization Helper for this 
                   10408:     # course
                   10409:     $cenv{'course.helper.not.run'} = 1;
                   10410:     #
                   10411:     # Use new Randomseed
                   10412:     #
                   10413:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   10414:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   10415:     #
                   10416:     # The encryption code and receipt prefix for this course
                   10417:     #
                   10418:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   10419:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   10420:     #
                   10421:     # By default, use standard grading
                   10422:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   10423: 
1.541     raeburn  10424:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   10425:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 10426: #
                   10427: # Open all assignments
                   10428: #
                   10429:     if ($args->{'openall'}) {
                   10430:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   10431:        my %storecontent = ($storeunder         => time,
                   10432:                            $storeunder.'.type' => 'date_start');
                   10433:        
                   10434:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  10435:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 10436:    }
                   10437: #
                   10438: # Set first page
                   10439: #
                   10440:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   10441: 	    || ($cloneid)) {
1.445     albertel 10442: 	use LONCAPA::map;
1.444     albertel 10443: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 10444: 
                   10445: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   10446:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   10447: 
1.444     albertel 10448:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   10449:         my $title; my $url;
                   10450:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   10451: 	    $title=&mt('Syllabus');
1.444     albertel 10452:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   10453:         } else {
1.690     bisitz   10454:             $title=&mt('Navigate Contents');
1.444     albertel 10455:             $url='/adm/navmaps';
                   10456:         }
1.445     albertel 10457: 
                   10458:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   10459: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   10460: 
                   10461: 	if ($errtext) { $fatal=2; }
1.541     raeburn  10462:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 10463:     }
1.566     albertel 10464: 
                   10465:     return (1,$outcome);
1.444     albertel 10466: }
                   10467: 
                   10468: ############################################################
                   10469: ############################################################
                   10470: 
1.378     raeburn  10471: sub course_type {
                   10472:     my ($cid) = @_;
                   10473:     if (!defined($cid)) {
                   10474:         $cid = $env{'request.course.id'};
                   10475:     }
1.404     albertel 10476:     if (defined($env{'course.'.$cid.'.type'})) {
                   10477:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  10478:     } else {
                   10479:         return 'Course';
1.377     raeburn  10480:     }
                   10481: }
1.156     albertel 10482: 
1.406     raeburn  10483: sub group_term {
                   10484:     my $crstype = &course_type();
                   10485:     my %names = (
                   10486:                   'Course' => 'group',
1.865     raeburn  10487:                   'Community' => 'group',
1.406     raeburn  10488:                 );
                   10489:     return $names{$crstype};
                   10490: }
                   10491: 
1.902     raeburn  10492: sub course_types {
                   10493:     my @types = ('official','unofficial','community');
                   10494:     my %typename = (
                   10495:                          official   => 'Official course',
                   10496:                          unofficial => 'Unofficial course',
                   10497:                          community  => 'Community',
                   10498:                    );
                   10499:     return (\@types,\%typename);
                   10500: }
                   10501: 
1.156     albertel 10502: sub icon {
                   10503:     my ($file)=@_;
1.505     albertel 10504:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 10505:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 10506:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 10507:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   10508: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   10509: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   10510: 	            $curfext.".gif") {
                   10511: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   10512: 		$curfext.".gif";
                   10513: 	}
                   10514:     }
1.249     albertel 10515:     return &lonhttpdurl($iconname);
1.154     albertel 10516: } 
1.84      albertel 10517: 
1.575     albertel 10518: sub lonhttpdurl {
1.692     www      10519: #
                   10520: # Had been used for "small fry" static images on separate port 8080.
                   10521: # Modify here if lightweight http functionality desired again.
                   10522: # Currently eliminated due to increasing firewall issues.
                   10523: #
1.575     albertel 10524:     my ($url)=@_;
1.692     www      10525:     return $url;
1.215     albertel 10526: }
                   10527: 
1.213     albertel 10528: sub connection_aborted {
                   10529:     my ($r)=@_;
                   10530:     $r->print(" ");$r->rflush();
                   10531:     my $c = $r->connection;
                   10532:     return $c->aborted();
                   10533: }
                   10534: 
1.221     foxr     10535: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     10536: #    strings as 'strings'.
                   10537: sub escape_single {
1.221     foxr     10538:     my ($input) = @_;
1.223     albertel 10539:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     10540:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   10541:     return $input;
                   10542: }
1.223     albertel 10543: 
1.222     foxr     10544: #  Same as escape_single, but escape's "'s  This 
                   10545: #  can be used for  "strings"
                   10546: sub escape_double {
                   10547:     my ($input) = @_;
                   10548:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   10549:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   10550:     return $input;
                   10551: }
1.223     albertel 10552:  
1.222     foxr     10553: #   Escapes the last element of a full URL.
                   10554: sub escape_url {
                   10555:     my ($url)   = @_;
1.238     raeburn  10556:     my @urlslices = split(/\//, $url,-1);
1.369     www      10557:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 10558:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     10559: }
1.462     albertel 10560: 
1.820     raeburn  10561: sub compare_arrays {
                   10562:     my ($arrayref1,$arrayref2) = @_;
                   10563:     my (@difference,%count);
                   10564:     @difference = ();
                   10565:     %count = ();
                   10566:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   10567:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   10568:         foreach my $element (keys(%count)) {
                   10569:             if ($count{$element} == 1) {
                   10570:                 push(@difference,$element);
                   10571:             }
                   10572:         }
                   10573:     }
                   10574:     return @difference;
                   10575: }
                   10576: 
1.817     bisitz   10577: # -------------------------------------------------------- Initialize user login
1.462     albertel 10578: sub init_user_environment {
1.463     albertel 10579:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 10580:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   10581: 
                   10582:     my $public=($username eq 'public' && $domain eq 'public');
                   10583: 
                   10584: # See if old ID present, if so, remove
                   10585: 
                   10586:     my ($filename,$cookie,$userroles);
                   10587:     my $now=time;
                   10588: 
                   10589:     if ($public) {
                   10590: 	my $max_public=100;
                   10591: 	my $oldest;
                   10592: 	my $oldest_time=0;
                   10593: 	for(my $next=1;$next<=$max_public;$next++) {
                   10594: 	    if (-e $lonids."/publicuser_$next.id") {
                   10595: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   10596: 		if ($mtime<$oldest_time || !$oldest_time) {
                   10597: 		    $oldest_time=$mtime;
                   10598: 		    $oldest=$next;
                   10599: 		}
                   10600: 	    } else {
                   10601: 		$cookie="publicuser_$next";
                   10602: 		last;
                   10603: 	    }
                   10604: 	}
                   10605: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   10606:     } else {
1.463     albertel 10607: 	# if this isn't a robot, kill any existing non-robot sessions
                   10608: 	if (!$args->{'robot'}) {
                   10609: 	    opendir(DIR,$lonids);
                   10610: 	    while ($filename=readdir(DIR)) {
                   10611: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   10612: 		    unlink($lonids.'/'.$filename);
                   10613: 		}
1.462     albertel 10614: 	    }
1.463     albertel 10615: 	    closedir(DIR);
1.462     albertel 10616: 	}
                   10617: # Give them a new cookie
1.463     albertel 10618: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      10619: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 10620: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 10621:     
                   10622: # Initialize roles
                   10623: 
                   10624: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   10625:     }
                   10626: # ------------------------------------ Check browser type and MathML capability
                   10627: 
                   10628:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   10629:         $clientunicode,$clientos) = &decode_user_agent($r);
                   10630: 
                   10631: # ------------------------------------------------------------- Get environment
                   10632: 
                   10633:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   10634:     my ($tmp) = keys(%userenv);
                   10635:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   10636: 	# default remote control to off
                   10637: 	if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
                   10638:     } else {
                   10639: 	undef(%userenv);
                   10640:     }
                   10641:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   10642: 	$form->{'interface'}=$userenv{'interface'};
                   10643:     }
                   10644:     $env{'environment.remote'}=$userenv{'remote'};
                   10645:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   10646: 
                   10647: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   10648:     foreach my $option ('interface','localpath','localres') {
                   10649:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 10650:     }
                   10651: # --------------------------------------------------------- Write first profile
                   10652: 
                   10653:     {
                   10654: 	my %initial_env = 
                   10655: 	    ("user.name"          => $username,
                   10656: 	     "user.domain"        => $domain,
                   10657: 	     "user.home"          => $authhost,
                   10658: 	     "browser.type"       => $clientbrowser,
                   10659: 	     "browser.version"    => $clientversion,
                   10660: 	     "browser.mathml"     => $clientmathml,
                   10661: 	     "browser.unicode"    => $clientunicode,
                   10662: 	     "browser.os"         => $clientos,
                   10663: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   10664: 	     "request.course.fn"  => '',
                   10665: 	     "request.course.uri" => '',
                   10666: 	     "request.course.sec" => '',
                   10667: 	     "request.role"       => 'cm',
                   10668: 	     "request.role.adv"   => $env{'user.adv'},
                   10669: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   10670: 
                   10671:         if ($form->{'localpath'}) {
                   10672: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   10673: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   10674:         }
                   10675: 	
                   10676: 	if ($public) {
                   10677: 	    $initial_env{"environment.remote"} = "off";
                   10678: 	}
                   10679: 	if ($form->{'interface'}) {
                   10680: 	    $form->{'interface'}=~s/\W//gs;
                   10681: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   10682: 	    $env{'browser.interface'}=$form->{'interface'};
                   10683: 	}
                   10684: 
1.724     raeburn  10685:         foreach my $tool ('aboutme','blog','portfolio') {
                   10686:             $userenv{'availabletools.'.$tool} = 
                   10687:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
                   10688:         }
                   10689: 
1.864     raeburn  10690:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  10691:             $userenv{'canrequest.'.$crstype} =
                   10692:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   10693:                                                   'reload','requestcourses');
                   10694:         }
                   10695: 
1.462     albertel 10696: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   10697: 	
                   10698: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   10699: 		 &GDBM_WRCREAT(),0640)) {
                   10700: 	    &_add_to_env(\%disk_env,\%initial_env);
                   10701: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   10702: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 10703: 	    if (ref($args->{'extra_env'})) {
                   10704: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   10705: 	    }
1.462     albertel 10706: 	    untie(%disk_env);
                   10707: 	} else {
1.705     tempelho 10708: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   10709: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 10710: 	    return 'error: '.$!;
                   10711: 	}
                   10712:     }
                   10713:     $env{'request.role'}='cm';
                   10714:     $env{'request.role.adv'}=$env{'user.adv'};
                   10715:     $env{'browser.type'}=$clientbrowser;
                   10716: 
                   10717:     return $cookie;
                   10718: 
                   10719: }
                   10720: 
                   10721: sub _add_to_env {
                   10722:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  10723:     if (ref($env_data) eq 'HASH') {
                   10724:         while (my ($key,$value) = each(%$env_data)) {
                   10725: 	    $idf->{$prefix.$key} = $value;
                   10726: 	    $env{$prefix.$key}   = $value;
                   10727:         }
1.462     albertel 10728:     }
                   10729: }
                   10730: 
1.685     tempelho 10731: # --- Get the symbolic name of a problem and the url
                   10732: sub get_symb {
                   10733:     my ($request,$silent) = @_;
1.726     raeburn  10734:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 10735:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   10736:     if ($symb eq '') {
                   10737:         if (!$silent) {
                   10738:             $request->print("Unable to handle ambiguous references:$url:.");
                   10739:             return ();
                   10740:         }
                   10741:     }
                   10742:     &Apache::lonenc::check_decrypt(\$symb);
                   10743:     return ($symb);
                   10744: }
                   10745: 
                   10746: # --------------------------------------------------------------Get annotation
                   10747: 
                   10748: sub get_annotation {
                   10749:     my ($symb,$enc) = @_;
                   10750: 
                   10751:     my $key = $symb;
                   10752:     if (!$enc) {
                   10753:         $key =
                   10754:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   10755:     }
                   10756:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   10757:     return $annotation{$key};
                   10758: }
                   10759: 
                   10760: sub clean_symb {
1.731     raeburn  10761:     my ($symb,$delete_enc) = @_;
1.685     tempelho 10762: 
                   10763:     &Apache::lonenc::check_decrypt(\$symb);
                   10764:     my $enc = $env{'request.enc'};
1.731     raeburn  10765:     if ($delete_enc) {
1.730     raeburn  10766:         delete($env{'request.enc'});
                   10767:     }
1.685     tempelho 10768: 
                   10769:     return ($symb,$enc);
                   10770: }
1.462     albertel 10771: 
1.41      ng       10772: =pod
                   10773: 
                   10774: =back
                   10775: 
1.112     bowersj2 10776: =cut
1.41      ng       10777: 
1.112     bowersj2 10778: 1;
                   10779: __END__;
1.41      ng       10780: 

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