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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1030  ! www         4: # $Id: loncommon.pm,v 1.1029 2011/12/04 16:27:05 www 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.999     www       412:     function openstdbrowser(formname,uname,udom,clicker,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+
1.999     www       424:                                     '&udomelement='+udom+
                    425:                                     '&clicker='+clicker;
1.111     www       426: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   427:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       428:         var title = 'Student_Browser';
1.74      www       429:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    430:         options += ',width=700,height=600';
                    431:         stdeditbrowser = open(url,title,options,'1');
                    432:         stdeditbrowser.focus();
                    433:     }
1.824     bisitz    434: // ]]>
1.74      www       435: </script>
                    436: ENDSTDBRW
                    437: }
1.42      matthew   438: 
1.1003    www       439: sub resourcebrowser_javascript {
                    440:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       441:    return (<<'ENDRESBRW');
1.1003    www       442: <script type="text/javascript" language="Javascript">
                    443: // <![CDATA[
                    444:     var reseditbrowser;
1.1004    www       445:     function openresbrowser(formname,reslink) {
1.1005    www       446:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       447:         var title = 'Resource_Browser';
                    448:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       449:         options += ',width=700,height=500';
1.1004    www       450:         reseditbrowser = open(url,title,options,'1');
                    451:         reseditbrowser.focus();
1.1003    www       452:     }
                    453: // ]]>
                    454: </script>
1.1004    www       455: ENDRESBRW
1.1003    www       456: }
                    457: 
1.74      www       458: sub selectstudent_link {
1.999     www       459:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    460:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    461:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    462:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  463:    if ($env{'request.course.id'}) {  
1.302     albertel  464:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    465: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    466: 					'/'.$env{'request.course.sec'})) {
1.111     www       467: 	   return '';
                    468:        }
1.999     www       469:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   470:        if ($courseadvonly)  {
                    471:            $callargs .= ",'',1,1";
                    472:        }
                    473:        return '<span class="LC_nobreak">'.
                    474:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    475:               &mt('Select User').'</a></span>';
1.74      www       476:    }
1.258     albertel  477:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       478:        $callargs .= ",'',1"; 
1.793     raeburn   479:        return '<span class="LC_nobreak">'.
                    480:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    481:               &mt('Select User').'</a></span>';
1.111     www       482:    }
                    483:    return '';
1.91      www       484: }
                    485: 
1.1004    www       486: sub selectresource_link {
                    487:    my ($form,$reslink,$arg)=@_;
                    488:    
                    489:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    490:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    491:    unless ($env{'request.course.id'}) { return $arg; }
                    492:    return '<span class="LC_nobreak">'.
                    493:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    494:               $arg.'</a></span>';
                    495: }
                    496: 
                    497: 
                    498: 
1.653     raeburn   499: sub authorbrowser_javascript {
                    500:     return <<"ENDAUTHORBRW";
1.776     bisitz    501: <script type="text/javascript" language="JavaScript">
1.824     bisitz    502: // <![CDATA[
1.653     raeburn   503: var stdeditbrowser;
                    504: 
                    505: function openauthorbrowser(formname,udom) {
                    506:     var url = '/adm/pickauthor?';
                    507:     url += 'form='+formname+'&roledom='+udom;
                    508:     var title = 'Author_Browser';
                    509:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    510:     options += ',width=700,height=600';
                    511:     stdeditbrowser = open(url,title,options,'1');
                    512:     stdeditbrowser.focus();
                    513: }
                    514: 
1.824     bisitz    515: // ]]>
1.653     raeburn   516: </script>
                    517: ENDAUTHORBRW
                    518: }
                    519: 
1.91      www       520: sub coursebrowser_javascript {
1.909     raeburn   521:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   522:     my $wintitle = 'Course_Browser';
1.931     raeburn   523:     if ($crstype eq 'Community') {
1.932     raeburn   524:         $wintitle = 'Community_Browser';
1.909     raeburn   525:     }
1.876     raeburn   526:     my $id_functions = &javascript_index_functions();
                    527:     my $output = '
1.776     bisitz    528: <script type="text/javascript" language="JavaScript">
1.824     bisitz    529: // <![CDATA[
1.468     raeburn   530:     var stdeditbrowser;'."\n";
1.876     raeburn   531: 
                    532:     $output .= <<"ENDSTDBRW";
1.909     raeburn   533:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       534:         var url = '/adm/pickcourse?';
1.895     raeburn   535:         var formid = getFormIdByName(formname);
1.876     raeburn   536:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  537:         if (domainfilter != null) {
                    538:            if (domainfilter != '') {
                    539:                url += 'domainfilter='+domainfilter+'&';
                    540: 	   }
                    541:         }
1.91      www       542:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  543: 	                            '&cdomelement='+udom+
                    544:                                     '&cnameelement='+desc;
1.468     raeburn   545:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   546:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   547:                 url += '&roleelement='+extra_element;
                    548:                 if (domainfilter == null || domainfilter == '') {
                    549:                     url += '&domainfilter='+extra_element;
                    550:                 }
1.234     raeburn   551:             }
1.468     raeburn   552:             else {
                    553:                 if (formname == 'portform') {
                    554:                     url += '&setroles='+extra_element;
1.800     raeburn   555:                 } else {
                    556:                     if (formname == 'rules') {
                    557:                         url += '&fixeddom='+extra_element; 
                    558:                     }
1.468     raeburn   559:                 }
                    560:             }     
1.230     raeburn   561:         }
1.909     raeburn   562:         if (type != null && type != '') {
                    563:             url += '&type='+type;
                    564:         }
                    565:         if (type_elem != null && type_elem != '') {
                    566:             url += '&typeelement='+type_elem;
                    567:         }
1.872     raeburn   568:         if (formname == 'ccrs') {
                    569:             var ownername = document.forms[formid].ccuname.value;
                    570:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    571:             url += '&cloner='+ownername+':'+ownerdom;
                    572:         }
1.293     raeburn   573:         if (multflag !=null && multflag != '') {
                    574:             url += '&multiple='+multflag;
                    575:         }
1.909     raeburn   576:         var title = '$wintitle';
1.91      www       577:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    578:         options += ',width=700,height=600';
                    579:         stdeditbrowser = open(url,title,options,'1');
                    580:         stdeditbrowser.focus();
                    581:     }
1.876     raeburn   582: $id_functions
                    583: ENDSTDBRW
1.905     raeburn   584:     if (($sec_element ne '') || ($role_element ne '')) {
                    585:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   586:     }
                    587:     $output .= '
                    588: // ]]>
                    589: </script>';
                    590:     return $output;
                    591: }
                    592: 
                    593: sub javascript_index_functions {
                    594:     return <<"ENDJS";
                    595: 
                    596: function getFormIdByName(formname) {
                    597:     for (var i=0;i<document.forms.length;i++) {
                    598:         if (document.forms[i].name == formname) {
                    599:             return i;
                    600:         }
                    601:     }
                    602:     return -1;
                    603: }
                    604: 
                    605: function getIndexByName(formid,item) {
                    606:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    607:         if (document.forms[formid].elements[i].name == item) {
                    608:             return i;
                    609:         }
                    610:     }
                    611:     return -1;
                    612: }
1.468     raeburn   613: 
1.876     raeburn   614: function getDomainFromSelectbox(formname,udom) {
                    615:     var userdom;
                    616:     var formid = getFormIdByName(formname);
                    617:     if (formid > -1) {
                    618:         var domid = getIndexByName(formid,udom);
                    619:         if (domid > -1) {
                    620:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    621:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    622:             }
                    623:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    624:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   625:             }
                    626:         }
                    627:     }
1.876     raeburn   628:     return userdom;
                    629: }
                    630: 
                    631: ENDJS
1.468     raeburn   632: 
1.876     raeburn   633: }
                    634: 
1.1017    raeburn   635: sub javascript_array_indexof {
1.1018    raeburn   636:     return <<ENDJS;
1.1017    raeburn   637: <script type="text/javascript" language="JavaScript">
                    638: // <![CDATA[
                    639: 
                    640: if (!Array.prototype.indexOf) {
                    641:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    642:         "use strict";
                    643:         if (this === void 0 || this === null) {
                    644:             throw new TypeError();
                    645:         }
                    646:         var t = Object(this);
                    647:         var len = t.length >>> 0;
                    648:         if (len === 0) {
                    649:             return -1;
                    650:         }
                    651:         var n = 0;
                    652:         if (arguments.length > 0) {
                    653:             n = Number(arguments[1]);
                    654:             if (n !== n) { // shortcut for verifying if it's NaN
                    655:                 n = 0;
                    656:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    657:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    658:             }
                    659:         }
                    660:         if (n >= len) {
                    661:             return -1;
                    662:         }
                    663:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    664:         for (; k < len; k++) {
                    665:             if (k in t && t[k] === searchElement) {
                    666:                 return k;
                    667:             }
                    668:         }
                    669:         return -1;
                    670:     }
                    671: }
                    672: 
                    673: // ]]>
                    674: </script>
                    675: 
                    676: ENDJS
                    677: 
                    678: }
                    679: 
1.876     raeburn   680: sub userbrowser_javascript {
                    681:     my $id_functions = &javascript_index_functions();
                    682:     return <<"ENDUSERBRW";
                    683: 
1.888     raeburn   684: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   685:     var url = '/adm/pickuser?';
                    686:     var userdom = getDomainFromSelectbox(formname,udom);
                    687:     if (userdom != null) {
                    688:        if (userdom != '') {
                    689:            url += 'srchdom='+userdom+'&';
                    690:        }
                    691:     }
                    692:     url += 'form=' + formname + '&unameelement='+uname+
                    693:                                 '&udomelement='+udom+
                    694:                                 '&ulastelement='+ulast+
                    695:                                 '&ufirstelement='+ufirst+
                    696:                                 '&uemailelement='+uemail+
1.881     raeburn   697:                                 '&hideudomelement='+hideudom+
                    698:                                 '&coursedom='+crsdom;
1.888     raeburn   699:     if ((caller != null) && (caller != undefined)) {
                    700:         url += '&caller='+caller;
                    701:     }
1.876     raeburn   702:     var title = 'User_Browser';
                    703:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    704:     options += ',width=700,height=600';
                    705:     var stdeditbrowser = open(url,title,options,'1');
                    706:     stdeditbrowser.focus();
                    707: }
                    708: 
1.888     raeburn   709: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   710:     var formid = getFormIdByName(formname);
                    711:     if (formid > -1) {
1.888     raeburn   712:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   713:         var domid = getIndexByName(formid,udom);
                    714:         var hidedomid = getIndexByName(formid,origdom);
                    715:         if (hidedomid > -1) {
                    716:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   717:             var unameval = document.forms[formid].elements[unameid].value;
                    718:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    719:                 if (domid > -1) {
                    720:                     var slct = document.forms[formid].elements[domid];
                    721:                     if (slct.type == 'select-one') {
                    722:                         var i;
                    723:                         for (i=0;i<slct.length;i++) {
                    724:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    725:                         }
                    726:                     }
                    727:                     if (slct.type == 'hidden') {
                    728:                         slct.value = fixeddom;
1.876     raeburn   729:                     }
                    730:                 }
1.468     raeburn   731:             }
                    732:         }
                    733:     }
1.876     raeburn   734:     return;
                    735: }
                    736: 
                    737: $id_functions
                    738: ENDUSERBRW
1.468     raeburn   739: }
                    740: 
                    741: sub setsec_javascript {
1.905     raeburn   742:     my ($sec_element,$formname,$role_element) = @_;
                    743:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    744:         $communityrolestr);
                    745:     if ($role_element ne '') {
                    746:         my @allroles = ('st','ta','ep','in','ad');
                    747:         foreach my $crstype ('Course','Community') {
                    748:             if ($crstype eq 'Community') {
                    749:                 foreach my $role (@allroles) {
                    750:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    751:                 }
                    752:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    753:             } else {
                    754:                 foreach my $role (@allroles) {
                    755:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    756:                 }
                    757:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    758:             }
                    759:         }
                    760:         $rolestr = '"'.join('","',@allroles).'"';
                    761:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    762:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    763:     }
1.468     raeburn   764:     my $setsections = qq|
                    765: function setSect(sectionlist) {
1.629     raeburn   766:     var sectionsArray = new Array();
                    767:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    768:         sectionsArray = sectionlist.split(",");
                    769:     }
1.468     raeburn   770:     var numSections = sectionsArray.length;
                    771:     document.$formname.$sec_element.length = 0;
                    772:     if (numSections == 0) {
                    773:         document.$formname.$sec_element.multiple=false;
                    774:         document.$formname.$sec_element.size=1;
                    775:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    776:     } else {
                    777:         if (numSections == 1) {
                    778:             document.$formname.$sec_element.multiple=false;
                    779:             document.$formname.$sec_element.size=1;
                    780:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    781:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    782:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    783:         } else {
                    784:             for (var i=0; i<numSections; i++) {
                    785:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    786:             }
                    787:             document.$formname.$sec_element.multiple=true
                    788:             if (numSections < 3) {
                    789:                 document.$formname.$sec_element.size=numSections;
                    790:             } else {
                    791:                 document.$formname.$sec_element.size=3;
                    792:             }
                    793:             document.$formname.$sec_element.options[0].selected = false
                    794:         }
                    795:     }
1.91      www       796: }
1.905     raeburn   797: 
                    798: function setRole(crstype) {
1.468     raeburn   799: |;
1.905     raeburn   800:     if ($role_element eq '') {
                    801:         $setsections .= '    return;
                    802: }
                    803: ';
                    804:     } else {
                    805:         $setsections .= qq|
                    806:     var elementLength = document.$formname.$role_element.length;
                    807:     var allroles = Array($rolestr);
                    808:     var courserolenames = Array($courserolestr);
                    809:     var communityrolenames = Array($communityrolestr);
                    810:     if (elementLength != undefined) {
                    811:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    812:             if (crstype == 'Course') {
                    813:                 return;
                    814:             } else {
                    815:                 allroles[5] = 'co';
                    816:                 for (var i=0; i<6; i++) {
                    817:                     document.$formname.$role_element.options[i].value = allroles[i];
                    818:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    819:                 }
                    820:             }
                    821:         } else {
                    822:             if (crstype == 'Community') {
                    823:                 return;
                    824:             } else {
                    825:                 allroles[5] = 'cc';
                    826:                 for (var i=0; i<6; i++) {
                    827:                     document.$formname.$role_element.options[i].value = allroles[i];
                    828:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    829:                 }
                    830:             }
                    831:         }
                    832:     }
                    833:     return;
                    834: }
                    835: |;
                    836:     }
1.468     raeburn   837:     return $setsections;
                    838: }
                    839: 
1.91      www       840: sub selectcourse_link {
1.909     raeburn   841:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    842:        $typeelement) = @_;
                    843:    my $type = $selecttype;
1.871     raeburn   844:    my $linktext = &mt('Select Course');
                    845:    if ($selecttype eq 'Community') {
1.909     raeburn   846:        $linktext = &mt('Select Community');
1.906     raeburn   847:    } elsif ($selecttype eq 'Course/Community') {
                    848:        $linktext = &mt('Select Course/Community');
1.909     raeburn   849:        $type = '';
1.1019    raeburn   850:    } elsif ($selecttype eq 'Select') {
                    851:        $linktext = &mt('Select');
                    852:        $type = '';
1.871     raeburn   853:    }
1.787     bisitz    854:    return '<span class="LC_nobreak">'
                    855:          ."<a href='"
                    856:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    857:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   858:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   859:          ."'>".$linktext.'</a>'
1.787     bisitz    860:          .'</span>';
1.74      www       861: }
1.42      matthew   862: 
1.653     raeburn   863: sub selectauthor_link {
                    864:    my ($form,$udom)=@_;
                    865:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    866:           &mt('Select Author').'</a>';
                    867: }
                    868: 
1.876     raeburn   869: sub selectuser_link {
1.881     raeburn   870:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   871:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   872:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   873:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   874:            ');">'.$linktext.'</a>';
1.876     raeburn   875: }
                    876: 
1.273     raeburn   877: sub check_uncheck_jscript {
                    878:     my $jscript = <<"ENDSCRT";
                    879: function checkAll(field) {
                    880:     if (field.length > 0) {
                    881:         for (i = 0; i < field.length; i++) {
                    882:             field[i].checked = true ;
                    883:         }
                    884:     } else {
                    885:         field.checked = true
                    886:     }
                    887: }
                    888:  
                    889: function uncheckAll(field) {
                    890:     if (field.length > 0) {
                    891:         for (i = 0; i < field.length; i++) {
                    892:             field[i].checked = false ;
1.543     albertel  893:         }
                    894:     } else {
1.273     raeburn   895:         field.checked = false ;
                    896:     }
                    897: }
                    898: ENDSCRT
                    899:     return $jscript;
                    900: }
                    901: 
1.656     www       902: sub select_timezone {
1.659     raeburn   903:    my ($name,$selected,$onchange,$includeempty)=@_;
                    904:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    905:    if ($includeempty) {
                    906:        $output .= '<option value=""';
                    907:        if (($selected eq '') || ($selected eq 'local')) {
                    908:            $output .= ' selected="selected" ';
                    909:        }
                    910:        $output .= '> </option>';
                    911:    }
1.657     raeburn   912:    my @timezones = DateTime::TimeZone->all_names;
                    913:    foreach my $tzone (@timezones) {
                    914:        $output.= '<option value="'.$tzone.'"';
                    915:        if ($tzone eq $selected) {
                    916:            $output.=' selected="selected"';
                    917:        }
                    918:        $output.=">$tzone</option>\n";
1.656     www       919:    }
                    920:    $output.="</select>";
                    921:    return $output;
                    922: }
1.273     raeburn   923: 
1.687     raeburn   924: sub select_datelocale {
                    925:     my ($name,$selected,$onchange,$includeempty)=@_;
                    926:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    927:     if ($includeempty) {
                    928:         $output .= '<option value=""';
                    929:         if ($selected eq '') {
                    930:             $output .= ' selected="selected" ';
                    931:         }
                    932:         $output .= '> </option>';
                    933:     }
                    934:     my (@possibles,%locale_names);
                    935:     my @locales = DateTime::Locale::Catalog::Locales;
                    936:     foreach my $locale (@locales) {
                    937:         if (ref($locale) eq 'HASH') {
                    938:             my $id = $locale->{'id'};
                    939:             if ($id ne '') {
                    940:                 my $en_terr = $locale->{'en_territory'};
                    941:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   942:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   943:                 if (grep(/^en$/,@languages) || !@languages) {
                    944:                     if ($en_terr ne '') {
                    945:                         $locale_names{$id} = '('.$en_terr.')';
                    946:                     } elsif ($native_terr ne '') {
                    947:                         $locale_names{$id} = $native_terr;
                    948:                     }
                    949:                 } else {
                    950:                     if ($native_terr ne '') {
                    951:                         $locale_names{$id} = $native_terr.' ';
                    952:                     } elsif ($en_terr ne '') {
                    953:                         $locale_names{$id} = '('.$en_terr.')';
                    954:                     }
                    955:                 }
                    956:                 push (@possibles,$id);
                    957:             }
                    958:         }
                    959:     }
                    960:     foreach my $item (sort(@possibles)) {
                    961:         $output.= '<option value="'.$item.'"';
                    962:         if ($item eq $selected) {
                    963:             $output.=' selected="selected"';
                    964:         }
                    965:         $output.=">$item";
                    966:         if ($locale_names{$item} ne '') {
                    967:             $output.="  $locale_names{$item}</option>\n";
                    968:         }
                    969:         $output.="</option>\n";
                    970:     }
                    971:     $output.="</select>";
                    972:     return $output;
                    973: }
                    974: 
1.792     raeburn   975: sub select_language {
                    976:     my ($name,$selected,$includeempty) = @_;
                    977:     my %langchoices;
                    978:     if ($includeempty) {
                    979:         %langchoices = ('' => 'No language preference');
                    980:     }
                    981:     foreach my $id (&languageids()) {
                    982:         my $code = &supportedlanguagecode($id);
                    983:         if ($code) {
                    984:             $langchoices{$code} = &plainlanguagedescription($id);
                    985:         }
                    986:     }
1.970     raeburn   987:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn   988: }
                    989: 
1.42      matthew   990: =pod
1.36      matthew   991: 
1.648     raeburn   992: =item * &linked_select_forms(...)
1.36      matthew   993: 
                    994: linked_select_forms returns a string containing a <script></script> block
                    995: and html for two <select> menus.  The select menus will be linked in that
                    996: changing the value of the first menu will result in new values being placed
                    997: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn   998: order unless a defined order is provided.
1.36      matthew   999: 
                   1000: linked_select_forms takes the following ordered inputs:
                   1001: 
                   1002: =over 4
                   1003: 
1.112     bowersj2 1004: =item * $formname, the name of the <form> tag
1.36      matthew  1005: 
1.112     bowersj2 1006: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1007: 
1.112     bowersj2 1008: =item * $firstdefault, the default value for the first menu
1.36      matthew  1009: 
1.112     bowersj2 1010: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1011: 
1.112     bowersj2 1012: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1013: 
1.112     bowersj2 1014: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1015: 
1.609     raeburn  1016: =item * $menuorder, the order of values in the first menu
                   1017: 
1.41      ng       1018: =back 
                   1019: 
1.36      matthew  1020: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1021: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1022: values for the first select menu.  The text that coincides with the 
1.41      ng       1023: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1024: and text for the second menu are given in the hash pointed to by 
                   1025: $menu{$choice1}->{'select2'}.  
                   1026: 
1.112     bowersj2 1027:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1028:                        default => "B3",
                   1029:                        select2 => { 
                   1030:                            B1 => "Choice B1",
                   1031:                            B2 => "Choice B2",
                   1032:                            B3 => "Choice B3",
                   1033:                            B4 => "Choice B4"
1.609     raeburn  1034:                            },
                   1035:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1036:                    },
                   1037:                A2 => { text =>"Choice A2" ,
                   1038:                        default => "C2",
                   1039:                        select2 => { 
                   1040:                            C1 => "Choice C1",
                   1041:                            C2 => "Choice C2",
                   1042:                            C3 => "Choice C3"
1.609     raeburn  1043:                            },
                   1044:                        order => ['C2','C1','C3'],
1.112     bowersj2 1045:                    },
                   1046:                A3 => { text =>"Choice A3" ,
                   1047:                        default => "D6",
                   1048:                        select2 => { 
                   1049:                            D1 => "Choice D1",
                   1050:                            D2 => "Choice D2",
                   1051:                            D3 => "Choice D3",
                   1052:                            D4 => "Choice D4",
                   1053:                            D5 => "Choice D5",
                   1054:                            D6 => "Choice D6",
                   1055:                            D7 => "Choice D7"
1.609     raeburn  1056:                            },
                   1057:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1058:                    }
                   1059:                );
1.36      matthew  1060: 
                   1061: =cut
                   1062: 
                   1063: sub linked_select_forms {
                   1064:     my ($formname,
                   1065:         $middletext,
                   1066:         $firstdefault,
                   1067:         $firstselectname,
                   1068:         $secondselectname, 
1.609     raeburn  1069:         $hashref,
                   1070:         $menuorder,
1.36      matthew  1071:         ) = @_;
                   1072:     my $second = "document.$formname.$secondselectname";
                   1073:     my $first = "document.$formname.$firstselectname";
                   1074:     # output the javascript to do the changing
                   1075:     my $result = '';
1.776     bisitz   1076:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1077:     $result.="// <![CDATA[\n";
1.36      matthew  1078:     $result.="var select2data = new Object();\n";
                   1079:     $" = '","';
                   1080:     my $debug = '';
                   1081:     foreach my $s1 (sort(keys(%$hashref))) {
                   1082:         $result.="select2data.d_$s1 = new Object();\n";        
                   1083:         $result.="select2data.d_$s1.def = new String('".
                   1084:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1085:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1086:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1087:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1088:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1089:         }
1.36      matthew  1090:         $result.="\"@s2values\");\n";
                   1091:         $result.="select2data.d_$s1.texts = new Array(";        
                   1092:         my @s2texts;
                   1093:         foreach my $value (@s2values) {
                   1094:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1095:         }
                   1096:         $result.="\"@s2texts\");\n";
                   1097:     }
                   1098:     $"=' ';
                   1099:     $result.= <<"END";
                   1100: 
                   1101: function select1_changed() {
                   1102:     // Determine new choice
                   1103:     var newvalue = "d_" + $first.value;
                   1104:     // update select2
                   1105:     var values     = select2data[newvalue].values;
                   1106:     var texts      = select2data[newvalue].texts;
                   1107:     var select2def = select2data[newvalue].def;
                   1108:     var i;
                   1109:     // out with the old
                   1110:     for (i = 0; i < $second.options.length; i++) {
                   1111:         $second.options[i] = null;
                   1112:     }
                   1113:     // in with the nuclear
                   1114:     for (i=0;i<values.length; i++) {
                   1115:         $second.options[i] = new Option(values[i]);
1.143     matthew  1116:         $second.options[i].value = values[i];
1.36      matthew  1117:         $second.options[i].text = texts[i];
                   1118:         if (values[i] == select2def) {
                   1119:             $second.options[i].selected = true;
                   1120:         }
                   1121:     }
                   1122: }
1.824     bisitz   1123: // ]]>
1.36      matthew  1124: </script>
                   1125: END
                   1126:     # output the initial values for the selection lists
                   1127:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1128:     my @order = sort(keys(%{$hashref}));
                   1129:     if (ref($menuorder) eq 'ARRAY') {
                   1130:         @order = @{$menuorder};
                   1131:     }
                   1132:     foreach my $value (@order) {
1.36      matthew  1133:         $result.="    <option value=\"$value\" ";
1.253     albertel 1134:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1135:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1136:     }
                   1137:     $result .= "</select>\n";
                   1138:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1139:     $result .= $middletext;
                   1140:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1141:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1142:     
                   1143:     my @secondorder = sort(keys(%select2));
                   1144:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1145:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1146:     }
                   1147:     foreach my $value (@secondorder) {
1.36      matthew  1148:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1149:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1150:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1151:     }
                   1152:     $result .= "</select>\n";
                   1153:     #    return $debug;
                   1154:     return $result;
                   1155: }   #  end of sub linked_select_forms {
                   1156: 
1.45      matthew  1157: =pod
1.44      bowersj2 1158: 
1.973     raeburn  1159: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1160: 
1.112     bowersj2 1161: Returns a string corresponding to an HTML link to the given help
                   1162: $topic, where $topic corresponds to the name of a .tex file in
                   1163: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1164: spaces. 
                   1165: 
                   1166: $text will optionally be linked to the same topic, allowing you to
                   1167: link text in addition to the graphic. If you do not want to link
                   1168: text, but wish to specify one of the later parameters, pass an
                   1169: empty string. 
                   1170: 
                   1171: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1172: the link will not open a new window. If false, the link will open
                   1173: a new window using Javascript. (Default is false.) 
                   1174: 
                   1175: $width and $height are optional numerical parameters that will
                   1176: override the width and height of the popped up window, which may
1.973     raeburn  1177: be useful for certain help topics with big pictures included.
                   1178: 
                   1179: $imgid is the id of the img tag used for the help icon. This may be
                   1180: used in a javascript call to switch the image src.  See 
                   1181: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1182: 
                   1183: =cut
                   1184: 
                   1185: sub help_open_topic {
1.973     raeburn  1186:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1187:     $text = "" if (not defined $text);
1.44      bowersj2 1188:     $stayOnPage = 0 if (not defined $stayOnPage);
                   1189:     $width = 350 if (not defined $width);
                   1190:     $height = 400 if (not defined $height);
                   1191:     my $filename = $topic;
                   1192:     $filename =~ s/ /_/g;
                   1193: 
1.48      bowersj2 1194:     my $template = "";
                   1195:     my $link;
1.572     banghart 1196:     
1.159     www      1197:     $topic=~s/\W/\_/g;
1.44      bowersj2 1198: 
1.572     banghart 1199:     if (!$stayOnPage) {
1.72      bowersj2 1200: 	$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 1201:     } else {
1.48      bowersj2 1202: 	$link = "/adm/help/${filename}.hlp";
                   1203:     }
                   1204: 
                   1205:     # Add the text
1.755     neumanie 1206:     if ($text ne "") {	
1.763     bisitz   1207: 	$template.='<span class="LC_help_open_topic">'
                   1208:                   .'<a target="_top" href="'.$link.'">'
                   1209:                   .$text.'</a>';
1.48      bowersj2 1210:     }
                   1211: 
1.763     bisitz   1212:     # (Always) Add the graphic
1.179     matthew  1213:     my $title = &mt('Online Help');
1.667     raeburn  1214:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1215:     if ($imgid ne '') {
                   1216:         $imgid = ' id="'.$imgid.'"';
                   1217:     }
1.763     bisitz   1218:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1219:               .'<img src="'.$helpicon.'" border="0"'
                   1220:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1221:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1222:               .' /></a>';
                   1223:     if ($text ne "") {	
                   1224:         $template.='</span>';
                   1225:     }
1.44      bowersj2 1226:     return $template;
                   1227: 
1.106     bowersj2 1228: }
                   1229: 
                   1230: # This is a quicky function for Latex cheatsheet editing, since it 
                   1231: # appears in at least four places
                   1232: sub helpLatexCheatsheet {
1.732     raeburn  1233:     my ($topic,$text,$not_author) = @_;
                   1234:     my $out;
1.106     bowersj2 1235:     my $addOther = '';
1.732     raeburn  1236:     if ($topic) {
1.763     bisitz   1237: 	$addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),
                   1238: 							       undef, undef, 600).
                   1239: 								   '</span> ';
                   1240:     }
                   1241:     $out = '<span>' # Start cheatsheet
                   1242: 	  .$addOther
                   1243:           .'<span>'
                   1244: 	  .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
                   1245: 					       undef,undef,600)
                   1246: 	  .'</span> <span>'
                   1247: 	  .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
                   1248: 					       undef,undef,600)
                   1249: 	  .'</span>';
1.732     raeburn  1250:     unless ($not_author) {
1.763     bisitz   1251:         $out .= ' <span>'
                   1252: 	       .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
                   1253: 	                                            undef,undef,600)
                   1254: 	       .'</span>';
1.732     raeburn  1255:     }
1.763     bisitz   1256:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1257:     return $out;
1.172     www      1258: }
                   1259: 
1.430     albertel 1260: sub general_help {
                   1261:     my $helptopic='Student_Intro';
                   1262:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1263: 	$helptopic='Authoring_Intro';
1.907     raeburn  1264:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1265: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1266:     } elsif ($env{'request.role'}=~/^dc/) {
                   1267:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1268:     }
                   1269:     return $helptopic;
                   1270: }
                   1271: 
                   1272: sub update_help_link {
                   1273:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1274:     my $origurl = $ENV{'REQUEST_URI'};
                   1275:     $origurl=~s|^/~|/priv/|;
                   1276:     my $timestamp = time;
                   1277:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1278:         $$datum = &escape($$datum);
                   1279:     }
                   1280: 
                   1281:     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";
                   1282:     my $output .= <<"ENDOUTPUT";
                   1283: <script type="text/javascript">
1.824     bisitz   1284: // <![CDATA[
1.430     albertel 1285: banner_link = '$banner_link';
1.824     bisitz   1286: // ]]>
1.430     albertel 1287: </script>
                   1288: ENDOUTPUT
                   1289:     return $output;
                   1290: }
                   1291: 
                   1292: # now just updates the help link and generates a blue icon
1.193     raeburn  1293: sub help_open_menu {
1.430     albertel 1294:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1295: 	= @_;    
1.949     droeschl 1296:     $stayOnPage = 1;
1.430     albertel 1297:     my $output;
                   1298:     if ($component_help) {
                   1299: 	if (!$text) {
                   1300: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1301: 				       $width,$height);
                   1302: 	} else {
                   1303: 	    my $help_text;
                   1304: 	    $help_text=&unescape($topic);
                   1305: 	    $output='<table><tr><td>'.
                   1306: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1307: 				 $width,$height).'</td></tr></table>';
                   1308: 	}
                   1309:     }
                   1310:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1311:     return $output.$banner_link;
                   1312: }
                   1313: 
                   1314: sub top_nav_help {
                   1315:     my ($text) = @_;
1.436     albertel 1316:     $text = &mt($text);
1.949     droeschl 1317:     my $stay_on_page = 1;
                   1318: 
1.572     banghart 1319:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1320: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1321:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1322: 
1.201     raeburn  1323:     my $title = &mt('Get help');
1.436     albertel 1324: 
                   1325:     return <<"END";
                   1326: $banner_link
                   1327:  <a href="$link" title="$title">$text</a>
                   1328: END
                   1329: }
                   1330: 
                   1331: sub help_menu_js {
                   1332:     my ($text) = @_;
1.949     droeschl 1333:     my $stayOnPage = 1;
1.436     albertel 1334:     my $width = 620;
                   1335:     my $height = 600;
1.430     albertel 1336:     my $helptopic=&general_help();
                   1337:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1338:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1339:     my $start_page =
                   1340:         &Apache::loncommon::start_page('Help Menu', undef,
                   1341: 				       {'frameset'    => 1,
                   1342: 					'js_ready'    => 1,
                   1343: 					'add_entries' => {
                   1344: 					    'border' => '0',
1.579     raeburn  1345: 					    'rows'   => "110,*",},});
1.331     albertel 1346:     my $end_page =
                   1347:         &Apache::loncommon::end_page({'frameset' => 1,
                   1348: 				      'js_ready' => 1,});
                   1349: 
1.436     albertel 1350:     my $template .= <<"ENDTEMPLATE";
                   1351: <script type="text/javascript">
1.877     bisitz   1352: // <![CDATA[
1.253     albertel 1353: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1354: var banner_link = '';
1.243     raeburn  1355: function helpMenu(target) {
                   1356:     var caller = this;
                   1357:     if (target == 'open') {
                   1358:         var newWindow = null;
                   1359:         try {
1.262     albertel 1360:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1361:         }
                   1362:         catch(error) {
                   1363:             writeHelp(caller);
                   1364:             return;
                   1365:         }
                   1366:         if (newWindow) {
                   1367:             caller = newWindow;
                   1368:         }
1.193     raeburn  1369:     }
1.243     raeburn  1370:     writeHelp(caller);
                   1371:     return;
                   1372: }
                   1373: function writeHelp(caller) {
1.430     albertel 1374:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn  1375:     caller.document.close()
                   1376:     caller.focus()
1.193     raeburn  1377: }
1.877     bisitz   1378: // END LON-CAPA Internal -->
1.253     albertel 1379: // ]]>
1.436     albertel 1380: </script>
1.193     raeburn  1381: ENDTEMPLATE
                   1382:     return $template;
                   1383: }
                   1384: 
1.172     www      1385: sub help_open_bug {
                   1386:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1387:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1388:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1389:     $text = "" if (not defined $text);
                   1390: 	$stayOnPage=1;
1.184     albertel 1391:     $width = 600 if (not defined $width);
                   1392:     $height = 600 if (not defined $height);
1.172     www      1393: 
                   1394:     $topic=~s/\W+/\+/g;
                   1395:     my $link='';
                   1396:     my $template='';
1.379     albertel 1397:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1398: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1399:     if (!$stayOnPage)
                   1400:     {
                   1401: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1402:     }
                   1403:     else
                   1404:     {
                   1405: 	$link = $url;
                   1406:     }
                   1407:     # Add the text
                   1408:     if ($text ne "")
                   1409:     {
                   1410: 	$template .= 
                   1411:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1412:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1413:     }
                   1414: 
                   1415:     # Add the graphic
1.179     matthew  1416:     my $title = &mt('Report a Bug');
1.215     albertel 1417:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1418:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1419:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1420: ENDTEMPLATE
                   1421:     if ($text ne '') { $template.='</td></tr></table>' };
                   1422:     return $template;
                   1423: 
                   1424: }
                   1425: 
                   1426: sub help_open_faq {
                   1427:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1428:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1429:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1430:     $text = "" if (not defined $text);
                   1431: 	$stayOnPage=1;
                   1432:     $width = 350 if (not defined $width);
                   1433:     $height = 400 if (not defined $height);
                   1434: 
                   1435:     $topic=~s/\W+/\+/g;
                   1436:     my $link='';
                   1437:     my $template='';
                   1438:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1439:     if (!$stayOnPage)
                   1440:     {
                   1441: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1442:     }
                   1443:     else
                   1444:     {
                   1445: 	$link = $url;
                   1446:     }
                   1447: 
                   1448:     # Add the text
                   1449:     if ($text ne "")
                   1450:     {
                   1451: 	$template .= 
1.173     www      1452:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1453:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1454:     }
                   1455: 
                   1456:     # Add the graphic
1.179     matthew  1457:     my $title = &mt('View the FAQ');
1.215     albertel 1458:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1459:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1460:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1461: ENDTEMPLATE
                   1462:     if ($text ne '') { $template.='</td></tr></table>' };
                   1463:     return $template;
                   1464: 
1.44      bowersj2 1465: }
1.37      matthew  1466: 
1.180     matthew  1467: ###############################################################
                   1468: ###############################################################
                   1469: 
1.45      matthew  1470: =pod
                   1471: 
1.648     raeburn  1472: =item * &change_content_javascript():
1.256     matthew  1473: 
                   1474: This and the next function allow you to create small sections of an
                   1475: otherwise static HTML page that you can update on the fly with
                   1476: Javascript, even in Netscape 4.
                   1477: 
                   1478: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1479: must be written to the HTML page once. It will prove the Javascript
                   1480: function "change(name, content)". Calling the change function with the
                   1481: name of the section 
                   1482: you want to update, matching the name passed to C<changable_area>, and
                   1483: the new content you want to put in there, will put the content into
                   1484: that area.
                   1485: 
                   1486: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1487: to contain room for the original contents. You need to "make space"
                   1488: for whatever changes you wish to make, and be B<sure> to check your
                   1489: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1490: it's adequate for updating a one-line status display, but little more.
                   1491: This script will set the space to 100% width, so you only need to
                   1492: worry about height in Netscape 4.
                   1493: 
                   1494: Modern browsers are much less limiting, and if you can commit to the
                   1495: user not using Netscape 4, this feature may be used freely with
                   1496: pretty much any HTML.
                   1497: 
                   1498: =cut
                   1499: 
                   1500: sub change_content_javascript {
                   1501:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1502:     if ($env{'browser.type'} eq 'netscape' &&
                   1503: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1504: 	return (<<NETSCAPE4);
                   1505: 	function change(name, content) {
                   1506: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1507: 	    doc.open();
                   1508: 	    doc.write(content);
                   1509: 	    doc.close();
                   1510: 	}
                   1511: NETSCAPE4
                   1512:     } else {
                   1513: 	# Otherwise, we need to use semi-standards-compliant code
                   1514: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1515: 	# is really scary, and every useful browser supports it
                   1516: 	return (<<DOMBASED);
                   1517: 	function change(name, content) {
                   1518: 	    element = document.getElementById(name);
                   1519: 	    element.innerHTML = content;
                   1520: 	}
                   1521: DOMBASED
                   1522:     }
                   1523: }
                   1524: 
                   1525: =pod
                   1526: 
1.648     raeburn  1527: =item * &changable_area($name,$origContent):
1.256     matthew  1528: 
                   1529: This provides a "changable area" that can be modified on the fly via
                   1530: the Javascript code provided in C<change_content_javascript>. $name is
                   1531: the name you will use to reference the area later; do not repeat the
                   1532: same name on a given HTML page more then once. $origContent is what
                   1533: the area will originally contain, which can be left blank.
                   1534: 
                   1535: =cut
                   1536: 
                   1537: sub changable_area {
                   1538:     my ($name, $origContent) = @_;
                   1539: 
1.258     albertel 1540:     if ($env{'browser.type'} eq 'netscape' &&
                   1541: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1542: 	# If this is netscape 4, we need to use the Layer tag
                   1543: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1544:     } else {
                   1545: 	return "<span id='$name'>$origContent</span>";
                   1546:     }
                   1547: }
                   1548: 
                   1549: =pod
                   1550: 
1.648     raeburn  1551: =item * &viewport_geometry_js 
1.590     raeburn  1552: 
                   1553: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1554: 
                   1555: =cut
                   1556: 
                   1557: 
                   1558: sub viewport_geometry_js { 
                   1559:     return <<"GEOMETRY";
                   1560: var Geometry = {};
                   1561: function init_geometry() {
                   1562:     if (Geometry.init) { return };
                   1563:     Geometry.init=1;
                   1564:     if (window.innerHeight) {
                   1565:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1566:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1567:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1568:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1569:     }
                   1570:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1571:         Geometry.getViewportHeight =
                   1572:             function() { return document.documentElement.clientHeight; };
                   1573:         Geometry.getViewportWidth =
                   1574:             function() { return document.documentElement.clientWidth; };
                   1575: 
                   1576:         Geometry.getHorizontalScroll =
                   1577:             function() { return document.documentElement.scrollLeft; };
                   1578:         Geometry.getVerticalScroll =
                   1579:             function() { return document.documentElement.scrollTop; };
                   1580:     }
                   1581:     else if (document.body.clientHeight) {
                   1582:         Geometry.getViewportHeight =
                   1583:             function() { return document.body.clientHeight; };
                   1584:         Geometry.getViewportWidth =
                   1585:             function() { return document.body.clientWidth; };
                   1586:         Geometry.getHorizontalScroll =
                   1587:             function() { return document.body.scrollLeft; };
                   1588:         Geometry.getVerticalScroll =
                   1589:             function() { return document.body.scrollTop; };
                   1590:     }
                   1591: }
                   1592: 
                   1593: GEOMETRY
                   1594: }
                   1595: 
                   1596: =pod
                   1597: 
1.648     raeburn  1598: =item * &viewport_size_js()
1.590     raeburn  1599: 
                   1600: 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. 
                   1601: 
                   1602: =cut
                   1603: 
                   1604: sub viewport_size_js {
                   1605:     my $geometry = &viewport_geometry_js();
                   1606:     return <<"DIMS";
                   1607: 
                   1608: $geometry
                   1609: 
                   1610: function getViewportDims(width,height) {
                   1611:     init_geometry();
                   1612:     width.value = Geometry.getViewportWidth();
                   1613:     height.value = Geometry.getViewportHeight();
                   1614:     return;
                   1615: }
                   1616: 
                   1617: DIMS
                   1618: }
                   1619: 
                   1620: =pod
                   1621: 
1.648     raeburn  1622: =item * &resize_textarea_js()
1.565     albertel 1623: 
                   1624: emits the needed javascript to resize a textarea to be as big as possible
                   1625: 
                   1626: creates a function resize_textrea that takes two IDs first should be
                   1627: the id of the element to resize, second should be the id of a div that
                   1628: surrounds everything that comes after the textarea, this routine needs
                   1629: to be attached to the <body> for the onload and onresize events.
                   1630: 
1.648     raeburn  1631: =back
1.565     albertel 1632: 
                   1633: =cut
                   1634: 
                   1635: sub resize_textarea_js {
1.590     raeburn  1636:     my $geometry = &viewport_geometry_js();
1.565     albertel 1637:     return <<"RESIZE";
                   1638:     <script type="text/javascript">
1.824     bisitz   1639: // <![CDATA[
1.590     raeburn  1640: $geometry
1.565     albertel 1641: 
1.588     albertel 1642: function getX(element) {
                   1643:     var x = 0;
                   1644:     while (element) {
                   1645: 	x += element.offsetLeft;
                   1646: 	element = element.offsetParent;
                   1647:     }
                   1648:     return x;
                   1649: }
                   1650: function getY(element) {
                   1651:     var y = 0;
                   1652:     while (element) {
                   1653: 	y += element.offsetTop;
                   1654: 	element = element.offsetParent;
                   1655:     }
                   1656:     return y;
                   1657: }
                   1658: 
                   1659: 
1.565     albertel 1660: function resize_textarea(textarea_id,bottom_id) {
                   1661:     init_geometry();
                   1662:     var textarea        = document.getElementById(textarea_id);
                   1663:     //alert(textarea);
                   1664: 
1.588     albertel 1665:     var textarea_top    = getY(textarea);
1.565     albertel 1666:     var textarea_height = textarea.offsetHeight;
                   1667:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1668:     var bottom_top      = getY(bottom);
1.565     albertel 1669:     var bottom_height   = bottom.offsetHeight;
                   1670:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1671:     var fudge           = 23;
1.565     albertel 1672:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1673:     if (new_height < 300) {
                   1674: 	new_height = 300;
                   1675:     }
                   1676:     textarea.style.height=new_height+'px';
                   1677: }
1.824     bisitz   1678: // ]]>
1.565     albertel 1679: </script>
                   1680: RESIZE
                   1681: 
                   1682: }
                   1683: 
                   1684: =pod
                   1685: 
1.256     matthew  1686: =head1 Excel and CSV file utility routines
                   1687: 
                   1688: =over 4
                   1689: 
                   1690: =cut
                   1691: 
                   1692: ###############################################################
                   1693: ###############################################################
                   1694: 
                   1695: =pod
                   1696: 
1.648     raeburn  1697: =item * &csv_translate($text) 
1.37      matthew  1698: 
1.185     www      1699: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1700: format.
                   1701: 
                   1702: =cut
                   1703: 
1.180     matthew  1704: ###############################################################
                   1705: ###############################################################
1.37      matthew  1706: sub csv_translate {
                   1707:     my $text = shift;
                   1708:     $text =~ s/\"/\"\"/g;
1.209     albertel 1709:     $text =~ s/\n/ /g;
1.37      matthew  1710:     return $text;
                   1711: }
1.180     matthew  1712: 
                   1713: ###############################################################
                   1714: ###############################################################
                   1715: 
                   1716: =pod
                   1717: 
1.648     raeburn  1718: =item * &define_excel_formats()
1.180     matthew  1719: 
                   1720: Define some commonly used Excel cell formats.
                   1721: 
                   1722: Currently supported formats:
                   1723: 
                   1724: =over 4
                   1725: 
                   1726: =item header
                   1727: 
                   1728: =item bold
                   1729: 
                   1730: =item h1
                   1731: 
                   1732: =item h2
                   1733: 
                   1734: =item h3
                   1735: 
1.256     matthew  1736: =item h4
                   1737: 
                   1738: =item i
                   1739: 
1.180     matthew  1740: =item date
                   1741: 
                   1742: =back
                   1743: 
                   1744: Inputs: $workbook
                   1745: 
                   1746: Returns: $format, a hash reference.
                   1747: 
                   1748: =cut
                   1749: 
                   1750: ###############################################################
                   1751: ###############################################################
                   1752: sub define_excel_formats {
                   1753:     my ($workbook) = @_;
                   1754:     my $format;
                   1755:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1756:                                                 bottom    => 1,
                   1757:                                                 align     => 'center');
                   1758:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1759:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1760:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1761:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1762:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1763:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1764:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1765:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1766:     return $format;
                   1767: }
                   1768: 
                   1769: ###############################################################
                   1770: ###############################################################
1.113     bowersj2 1771: 
                   1772: =pod
                   1773: 
1.648     raeburn  1774: =item * &create_workbook()
1.255     matthew  1775: 
                   1776: Create an Excel worksheet.  If it fails, output message on the
                   1777: request object and return undefs.
                   1778: 
                   1779: Inputs: Apache request object
                   1780: 
                   1781: Returns (undef) on failure, 
                   1782:     Excel worksheet object, scalar with filename, and formats 
                   1783:     from &Apache::loncommon::define_excel_formats on success
                   1784: 
                   1785: =cut
                   1786: 
                   1787: ###############################################################
                   1788: ###############################################################
                   1789: sub create_workbook {
                   1790:     my ($r) = @_;
                   1791:         #
                   1792:     # Create the excel spreadsheet
                   1793:     my $filename = '/prtspool/'.
1.258     albertel 1794:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1795:         time.'_'.rand(1000000000).'.xls';
                   1796:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1797:     if (! defined($workbook)) {
                   1798:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1799:         $r->print(
                   1800:             '<p class="LC_error">'
                   1801:            .&mt('Problems occurred in creating the new Excel file.')
                   1802:            .' '.&mt('This error has been logged.')
                   1803:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1804:            .'</p>'
                   1805:         );
1.255     matthew  1806:         return (undef);
                   1807:     }
                   1808:     #
1.1014    foxr     1809:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1810:     #
                   1811:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1812:     return ($workbook,$filename,$format);
                   1813: }
                   1814: 
                   1815: ###############################################################
                   1816: ###############################################################
                   1817: 
                   1818: =pod
                   1819: 
1.648     raeburn  1820: =item * &create_text_file()
1.113     bowersj2 1821: 
1.542     raeburn  1822: Create a file to write to and eventually make available to the user.
1.256     matthew  1823: If file creation fails, outputs an error message on the request object and 
                   1824: return undefs.
1.113     bowersj2 1825: 
1.256     matthew  1826: Inputs: Apache request object, and file suffix
1.113     bowersj2 1827: 
1.256     matthew  1828: Returns (undef) on failure, 
                   1829:     Filehandle and filename on success.
1.113     bowersj2 1830: 
                   1831: =cut
                   1832: 
1.256     matthew  1833: ###############################################################
                   1834: ###############################################################
                   1835: sub create_text_file {
                   1836:     my ($r,$suffix) = @_;
                   1837:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1838:     my $fh;
                   1839:     my $filename = '/prtspool/'.
1.258     albertel 1840:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1841:         time.'_'.rand(1000000000).'.'.$suffix;
                   1842:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1843:     if (! defined($fh)) {
                   1844:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1845:         $r->print(
                   1846:             '<p class="LC_error">'
                   1847:            .&mt('Problems occurred in creating the output file.')
                   1848:            .' '.&mt('This error has been logged.')
                   1849:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1850:            .'</p>'
                   1851:         );
1.113     bowersj2 1852:     }
1.256     matthew  1853:     return ($fh,$filename)
1.113     bowersj2 1854: }
                   1855: 
                   1856: 
1.256     matthew  1857: =pod 
1.113     bowersj2 1858: 
                   1859: =back
                   1860: 
                   1861: =cut
1.37      matthew  1862: 
                   1863: ###############################################################
1.33      matthew  1864: ##        Home server <option> list generating code          ##
                   1865: ###############################################################
1.35      matthew  1866: 
1.169     www      1867: # ------------------------------------------
                   1868: 
                   1869: sub domain_select {
                   1870:     my ($name,$value,$multiple)=@_;
                   1871:     my %domains=map { 
1.514     albertel 1872: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1873:     } &Apache::lonnet::all_domains();
1.169     www      1874:     if ($multiple) {
                   1875: 	$domains{''}=&mt('Any domain');
1.550     albertel 1876: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1877: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1878:     } else {
1.550     albertel 1879: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1880: 	return &select_form($name,$value,\%domains);
1.169     www      1881:     }
                   1882: }
                   1883: 
1.282     albertel 1884: #-------------------------------------------
                   1885: 
                   1886: =pod
                   1887: 
1.519     raeburn  1888: =head1 Routines for form select boxes
                   1889: 
                   1890: =over 4
                   1891: 
1.648     raeburn  1892: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1893: 
                   1894: Returns a string containing a <select> element int multiple mode
                   1895: 
                   1896: 
                   1897: Args:
                   1898:   $name - name of the <select> element
1.506     raeburn  1899:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1900:   $size - number of rows long the select element is
1.283     albertel 1901:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1902:           (shown text should already have been &mt())
1.506     raeburn  1903:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1904: 
1.282     albertel 1905: =cut
                   1906: 
                   1907: #-------------------------------------------
1.169     www      1908: sub multiple_select_form {
1.284     albertel 1909:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1910:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1911:     my $output='';
1.191     matthew  1912:     if (! defined($size)) {
                   1913:         $size = 4;
1.283     albertel 1914:         if (scalar(keys(%$hash))<4) {
                   1915:             $size = scalar(keys(%$hash));
1.191     matthew  1916:         }
                   1917:     }
1.734     bisitz   1918:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1919:     my @order;
1.506     raeburn  1920:     if (ref($order) eq 'ARRAY')  {
                   1921:         @order = @{$order};
                   1922:     } else {
                   1923:         @order = sort(keys(%$hash));
1.501     banghart 1924:     }
                   1925:     if (exists($$hash{'select_form_order'})) {
                   1926:         @order = @{$$hash{'select_form_order'}};
                   1927:     }
                   1928:         
1.284     albertel 1929:     foreach my $key (@order) {
1.356     albertel 1930:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1931:         $output.='selected="selected" ' if ($selected{$key});
                   1932:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1933:     }
                   1934:     $output.="</select>\n";
                   1935:     return $output;
                   1936: }
                   1937: 
1.88      www      1938: #-------------------------------------------
                   1939: 
                   1940: =pod
                   1941: 
1.970     raeburn  1942: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1943: 
                   1944: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1945: allow a user to select options from a ref to a hash containing:
                   1946: option_name => displayed text. An optional $onchange can include
                   1947: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1948: 
1.88      www      1949: See lonrights.pm for an example invocation and use.
                   1950: 
                   1951: =cut
                   1952: 
                   1953: #-------------------------------------------
                   1954: sub select_form {
1.970     raeburn  1955:     my ($def,$name,$hashref,$onchange) = @_;
                   1956:     return unless (ref($hashref) eq 'HASH');
                   1957:     if ($onchange) {
                   1958:         $onchange = ' onchange="'.$onchange.'"';
                   1959:     }
                   1960:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1961:     my @keys;
1.970     raeburn  1962:     if (exists($hashref->{'select_form_order'})) {
                   1963: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1964:     } else {
1.970     raeburn  1965: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1966:     }
1.356     albertel 1967:     foreach my $key (@keys) {
                   1968:         $selectform.=
                   1969: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1970:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1971:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1972:     }
                   1973:     $selectform.="</select>";
                   1974:     return $selectform;
                   1975: }
                   1976: 
1.475     www      1977: # For display filters
                   1978: 
                   1979: sub display_filter {
                   1980:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1981:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1982:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1983: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1984: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1985: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1986:            &mt('Filter [_1]',
1.477     www      1987: 	   &select_form($env{'form.displayfilter'},
                   1988: 			'displayfilter',
1.970     raeburn  1989: 			{'currentfolder' => 'Current folder/page',
1.477     www      1990: 			 'containing' => 'Containing phrase',
1.970     raeburn  1991: 			 'none' => 'None'})).
1.714     bisitz   1992: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1993: }
                   1994: 
1.167     www      1995: sub gradeleveldescription {
                   1996:     my $gradelevel=shift;
                   1997:     my %gradelevels=(0 => 'Not specified',
                   1998: 		     1 => 'Grade 1',
                   1999: 		     2 => 'Grade 2',
                   2000: 		     3 => 'Grade 3',
                   2001: 		     4 => 'Grade 4',
                   2002: 		     5 => 'Grade 5',
                   2003: 		     6 => 'Grade 6',
                   2004: 		     7 => 'Grade 7',
                   2005: 		     8 => 'Grade 8',
                   2006: 		     9 => 'Grade 9',
                   2007: 		     10 => 'Grade 10',
                   2008: 		     11 => 'Grade 11',
                   2009: 		     12 => 'Grade 12',
                   2010: 		     13 => 'Grade 13',
                   2011: 		     14 => '100 Level',
                   2012: 		     15 => '200 Level',
                   2013: 		     16 => '300 Level',
                   2014: 		     17 => '400 Level',
                   2015: 		     18 => 'Graduate Level');
                   2016:     return &mt($gradelevels{$gradelevel});
                   2017: }
                   2018: 
1.163     www      2019: sub select_level_form {
                   2020:     my ($deflevel,$name)=@_;
                   2021:     unless ($deflevel) { $deflevel=0; }
1.167     www      2022:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2023:     for (my $i=0; $i<=18; $i++) {
                   2024:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2025:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2026:                 ">".&gradeleveldescription($i)."</option>\n";
                   2027:     }
                   2028:     $selectform.="</select>";
                   2029:     return $selectform;
1.163     www      2030: }
1.167     www      2031: 
1.35      matthew  2032: #-------------------------------------------
                   2033: 
1.45      matthew  2034: =pod
                   2035: 
1.910     raeburn  2036: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2037: 
                   2038: Returns a string containing a <select name='$name' size='1'> form to 
                   2039: allow a user to select the domain to preform an operation in.  
                   2040: See loncreateuser.pm for an example invocation and use.
                   2041: 
1.90      www      2042: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2043: selected");
                   2044: 
1.743     raeburn  2045: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2046: 
1.910     raeburn  2047: 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.
                   2048: 
                   2049: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2050: 
1.35      matthew  2051: =cut
                   2052: 
                   2053: #-------------------------------------------
1.34      matthew  2054: sub select_dom_form {
1.910     raeburn  2055:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2056:     if ($onchange) {
1.874     raeburn  2057:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2058:     }
1.910     raeburn  2059:     my @domains;
                   2060:     if (ref($incdoms) eq 'ARRAY') {
                   2061:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2062:     } else {
                   2063:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2064:     }
1.90      www      2065:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2066:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2067:     foreach my $dom (@domains) {
                   2068:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2069:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2070:         if ($showdomdesc) {
                   2071:             if ($dom ne '') {
                   2072:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2073:                 if ($domdesc ne '') {
                   2074:                     $selectdomain .= ' ('.$domdesc.')';
                   2075:                 }
                   2076:             } 
                   2077:         }
                   2078:         $selectdomain .= "</option>\n";
1.34      matthew  2079:     }
                   2080:     $selectdomain.="</select>";
                   2081:     return $selectdomain;
                   2082: }
                   2083: 
1.35      matthew  2084: #-------------------------------------------
                   2085: 
1.45      matthew  2086: =pod
                   2087: 
1.648     raeburn  2088: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2089: 
1.586     raeburn  2090: input: 4 arguments (two required, two optional) - 
                   2091:     $domain - domain of new user
                   2092:     $name - name of form element
                   2093:     $default - Value of 'default' causes a default item to be first 
                   2094:                             option, and selected by default. 
                   2095:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2096:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2097: output: returns 2 items: 
1.586     raeburn  2098: (a) form element which contains either:
                   2099:    (i) <select name="$name">
                   2100:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2101:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2102:        </select>
                   2103:        form item if there are multiple library servers in $domain, or
                   2104:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2105:        if there is only one library server in $domain.
                   2106: 
                   2107: (b) number of library servers found.
                   2108: 
                   2109: See loncreateuser.pm for example of use.
1.35      matthew  2110: 
                   2111: =cut
                   2112: 
                   2113: #-------------------------------------------
1.586     raeburn  2114: sub home_server_form_item {
                   2115:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2116:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2117:     my $result;
                   2118:     my $numlib = keys(%servers);
                   2119:     if ($numlib > 1) {
                   2120:         $result .= '<select name="'.$name.'" />'."\n";
                   2121:         if ($default) {
1.804     bisitz   2122:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2123:                        '</option>'."\n";
                   2124:         }
                   2125:         foreach my $hostid (sort(keys(%servers))) {
                   2126:             $result.= '<option value="'.$hostid.'">'.
                   2127: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2128:         }
                   2129:         $result .= '</select>'."\n";
                   2130:     } elsif ($numlib == 1) {
                   2131:         my $hostid;
                   2132:         foreach my $item (keys(%servers)) {
                   2133:             $hostid = $item;
                   2134:         }
                   2135:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2136:                    $hostid.'" />';
                   2137:                    if (!$hide) {
                   2138:                        $result .= $hostid.' '.$servers{$hostid};
                   2139:                    }
                   2140:                    $result .= "\n";
                   2141:     } elsif ($default) {
                   2142:         $result .= '<input type="hidden" name="'.$name.
                   2143:                    '" value="default" />';
                   2144:                    if (!$hide) {
                   2145:                        $result .= &mt('default');
                   2146:                    }
                   2147:                    $result .= "\n";
1.33      matthew  2148:     }
1.586     raeburn  2149:     return ($result,$numlib);
1.33      matthew  2150: }
1.112     bowersj2 2151: 
                   2152: =pod
                   2153: 
1.534     albertel 2154: =back 
                   2155: 
1.112     bowersj2 2156: =cut
1.87      matthew  2157: 
                   2158: ###############################################################
1.112     bowersj2 2159: ##                  Decoding User Agent                      ##
1.87      matthew  2160: ###############################################################
                   2161: 
                   2162: =pod
                   2163: 
1.112     bowersj2 2164: =head1 Decoding the User Agent
                   2165: 
                   2166: =over 4
                   2167: 
                   2168: =item * &decode_user_agent()
1.87      matthew  2169: 
                   2170: Inputs: $r
                   2171: 
                   2172: Outputs:
                   2173: 
                   2174: =over 4
                   2175: 
1.112     bowersj2 2176: =item * $httpbrowser
1.87      matthew  2177: 
1.112     bowersj2 2178: =item * $clientbrowser
1.87      matthew  2179: 
1.112     bowersj2 2180: =item * $clientversion
1.87      matthew  2181: 
1.112     bowersj2 2182: =item * $clientmathml
1.87      matthew  2183: 
1.112     bowersj2 2184: =item * $clientunicode
1.87      matthew  2185: 
1.112     bowersj2 2186: =item * $clientos
1.87      matthew  2187: 
                   2188: =back
                   2189: 
1.157     matthew  2190: =back 
                   2191: 
1.87      matthew  2192: =cut
                   2193: 
                   2194: ###############################################################
                   2195: ###############################################################
                   2196: sub decode_user_agent {
1.247     albertel 2197:     my ($r)=@_;
1.87      matthew  2198:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2199:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2200:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2201:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2202:     my $clientbrowser='unknown';
                   2203:     my $clientversion='0';
                   2204:     my $clientmathml='';
                   2205:     my $clientunicode='0';
                   2206:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2207:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2208: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2209: 	    $clientbrowser=$bname;
                   2210:             $httpbrowser=~/$vreg/i;
                   2211: 	    $clientversion=$1;
                   2212:             $clientmathml=($clientversion>=$minv);
                   2213:             $clientunicode=($clientversion>=$univ);
                   2214: 	}
                   2215:     }
                   2216:     my $clientos='unknown';
                   2217:     if (($httpbrowser=~/linux/i) ||
                   2218:         ($httpbrowser=~/unix/i) ||
                   2219:         ($httpbrowser=~/ux/i) ||
                   2220:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2221:     if (($httpbrowser=~/vax/i) ||
                   2222:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2223:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2224:     if (($httpbrowser=~/mac/i) ||
                   2225:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2226:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2227:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2228:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2229:             $clientunicode,$clientos,);
                   2230: }
                   2231: 
1.32      matthew  2232: ###############################################################
                   2233: ##    Authentication changing form generation subroutines    ##
                   2234: ###############################################################
                   2235: ##
                   2236: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2237: ## hash, and have reasonable default values.
                   2238: ##
                   2239: ##    formname = the name given in the <form> tag.
1.35      matthew  2240: #-------------------------------------------
                   2241: 
1.45      matthew  2242: =pod
                   2243: 
1.112     bowersj2 2244: =head1 Authentication Routines
                   2245: 
                   2246: =over 4
                   2247: 
1.648     raeburn  2248: =item * &authform_xxxxxx()
1.35      matthew  2249: 
                   2250: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2251: handle some of the conveniences required for authentication forms.  
                   2252: This is not an optimal method, but it works.  
                   2253: 
                   2254: =over 4
                   2255: 
1.112     bowersj2 2256: =item * authform_header
1.35      matthew  2257: 
1.112     bowersj2 2258: =item * authform_authorwarning
1.35      matthew  2259: 
1.112     bowersj2 2260: =item * authform_nochange
1.35      matthew  2261: 
1.112     bowersj2 2262: =item * authform_kerberos
1.35      matthew  2263: 
1.112     bowersj2 2264: =item * authform_internal
1.35      matthew  2265: 
1.112     bowersj2 2266: =item * authform_filesystem
1.35      matthew  2267: 
                   2268: =back
                   2269: 
1.648     raeburn  2270: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2271: 
1.35      matthew  2272: =cut
                   2273: 
                   2274: #-------------------------------------------
1.32      matthew  2275: sub authform_header{  
                   2276:     my %in = (
                   2277:         formname => 'cu',
1.80      albertel 2278:         kerb_def_dom => '',
1.32      matthew  2279:         @_,
                   2280:     );
                   2281:     $in{'formname'} = 'document.' . $in{'formname'};
                   2282:     my $result='';
1.80      albertel 2283: 
                   2284: #---------------------------------------------- Code for upper case translation
                   2285:     my $Javascript_toUpperCase;
                   2286:     unless ($in{kerb_def_dom}) {
                   2287:         $Javascript_toUpperCase =<<"END";
                   2288:         switch (choice) {
                   2289:            case 'krb': currentform.elements[choicearg].value =
                   2290:                currentform.elements[choicearg].value.toUpperCase();
                   2291:                break;
                   2292:            default:
                   2293:         }
                   2294: END
                   2295:     } else {
                   2296:         $Javascript_toUpperCase = "";
                   2297:     }
                   2298: 
1.165     raeburn  2299:     my $radioval = "'nochange'";
1.591     raeburn  2300:     if (defined($in{'curr_authtype'})) {
                   2301:         if ($in{'curr_authtype'} ne '') {
                   2302:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2303:         }
1.174     matthew  2304:     }
1.165     raeburn  2305:     my $argfield = 'null';
1.591     raeburn  2306:     if (defined($in{'mode'})) {
1.165     raeburn  2307:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2308:             if (defined($in{'curr_autharg'})) {
                   2309:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2310:                     $argfield = "'$in{'curr_autharg'}'";
                   2311:                 }
                   2312:             }
                   2313:         }
                   2314:     }
                   2315: 
1.32      matthew  2316:     $result.=<<"END";
                   2317: var current = new Object();
1.165     raeburn  2318: current.radiovalue = $radioval;
                   2319: current.argfield = $argfield;
1.32      matthew  2320: 
                   2321: function changed_radio(choice,currentform) {
                   2322:     var choicearg = choice + 'arg';
                   2323:     // If a radio button in changed, we need to change the argfield
                   2324:     if (current.radiovalue != choice) {
                   2325:         current.radiovalue = choice;
                   2326:         if (current.argfield != null) {
                   2327:             currentform.elements[current.argfield].value = '';
                   2328:         }
                   2329:         if (choice == 'nochange') {
                   2330:             current.argfield = null;
                   2331:         } else {
                   2332:             current.argfield = choicearg;
                   2333:             switch(choice) {
                   2334:                 case 'krb': 
                   2335:                     currentform.elements[current.argfield].value = 
                   2336:                         "$in{'kerb_def_dom'}";
                   2337:                 break;
                   2338:               default:
                   2339:                 break;
                   2340:             }
                   2341:         }
                   2342:     }
                   2343:     return;
                   2344: }
1.22      www      2345: 
1.32      matthew  2346: function changed_text(choice,currentform) {
                   2347:     var choicearg = choice + 'arg';
                   2348:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2349:         $Javascript_toUpperCase
1.32      matthew  2350:         // clear old field
                   2351:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2352:             currentform.elements[current.argfield].value = '';
                   2353:         }
                   2354:         current.argfield = choicearg;
                   2355:     }
                   2356:     set_auth_radio_buttons(choice,currentform);
                   2357:     return;
1.20      www      2358: }
1.32      matthew  2359: 
                   2360: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2361:     var numauthchoices = currentform.login.length;
                   2362:     if (typeof numauthchoices  == "undefined") {
                   2363:         return;
                   2364:     } 
1.32      matthew  2365:     var i=0;
1.986     raeburn  2366:     while (i < numauthchoices) {
1.32      matthew  2367:         if (currentform.login[i].value == newvalue) { break; }
                   2368:         i++;
                   2369:     }
1.986     raeburn  2370:     if (i == numauthchoices) {
1.32      matthew  2371:         return;
                   2372:     }
                   2373:     current.radiovalue = newvalue;
                   2374:     currentform.login[i].checked = true;
                   2375:     return;
                   2376: }
                   2377: END
                   2378:     return $result;
                   2379: }
                   2380: 
                   2381: sub authform_authorwarning{
                   2382:     my $result='';
1.144     matthew  2383:     $result='<i>'.
                   2384:         &mt('As a general rule, only authors or co-authors should be '.
                   2385:             'filesystem authenticated '.
                   2386:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2387:     return $result;
                   2388: }
                   2389: 
                   2390: sub authform_nochange{  
                   2391:     my %in = (
                   2392:               formname => 'document.cu',
                   2393:               kerb_def_dom => 'MSU.EDU',
                   2394:               @_,
                   2395:           );
1.586     raeburn  2396:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2397:     my $result;
                   2398:     if (keys(%can_assign) == 0) {
                   2399:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2400:     } else {
                   2401:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2402:                   '<input type="radio" name="login" value="nochange" '.
                   2403:                   'checked="checked" onclick="'.
1.281     albertel 2404:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2405: 	    '</label>';
1.586     raeburn  2406:     }
1.32      matthew  2407:     return $result;
                   2408: }
                   2409: 
1.591     raeburn  2410: sub authform_kerberos {
1.32      matthew  2411:     my %in = (
                   2412:               formname => 'document.cu',
                   2413:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2414:               kerb_def_auth => 'krb4',
1.32      matthew  2415:               @_,
                   2416:               );
1.586     raeburn  2417:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2418:         $autharg,$jscall);
                   2419:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2420:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2421:        $check5 = ' checked="checked"';
1.80      albertel 2422:     } else {
1.772     bisitz   2423:        $check4 = ' checked="checked"';
1.80      albertel 2424:     }
1.165     raeburn  2425:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2426:     if (defined($in{'curr_authtype'})) {
                   2427:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2428:             $krbcheck = ' checked="checked"';
1.623     raeburn  2429:             if (defined($in{'mode'})) {
                   2430:                 if ($in{'mode'} eq 'modifyuser') {
                   2431:                     $krbcheck = '';
                   2432:                 }
                   2433:             }
1.591     raeburn  2434:             if (defined($in{'curr_kerb_ver'})) {
                   2435:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2436:                     $check5 = ' checked="checked"';
1.591     raeburn  2437:                     $check4 = '';
                   2438:                 } else {
1.772     bisitz   2439:                     $check4 = ' checked="checked"';
1.591     raeburn  2440:                     $check5 = '';
                   2441:                 }
1.586     raeburn  2442:             }
1.591     raeburn  2443:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2444:                 $krbarg = $in{'curr_autharg'};
                   2445:             }
1.586     raeburn  2446:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2447:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2448:                     $result = 
                   2449:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2450:         $in{'curr_autharg'},$krbver);
                   2451:                 } else {
                   2452:                     $result =
                   2453:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2454:                 }
                   2455:                 return $result; 
                   2456:             }
                   2457:         }
                   2458:     } else {
                   2459:         if ($authnum == 1) {
1.784     bisitz   2460:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2461:         }
                   2462:     }
1.586     raeburn  2463:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2464:         return;
1.587     raeburn  2465:     } elsif ($authtype eq '') {
1.591     raeburn  2466:         if (defined($in{'mode'})) {
1.587     raeburn  2467:             if ($in{'mode'} eq 'modifycourse') {
                   2468:                 if ($authnum == 1) {
1.784     bisitz   2469:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2470:                 }
                   2471:             }
                   2472:         }
1.586     raeburn  2473:     }
                   2474:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2475:     if ($authtype eq '') {
                   2476:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2477:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2478:                     $krbcheck.' />';
                   2479:     }
                   2480:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2481:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2482:          $in{'curr_authtype'} eq 'krb5') ||
                   2483:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2484:          $in{'curr_authtype'} eq 'krb4')) {
                   2485:         $result .= &mt
1.144     matthew  2486:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2487:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2488:          '<label>'.$authtype,
1.281     albertel 2489:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2490:              'value="'.$krbarg.'" '.
1.144     matthew  2491:              'onchange="'.$jscall.'" />',
1.281     albertel 2492:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2493:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2494: 	 '</label>');
1.586     raeburn  2495:     } elsif ($can_assign{'krb4'}) {
                   2496:         $result .= &mt
                   2497:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2498:          '[_3] Version 4 [_4]',
                   2499:          '<label>'.$authtype,
                   2500:          '</label><input type="text" size="10" name="krbarg" '.
                   2501:              'value="'.$krbarg.'" '.
                   2502:              'onchange="'.$jscall.'" />',
                   2503:          '<label><input type="hidden" name="krbver" value="4" />',
                   2504:          '</label>');
                   2505:     } elsif ($can_assign{'krb5'}) {
                   2506:         $result .= &mt
                   2507:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2508:          '[_3] Version 5 [_4]',
                   2509:          '<label>'.$authtype,
                   2510:          '</label><input type="text" size="10" name="krbarg" '.
                   2511:              'value="'.$krbarg.'" '.
                   2512:              'onchange="'.$jscall.'" />',
                   2513:          '<label><input type="hidden" name="krbver" value="5" />',
                   2514:          '</label>');
                   2515:     }
1.32      matthew  2516:     return $result;
                   2517: }
                   2518: 
                   2519: sub authform_internal{  
1.586     raeburn  2520:     my %in = (
1.32      matthew  2521:                 formname => 'document.cu',
                   2522:                 kerb_def_dom => 'MSU.EDU',
                   2523:                 @_,
                   2524:                 );
1.586     raeburn  2525:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2526:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2527:     if (defined($in{'curr_authtype'})) {
                   2528:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2529:             if ($can_assign{'int'}) {
1.772     bisitz   2530:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2531:                 if (defined($in{'mode'})) {
                   2532:                     if ($in{'mode'} eq 'modifyuser') {
                   2533:                         $intcheck = '';
                   2534:                     }
                   2535:                 }
1.591     raeburn  2536:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2537:                     $intarg = $in{'curr_autharg'};
                   2538:                 }
                   2539:             } else {
                   2540:                 $result = &mt('Currently internally authenticated.');
                   2541:                 return $result;
1.165     raeburn  2542:             }
                   2543:         }
1.586     raeburn  2544:     } else {
                   2545:         if ($authnum == 1) {
1.784     bisitz   2546:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2547:         }
                   2548:     }
                   2549:     if (!$can_assign{'int'}) {
                   2550:         return;
1.587     raeburn  2551:     } elsif ($authtype eq '') {
1.591     raeburn  2552:         if (defined($in{'mode'})) {
1.587     raeburn  2553:             if ($in{'mode'} eq 'modifycourse') {
                   2554:                 if ($authnum == 1) {
1.784     bisitz   2555:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2556:                 }
                   2557:             }
                   2558:         }
1.165     raeburn  2559:     }
1.586     raeburn  2560:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2561:     if ($authtype eq '') {
                   2562:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2563:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2564:     }
1.605     bisitz   2565:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2566:                $intarg.'" onchange="'.$jscall.'" />';
                   2567:     $result = &mt
1.144     matthew  2568:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2569:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2570:     $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  2571:     return $result;
                   2572: }
                   2573: 
                   2574: sub authform_local{  
                   2575:     my %in = (
                   2576:               formname => 'document.cu',
                   2577:               kerb_def_dom => 'MSU.EDU',
                   2578:               @_,
                   2579:               );
1.586     raeburn  2580:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2581:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2582:     if (defined($in{'curr_authtype'})) {
                   2583:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2584:             if ($can_assign{'loc'}) {
1.772     bisitz   2585:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2586:                 if (defined($in{'mode'})) {
                   2587:                     if ($in{'mode'} eq 'modifyuser') {
                   2588:                         $loccheck = '';
                   2589:                     }
                   2590:                 }
1.591     raeburn  2591:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2592:                     $locarg = $in{'curr_autharg'};
                   2593:                 }
                   2594:             } else {
                   2595:                 $result = &mt('Currently using local (institutional) authentication.');
                   2596:                 return $result;
1.165     raeburn  2597:             }
                   2598:         }
1.586     raeburn  2599:     } else {
                   2600:         if ($authnum == 1) {
1.784     bisitz   2601:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2602:         }
                   2603:     }
                   2604:     if (!$can_assign{'loc'}) {
                   2605:         return;
1.587     raeburn  2606:     } elsif ($authtype eq '') {
1.591     raeburn  2607:         if (defined($in{'mode'})) {
1.587     raeburn  2608:             if ($in{'mode'} eq 'modifycourse') {
                   2609:                 if ($authnum == 1) {
1.784     bisitz   2610:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2611:                 }
                   2612:             }
                   2613:         }
1.165     raeburn  2614:     }
1.586     raeburn  2615:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2616:     if ($authtype eq '') {
                   2617:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2618:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2619:                     $jscall.'" />';
                   2620:     }
                   2621:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2622:                $locarg.'" onchange="'.$jscall.'" />';
                   2623:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2624:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2625:     return $result;
                   2626: }
                   2627: 
                   2628: sub authform_filesystem{  
                   2629:     my %in = (
                   2630:               formname => 'document.cu',
                   2631:               kerb_def_dom => 'MSU.EDU',
                   2632:               @_,
                   2633:               );
1.586     raeburn  2634:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2635:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2636:     if (defined($in{'curr_authtype'})) {
                   2637:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2638:             if ($can_assign{'fsys'}) {
1.772     bisitz   2639:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2640:                 if (defined($in{'mode'})) {
                   2641:                     if ($in{'mode'} eq 'modifyuser') {
                   2642:                         $fsyscheck = '';
                   2643:                     }
                   2644:                 }
1.586     raeburn  2645:             } else {
                   2646:                 $result = &mt('Currently Filesystem Authenticated.');
                   2647:                 return $result;
                   2648:             }           
                   2649:         }
                   2650:     } else {
                   2651:         if ($authnum == 1) {
1.784     bisitz   2652:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2653:         }
                   2654:     }
                   2655:     if (!$can_assign{'fsys'}) {
                   2656:         return;
1.587     raeburn  2657:     } elsif ($authtype eq '') {
1.591     raeburn  2658:         if (defined($in{'mode'})) {
1.587     raeburn  2659:             if ($in{'mode'} eq 'modifycourse') {
                   2660:                 if ($authnum == 1) {
1.784     bisitz   2661:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2662:                 }
                   2663:             }
                   2664:         }
1.586     raeburn  2665:     }
                   2666:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2667:     if ($authtype eq '') {
                   2668:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2669:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2670:                     $jscall.'" />';
                   2671:     }
                   2672:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2673:                ' onchange="'.$jscall.'" />';
                   2674:     $result = &mt
1.144     matthew  2675:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2676:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2677:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2678:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2679:                   'onchange="'.$jscall.'" />');
1.32      matthew  2680:     return $result;
                   2681: }
                   2682: 
1.586     raeburn  2683: sub get_assignable_auth {
                   2684:     my ($dom) = @_;
                   2685:     if ($dom eq '') {
                   2686:         $dom = $env{'request.role.domain'};
                   2687:     }
                   2688:     my %can_assign = (
                   2689:                           krb4 => 1,
                   2690:                           krb5 => 1,
                   2691:                           int  => 1,
                   2692:                           loc  => 1,
                   2693:                      );
                   2694:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2695:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2696:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2697:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2698:             my $context;
                   2699:             if ($env{'request.role'} =~ /^au/) {
                   2700:                 $context = 'author';
                   2701:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2702:                 $context = 'domain';
                   2703:             } elsif ($env{'request.course.id'}) {
                   2704:                 $context = 'course';
                   2705:             }
                   2706:             if ($context) {
                   2707:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2708:                    %can_assign = %{$authhash->{$context}}; 
                   2709:                 }
                   2710:             }
                   2711:         }
                   2712:     }
                   2713:     my $authnum = 0;
                   2714:     foreach my $key (keys(%can_assign)) {
                   2715:         if ($can_assign{$key}) {
                   2716:             $authnum ++;
                   2717:         }
                   2718:     }
                   2719:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2720:         $authnum --;
                   2721:     }
                   2722:     return ($authnum,%can_assign);
                   2723: }
                   2724: 
1.80      albertel 2725: ###############################################################
                   2726: ##    Get Kerberos Defaults for Domain                 ##
                   2727: ###############################################################
                   2728: ##
                   2729: ## Returns default kerberos version and an associated argument
                   2730: ## as listed in file domain.tab. If not listed, provides
                   2731: ## appropriate default domain and kerberos version.
                   2732: ##
                   2733: #-------------------------------------------
                   2734: 
                   2735: =pod
                   2736: 
1.648     raeburn  2737: =item * &get_kerberos_defaults()
1.80      albertel 2738: 
                   2739: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2740: version and domain. If not found, it defaults to version 4 and the 
                   2741: domain of the server.
1.80      albertel 2742: 
1.648     raeburn  2743: =over 4
                   2744: 
1.80      albertel 2745: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2746: 
1.648     raeburn  2747: =back
                   2748: 
                   2749: =back
                   2750: 
1.80      albertel 2751: =cut
                   2752: 
                   2753: #-------------------------------------------
                   2754: sub get_kerberos_defaults {
                   2755:     my $domain=shift;
1.641     raeburn  2756:     my ($krbdef,$krbdefdom);
                   2757:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2758:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2759:         $krbdef = $domdefaults{'auth_def'};
                   2760:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2761:     } else {
1.80      albertel 2762:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2763:         my $krbdefdom=$1;
                   2764:         $krbdefdom=~tr/a-z/A-Z/;
                   2765:         $krbdef = "krb4";
                   2766:     }
                   2767:     return ($krbdef,$krbdefdom);
                   2768: }
1.112     bowersj2 2769: 
1.32      matthew  2770: 
1.46      matthew  2771: ###############################################################
                   2772: ##                Thesaurus Functions                        ##
                   2773: ###############################################################
1.20      www      2774: 
1.46      matthew  2775: =pod
1.20      www      2776: 
1.112     bowersj2 2777: =head1 Thesaurus Functions
                   2778: 
                   2779: =over 4
                   2780: 
1.648     raeburn  2781: =item * &initialize_keywords()
1.46      matthew  2782: 
                   2783: Initializes the package variable %Keywords if it is empty.  Uses the
                   2784: package variable $thesaurus_db_file.
                   2785: 
                   2786: =cut
                   2787: 
                   2788: ###################################################
                   2789: 
                   2790: sub initialize_keywords {
                   2791:     return 1 if (scalar keys(%Keywords));
                   2792:     # If we are here, %Keywords is empty, so fill it up
                   2793:     #   Make sure the file we need exists...
                   2794:     if (! -e $thesaurus_db_file) {
                   2795:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2796:                                  " failed because it does not exist");
                   2797:         return 0;
                   2798:     }
                   2799:     #   Set up the hash as a database
                   2800:     my %thesaurus_db;
                   2801:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2802:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2803:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2804:                                  $thesaurus_db_file);
                   2805:         return 0;
                   2806:     } 
                   2807:     #  Get the average number of appearances of a word.
                   2808:     my $avecount = $thesaurus_db{'average.count'};
                   2809:     #  Put keywords (those that appear > average) into %Keywords
                   2810:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2811:         my ($count,undef) = split /:/,$data;
                   2812:         $Keywords{$word}++ if ($count > $avecount);
                   2813:     }
                   2814:     untie %thesaurus_db;
                   2815:     # Remove special values from %Keywords.
1.356     albertel 2816:     foreach my $value ('total.count','average.count') {
                   2817:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2818:   }
1.46      matthew  2819:     return 1;
                   2820: }
                   2821: 
                   2822: ###################################################
                   2823: 
                   2824: =pod
                   2825: 
1.648     raeburn  2826: =item * &keyword($word)
1.46      matthew  2827: 
                   2828: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2829: than the average number of times in the thesaurus database.  Calls 
                   2830: &initialize_keywords
                   2831: 
                   2832: =cut
                   2833: 
                   2834: ###################################################
1.20      www      2835: 
                   2836: sub keyword {
1.46      matthew  2837:     return if (!&initialize_keywords());
                   2838:     my $word=lc(shift());
                   2839:     $word=~s/\W//g;
                   2840:     return exists($Keywords{$word});
1.20      www      2841: }
1.46      matthew  2842: 
                   2843: ###############################################################
                   2844: 
                   2845: =pod 
1.20      www      2846: 
1.648     raeburn  2847: =item * &get_related_words()
1.46      matthew  2848: 
1.160     matthew  2849: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2850: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2851: will be returned.  The order of the words returned is determined by the
                   2852: database which holds them.
                   2853: 
                   2854: Uses global $thesaurus_db_file.
                   2855: 
                   2856: =cut
                   2857: 
                   2858: ###############################################################
                   2859: sub get_related_words {
                   2860:     my $keyword = shift;
                   2861:     my %thesaurus_db;
                   2862:     if (! -e $thesaurus_db_file) {
                   2863:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2864:                                  "failed because the file does not exist");
                   2865:         return ();
                   2866:     }
                   2867:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2868:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2869:         return ();
                   2870:     } 
                   2871:     my @Words=();
1.429     www      2872:     my $count=0;
1.46      matthew  2873:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2874: 	# The first element is the number of times
                   2875: 	# the word appears.  We do not need it now.
1.429     www      2876: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2877: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2878: 	my $threshold=$mostfrequentcount/10;
                   2879:         foreach my $possibleword (@RelatedWords) {
                   2880:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2881:             if ($wordcount>$threshold) {
                   2882: 		push(@Words,$word);
                   2883:                 $count++;
                   2884:                 if ($count>10) { last; }
                   2885: 	    }
1.20      www      2886:         }
                   2887:     }
1.46      matthew  2888:     untie %thesaurus_db;
                   2889:     return @Words;
1.14      harris41 2890: }
1.46      matthew  2891: 
1.112     bowersj2 2892: =pod
                   2893: 
                   2894: =back
                   2895: 
                   2896: =cut
1.61      www      2897: 
                   2898: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2899: =pod
                   2900: 
1.112     bowersj2 2901: =head1 User Name Functions
                   2902: 
                   2903: =over 4
                   2904: 
1.648     raeburn  2905: =item * &plainname($uname,$udom,$first)
1.81      albertel 2906: 
1.112     bowersj2 2907: Takes a users logon name and returns it as a string in
1.226     albertel 2908: "first middle last generation" form 
                   2909: if $first is set to 'lastname' then it returns it as
                   2910: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2911: 
                   2912: =cut
1.61      www      2913: 
1.295     www      2914: 
1.81      albertel 2915: ###############################################################
1.61      www      2916: sub plainname {
1.226     albertel 2917:     my ($uname,$udom,$first)=@_;
1.537     albertel 2918:     return if (!defined($uname) || !defined($udom));
1.295     www      2919:     my %names=&getnames($uname,$udom);
1.226     albertel 2920:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2921: 					  $names{'middlename'},
                   2922: 					  $names{'lastname'},
                   2923: 					  $names{'generation'},$first);
                   2924:     $name=~s/^\s+//;
1.62      www      2925:     $name=~s/\s+$//;
                   2926:     $name=~s/\s+/ /g;
1.353     albertel 2927:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2928:     return $name;
1.61      www      2929: }
1.66      www      2930: 
                   2931: # -------------------------------------------------------------------- Nickname
1.81      albertel 2932: =pod
                   2933: 
1.648     raeburn  2934: =item * &nickname($uname,$udom)
1.81      albertel 2935: 
                   2936: Gets a users name and returns it as a string as
                   2937: 
                   2938: "&quot;nickname&quot;"
1.66      www      2939: 
1.81      albertel 2940: if the user has a nickname or
                   2941: 
                   2942: "first middle last generation"
                   2943: 
                   2944: if the user does not
                   2945: 
                   2946: =cut
1.66      www      2947: 
                   2948: sub nickname {
                   2949:     my ($uname,$udom)=@_;
1.537     albertel 2950:     return if (!defined($uname) || !defined($udom));
1.295     www      2951:     my %names=&getnames($uname,$udom);
1.68      albertel 2952:     my $name=$names{'nickname'};
1.66      www      2953:     if ($name) {
                   2954:        $name='&quot;'.$name.'&quot;'; 
                   2955:     } else {
                   2956:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2957: 	     $names{'lastname'}.' '.$names{'generation'};
                   2958:        $name=~s/\s+$//;
                   2959:        $name=~s/\s+/ /g;
                   2960:     }
                   2961:     return $name;
                   2962: }
                   2963: 
1.295     www      2964: sub getnames {
                   2965:     my ($uname,$udom)=@_;
1.537     albertel 2966:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2967:     if ($udom eq 'public' && $uname eq 'public') {
                   2968: 	return ('lastname' => &mt('Public'));
                   2969:     }
1.295     www      2970:     my $id=$uname.':'.$udom;
                   2971:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2972:     if ($cached) {
                   2973: 	return %{$names};
                   2974:     } else {
                   2975: 	my %loadnames=&Apache::lonnet::get('environment',
                   2976:                     ['firstname','middlename','lastname','generation','nickname'],
                   2977: 					 $udom,$uname);
                   2978: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2979: 	return %loadnames;
                   2980:     }
                   2981: }
1.61      www      2982: 
1.542     raeburn  2983: # -------------------------------------------------------------------- getemails
1.648     raeburn  2984: 
1.542     raeburn  2985: =pod
                   2986: 
1.648     raeburn  2987: =item * &getemails($uname,$udom)
1.542     raeburn  2988: 
                   2989: Gets a user's email information and returns it as a hash with keys:
                   2990: notification, critnotification, permanentemail
                   2991: 
                   2992: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2993: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2994:  
1.648     raeburn  2995: 
1.542     raeburn  2996: =cut
                   2997: 
1.648     raeburn  2998: 
1.466     albertel 2999: sub getemails {
                   3000:     my ($uname,$udom)=@_;
                   3001:     if ($udom eq 'public' && $uname eq 'public') {
                   3002: 	return;
                   3003:     }
1.467     www      3004:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3005:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3006:     my $id=$uname.':'.$udom;
                   3007:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3008:     if ($cached) {
                   3009: 	return %{$names};
                   3010:     } else {
                   3011: 	my %loadnames=&Apache::lonnet::get('environment',
                   3012:                     			   ['notification','critnotification',
                   3013: 					    'permanentemail'],
                   3014: 					   $udom,$uname);
                   3015: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3016: 	return %loadnames;
                   3017:     }
                   3018: }
                   3019: 
1.551     albertel 3020: sub flush_email_cache {
                   3021:     my ($uname,$udom)=@_;
                   3022:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3023:     if (!$uname) { $uname=$env{'user.name'};   }
                   3024:     return if ($udom eq 'public' && $uname eq 'public');
                   3025:     my $id=$uname.':'.$udom;
                   3026:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3027: }
                   3028: 
1.728     raeburn  3029: # -------------------------------------------------------------------- getlangs
                   3030: 
                   3031: =pod
                   3032: 
                   3033: =item * &getlangs($uname,$udom)
                   3034: 
                   3035: Gets a user's language preference and returns it as a hash with key:
                   3036: language.
                   3037: 
                   3038: =cut
                   3039: 
                   3040: 
                   3041: sub getlangs {
                   3042:     my ($uname,$udom) = @_;
                   3043:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3044:     if (!$uname) { $uname=$env{'user.name'};   }
                   3045:     my $id=$uname.':'.$udom;
                   3046:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3047:     if ($cached) {
                   3048:         return %{$langs};
                   3049:     } else {
                   3050:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3051:                                            $udom,$uname);
                   3052:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3053:         return %loadlangs;
                   3054:     }
                   3055: }
                   3056: 
                   3057: sub flush_langs_cache {
                   3058:     my ($uname,$udom)=@_;
                   3059:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3060:     if (!$uname) { $uname=$env{'user.name'};   }
                   3061:     return if ($udom eq 'public' && $uname eq 'public');
                   3062:     my $id=$uname.':'.$udom;
                   3063:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3064: }
                   3065: 
1.61      www      3066: # ------------------------------------------------------------------ Screenname
1.81      albertel 3067: 
                   3068: =pod
                   3069: 
1.648     raeburn  3070: =item * &screenname($uname,$udom)
1.81      albertel 3071: 
                   3072: Gets a users screenname and returns it as a string
                   3073: 
                   3074: =cut
1.61      www      3075: 
                   3076: sub screenname {
                   3077:     my ($uname,$udom)=@_;
1.258     albertel 3078:     if ($uname eq $env{'user.name'} &&
                   3079: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3080:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3081:     return $names{'screenname'};
1.62      www      3082: }
                   3083: 
1.212     albertel 3084: 
1.802     bisitz   3085: # ------------------------------------------------------------- Confirm Wrapper
                   3086: =pod
                   3087: 
                   3088: =item confirmwrapper
                   3089: 
                   3090: Wrap messages about completion of operation in box
                   3091: 
                   3092: =cut
                   3093: 
                   3094: sub confirmwrapper {
                   3095:     my ($message)=@_;
                   3096:     if ($message) {
                   3097:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3098:                .$message."\n"
                   3099:                .'</div>'."\n";
                   3100:     } else {
                   3101:         return $message;
                   3102:     }
                   3103: }
                   3104: 
1.62      www      3105: # ------------------------------------------------------------- Message Wrapper
                   3106: 
                   3107: sub messagewrapper {
1.369     www      3108:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3109:     return 
1.441     albertel 3110:         '<a href="/adm/email?compose=individual&amp;'.
                   3111:         'recname='.$username.'&amp;recdom='.$domain.
                   3112: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3113:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3114: }
1.802     bisitz   3115: 
1.74      www      3116: # --------------------------------------------------------------- Notes Wrapper
                   3117: 
                   3118: sub noteswrapper {
                   3119:     my ($link,$un,$do)=@_;
                   3120:     return 
1.896     amueller 3121: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3122: }
1.802     bisitz   3123: 
1.62      www      3124: # ------------------------------------------------------------- Aboutme Wrapper
                   3125: 
                   3126: sub aboutmewrapper {
1.166     www      3127:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  3128:     if (!defined($username)  && !defined($domain)) {
                   3129:         return;
                   3130:     }
1.892     amueller 3131:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756     weissno  3132: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3133: }
                   3134: 
                   3135: # ------------------------------------------------------------ Syllabus Wrapper
                   3136: 
                   3137: sub syllabuswrapper {
1.707     bisitz   3138:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3139:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3140: }
1.14      harris41 3141: 
1.802     bisitz   3142: # -----------------------------------------------------------------------------
                   3143: 
1.208     matthew  3144: sub track_student_link {
1.887     raeburn  3145:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3146:     my $link ="/adm/trackstudent?";
1.208     matthew  3147:     my $title = 'View recent activity';
                   3148:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3149:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3150:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3151:         $title .= ' of this student';
1.268     albertel 3152:     } 
1.208     matthew  3153:     if (defined($target) && $target !~ /^\s*$/) {
                   3154:         $target = qq{target="$target"};
                   3155:     } else {
                   3156:         $target = '';
                   3157:     }
1.268     albertel 3158:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3159:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3160:     $title = &mt($title);
                   3161:     $linktext = &mt($linktext);
1.448     albertel 3162:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3163: 	&help_open_topic('View_recent_activity');
1.208     matthew  3164: }
                   3165: 
1.781     raeburn  3166: sub slot_reservations_link {
                   3167:     my ($linktext,$sname,$sdom,$target) = @_;
                   3168:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3169:     my $title = 'View slot reservation history';
                   3170:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3171:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3172:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3173:         $title .= ' of this student';
                   3174:     }
                   3175:     if (defined($target) && $target !~ /^\s*$/) {
                   3176:         $target = qq{target="$target"};
                   3177:     } else {
                   3178:         $target = '';
                   3179:     }
                   3180:     $title = &mt($title);
                   3181:     $linktext = &mt($linktext);
                   3182:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3183: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3184: 
                   3185: }
                   3186: 
1.508     www      3187: # ===================================================== Display a student photo
                   3188: 
                   3189: 
1.509     albertel 3190: sub student_image_tag {
1.508     www      3191:     my ($domain,$user)=@_;
                   3192:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3193:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3194: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3195:     } else {
                   3196: 	return '';
                   3197:     }
                   3198: }
                   3199: 
1.112     bowersj2 3200: =pod
                   3201: 
                   3202: =back
                   3203: 
                   3204: =head1 Access .tab File Data
                   3205: 
                   3206: =over 4
                   3207: 
1.648     raeburn  3208: =item * &languageids() 
1.112     bowersj2 3209: 
                   3210: returns list of all language ids
                   3211: 
                   3212: =cut
                   3213: 
1.14      harris41 3214: sub languageids {
1.16      harris41 3215:     return sort(keys(%language));
1.14      harris41 3216: }
                   3217: 
1.112     bowersj2 3218: =pod
                   3219: 
1.648     raeburn  3220: =item * &languagedescription() 
1.112     bowersj2 3221: 
                   3222: returns description of a specified language id
                   3223: 
                   3224: =cut
                   3225: 
1.14      harris41 3226: sub languagedescription {
1.125     www      3227:     my $code=shift;
                   3228:     return  ($supported_language{$code}?'* ':'').
                   3229:             $language{$code}.
1.126     www      3230: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3231: }
                   3232: 
                   3233: sub plainlanguagedescription {
                   3234:     my $code=shift;
                   3235:     return $language{$code};
                   3236: }
                   3237: 
                   3238: sub supportedlanguagecode {
                   3239:     my $code=shift;
                   3240:     return $supported_language{$code};
1.97      www      3241: }
                   3242: 
1.112     bowersj2 3243: =pod
                   3244: 
1.648     raeburn  3245: =item * &copyrightids() 
1.112     bowersj2 3246: 
                   3247: returns list of all copyrights
                   3248: 
                   3249: =cut
                   3250: 
                   3251: sub copyrightids {
                   3252:     return sort(keys(%cprtag));
                   3253: }
                   3254: 
                   3255: =pod
                   3256: 
1.648     raeburn  3257: =item * &copyrightdescription() 
1.112     bowersj2 3258: 
                   3259: returns description of a specified copyright id
                   3260: 
                   3261: =cut
                   3262: 
                   3263: sub copyrightdescription {
1.166     www      3264:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3265: }
1.197     matthew  3266: 
                   3267: =pod
                   3268: 
1.648     raeburn  3269: =item * &source_copyrightids() 
1.192     taceyjo1 3270: 
                   3271: returns list of all source copyrights
                   3272: 
                   3273: =cut
                   3274: 
                   3275: sub source_copyrightids {
                   3276:     return sort(keys(%scprtag));
                   3277: }
                   3278: 
                   3279: =pod
                   3280: 
1.648     raeburn  3281: =item * &source_copyrightdescription() 
1.192     taceyjo1 3282: 
                   3283: returns description of a specified source copyright id
                   3284: 
                   3285: =cut
                   3286: 
                   3287: sub source_copyrightdescription {
                   3288:     return &mt($scprtag{shift(@_)});
                   3289: }
1.112     bowersj2 3290: 
                   3291: =pod
                   3292: 
1.648     raeburn  3293: =item * &filecategories() 
1.112     bowersj2 3294: 
                   3295: returns list of all file categories
                   3296: 
                   3297: =cut
                   3298: 
                   3299: sub filecategories {
                   3300:     return sort(keys(%category_extensions));
                   3301: }
                   3302: 
                   3303: =pod
                   3304: 
1.648     raeburn  3305: =item * &filecategorytypes() 
1.112     bowersj2 3306: 
                   3307: returns list of file types belonging to a given file
                   3308: category
                   3309: 
                   3310: =cut
                   3311: 
                   3312: sub filecategorytypes {
1.356     albertel 3313:     my ($cat) = @_;
                   3314:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3315: }
                   3316: 
                   3317: =pod
                   3318: 
1.648     raeburn  3319: =item * &fileembstyle() 
1.112     bowersj2 3320: 
                   3321: returns embedding style for a specified file type
                   3322: 
                   3323: =cut
                   3324: 
                   3325: sub fileembstyle {
                   3326:     return $fe{lc(shift(@_))};
1.169     www      3327: }
                   3328: 
1.351     www      3329: sub filemimetype {
                   3330:     return $fm{lc(shift(@_))};
                   3331: }
                   3332: 
1.169     www      3333: 
                   3334: sub filecategoryselect {
                   3335:     my ($name,$value)=@_;
1.189     matthew  3336:     return &select_form($value,$name,
1.970     raeburn  3337:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3338: }
                   3339: 
                   3340: =pod
                   3341: 
1.648     raeburn  3342: =item * &filedescription() 
1.112     bowersj2 3343: 
                   3344: returns description for a specified file type
                   3345: 
                   3346: =cut
                   3347: 
                   3348: sub filedescription {
1.188     matthew  3349:     my $file_description = $fd{lc(shift())};
                   3350:     $file_description =~ s:([\[\]]):~$1:g;
                   3351:     return &mt($file_description);
1.112     bowersj2 3352: }
                   3353: 
                   3354: =pod
                   3355: 
1.648     raeburn  3356: =item * &filedescriptionex() 
1.112     bowersj2 3357: 
                   3358: returns description for a specified file type with
                   3359: extra formatting
                   3360: 
                   3361: =cut
                   3362: 
                   3363: sub filedescriptionex {
                   3364:     my $ex=shift;
1.188     matthew  3365:     my $file_description = $fd{lc($ex)};
                   3366:     $file_description =~ s:([\[\]]):~$1:g;
                   3367:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3368: }
                   3369: 
                   3370: # End of .tab access
                   3371: =pod
                   3372: 
                   3373: =back
                   3374: 
                   3375: =cut
                   3376: 
                   3377: # ------------------------------------------------------------------ File Types
                   3378: sub fileextensions {
                   3379:     return sort(keys(%fe));
                   3380: }
                   3381: 
1.97      www      3382: # ----------------------------------------------------------- Display Languages
                   3383: # returns a hash with all desired display languages
                   3384: #
                   3385: 
                   3386: sub display_languages {
                   3387:     my %languages=();
1.695     raeburn  3388:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3389: 	$languages{$lang}=1;
1.97      www      3390:     }
                   3391:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3392:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3393: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3394: 	    $languages{$lang}=1;
1.97      www      3395:         }
                   3396:     }
                   3397:     return %languages;
1.14      harris41 3398: }
                   3399: 
1.582     albertel 3400: sub languages {
                   3401:     my ($possible_langs) = @_;
1.695     raeburn  3402:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3403:     if (!ref($possible_langs)) {
                   3404: 	if( wantarray ) {
                   3405: 	    return @preferred_langs;
                   3406: 	} else {
                   3407: 	    return $preferred_langs[0];
                   3408: 	}
                   3409:     }
                   3410:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3411:     my @preferred_possibilities;
                   3412:     foreach my $preferred_lang (@preferred_langs) {
                   3413: 	if (exists($possibilities{$preferred_lang})) {
                   3414: 	    push(@preferred_possibilities, $preferred_lang);
                   3415: 	}
                   3416:     }
                   3417:     if( wantarray ) {
                   3418: 	return @preferred_possibilities;
                   3419:     }
                   3420:     return $preferred_possibilities[0];
                   3421: }
                   3422: 
1.742     raeburn  3423: sub user_lang {
                   3424:     my ($touname,$toudom,$fromcid) = @_;
                   3425:     my @userlangs;
                   3426:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3427:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3428:                     $env{'course.'.$fromcid.'.languages'}));
                   3429:     } else {
                   3430:         my %langhash = &getlangs($touname,$toudom);
                   3431:         if ($langhash{'languages'} ne '') {
                   3432:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3433:         } else {
                   3434:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3435:             if ($domdefs{'lang_def'} ne '') {
                   3436:                 @userlangs = ($domdefs{'lang_def'});
                   3437:             }
                   3438:         }
                   3439:     }
                   3440:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3441:     my $user_lh = Apache::localize->get_handle(@languages);
                   3442:     return $user_lh;
                   3443: }
                   3444: 
                   3445: 
1.112     bowersj2 3446: ###############################################################
                   3447: ##               Student Answer Attempts                     ##
                   3448: ###############################################################
                   3449: 
                   3450: =pod
                   3451: 
                   3452: =head1 Alternate Problem Views
                   3453: 
                   3454: =over 4
                   3455: 
1.648     raeburn  3456: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3457:     $getattempt, $regexp, $gradesub)
                   3458: 
                   3459: Return string with previous attempt on problem. Arguments:
                   3460: 
                   3461: =over 4
                   3462: 
                   3463: =item * $symb: Problem, including path
                   3464: 
                   3465: =item * $username: username of the desired student
                   3466: 
                   3467: =item * $domain: domain of the desired student
1.14      harris41 3468: 
1.112     bowersj2 3469: =item * $course: Course ID
1.14      harris41 3470: 
1.112     bowersj2 3471: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3472:     something
1.14      harris41 3473: 
1.112     bowersj2 3474: =item * $regexp: if string matches this regexp, the string will be
                   3475:     sent to $gradesub
1.14      harris41 3476: 
1.112     bowersj2 3477: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3478: 
1.112     bowersj2 3479: =back
1.14      harris41 3480: 
1.112     bowersj2 3481: The output string is a table containing all desired attempts, if any.
1.16      harris41 3482: 
1.112     bowersj2 3483: =cut
1.1       albertel 3484: 
                   3485: sub get_previous_attempt {
1.43      ng       3486:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3487:   my $prevattempts='';
1.43      ng       3488:   no strict 'refs';
1.1       albertel 3489:   if ($symb) {
1.3       albertel 3490:     my (%returnhash)=
                   3491:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3492:     if ($returnhash{'version'}) {
                   3493:       my %lasthash=();
                   3494:       my $version;
                   3495:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3496:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3497: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3498:         }
1.1       albertel 3499:       }
1.596     albertel 3500:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3501:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3502:       my (%typeparts,%lasthidden);
1.945     raeburn  3503:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3504:       foreach my $key (sort(keys(%lasthash))) {
                   3505: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3506: 	if ($#parts > 0) {
1.31      albertel 3507: 	  my $data=$parts[-1];
1.989     raeburn  3508:           next if ($data eq 'foilorder');
1.31      albertel 3509: 	  pop(@parts);
1.1010    www      3510:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3511:           if ($data eq 'type') {
                   3512:               unless ($showsurv) {
                   3513:                   my $id = join(',',@parts);
                   3514:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3515:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3516:                       $lasthidden{$ign.'.'.$id} = 1;
                   3517:                   }
1.945     raeburn  3518:               }
1.1010    www      3519:           } 
1.31      albertel 3520: 	} else {
1.41      ng       3521: 	  if ($#parts == 0) {
                   3522: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3523: 	  } else {
                   3524: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3525: 	  }
1.31      albertel 3526: 	}
1.16      harris41 3527:       }
1.596     albertel 3528:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3529:       if ($getattempt eq '') {
                   3530: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3531:             my @hidden;
                   3532:             if (%typeparts) {
                   3533:                 foreach my $id (keys(%typeparts)) {
                   3534:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3535:                         push(@hidden,$id);
                   3536:                     }
                   3537:                 }
                   3538:             }
                   3539:             $prevattempts.=&start_data_table_row().
                   3540:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3541:             if (@hidden) {
                   3542:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3543:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3544:                     my $hide;
                   3545:                     foreach my $id (@hidden) {
                   3546:                         if ($key =~ /^\Q$id\E/) {
                   3547:                             $hide = 1;
                   3548:                             last;
                   3549:                         }
                   3550:                     }
                   3551:                     if ($hide) {
                   3552:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3553:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3554:                             my $value = &format_previous_attempt_value($key,
                   3555:                                              $returnhash{$version.':'.$key});
                   3556:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3557:                         } else {
                   3558:                             $prevattempts.='<td>&nbsp;</td>';
                   3559:                         }
                   3560:                     } else {
                   3561:                         if ($key =~ /\./) {
                   3562:                             my $value = &format_previous_attempt_value($key,
                   3563:                                               $returnhash{$version.':'.$key});
                   3564:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3565:                         } else {
                   3566:                             $prevattempts.='<td>&nbsp;</td>';
                   3567:                         }
                   3568:                     }
                   3569:                 }
                   3570:             } else {
                   3571: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3572:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3573: 		    my $value = &format_previous_attempt_value($key,
                   3574: 			            $returnhash{$version.':'.$key});
                   3575: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3576: 	        }
                   3577:             }
                   3578: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3579: 	 }
1.1       albertel 3580:       }
1.945     raeburn  3581:       my @currhidden = keys(%lasthidden);
1.596     albertel 3582:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3583:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3584:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3585:           if (%typeparts) {
                   3586:               my $hidden;
                   3587:               foreach my $id (@currhidden) {
                   3588:                   if ($key =~ /^\Q$id\E/) {
                   3589:                       $hidden = 1;
                   3590:                       last;
                   3591:                   }
                   3592:               }
                   3593:               if ($hidden) {
                   3594:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3595:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3596:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3597:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3598:                           $value = &$gradesub($value);
                   3599:                       }
                   3600:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3601:                   } else {
                   3602:                       $prevattempts.='<td>&nbsp;</td>';
                   3603:                   }
                   3604:               } else {
                   3605:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3606:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3607:                       $value = &$gradesub($value);
                   3608:                   }
                   3609:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3610:               }
                   3611:           } else {
                   3612: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3613: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3614:                   $value = &$gradesub($value);
                   3615:               }
                   3616: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3617:           }
1.16      harris41 3618:       }
1.596     albertel 3619:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3620:     } else {
1.596     albertel 3621:       $prevattempts=
                   3622: 	  &start_data_table().&start_data_table_row().
                   3623: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3624: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3625:     }
                   3626:   } else {
1.596     albertel 3627:     $prevattempts=
                   3628: 	  &start_data_table().&start_data_table_row().
                   3629: 	  '<td>'.&mt('No data.').'</td>'.
                   3630: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3631:   }
1.10      albertel 3632: }
                   3633: 
1.581     albertel 3634: sub format_previous_attempt_value {
                   3635:     my ($key,$value) = @_;
1.1011    www      3636:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3637: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3638:     } elsif (ref($value) eq 'ARRAY') {
                   3639: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3640:     } elsif ($key =~ /answerstring$/) {
                   3641:         my %answers = &Apache::lonnet::str2hash($value);
                   3642:         my @anskeys = sort(keys(%answers));
                   3643:         if (@anskeys == 1) {
                   3644:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3645:             if ($answer =~ m{\0}) {
                   3646:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3647:             }
                   3648:             my $tag_internal_answer_name = 'INTERNAL';
                   3649:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3650:                 $value = $answer; 
                   3651:             } else {
                   3652:                 $value = $anskeys[0].'='.$answer;
                   3653:             }
                   3654:         } else {
                   3655:             foreach my $ans (@anskeys) {
                   3656:                 my $answer = $answers{$ans};
1.1001    raeburn  3657:                 if ($answer =~ m{\0}) {
                   3658:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3659:                 }
                   3660:                 $value .=  $ans.'='.$answer.'<br />';;
                   3661:             } 
                   3662:         }
1.581     albertel 3663:     } else {
                   3664: 	$value = &unescape($value);
                   3665:     }
                   3666:     return $value;
                   3667: }
                   3668: 
                   3669: 
1.107     albertel 3670: sub relative_to_absolute {
                   3671:     my ($url,$output)=@_;
                   3672:     my $parser=HTML::TokeParser->new(\$output);
                   3673:     my $token;
                   3674:     my $thisdir=$url;
                   3675:     my @rlinks=();
                   3676:     while ($token=$parser->get_token) {
                   3677: 	if ($token->[0] eq 'S') {
                   3678: 	    if ($token->[1] eq 'a') {
                   3679: 		if ($token->[2]->{'href'}) {
                   3680: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3681: 		}
                   3682: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3683: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3684: 	    } elsif ($token->[1] eq 'base') {
                   3685: 		$thisdir=$token->[2]->{'href'};
                   3686: 	    }
                   3687: 	}
                   3688:     }
                   3689:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3690:     foreach my $link (@rlinks) {
1.726     raeburn  3691: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3692: 		($link=~/^\//) ||
                   3693: 		($link=~/^javascript:/i) ||
                   3694: 		($link=~/^mailto:/i) ||
                   3695: 		($link=~/^\#/)) {
                   3696: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3697: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3698: 	}
                   3699:     }
                   3700: # -------------------------------------------------- Deal with Applet codebases
                   3701:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3702:     return $output;
                   3703: }
                   3704: 
1.112     bowersj2 3705: =pod
                   3706: 
1.648     raeburn  3707: =item * &get_student_view()
1.112     bowersj2 3708: 
                   3709: show a snapshot of what student was looking at
                   3710: 
                   3711: =cut
                   3712: 
1.10      albertel 3713: sub get_student_view {
1.186     albertel 3714:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3715:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3716:   my (%form);
1.10      albertel 3717:   my @elements=('symb','courseid','domain','username');
                   3718:   foreach my $element (@elements) {
1.186     albertel 3719:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3720:   }
1.186     albertel 3721:   if (defined($moreenv)) {
                   3722:       %form=(%form,%{$moreenv});
                   3723:   }
1.236     albertel 3724:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3725:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3726:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3727:   $userview=~s/\<body[^\>]*\>//gi;
                   3728:   $userview=~s/\<\/body\>//gi;
                   3729:   $userview=~s/\<html\>//gi;
                   3730:   $userview=~s/\<\/html\>//gi;
                   3731:   $userview=~s/\<head\>//gi;
                   3732:   $userview=~s/\<\/head\>//gi;
                   3733:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3734:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3735:   if (wantarray) {
                   3736:      return ($userview,$response);
                   3737:   } else {
                   3738:      return $userview;
                   3739:   }
                   3740: }
                   3741: 
                   3742: sub get_student_view_with_retries {
                   3743:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3744: 
                   3745:     my $ok = 0;                 # True if we got a good response.
                   3746:     my $content;
                   3747:     my $response;
                   3748: 
                   3749:     # Try to get the student_view done. within the retries count:
                   3750:     
                   3751:     do {
                   3752:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3753:          $ok      = $response->is_success;
                   3754:          if (!$ok) {
                   3755:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3756:          }
                   3757:          $retries--;
                   3758:     } while (!$ok && ($retries > 0));
                   3759:     
                   3760:     if (!$ok) {
                   3761:        $content = '';          # On error return an empty content.
                   3762:     }
1.651     www      3763:     if (wantarray) {
                   3764:        return ($content, $response);
                   3765:     } else {
                   3766:        return $content;
                   3767:     }
1.11      albertel 3768: }
                   3769: 
1.112     bowersj2 3770: =pod
                   3771: 
1.648     raeburn  3772: =item * &get_student_answers() 
1.112     bowersj2 3773: 
                   3774: show a snapshot of how student was answering problem
                   3775: 
                   3776: =cut
                   3777: 
1.11      albertel 3778: sub get_student_answers {
1.100     sakharuk 3779:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3780:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3781:   my (%moreenv);
1.11      albertel 3782:   my @elements=('symb','courseid','domain','username');
                   3783:   foreach my $element (@elements) {
1.186     albertel 3784:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3785:   }
1.186     albertel 3786:   $moreenv{'grade_target'}='answer';
                   3787:   %moreenv=(%form,%moreenv);
1.497     raeburn  3788:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3789:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3790:   return $userview;
1.1       albertel 3791: }
1.116     albertel 3792: 
                   3793: =pod
                   3794: 
                   3795: =item * &submlink()
                   3796: 
1.242     albertel 3797: Inputs: $text $uname $udom $symb $target
1.116     albertel 3798: 
                   3799: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3800: 
                   3801: =cut
                   3802: 
                   3803: ###############################################
                   3804: sub submlink {
1.242     albertel 3805:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3806:     if (!($uname && $udom)) {
                   3807: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3808: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3809: 	if (!$symb) { $symb=$cursymb; }
                   3810:     }
1.254     matthew  3811:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3812:     $symb=&escape($symb);
1.960     bisitz   3813:     if ($target) { $target=" target=\"$target\""; }
                   3814:     return
                   3815:         '<a href="/adm/grades?command=submission'.
                   3816:         '&amp;symb='.$symb.
                   3817:         '&amp;student='.$uname.
                   3818:         '&amp;userdom='.$udom.'"'.
                   3819:         $target.'>'.$text.'</a>';
1.242     albertel 3820: }
                   3821: ##############################################
                   3822: 
                   3823: =pod
                   3824: 
                   3825: =item * &pgrdlink()
                   3826: 
                   3827: Inputs: $text $uname $udom $symb $target
                   3828: 
                   3829: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3830: 
                   3831: =cut
                   3832: 
                   3833: ###############################################
                   3834: sub pgrdlink {
                   3835:     my $link=&submlink(@_);
                   3836:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3837:     return $link;
                   3838: }
                   3839: ##############################################
                   3840: 
                   3841: =pod
                   3842: 
                   3843: =item * &pprmlink()
                   3844: 
                   3845: Inputs: $text $uname $udom $symb $target
                   3846: 
                   3847: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3848: student and a specific resource
1.242     albertel 3849: 
                   3850: =cut
                   3851: 
                   3852: ###############################################
                   3853: sub pprmlink {
                   3854:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3855:     if (!($uname && $udom)) {
                   3856: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3857: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3858: 	if (!$symb) { $symb=$cursymb; }
                   3859:     }
1.254     matthew  3860:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3861:     $symb=&escape($symb);
1.242     albertel 3862:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3863:     return '<a href="/adm/parmset?command=set&amp;'.
                   3864: 	'symb='.$symb.'&amp;uname='.$uname.
                   3865: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3866: }
                   3867: ##############################################
1.37      matthew  3868: 
1.112     bowersj2 3869: =pod
                   3870: 
                   3871: =back
                   3872: 
                   3873: =cut
                   3874: 
1.37      matthew  3875: ###############################################
1.51      www      3876: 
                   3877: 
                   3878: sub timehash {
1.687     raeburn  3879:     my ($thistime) = @_;
                   3880:     my $timezone = &Apache::lonlocal::gettimezone();
                   3881:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3882:                      ->set_time_zone($timezone);
                   3883:     my $wday = $dt->day_of_week();
                   3884:     if ($wday == 7) { $wday = 0; }
                   3885:     return ( 'second' => $dt->second(),
                   3886:              'minute' => $dt->minute(),
                   3887:              'hour'   => $dt->hour(),
                   3888:              'day'     => $dt->day_of_month(),
                   3889:              'month'   => $dt->month(),
                   3890:              'year'    => $dt->year(),
                   3891:              'weekday' => $wday,
                   3892:              'dayyear' => $dt->day_of_year(),
                   3893:              'dlsav'   => $dt->is_dst() );
1.51      www      3894: }
                   3895: 
1.370     www      3896: sub utc_string {
                   3897:     my ($date)=@_;
1.371     www      3898:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3899: }
                   3900: 
1.51      www      3901: sub maketime {
                   3902:     my %th=@_;
1.687     raeburn  3903:     my ($epoch_time,$timezone,$dt);
                   3904:     $timezone = &Apache::lonlocal::gettimezone();
                   3905:     eval {
                   3906:         $dt = DateTime->new( year   => $th{'year'},
                   3907:                              month  => $th{'month'},
                   3908:                              day    => $th{'day'},
                   3909:                              hour   => $th{'hour'},
                   3910:                              minute => $th{'minute'},
                   3911:                              second => $th{'second'},
                   3912:                              time_zone => $timezone,
                   3913:                          );
                   3914:     };
                   3915:     if (!$@) {
                   3916:         $epoch_time = $dt->epoch;
                   3917:         if ($epoch_time) {
                   3918:             return $epoch_time;
                   3919:         }
                   3920:     }
1.51      www      3921:     return POSIX::mktime(
                   3922:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3923:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3924: }
                   3925: 
                   3926: #########################################
1.51      www      3927: 
                   3928: sub findallcourses {
1.482     raeburn  3929:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3930:     my %roles;
                   3931:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3932:     my %courses;
1.51      www      3933:     my $now=time;
1.482     raeburn  3934:     if (!defined($uname)) {
                   3935:         $uname = $env{'user.name'};
                   3936:     }
                   3937:     if (!defined($udom)) {
                   3938:         $udom = $env{'user.domain'};
                   3939:     }
                   3940:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.982     raeburn  3941:         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   3942:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
                   3943:                                               $extra);
1.482     raeburn  3944:         if (!%roles) {
                   3945:             %roles = (
                   3946:                        cc => 1,
1.907     raeburn  3947:                        co => 1,
1.482     raeburn  3948:                        in => 1,
                   3949:                        ep => 1,
                   3950:                        ta => 1,
                   3951:                        cr => 1,
                   3952:                        st => 1,
                   3953:              );
                   3954:         }
                   3955:         foreach my $entry (keys(%roleshash)) {
                   3956:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3957:             if ($trole =~ /^cr/) { 
                   3958:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3959:             } else {
                   3960:                 next if (!exists($roles{$trole}));
                   3961:             }
                   3962:             if ($tend) {
                   3963:                 next if ($tend < $now);
                   3964:             }
                   3965:             if ($tstart) {
                   3966:                 next if ($tstart > $now);
                   3967:             }
                   3968:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3969:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3970:             if ($secpart eq '') {
                   3971:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3972:                 $sec = 'none';
                   3973:                 $realsec = '';
                   3974:             } else {
                   3975:                 $cnum = $cnumpart;
                   3976:                 ($sec,$role) = split(/_/,$secpart);
                   3977:                 $realsec = $sec;
1.490     raeburn  3978:             }
1.482     raeburn  3979:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3980:         }
                   3981:     } else {
                   3982:         foreach my $key (keys(%env)) {
1.483     albertel 3983: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3984:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3985: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3986: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3987: 	        next if (%roles && !exists($roles{$role}));
                   3988: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3989:                 my $active=1;
                   3990:                 if ($starttime) {
                   3991: 		    if ($now<$starttime) { $active=0; }
                   3992:                 }
                   3993:                 if ($endtime) {
                   3994:                     if ($now>$endtime) { $active=0; }
                   3995:                 }
                   3996:                 if ($active) {
                   3997:                     if ($sec eq '') {
                   3998:                         $sec = 'none';
                   3999:                     }
                   4000:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   4001:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  4002:                 }
                   4003:             }
1.51      www      4004:         }
                   4005:     }
1.474     raeburn  4006:     return %courses;
1.51      www      4007: }
1.37      matthew  4008: 
1.54      www      4009: ###############################################
1.474     raeburn  4010: 
                   4011: sub blockcheck {
1.482     raeburn  4012:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  4013: 
                   4014:     if (!defined($udom)) {
                   4015:         $udom = $env{'user.domain'};
                   4016:     }
                   4017:     if (!defined($uname)) {
                   4018:         $uname = $env{'user.name'};
                   4019:     }
                   4020: 
                   4021:     # If uname and udom are for a course, check for blocks in the course.
                   4022: 
                   4023:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   4024:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  4025:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  4026:         return ($startblock,$endblock);
                   4027:     }
1.474     raeburn  4028: 
1.502     raeburn  4029:     my $startblock = 0;
                   4030:     my $endblock = 0;
1.482     raeburn  4031:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4032: 
1.490     raeburn  4033:     # If uname is for a user, and activity is course-specific, i.e.,
                   4034:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4035: 
1.490     raeburn  4036:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4037:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4038:         foreach my $key (keys(%live_courses)) {
                   4039:             if ($key ne $env{'request.course.id'}) {
                   4040:                 delete($live_courses{$key});
                   4041:             }
                   4042:         }
                   4043:     }
                   4044: 
                   4045:     my $otheruser = 0;
                   4046:     my %own_courses;
                   4047:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4048:         # Resource belongs to user other than current user.
                   4049:         $otheruser = 1;
                   4050:         # Gather courses for current user
                   4051:         %own_courses = 
                   4052:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4053:     }
                   4054: 
                   4055:     # Gather active course roles - course coordinator, instructor, 
                   4056:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4057: 
                   4058:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4059:         my ($cdom,$cnum);
                   4060:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4061:             $cdom = $env{'course.'.$course.'.domain'};
                   4062:             $cnum = $env{'course.'.$course.'.num'};
                   4063:         } else {
1.490     raeburn  4064:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4065:         }
                   4066:         my $no_ownblock = 0;
                   4067:         my $no_userblock = 0;
1.533     raeburn  4068:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4069:             # Check if current user has 'evb' priv for this
                   4070:             if (defined($own_courses{$course})) {
                   4071:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4072:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4073:                     if ($sec ne 'none') {
                   4074:                         $checkrole .= '/'.$sec;
                   4075:                     }
                   4076:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4077:                         $no_ownblock = 1;
                   4078:                         last;
                   4079:                     }
                   4080:                 }
                   4081:             }
                   4082:             # if they have 'evb' priv and are currently not playing student
                   4083:             next if (($no_ownblock) &&
                   4084:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4085:         }
1.474     raeburn  4086:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4087:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4088:             if ($sec ne 'none') {
1.482     raeburn  4089:                 $checkrole .= '/'.$sec;
1.474     raeburn  4090:             }
1.490     raeburn  4091:             if ($otheruser) {
                   4092:                 # Resource belongs to user other than current user.
                   4093:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  4094:                 my ($trole,$tdom,$tnum,$tsec);
                   4095:                 my $entry = $live_courses{$course}{$sec};
                   4096:                 if ($entry =~ /^cr/) {
                   4097:                     ($trole,$tdom,$tnum,$tsec) = 
                   4098:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4099:                 } else {
                   4100:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4101:                 }
                   4102:                 my ($spec,$area,$trest,%allroles,%userroles);
                   4103:                 $area = '/'.$tdom.'/'.$tnum;
                   4104:                 $trest = $tnum;
                   4105:                 if ($tsec ne '') {
                   4106:                     $area .= '/'.$tsec;
                   4107:                     $trest .= '/'.$tsec;
                   4108:                 }
                   4109:                 $spec = $trole.'.'.$area;
                   4110:                 if ($trole =~ /^cr/) {
                   4111:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4112:                                                       $tdom,$spec,$trest,$area);
                   4113:                 } else {
                   4114:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4115:                                                        $tdom,$spec,$trest,$area);
                   4116:                 }
                   4117:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  4118:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4119:                     if ($1) {
                   4120:                         $no_userblock = 1;
                   4121:                         last;
                   4122:                     }
                   4123:                 }
1.490     raeburn  4124:             } else {
                   4125:                 # Resource belongs to current user
                   4126:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4127:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4128:                     $no_ownblock = 1;
                   4129:                     last;
                   4130:                 }
1.474     raeburn  4131:             }
                   4132:         }
                   4133:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4134:         next if (($no_ownblock) &&
1.491     albertel 4135:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4136:         next if ($no_userblock);
1.474     raeburn  4137: 
1.866     kalberla 4138:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4139:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4140:         
                   4141:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   4142:         if (($start != 0) && 
                   4143:             (($startblock == 0) || ($startblock > $start))) {
                   4144:             $startblock = $start;
                   4145:         }
                   4146:         if (($end != 0)  &&
                   4147:             (($endblock == 0) || ($endblock < $end))) {
                   4148:             $endblock = $end;
                   4149:         }
1.490     raeburn  4150:     }
                   4151:     return ($startblock,$endblock);
                   4152: }
                   4153: 
                   4154: sub get_blocks {
                   4155:     my ($setters,$activity,$cdom,$cnum) = @_;
                   4156:     my $startblock = 0;
                   4157:     my $endblock = 0;
                   4158:     my $course = $cdom.'_'.$cnum;
                   4159:     $setters->{$course} = {};
                   4160:     $setters->{$course}{'staff'} = [];
                   4161:     $setters->{$course}{'times'} = [];
                   4162:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   4163:     foreach my $record (keys(%records)) {
                   4164:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   4165:         if ($start <= time && $end >= time) {
                   4166:             my ($staff_name,$staff_dom,$title,$blocks) =
                   4167:                 &parse_block_record($records{$record});
                   4168:             if ($blocks->{$activity} eq 'on') {
                   4169:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4170:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 4171:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   4172:                     $startblock = $start;
1.490     raeburn  4173:                 }
1.491     albertel 4174:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   4175:                     $endblock = $end;
1.474     raeburn  4176:                 }
                   4177:             }
                   4178:         }
                   4179:     }
                   4180:     return ($startblock,$endblock);
                   4181: }
                   4182: 
                   4183: sub parse_block_record {
                   4184:     my ($record) = @_;
                   4185:     my ($setuname,$setudom,$title,$blocks);
                   4186:     if (ref($record) eq 'HASH') {
                   4187:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4188:         $title = &unescape($record->{'event'});
                   4189:         $blocks = $record->{'blocks'};
                   4190:     } else {
                   4191:         my @data = split(/:/,$record,3);
                   4192:         if (scalar(@data) eq 2) {
                   4193:             $title = $data[1];
                   4194:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4195:         } else {
                   4196:             ($setuname,$setudom,$title) = @data;
                   4197:         }
                   4198:         $blocks = { 'com' => 'on' };
                   4199:     }
                   4200:     return ($setuname,$setudom,$title,$blocks);
                   4201: }
                   4202: 
1.854     kalberla 4203: sub blocking_status {
                   4204:   my ($activity,$uname,$udom) = @_;
1.867     kalberla 4205:   my %setters;
1.890     droeschl 4206: 
                   4207:   # check for active blocking
1.867     kalberla 4208:   my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854     kalberla 4209: 
1.890     droeschl 4210:   my $blocked = $startblock && $endblock ? 1 : 0;
                   4211: 
                   4212:   # caller just wants to know whether a block is active
                   4213:   if (!wantarray) { return $blocked; }
                   4214: 
                   4215:   # build a link to a popup window containing the details
                   4216:   my $querystring  = "?activity=$activity";
                   4217:   # $uname and $udom decide whose portfolio the user is trying to look at
                   4218:      $querystring .= "&amp;udom=$udom"      if $udom;
                   4219:      $querystring .= "&amp;uname=$uname"    if $uname;
                   4220: 
                   4221:   my $output .= <<'END_MYBLOCK';
1.854     kalberla 4222:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4223:         var options = "width=" + w + ",height=" + h + ",";
                   4224:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4225:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4226:         var newWin = window.open(url, wdwName, options);
                   4227:         newWin.focus();
                   4228:     }
1.890     droeschl 4229: END_MYBLOCK
1.854     kalberla 4230: 
1.890     droeschl 4231:   $output = Apache::lonhtmlcommon::scripttag($output);
                   4232:   
1.854     kalberla 4233:   my $popupUrl = "/adm/blockingstatus/$querystring";
1.890     droeschl 4234:   my $text = mt('Communication Blocked');
                   4235: 
1.867     kalberla 4236:   $output .= <<"END_BLOCK";
                   4237: <div class='LC_comblock'>
1.869     kalberla 4238:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4239:   title='$text'>
                   4240:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4241:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4242:   title='$text'>$text</a>
1.867     kalberla 4243: </div>
                   4244: 
                   4245: END_BLOCK
1.474     raeburn  4246: 
1.854     kalberla 4247:   return ($blocked, $output);
                   4248: }
1.490     raeburn  4249: 
1.60      matthew  4250: ###############################################
                   4251: 
1.682     raeburn  4252: sub check_ip_acc {
                   4253:     my ($acc)=@_;
                   4254:     &Apache::lonxml::debug("acc is $acc");
                   4255:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4256:         return 1;
                   4257:     }
                   4258:     my $allowed=0;
                   4259:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4260: 
                   4261:     my $name;
                   4262:     foreach my $pattern (split(',',$acc)) {
                   4263:         $pattern =~ s/^\s*//;
                   4264:         $pattern =~ s/\s*$//;
                   4265:         if ($pattern =~ /\*$/) {
                   4266:             #35.8.*
                   4267:             $pattern=~s/\*//;
                   4268:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4269:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4270:             #35.8.3.[34-56]
                   4271:             my $low=$2;
                   4272:             my $high=$3;
                   4273:             $pattern=$1;
                   4274:             if ($ip =~ /^\Q$pattern\E/) {
                   4275:                 my $last=(split(/\./,$ip))[3];
                   4276:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4277:             }
                   4278:         } elsif ($pattern =~ /^\*/) {
                   4279:             #*.msu.edu
                   4280:             $pattern=~s/\*//;
                   4281:             if (!defined($name)) {
                   4282:                 use Socket;
                   4283:                 my $netaddr=inet_aton($ip);
                   4284:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4285:             }
                   4286:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4287:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4288:             #127.0.0.1
                   4289:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4290:         } else {
                   4291:             #some.name.com
                   4292:             if (!defined($name)) {
                   4293:                 use Socket;
                   4294:                 my $netaddr=inet_aton($ip);
                   4295:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4296:             }
                   4297:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4298:         }
                   4299:         if ($allowed) { last; }
                   4300:     }
                   4301:     return $allowed;
                   4302: }
                   4303: 
                   4304: ###############################################
                   4305: 
1.60      matthew  4306: =pod
                   4307: 
1.112     bowersj2 4308: =head1 Domain Template Functions
                   4309: 
                   4310: =over 4
                   4311: 
                   4312: =item * &determinedomain()
1.60      matthew  4313: 
                   4314: Inputs: $domain (usually will be undef)
                   4315: 
1.63      www      4316: Returns: Determines which domain should be used for designs
1.60      matthew  4317: 
                   4318: =cut
1.54      www      4319: 
1.60      matthew  4320: ###############################################
1.63      www      4321: sub determinedomain {
                   4322:     my $domain=shift;
1.531     albertel 4323:     if (! $domain) {
1.60      matthew  4324:         # Determine domain if we have not been given one
1.893     raeburn  4325:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4326:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4327:         if ($env{'request.role.domain'}) { 
                   4328:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4329:         }
                   4330:     }
1.63      www      4331:     return $domain;
                   4332: }
                   4333: ###############################################
1.517     raeburn  4334: 
1.518     albertel 4335: sub devalidate_domconfig_cache {
                   4336:     my ($udom)=@_;
                   4337:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4338: }
                   4339: 
                   4340: # ---------------------- Get domain configuration for a domain
                   4341: sub get_domainconf {
                   4342:     my ($udom) = @_;
                   4343:     my $cachetime=1800;
                   4344:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4345:     if (defined($cached)) { return %{$result}; }
                   4346: 
                   4347:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4348: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4349:     my (%designhash,%legacy);
1.518     albertel 4350:     if (keys(%domconfig) > 0) {
                   4351:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4352:             if (keys(%{$domconfig{'login'}})) {
                   4353:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4354:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4355:                         if ($key eq 'loginvia') {
                   4356:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4357:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4358:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4359:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4360:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4361:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4362:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4363: 
                   4364:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4365:                                             } else {
1.1013    raeburn  4366:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4367:                                             }
                   4368:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4369:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4370:                                             }
1.946     raeburn  4371:                                         }
                   4372:                                     }
                   4373:                                 }
                   4374:                             }
                   4375:                         } else {
                   4376:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4377:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4378:                                     $domconfig{'login'}{$key}{$img};
                   4379:                             }
1.699     raeburn  4380:                         }
                   4381:                     } else {
                   4382:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4383:                     }
1.632     raeburn  4384:                 }
                   4385:             } else {
                   4386:                 $legacy{'login'} = 1;
1.518     albertel 4387:             }
1.632     raeburn  4388:         } else {
                   4389:             $legacy{'login'} = 1;
1.518     albertel 4390:         }
                   4391:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4392:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4393:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4394:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4395:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4396:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4397:                         }
1.518     albertel 4398:                     }
                   4399:                 }
1.632     raeburn  4400:             } else {
                   4401:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4402:             }
1.632     raeburn  4403:         } else {
                   4404:             $legacy{'rolecolors'} = 1;
1.518     albertel 4405:         }
1.948     raeburn  4406:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4407:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4408:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4409:             }
                   4410:         }
1.632     raeburn  4411:         if (keys(%legacy) > 0) {
                   4412:             my %legacyhash = &get_legacy_domconf($udom);
                   4413:             foreach my $item (keys(%legacyhash)) {
                   4414:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4415:                     if ($legacy{'login'}) { 
                   4416:                         $designhash{$item} = $legacyhash{$item};
                   4417:                     }
                   4418:                 } else {
                   4419:                     if ($legacy{'rolecolors'}) {
                   4420:                         $designhash{$item} = $legacyhash{$item};
                   4421:                     }
1.518     albertel 4422:                 }
                   4423:             }
                   4424:         }
1.632     raeburn  4425:     } else {
                   4426:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4427:     }
                   4428:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4429: 				  $cachetime);
                   4430:     return %designhash;
                   4431: }
                   4432: 
1.632     raeburn  4433: sub get_legacy_domconf {
                   4434:     my ($udom) = @_;
                   4435:     my %legacyhash;
                   4436:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4437:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4438:     if (-e $designfile) {
                   4439:         if ( open (my $fh,"<$designfile") ) {
                   4440:             while (my $line = <$fh>) {
                   4441:                 next if ($line =~ /^\#/);
                   4442:                 chomp($line);
                   4443:                 my ($key,$val)=(split(/\=/,$line));
                   4444:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4445:             }
                   4446:             close($fh);
                   4447:         }
                   4448:     }
1.1026    raeburn  4449:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4450:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4451:     }
                   4452:     return %legacyhash;
                   4453: }
                   4454: 
1.63      www      4455: =pod
                   4456: 
1.112     bowersj2 4457: =item * &domainlogo()
1.63      www      4458: 
                   4459: Inputs: $domain (usually will be undef)
                   4460: 
                   4461: Returns: A link to a domain logo, if the domain logo exists.
                   4462: If the domain logo does not exist, a description of the domain.
                   4463: 
                   4464: =cut
1.112     bowersj2 4465: 
1.63      www      4466: ###############################################
                   4467: sub domainlogo {
1.517     raeburn  4468:     my $domain = &determinedomain(shift);
1.518     albertel 4469:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4470:     # See if there is a logo
                   4471:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4472:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4473:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4474: 	    if ($imgsrc =~ m{^/res/}) {
                   4475: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4476: 		&Apache::lonnet::repcopy($local_name);
                   4477: 	    }
                   4478: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4479:         } 
                   4480:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4481:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4482:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4483:     } else {
1.60      matthew  4484:         return '';
1.59      www      4485:     }
                   4486: }
1.63      www      4487: ##############################################
                   4488: 
                   4489: =pod
                   4490: 
1.112     bowersj2 4491: =item * &designparm()
1.63      www      4492: 
                   4493: Inputs: $which parameter; $domain (usually will be undef)
                   4494: 
                   4495: Returns: value of designparamter $which
                   4496: 
                   4497: =cut
1.112     bowersj2 4498: 
1.397     albertel 4499: 
1.400     albertel 4500: ##############################################
1.397     albertel 4501: sub designparm {
                   4502:     my ($which,$domain)=@_;
                   4503:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4504:         return $env{'environment.color.'.$which};
1.96      www      4505:     }
1.63      www      4506:     $domain=&determinedomain($domain);
1.1016    raeburn  4507:     my %domdesign;
                   4508:     unless ($domain eq 'public') {
                   4509:         %domdesign = &get_domainconf($domain);
                   4510:     }
1.520     raeburn  4511:     my $output;
1.517     raeburn  4512:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4513:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4514:     } else {
1.520     raeburn  4515:         $output = $defaultdesign{$which};
                   4516:     }
                   4517:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4518:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4519:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4520:             if ($output =~ m{^/res/}) {
                   4521:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4522:                 &Apache::lonnet::repcopy($local_name);
                   4523:             }
1.520     raeburn  4524:             $output = &lonhttpdurl($output);
                   4525:         }
1.63      www      4526:     }
1.520     raeburn  4527:     return $output;
1.63      www      4528: }
1.59      www      4529: 
1.822     bisitz   4530: ##############################################
                   4531: =pod
                   4532: 
1.832     bisitz   4533: =item * &authorspace()
                   4534: 
1.1028    raeburn  4535: Inputs: $url (usually will be undef).
1.832     bisitz   4536: 
1.1028    raeburn  4537: Returns: Path to Construction Space containing the resource or 
                   4538:          directory being viewed (or for which action is being taken). 
                   4539:          If $url is provided, and begins /priv/<domain>/<uname>
                   4540:          the path will be that portion of the $context argument.
                   4541:          Otherwise the path will be for the author space of the current
                   4542:          user when the current role is author, or for that of the 
                   4543:          co-author/assistant co-author space when the current role 
                   4544:          is co-author or assistant co-author.
1.832     bisitz   4545: 
                   4546: =cut
                   4547: 
                   4548: sub authorspace {
1.1028    raeburn  4549:     my ($url) = @_;
                   4550:     if ($url ne '') {
                   4551:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4552:            return $1;
                   4553:         }
                   4554:     }
1.832     bisitz   4555:     my $caname = '';
1.1024    www      4556:     my $cadom = '';
1.1028    raeburn  4557:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4558:         ($cadom,$caname) =
1.832     bisitz   4559:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4560:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4561:         $caname = $env{'user.name'};
1.1024    www      4562:         $cadom = $env{'user.domain'};
1.832     bisitz   4563:     }
1.1028    raeburn  4564:     if (($caname ne '') && ($cadom ne '')) {
                   4565:         return "/priv/$cadom/$caname/";
                   4566:     }
                   4567:     return;
1.832     bisitz   4568: }
                   4569: 
                   4570: ##############################################
                   4571: =pod
                   4572: 
1.822     bisitz   4573: =item * &head_subbox()
                   4574: 
                   4575: Inputs: $content (contains HTML code with page functions, etc.)
                   4576: 
                   4577: Returns: HTML div with $content
                   4578:          To be included in page header
                   4579: 
                   4580: =cut
                   4581: 
                   4582: sub head_subbox {
                   4583:     my ($content)=@_;
                   4584:     my $output =
1.993     raeburn  4585:         '<div class="LC_head_subbox">'
1.822     bisitz   4586:        .$content
                   4587:        .'</div>'
                   4588: }
                   4589: 
                   4590: ##############################################
                   4591: =pod
                   4592: 
                   4593: =item * &CSTR_pageheader()
                   4594: 
1.1026    raeburn  4595: Input: (optional) filename from which breadcrumb trail is built.
                   4596:        In most cases no input as needed, as $env{'request.filename'}
                   4597:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4598: 
                   4599: Returns: HTML div with CSTR path and recent box
                   4600:          To be included on Construction Space pages
                   4601: 
                   4602: =cut
                   4603: 
                   4604: sub CSTR_pageheader {
1.1026    raeburn  4605:     my ($trailfile) = @_;
                   4606:     if ($trailfile eq '') {
                   4607:         $trailfile = $env{'request.filename'};
                   4608:     }
                   4609: 
                   4610: # this is for resources; directories have customtitle, and crumbs
                   4611: # and select recent are created in lonpubdir.pm
                   4612: 
                   4613:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4614:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4615:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4616:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4617:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4618: 
                   4619:     my $parentpath = '';
                   4620:     my $lastitem = '';
                   4621:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4622:         $parentpath = $1;
                   4623:         $lastitem = $2;
                   4624:     } else {
                   4625:         $lastitem = $thisdisfn;
                   4626:     }
1.921     bisitz   4627: 
                   4628:     my $output =
1.822     bisitz   4629:          '<div>'
                   4630:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4631:         .'<b>'.&mt('Construction Space:').'</b> '
                   4632:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4633:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4634:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4635: 
                   4636:     if ($lastitem) {
                   4637:         $output .=
                   4638:              '<span class="LC_filename">'
                   4639:             .$lastitem
                   4640:             .'</span>';
                   4641:     }
                   4642:     $output .=
                   4643:          '<br />'
1.822     bisitz   4644:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4645:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4646:         .'</form>'
                   4647:         .&Apache::lonmenu::constspaceform()
                   4648:         .'</div>';
1.921     bisitz   4649: 
                   4650:     return $output;
1.822     bisitz   4651: }
                   4652: 
1.60      matthew  4653: ###############################################
                   4654: ###############################################
                   4655: 
                   4656: =pod
                   4657: 
1.112     bowersj2 4658: =back
                   4659: 
1.549     albertel 4660: =head1 HTML Helpers
1.112     bowersj2 4661: 
                   4662: =over 4
                   4663: 
                   4664: =item * &bodytag()
1.60      matthew  4665: 
                   4666: Returns a uniform header for LON-CAPA web pages.
                   4667: 
                   4668: Inputs: 
                   4669: 
1.112     bowersj2 4670: =over 4
                   4671: 
                   4672: =item * $title, A title to be displayed on the page.
                   4673: 
                   4674: =item * $function, the current role (can be undef).
                   4675: 
                   4676: =item * $addentries, extra parameters for the <body> tag.
                   4677: 
                   4678: =item * $bodyonly, if defined, only return the <body> tag.
                   4679: 
                   4680: =item * $domain, if defined, force a given domain.
                   4681: 
                   4682: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4683:             text interface only)
1.60      matthew  4684: 
1.814     bisitz   4685: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4686:                      navigational links
1.317     albertel 4687: 
1.338     albertel 4688: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4689: 
1.460     albertel 4690: =item * $args, optional argument valid values are
                   4691:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4692:             inherit_jsmath -> when creating popup window in a page,
                   4693:                               should it have jsmath forced on by the
                   4694:                               current page
1.460     albertel 4695: 
1.112     bowersj2 4696: =back
                   4697: 
1.60      matthew  4698: Returns: A uniform header for LON-CAPA web pages.  
                   4699: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4700: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4701: other decorations will be returned.
                   4702: 
                   4703: =cut
                   4704: 
1.54      www      4705: sub bodytag {
1.831     bisitz   4706:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962     droeschl 4707:         $no_nav_bar,$bgcolor,$args)=@_;
1.339     albertel 4708: 
1.954     raeburn  4709:     my $public;
                   4710:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4711:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4712:         $public = 1;
                   4713:     }
1.460     albertel 4714:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4715: 
1.183     matthew  4716:     $function = &get_users_function() if (!$function);
1.339     albertel 4717:     my $img =    &designparm($function.'.img',$domain);
                   4718:     my $font =   &designparm($function.'.font',$domain);
                   4719:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4720: 
1.803     bisitz   4721:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 4722: 		   'bgcolor' => $pgbg,
1.339     albertel 4723: 		   'text'    => $font,
                   4724:                    'alink'   => &designparm($function.'.alink',$domain),
                   4725: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4726: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4727:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4728: 
1.63      www      4729:  # role and realm
1.378     raeburn  4730:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4731:     if ($role  eq 'ca') {
1.479     albertel 4732:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4733:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4734:     } 
1.55      www      4735: # realm
1.258     albertel 4736:     if ($env{'request.course.id'}) {
1.378     raeburn  4737:         if ($env{'request.role'} !~ /^cr/) {
                   4738:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4739:         }
1.898     raeburn  4740:         if ($env{'request.course.sec'}) {
                   4741:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   4742:         }   
1.359     albertel 4743: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4744:     } else {
                   4745:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4746:     }
1.433     albertel 4747: 
1.359     albertel 4748:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 4749: 
1.438     albertel 4750:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4751: 
1.101     www      4752: # construct main body tag
1.359     albertel 4753:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4754: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4755: 
1.530     albertel 4756:     if ($bodyonly) {
1.60      matthew  4757:         return $bodytag;
1.798     tempelho 4758:     } 
1.359     albertel 4759: 
1.410     albertel 4760:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  4761:     if ($public) {
1.433     albertel 4762: 	undef($role);
1.434     albertel 4763:     } else {
                   4764: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 4765:     }
1.359     albertel 4766:     
1.762     bisitz   4767:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 4768:     #
                   4769:     # Extra info if you are the DC
                   4770:     my $dc_info = '';
                   4771:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4772:                         $env{'course.'.$env{'request.course.id'}.
                   4773:                                  '.domain'}.'/'})) {
                   4774:         my $cid = $env{'request.course.id'};
1.917     raeburn  4775:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4776:         $dc_info =~ s/\s+$//;
1.359     albertel 4777:     }
                   4778: 
1.898     raeburn  4779:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 4780:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   4781: 
1.916     droeschl 4782:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   4783:             return $bodytag; 
                   4784:         } 
1.903     droeschl 4785: 
                   4786:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   4787: 
                   4788:         #    if ($env{'request.state'} eq 'construct') {
                   4789:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   4790:         #    }
                   4791: 
1.359     albertel 4792: 
                   4793: 
1.916     droeschl 4794:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  4795:              if ($dc_info) {
                   4796:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   4797:              }
1.916     droeschl 4798:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   4799:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 4800:             return $bodytag;
                   4801:         }
1.894     droeschl 4802: 
1.927     raeburn  4803:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   4804:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   4805:         }
1.916     droeschl 4806: 
1.903     droeschl 4807:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   4808:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   4809: 
1.903     droeschl 4810:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 4811: 
1.917     raeburn  4812:         if ($dc_info) {
                   4813:             $dc_info = &dc_courseid_toggle($dc_info);
                   4814:         }
                   4815:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 4816: 
1.903     droeschl 4817:         #don't show menus for public users
1.954     raeburn  4818:         if (!$public){
1.903     droeschl 4819:             $bodytag .= Apache::lonmenu::secondary_menu();
                   4820:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  4821:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   4822:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 4823:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  4824:                                 $args->{'bread_crumbs'});
                   4825:             } elsif ($forcereg) { 
                   4826:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   4827:             }
1.903     droeschl 4828:         }else{
                   4829:             # this is to seperate menu from content when there's no secondary
                   4830:             # menu. Especially needed for public accessible ressources.
                   4831:             $bodytag .= '<hr style="clear:both" />';
                   4832:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  4833:         }
1.903     droeschl 4834: 
1.235     raeburn  4835:         return $bodytag;
1.182     matthew  4836: }
                   4837: 
1.917     raeburn  4838: sub dc_courseid_toggle {
                   4839:     my ($dc_info) = @_;
1.980     raeburn  4840:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.917     raeburn  4841:            '<a href="javascript:showCourseID();">'.
                   4842:            &mt('(More ...)').'</a></span>'.
                   4843:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   4844: }
                   4845: 
1.330     albertel 4846: sub make_attr_string {
                   4847:     my ($register,$attr_ref) = @_;
                   4848: 
                   4849:     if ($attr_ref && !ref($attr_ref)) {
                   4850: 	die("addentries Must be a hash ref ".
                   4851: 	    join(':',caller(1))." ".
                   4852: 	    join(':',caller(0))." ");
                   4853:     }
                   4854: 
                   4855:     if ($register) {
1.339     albertel 4856: 	my ($on_load,$on_unload);
                   4857: 	foreach my $key (keys(%{$attr_ref})) {
                   4858: 	    if      (lc($key) eq 'onload') {
                   4859: 		$on_load.=$attr_ref->{$key}.';';
                   4860: 		delete($attr_ref->{$key});
                   4861: 
                   4862: 	    } elsif (lc($key) eq 'onunload') {
                   4863: 		$on_unload.=$attr_ref->{$key}.';';
                   4864: 		delete($attr_ref->{$key});
                   4865: 	    }
                   4866: 	}
1.953     droeschl 4867: 	$attr_ref->{'onload'}  = $on_load;
                   4868: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 4869:     }
1.339     albertel 4870: 
1.330     albertel 4871:     my $attr_string;
                   4872:     foreach my $attr (keys(%$attr_ref)) {
                   4873: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4874:     }
                   4875:     return $attr_string;
                   4876: }
                   4877: 
                   4878: 
1.182     matthew  4879: ###############################################
1.251     albertel 4880: ###############################################
                   4881: 
                   4882: =pod
                   4883: 
                   4884: =item * &endbodytag()
                   4885: 
                   4886: Returns a uniform footer for LON-CAPA web pages.
                   4887: 
1.635     raeburn  4888: Inputs: 1 - optional reference to an args hash
                   4889: If in the hash, key for noredirectlink has a value which evaluates to true,
                   4890: a 'Continue' link is not displayed if the page contains an
                   4891: internal redirect in the <head></head> section,
                   4892: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 4893: 
                   4894: =cut
                   4895: 
                   4896: sub endbodytag {
1.635     raeburn  4897:     my ($args) = @_;
1.251     albertel 4898:     my $endbodytag='</body>';
1.269     albertel 4899:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4900:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  4901:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   4902: 	    $endbodytag=
                   4903: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4904: 	        &mt('Continue').'</a>'.
                   4905: 	        $endbodytag;
                   4906:         }
1.315     albertel 4907:     }
1.251     albertel 4908:     return $endbodytag;
                   4909: }
                   4910: 
1.352     albertel 4911: =pod
                   4912: 
                   4913: =item * &standard_css()
                   4914: 
                   4915: Returns a style sheet
                   4916: 
                   4917: Inputs: (all optional)
                   4918:             domain         -> force to color decorate a page for a specific
                   4919:                                domain
                   4920:             function       -> force usage of a specific rolish color scheme
                   4921:             bgcolor        -> override the default page bgcolor
                   4922: 
                   4923: =cut
                   4924: 
1.343     albertel 4925: sub standard_css {
1.345     albertel 4926:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4927:     $function  = &get_users_function() if (!$function);
                   4928:     my $img    = &designparm($function.'.img',   $domain);
                   4929:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4930:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 4931:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 4932: #second colour for later usage
1.345     albertel 4933:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4934:     my $pgbg_or_bgcolor =
                   4935: 	         $bgcolor ||
1.352     albertel 4936: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4937:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4938:     my $alink  = &designparm($function.'.alink', $domain);
                   4939:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4940:     my $link   = &designparm($function.'.link',  $domain);
                   4941: 
1.602     albertel 4942:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4943:     my $mono                 = 'monospace';
1.850     bisitz   4944:     my $data_table_head      = $sidebg;
                   4945:     my $data_table_light     = '#FAFAFA';
                   4946:     my $data_table_dark      = '#F0F0F0';
1.470     banghart 4947:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4948:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4949:     my $mail_new             = '#FFBB77';
                   4950:     my $mail_new_hover       = '#DD9955';
                   4951:     my $mail_read            = '#BBBB77';
                   4952:     my $mail_read_hover      = '#999944';
                   4953:     my $mail_replied         = '#AAAA88';
                   4954:     my $mail_replied_hover   = '#888855';
                   4955:     my $mail_other           = '#99BBBB';
                   4956:     my $mail_other_hover     = '#669999';
1.391     albertel 4957:     my $table_header         = '#DDDDDD';
1.489     raeburn  4958:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   4959:     my $lg_border_color      = '#C8C8C8';
1.952     onken    4960:     my $button_hover         = '#BF2317';
1.392     albertel 4961: 
1.608     albertel 4962:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   4963:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   4964:                                              : '0 3px 0 4px';
1.448     albertel 4965: 
1.523     albertel 4966: 
1.343     albertel 4967:     return <<END;
1.947     droeschl 4968: 
                   4969: /* needed for iframe to allow 100% height in FF */
                   4970: body, html { 
                   4971:     margin: 0;
                   4972:     padding: 0 0.5%;
                   4973:     height: 99%; /* to avoid scrollbars */
                   4974: }
                   4975: 
1.795     www      4976: body {
1.911     bisitz   4977:   font-family: $sans;
                   4978:   line-height:130%;
                   4979:   font-size:0.83em;
                   4980:   color:$font;
1.795     www      4981: }
                   4982: 
1.959     onken    4983: a:focus,
                   4984: a:focus img {
1.795     www      4985:   color: red;
1.911     bisitz   4986:   background: yellow;
1.795     www      4987: }
1.698     harmsja  4988: 
1.911     bisitz   4989: form, .inline {
                   4990:   display: inline;
1.795     www      4991: }
1.721     harmsja  4992: 
1.795     www      4993: .LC_right {
1.911     bisitz   4994:   text-align:right;
1.795     www      4995: }
                   4996: 
                   4997: .LC_middle {
1.911     bisitz   4998:   vertical-align:middle;
1.795     www      4999: }
1.721     harmsja  5000: 
1.911     bisitz   5001: .LC_400Box {
                   5002:   width:400px;
                   5003: }
1.721     harmsja  5004: 
1.947     droeschl 5005: .LC_iframecontainer {
                   5006:     width: 98%;
                   5007:     margin: 0;
                   5008:     position: fixed;
                   5009:     top: 8.5em;
                   5010:     bottom: 0;
                   5011: }
                   5012: 
                   5013: .LC_iframecontainer iframe{
                   5014:     border: none;
                   5015:     width: 100%;
                   5016:     height: 100%;
                   5017: }
                   5018: 
1.778     bisitz   5019: .LC_filename {
                   5020:   font-family: $mono;
                   5021:   white-space:pre;
1.921     bisitz   5022:   font-size: 120%;
1.778     bisitz   5023: }
                   5024: 
                   5025: .LC_fileicon {
                   5026:   border: none;
                   5027:   height: 1.3em;
                   5028:   vertical-align: text-bottom;
                   5029:   margin-right: 0.3em;
                   5030:   text-decoration:none;
                   5031: }
                   5032: 
1.1008    www      5033: .LC_setting {
                   5034:   text-decoration:underline;
                   5035: }
                   5036: 
1.350     albertel 5037: .LC_error {
                   5038:   color: red;
                   5039:   font-size: larger;
                   5040: }
1.795     www      5041: 
1.457     albertel 5042: .LC_warning,
                   5043: .LC_diff_removed {
1.733     bisitz   5044:   color: red;
1.394     albertel 5045: }
1.532     albertel 5046: 
                   5047: .LC_info,
1.457     albertel 5048: .LC_success,
                   5049: .LC_diff_added {
1.350     albertel 5050:   color: green;
                   5051: }
1.795     www      5052: 
1.802     bisitz   5053: div.LC_confirm_box {
                   5054:   background-color: #FAFAFA;
                   5055:   border: 1px solid $lg_border_color;
                   5056:   margin-right: 0;
                   5057:   padding: 5px;
                   5058: }
                   5059: 
                   5060: div.LC_confirm_box .LC_error img,
                   5061: div.LC_confirm_box .LC_success img {
                   5062:   vertical-align: middle;
                   5063: }
                   5064: 
1.440     albertel 5065: .LC_icon {
1.771     droeschl 5066:   border: none;
1.790     droeschl 5067:   vertical-align: middle;
1.771     droeschl 5068: }
                   5069: 
1.543     albertel 5070: .LC_docs_spacer {
                   5071:   width: 25px;
                   5072:   height: 1px;
1.771     droeschl 5073:   border: none;
1.543     albertel 5074: }
1.346     albertel 5075: 
1.532     albertel 5076: .LC_internal_info {
1.735     bisitz   5077:   color: #999999;
1.532     albertel 5078: }
                   5079: 
1.794     www      5080: .LC_discussion {
1.911     bisitz   5081:   background: $tabbg;
                   5082:   border: 1px solid black;
                   5083:   margin: 2px;
1.794     www      5084: }
                   5085: 
                   5086: .LC_disc_action_links_bar {
1.911     bisitz   5087:   background: $tabbg;
                   5088:   border: none;
                   5089:   margin: 4px;
1.794     www      5090: }
                   5091: 
                   5092: .LC_disc_action_left {
1.911     bisitz   5093:   text-align: left;
1.794     www      5094: }
                   5095: 
                   5096: .LC_disc_action_right {
1.911     bisitz   5097:   text-align: right;
1.794     www      5098: }
                   5099: 
                   5100: .LC_disc_new_item {
1.911     bisitz   5101:   background: white;
                   5102:   border: 2px solid red;
                   5103:   margin: 2px;
1.794     www      5104: }
                   5105: 
                   5106: .LC_disc_old_item {
1.911     bisitz   5107:   background: white;
                   5108:   border: 1px solid black;
                   5109:   margin: 2px;
1.794     www      5110: }
                   5111: 
1.458     albertel 5112: table.LC_pastsubmission {
                   5113:   border: 1px solid black;
                   5114:   margin: 2px;
                   5115: }
                   5116: 
1.924     bisitz   5117: table#LC_menubuttons {
1.345     albertel 5118:   width: 100%;
                   5119:   background: $pgbg;
1.392     albertel 5120:   border: 2px;
1.402     albertel 5121:   border-collapse: separate;
1.803     bisitz   5122:   padding: 0;
1.345     albertel 5123: }
1.392     albertel 5124: 
1.801     tempelho 5125: table#LC_title_bar a {
                   5126:   color: $fontmenu;
                   5127: }
1.836     bisitz   5128: 
1.807     droeschl 5129: table#LC_title_bar {
1.819     tempelho 5130:   clear: both;
1.836     bisitz   5131:   display: none;
1.807     droeschl 5132: }
                   5133: 
1.795     www      5134: table#LC_title_bar,
1.933     droeschl 5135: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5136: table#LC_title_bar.LC_with_remote {
1.359     albertel 5137:   width: 100%;
1.392     albertel 5138:   border-color: $pgbg;
                   5139:   border-style: solid;
                   5140:   border-width: $border;
1.379     albertel 5141:   background: $pgbg;
1.801     tempelho 5142:   color: $fontmenu;
1.392     albertel 5143:   border-collapse: collapse;
1.803     bisitz   5144:   padding: 0;
1.819     tempelho 5145:   margin: 0;
1.359     albertel 5146: }
1.795     www      5147: 
1.933     droeschl 5148: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5149:     margin: 0;
                   5150:     padding: 0;
1.933     droeschl 5151:     position: relative;
                   5152:     list-style: none;
1.913     droeschl 5153: }
1.933     droeschl 5154: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5155:     display: inline;
                   5156: }
1.933     droeschl 5157: 
                   5158: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5159:     padding: 0;
1.933     droeschl 5160:     margin: 0;
                   5161:     float: left;
1.913     droeschl 5162: }
1.933     droeschl 5163: .LC_breadcrumb_tools_tools {
                   5164:     padding: 0;
                   5165:     margin: 0;
1.913     droeschl 5166:     float: right;
                   5167: }
                   5168: 
1.359     albertel 5169: table#LC_title_bar td {
                   5170:   background: $tabbg;
                   5171: }
1.795     www      5172: 
1.911     bisitz   5173: table#LC_menubuttons img {
1.803     bisitz   5174:   border: none;
1.346     albertel 5175: }
1.795     www      5176: 
1.842     droeschl 5177: .LC_breadcrumbs_component {
1.911     bisitz   5178:   float: right;
                   5179:   margin: 0 1em;
1.357     albertel 5180: }
1.842     droeschl 5181: .LC_breadcrumbs_component img {
1.911     bisitz   5182:   vertical-align: middle;
1.777     tempelho 5183: }
1.795     www      5184: 
1.383     albertel 5185: td.LC_table_cell_checkbox {
                   5186:   text-align: center;
                   5187: }
1.795     www      5188: 
                   5189: .LC_fontsize_small {
1.911     bisitz   5190:   font-size: 70%;
1.705     tempelho 5191: }
                   5192: 
1.844     bisitz   5193: #LC_breadcrumbs {
1.911     bisitz   5194:   clear:both;
                   5195:   background: $sidebg;
                   5196:   border-bottom: 1px solid $lg_border_color;
                   5197:   line-height: 2.5em;
1.933     droeschl 5198:   overflow: hidden;
1.911     bisitz   5199:   margin: 0;
                   5200:   padding: 0;
1.995     raeburn  5201:   text-align: left;
1.819     tempelho 5202: }
1.862     bisitz   5203: 
1.993     raeburn  5204: .LC_head_subbox {
1.911     bisitz   5205:   clear:both;
                   5206:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5207:   border: 1px solid $sidebg;
                   5208:   margin: 0 0 10px 0;      
1.966     bisitz   5209:   padding: 3px;
1.995     raeburn  5210:   text-align: left;
1.822     bisitz   5211: }
                   5212: 
1.795     www      5213: .LC_fontsize_medium {
1.911     bisitz   5214:   font-size: 85%;
1.705     tempelho 5215: }
                   5216: 
1.795     www      5217: .LC_fontsize_large {
1.911     bisitz   5218:   font-size: 120%;
1.705     tempelho 5219: }
                   5220: 
1.346     albertel 5221: .LC_menubuttons_inline_text {
                   5222:   color: $font;
1.698     harmsja  5223:   font-size: 90%;
1.701     harmsja  5224:   padding-left:3px;
1.346     albertel 5225: }
                   5226: 
1.934     droeschl 5227: .LC_menubuttons_inline_text img{
                   5228:   vertical-align: middle;
                   5229: }
                   5230: 
1.951     onken    5231: li.LC_menubuttons_inline_text img,a {
                   5232:   cursor:pointer;
1.1002    droeschl 5233:   text-decoration: none;
1.951     onken    5234: }
                   5235: 
1.526     www      5236: .LC_menubuttons_link {
                   5237:   text-decoration: none;
                   5238: }
1.795     www      5239: 
1.522     albertel 5240: .LC_menubuttons_category {
1.521     www      5241:   color: $font;
1.526     www      5242:   background: $pgbg;
1.521     www      5243:   font-size: larger;
                   5244:   font-weight: bold;
                   5245: }
                   5246: 
1.346     albertel 5247: td.LC_menubuttons_text {
1.911     bisitz   5248:   color: $font;
1.346     albertel 5249: }
1.706     harmsja  5250: 
1.346     albertel 5251: .LC_current_location {
                   5252:   background: $tabbg;
                   5253: }
1.795     www      5254: 
1.938     bisitz   5255: table.LC_data_table {
1.347     albertel 5256:   border: 1px solid #000000;
1.402     albertel 5257:   border-collapse: separate;
1.426     albertel 5258:   border-spacing: 1px;
1.610     albertel 5259:   background: $pgbg;
1.347     albertel 5260: }
1.795     www      5261: 
1.422     albertel 5262: .LC_data_table_dense {
                   5263:   font-size: small;
                   5264: }
1.795     www      5265: 
1.507     raeburn  5266: table.LC_nested_outer {
                   5267:   border: 1px solid #000000;
1.589     raeburn  5268:   border-collapse: collapse;
1.803     bisitz   5269:   border-spacing: 0;
1.507     raeburn  5270:   width: 100%;
                   5271: }
1.795     www      5272: 
1.879     raeburn  5273: table.LC_innerpickbox,
1.507     raeburn  5274: table.LC_nested {
1.803     bisitz   5275:   border: none;
1.589     raeburn  5276:   border-collapse: collapse;
1.803     bisitz   5277:   border-spacing: 0;
1.507     raeburn  5278:   width: 100%;
                   5279: }
1.795     www      5280: 
1.911     bisitz   5281: table.LC_data_table tr th,
                   5282: table.LC_calendar tr th,
1.879     raeburn  5283: table.LC_prior_tries tr th,
                   5284: table.LC_innerpickbox tr th {
1.349     albertel 5285:   font-weight: bold;
                   5286:   background-color: $data_table_head;
1.801     tempelho 5287:   color:$fontmenu;
1.701     harmsja  5288:   font-size:90%;
1.347     albertel 5289: }
1.795     www      5290: 
1.879     raeburn  5291: table.LC_innerpickbox tr th,
                   5292: table.LC_innerpickbox tr td {
                   5293:   vertical-align: top;
                   5294: }
                   5295: 
1.711     raeburn  5296: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5297:   background-color: #CCCCCC;
1.711     raeburn  5298:   font-weight: bold;
                   5299:   text-align: left;
                   5300: }
1.795     www      5301: 
1.912     bisitz   5302: table.LC_data_table tr.LC_odd_row > td {
                   5303:   background-color: $data_table_light;
                   5304:   padding: 2px;
                   5305:   vertical-align: top;
                   5306: }
                   5307: 
1.809     bisitz   5308: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5309:   background-color: $data_table_light;
1.912     bisitz   5310:   vertical-align: top;
                   5311: }
                   5312: 
                   5313: table.LC_data_table tr.LC_even_row > td {
                   5314:   background-color: $data_table_dark;
1.425     albertel 5315:   padding: 2px;
1.900     bisitz   5316:   vertical-align: top;
1.347     albertel 5317: }
1.795     www      5318: 
1.809     bisitz   5319: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5320:   background-color: $data_table_dark;
1.900     bisitz   5321:   vertical-align: top;
1.347     albertel 5322: }
1.795     www      5323: 
1.425     albertel 5324: table.LC_data_table tr.LC_data_table_highlight td {
                   5325:   background-color: $data_table_darker;
                   5326: }
1.795     www      5327: 
1.639     raeburn  5328: table.LC_data_table tr td.LC_leftcol_header {
                   5329:   background-color: $data_table_head;
                   5330:   font-weight: bold;
                   5331: }
1.795     www      5332: 
1.451     albertel 5333: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5334: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5335:   font-weight: bold;
                   5336:   font-style: italic;
                   5337:   text-align: center;
                   5338:   padding: 8px;
1.347     albertel 5339: }
1.795     www      5340: 
1.940     bisitz   5341: table.LC_data_table tr.LC_empty_row td {
                   5342:   background-color: $sidebg;
                   5343: }
                   5344: 
                   5345: table.LC_nested tr.LC_empty_row td {
                   5346:   background-color: #FFFFFF;
                   5347: }
                   5348: 
1.890     droeschl 5349: table.LC_caption {
                   5350: }
                   5351: 
1.507     raeburn  5352: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5353:   padding: 4ex
                   5354: }
1.795     www      5355: 
1.507     raeburn  5356: table.LC_nested_outer tr th {
                   5357:   font-weight: bold;
1.801     tempelho 5358:   color:$fontmenu;
1.507     raeburn  5359:   background-color: $data_table_head;
1.701     harmsja  5360:   font-size: small;
1.507     raeburn  5361:   border-bottom: 1px solid #000000;
                   5362: }
1.795     www      5363: 
1.507     raeburn  5364: table.LC_nested_outer tr td.LC_subheader {
                   5365:   background-color: $data_table_head;
                   5366:   font-weight: bold;
                   5367:   font-size: small;
                   5368:   border-bottom: 1px solid #000000;
                   5369:   text-align: right;
1.451     albertel 5370: }
1.795     www      5371: 
1.507     raeburn  5372: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5373:   background-color: #CCCCCC;
1.451     albertel 5374:   font-weight: bold;
                   5375:   font-size: small;
1.507     raeburn  5376:   text-align: center;
                   5377: }
1.795     www      5378: 
1.589     raeburn  5379: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5380: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5381:   text-align: left;
1.451     albertel 5382: }
1.795     www      5383: 
1.507     raeburn  5384: table.LC_nested td {
1.735     bisitz   5385:   background-color: #FFFFFF;
1.451     albertel 5386:   font-size: small;
1.507     raeburn  5387: }
1.795     www      5388: 
1.507     raeburn  5389: table.LC_nested_outer tr th.LC_right_item,
                   5390: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5391: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5392: table.LC_nested tr td.LC_right_item {
1.451     albertel 5393:   text-align: right;
                   5394: }
                   5395: 
1.507     raeburn  5396: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5397:   background-color: #EEEEEE;
1.451     albertel 5398: }
                   5399: 
1.473     raeburn  5400: table.LC_createuser {
                   5401: }
                   5402: 
                   5403: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5404:   font-size: small;
1.473     raeburn  5405: }
                   5406: 
                   5407: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5408:   background-color: #CCCCCC;
1.473     raeburn  5409:   font-weight: bold;
                   5410:   text-align: center;
                   5411: }
                   5412: 
1.349     albertel 5413: table.LC_calendar {
                   5414:   border: 1px solid #000000;
                   5415:   border-collapse: collapse;
1.917     raeburn  5416:   width: 98%;
1.349     albertel 5417: }
1.795     www      5418: 
1.349     albertel 5419: table.LC_calendar_pickdate {
                   5420:   font-size: xx-small;
                   5421: }
1.795     www      5422: 
1.349     albertel 5423: table.LC_calendar tr td {
                   5424:   border: 1px solid #000000;
                   5425:   vertical-align: top;
1.917     raeburn  5426:   width: 14%;
1.349     albertel 5427: }
1.795     www      5428: 
1.349     albertel 5429: table.LC_calendar tr td.LC_calendar_day_empty {
                   5430:   background-color: $data_table_dark;
                   5431: }
1.795     www      5432: 
1.779     bisitz   5433: table.LC_calendar tr td.LC_calendar_day_current {
                   5434:   background-color: $data_table_highlight;
1.777     tempelho 5435: }
1.795     www      5436: 
1.938     bisitz   5437: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5438:   background-color: $mail_new;
                   5439: }
1.795     www      5440: 
1.938     bisitz   5441: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5442:   background-color: $mail_new_hover;
                   5443: }
1.795     www      5444: 
1.938     bisitz   5445: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5446:   background-color: $mail_read;
                   5447: }
1.795     www      5448: 
1.938     bisitz   5449: /*
                   5450: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5451:   background-color: $mail_read_hover;
                   5452: }
1.938     bisitz   5453: */
1.795     www      5454: 
1.938     bisitz   5455: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5456:   background-color: $mail_replied;
                   5457: }
1.795     www      5458: 
1.938     bisitz   5459: /*
                   5460: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5461:   background-color: $mail_replied_hover;
                   5462: }
1.938     bisitz   5463: */
1.795     www      5464: 
1.938     bisitz   5465: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5466:   background-color: $mail_other;
                   5467: }
1.795     www      5468: 
1.938     bisitz   5469: /*
                   5470: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5471:   background-color: $mail_other_hover;
                   5472: }
1.938     bisitz   5473: */
1.494     raeburn  5474: 
1.777     tempelho 5475: table.LC_data_table tr > td.LC_browser_file,
                   5476: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5477:   background: #AAEE77;
1.389     albertel 5478: }
1.795     www      5479: 
1.777     tempelho 5480: table.LC_data_table tr > td.LC_browser_file_locked,
                   5481: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5482:   background: #FFAA99;
1.387     albertel 5483: }
1.795     www      5484: 
1.777     tempelho 5485: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5486:   background: #888888;
1.779     bisitz   5487: }
1.795     www      5488: 
1.777     tempelho 5489: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5490: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5491:   background: #F8F866;
1.777     tempelho 5492: }
1.795     www      5493: 
1.696     bisitz   5494: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5495:   background: #E0E8FF;
1.387     albertel 5496: }
1.696     bisitz   5497: 
1.707     bisitz   5498: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5499:   /* background: #77FF77; */
1.707     bisitz   5500: }
1.795     www      5501: 
1.707     bisitz   5502: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5503:   border-right: 8px solid #FFFF77;
1.707     bisitz   5504: }
1.795     www      5505: 
1.707     bisitz   5506: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5507:   border-right: 8px solid #FFAA77;
1.707     bisitz   5508: }
1.795     www      5509: 
1.707     bisitz   5510: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5511:   border-right: 8px solid #FF7777;
1.707     bisitz   5512: }
1.795     www      5513: 
1.707     bisitz   5514: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5515:   border-right: 8px solid #AAFF77;
1.707     bisitz   5516: }
1.795     www      5517: 
1.707     bisitz   5518: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5519:   border-right: 8px solid #11CC55;
1.707     bisitz   5520: }
                   5521: 
1.388     albertel 5522: span.LC_current_location {
1.701     harmsja  5523:   font-size:larger;
1.388     albertel 5524:   background: $pgbg;
                   5525: }
1.387     albertel 5526: 
1.1029    www      5527: span.LC_current_nav_location {
                   5528:   font-weight:bold;
                   5529:   background: $sidebg;
                   5530: }
                   5531: 
1.395     albertel 5532: span.LC_parm_menu_item {
                   5533:   font-size: larger;
                   5534: }
1.795     www      5535: 
1.395     albertel 5536: span.LC_parm_scope_all {
                   5537:   color: red;
                   5538: }
1.795     www      5539: 
1.395     albertel 5540: span.LC_parm_scope_folder {
                   5541:   color: green;
                   5542: }
1.795     www      5543: 
1.395     albertel 5544: span.LC_parm_scope_resource {
                   5545:   color: orange;
                   5546: }
1.795     www      5547: 
1.395     albertel 5548: span.LC_parm_part {
                   5549:   color: blue;
                   5550: }
1.795     www      5551: 
1.911     bisitz   5552: span.LC_parm_folder,
                   5553: span.LC_parm_symb {
1.395     albertel 5554:   font-size: x-small;
                   5555:   font-family: $mono;
                   5556:   color: #AAAAAA;
                   5557: }
                   5558: 
1.977     bisitz   5559: ul.LC_parm_parmlist li {
                   5560:   display: inline-block;
                   5561:   padding: 0.3em 0.8em;
                   5562:   vertical-align: top;
                   5563:   width: 150px;
                   5564:   border-top:1px solid $lg_border_color;
                   5565: }
                   5566: 
1.795     www      5567: td.LC_parm_overview_level_menu,
                   5568: td.LC_parm_overview_map_menu,
                   5569: td.LC_parm_overview_parm_selectors,
                   5570: td.LC_parm_overview_restrictions  {
1.396     albertel 5571:   border: 1px solid black;
                   5572:   border-collapse: collapse;
                   5573: }
1.795     www      5574: 
1.396     albertel 5575: table.LC_parm_overview_restrictions td {
                   5576:   border-width: 1px 4px 1px 4px;
                   5577:   border-style: solid;
                   5578:   border-color: $pgbg;
                   5579:   text-align: center;
                   5580: }
1.795     www      5581: 
1.396     albertel 5582: table.LC_parm_overview_restrictions th {
                   5583:   background: $tabbg;
                   5584:   border-width: 1px 4px 1px 4px;
                   5585:   border-style: solid;
                   5586:   border-color: $pgbg;
                   5587: }
1.795     www      5588: 
1.398     albertel 5589: table#LC_helpmenu {
1.803     bisitz   5590:   border: none;
1.398     albertel 5591:   height: 55px;
1.803     bisitz   5592:   border-spacing: 0;
1.398     albertel 5593: }
                   5594: 
                   5595: table#LC_helpmenu fieldset legend {
                   5596:   font-size: larger;
                   5597: }
1.795     www      5598: 
1.397     albertel 5599: table#LC_helpmenu_links {
                   5600:   width: 100%;
                   5601:   border: 1px solid black;
                   5602:   background: $pgbg;
1.803     bisitz   5603:   padding: 0;
1.397     albertel 5604:   border-spacing: 1px;
                   5605: }
1.795     www      5606: 
1.397     albertel 5607: table#LC_helpmenu_links tr td {
                   5608:   padding: 1px;
                   5609:   background: $tabbg;
1.399     albertel 5610:   text-align: center;
                   5611:   font-weight: bold;
1.397     albertel 5612: }
1.396     albertel 5613: 
1.795     www      5614: table#LC_helpmenu_links a:link,
                   5615: table#LC_helpmenu_links a:visited,
1.397     albertel 5616: table#LC_helpmenu_links a:active {
                   5617:   text-decoration: none;
                   5618:   color: $font;
                   5619: }
1.795     www      5620: 
1.397     albertel 5621: table#LC_helpmenu_links a:hover {
                   5622:   text-decoration: underline;
                   5623:   color: $vlink;
                   5624: }
1.396     albertel 5625: 
1.417     albertel 5626: .LC_chrt_popup_exists {
                   5627:   border: 1px solid #339933;
                   5628:   margin: -1px;
                   5629: }
1.795     www      5630: 
1.417     albertel 5631: .LC_chrt_popup_up {
                   5632:   border: 1px solid yellow;
                   5633:   margin: -1px;
                   5634: }
1.795     www      5635: 
1.417     albertel 5636: .LC_chrt_popup {
                   5637:   border: 1px solid #8888FF;
                   5638:   background: #CCCCFF;
                   5639: }
1.795     www      5640: 
1.421     albertel 5641: table.LC_pick_box {
                   5642:   border-collapse: separate;
                   5643:   background: white;
                   5644:   border: 1px solid black;
                   5645:   border-spacing: 1px;
                   5646: }
1.795     www      5647: 
1.421     albertel 5648: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   5649:   background: $sidebg;
1.421     albertel 5650:   font-weight: bold;
1.900     bisitz   5651:   text-align: left;
1.740     bisitz   5652:   vertical-align: top;
1.421     albertel 5653:   width: 184px;
                   5654:   padding: 8px;
                   5655: }
1.795     www      5656: 
1.579     raeburn  5657: table.LC_pick_box td.LC_pick_box_value {
                   5658:   text-align: left;
                   5659:   padding: 8px;
                   5660: }
1.795     www      5661: 
1.579     raeburn  5662: table.LC_pick_box td.LC_pick_box_select {
                   5663:   text-align: left;
                   5664:   padding: 8px;
                   5665: }
1.795     www      5666: 
1.424     albertel 5667: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   5668:   padding: 0;
1.421     albertel 5669:   height: 1px;
                   5670:   background: black;
                   5671: }
1.795     www      5672: 
1.421     albertel 5673: table.LC_pick_box td.LC_pick_box_submit {
                   5674:   text-align: right;
                   5675: }
1.795     www      5676: 
1.579     raeburn  5677: table.LC_pick_box td.LC_evenrow_value {
                   5678:   text-align: left;
                   5679:   padding: 8px;
                   5680:   background-color: $data_table_light;
                   5681: }
1.795     www      5682: 
1.579     raeburn  5683: table.LC_pick_box td.LC_oddrow_value {
                   5684:   text-align: left;
                   5685:   padding: 8px;
                   5686:   background-color: $data_table_light;
                   5687: }
1.795     www      5688: 
1.579     raeburn  5689: span.LC_helpform_receipt_cat {
                   5690:   font-weight: bold;
                   5691: }
1.795     www      5692: 
1.424     albertel 5693: table.LC_group_priv_box {
                   5694:   background: white;
                   5695:   border: 1px solid black;
                   5696:   border-spacing: 1px;
                   5697: }
1.795     www      5698: 
1.424     albertel 5699: table.LC_group_priv_box td.LC_pick_box_title {
                   5700:   background: $tabbg;
                   5701:   font-weight: bold;
                   5702:   text-align: right;
                   5703:   width: 184px;
                   5704: }
1.795     www      5705: 
1.424     albertel 5706: table.LC_group_priv_box td.LC_groups_fixed {
                   5707:   background: $data_table_light;
                   5708:   text-align: center;
                   5709: }
1.795     www      5710: 
1.424     albertel 5711: table.LC_group_priv_box td.LC_groups_optional {
                   5712:   background: $data_table_dark;
                   5713:   text-align: center;
                   5714: }
1.795     www      5715: 
1.424     albertel 5716: table.LC_group_priv_box td.LC_groups_functionality {
                   5717:   background: $data_table_darker;
                   5718:   text-align: center;
                   5719:   font-weight: bold;
                   5720: }
1.795     www      5721: 
1.424     albertel 5722: table.LC_group_priv td {
                   5723:   text-align: left;
1.803     bisitz   5724:   padding: 0;
1.424     albertel 5725: }
                   5726: 
                   5727: .LC_navbuttons {
                   5728:   margin: 2ex 0ex 2ex 0ex;
                   5729: }
1.795     www      5730: 
1.423     albertel 5731: .LC_topic_bar {
                   5732:   font-weight: bold;
                   5733:   background: $tabbg;
1.918     wenzelju 5734:   margin: 1em 0em 1em 2em;
1.805     bisitz   5735:   padding: 3px;
1.918     wenzelju 5736:   font-size: 1.2em;
1.423     albertel 5737: }
1.795     www      5738: 
1.423     albertel 5739: .LC_topic_bar span {
1.918     wenzelju 5740:   left: 0.5em;
                   5741:   position: absolute;
1.423     albertel 5742:   vertical-align: middle;
1.918     wenzelju 5743:   font-size: 1.2em;
1.423     albertel 5744: }
1.795     www      5745: 
1.423     albertel 5746: table.LC_course_group_status {
                   5747:   margin: 20px;
                   5748: }
1.795     www      5749: 
1.423     albertel 5750: table.LC_status_selector td {
                   5751:   vertical-align: top;
                   5752:   text-align: center;
1.424     albertel 5753:   padding: 4px;
                   5754: }
1.795     www      5755: 
1.599     albertel 5756: div.LC_feedback_link {
1.616     albertel 5757:   clear: both;
1.829     kalberla 5758:   background: $sidebg;
1.779     bisitz   5759:   width: 100%;
1.829     kalberla 5760:   padding-bottom: 10px;
                   5761:   border: 1px $tabbg solid;
1.833     kalberla 5762:   height: 22px;
                   5763:   line-height: 22px;
                   5764:   padding-top: 5px;
                   5765: }
                   5766: 
                   5767: div.LC_feedback_link img {
                   5768:   height: 22px;
1.867     kalberla 5769:   vertical-align:middle;
1.829     kalberla 5770: }
                   5771: 
1.911     bisitz   5772: div.LC_feedback_link a {
1.829     kalberla 5773:   text-decoration: none;
1.489     raeburn  5774: }
1.795     www      5775: 
1.867     kalberla 5776: div.LC_comblock {
1.911     bisitz   5777:   display:inline;
1.867     kalberla 5778:   color:$font;
                   5779:   font-size:90%;
                   5780: }
                   5781: 
                   5782: div.LC_feedback_link div.LC_comblock {
                   5783:   padding-left:5px;
                   5784: }
                   5785: 
                   5786: div.LC_feedback_link div.LC_comblock a {
                   5787:   color:$font;
                   5788: }
                   5789: 
1.489     raeburn  5790: span.LC_feedback_link {
1.858     bisitz   5791:   /* background: $feedback_link_bg; */
1.599     albertel 5792:   font-size: larger;
                   5793: }
1.795     www      5794: 
1.599     albertel 5795: span.LC_message_link {
1.858     bisitz   5796:   /* background: $feedback_link_bg; */
1.599     albertel 5797:   font-size: larger;
                   5798:   position: absolute;
                   5799:   right: 1em;
1.489     raeburn  5800: }
1.421     albertel 5801: 
1.515     albertel 5802: table.LC_prior_tries {
1.524     albertel 5803:   border: 1px solid #000000;
                   5804:   border-collapse: separate;
                   5805:   border-spacing: 1px;
1.515     albertel 5806: }
1.523     albertel 5807: 
1.515     albertel 5808: table.LC_prior_tries td {
1.524     albertel 5809:   padding: 2px;
1.515     albertel 5810: }
1.523     albertel 5811: 
                   5812: .LC_answer_correct {
1.795     www      5813:   background: lightgreen;
                   5814:   color: darkgreen;
                   5815:   padding: 6px;
1.523     albertel 5816: }
1.795     www      5817: 
1.523     albertel 5818: .LC_answer_charged_try {
1.797     www      5819:   background: #FFAAAA;
1.795     www      5820:   color: darkred;
                   5821:   padding: 6px;
1.523     albertel 5822: }
1.795     www      5823: 
1.779     bisitz   5824: .LC_answer_not_charged_try,
1.523     albertel 5825: .LC_answer_no_grade,
                   5826: .LC_answer_late {
1.795     www      5827:   background: lightyellow;
1.523     albertel 5828:   color: black;
1.795     www      5829:   padding: 6px;
1.523     albertel 5830: }
1.795     www      5831: 
1.523     albertel 5832: .LC_answer_previous {
1.795     www      5833:   background: lightblue;
                   5834:   color: darkblue;
                   5835:   padding: 6px;
1.523     albertel 5836: }
1.795     www      5837: 
1.779     bisitz   5838: .LC_answer_no_message {
1.777     tempelho 5839:   background: #FFFFFF;
                   5840:   color: black;
1.795     www      5841:   padding: 6px;
1.779     bisitz   5842: }
1.795     www      5843: 
1.779     bisitz   5844: .LC_answer_unknown {
                   5845:   background: orange;
                   5846:   color: black;
1.795     www      5847:   padding: 6px;
1.777     tempelho 5848: }
1.795     www      5849: 
1.529     albertel 5850: span.LC_prior_numerical,
                   5851: span.LC_prior_string,
                   5852: span.LC_prior_custom,
                   5853: span.LC_prior_reaction,
                   5854: span.LC_prior_math {
1.925     bisitz   5855:   font-family: $mono;
1.523     albertel 5856:   white-space: pre;
                   5857: }
                   5858: 
1.525     albertel 5859: span.LC_prior_string {
1.925     bisitz   5860:   font-family: $mono;
1.525     albertel 5861:   white-space: pre;
                   5862: }
                   5863: 
1.523     albertel 5864: table.LC_prior_option {
                   5865:   width: 100%;
                   5866:   border-collapse: collapse;
                   5867: }
1.795     www      5868: 
1.911     bisitz   5869: table.LC_prior_rank,
1.795     www      5870: table.LC_prior_match {
1.528     albertel 5871:   border-collapse: collapse;
                   5872: }
1.795     www      5873: 
1.528     albertel 5874: table.LC_prior_option tr td,
                   5875: table.LC_prior_rank tr td,
                   5876: table.LC_prior_match tr td {
1.524     albertel 5877:   border: 1px solid #000000;
1.515     albertel 5878: }
                   5879: 
1.855     bisitz   5880: .LC_nobreak {
1.544     albertel 5881:   white-space: nowrap;
1.519     raeburn  5882: }
                   5883: 
1.576     raeburn  5884: span.LC_cusr_emph {
                   5885:   font-style: italic;
                   5886: }
                   5887: 
1.633     raeburn  5888: span.LC_cusr_subheading {
                   5889:   font-weight: normal;
                   5890:   font-size: 85%;
                   5891: }
                   5892: 
1.861     bisitz   5893: div.LC_docs_entry_move {
1.859     bisitz   5894:   border: 1px solid #BBBBBB;
1.545     albertel 5895:   background: #DDDDDD;
1.861     bisitz   5896:   width: 22px;
1.859     bisitz   5897:   padding: 1px;
                   5898:   margin: 0;
1.545     albertel 5899: }
                   5900: 
1.861     bisitz   5901: table.LC_data_table tr > td.LC_docs_entry_commands,
                   5902: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 5903:   background: #DDDDDD;
                   5904:   font-size: x-small;
                   5905: }
1.795     www      5906: 
1.861     bisitz   5907: .LC_docs_entry_parameter {
                   5908:   white-space: nowrap;
                   5909: }
                   5910: 
1.544     albertel 5911: .LC_docs_copy {
1.545     albertel 5912:   color: #000099;
1.544     albertel 5913: }
1.795     www      5914: 
1.544     albertel 5915: .LC_docs_cut {
1.545     albertel 5916:   color: #550044;
1.544     albertel 5917: }
1.795     www      5918: 
1.544     albertel 5919: .LC_docs_rename {
1.545     albertel 5920:   color: #009900;
1.544     albertel 5921: }
1.795     www      5922: 
1.544     albertel 5923: .LC_docs_remove {
1.545     albertel 5924:   color: #990000;
                   5925: }
                   5926: 
1.547     albertel 5927: .LC_docs_reinit_warn,
                   5928: .LC_docs_ext_edit {
                   5929:   font-size: x-small;
                   5930: }
                   5931: 
1.545     albertel 5932: table.LC_docs_adddocs td,
                   5933: table.LC_docs_adddocs th {
                   5934:   border: 1px solid #BBBBBB;
                   5935:   padding: 4px;
                   5936:   background: #DDDDDD;
1.543     albertel 5937: }
                   5938: 
1.584     albertel 5939: table.LC_sty_begin {
                   5940:   background: #BBFFBB;
                   5941: }
1.795     www      5942: 
1.584     albertel 5943: table.LC_sty_end {
                   5944:   background: #FFBBBB;
                   5945: }
                   5946: 
1.589     raeburn  5947: table.LC_double_column {
1.803     bisitz   5948:   border-width: 0;
1.589     raeburn  5949:   border-collapse: collapse;
                   5950:   width: 100%;
                   5951:   padding: 2px;
                   5952: }
                   5953: 
                   5954: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  5955:   top: 2px;
1.589     raeburn  5956:   left: 2px;
                   5957:   width: 47%;
                   5958:   vertical-align: top;
                   5959: }
                   5960: 
                   5961: table.LC_double_column tr td.LC_right_col {
                   5962:   top: 2px;
1.779     bisitz   5963:   right: 2px;
1.589     raeburn  5964:   width: 47%;
                   5965:   vertical-align: top;
                   5966: }
                   5967: 
1.591     raeburn  5968: div.LC_left_float {
                   5969:   float: left;
                   5970:   padding-right: 5%;
1.597     albertel 5971:   padding-bottom: 4px;
1.591     raeburn  5972: }
                   5973: 
                   5974: div.LC_clear_float_header {
1.597     albertel 5975:   padding-bottom: 2px;
1.591     raeburn  5976: }
                   5977: 
                   5978: div.LC_clear_float_footer {
1.597     albertel 5979:   padding-top: 10px;
1.591     raeburn  5980:   clear: both;
                   5981: }
                   5982: 
1.597     albertel 5983: div.LC_grade_show_user {
1.941     bisitz   5984: /*  border-left: 5px solid $sidebg; */
                   5985:   border-top: 5px solid #000000;
                   5986:   margin: 50px 0 0 0;
1.936     bisitz   5987:   padding: 15px 0 5px 10px;
1.597     albertel 5988: }
1.795     www      5989: 
1.936     bisitz   5990: div.LC_grade_show_user_odd_row {
1.941     bisitz   5991: /*  border-left: 5px solid #000000; */
                   5992: }
                   5993: 
                   5994: div.LC_grade_show_user div.LC_Box {
                   5995:   margin-right: 50px;
1.597     albertel 5996: }
                   5997: 
                   5998: div.LC_grade_submissions,
                   5999: div.LC_grade_message_center,
1.936     bisitz   6000: div.LC_grade_info_links {
1.597     albertel 6001:   margin: 5px;
                   6002:   width: 99%;
                   6003:   background: #FFFFFF;
                   6004: }
1.795     www      6005: 
1.597     albertel 6006: div.LC_grade_submissions_header,
1.936     bisitz   6007: div.LC_grade_message_center_header {
1.705     tempelho 6008:   font-weight: bold;
                   6009:   font-size: large;
1.597     albertel 6010: }
1.795     www      6011: 
1.597     albertel 6012: div.LC_grade_submissions_body,
1.936     bisitz   6013: div.LC_grade_message_center_body {
1.597     albertel 6014:   border: 1px solid black;
                   6015:   width: 99%;
                   6016:   background: #FFFFFF;
                   6017: }
1.795     www      6018: 
1.613     albertel 6019: table.LC_scantron_action {
                   6020:   width: 100%;
                   6021: }
1.795     www      6022: 
1.613     albertel 6023: table.LC_scantron_action tr th {
1.698     harmsja  6024:   font-weight:bold;
                   6025:   font-style:normal;
1.613     albertel 6026: }
1.795     www      6027: 
1.779     bisitz   6028: .LC_edit_problem_header,
1.614     albertel 6029: div.LC_edit_problem_footer {
1.705     tempelho 6030:   font-weight: normal;
                   6031:   font-size:  medium;
1.602     albertel 6032:   margin: 2px;
1.600     albertel 6033: }
1.795     www      6034: 
1.600     albertel 6035: div.LC_edit_problem_header,
1.602     albertel 6036: div.LC_edit_problem_header div,
1.614     albertel 6037: div.LC_edit_problem_footer,
                   6038: div.LC_edit_problem_footer div,
1.602     albertel 6039: div.LC_edit_problem_editxml_header,
                   6040: div.LC_edit_problem_editxml_header div {
1.600     albertel 6041:   margin-top: 5px;
                   6042: }
1.795     www      6043: 
1.600     albertel 6044: div.LC_edit_problem_header_title {
1.705     tempelho 6045:   font-weight: bold;
                   6046:   font-size: larger;
1.602     albertel 6047:   background: $tabbg;
                   6048:   padding: 3px;
                   6049: }
1.795     www      6050: 
1.602     albertel 6051: table.LC_edit_problem_header_title {
                   6052:   width: 100%;
1.600     albertel 6053:   background: $tabbg;
1.602     albertel 6054: }
                   6055: 
                   6056: div.LC_edit_problem_discards {
                   6057:   float: left;
                   6058:   padding-bottom: 5px;
                   6059: }
1.795     www      6060: 
1.602     albertel 6061: div.LC_edit_problem_saves {
                   6062:   float: right;
                   6063:   padding-bottom: 5px;
1.600     albertel 6064: }
1.795     www      6065: 
1.911     bisitz   6066: img.stift {
1.803     bisitz   6067:   border-width: 0;
                   6068:   vertical-align: middle;
1.677     riegler  6069: }
1.680     riegler  6070: 
1.923     bisitz   6071: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6072:   vertical-align: top;
1.777     tempelho 6073: }
1.795     www      6074: 
1.716     raeburn  6075: div.LC_createcourse {
1.911     bisitz   6076:   margin: 10px 10px 10px 10px;
1.716     raeburn  6077: }
                   6078: 
1.917     raeburn  6079: .LC_dccid {
                   6080:   margin: 0.2em 0 0 0;
                   6081:   padding: 0;
                   6082:   font-size: 90%;
                   6083:   display:none;
                   6084: }
                   6085: 
1.698     harmsja  6086: a:hover,
1.897     wenzelju 6087: ol.LC_primary_menu a:hover,
1.721     harmsja  6088: ol#LC_MenuBreadcrumbs a:hover,
                   6089: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6090: ul#LC_secondary_menu a:hover,
1.721     harmsja  6091: .LC_FormSectionClearButton input:hover
1.795     www      6092: ul.LC_TabContent   li:hover a {
1.952     onken    6093:   color:$button_hover;
1.911     bisitz   6094:   text-decoration:none;
1.693     droeschl 6095: }
                   6096: 
1.779     bisitz   6097: h1 {
1.911     bisitz   6098:   padding: 0;
                   6099:   line-height:130%;
1.693     droeschl 6100: }
1.698     harmsja  6101: 
1.911     bisitz   6102: h2,
                   6103: h3,
                   6104: h4,
                   6105: h5,
                   6106: h6 {
                   6107:   margin: 5px 0 5px 0;
                   6108:   padding: 0;
                   6109:   line-height:130%;
1.693     droeschl 6110: }
1.795     www      6111: 
                   6112: .LC_hcell {
1.911     bisitz   6113:   padding:3px 15px 3px 15px;
                   6114:   margin: 0;
                   6115:   background-color:$tabbg;
                   6116:   color:$fontmenu;
                   6117:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6118: }
1.795     www      6119: 
1.840     bisitz   6120: .LC_Box > .LC_hcell {
1.911     bisitz   6121:   margin: 0 -10px 10px -10px;
1.835     bisitz   6122: }
                   6123: 
1.721     harmsja  6124: .LC_noBorder {
1.911     bisitz   6125:   border: 0;
1.698     harmsja  6126: }
1.693     droeschl 6127: 
1.721     harmsja  6128: .LC_FormSectionClearButton input {
1.911     bisitz   6129:   background-color:transparent;
                   6130:   border: none;
                   6131:   cursor:pointer;
                   6132:   text-decoration:underline;
1.693     droeschl 6133: }
1.763     bisitz   6134: 
                   6135: .LC_help_open_topic {
1.911     bisitz   6136:   color: #FFFFFF;
                   6137:   background-color: #EEEEFF;
                   6138:   margin: 1px;
                   6139:   padding: 4px;
                   6140:   border: 1px solid #000033;
                   6141:   white-space: nowrap;
                   6142:   /* vertical-align: middle; */
1.759     neumanie 6143: }
1.693     droeschl 6144: 
1.911     bisitz   6145: dl,
                   6146: ul,
                   6147: div,
                   6148: fieldset {
                   6149:   margin: 10px 10px 10px 0;
                   6150:   /* overflow: hidden; */
1.693     droeschl 6151: }
1.795     www      6152: 
1.838     bisitz   6153: fieldset > legend {
1.911     bisitz   6154:   font-weight: bold;
                   6155:   padding: 0 5px 0 5px;
1.838     bisitz   6156: }
                   6157: 
1.813     bisitz   6158: #LC_nav_bar {
1.911     bisitz   6159:   float: left;
1.995     raeburn  6160:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6161:   margin: 0 0 2px 0;
1.807     droeschl 6162: }
                   6163: 
1.916     droeschl 6164: #LC_realm {
                   6165:   margin: 0.2em 0 0 0;
                   6166:   padding: 0;
                   6167:   font-weight: bold;
                   6168:   text-align: center;
1.995     raeburn  6169:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6170: }
                   6171: 
1.911     bisitz   6172: #LC_nav_bar em {
                   6173:   font-weight: bold;
                   6174:   font-style: normal;
1.807     droeschl 6175: }
                   6176: 
1.897     wenzelju 6177: ol.LC_primary_menu {
1.911     bisitz   6178:   float: right;
1.934     droeschl 6179:   margin: 0;
1.995     raeburn  6180:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6181: }
                   6182: 
1.852     droeschl 6183: ol#LC_PathBreadcrumbs {
1.911     bisitz   6184:   margin: 0;
1.693     droeschl 6185: }
                   6186: 
1.897     wenzelju 6187: ol.LC_primary_menu li {
1.911     bisitz   6188:   display: inline;
                   6189:   padding: 5px 5px 0 10px;
                   6190:   vertical-align: top;
1.693     droeschl 6191: }
                   6192: 
1.897     wenzelju 6193: ol.LC_primary_menu li img {
1.911     bisitz   6194:   vertical-align: bottom;
1.934     droeschl 6195:   height: 1.1em;
1.693     droeschl 6196: }
                   6197: 
1.897     wenzelju 6198: ol.LC_primary_menu a {
1.911     bisitz   6199:   color: RGB(80, 80, 80);
                   6200:   text-decoration: none;
1.693     droeschl 6201: }
1.795     www      6202: 
1.949     droeschl 6203: ol.LC_primary_menu a.LC_new_message {
                   6204:   font-weight:bold;
                   6205:   color: darkred;
                   6206: }
                   6207: 
1.975     raeburn  6208: ol.LC_docs_parameters {
                   6209:   margin-left: 0;
                   6210:   padding: 0;
                   6211:   list-style: none;
                   6212: }
                   6213: 
                   6214: ol.LC_docs_parameters li {
                   6215:   margin: 0;
                   6216:   padding-right: 20px;
                   6217:   display: inline;
                   6218: }
                   6219: 
1.976     raeburn  6220: ol.LC_docs_parameters li:before {
                   6221:   content: "\\002022 \\0020";
                   6222: }
                   6223: 
                   6224: li.LC_docs_parameters_title {
                   6225:   font-weight: bold;
                   6226: }
                   6227: 
                   6228: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6229:   content: "";
                   6230: }
                   6231: 
1.897     wenzelju 6232: ul#LC_secondary_menu {
1.911     bisitz   6233:   clear: both;
                   6234:   color: $fontmenu;
                   6235:   background: $tabbg;
                   6236:   list-style: none;
                   6237:   padding: 0;
                   6238:   margin: 0;
                   6239:   width: 100%;
1.995     raeburn  6240:   text-align: left;
1.808     droeschl 6241: }
                   6242: 
1.897     wenzelju 6243: ul#LC_secondary_menu li {
1.911     bisitz   6244:   font-weight: bold;
                   6245:   line-height: 1.8em;
                   6246:   padding: 0 0.8em;
                   6247:   border-right: 1px solid black;
                   6248:   display: inline;
                   6249:   vertical-align: middle;
1.807     droeschl 6250: }
                   6251: 
1.847     tempelho 6252: ul.LC_TabContent {
1.911     bisitz   6253:   display:block;
                   6254:   background: $sidebg;
                   6255:   border-bottom: solid 1px $lg_border_color;
                   6256:   list-style:none;
1.1020    raeburn  6257:   margin: -1px -10px 0 -10px;
1.911     bisitz   6258:   padding: 0;
1.693     droeschl 6259: }
                   6260: 
1.795     www      6261: ul.LC_TabContent li,
                   6262: ul.LC_TabContentBigger li {
1.911     bisitz   6263:   float:left;
1.741     harmsja  6264: }
1.795     www      6265: 
1.897     wenzelju 6266: ul#LC_secondary_menu li a {
1.911     bisitz   6267:   color: $fontmenu;
                   6268:   text-decoration: none;
1.693     droeschl 6269: }
1.795     www      6270: 
1.721     harmsja  6271: ul.LC_TabContent {
1.952     onken    6272:   min-height:20px;
1.721     harmsja  6273: }
1.795     www      6274: 
                   6275: ul.LC_TabContent li {
1.911     bisitz   6276:   vertical-align:middle;
1.959     onken    6277:   padding: 0 16px 0 10px;
1.911     bisitz   6278:   background-color:$tabbg;
                   6279:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6280:   border-left: solid 1px $font;
1.721     harmsja  6281: }
1.795     www      6282: 
1.847     tempelho 6283: ul.LC_TabContent .right {
1.911     bisitz   6284:   float:right;
1.847     tempelho 6285: }
                   6286: 
1.911     bisitz   6287: ul.LC_TabContent li a,
                   6288: ul.LC_TabContent li {
                   6289:   color:rgb(47,47,47);
                   6290:   text-decoration:none;
                   6291:   font-size:95%;
                   6292:   font-weight:bold;
1.952     onken    6293:   min-height:20px;
                   6294: }
                   6295: 
1.959     onken    6296: ul.LC_TabContent li a:hover,
                   6297: ul.LC_TabContent li a:focus {
1.952     onken    6298:   color: $button_hover;
1.959     onken    6299:   background:none;
                   6300:   outline:none;
1.952     onken    6301: }
                   6302: 
                   6303: ul.LC_TabContent li:hover {
                   6304:   color: $button_hover;
                   6305:   cursor:pointer;
1.721     harmsja  6306: }
1.795     www      6307: 
1.911     bisitz   6308: ul.LC_TabContent li.active {
1.952     onken    6309:   color: $font;
1.911     bisitz   6310:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6311:   border-bottom:solid 1px #FFFFFF;
                   6312:   cursor: default;
1.744     ehlerst  6313: }
1.795     www      6314: 
1.959     onken    6315: ul.LC_TabContent li.active a {
                   6316:   color:$font;
                   6317:   background:#FFFFFF;
                   6318:   outline: none;
                   6319: }
1.870     tempelho 6320: #maincoursedoc {
1.911     bisitz   6321:   clear:both;
1.870     tempelho 6322: }
                   6323: 
                   6324: ul.LC_TabContentBigger {
1.911     bisitz   6325:   display:block;
                   6326:   list-style:none;
                   6327:   padding: 0;
1.870     tempelho 6328: }
                   6329: 
1.795     www      6330: ul.LC_TabContentBigger li {
1.911     bisitz   6331:   vertical-align:bottom;
                   6332:   height: 30px;
                   6333:   font-size:110%;
                   6334:   font-weight:bold;
                   6335:   color: #737373;
1.841     tempelho 6336: }
                   6337: 
1.957     onken    6338: ul.LC_TabContentBigger li.active {
                   6339:   position: relative;
                   6340:   top: 1px;
                   6341: }
                   6342: 
1.870     tempelho 6343: ul.LC_TabContentBigger li a {
1.911     bisitz   6344:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6345:   height: 30px;
                   6346:   line-height: 30px;
                   6347:   text-align: center;
                   6348:   display: block;
                   6349:   text-decoration: none;
1.958     onken    6350:   outline: none;  
1.741     harmsja  6351: }
1.795     www      6352: 
1.870     tempelho 6353: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6354:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6355:   color:$font;
1.744     ehlerst  6356: }
1.795     www      6357: 
1.870     tempelho 6358: ul.LC_TabContentBigger li b {
1.911     bisitz   6359:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6360:   display: block;
                   6361:   float: left;
                   6362:   padding: 0 30px;
1.957     onken    6363:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6364: }
                   6365: 
1.956     onken    6366: ul.LC_TabContentBigger li:hover b {
                   6367:   color:$button_hover;
                   6368: }
                   6369: 
1.870     tempelho 6370: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6371:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6372:   color:$font;
1.957     onken    6373:   border: 0;
1.741     harmsja  6374: }
1.693     droeschl 6375: 
1.870     tempelho 6376: 
1.862     bisitz   6377: ul.LC_CourseBreadcrumbs {
                   6378:   background: $sidebg;
1.1020    raeburn  6379:   height: 2em;
1.862     bisitz   6380:   padding-left: 10px;
1.1020    raeburn  6381:   margin: 0;
1.862     bisitz   6382:   list-style-position: inside;
                   6383: }
                   6384: 
1.911     bisitz   6385: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6386: ol#LC_PathBreadcrumbs {
1.911     bisitz   6387:   padding-left: 10px;
                   6388:   margin: 0;
1.933     droeschl 6389:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6390: }
                   6391: 
1.911     bisitz   6392: ol#LC_MenuBreadcrumbs li,
                   6393: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6394: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6395:   display: inline;
1.933     droeschl 6396:   white-space: normal;  
1.693     droeschl 6397: }
                   6398: 
1.823     bisitz   6399: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6400: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6401:   text-decoration: none;
                   6402:   font-size:90%;
1.693     droeschl 6403: }
1.795     www      6404: 
1.969     droeschl 6405: ol#LC_MenuBreadcrumbs h1 {
                   6406:   display: inline;
                   6407:   font-size: 90%;
                   6408:   line-height: 2.5em;
                   6409:   margin: 0;
                   6410:   padding: 0;
                   6411: }
                   6412: 
1.795     www      6413: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6414:   text-decoration:none;
                   6415:   font-size:100%;
                   6416:   font-weight:bold;
1.693     droeschl 6417: }
1.795     www      6418: 
1.840     bisitz   6419: .LC_Box {
1.911     bisitz   6420:   border: solid 1px $lg_border_color;
                   6421:   padding: 0 10px 10px 10px;
1.746     neumanie 6422: }
1.795     www      6423: 
1.1020    raeburn  6424: .LC_DocsBox {
                   6425:   border: solid 1px $lg_border_color;
                   6426:   padding: 0 0 10px 10px;
                   6427: }
                   6428: 
1.795     www      6429: .LC_AboutMe_Image {
1.911     bisitz   6430:   float:left;
                   6431:   margin-right:10px;
1.747     neumanie 6432: }
1.795     www      6433: 
                   6434: .LC_Clear_AboutMe_Image {
1.911     bisitz   6435:   clear:left;
1.747     neumanie 6436: }
1.795     www      6437: 
1.721     harmsja  6438: dl.LC_ListStyleClean dt {
1.911     bisitz   6439:   padding-right: 5px;
                   6440:   display: table-header-group;
1.693     droeschl 6441: }
                   6442: 
1.721     harmsja  6443: dl.LC_ListStyleClean dd {
1.911     bisitz   6444:   display: table-row;
1.693     droeschl 6445: }
                   6446: 
1.721     harmsja  6447: .LC_ListStyleClean,
                   6448: .LC_ListStyleSimple,
                   6449: .LC_ListStyleNormal,
1.795     www      6450: .LC_ListStyleSpecial {
1.911     bisitz   6451:   /* display:block; */
                   6452:   list-style-position: inside;
                   6453:   list-style-type: none;
                   6454:   overflow: hidden;
                   6455:   padding: 0;
1.693     droeschl 6456: }
                   6457: 
1.721     harmsja  6458: .LC_ListStyleSimple li,
                   6459: .LC_ListStyleSimple dd,
                   6460: .LC_ListStyleNormal li,
                   6461: .LC_ListStyleNormal dd,
                   6462: .LC_ListStyleSpecial li,
1.795     www      6463: .LC_ListStyleSpecial dd {
1.911     bisitz   6464:   margin: 0;
                   6465:   padding: 5px 5px 5px 10px;
                   6466:   clear: both;
1.693     droeschl 6467: }
                   6468: 
1.721     harmsja  6469: .LC_ListStyleClean li,
                   6470: .LC_ListStyleClean dd {
1.911     bisitz   6471:   padding-top: 0;
                   6472:   padding-bottom: 0;
1.693     droeschl 6473: }
                   6474: 
1.721     harmsja  6475: .LC_ListStyleSimple dd,
1.795     www      6476: .LC_ListStyleSimple li {
1.911     bisitz   6477:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6478: }
                   6479: 
1.721     harmsja  6480: .LC_ListStyleSpecial li,
                   6481: .LC_ListStyleSpecial dd {
1.911     bisitz   6482:   list-style-type: none;
                   6483:   background-color: RGB(220, 220, 220);
                   6484:   margin-bottom: 4px;
1.693     droeschl 6485: }
                   6486: 
1.721     harmsja  6487: table.LC_SimpleTable {
1.911     bisitz   6488:   margin:5px;
                   6489:   border:solid 1px $lg_border_color;
1.795     www      6490: }
1.693     droeschl 6491: 
1.721     harmsja  6492: table.LC_SimpleTable tr {
1.911     bisitz   6493:   padding: 0;
                   6494:   border:solid 1px $lg_border_color;
1.693     droeschl 6495: }
1.795     www      6496: 
                   6497: table.LC_SimpleTable thead {
1.911     bisitz   6498:   background:rgb(220,220,220);
1.693     droeschl 6499: }
                   6500: 
1.721     harmsja  6501: div.LC_columnSection {
1.911     bisitz   6502:   display: block;
                   6503:   clear: both;
                   6504:   overflow: hidden;
                   6505:   margin: 0;
1.693     droeschl 6506: }
                   6507: 
1.721     harmsja  6508: div.LC_columnSection>* {
1.911     bisitz   6509:   float: left;
                   6510:   margin: 10px 20px 10px 0;
                   6511:   overflow:hidden;
1.693     droeschl 6512: }
1.721     harmsja  6513: 
1.795     www      6514: table em {
1.911     bisitz   6515:   font-weight: bold;
                   6516:   font-style: normal;
1.748     schulted 6517: }
1.795     www      6518: 
1.779     bisitz   6519: table.LC_tableBrowseRes,
1.795     www      6520: table.LC_tableOfContent {
1.911     bisitz   6521:   border:none;
                   6522:   border-spacing: 1px;
                   6523:   padding: 3px;
                   6524:   background-color: #FFFFFF;
                   6525:   font-size: 90%;
1.753     droeschl 6526: }
1.789     droeschl 6527: 
1.911     bisitz   6528: table.LC_tableOfContent {
                   6529:   border-collapse: collapse;
1.789     droeschl 6530: }
                   6531: 
1.771     droeschl 6532: table.LC_tableBrowseRes a,
1.768     schulted 6533: table.LC_tableOfContent a {
1.911     bisitz   6534:   background-color: transparent;
                   6535:   text-decoration: none;
1.753     droeschl 6536: }
                   6537: 
1.795     www      6538: table.LC_tableOfContent img {
1.911     bisitz   6539:   border: none;
                   6540:   height: 1.3em;
                   6541:   vertical-align: text-bottom;
                   6542:   margin-right: 0.3em;
1.753     droeschl 6543: }
1.757     schulted 6544: 
1.795     www      6545: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6546:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6547: }
                   6548: 
1.795     www      6549: a#LC_content_toolbar_everything {
1.911     bisitz   6550:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6551: }
                   6552: 
1.795     www      6553: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6554:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6555: }
                   6556: 
1.795     www      6557: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6558:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6559: }
                   6560: 
1.795     www      6561: a#LC_content_toolbar_changefolder {
1.911     bisitz   6562:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6563: }
                   6564: 
1.795     www      6565: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6566:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6567: }
                   6568: 
1.795     www      6569: ul#LC_toolbar li a:hover {
1.911     bisitz   6570:   background-position: bottom center;
1.757     schulted 6571: }
                   6572: 
1.795     www      6573: ul#LC_toolbar {
1.911     bisitz   6574:   padding: 0;
                   6575:   margin: 2px;
                   6576:   list-style:none;
                   6577:   position:relative;
                   6578:   background-color:white;
1.757     schulted 6579: }
                   6580: 
1.795     www      6581: ul#LC_toolbar li {
1.911     bisitz   6582:   border:1px solid white;
                   6583:   padding: 0;
                   6584:   margin: 0;
                   6585:   float: left;
                   6586:   display:inline;
                   6587:   vertical-align:middle;
                   6588: }
1.757     schulted 6589: 
1.783     amueller 6590: 
1.795     www      6591: a.LC_toolbarItem {
1.911     bisitz   6592:   display:block;
                   6593:   padding: 0;
                   6594:   margin: 0;
                   6595:   height: 32px;
                   6596:   width: 32px;
                   6597:   color:white;
                   6598:   border: none;
                   6599:   background-repeat:no-repeat;
                   6600:   background-color:transparent;
1.757     schulted 6601: }
                   6602: 
1.915     droeschl 6603: ul.LC_funclist {
                   6604:     margin: 0;
                   6605:     padding: 0.5em 1em 0.5em 0;
                   6606: }
                   6607: 
1.933     droeschl 6608: ul.LC_funclist > li:first-child {
                   6609:     font-weight:bold; 
                   6610:     margin-left:0.8em;
                   6611: }
                   6612: 
1.915     droeschl 6613: ul.LC_funclist + ul.LC_funclist {
                   6614:     /* 
                   6615:        left border as a seperator if we have more than
                   6616:        one list 
                   6617:     */
                   6618:     border-left: 1px solid $sidebg;
                   6619:     /* 
                   6620:        this hides the left border behind the border of the 
                   6621:        outer box if element is wrapped to the next 'line' 
                   6622:     */
                   6623:     margin-left: -1px;
                   6624: }
                   6625: 
1.843     bisitz   6626: ul.LC_funclist li {
1.915     droeschl 6627:   display: inline;
1.782     bisitz   6628:   white-space: nowrap;
1.915     droeschl 6629:   margin: 0 0 0 25px;
                   6630:   line-height: 150%;
1.782     bisitz   6631: }
                   6632: 
1.974     wenzelju 6633: .LC_hidden {
                   6634:   display: none;
                   6635: }
                   6636: 
1.1030  ! www      6637: .LCmodal-overlay {
        !          6638: 		position:fixed;
        !          6639: 		top:0;
        !          6640: 		right:0;
        !          6641: 		bottom:0;
        !          6642: 		left:0;
        !          6643: 		height:100%;
        !          6644: 		width:100%;
        !          6645: 		margin:0;
        !          6646: 		padding:0;
        !          6647: 		background:#999;
        !          6648: 		opacity:.75;
        !          6649: 		filter: alpha(opacity=75);
        !          6650: 		-moz-opacity: 0.75;
        !          6651: 		z-index:101;
        !          6652: }
        !          6653: 
        !          6654: * html .LCmodal-overlay {   
        !          6655: 		position: absolute;
        !          6656: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
        !          6657: }
        !          6658: 
        !          6659: .LCmodal-window {
        !          6660: 		position:fixed;
        !          6661: 		top:50%;
        !          6662: 		left:50%;
        !          6663: 		margin:0;
        !          6664: 		padding:0;
        !          6665: 		z-index:102;
        !          6666: 	}
        !          6667: 
        !          6668: * html .LCmodal-window {
        !          6669: 		position:absolute;
        !          6670: }
        !          6671: 
        !          6672: .LCclose-window {
        !          6673: 		position:absolute;
        !          6674: 		width:32px;
        !          6675: 		height:32px;
        !          6676: 		right:8px;
        !          6677: 		top:8px;
        !          6678: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
        !          6679: 		text-indent:-99999px;
        !          6680: 		overflow:hidden;
        !          6681: 		cursor:pointer;
        !          6682: }
        !          6683: 
1.343     albertel 6684: END
                   6685: }
                   6686: 
1.306     albertel 6687: =pod
                   6688: 
                   6689: =item * &headtag()
                   6690: 
                   6691: Returns a uniform footer for LON-CAPA web pages.
                   6692: 
1.307     albertel 6693: Inputs: $title - optional title for the head
                   6694:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 6695:         $args - optional arguments
1.319     albertel 6696:             force_register - if is true call registerurl so the remote is 
                   6697:                              informed
1.415     albertel 6698:             redirect       -> array ref of
                   6699:                                    1- seconds before redirect occurs
                   6700:                                    2- url to redirect to
                   6701:                                    3- whether the side effect should occur
1.315     albertel 6702:                            (side effect of setting 
                   6703:                                $env{'internal.head.redirect'} to the url 
                   6704:                                redirected too)
1.352     albertel 6705:             domain         -> force to color decorate a page for a specific
                   6706:                                domain
                   6707:             function       -> force usage of a specific rolish color scheme
                   6708:             bgcolor        -> override the default page bgcolor
1.460     albertel 6709:             no_auto_mt_title
                   6710:                            -> prevent &mt()ing the title arg
1.464     albertel 6711: 
1.306     albertel 6712: =cut
                   6713: 
                   6714: sub headtag {
1.313     albertel 6715:     my ($title,$head_extra,$args) = @_;
1.306     albertel 6716:     
1.363     albertel 6717:     my $function = $args->{'function'} || &get_users_function();
                   6718:     my $domain   = $args->{'domain'}   || &determinedomain();
                   6719:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 6720:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 6721: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 6722: 		   #time(),
1.418     albertel 6723: 		   $env{'environment.color.timestamp'},
1.363     albertel 6724: 		   $function,$domain,$bgcolor);
                   6725: 
1.369     www      6726:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 6727: 
1.308     albertel 6728:     my $result =
                   6729: 	'<head>'.
1.461     albertel 6730: 	&font_settings();
1.319     albertel 6731: 
1.461     albertel 6732:     if (!$args->{'frameset'}) {
                   6733: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   6734:     }
1.962     droeschl 6735:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   6736:         $result .= Apache::lonxml::display_title();
1.319     albertel 6737:     }
1.436     albertel 6738:     if (!$args->{'no_nav_bar'} 
                   6739: 	&& !$args->{'only_body'}
                   6740: 	&& !$args->{'frameset'}) {
                   6741: 	$result .= &help_menu_js();
                   6742:     }
1.1030  ! www      6743:     $result.=&modal_window();
1.314     albertel 6744:     if (ref($args->{'redirect'})) {
1.414     albertel 6745: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6746: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6747: 	if (!$inhibit_continue) {
                   6748: 	    $env{'internal.head.redirect'} = $url;
                   6749: 	}
1.313     albertel 6750: 	$result.=<<ADDMETA
                   6751: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6752: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6753: ADDMETA
                   6754:     }
1.306     albertel 6755:     if (!defined($title)) {
                   6756: 	$title = 'The LearningOnline Network with CAPA';
                   6757:     }
1.460     albertel 6758:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6759:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6760: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   6761: 	.$head_extra;
1.962     droeschl 6762:     return $result.'</head>';
1.306     albertel 6763: }
                   6764: 
                   6765: =pod
                   6766: 
1.340     albertel 6767: =item * &font_settings()
                   6768: 
                   6769: Returns neccessary <meta> to set the proper encoding
                   6770: 
                   6771: Inputs: none
                   6772: 
                   6773: =cut
                   6774: 
                   6775: sub font_settings {
                   6776:     my $headerstring='';
1.647     www      6777:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6778: 	$headerstring.=
                   6779: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6780:     }
                   6781:     return $headerstring;
                   6782: }
                   6783: 
1.341     albertel 6784: =pod
                   6785: 
                   6786: =item * &xml_begin()
                   6787: 
                   6788: Returns the needed doctype and <html>
                   6789: 
                   6790: Inputs: none
                   6791: 
                   6792: =cut
                   6793: 
                   6794: sub xml_begin {
                   6795:     my $output='';
                   6796: 
                   6797:     if ($env{'browser.mathml'}) {
                   6798: 	$output='<?xml version="1.0"?>'
                   6799:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   6800: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   6801:             
                   6802: #	    .'<!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">] >'
                   6803: 	    .'<!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">'
                   6804:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   6805: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   6806:     } else {
1.849     bisitz   6807: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   6808:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 6809:     }
                   6810:     return $output;
                   6811: }
1.340     albertel 6812: 
                   6813: =pod
                   6814: 
1.306     albertel 6815: =item * &start_page()
                   6816: 
                   6817: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6818: 
1.648     raeburn  6819: Inputs:
                   6820: 
                   6821: =over 4
                   6822: 
                   6823: $title - optional title for the page
                   6824: 
                   6825: $head_extra - optional extra HTML to incude inside the <head>
                   6826: 
                   6827: $args - additional optional args supported are:
                   6828: 
                   6829: =over 8
                   6830: 
                   6831:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6832:                                     arg on
1.814     bisitz   6833:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  6834:              add_entries    -> additional attributes to add to the  <body>
                   6835:              domain         -> force to color decorate a page for a 
1.317     albertel 6836:                                     specific domain
1.648     raeburn  6837:              function       -> force usage of a specific rolish color
1.317     albertel 6838:                                     scheme
1.648     raeburn  6839:              redirect       -> see &headtag()
                   6840:              bgcolor        -> override the default page bg color
                   6841:              js_ready       -> return a string ready for being used in 
1.317     albertel 6842:                                     a javascript writeln
1.648     raeburn  6843:              html_encode    -> return a string ready for being used in 
1.320     albertel 6844:                                     a html attribute
1.648     raeburn  6845:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6846:                                     $forcereg arg
1.648     raeburn  6847:              frameset       -> if true will start with a <frameset>
1.330     albertel 6848:                                     rather than <body>
1.648     raeburn  6849:              skip_phases    -> hash ref of 
1.338     albertel 6850:                                     head -> skip the <html><head> generation
                   6851:                                     body -> skip all <body> generation
1.648     raeburn  6852:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6853:              inherit_jsmath -> when creating popup window in a page,
                   6854:                                     should it have jsmath forced on by the
                   6855:                                     current page
1.867     kalberla 6856:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  6857:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 6858: 
1.648     raeburn  6859: =back
1.460     albertel 6860: 
1.648     raeburn  6861: =back
1.562     albertel 6862: 
1.306     albertel 6863: =cut
                   6864: 
                   6865: sub start_page {
1.309     albertel 6866:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6867:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 6868: 
1.315     albertel 6869:     $env{'internal.start_page'}++;
1.338     albertel 6870:     my $result;
1.964     droeschl 6871: 
1.338     albertel 6872:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030  ! www      6873:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 6874:     }
                   6875:     
                   6876:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6877: 	if ($args->{'frameset'}) {
                   6878: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6879: 						$args->{'add_entries'});
                   6880: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   6881:         } else {
                   6882:             $result .=
                   6883:                 &bodytag($title, 
                   6884:                          $args->{'function'},       $args->{'add_entries'},
                   6885:                          $args->{'only_body'},      $args->{'domain'},
                   6886:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 6887:                          $args->{'bgcolor'},        $args);
1.831     bisitz   6888:         }
1.330     albertel 6889:     }
1.338     albertel 6890: 
1.315     albertel 6891:     if ($args->{'js_ready'}) {
1.713     kaisler  6892: 		$result = &js_ready($result);
1.315     albertel 6893:     }
1.320     albertel 6894:     if ($args->{'html_encode'}) {
1.713     kaisler  6895: 		$result = &html_encode($result);
                   6896:     }
                   6897: 
1.813     bisitz   6898:     # Preparation for new and consistent functionlist at top of screen
                   6899:     # if ($args->{'functionlist'}) {
                   6900:     #            $result .= &build_functionlist();
                   6901:     #}
                   6902: 
1.964     droeschl 6903:     # Don't add anything more if only_body wanted or in const space
                   6904:     return $result if    $args->{'only_body'} 
                   6905:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   6906: 
                   6907:     #Breadcrumbs
1.758     kaisler  6908:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   6909: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   6910: 		#if any br links exists, add them to the breadcrumbs
                   6911: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6912: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6913: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6914: 			}
                   6915: 		}
                   6916: 
                   6917: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   6918: 		if(exists($args->{'bread_crumbs_component'})){
                   6919: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   6920: 		}else{
                   6921: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   6922: 		}
1.320     albertel 6923:     }
1.315     albertel 6924:     return $result;
1.306     albertel 6925: }
                   6926: 
                   6927: sub end_page {
1.315     albertel 6928:     my ($args) = @_;
                   6929:     $env{'internal.end_page'}++;
1.330     albertel 6930:     my $result;
1.335     albertel 6931:     if ($args->{'discussion'}) {
                   6932: 	my ($target,$parser);
                   6933: 	if (ref($args->{'discussion'})) {
                   6934: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6935: 				$args->{'discussion'}{'parser'});
                   6936: 	}
                   6937: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6938:     }
1.330     albertel 6939:     if ($args->{'frameset'}) {
                   6940: 	$result .= '</frameset>';
                   6941:     } else {
1.635     raeburn  6942: 	$result .= &endbodytag($args);
1.330     albertel 6943:     }
                   6944:     $result .= "\n</html>";
                   6945: 
1.315     albertel 6946:     if ($args->{'js_ready'}) {
1.317     albertel 6947: 	$result = &js_ready($result);
1.315     albertel 6948:     }
1.335     albertel 6949: 
1.320     albertel 6950:     if ($args->{'html_encode'}) {
                   6951: 	$result = &html_encode($result);
                   6952:     }
1.335     albertel 6953: 
1.315     albertel 6954:     return $result;
                   6955: }
                   6956: 
1.1030  ! www      6957: sub modal_window {
        !          6958:     return(<<'ENDMODAL');
        !          6959: <script type="text/javascript" lang="javascript">
        !          6960: // <![CDATA[
        !          6961: // <!-- BEGIN LON-CAPA Internal
        !          6962: var modalWindow = {
        !          6963: 	parent:"body",
        !          6964: 	windowId:null,
        !          6965: 	content:null,
        !          6966: 	width:null,
        !          6967: 	height:null,
        !          6968: 	close:function()
        !          6969: 	{
        !          6970: 	        $(".LCmodal-window").remove();
        !          6971: 	        $(".LCmodal-overlay").remove();
        !          6972: 	},
        !          6973: 	open:function()
        !          6974: 	{
        !          6975: 		var modal = "";
        !          6976: 		modal += "<div class=\"LCmodal-overlay\"></div>";
        !          6977: 		modal += "<div id=\"" + this.windowId + "\" class=\"LCmodal-window\" style=\"width:" + this.width + "px; height:" + this.height + "px; margin-top:-" + (this.height / 2) + "px; margin-left:-" + (this.width / 2) + "px;\">";
        !          6978: 		modal += this.content;
        !          6979: 		modal += "</div>";	
        !          6980: 
        !          6981: 		$(this.parent).append(modal);
        !          6982: 
        !          6983: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
        !          6984: 		$(".LCclose-window").click(function(){modalWindow.close();});
        !          6985: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
        !          6986: 	}
        !          6987: };
        !          6988: 	var openMyModal = function(source,width,height)
        !          6989: 	{
        !          6990: 		modalWindow.windowId = "myModal";
        !          6991: 		modalWindow.width = width;
        !          6992: 		modalWindow.height = height;
        !          6993: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='no' allowtransparency='true' src='" + source + "'>&lt/iframe>";
        !          6994: 		modalWindow.open();
        !          6995: 	};	
        !          6996: // END LON-CAPA Internal -->
        !          6997: // ]]>
        !          6998: </script>
        !          6999: ENDMODAL
        !          7000: }
        !          7001: 
        !          7002: sub modal_link {
        !          7003:     my ($link,$linktext,$width,$height,$target)=@_;
        !          7004:     unless ($width) { $width=480; }
        !          7005:     unless ($height) { $height=400; }
        !          7006:     return '<a href="'.$link.'" target="'.$target.'" onclick="openMyModal(\''.$link.'\','.$width.','.$height.'); return false;">'.$linktext.'</a>';
        !          7007: }
        !          7008: 
1.320     albertel 7009: sub html_encode {
                   7010:     my ($result) = @_;
                   7011: 
1.322     albertel 7012:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7013:     
                   7014:     return $result;
                   7015: }
1.317     albertel 7016: sub js_ready {
                   7017:     my ($result) = @_;
                   7018: 
1.323     albertel 7019:     $result =~ s/[\n\r]/ /xmsg;
                   7020:     $result =~ s/\\/\\\\/xmsg;
                   7021:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7022:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7023:     
                   7024:     return $result;
                   7025: }
                   7026: 
1.315     albertel 7027: sub validate_page {
                   7028:     if (  exists($env{'internal.start_page'})
1.316     albertel 7029: 	  &&     $env{'internal.start_page'} > 1) {
                   7030: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7031: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7032: 				 $ENV{'request.filename'});
1.315     albertel 7033:     }
                   7034:     if (  exists($env{'internal.end_page'})
1.316     albertel 7035: 	  &&     $env{'internal.end_page'} > 1) {
                   7036: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7037: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7038: 				 $env{'request.filename'});
1.315     albertel 7039:     }
                   7040:     if (     exists($env{'internal.start_page'})
                   7041: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7042: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7043: 				 $env{'request.filename'});
1.315     albertel 7044:     }
                   7045:     if (   ! exists($env{'internal.start_page'})
                   7046: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7047: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7048: 				 $env{'request.filename'});
1.315     albertel 7049:     }
1.306     albertel 7050: }
1.315     albertel 7051: 
1.996     www      7052: 
                   7053: sub start_scrollbox {
1.1018    raeburn  7054:     my ($outerwidth,$width,$height,$id)=@_;
1.998     raeburn  7055:     unless ($outerwidth) { $outerwidth='520px'; }
                   7056:     unless ($width) { $width='500px'; }
                   7057:     unless ($height) { $height='200px'; }
1.1020    raeburn  7058:     my ($table_id,$div_id);
1.1018    raeburn  7059:     if ($id ne '') {
1.1020    raeburn  7060:         $table_id = " id='table_$id'";
                   7061:         $div_id = " id='div_$id'";
1.1018    raeburn  7062:     }
1.1020    raeburn  7063:     return "<table style='width: $outerwidth; border: 1px solid none;'$table_id><tr><td style='width: $width;' bgcolor='#FFFFFF'><div style='overflow:auto; width:$width; height: $height;'$div_id>";
1.996     www      7064: }
                   7065: 
                   7066: sub end_scrollbox {
1.998     raeburn  7067:     return '</td></tr></table>';
1.996     www      7068: }
                   7069: 
1.318     albertel 7070: sub simple_error_page {
                   7071:     my ($r,$title,$msg) = @_;
                   7072:     my $page =
                   7073: 	&Apache::loncommon::start_page($title).
                   7074: 	&mt($msg).
                   7075: 	&Apache::loncommon::end_page();
                   7076:     if (ref($r)) {
                   7077: 	$r->print($page);
1.327     albertel 7078: 	return;
1.318     albertel 7079:     }
                   7080:     return $page;
                   7081: }
1.347     albertel 7082: 
                   7083: {
1.610     albertel 7084:     my @row_count;
1.961     onken    7085: 
                   7086:     sub start_data_table_count {
                   7087:         unshift(@row_count, 0);
                   7088:         return;
                   7089:     }
                   7090: 
                   7091:     sub end_data_table_count {
                   7092:         shift(@row_count);
                   7093:         return;
                   7094:     }
                   7095: 
1.347     albertel 7096:     sub start_data_table {
1.1018    raeburn  7097: 	my ($add_class,$id) = @_;
1.422     albertel 7098: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7099:         my $table_id;
                   7100:         if (defined($id)) {
                   7101:             $table_id = ' id="'.$id.'"';
                   7102:         }
1.961     onken    7103: 	&start_data_table_count();
1.1018    raeburn  7104: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7105:     }
                   7106: 
                   7107:     sub end_data_table {
1.961     onken    7108: 	&end_data_table_count();
1.389     albertel 7109: 	return '</table>'."\n";;
1.347     albertel 7110:     }
                   7111: 
                   7112:     sub start_data_table_row {
1.974     wenzelju 7113: 	my ($add_class, $id) = @_;
1.610     albertel 7114: 	$row_count[0]++;
                   7115: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7116: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7117:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7118:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7119:     }
1.471     banghart 7120:     
                   7121:     sub continue_data_table_row {
1.974     wenzelju 7122: 	my ($add_class, $id) = @_;
1.610     albertel 7123: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7124: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7125:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7126:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7127:     }
1.347     albertel 7128: 
                   7129:     sub end_data_table_row {
1.389     albertel 7130: 	return '</tr>'."\n";;
1.347     albertel 7131:     }
1.367     www      7132: 
1.421     albertel 7133:     sub start_data_table_empty_row {
1.707     bisitz   7134: #	$row_count[0]++;
1.421     albertel 7135: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7136:     }
                   7137: 
                   7138:     sub end_data_table_empty_row {
                   7139: 	return '</tr>'."\n";;
                   7140:     }
                   7141: 
1.367     www      7142:     sub start_data_table_header_row {
1.389     albertel 7143: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7144:     }
                   7145: 
                   7146:     sub end_data_table_header_row {
1.389     albertel 7147: 	return '</tr>'."\n";;
1.367     www      7148:     }
1.890     droeschl 7149: 
                   7150:     sub data_table_caption {
                   7151:         my $caption = shift;
                   7152:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7153:     }
1.347     albertel 7154: }
                   7155: 
1.548     albertel 7156: =pod
                   7157: 
                   7158: =item * &inhibit_menu_check($arg)
                   7159: 
                   7160: Checks for a inhibitmenu state and generates output to preserve it
                   7161: 
                   7162: Inputs:         $arg - can be any of
                   7163:                      - undef - in which case the return value is a string 
                   7164:                                to add  into arguments list of a uri
                   7165:                      - 'input' - in which case the return value is a HTML
                   7166:                                  <form> <input> field of type hidden to
                   7167:                                  preserve the value
                   7168:                      - a url - in which case the return value is the url with
                   7169:                                the neccesary cgi args added to preserve the
                   7170:                                inhibitmenu state
                   7171:                      - a ref to a url - no return value, but the string is
                   7172:                                         updated to include the neccessary cgi
                   7173:                                         args to preserve the inhibitmenu state
                   7174: 
                   7175: =cut
                   7176: 
                   7177: sub inhibit_menu_check {
                   7178:     my ($arg) = @_;
                   7179:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7180:     if ($arg eq 'input') {
                   7181: 	if ($env{'form.inhibitmenu'}) {
                   7182: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7183: 	} else {
                   7184: 	    return
                   7185: 	}
                   7186:     }
                   7187:     if ($env{'form.inhibitmenu'}) {
                   7188: 	if (ref($arg)) {
                   7189: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7190: 	} elsif ($arg eq '') {
                   7191: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7192: 	} else {
                   7193: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7194: 	}
                   7195:     }
                   7196:     if (!ref($arg)) {
                   7197: 	return $arg;
                   7198:     }
                   7199: }
                   7200: 
1.251     albertel 7201: ###############################################
1.182     matthew  7202: 
                   7203: =pod
                   7204: 
1.549     albertel 7205: =back
                   7206: 
                   7207: =head1 User Information Routines
                   7208: 
                   7209: =over 4
                   7210: 
1.405     albertel 7211: =item * &get_users_function()
1.182     matthew  7212: 
                   7213: Used by &bodytag to determine the current users primary role.
                   7214: Returns either 'student','coordinator','admin', or 'author'.
                   7215: 
                   7216: =cut
                   7217: 
                   7218: ###############################################
                   7219: sub get_users_function {
1.815     tempelho 7220:     my $function = 'norole';
1.818     tempelho 7221:     if ($env{'request.role'}=~/^(st)/) {
                   7222:         $function='student';
                   7223:     }
1.907     raeburn  7224:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7225:         $function='coordinator';
                   7226:     }
1.258     albertel 7227:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7228:         $function='admin';
                   7229:     }
1.826     bisitz   7230:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  7231:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  7232:         $function='author';
                   7233:     }
                   7234:     return $function;
1.54      www      7235: }
1.99      www      7236: 
                   7237: ###############################################
                   7238: 
1.233     raeburn  7239: =pod
                   7240: 
1.821     raeburn  7241: =item * &show_course()
                   7242: 
                   7243: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7244: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7245: 
                   7246: Inputs:
                   7247: None
                   7248: 
                   7249: Outputs:
                   7250: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7251: 
                   7252: =cut
                   7253: 
                   7254: ###############################################
                   7255: sub show_course {
                   7256:     my $course = !$env{'user.adv'};
                   7257:     if (!$env{'user.adv'}) {
                   7258:         foreach my $env (keys(%env)) {
                   7259:             next if ($env !~ m/^user\.priv\./);
                   7260:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7261:                 $course = 0;
                   7262:                 last;
                   7263:             }
                   7264:         }
                   7265:     }
                   7266:     return $course;
                   7267: }
                   7268: 
                   7269: ###############################################
                   7270: 
                   7271: =pod
                   7272: 
1.542     raeburn  7273: =item * &check_user_status()
1.274     raeburn  7274: 
                   7275: Determines current status of supplied role for a
                   7276: specific user. Roles can be active, previous or future.
                   7277: 
                   7278: Inputs: 
                   7279: user's domain, user's username, course's domain,
1.375     raeburn  7280: course's number, optional section ID.
1.274     raeburn  7281: 
                   7282: Outputs:
                   7283: role status: active, previous or future. 
                   7284: 
                   7285: =cut
                   7286: 
                   7287: sub check_user_status {
1.412     raeburn  7288:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.982     raeburn  7289:     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   7290:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
1.274     raeburn  7291:     my @uroles = keys %userinfo;
                   7292:     my $srchstr;
                   7293:     my $active_chk = 'none';
1.412     raeburn  7294:     my $now = time;
1.274     raeburn  7295:     if (@uroles > 0) {
1.908     raeburn  7296:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7297:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7298:         } else {
1.412     raeburn  7299:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7300:         }
                   7301:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7302:             my $role_end = 0;
                   7303:             my $role_start = 0;
                   7304:             $active_chk = 'active';
1.412     raeburn  7305:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7306:                 $role_end = $1;
                   7307:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7308:                     $role_start = $1;
1.274     raeburn  7309:                 }
                   7310:             }
                   7311:             if ($role_start > 0) {
1.412     raeburn  7312:                 if ($now < $role_start) {
1.274     raeburn  7313:                     $active_chk = 'future';
                   7314:                 }
                   7315:             }
                   7316:             if ($role_end > 0) {
1.412     raeburn  7317:                 if ($now > $role_end) {
1.274     raeburn  7318:                     $active_chk = 'previous';
                   7319:                 }
                   7320:             }
                   7321:         }
                   7322:     }
                   7323:     return $active_chk;
                   7324: }
                   7325: 
                   7326: ###############################################
                   7327: 
                   7328: =pod
                   7329: 
1.405     albertel 7330: =item * &get_sections()
1.233     raeburn  7331: 
                   7332: Determines all the sections for a course including
                   7333: sections with students and sections containing other roles.
1.419     raeburn  7334: Incoming parameters: 
                   7335: 
                   7336: 1. domain
                   7337: 2. course number 
                   7338: 3. reference to array containing roles for which sections should 
                   7339: be gathered (optional).
                   7340: 4. reference to array containing status types for which sections 
                   7341: should be gathered (optional).
                   7342: 
                   7343: If the third argument is undefined, sections are gathered for any role. 
                   7344: If the fourth argument is undefined, sections are gathered for any status.
                   7345: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7346:  
1.374     raeburn  7347: Returns section hash (keys are section IDs, values are
                   7348: number of users in each section), subject to the
1.419     raeburn  7349: optional roles filter, optional status filter 
1.233     raeburn  7350: 
                   7351: =cut
                   7352: 
                   7353: ###############################################
                   7354: sub get_sections {
1.419     raeburn  7355:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7356:     if (!defined($cdom) || !defined($cnum)) {
                   7357:         my $cid =  $env{'request.course.id'};
                   7358: 
                   7359: 	return if (!defined($cid));
                   7360: 
                   7361:         $cdom = $env{'course.'.$cid.'.domain'};
                   7362:         $cnum = $env{'course.'.$cid.'.num'};
                   7363:     }
                   7364: 
                   7365:     my %sectioncount;
1.419     raeburn  7366:     my $now = time;
1.240     albertel 7367: 
1.366     albertel 7368:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7369: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7370: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7371: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7372:         my $start_index = &Apache::loncoursedata::CL_START();
                   7373:         my $end_index = &Apache::loncoursedata::CL_END();
                   7374:         my $status;
1.366     albertel 7375: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7376: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7377: 				                     $data->[$status_index],
                   7378:                                                      $data->[$start_index],
                   7379:                                                      $data->[$end_index]);
                   7380:             if ($stu_status eq 'Active') {
                   7381:                 $status = 'active';
                   7382:             } elsif ($end < $now) {
                   7383:                 $status = 'previous';
                   7384:             } elsif ($start > $now) {
                   7385:                 $status = 'future';
                   7386:             } 
                   7387: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7388:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7389:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7390: 		    $sectioncount{$section}++;
                   7391:                 }
1.240     albertel 7392: 	    }
                   7393: 	}
                   7394:     }
                   7395:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7396:     foreach my $user (sort(keys(%courseroles))) {
                   7397: 	if ($user !~ /^(\w{2})/) { next; }
                   7398: 	my ($role) = ($user =~ /^(\w{2})/);
                   7399: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7400: 	my ($section,$status);
1.240     albertel 7401: 	if ($role eq 'cr' &&
                   7402: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7403: 	    $section=$1;
                   7404: 	}
                   7405: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7406: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7407:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7408:         if ($end == -1 && $start == -1) {
                   7409:             next; #deleted role
                   7410:         }
                   7411:         if (!defined($possible_status)) { 
                   7412:             $sectioncount{$section}++;
                   7413:         } else {
                   7414:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7415:                 $status = 'active';
                   7416:             } elsif ($end < $now) {
                   7417:                 $status = 'future';
                   7418:             } elsif ($start > $now) {
                   7419:                 $status = 'previous';
                   7420:             }
                   7421:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7422:                 $sectioncount{$section}++;
                   7423:             }
                   7424:         }
1.233     raeburn  7425:     }
1.366     albertel 7426:     return %sectioncount;
1.233     raeburn  7427: }
                   7428: 
1.274     raeburn  7429: ###############################################
1.294     raeburn  7430: 
                   7431: =pod
1.405     albertel 7432: 
                   7433: =item * &get_course_users()
                   7434: 
1.275     raeburn  7435: Retrieves usernames:domains for users in the specified course
                   7436: with specific role(s), and access status. 
                   7437: 
                   7438: Incoming parameters:
1.277     albertel 7439: 1. course domain
                   7440: 2. course number
                   7441: 3. access status: users must have - either active, 
1.275     raeburn  7442: previous, future, or all.
1.277     albertel 7443: 4. reference to array of permissible roles
1.288     raeburn  7444: 5. reference to array of section restrictions (optional)
                   7445: 6. reference to results object (hash of hashes).
                   7446: 7. reference to optional userdata hash
1.609     raeburn  7447: 8. reference to optional statushash
1.630     raeburn  7448: 9. flag if privileged users (except those set to unhide in
                   7449:    course settings) should be excluded    
1.609     raeburn  7450: Keys of top level results hash are roles.
1.275     raeburn  7451: Keys of inner hashes are username:domain, with 
                   7452: values set to access type.
1.288     raeburn  7453: Optional userdata hash returns an array with arguments in the 
                   7454: same order as loncoursedata::get_classlist() for student data.
                   7455: 
1.609     raeburn  7456: Optional statushash returns
                   7457: 
1.288     raeburn  7458: Entries for end, start, section and status are blank because
                   7459: of the possibility of multiple values for non-student roles.
                   7460: 
1.275     raeburn  7461: =cut
1.405     albertel 7462: 
1.275     raeburn  7463: ###############################################
1.405     albertel 7464: 
1.275     raeburn  7465: sub get_course_users {
1.630     raeburn  7466:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7467:     my %idx = ();
1.419     raeburn  7468:     my %seclists;
1.288     raeburn  7469: 
                   7470:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7471:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7472:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7473:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7474:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7475:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7476:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7477:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7478: 
1.290     albertel 7479:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7480:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7481:         my $now = time;
1.277     albertel 7482:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7483:             my $match = 0;
1.412     raeburn  7484:             my $secmatch = 0;
1.419     raeburn  7485:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7486:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7487:             if ($section eq '') {
                   7488:                 $section = 'none';
                   7489:             }
1.291     albertel 7490:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7491:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7492:                     $secmatch = 1;
                   7493:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 7494:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7495:                         $secmatch = 1;
                   7496:                     }
                   7497:                 } else {  
1.419     raeburn  7498: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  7499: 		        $secmatch = 1;
                   7500:                     }
1.290     albertel 7501: 		}
1.412     raeburn  7502:                 if (!$secmatch) {
                   7503:                     next;
                   7504:                 }
1.419     raeburn  7505:             }
1.275     raeburn  7506:             if (defined($$types{'active'})) {
1.288     raeburn  7507:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  7508:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  7509:                     $match = 1;
1.275     raeburn  7510:                 }
                   7511:             }
                   7512:             if (defined($$types{'previous'})) {
1.609     raeburn  7513:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  7514:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  7515:                     $match = 1;
1.275     raeburn  7516:                 }
                   7517:             }
                   7518:             if (defined($$types{'future'})) {
1.609     raeburn  7519:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  7520:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  7521:                     $match = 1;
1.275     raeburn  7522:                 }
                   7523:             }
1.609     raeburn  7524:             if ($match) {
                   7525:                 push(@{$seclists{$student}},$section);
                   7526:                 if (ref($userdata) eq 'HASH') {
                   7527:                     $$userdata{$student} = $$classlist{$student};
                   7528:                 }
                   7529:                 if (ref($statushash) eq 'HASH') {
                   7530:                     $statushash->{$student}{'st'}{$section} = $status;
                   7531:                 }
1.288     raeburn  7532:             }
1.275     raeburn  7533:         }
                   7534:     }
1.412     raeburn  7535:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  7536:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7537:         my $now = time;
1.609     raeburn  7538:         my %displaystatus = ( previous => 'Expired',
                   7539:                               active   => 'Active',
                   7540:                               future   => 'Future',
                   7541:                             );
1.630     raeburn  7542:         my %nothide;
                   7543:         if ($hidepriv) {
                   7544:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   7545:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   7546:                 if ($user !~ /:/) {
                   7547:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   7548:                 } else {
                   7549:                     $nothide{$user} = 1;
                   7550:                 }
                   7551:             }
                   7552:         }
1.439     raeburn  7553:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  7554:             my $match = 0;
1.412     raeburn  7555:             my $secmatch = 0;
1.439     raeburn  7556:             my $status;
1.412     raeburn  7557:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  7558:             $user =~ s/:$//;
1.439     raeburn  7559:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   7560:             if ($end == -1 || $start == -1) {
                   7561:                 next;
                   7562:             }
                   7563:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   7564:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  7565:                 my ($uname,$udom) = split(/:/,$user);
                   7566:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7567:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7568:                         $secmatch = 1;
                   7569:                     } elsif ($usec eq '') {
1.420     albertel 7570:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7571:                             $secmatch = 1;
                   7572:                         }
                   7573:                     } else {
                   7574:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   7575:                             $secmatch = 1;
                   7576:                         }
                   7577:                     }
                   7578:                     if (!$secmatch) {
                   7579:                         next;
                   7580:                     }
1.288     raeburn  7581:                 }
1.419     raeburn  7582:                 if ($usec eq '') {
                   7583:                     $usec = 'none';
                   7584:                 }
1.275     raeburn  7585:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  7586:                     if ($hidepriv) {
                   7587:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   7588:                             (!$nothide{$uname.':'.$udom})) {
                   7589:                             next;
                   7590:                         }
                   7591:                     }
1.503     raeburn  7592:                     if ($end > 0 && $end < $now) {
1.439     raeburn  7593:                         $status = 'previous';
                   7594:                     } elsif ($start > $now) {
                   7595:                         $status = 'future';
                   7596:                     } else {
                   7597:                         $status = 'active';
                   7598:                     }
1.277     albertel 7599:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  7600:                         if ($status eq $type) {
1.420     albertel 7601:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  7602:                                 push(@{$$users{$role}{$user}},$type);
                   7603:                             }
1.288     raeburn  7604:                             $match = 1;
                   7605:                         }
                   7606:                     }
1.419     raeburn  7607:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   7608:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   7609: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   7610:                         }
1.420     albertel 7611:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  7612:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   7613:                         }
1.609     raeburn  7614:                         if (ref($statushash) eq 'HASH') {
                   7615:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   7616:                         }
1.275     raeburn  7617:                     }
                   7618:                 }
                   7619:             }
                   7620:         }
1.290     albertel 7621:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  7622:             if ((defined($cdom)) && (defined($cnum))) {
                   7623:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   7624:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   7625:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  7626:                     next if ($owner eq '');
                   7627:                     my ($ownername,$ownerdom);
                   7628:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   7629:                         $ownername = $1;
                   7630:                         $ownerdom = $2;
                   7631:                     } else {
                   7632:                         $ownername = $owner;
                   7633:                         $ownerdom = $cdom;
                   7634:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  7635:                     }
                   7636:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 7637:                     if (defined($userdata) && 
1.609     raeburn  7638: 			!exists($$userdata{$owner})) {
                   7639: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   7640:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   7641:                             push(@{$seclists{$owner}},'none');
                   7642:                         }
                   7643:                         if (ref($statushash) eq 'HASH') {
                   7644:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  7645:                         }
1.290     albertel 7646: 		    }
1.279     raeburn  7647:                 }
                   7648:             }
                   7649:         }
1.419     raeburn  7650:         foreach my $user (keys(%seclists)) {
                   7651:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   7652:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   7653:         }
1.275     raeburn  7654:     }
                   7655:     return;
                   7656: }
                   7657: 
1.288     raeburn  7658: sub get_user_info {
                   7659:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 7660:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   7661: 	&plainname($uname,$udom,'lastname');
1.291     albertel 7662:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  7663:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  7664:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   7665:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  7666:     return;
                   7667: }
1.275     raeburn  7668: 
1.472     raeburn  7669: ###############################################
                   7670: 
                   7671: =pod
                   7672: 
                   7673: =item * &get_user_quota()
                   7674: 
                   7675: Retrieves quota assigned for storage of portfolio files for a user  
                   7676: 
                   7677: Incoming parameters:
                   7678: 1. user's username
                   7679: 2. user's domain
                   7680: 
                   7681: Returns:
1.536     raeburn  7682: 1. Disk quota (in Mb) assigned to student.
                   7683: 2. (Optional) Type of setting: custom or default
                   7684:    (individually assigned or default for user's 
                   7685:    institutional status).
                   7686: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   7687:    or student - types as defined in localenroll::inst_usertypes 
                   7688:    for user's domain, which determines default quota for user.
                   7689: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  7690: 
                   7691: If a value has been stored in the user's environment, 
1.536     raeburn  7692: it will return that, otherwise it returns the maximal default
                   7693: defined for the user's instituional status(es) in the domain.
1.472     raeburn  7694: 
                   7695: =cut
                   7696: 
                   7697: ###############################################
                   7698: 
                   7699: 
                   7700: sub get_user_quota {
                   7701:     my ($uname,$udom) = @_;
1.536     raeburn  7702:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  7703:     if (!defined($udom)) {
                   7704:         $udom = $env{'user.domain'};
                   7705:     }
                   7706:     if (!defined($uname)) {
                   7707:         $uname = $env{'user.name'};
                   7708:     }
                   7709:     if (($udom eq '' || $uname eq '') ||
                   7710:         ($udom eq 'public') && ($uname eq 'public')) {
                   7711:         $quota = 0;
1.536     raeburn  7712:         $quotatype = 'default';
                   7713:         $defquota = 0; 
1.472     raeburn  7714:     } else {
1.536     raeburn  7715:         my $inststatus;
1.472     raeburn  7716:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   7717:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  7718:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  7719:         } else {
1.536     raeburn  7720:             my %userenv = 
                   7721:                 &Apache::lonnet::get('environment',['portfolioquota',
                   7722:                                      'inststatus'],$udom,$uname);
1.472     raeburn  7723:             my ($tmp) = keys(%userenv);
                   7724:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   7725:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  7726:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  7727:             } else {
                   7728:                 undef(%userenv);
                   7729:             }
                   7730:         }
1.536     raeburn  7731:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  7732:         if ($quota eq '') {
1.536     raeburn  7733:             $quota = $defquota;
                   7734:             $quotatype = 'default';
                   7735:         } else {
                   7736:             $quotatype = 'custom';
1.472     raeburn  7737:         }
                   7738:     }
1.536     raeburn  7739:     if (wantarray) {
                   7740:         return ($quota,$quotatype,$settingstatus,$defquota);
                   7741:     } else {
                   7742:         return $quota;
                   7743:     }
1.472     raeburn  7744: }
                   7745: 
                   7746: ###############################################
                   7747: 
                   7748: =pod
                   7749: 
                   7750: =item * &default_quota()
                   7751: 
1.536     raeburn  7752: Retrieves default quota assigned for storage of user portfolio files,
                   7753: given an (optional) user's institutional status.
1.472     raeburn  7754: 
                   7755: Incoming parameters:
                   7756: 1. domain
1.536     raeburn  7757: 2. (Optional) institutional status(es).  This is a : separated list of 
                   7758:    status types (e.g., faculty, staff, student etc.)
                   7759:    which apply to the user for whom the default is being retrieved.
                   7760:    If the institutional status string in undefined, the domain
                   7761:    default quota will be returned. 
1.472     raeburn  7762: 
                   7763: Returns:
                   7764: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  7765: 2. (Optional) institutional type which determined the value of the
                   7766:    default quota.
1.472     raeburn  7767: 
                   7768: If a value has been stored in the domain's configuration db,
                   7769: it will return that, otherwise it returns 20 (for backwards 
                   7770: compatibility with domains which have not set up a configuration
                   7771: db file; the original statically defined portfolio quota was 20 Mb). 
                   7772: 
1.536     raeburn  7773: If the user's status includes multiple types (e.g., staff and student),
                   7774: the largest default quota which applies to the user determines the
                   7775: default quota returned.
                   7776: 
1.780     raeburn  7777: =back
                   7778: 
1.472     raeburn  7779: =cut
                   7780: 
                   7781: ###############################################
                   7782: 
                   7783: 
                   7784: sub default_quota {
1.536     raeburn  7785:     my ($udom,$inststatus) = @_;
                   7786:     my ($defquota,$settingstatus);
                   7787:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  7788:                                             ['quotas'],$udom);
                   7789:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  7790:         if ($inststatus ne '') {
1.765     raeburn  7791:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  7792:             foreach my $item (@statuses) {
1.711     raeburn  7793:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7794:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   7795:                         if ($defquota eq '') {
                   7796:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7797:                             $settingstatus = $item;
                   7798:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   7799:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7800:                             $settingstatus = $item;
                   7801:                         }
                   7802:                     }
                   7803:                 } else {
                   7804:                     if ($quotahash{'quotas'}{$item} ne '') {
                   7805:                         if ($defquota eq '') {
                   7806:                             $defquota = $quotahash{'quotas'}{$item};
                   7807:                             $settingstatus = $item;
                   7808:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   7809:                             $defquota = $quotahash{'quotas'}{$item};
                   7810:                             $settingstatus = $item;
                   7811:                         }
1.536     raeburn  7812:                     }
                   7813:                 }
                   7814:             }
                   7815:         }
                   7816:         if ($defquota eq '') {
1.711     raeburn  7817:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7818:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   7819:             } else {
                   7820:                 $defquota = $quotahash{'quotas'}{'default'};
                   7821:             }
1.536     raeburn  7822:             $settingstatus = 'default';
                   7823:         }
                   7824:     } else {
                   7825:         $settingstatus = 'default';
                   7826:         $defquota = 20;
                   7827:     }
                   7828:     if (wantarray) {
                   7829:         return ($defquota,$settingstatus);
1.472     raeburn  7830:     } else {
1.536     raeburn  7831:         return $defquota;
1.472     raeburn  7832:     }
                   7833: }
                   7834: 
1.384     raeburn  7835: sub get_secgrprole_info {
                   7836:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   7837:     my %sections_count = &get_sections($cdom,$cnum);
                   7838:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   7839:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   7840:     my @groups = sort(keys(%curr_groups));
                   7841:     my $allroles = [];
                   7842:     my $rolehash;
                   7843:     my $accesshash = {
                   7844:                      active => 'Currently has access',
                   7845:                      future => 'Will have future access',
                   7846:                      previous => 'Previously had access',
                   7847:                   };
                   7848:     if ($needroles) {
                   7849:         $rolehash = {'all' => 'all'};
1.385     albertel 7850:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7851: 	if (&Apache::lonnet::error(%user_roles)) {
                   7852: 	    undef(%user_roles);
                   7853: 	}
                   7854:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  7855:             my ($role)=split(/\:/,$item,2);
                   7856:             if ($role eq 'cr') { next; }
                   7857:             if ($role =~ /^cr/) {
                   7858:                 $$rolehash{$role} = (split('/',$role))[3];
                   7859:             } else {
                   7860:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   7861:             }
                   7862:         }
                   7863:         foreach my $key (sort(keys(%{$rolehash}))) {
                   7864:             push(@{$allroles},$key);
                   7865:         }
                   7866:         push (@{$allroles},'st');
                   7867:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   7868:     }
                   7869:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   7870: }
                   7871: 
1.555     raeburn  7872: sub user_picker {
1.994     raeburn  7873:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  7874:     my $currdom = $dom;
                   7875:     my %curr_selected = (
                   7876:                         srchin => 'dom',
1.580     raeburn  7877:                         srchby => 'lastname',
1.555     raeburn  7878:                       );
                   7879:     my $srchterm;
1.625     raeburn  7880:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  7881:         if ($srch->{'srchby'} ne '') {
                   7882:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   7883:         }
                   7884:         if ($srch->{'srchin'} ne '') {
                   7885:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   7886:         }
                   7887:         if ($srch->{'srchtype'} ne '') {
                   7888:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   7889:         }
                   7890:         if ($srch->{'srchdomain'} ne '') {
                   7891:             $currdom = $srch->{'srchdomain'};
                   7892:         }
                   7893:         $srchterm = $srch->{'srchterm'};
                   7894:     }
                   7895:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  7896:                     'usr'       => 'Search criteria',
1.563     raeburn  7897:                     'doma'      => 'Domain/institution to search',
1.558     albertel 7898:                     'uname'     => 'username',
                   7899:                     'lastname'  => 'last name',
1.555     raeburn  7900:                     'lastfirst' => 'last name, first name',
1.558     albertel 7901:                     'crs'       => 'in this course',
1.576     raeburn  7902:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 7903:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  7904:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 7905:                     'exact'     => 'is',
                   7906:                     'contains'  => 'contains',
1.569     raeburn  7907:                     'begins'    => 'begins with',
1.571     raeburn  7908:                     'youm'      => "You must include some text to search for.",
                   7909:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   7910:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   7911:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   7912:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   7913:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   7914:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   7915:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  7916:                                        );
1.563     raeburn  7917:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   7918:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  7919: 
                   7920:     my @srchins = ('crs','dom','alc','instd');
                   7921: 
                   7922:     foreach my $option (@srchins) {
                   7923:         # FIXME 'alc' option unavailable until 
                   7924:         #       loncreateuser::print_user_query_page()
                   7925:         #       has been completed.
                   7926:         next if ($option eq 'alc');
1.880     raeburn  7927:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  7928:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  7929:         if ($curr_selected{'srchin'} eq $option) {
                   7930:             $srchinsel .= ' 
                   7931:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7932:         } else {
                   7933:             $srchinsel .= '
                   7934:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7935:         }
1.555     raeburn  7936:     }
1.563     raeburn  7937:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  7938: 
                   7939:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  7940:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  7941:         if ($curr_selected{'srchby'} eq $option) {
                   7942:             $srchbysel .= '
                   7943:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7944:         } else {
                   7945:             $srchbysel .= '
                   7946:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7947:          }
                   7948:     }
                   7949:     $srchbysel .= "\n  </select>\n";
                   7950: 
                   7951:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  7952:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  7953:         if ($curr_selected{'srchtype'} eq $option) {
                   7954:             $srchtypesel .= '
                   7955:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7956:         } else {
                   7957:             $srchtypesel .= '
                   7958:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7959:         }
                   7960:     }
                   7961:     $srchtypesel .= "\n  </select>\n";
                   7962: 
1.558     albertel 7963:     my ($newuserscript,$new_user_create);
1.994     raeburn  7964:     my $context_dom = $env{'request.role.domain'};
                   7965:     if ($context eq 'requestcrs') {
                   7966:         if ($env{'form.coursedom'} ne '') { 
                   7967:             $context_dom = $env{'form.coursedom'};
                   7968:         }
                   7969:     }
1.556     raeburn  7970:     if ($forcenewuser) {
1.576     raeburn  7971:         if (ref($srch) eq 'HASH') {
1.994     raeburn  7972:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  7973:                 if ($cancreate) {
                   7974:                     $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>';
                   7975:                 } else {
1.799     bisitz   7976:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  7977:                     my %usertypetext = (
                   7978:                         official   => 'institutional',
                   7979:                         unofficial => 'non-institutional',
                   7980:                     );
1.799     bisitz   7981:                     $new_user_create = '<p class="LC_warning">'
                   7982:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   7983:                                       .' '
                   7984:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   7985:                                           ,'<a href="'.$helplink.'">','</a>')
                   7986:                                       .'</p><br />';
1.627     raeburn  7987:                 }
1.576     raeburn  7988:             }
                   7989:         }
                   7990: 
1.556     raeburn  7991:         $newuserscript = <<"ENDSCRIPT";
                   7992: 
1.570     raeburn  7993: function setSearch(createnew,callingForm) {
1.556     raeburn  7994:     if (createnew == 1) {
1.570     raeburn  7995:         for (var i=0; i<callingForm.srchby.length; i++) {
                   7996:             if (callingForm.srchby.options[i].value == 'uname') {
                   7997:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  7998:             }
                   7999:         }
1.570     raeburn  8000:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8001:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8002: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8003:             }
                   8004:         }
1.570     raeburn  8005:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8006:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8007:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8008:             }
                   8009:         }
1.570     raeburn  8010:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8011:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8012:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8013:             }
                   8014:         }
                   8015:     }
                   8016: }
                   8017: ENDSCRIPT
1.558     albertel 8018: 
1.556     raeburn  8019:     }
                   8020: 
1.555     raeburn  8021:     my $output = <<"END_BLOCK";
1.556     raeburn  8022: <script type="text/javascript">
1.824     bisitz   8023: // <![CDATA[
1.570     raeburn  8024: function validateEntry(callingForm) {
1.558     albertel 8025: 
1.556     raeburn  8026:     var checkok = 1;
1.558     albertel 8027:     var srchin;
1.570     raeburn  8028:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8029: 	if ( callingForm.srchin[i].checked ) {
                   8030: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8031: 	}
                   8032:     }
                   8033: 
1.570     raeburn  8034:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8035:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8036:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8037:     var srchterm =  callingForm.srchterm.value;
                   8038:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8039:     var msg = "";
                   8040: 
                   8041:     if (srchterm == "") {
                   8042:         checkok = 0;
1.571     raeburn  8043:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8044:     }
                   8045: 
1.569     raeburn  8046:     if (srchtype== 'begins') {
                   8047:         if (srchterm.length < 2) {
                   8048:             checkok = 0;
1.571     raeburn  8049:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8050:         }
                   8051:     }
                   8052: 
1.556     raeburn  8053:     if (srchtype== 'contains') {
                   8054:         if (srchterm.length < 3) {
                   8055:             checkok = 0;
1.571     raeburn  8056:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8057:         }
                   8058:     }
                   8059:     if (srchin == 'instd') {
                   8060:         if (srchdomain == '') {
                   8061:             checkok = 0;
1.571     raeburn  8062:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8063:         }
                   8064:     }
                   8065:     if (srchin == 'dom') {
                   8066:         if (srchdomain == '') {
                   8067:             checkok = 0;
1.571     raeburn  8068:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8069:         }
                   8070:     }
                   8071:     if (srchby == 'lastfirst') {
                   8072:         if (srchterm.indexOf(",") == -1) {
                   8073:             checkok = 0;
1.571     raeburn  8074:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8075:         }
                   8076:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8077:             checkok = 0;
1.571     raeburn  8078:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8079:         }
                   8080:     }
                   8081:     if (checkok == 0) {
1.571     raeburn  8082:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8083:         return;
                   8084:     }
                   8085:     if (checkok == 1) {
1.570     raeburn  8086:         callingForm.submit();
1.556     raeburn  8087:     }
                   8088: }
                   8089: 
                   8090: $newuserscript
                   8091: 
1.824     bisitz   8092: // ]]>
1.556     raeburn  8093: </script>
1.558     albertel 8094: 
                   8095: $new_user_create
                   8096: 
1.555     raeburn  8097: END_BLOCK
1.558     albertel 8098: 
1.876     raeburn  8099:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8100:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8101:                $domform.
                   8102:                &Apache::lonhtmlcommon::row_closure().
                   8103:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8104:                $srchbysel.
                   8105:                $srchtypesel. 
                   8106:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8107:                $srchinsel.
                   8108:                &Apache::lonhtmlcommon::row_closure(1). 
                   8109:                &Apache::lonhtmlcommon::end_pick_box().
                   8110:                '<br />';
1.555     raeburn  8111:     return $output;
                   8112: }
                   8113: 
1.612     raeburn  8114: sub user_rule_check {
1.615     raeburn  8115:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8116:     my $response;
                   8117:     if (ref($usershash) eq 'HASH') {
                   8118:         foreach my $user (keys(%{$usershash})) {
                   8119:             my ($uname,$udom) = split(/:/,$user);
                   8120:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8121:             my ($id,$newuser);
1.612     raeburn  8122:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8123:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8124:                 $id = $usershash->{$user}->{'id'};
                   8125:             }
                   8126:             my $inst_response;
                   8127:             if (ref($checks) eq 'HASH') {
                   8128:                 if (defined($checks->{'username'})) {
1.615     raeburn  8129:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8130:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8131:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8132:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8133:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8134:                 }
1.615     raeburn  8135:             } else {
                   8136:                 ($inst_response,%{$inst_results->{$user}}) =
                   8137:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8138:                 return;
1.612     raeburn  8139:             }
1.615     raeburn  8140:             if (!$got_rules->{$udom}) {
1.612     raeburn  8141:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8142:                                                   ['usercreation'],$udom);
                   8143:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8144:                     foreach my $item ('username','id') {
1.612     raeburn  8145:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8146:                             $$curr_rules{$udom}{$item} = 
                   8147:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8148:                         }
                   8149:                     }
                   8150:                 }
1.615     raeburn  8151:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8152:             }
1.612     raeburn  8153:             foreach my $item (keys(%{$checks})) {
                   8154:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8155:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8156:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8157:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8158:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8159:                                 if ($rule_check{$rule}) {
                   8160:                                     $$rulematch{$user}{$item} = $rule;
                   8161:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8162:                                         if (ref($inst_results) eq 'HASH') {
                   8163:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8164:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8165:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8166:                                                 }
1.612     raeburn  8167:                                             }
                   8168:                                         }
1.615     raeburn  8169:                                     }
                   8170:                                     last;
1.585     raeburn  8171:                                 }
                   8172:                             }
                   8173:                         }
                   8174:                     }
                   8175:                 }
                   8176:             }
                   8177:         }
                   8178:     }
1.612     raeburn  8179:     return;
                   8180: }
                   8181: 
                   8182: sub user_rule_formats {
                   8183:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8184:     my %text = ( 
                   8185:                  'username' => 'Usernames',
                   8186:                  'id'       => 'IDs',
                   8187:                );
                   8188:     my $output;
                   8189:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8190:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8191:         if (@{$ruleorder} > 0) {
                   8192:             $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>';
                   8193:             foreach my $rule (@{$ruleorder}) {
                   8194:                 if (ref($curr_rules) eq 'ARRAY') {
                   8195:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8196:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8197:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8198:                                         $rules->{$rule}{'desc'}.'</li>';
                   8199:                         }
                   8200:                     }
                   8201:                 }
                   8202:             }
                   8203:             $output .= '</ul>';
                   8204:         }
                   8205:     }
                   8206:     return $output;
                   8207: }
                   8208: 
                   8209: sub instrule_disallow_msg {
1.615     raeburn  8210:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8211:     my $response;
                   8212:     my %text = (
                   8213:                   item   => 'username',
                   8214:                   items  => 'usernames',
                   8215:                   match  => 'matches',
                   8216:                   do     => 'does',
                   8217:                   action => 'a username',
                   8218:                   one    => 'one',
                   8219:                );
                   8220:     if ($count > 1) {
                   8221:         $text{'item'} = 'usernames';
                   8222:         $text{'match'} ='match';
                   8223:         $text{'do'} = 'do';
                   8224:         $text{'action'} = 'usernames',
                   8225:         $text{'one'} = 'ones';
                   8226:     }
                   8227:     if ($checkitem eq 'id') {
                   8228:         $text{'items'} = 'IDs';
                   8229:         $text{'item'} = 'ID';
                   8230:         $text{'action'} = 'an ID';
1.615     raeburn  8231:         if ($count > 1) {
                   8232:             $text{'item'} = 'IDs';
                   8233:             $text{'action'} = 'IDs';
                   8234:         }
1.612     raeburn  8235:     }
1.674     bisitz   8236:     $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  8237:     if ($mode eq 'upload') {
                   8238:         if ($checkitem eq 'username') {
                   8239:             $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'}.");
                   8240:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8241:             $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  8242:         }
1.669     raeburn  8243:     } elsif ($mode eq 'selfcreate') {
                   8244:         if ($checkitem eq 'id') {
                   8245:             $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.");
                   8246:         }
1.615     raeburn  8247:     } else {
                   8248:         if ($checkitem eq 'username') {
                   8249:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8250:         } elsif ($checkitem eq 'id') {
                   8251:             $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.");
                   8252:         }
1.612     raeburn  8253:     }
                   8254:     return $response;
1.585     raeburn  8255: }
                   8256: 
1.624     raeburn  8257: sub personal_data_fieldtitles {
                   8258:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8259:                         id => 'Student/Employee ID',
                   8260:                         permanentemail => 'E-mail address',
                   8261:                         lastname => 'Last Name',
                   8262:                         firstname => 'First Name',
                   8263:                         middlename => 'Middle Name',
                   8264:                         generation => 'Generation',
                   8265:                         gen => 'Generation',
1.765     raeburn  8266:                         inststatus => 'Affiliation',
1.624     raeburn  8267:                    );
                   8268:     return %fieldtitles;
                   8269: }
                   8270: 
1.642     raeburn  8271: sub sorted_inst_types {
                   8272:     my ($dom) = @_;
                   8273:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8274:     my $othertitle = &mt('All users');
                   8275:     if ($env{'request.course.id'}) {
1.668     raeburn  8276:         $othertitle  = &mt('Any users');
1.642     raeburn  8277:     }
                   8278:     my @types;
                   8279:     if (ref($order) eq 'ARRAY') {
                   8280:         @types = @{$order};
                   8281:     }
                   8282:     if (@types == 0) {
                   8283:         if (ref($usertypes) eq 'HASH') {
                   8284:             @types = sort(keys(%{$usertypes}));
                   8285:         }
                   8286:     }
                   8287:     if (keys(%{$usertypes}) > 0) {
                   8288:         $othertitle = &mt('Other users');
                   8289:     }
                   8290:     return ($othertitle,$usertypes,\@types);
                   8291: }
                   8292: 
1.645     raeburn  8293: sub get_institutional_codes {
                   8294:     my ($settings,$allcourses,$LC_code) = @_;
                   8295: # Get complete list of course sections to update
                   8296:     my @currsections = ();
                   8297:     my @currxlists = ();
                   8298:     my $coursecode = $$settings{'internal.coursecode'};
                   8299: 
                   8300:     if ($$settings{'internal.sectionnums'} ne '') {
                   8301:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8302:     }
                   8303: 
                   8304:     if ($$settings{'internal.crosslistings'} ne '') {
                   8305:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8306:     }
                   8307: 
                   8308:     if (@currxlists > 0) {
                   8309:         foreach (@currxlists) {
                   8310:             if (m/^([^:]+):(\w*)$/) {
                   8311:                 unless (grep/^$1$/,@{$allcourses}) {
                   8312:                     push @{$allcourses},$1;
                   8313:                     $$LC_code{$1} = $2;
                   8314:                 }
                   8315:             }
                   8316:         }
                   8317:     }
                   8318:  
                   8319:     if (@currsections > 0) {
                   8320:         foreach (@currsections) {
                   8321:             if (m/^(\w+):(\w*)$/) {
                   8322:                 my $sec = $coursecode.$1;
                   8323:                 my $lc_sec = $2;
                   8324:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8325:                     push @{$allcourses},$sec;
                   8326:                     $$LC_code{$sec} = $lc_sec;
                   8327:                 }
                   8328:             }
                   8329:         }
                   8330:     }
                   8331:     return;
                   8332: }
                   8333: 
1.971     raeburn  8334: sub get_standard_codeitems {
                   8335:     return ('Year','Semester','Department','Number','Section');
                   8336: }
                   8337: 
1.112     bowersj2 8338: =pod
                   8339: 
1.780     raeburn  8340: =head1 Slot Helpers
                   8341: 
                   8342: =over 4
                   8343: 
                   8344: =item * sorted_slots()
                   8345: 
                   8346: Sorts an array of slot names in order of slot start time (earliest first). 
                   8347: 
                   8348: Inputs:
                   8349: 
                   8350: =over 4
                   8351: 
                   8352: slotsarr  - Reference to array of unsorted slot names.
                   8353: 
                   8354: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8355: 
1.549     albertel 8356: =back
                   8357: 
1.780     raeburn  8358: Returns:
                   8359: 
                   8360: =over 4
                   8361: 
                   8362: sorted   - An array of slot names sorted by the start time of the slot.
                   8363: 
                   8364: =back
                   8365: 
                   8366: =back
                   8367: 
                   8368: =cut
                   8369: 
                   8370: 
                   8371: sub sorted_slots {
                   8372:     my ($slotsarr,$slots) = @_;
                   8373:     my @sorted;
                   8374:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8375:         @sorted =
                   8376:             sort {
                   8377:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
                   8378:                          return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
                   8379:                      }
                   8380:                      if (ref($slots->{$a})) { return -1;}
                   8381:                      if (ref($slots->{$b})) { return 1;}
                   8382:                      return 0;
                   8383:                  } @{$slotsarr};
                   8384:     }
                   8385:     return @sorted;
                   8386: }
                   8387: 
                   8388: 
                   8389: =pod
                   8390: 
1.549     albertel 8391: =head1 HTTP Helpers
                   8392: 
                   8393: =over 4
                   8394: 
1.648     raeburn  8395: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 8396: 
1.258     albertel 8397: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 8398: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 8399: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 8400: 
                   8401: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   8402: $possible_names is an ref to an array of form element names.  As an example:
                   8403: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 8404: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 8405: 
                   8406: =cut
1.1       albertel 8407: 
1.6       albertel 8408: sub get_unprocessed_cgi {
1.25      albertel 8409:   my ($query,$possible_names)= @_;
1.26      matthew  8410:   # $Apache::lonxml::debug=1;
1.356     albertel 8411:   foreach my $pair (split(/&/,$query)) {
                   8412:     my ($name, $value) = split(/=/,$pair);
1.369     www      8413:     $name = &unescape($name);
1.25      albertel 8414:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   8415:       $value =~ tr/+/ /;
                   8416:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 8417:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 8418:     }
1.16      harris41 8419:   }
1.6       albertel 8420: }
                   8421: 
1.112     bowersj2 8422: =pod
                   8423: 
1.648     raeburn  8424: =item * &cacheheader() 
1.112     bowersj2 8425: 
                   8426: returns cache-controlling header code
                   8427: 
                   8428: =cut
                   8429: 
1.7       albertel 8430: sub cacheheader {
1.258     albertel 8431:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 8432:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   8433:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 8434:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   8435:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 8436:     return $output;
1.7       albertel 8437: }
                   8438: 
1.112     bowersj2 8439: =pod
                   8440: 
1.648     raeburn  8441: =item * &no_cache($r) 
1.112     bowersj2 8442: 
                   8443: specifies header code to not have cache
                   8444: 
                   8445: =cut
                   8446: 
1.9       albertel 8447: sub no_cache {
1.216     albertel 8448:     my ($r) = @_;
                   8449:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 8450: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 8451:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   8452:     $r->no_cache(1);
                   8453:     $r->header_out("Expires" => $date);
                   8454:     $r->header_out("Pragma" => "no-cache");
1.123     www      8455: }
                   8456: 
                   8457: sub content_type {
1.181     albertel 8458:     my ($r,$type,$charset) = @_;
1.299     foxr     8459:     if ($r) {
                   8460: 	#  Note that printout.pl calls this with undef for $r.
                   8461: 	&no_cache($r);
                   8462:     }
1.258     albertel 8463:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 8464:     unless ($charset) {
                   8465: 	$charset=&Apache::lonlocal::current_encoding;
                   8466:     }
                   8467:     if ($charset) { $type.='; charset='.$charset; }
                   8468:     if ($r) {
                   8469: 	$r->content_type($type);
                   8470:     } else {
                   8471: 	print("Content-type: $type\n\n");
                   8472:     }
1.9       albertel 8473: }
1.25      albertel 8474: 
1.112     bowersj2 8475: =pod
                   8476: 
1.648     raeburn  8477: =item * &add_to_env($name,$value) 
1.112     bowersj2 8478: 
1.258     albertel 8479: adds $name to the %env hash with value
1.112     bowersj2 8480: $value, if $name already exists, the entry is converted to an array
                   8481: reference and $value is added to the array.
                   8482: 
                   8483: =cut
                   8484: 
1.25      albertel 8485: sub add_to_env {
                   8486:   my ($name,$value)=@_;
1.258     albertel 8487:   if (defined($env{$name})) {
                   8488:     if (ref($env{$name})) {
1.25      albertel 8489:       #already have multiple values
1.258     albertel 8490:       push(@{ $env{$name} },$value);
1.25      albertel 8491:     } else {
                   8492:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 8493:       my $first=$env{$name};
                   8494:       undef($env{$name});
                   8495:       push(@{ $env{$name} },$first,$value);
1.25      albertel 8496:     }
                   8497:   } else {
1.258     albertel 8498:     $env{$name}=$value;
1.25      albertel 8499:   }
1.31      albertel 8500: }
1.149     albertel 8501: 
                   8502: =pod
                   8503: 
1.648     raeburn  8504: =item * &get_env_multiple($name) 
1.149     albertel 8505: 
1.258     albertel 8506: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 8507: values may be defined and end up as an array ref.
                   8508: 
                   8509: returns an array of values
                   8510: 
                   8511: =cut
                   8512: 
                   8513: sub get_env_multiple {
                   8514:     my ($name) = @_;
                   8515:     my @values;
1.258     albertel 8516:     if (defined($env{$name})) {
1.149     albertel 8517:         # exists is it an array
1.258     albertel 8518:         if (ref($env{$name})) {
                   8519:             @values=@{ $env{$name} };
1.149     albertel 8520:         } else {
1.258     albertel 8521:             $values[0]=$env{$name};
1.149     albertel 8522:         }
                   8523:     }
                   8524:     return(@values);
                   8525: }
                   8526: 
1.660     raeburn  8527: sub ask_for_embedded_content {
                   8528:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.987     raeburn  8529:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
1.660     raeburn  8530:     my $num = 0;
1.987     raeburn  8531:     my $numremref = 0;
                   8532:     my $numinvalid = 0;
                   8533:     my $numpathchg = 0;
                   8534:     my $numexisting = 0;
                   8535:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
1.984     raeburn  8536:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8537:         my $current_path='/';
                   8538:         if ($env{'form.currentpath'}) {
                   8539:             $current_path = $env{'form.currentpath'};
                   8540:         }
                   8541:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   8542:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8543:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   8544:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   8545:         } else {
                   8546:             $udom = $env{'user.domain'};
                   8547:             $uname = $env{'user.name'};
                   8548:             $url = '/userfiles/portfolio';
                   8549:         }
1.987     raeburn  8550:         $toplevel = $url.'/';
1.984     raeburn  8551:         $url .= $current_path;
                   8552:         $getpropath = 1;
1.987     raeburn  8553:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   8554:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      8555:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  8556:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  8557:         $toplevel = $url;
1.984     raeburn  8558:         if ($rest ne '') {
1.987     raeburn  8559:             $url .= $rest;
                   8560:         }
                   8561:     } elsif ($actionurl eq '/adm/coursedocs') {
                   8562:         if (ref($args) eq 'HASH') {
                   8563:            $url = $args->{'docs_url'};
                   8564:            $toplevel = $url;
                   8565:         }
                   8566:     }
                   8567:     my $now = time();
                   8568:     foreach my $embed_file (keys(%{$allfiles})) {
                   8569:         my $absolutepath;
                   8570:         if ($embed_file =~ m{^\w+://}) {
                   8571:             $newfiles{$embed_file} = 1;
                   8572:             $mapping{$embed_file} = $embed_file;
                   8573:         } else {
                   8574:             if ($embed_file =~ m{^/}) {
                   8575:                 $absolutepath = $embed_file;
                   8576:                 $embed_file =~ s{^(/+)}{};
                   8577:             }
                   8578:             if ($embed_file =~ m{/}) {
                   8579:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   8580:                 $path = &check_for_traversal($path,$url,$toplevel);
                   8581:                 my $item = $fname;
                   8582:                 if ($path ne '') {
                   8583:                     $item = $path.'/'.$fname;
                   8584:                     $subdependencies{$path}{$fname} = 1;
                   8585:                 } else {
                   8586:                     $dependencies{$item} = 1;
                   8587:                 }
                   8588:                 if ($absolutepath) {
                   8589:                     $mapping{$item} = $absolutepath;
                   8590:                 } else {
                   8591:                     $mapping{$item} = $embed_file;
                   8592:                 }
                   8593:             } else {
                   8594:                 $dependencies{$embed_file} = 1;
                   8595:                 if ($absolutepath) {
                   8596:                     $mapping{$embed_file} = $absolutepath;
                   8597:                 } else {
                   8598:                     $mapping{$embed_file} = $embed_file;
                   8599:                 }
                   8600:             }
1.984     raeburn  8601:         }
                   8602:     }
                   8603:     foreach my $path (keys(%subdependencies)) {
                   8604:         my %currsubfile;
                   8605:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  8606:             my ($sublistref,$listerror) =
                   8607:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   8608:             if (ref($sublistref) eq 'ARRAY') {
                   8609:                 foreach my $line (@{$sublistref}) {
                   8610:                     my ($file_name,$rest) = split(/\&/,$line,2);
                   8611:                     $currsubfile{$file_name} = 1;
                   8612:                 }
1.984     raeburn  8613:             }
1.987     raeburn  8614:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8615:             if (opendir(my $dir,$url.'/'.$path)) {
                   8616:                 my @subdir_list = grep(!/^\./,readdir($dir));
                   8617:                 map {$currsubfile{$_} = 1;} @subdir_list;
                   8618:             }
                   8619:         }
                   8620:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.987     raeburn  8621:             if ($currsubfile{$file}) {
                   8622:                 my $item = $path.'/'.$file;
                   8623:                 unless ($mapping{$item} eq $item) {
                   8624:                     $pathchanges{$item} = 1;
                   8625:                 }
                   8626:                 $existing{$item} = 1;
                   8627:                 $numexisting ++;
                   8628:             } else {
                   8629:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  8630:             }
                   8631:         }
                   8632:     }
1.987     raeburn  8633:     my %currfile;
1.984     raeburn  8634:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  8635:         my ($dirlistref,$listerror) =
                   8636:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   8637:         if (ref($dirlistref) eq 'ARRAY') {
                   8638:             foreach my $line (@{$dirlistref}) {
                   8639:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   8640:                 $currfile{$file_name} = 1;
                   8641:             }
1.984     raeburn  8642:         }
1.987     raeburn  8643:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8644:         if (opendir(my $dir,$url)) {
1.987     raeburn  8645:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  8646:             map {$currfile{$_} = 1;} @dir_list;
                   8647:         }
                   8648:     }
                   8649:     foreach my $file (keys(%dependencies)) {
1.987     raeburn  8650:         if ($currfile{$file}) {
                   8651:             unless ($mapping{$file} eq $file) {
                   8652:                 $pathchanges{$file} = 1;
                   8653:             }
                   8654:             $existing{$file} = 1;
                   8655:             $numexisting ++;
                   8656:         } else {
1.984     raeburn  8657:             $newfiles{$file} = 1;
                   8658:         }
                   8659:     }
                   8660:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.660     raeburn  8661:         $upload_output .= &start_data_table_row().
1.987     raeburn  8662:                           '<td><span class="LC_filename">'.$embed_file.'</span>';
                   8663:         unless ($mapping{$embed_file} eq $embed_file) {
                   8664:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   8665:         }
                   8666:         $upload_output .= '</td><td>';
1.660     raeburn  8667:         if ($args->{'ignore_remote_references'}
                   8668:             && $embed_file =~ m{^\w+://}) {
                   8669:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  8670:             $numremref++;
1.660     raeburn  8671:         } elsif ($args->{'error_on_invalid_names'}
                   8672:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   8673: 
1.987     raeburn  8674:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   8675:             $numinvalid++;
1.660     raeburn  8676:         } else {
1.987     raeburn  8677:             $upload_output .= &embedded_file_element('upload_embedded',$num,
                   8678:                                                      $embed_file,\%mapping,
                   8679:                                                      $allfiles,$codebase);
                   8680:             $num++;
                   8681:         }
                   8682:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   8683:     }
                   8684:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
                   8685:         $upload_output .= &start_data_table_row().
                   8686:                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.
                   8687:                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   8688:                           &Apache::loncommon::end_data_table_row()."\n";
                   8689:     }
                   8690:     if ($upload_output) {
                   8691:         $upload_output = &start_data_table().
                   8692:                          $upload_output.
                   8693:                          &end_data_table()."\n";
                   8694:     }
                   8695:     my $applies = 0;
                   8696:     if ($numremref) {
                   8697:         $applies ++;
                   8698:     }
                   8699:     if ($numinvalid) {
                   8700:         $applies ++;
                   8701:     }
                   8702:     if ($numexisting) {
                   8703:         $applies ++;
                   8704:     }
                   8705:     if ($num) {
                   8706:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   8707:                   ' method="post" enctype="multipart/form-data">'."\n".
                   8708:                   $state.
                   8709:                   '<h3>'.&mt('Upload embedded files').
                   8710:                   ':</h3>'.$upload_output.'<br />'."\n".
                   8711:                   '<input type ="hidden" name="number_embedded_items" value="'.
                   8712:                   $num.'" />'."\n";
                   8713:         if ($actionurl eq '') {
                   8714:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   8715:         }
                   8716:     } elsif ($applies) {
                   8717:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   8718:         if ($applies > 1) {
                   8719:             $output .=  
                   8720:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   8721:             if ($numremref) {
                   8722:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   8723:             }
                   8724:             if ($numinvalid) {
                   8725:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   8726:             }
                   8727:             if ($numexisting) {
                   8728:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   8729:             }
                   8730:             $output .= '</ul><br />';
                   8731:         } elsif ($numremref) {
                   8732:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   8733:         } elsif ($numinvalid) {
                   8734:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   8735:         } elsif ($numexisting) {
                   8736:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   8737:         }
                   8738:         $output .= $upload_output.'<br />';
                   8739:     }
                   8740:     my ($pathchange_output,$chgcount);
                   8741:     $chgcount = $num;
                   8742:     if (keys(%pathchanges) > 0) {
                   8743:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
                   8744:             if ($num) {
                   8745:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   8746:                                                   $embed_file,\%mapping,
                   8747:                                                   $allfiles,$codebase);
                   8748:             } else {
                   8749:                 $pathchange_output .= 
                   8750:                     &start_data_table_row().
                   8751:                     '<td><input type ="checkbox" name="namechange" value="'.
                   8752:                     $chgcount.'" checked="checked" /></td>'.
                   8753:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   8754:                     '<td>'.$embed_file.
                   8755:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
                   8756:                                            \%mapping,$allfiles,$codebase).
                   8757:                     '</td>'.&end_data_table_row();
1.660     raeburn  8758:             }
1.987     raeburn  8759:             $numpathchg ++;
                   8760:             $chgcount ++;
1.660     raeburn  8761:         }
                   8762:     }
1.984     raeburn  8763:     if ($num) {
1.987     raeburn  8764:         if ($numpathchg) {
                   8765:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   8766:                        $numpathchg.'" />'."\n";
                   8767:         }
                   8768:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   8769:             ($actionurl eq '/adm/imsimport')) {
                   8770:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   8771:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   8772:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
                   8773:         }
                   8774:         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".
                   8775:                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";
                   8776:     } elsif ($numpathchg) {
                   8777:         my %pathchange = ();
                   8778:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   8779:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8780:             $output .= '<p>'.&mt('or').'</p>'; 
                   8781:         } 
                   8782:     }
                   8783:     return ($output,$num,$numpathchg);
                   8784: }
                   8785: 
                   8786: sub embedded_file_element {
                   8787:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
                   8788:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   8789:                    (ref($codebase) eq 'HASH'));
                   8790:     my $output;
                   8791:     if ($context eq 'upload_embedded') {
                   8792:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   8793:     }
                   8794:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   8795:                &escape($embed_file).'" />';
                   8796:     unless (($context eq 'upload_embedded') && 
                   8797:             ($mapping->{$embed_file} eq $embed_file)) {
                   8798:         $output .='
                   8799:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   8800:     }
                   8801:     my $attrib;
                   8802:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   8803:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   8804:     }
                   8805:     $output .=
                   8806:         "\n\t\t".
                   8807:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   8808:         $attrib.'" />';
                   8809:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   8810:         $output .=
                   8811:             "\n\t\t".
                   8812:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   8813:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  8814:     }
1.987     raeburn  8815:     return $output;
1.660     raeburn  8816: }
                   8817: 
1.661     raeburn  8818: sub upload_embedded {
                   8819:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  8820:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   8821:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  8822:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   8823:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   8824:         my $orig_uploaded_filename =
                   8825:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  8826:         foreach my $type ('orig','ref','attrib','codebase') {
                   8827:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   8828:                 $env{'form.embedded_'.$type.'_'.$i} =
                   8829:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   8830:             }
                   8831:         }
1.661     raeburn  8832:         my ($path,$fname) =
                   8833:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   8834:         # no path, whole string is fname
                   8835:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   8836:         $fname = &Apache::lonnet::clean_filename($fname);
                   8837:         # See if there is anything left
                   8838:         next if ($fname eq '');
                   8839: 
                   8840:         # Check if file already exists as a file or directory.
                   8841:         my ($state,$msg);
                   8842:         if ($context eq 'portfolio') {
                   8843:             my $port_path = $dirpath;
                   8844:             if ($group ne '') {
                   8845:                 $port_path = "groups/$group/$port_path";
                   8846:             }
1.987     raeburn  8847:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   8848:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  8849:                                               $dir_root,$port_path,$disk_quota,
                   8850:                                               $current_disk_usage,$uname,$udom);
                   8851:             if ($state eq 'will_exceed_quota'
1.984     raeburn  8852:                 || $state eq 'file_locked') {
1.661     raeburn  8853:                 $output .= $msg;
                   8854:                 next;
                   8855:             }
                   8856:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   8857:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   8858:             if ($state eq 'exists') {
                   8859:                 $output .= $msg;
                   8860:                 next;
                   8861:             }
                   8862:         }
                   8863:         # Check if extension is valid
                   8864:         if (($fname =~ /\.(\w+)$/) &&
                   8865:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  8866:             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
1.661     raeburn  8867:             next;
                   8868:         } elsif (($fname =~ /\.(\w+)$/) &&
                   8869:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  8870:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  8871:             next;
                   8872:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  8873:             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661     raeburn  8874:             next;
                   8875:         }
                   8876: 
                   8877:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   8878:         if ($context eq 'portfolio') {
1.984     raeburn  8879:             my $result;
                   8880:             if ($state eq 'existingfile') {
                   8881:                 $result=
                   8882:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  8883:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  8884:             } else {
1.984     raeburn  8885:                 $result=
                   8886:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  8887:                                                     $dirpath.
                   8888:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  8889:                 if ($result !~ m|^/uploaded/|) {
                   8890:                     $output .= '<span class="LC_error">'
                   8891:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8892:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8893:                                .'</span><br />';
                   8894:                     next;
                   8895:                 } else {
1.987     raeburn  8896:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8897:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  8898:                 }
1.661     raeburn  8899:             }
1.987     raeburn  8900:         } elsif ($context eq 'coursedoc') {
                   8901:             my $result =
                   8902:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   8903:                                                 $dirpath.'/'.$path);
                   8904:             if ($result !~ m|^/uploaded/|) {
                   8905:                 $output .= '<span class="LC_error">'
                   8906:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8907:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8908:                            .'</span><br />';
                   8909:                     next;
                   8910:             } else {
                   8911:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8912:                            $path.$fname.'</span>').'<br />';
                   8913:             }
1.661     raeburn  8914:         } else {
                   8915: # Save the file
                   8916:             my $target = $env{'form.embedded_item_'.$i};
                   8917:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   8918:             my $dest = $fullpath.$fname;
                   8919:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  8920:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  8921:             my $count;
                   8922:             my $filepath = $dir_root;
1.1027    raeburn  8923:             foreach my $subdir (@parts) {
                   8924:                 $filepath .= "/$subdir";
                   8925:                 if (!-e $filepath) {
1.661     raeburn  8926:                     mkdir($filepath,0770);
                   8927:                 }
                   8928:             }
                   8929:             my $fh;
                   8930:             if (!open($fh,'>'.$dest)) {
                   8931:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   8932:                 $output .= '<span class="LC_error">'.
                   8933:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8934:                            '</span><br />';
                   8935:             } else {
                   8936:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   8937:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   8938:                     $output .= '<span class="LC_error">'.
                   8939:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8940:                               '</span><br />';
                   8941:                 } else {
1.987     raeburn  8942:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8943:                                $url.'</span>').'<br />';
                   8944:                     unless ($context eq 'testbank') {
                   8945:                         $footer .= &mt('View embedded file: [_1]',
                   8946:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   8947:                     }
                   8948:                 }
                   8949:                 close($fh);
                   8950:             }
                   8951:         }
                   8952:         if ($env{'form.embedded_ref_'.$i}) {
                   8953:             $pathchange{$i} = 1;
                   8954:         }
                   8955:     }
                   8956:     if ($output) {
                   8957:         $output = '<p>'.$output.'</p>';
                   8958:     }
                   8959:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   8960:     $returnflag = 'ok';
                   8961:     if (keys(%pathchange) > 0) {
                   8962:         if ($context eq 'portfolio') {
                   8963:             $output .= '<p>'.&mt('or').'</p>';
                   8964:         } elsif ($context eq 'testbank') {
1.988     raeburn  8965:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  8966:             $returnflag = 'modify_orightml';
                   8967:         }
                   8968:     }
                   8969:     return ($output.$footer,$returnflag);
                   8970: }
                   8971: 
                   8972: sub modify_html_form {
                   8973:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   8974:     my $end = 0;
                   8975:     my $modifyform;
                   8976:     if ($context eq 'upload_embedded') {
                   8977:         return unless (ref($pathchange) eq 'HASH');
                   8978:         if ($env{'form.number_embedded_items'}) {
                   8979:             $end += $env{'form.number_embedded_items'};
                   8980:         }
                   8981:         if ($env{'form.number_pathchange_items'}) {
                   8982:             $end += $env{'form.number_pathchange_items'};
                   8983:         }
                   8984:         if ($end) {
                   8985:             for (my $i=0; $i<$end; $i++) {
                   8986:                 if ($i < $env{'form.number_embedded_items'}) {
                   8987:                     next unless($pathchange->{$i});
                   8988:                 }
                   8989:                 $modifyform .=
                   8990:                     &start_data_table_row().
                   8991:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   8992:                     'checked="checked" /></td>'.
                   8993:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   8994:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   8995:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   8996:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   8997:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   8998:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   8999:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   9000:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   9001:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   9002:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   9003:                     &end_data_table_row();
                   9004:             } 
                   9005:         }
                   9006:     } else {
                   9007:         $modifyform = $pathchgtable;
                   9008:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   9009:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   9010:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9011:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   9012:         }
                   9013:     }
                   9014:     if ($modifyform) {
                   9015:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   9016:                '<p>'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'<ol>'."\n".
                   9017:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   9018:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   9019:                '</ol></p>'."\n".'<p>'.
                   9020:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   9021:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   9022:                &start_data_table()."\n".
                   9023:                &start_data_table_header_row().
                   9024:                '<th>'.&mt('Change?').'</th>'.
                   9025:                '<th>'.&mt('Current reference').'</th>'.
                   9026:                '<th>'.&mt('Required reference').'</th>'.
                   9027:                &end_data_table_header_row()."\n".
                   9028:                $modifyform.
                   9029:                &end_data_table().'<br />'."\n".$hiddenstate.
                   9030:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   9031:                '</form>'."\n";
                   9032:     }
                   9033:     return;
                   9034: }
                   9035: 
                   9036: sub modify_html_refs {
                   9037:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   9038:     my $container;
                   9039:     if ($context eq 'portfolio') {
                   9040:         $container = $env{'form.container'};
                   9041:     } elsif ($context eq 'coursedoc') {
                   9042:         $container = $env{'form.primaryurl'};
                   9043:     } else {
1.1027    raeburn  9044:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  9045:     }
                   9046:     my (%allfiles,%codebase,$output,$content);
                   9047:     my @changes = &get_env_multiple('form.namechange');
                   9048:     return unless (@changes > 0);
                   9049:     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {
                   9050:         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});
                   9051:         $content = &Apache::lonnet::getfile($container);
                   9052:         return if ($content eq '-1');
                   9053:     } else {
                   9054:         return unless ($container =~ /^\Q$dir_root\E/); 
                   9055:         if (open(my $fh,"<$container")) {
                   9056:             $content = join('', <$fh>);
                   9057:             close($fh);
                   9058:         } else {
                   9059:             return;
                   9060:         }
                   9061:     }
                   9062:     my ($count,$codebasecount) = (0,0);
                   9063:     my $mm = new File::MMagic;
                   9064:     my $mime_type = $mm->checktype_contents($content);
                   9065:     if ($mime_type eq 'text/html') {
                   9066:         my $parse_result = 
                   9067:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   9068:                                                     \%codebase,\$content);
                   9069:         if ($parse_result eq 'ok') {
                   9070:             foreach my $i (@changes) {
                   9071:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   9072:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   9073:                 if ($allfiles{$ref}) {
                   9074:                     my $newname =  $orig;
                   9075:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  9076:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  9077:                     if ($attrib_regexp =~ /:/) {
                   9078:                         $attrib_regexp =~ s/\:/|/g;
                   9079:                     }
                   9080:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   9081:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   9082:                         $count += $numchg;
                   9083:                     }
                   9084:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  9085:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  9086:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   9087:                         $codebasecount ++;
                   9088:                     }
                   9089:                 }
                   9090:             }
                   9091:             if ($count || $codebasecount) {
                   9092:                 my $saveresult;
                   9093:                 if ($context eq 'portfolio' || $context eq 'coursedoc') {
                   9094:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   9095:                     if ($url eq $container) {
                   9096:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   9097:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9098:                                             $count,'<span class="LC_filename">'.
                   9099:                                             $fname.'</span>').'</p>'; 
                   9100:                     } else {
                   9101:                          $output = '<p class="LC_error">'.
                   9102:                                    &mt('Error: update failed for: [_1].',
                   9103:                                    '<span class="LC_filename">'.
                   9104:                                    $container.'</span>').'</p>';
                   9105:                     }
                   9106:                 } else {
                   9107:                     if (open(my $fh,">$container")) {
                   9108:                         print $fh $content;
                   9109:                         close($fh);
                   9110:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9111:                                   $count,'<span class="LC_filename">'.
                   9112:                                   $container.'</span>').'</p>';
1.661     raeburn  9113:                     } else {
1.987     raeburn  9114:                          $output = '<p class="LC_error">'.
                   9115:                                    &mt('Error: could not update [_1].',
                   9116:                                    '<span class="LC_filename">'.
                   9117:                                    $container.'</span>').'</p>';
1.661     raeburn  9118:                     }
                   9119:                 }
                   9120:             }
1.987     raeburn  9121:         } else {
                   9122:             &logthis('Failed to parse '.$container.
                   9123:                      ' to modify references: '.$parse_result);
1.661     raeburn  9124:         }
                   9125:     }
                   9126:     return $output;
                   9127: }
                   9128: 
                   9129: sub check_for_existing {
                   9130:     my ($path,$fname,$element) = @_;
                   9131:     my ($state,$msg);
                   9132:     if (-d $path.'/'.$fname) {
                   9133:         $state = 'exists';
                   9134:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   9135:     } elsif (-e $path.'/'.$fname) {
                   9136:         $state = 'exists';
                   9137:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   9138:     }
                   9139:     if ($state eq 'exists') {
                   9140:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   9141:     }
                   9142:     return ($state,$msg);
                   9143: }
                   9144: 
                   9145: sub check_for_upload {
                   9146:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   9147:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  9148:     my $filesize = length($env{'form.'.$element});
                   9149:     if (!$filesize) {
                   9150:         my $msg = '<span class="LC_error">'.
                   9151:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   9152:                       '<span class="LC_filename">'.$fname.'</span>',
                   9153:                       $filesize).'<br />'.
1.1007    raeburn  9154:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  9155:                   '</span>';
                   9156:         return ('zero_bytes',$msg);
                   9157:     }
                   9158:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  9159:     my $getpropath = 1;
1.1021    raeburn  9160:     my ($dirlistref,$listerror) =
                   9161:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  9162:     my $found_file = 0;
                   9163:     my $locked_file = 0;
1.991     raeburn  9164:     my @lockers;
                   9165:     my $navmap;
                   9166:     if ($env{'request.course.id'}) {
                   9167:         $navmap = Apache::lonnavmaps::navmap->new();
                   9168:     }
1.1021    raeburn  9169:     if (ref($dirlistref) eq 'ARRAY') {
                   9170:         foreach my $line (@{$dirlistref}) {
                   9171:             my ($file_name,$rest)=split(/\&/,$line,2);
                   9172:             if ($file_name eq $fname){
                   9173:                 $file_name = $path.$file_name;
                   9174:                 if ($group ne '') {
                   9175:                     $file_name = $group.$file_name;
                   9176:                 }
                   9177:                 $found_file = 1;
                   9178:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   9179:                     foreach my $lock (@lockers) {
                   9180:                         if (ref($lock) eq 'ARRAY') {
                   9181:                             my ($symb,$crsid) = @{$lock};
                   9182:                             if ($crsid eq $env{'request.course.id'}) {
                   9183:                                 if (ref($navmap)) {
                   9184:                                     my $res = $navmap->getBySymb($symb);
                   9185:                                     foreach my $part (@{$res->parts()}) { 
                   9186:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   9187:                                         unless (($slot_status == $res->RESERVED) ||
                   9188:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   9189:                                             $locked_file = 1;
                   9190:                                         }
1.991     raeburn  9191:                                     }
1.1021    raeburn  9192:                                 } else {
                   9193:                                     $locked_file = 1;
1.991     raeburn  9194:                                 }
                   9195:                             } else {
                   9196:                                 $locked_file = 1;
                   9197:                             }
                   9198:                         }
1.1021    raeburn  9199:                    }
                   9200:                 } else {
                   9201:                     my @info = split(/\&/,$rest);
                   9202:                     my $currsize = $info[6]/1000;
                   9203:                     if ($currsize < $filesize) {
                   9204:                         my $extra = $filesize - $currsize;
                   9205:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   9206:                             my $msg = '<span class="LC_error">'.
                   9207:                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
                   9208:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   9209:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   9210:                                                    $disk_quota,$current_disk_usage);
                   9211:                             return ('will_exceed_quota',$msg);
                   9212:                         }
1.984     raeburn  9213:                     }
                   9214:                 }
1.661     raeburn  9215:             }
                   9216:         }
                   9217:     }
                   9218:     if (($current_disk_usage + $filesize) > $disk_quota){
                   9219:         my $msg = '<span class="LC_error">'.
                   9220:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   9221:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   9222:         return ('will_exceed_quota',$msg);
                   9223:     } elsif ($found_file) {
                   9224:         if ($locked_file) {
                   9225:             my $msg = '<span class="LC_error">';
                   9226:             $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>');
                   9227:             $msg .= '</span><br />';
                   9228:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   9229:             return ('file_locked',$msg);
                   9230:         } else {
                   9231:             my $msg = '<span class="LC_error">';
1.984     raeburn  9232:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.661     raeburn  9233:             $msg .= '</span>';
1.984     raeburn  9234:             return ('existingfile',$msg);
1.661     raeburn  9235:         }
                   9236:     }
                   9237: }
                   9238: 
1.987     raeburn  9239: sub check_for_traversal {
                   9240:     my ($path,$url,$toplevel) = @_;
                   9241:     my @parts=split(/\//,$path);
                   9242:     my $cleanpath;
                   9243:     my $fullpath = $url;
                   9244:     for (my $i=0;$i<@parts;$i++) {
                   9245:         next if ($parts[$i] eq '.');
                   9246:         if ($parts[$i] eq '..') {
                   9247:             $fullpath =~ s{([^/]+/)$}{};
                   9248:         } else {
                   9249:             $fullpath .= $parts[$i].'/';
                   9250:         }
                   9251:     }
                   9252:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   9253:         $cleanpath = $1;
                   9254:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   9255:         my $curr_toprel = $1;
                   9256:         my @parts = split(/\//,$curr_toprel);
                   9257:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   9258:         my @urlparts = split(/\//,$url_toprel);
                   9259:         my $doubledots;
                   9260:         my $startdiff = -1;
                   9261:         for (my $i=0; $i<@urlparts; $i++) {
                   9262:             if ($startdiff == -1) {
                   9263:                 unless ($urlparts[$i] eq $parts[$i]) {
                   9264:                     $startdiff = $i;
                   9265:                     $doubledots .= '../';
                   9266:                 }
                   9267:             } else {
                   9268:                 $doubledots .= '../';
                   9269:             }
                   9270:         }
                   9271:         if ($startdiff > -1) {
                   9272:             $cleanpath = $doubledots;
                   9273:             for (my $i=$startdiff; $i<@parts; $i++) {
                   9274:                 $cleanpath .= $parts[$i].'/';
                   9275:             }
                   9276:         }
                   9277:     }
                   9278:     $cleanpath =~ s{(/)$}{};
                   9279:     return $cleanpath;
                   9280: }
1.31      albertel 9281: 
1.41      ng       9282: =pod
1.45      matthew  9283: 
1.1015    raeburn  9284: =item * &get_turnedin_filepath()
                   9285: 
                   9286: Determines path in a user's portfolio file for storage of files uploaded
                   9287: to a specific essayresponse or dropbox item.
                   9288: 
                   9289: Inputs: 3 required + 1 optional.
                   9290: $symb is symb for resource, $uname and $udom are for current user (required).
                   9291: $caller is optional (can be "submission", if routine is called when storing
                   9292: an upoaded file when "Submit Answer" button was pressed).
                   9293: 
                   9294: Returns array containing $path and $multiresp. 
                   9295: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   9296: than one file upload item.  Callers of routine should append partid as a 
                   9297: subdirectory to $path in cases where $multiresp is 1.
                   9298: 
                   9299: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   9300: 
                   9301: =cut
                   9302: 
                   9303: sub get_turnedin_filepath {
                   9304:     my ($symb,$uname,$udom,$caller) = @_;
                   9305:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   9306:     my $turnindir;
                   9307:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   9308:     $turnindir = $userhash{'turnindir'};
                   9309:     my ($path,$multiresp);
                   9310:     if ($turnindir eq '') {
                   9311:         if ($caller eq 'submission') {
                   9312:             $turnindir = &mt('turned in');
                   9313:             $turnindir =~ s/\W+/_/g;
                   9314:             my %newhash = (
                   9315:                             'turnindir' => $turnindir,
                   9316:                           );
                   9317:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   9318:         }
                   9319:     }
                   9320:     if ($turnindir ne '') {
                   9321:         $path = '/'.$turnindir.'/';
                   9322:         my ($multipart,$turnin,@pathitems);
                   9323:         my $navmap = Apache::lonnavmaps::navmap->new();
                   9324:         if (defined($navmap)) {
                   9325:             my $mapres = $navmap->getResourceByUrl($map);
                   9326:             if (ref($mapres)) {
                   9327:                 my $pcslist = $mapres->map_hierarchy();
                   9328:                 if ($pcslist ne '') {
                   9329:                     foreach my $pc (split(/,/,$pcslist)) {
                   9330:                         my $res = $navmap->getByMapPc($pc);
                   9331:                         if (ref($res)) {
                   9332:                             my $title = $res->compTitle();
                   9333:                             $title =~ s/\W+/_/g;
                   9334:                             if ($title ne '') {
                   9335:                                 push(@pathitems,$title);
                   9336:                             }
                   9337:                         }
                   9338:                     }
                   9339:                 }
                   9340:                 my $maptitle = $mapres->compTitle();
                   9341:                 $maptitle =~ s/\W+/_/g;
                   9342:                 if ($maptitle ne '') {
                   9343:                     push(@pathitems,$maptitle);
                   9344:                 }
                   9345:                 unless ($env{'request.state'} eq 'construct') {
                   9346:                     my $res = $navmap->getBySymb($symb);
                   9347:                     if (ref($res)) {
                   9348:                         my $partlist = $res->parts();
                   9349:                         my $totaluploads = 0;
                   9350:                         if (ref($partlist) eq 'ARRAY') {
                   9351:                             foreach my $part (@{$partlist}) {
                   9352:                                 my @types = $res->responseType($part);
                   9353:                                 my @ids = $res->responseIds($part);
                   9354:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   9355:                                     if ($types[$i] eq 'essay') {
                   9356:                                         my $partid = $part.'_'.$ids[$i];
                   9357:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   9358:                                             $totaluploads ++;
                   9359:                                         }
                   9360:                                     }
                   9361:                                 }
                   9362:                             }
                   9363:                             if ($totaluploads > 1) {
                   9364:                                 $multiresp = 1;
                   9365:                             }
                   9366:                         }
                   9367:                     }
                   9368:                 }
                   9369:             } else {
                   9370:                 return;
                   9371:             }
                   9372:         } else {
                   9373:             return;
                   9374:         }
                   9375:         my $restitle=&Apache::lonnet::gettitle($symb);
                   9376:         $restitle =~ s/\W+/_/g;
                   9377:         if ($restitle eq '') {
                   9378:             $restitle = ($resurl =~ m{/[^/]+$});
                   9379:             if ($restitle eq '') {
                   9380:                 $restitle = time;
                   9381:             }
                   9382:         }
                   9383:         push(@pathitems,$restitle);
                   9384:         $path .= join('/',@pathitems);
                   9385:     }
                   9386:     return ($path,$multiresp);
                   9387: }
                   9388: 
                   9389: =pod
                   9390: 
1.464     albertel 9391: =back
1.41      ng       9392: 
1.112     bowersj2 9393: =head1 CSV Upload/Handling functions
1.38      albertel 9394: 
1.41      ng       9395: =over 4
                   9396: 
1.648     raeburn  9397: =item * &upfile_store($r)
1.41      ng       9398: 
                   9399: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 9400: needs $env{'form.upfile'}
1.41      ng       9401: returns $datatoken to be put into hidden field
                   9402: 
                   9403: =cut
1.31      albertel 9404: 
                   9405: sub upfile_store {
                   9406:     my $r=shift;
1.258     albertel 9407:     $env{'form.upfile'}=~s/\r/\n/gs;
                   9408:     $env{'form.upfile'}=~s/\f/\n/gs;
                   9409:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   9410:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 9411: 
1.258     albertel 9412:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   9413: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 9414:     {
1.158     raeburn  9415:         my $datafile = $r->dir_config('lonDaemons').
                   9416:                            '/tmp/'.$datatoken.'.tmp';
                   9417:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 9418:             print $fh $env{'form.upfile'};
1.158     raeburn  9419:             close($fh);
                   9420:         }
1.31      albertel 9421:     }
                   9422:     return $datatoken;
                   9423: }
                   9424: 
1.56      matthew  9425: =pod
                   9426: 
1.648     raeburn  9427: =item * &load_tmp_file($r)
1.41      ng       9428: 
                   9429: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 9430: needs $env{'form.datatoken'},
                   9431: sets $env{'form.upfile'} to the contents of the file
1.41      ng       9432: 
                   9433: =cut
1.31      albertel 9434: 
                   9435: sub load_tmp_file {
                   9436:     my $r=shift;
                   9437:     my @studentdata=();
                   9438:     {
1.158     raeburn  9439:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 9440:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  9441:         if ( open(my $fh,"<$studentfile") ) {
                   9442:             @studentdata=<$fh>;
                   9443:             close($fh);
                   9444:         }
1.31      albertel 9445:     }
1.258     albertel 9446:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 9447: }
                   9448: 
1.56      matthew  9449: =pod
                   9450: 
1.648     raeburn  9451: =item * &upfile_record_sep()
1.41      ng       9452: 
                   9453: Separate uploaded file into records
                   9454: returns array of records,
1.258     albertel 9455: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       9456: 
                   9457: =cut
1.31      albertel 9458: 
                   9459: sub upfile_record_sep {
1.258     albertel 9460:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 9461:     } else {
1.248     albertel 9462: 	my @records;
1.258     albertel 9463: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 9464: 	    if ($line=~/^\s*$/) { next; }
                   9465: 	    push(@records,$line);
                   9466: 	}
                   9467: 	return @records;
1.31      albertel 9468:     }
                   9469: }
                   9470: 
1.56      matthew  9471: =pod
                   9472: 
1.648     raeburn  9473: =item * &record_sep($record)
1.41      ng       9474: 
1.258     albertel 9475: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       9476: 
                   9477: =cut
                   9478: 
1.263     www      9479: sub takeleft {
                   9480:     my $index=shift;
                   9481:     return substr('0000'.$index,-4,4);
                   9482: }
                   9483: 
1.31      albertel 9484: sub record_sep {
                   9485:     my $record=shift;
                   9486:     my %components=();
1.258     albertel 9487:     if ($env{'form.upfiletype'} eq 'xml') {
                   9488:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 9489:         my $i=0;
1.356     albertel 9490:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 9491:             $field=~s/^(\"|\')//;
                   9492:             $field=~s/(\"|\')$//;
1.263     www      9493:             $components{&takeleft($i)}=$field;
1.31      albertel 9494:             $i++;
                   9495:         }
1.258     albertel 9496:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 9497:         my $i=0;
1.356     albertel 9498:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 9499:             $field=~s/^(\"|\')//;
                   9500:             $field=~s/(\"|\')$//;
1.263     www      9501:             $components{&takeleft($i)}=$field;
1.31      albertel 9502:             $i++;
                   9503:         }
                   9504:     } else {
1.561     www      9505:         my $separator=',';
1.480     banghart 9506:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      9507:             $separator=';';
1.480     banghart 9508:         }
1.31      albertel 9509:         my $i=0;
1.561     www      9510: # the character we are looking for to indicate the end of a quote or a record 
                   9511:         my $looking_for=$separator;
                   9512: # do not add the characters to the fields
                   9513:         my $ignore=0;
                   9514: # we just encountered a separator (or the beginning of the record)
                   9515:         my $just_found_separator=1;
                   9516: # store the field we are working on here
                   9517:         my $field='';
                   9518: # work our way through all characters in record
                   9519:         foreach my $character ($record=~/(.)/g) {
                   9520:             if ($character eq $looking_for) {
                   9521:                if ($character ne $separator) {
                   9522: # Found the end of a quote, again looking for separator
                   9523:                   $looking_for=$separator;
                   9524:                   $ignore=1;
                   9525:                } else {
                   9526: # Found a separator, store away what we got
                   9527:                   $components{&takeleft($i)}=$field;
                   9528: 	          $i++;
                   9529:                   $just_found_separator=1;
                   9530:                   $ignore=0;
                   9531:                   $field='';
                   9532:                }
                   9533:                next;
                   9534:             }
                   9535: # single or double quotation marks after a separator indicate beginning of a quote
                   9536: # we are now looking for the end of the quote and need to ignore separators
                   9537:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   9538:                $looking_for=$character;
                   9539:                next;
                   9540:             }
                   9541: # ignore would be true after we reached the end of a quote
                   9542:             if ($ignore) { next; }
                   9543:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   9544:             $field.=$character;
                   9545:             $just_found_separator=0; 
1.31      albertel 9546:         }
1.561     www      9547: # catch the very last entry, since we never encountered the separator
                   9548:         $components{&takeleft($i)}=$field;
1.31      albertel 9549:     }
                   9550:     return %components;
                   9551: }
                   9552: 
1.144     matthew  9553: ######################################################
                   9554: ######################################################
                   9555: 
1.56      matthew  9556: =pod
                   9557: 
1.648     raeburn  9558: =item * &upfile_select_html()
1.41      ng       9559: 
1.144     matthew  9560: Return HTML code to select a file from the users machine and specify 
                   9561: the file type.
1.41      ng       9562: 
                   9563: =cut
                   9564: 
1.144     matthew  9565: ######################################################
                   9566: ######################################################
1.31      albertel 9567: sub upfile_select_html {
1.144     matthew  9568:     my %Types = (
                   9569:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 9570:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  9571:                  space => &mt('Space separated'),
                   9572:                  tab   => &mt('Tabulator separated'),
                   9573: #                 xml   => &mt('HTML/XML'),
                   9574:                  );
                   9575:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  9576:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  9577:     foreach my $type (sort(keys(%Types))) {
                   9578:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   9579:     }
                   9580:     $Str .= "</select>\n";
                   9581:     return $Str;
1.31      albertel 9582: }
                   9583: 
1.301     albertel 9584: sub get_samples {
                   9585:     my ($records,$toget) = @_;
                   9586:     my @samples=({});
                   9587:     my $got=0;
                   9588:     foreach my $rec (@$records) {
                   9589: 	my %temp = &record_sep($rec);
                   9590: 	if (! grep(/\S/, values(%temp))) { next; }
                   9591: 	if (%temp) {
                   9592: 	    $samples[$got]=\%temp;
                   9593: 	    $got++;
                   9594: 	    if ($got == $toget) { last; }
                   9595: 	}
                   9596:     }
                   9597:     return \@samples;
                   9598: }
                   9599: 
1.144     matthew  9600: ######################################################
                   9601: ######################################################
                   9602: 
1.56      matthew  9603: =pod
                   9604: 
1.648     raeburn  9605: =item * &csv_print_samples($r,$records)
1.41      ng       9606: 
                   9607: Prints a table of sample values from each column uploaded $r is an
                   9608: Apache Request ref, $records is an arrayref from
                   9609: &Apache::loncommon::upfile_record_sep
                   9610: 
                   9611: =cut
                   9612: 
1.144     matthew  9613: ######################################################
                   9614: ######################################################
1.31      albertel 9615: sub csv_print_samples {
                   9616:     my ($r,$records) = @_;
1.662     bisitz   9617:     my $samples = &get_samples($records,5);
1.301     albertel 9618: 
1.594     raeburn  9619:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   9620:               &start_data_table_header_row());
1.356     albertel 9621:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   9622:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  9623:     $r->print(&end_data_table_header_row());
1.301     albertel 9624:     foreach my $hash (@$samples) {
1.594     raeburn  9625: 	$r->print(&start_data_table_row());
1.356     albertel 9626: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 9627: 	    $r->print('<td>');
1.356     albertel 9628: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 9629: 	    $r->print('</td>');
                   9630: 	}
1.594     raeburn  9631: 	$r->print(&end_data_table_row());
1.31      albertel 9632:     }
1.594     raeburn  9633:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 9634: }
                   9635: 
1.144     matthew  9636: ######################################################
                   9637: ######################################################
                   9638: 
1.56      matthew  9639: =pod
                   9640: 
1.648     raeburn  9641: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       9642: 
                   9643: Prints a table to create associations between values and table columns.
1.144     matthew  9644: 
1.41      ng       9645: $r is an Apache Request ref,
                   9646: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  9647: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       9648: 
                   9649: =cut
                   9650: 
1.144     matthew  9651: ######################################################
                   9652: ######################################################
1.31      albertel 9653: sub csv_print_select_table {
                   9654:     my ($r,$records,$d) = @_;
1.301     albertel 9655:     my $i=0;
                   9656:     my $samples = &get_samples($records,1);
1.144     matthew  9657:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  9658: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  9659:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  9660:               '<th>'.&mt('Column').'</th>'.
                   9661:               &end_data_table_header_row()."\n");
1.356     albertel 9662:     foreach my $array_ref (@$d) {
                   9663: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  9664: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 9665: 
1.875     bisitz   9666: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  9667: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 9668: 	$r->print('<option value="none"></option>');
1.356     albertel 9669: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   9670: 	    $r->print('<option value="'.$sample.'"'.
                   9671:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   9672:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 9673: 	}
1.594     raeburn  9674: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 9675: 	$i++;
                   9676:     }
1.594     raeburn  9677:     $r->print(&end_data_table());
1.31      albertel 9678:     $i--;
                   9679:     return $i;
                   9680: }
1.56      matthew  9681: 
1.144     matthew  9682: ######################################################
                   9683: ######################################################
                   9684: 
1.56      matthew  9685: =pod
1.31      albertel 9686: 
1.648     raeburn  9687: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       9688: 
                   9689: Prints a table of sample values from the upload and can make associate samples to internal names.
                   9690: 
                   9691: $r is an Apache Request ref,
                   9692: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   9693: $d is an array of 2 element arrays (internal name, displayed name)
                   9694: 
                   9695: =cut
                   9696: 
1.144     matthew  9697: ######################################################
                   9698: ######################################################
1.31      albertel 9699: sub csv_samples_select_table {
                   9700:     my ($r,$records,$d) = @_;
                   9701:     my $i=0;
1.144     matthew  9702:     #
1.662     bisitz   9703:     my $max_samples = 5;
                   9704:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  9705:     $r->print(&start_data_table().
                   9706:               &start_data_table_header_row().'<th>'.
                   9707:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   9708:               &end_data_table_header_row());
1.301     albertel 9709: 
                   9710:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  9711: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  9712: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 9713: 	foreach my $option (@$d) {
                   9714: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  9715: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 9716:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  9717:                       $display.'</option>');
1.31      albertel 9718: 	}
                   9719: 	$r->print('</select></td><td>');
1.662     bisitz   9720: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 9721: 	    if (defined($samples->[$line]{$key})) { 
                   9722: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   9723: 	    }
                   9724: 	}
1.594     raeburn  9725: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 9726: 	$i++;
                   9727:     }
1.594     raeburn  9728:     $r->print(&end_data_table());
1.31      albertel 9729:     $i--;
                   9730:     return($i);
1.115     matthew  9731: }
                   9732: 
1.144     matthew  9733: ######################################################
                   9734: ######################################################
                   9735: 
1.115     matthew  9736: =pod
                   9737: 
1.648     raeburn  9738: =item * &clean_excel_name($name)
1.115     matthew  9739: 
                   9740: Returns a replacement for $name which does not contain any illegal characters.
                   9741: 
                   9742: =cut
                   9743: 
1.144     matthew  9744: ######################################################
                   9745: ######################################################
1.115     matthew  9746: sub clean_excel_name {
                   9747:     my ($name) = @_;
                   9748:     $name =~ s/[:\*\?\/\\]//g;
                   9749:     if (length($name) > 31) {
                   9750:         $name = substr($name,0,31);
                   9751:     }
                   9752:     return $name;
1.25      albertel 9753: }
1.84      albertel 9754: 
1.85      albertel 9755: =pod
                   9756: 
1.648     raeburn  9757: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 9758: 
                   9759: Returns either 1 or undef
                   9760: 
                   9761: 1 if the part is to be hidden, undef if it is to be shown
                   9762: 
                   9763: Arguments are:
                   9764: 
                   9765: $id the id of the part to be checked
                   9766: $symb, optional the symb of the resource to check
                   9767: $udom, optional the domain of the user to check for
                   9768: $uname, optional the username of the user to check for
                   9769: 
                   9770: =cut
1.84      albertel 9771: 
                   9772: sub check_if_partid_hidden {
                   9773:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 9774:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 9775: 					 $symb,$udom,$uname);
1.141     albertel 9776:     my $truth=1;
                   9777:     #if the string starts with !, then the list is the list to show not hide
                   9778:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 9779:     my @hiddenlist=split(/,/,$hiddenparts);
                   9780:     foreach my $checkid (@hiddenlist) {
1.141     albertel 9781: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 9782:     }
1.141     albertel 9783:     return !$truth;
1.84      albertel 9784: }
1.127     matthew  9785: 
1.138     matthew  9786: 
                   9787: ############################################################
                   9788: ############################################################
                   9789: 
                   9790: =pod
                   9791: 
1.157     matthew  9792: =back 
                   9793: 
1.138     matthew  9794: =head1 cgi-bin script and graphing routines
                   9795: 
1.157     matthew  9796: =over 4
                   9797: 
1.648     raeburn  9798: =item * &get_cgi_id()
1.138     matthew  9799: 
                   9800: Inputs: none
                   9801: 
                   9802: Returns an id which can be used to pass environment variables
                   9803: to various cgi-bin scripts.  These environment variables will
                   9804: be removed from the users environment after a given time by
                   9805: the routine &Apache::lonnet::transfer_profile_to_env.
                   9806: 
                   9807: =cut
                   9808: 
                   9809: ############################################################
                   9810: ############################################################
1.152     albertel 9811: my $uniq=0;
1.136     matthew  9812: sub get_cgi_id {
1.154     albertel 9813:     $uniq=($uniq+1)%100000;
1.280     albertel 9814:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  9815: }
                   9816: 
1.127     matthew  9817: ############################################################
                   9818: ############################################################
                   9819: 
                   9820: =pod
                   9821: 
1.648     raeburn  9822: =item * &DrawBarGraph()
1.127     matthew  9823: 
1.138     matthew  9824: Facilitates the plotting of data in a (stacked) bar graph.
                   9825: Puts plot definition data into the users environment in order for 
                   9826: graph.png to plot it.  Returns an <img> tag for the plot.
                   9827: The bars on the plot are labeled '1','2',...,'n'.
                   9828: 
                   9829: Inputs:
                   9830: 
                   9831: =over 4
                   9832: 
                   9833: =item $Title: string, the title of the plot
                   9834: 
                   9835: =item $xlabel: string, text describing the X-axis of the plot
                   9836: 
                   9837: =item $ylabel: string, text describing the Y-axis of the plot
                   9838: 
                   9839: =item $Max: scalar, the maximum Y value to use in the plot
                   9840: If $Max is < any data point, the graph will not be rendered.
                   9841: 
1.140     matthew  9842: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  9843: they are plotted.  If undefined, default values will be used.
                   9844: 
1.178     matthew  9845: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   9846: 
1.138     matthew  9847: =item @Values: An array of array references.  Each array reference holds data
                   9848: to be plotted in a stacked bar chart.
                   9849: 
1.239     matthew  9850: =item If the final element of @Values is a hash reference the key/value
                   9851: pairs will be added to the graph definition.
                   9852: 
1.138     matthew  9853: =back
                   9854: 
                   9855: Returns:
                   9856: 
                   9857: An <img> tag which references graph.png and the appropriate identifying
                   9858: information for the plot.
                   9859: 
1.127     matthew  9860: =cut
                   9861: 
                   9862: ############################################################
                   9863: ############################################################
1.134     matthew  9864: sub DrawBarGraph {
1.178     matthew  9865:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  9866:     #
                   9867:     if (! defined($colors)) {
                   9868:         $colors = ['#33ff00', 
                   9869:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   9870:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   9871:                   ]; 
                   9872:     }
1.228     matthew  9873:     my $extra_settings = {};
                   9874:     if (ref($Values[-1]) eq 'HASH') {
                   9875:         $extra_settings = pop(@Values);
                   9876:     }
1.127     matthew  9877:     #
1.136     matthew  9878:     my $identifier = &get_cgi_id();
                   9879:     my $id = 'cgi.'.$identifier;        
1.129     matthew  9880:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  9881:         return '';
                   9882:     }
1.225     matthew  9883:     #
                   9884:     my @Labels;
                   9885:     if (defined($labels)) {
                   9886:         @Labels = @$labels;
                   9887:     } else {
                   9888:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   9889:             push (@Labels,$i+1);
                   9890:         }
                   9891:     }
                   9892:     #
1.129     matthew  9893:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  9894:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  9895:     my %ValuesHash;
                   9896:     my $NumSets=1;
                   9897:     foreach my $array (@Values) {
                   9898:         next if (! ref($array));
1.136     matthew  9899:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  9900:             join(',',@$array);
1.129     matthew  9901:     }
1.127     matthew  9902:     #
1.136     matthew  9903:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  9904:     if ($NumBars < 3) {
                   9905:         $width = 120+$NumBars*32;
1.220     matthew  9906:         $xskip = 1;
1.225     matthew  9907:         $bar_width = 30;
                   9908:     } elsif ($NumBars < 5) {
                   9909:         $width = 120+$NumBars*20;
                   9910:         $xskip = 1;
                   9911:         $bar_width = 20;
1.220     matthew  9912:     } elsif ($NumBars < 10) {
1.136     matthew  9913:         $width = 120+$NumBars*15;
                   9914:         $xskip = 1;
                   9915:         $bar_width = 15;
                   9916:     } elsif ($NumBars <= 25) {
                   9917:         $width = 120+$NumBars*11;
                   9918:         $xskip = 5;
                   9919:         $bar_width = 8;
                   9920:     } elsif ($NumBars <= 50) {
                   9921:         $width = 120+$NumBars*8;
                   9922:         $xskip = 5;
                   9923:         $bar_width = 4;
                   9924:     } else {
                   9925:         $width = 120+$NumBars*8;
                   9926:         $xskip = 5;
                   9927:         $bar_width = 4;
                   9928:     }
                   9929:     #
1.137     matthew  9930:     $Max = 1 if ($Max < 1);
                   9931:     if ( int($Max) < $Max ) {
                   9932:         $Max++;
                   9933:         $Max = int($Max);
                   9934:     }
1.127     matthew  9935:     $Title  = '' if (! defined($Title));
                   9936:     $xlabel = '' if (! defined($xlabel));
                   9937:     $ylabel = '' if (! defined($ylabel));
1.369     www      9938:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   9939:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   9940:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  9941:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  9942:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   9943:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   9944:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   9945:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9946:     $ValuesHash{$id.'.height'}   = $height;
                   9947:     $ValuesHash{$id.'.width'}    = $width;
                   9948:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   9949:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   9950:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  9951:     #
1.228     matthew  9952:     # Deal with other parameters
                   9953:     while (my ($key,$value) = each(%$extra_settings)) {
                   9954:         $ValuesHash{$id.'.'.$key} = $value;
                   9955:     }
                   9956:     #
1.646     raeburn  9957:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  9958:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9959: }
                   9960: 
                   9961: ############################################################
                   9962: ############################################################
                   9963: 
                   9964: =pod
                   9965: 
1.648     raeburn  9966: =item * &DrawXYGraph()
1.137     matthew  9967: 
1.138     matthew  9968: Facilitates the plotting of data in an XY graph.
                   9969: Puts plot definition data into the users environment in order for 
                   9970: graph.png to plot it.  Returns an <img> tag for the plot.
                   9971: 
                   9972: Inputs:
                   9973: 
                   9974: =over 4
                   9975: 
                   9976: =item $Title: string, the title of the plot
                   9977: 
                   9978: =item $xlabel: string, text describing the X-axis of the plot
                   9979: 
                   9980: =item $ylabel: string, text describing the Y-axis of the plot
                   9981: 
                   9982: =item $Max: scalar, the maximum Y value to use in the plot
                   9983: If $Max is < any data point, the graph will not be rendered.
                   9984: 
                   9985: =item $colors: Array ref containing the hex color codes for the data to be 
                   9986: plotted in.  If undefined, default values will be used.
                   9987: 
                   9988: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9989: 
                   9990: =item $Ydata: Array ref containing Array refs.  
1.185     www      9991: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  9992: 
                   9993: =item %Values: hash indicating or overriding any default values which are 
                   9994: passed to graph.png.  
                   9995: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9996: 
                   9997: =back
                   9998: 
                   9999: Returns:
                   10000: 
                   10001: An <img> tag which references graph.png and the appropriate identifying
                   10002: information for the plot.
                   10003: 
1.137     matthew  10004: =cut
                   10005: 
                   10006: ############################################################
                   10007: ############################################################
                   10008: sub DrawXYGraph {
                   10009:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   10010:     #
                   10011:     # Create the identifier for the graph
                   10012:     my $identifier = &get_cgi_id();
                   10013:     my $id = 'cgi.'.$identifier;
                   10014:     #
                   10015:     $Title  = '' if (! defined($Title));
                   10016:     $xlabel = '' if (! defined($xlabel));
                   10017:     $ylabel = '' if (! defined($ylabel));
                   10018:     my %ValuesHash = 
                   10019:         (
1.369     www      10020:          $id.'.title'  => &escape($Title),
                   10021:          $id.'.xlabel' => &escape($xlabel),
                   10022:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  10023:          $id.'.y_max_value'=> $Max,
                   10024:          $id.'.labels'     => join(',',@$Xlabels),
                   10025:          $id.'.PlotType'   => 'XY',
                   10026:          );
                   10027:     #
                   10028:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   10029:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10030:     }
                   10031:     #
                   10032:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   10033:         return '';
                   10034:     }
                   10035:     my $NumSets=1;
1.138     matthew  10036:     foreach my $array (@{$Ydata}){
1.137     matthew  10037:         next if (! ref($array));
                   10038:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   10039:     }
1.138     matthew  10040:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  10041:     #
                   10042:     # Deal with other parameters
                   10043:     while (my ($key,$value) = each(%Values)) {
                   10044:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  10045:     }
                   10046:     #
1.646     raeburn  10047:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  10048:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   10049: }
                   10050: 
                   10051: ############################################################
                   10052: ############################################################
                   10053: 
                   10054: =pod
                   10055: 
1.648     raeburn  10056: =item * &DrawXYYGraph()
1.138     matthew  10057: 
                   10058: Facilitates the plotting of data in an XY graph with two Y axes.
                   10059: Puts plot definition data into the users environment in order for 
                   10060: graph.png to plot it.  Returns an <img> tag for the plot.
                   10061: 
                   10062: Inputs:
                   10063: 
                   10064: =over 4
                   10065: 
                   10066: =item $Title: string, the title of the plot
                   10067: 
                   10068: =item $xlabel: string, text describing the X-axis of the plot
                   10069: 
                   10070: =item $ylabel: string, text describing the Y-axis of the plot
                   10071: 
                   10072: =item $colors: Array ref containing the hex color codes for the data to be 
                   10073: plotted in.  If undefined, default values will be used.
                   10074: 
                   10075: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   10076: 
                   10077: =item $Ydata1: The first data set
                   10078: 
                   10079: =item $Min1: The minimum value of the left Y-axis
                   10080: 
                   10081: =item $Max1: The maximum value of the left Y-axis
                   10082: 
                   10083: =item $Ydata2: The second data set
                   10084: 
                   10085: =item $Min2: The minimum value of the right Y-axis
                   10086: 
                   10087: =item $Max2: The maximum value of the left Y-axis
                   10088: 
                   10089: =item %Values: hash indicating or overriding any default values which are 
                   10090: passed to graph.png.  
                   10091: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   10092: 
                   10093: =back
                   10094: 
                   10095: Returns:
                   10096: 
                   10097: An <img> tag which references graph.png and the appropriate identifying
                   10098: information for the plot.
1.136     matthew  10099: 
                   10100: =cut
                   10101: 
                   10102: ############################################################
                   10103: ############################################################
1.137     matthew  10104: sub DrawXYYGraph {
                   10105:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   10106:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  10107:     #
                   10108:     # Create the identifier for the graph
                   10109:     my $identifier = &get_cgi_id();
                   10110:     my $id = 'cgi.'.$identifier;
                   10111:     #
                   10112:     $Title  = '' if (! defined($Title));
                   10113:     $xlabel = '' if (! defined($xlabel));
                   10114:     $ylabel = '' if (! defined($ylabel));
                   10115:     my %ValuesHash = 
                   10116:         (
1.369     www      10117:          $id.'.title'  => &escape($Title),
                   10118:          $id.'.xlabel' => &escape($xlabel),
                   10119:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  10120:          $id.'.labels' => join(',',@$Xlabels),
                   10121:          $id.'.PlotType' => 'XY',
                   10122:          $id.'.NumSets' => 2,
1.137     matthew  10123:          $id.'.two_axes' => 1,
                   10124:          $id.'.y1_max_value' => $Max1,
                   10125:          $id.'.y1_min_value' => $Min1,
                   10126:          $id.'.y2_max_value' => $Max2,
                   10127:          $id.'.y2_min_value' => $Min2,
1.136     matthew  10128:          );
                   10129:     #
1.137     matthew  10130:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   10131:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10132:     }
                   10133:     #
                   10134:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   10135:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  10136:         return '';
                   10137:     }
                   10138:     my $NumSets=1;
1.137     matthew  10139:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  10140:         next if (! ref($array));
                   10141:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  10142:     }
                   10143:     #
                   10144:     # Deal with other parameters
                   10145:     while (my ($key,$value) = each(%Values)) {
                   10146:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  10147:     }
                   10148:     #
1.646     raeburn  10149:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 10150:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  10151: }
                   10152: 
                   10153: ############################################################
                   10154: ############################################################
                   10155: 
                   10156: =pod
                   10157: 
1.157     matthew  10158: =back 
                   10159: 
1.139     matthew  10160: =head1 Statistics helper routines?  
                   10161: 
                   10162: Bad place for them but what the hell.
                   10163: 
1.157     matthew  10164: =over 4
                   10165: 
1.648     raeburn  10166: =item * &chartlink()
1.139     matthew  10167: 
                   10168: Returns a link to the chart for a specific student.  
                   10169: 
                   10170: Inputs:
                   10171: 
                   10172: =over 4
                   10173: 
                   10174: =item $linktext: The text of the link
                   10175: 
                   10176: =item $sname: The students username
                   10177: 
                   10178: =item $sdomain: The students domain
                   10179: 
                   10180: =back
                   10181: 
1.157     matthew  10182: =back
                   10183: 
1.139     matthew  10184: =cut
                   10185: 
                   10186: ############################################################
                   10187: ############################################################
                   10188: sub chartlink {
                   10189:     my ($linktext, $sname, $sdomain) = @_;
                   10190:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      10191:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 10192:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  10193:        '">'.$linktext.'</a>';
1.153     matthew  10194: }
                   10195: 
                   10196: #######################################################
                   10197: #######################################################
                   10198: 
                   10199: =pod
                   10200: 
                   10201: =head1 Course Environment Routines
1.157     matthew  10202: 
                   10203: =over 4
1.153     matthew  10204: 
1.648     raeburn  10205: =item * &restore_course_settings()
1.153     matthew  10206: 
1.648     raeburn  10207: =item * &store_course_settings()
1.153     matthew  10208: 
                   10209: Restores/Store indicated form parameters from the course environment.
                   10210: Will not overwrite existing values of the form parameters.
                   10211: 
                   10212: Inputs: 
                   10213: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   10214: 
                   10215: a hash ref describing the data to be stored.  For example:
                   10216:    
                   10217: %Save_Parameters = ('Status' => 'scalar',
                   10218:     'chartoutputmode' => 'scalar',
                   10219:     'chartoutputdata' => 'scalar',
                   10220:     'Section' => 'array',
1.373     raeburn  10221:     'Group' => 'array',
1.153     matthew  10222:     'StudentData' => 'array',
                   10223:     'Maps' => 'array');
                   10224: 
                   10225: Returns: both routines return nothing
                   10226: 
1.631     raeburn  10227: =back
                   10228: 
1.153     matthew  10229: =cut
                   10230: 
                   10231: #######################################################
                   10232: #######################################################
                   10233: sub store_course_settings {
1.496     albertel 10234:     return &store_settings($env{'request.course.id'},@_);
                   10235: }
                   10236: 
                   10237: sub store_settings {
1.153     matthew  10238:     # save to the environment
                   10239:     # appenv the same items, just to be safe
1.300     albertel 10240:     my $udom  = $env{'user.domain'};
                   10241:     my $uname = $env{'user.name'};
1.496     albertel 10242:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10243:     my %SaveHash;
                   10244:     my %AppHash;
                   10245:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 10246:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 10247:         my $envname = 'environment.'.$basename;
1.258     albertel 10248:         if (exists($env{'form.'.$setting})) {
1.153     matthew  10249:             # Save this value away
                   10250:             if ($type eq 'scalar' &&
1.258     albertel 10251:                 (! exists($env{$envname}) || 
                   10252:                  $env{$envname} ne $env{'form.'.$setting})) {
                   10253:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   10254:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  10255:             } elsif ($type eq 'array') {
                   10256:                 my $stored_form;
1.258     albertel 10257:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  10258:                     $stored_form = join(',',
                   10259:                                         map {
1.369     www      10260:                                             &escape($_);
1.258     albertel 10261:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  10262:                 } else {
                   10263:                     $stored_form = 
1.369     www      10264:                         &escape($env{'form.'.$setting});
1.153     matthew  10265:                 }
                   10266:                 # Determine if the array contents are the same.
1.258     albertel 10267:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  10268:                     $SaveHash{$basename} = $stored_form;
                   10269:                     $AppHash{$envname}   = $stored_form;
                   10270:                 }
                   10271:             }
                   10272:         }
                   10273:     }
                   10274:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 10275:                                           $udom,$uname);
1.153     matthew  10276:     if ($put_result !~ /^(ok|delayed)/) {
                   10277:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   10278:                                  'got error:'.$put_result);
                   10279:     }
                   10280:     # Make sure these settings stick around in this session, too
1.646     raeburn  10281:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  10282:     return;
                   10283: }
                   10284: 
                   10285: sub restore_course_settings {
1.499     albertel 10286:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 10287: }
                   10288: 
                   10289: sub restore_settings {
                   10290:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10291:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 10292:         next if (exists($env{'form.'.$setting}));
1.496     albertel 10293:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  10294:             '.'.$setting;
1.258     albertel 10295:         if (exists($env{$envname})) {
1.153     matthew  10296:             if ($type eq 'scalar') {
1.258     albertel 10297:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  10298:             } elsif ($type eq 'array') {
1.258     albertel 10299:                 $env{'form.'.$setting} = [ 
1.153     matthew  10300:                                            map { 
1.369     www      10301:                                                &unescape($_); 
1.258     albertel 10302:                                            } split(',',$env{$envname})
1.153     matthew  10303:                                            ];
                   10304:             }
                   10305:         }
                   10306:     }
1.127     matthew  10307: }
                   10308: 
1.618     raeburn  10309: #######################################################
                   10310: #######################################################
                   10311: 
                   10312: =pod
                   10313: 
                   10314: =head1 Domain E-mail Routines  
                   10315: 
                   10316: =over 4
                   10317: 
1.648     raeburn  10318: =item * &build_recipient_list()
1.618     raeburn  10319: 
1.884     raeburn  10320: Build recipient lists for five types of e-mail:
1.766     raeburn  10321: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  10322: (d) Help requests, (e) Course requests needing approval,  generated by
                   10323: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   10324: loncoursequeueadmin.pm respectively.
1.618     raeburn  10325: 
                   10326: Inputs:
1.619     raeburn  10327: defmail (scalar - email address of default recipient), 
1.618     raeburn  10328: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  10329: defdom (domain for which to retrieve configuration settings),
                   10330: origmail (scalar - email address of recipient from loncapa.conf, 
                   10331: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  10332: 
1.655     raeburn  10333: Returns: comma separated list of addresses to which to send e-mail.
                   10334: 
                   10335: =back
1.618     raeburn  10336: 
                   10337: =cut
                   10338: 
                   10339: ############################################################
                   10340: ############################################################
                   10341: sub build_recipient_list {
1.619     raeburn  10342:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  10343:     my @recipients;
                   10344:     my $otheremails;
                   10345:     my %domconfig =
                   10346:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   10347:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  10348:         if (exists($domconfig{'contacts'}{$mailing})) {
                   10349:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   10350:                 my @contacts = ('adminemail','supportemail');
                   10351:                 foreach my $item (@contacts) {
                   10352:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   10353:                         my $addr = $domconfig{'contacts'}{$item}; 
                   10354:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10355:                             push(@recipients,$addr);
                   10356:                         }
1.619     raeburn  10357:                     }
1.766     raeburn  10358:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  10359:                 }
                   10360:             }
1.766     raeburn  10361:         } elsif ($origmail ne '') {
                   10362:             push(@recipients,$origmail);
1.618     raeburn  10363:         }
1.619     raeburn  10364:     } elsif ($origmail ne '') {
                   10365:         push(@recipients,$origmail);
1.618     raeburn  10366:     }
1.688     raeburn  10367:     if (defined($defmail)) {
                   10368:         if ($defmail ne '') {
                   10369:             push(@recipients,$defmail);
                   10370:         }
1.618     raeburn  10371:     }
                   10372:     if ($otheremails) {
1.619     raeburn  10373:         my @others;
                   10374:         if ($otheremails =~ /,/) {
                   10375:             @others = split(/,/,$otheremails);
1.618     raeburn  10376:         } else {
1.619     raeburn  10377:             push(@others,$otheremails);
                   10378:         }
                   10379:         foreach my $addr (@others) {
                   10380:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10381:                 push(@recipients,$addr);
                   10382:             }
1.618     raeburn  10383:         }
                   10384:     }
1.619     raeburn  10385:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  10386:     return $recipientlist;
                   10387: }
                   10388: 
1.127     matthew  10389: ############################################################
                   10390: ############################################################
1.154     albertel 10391: 
1.655     raeburn  10392: =pod
                   10393: 
                   10394: =head1 Course Catalog Routines
                   10395: 
                   10396: =over 4
                   10397: 
                   10398: =item * &gather_categories()
                   10399: 
                   10400: Converts category definitions - keys of categories hash stored in  
                   10401: coursecategories in configuration.db on the primary library server in a 
                   10402: domain - to an array.  Also generates javascript and idx hash used to 
                   10403: generate Domain Coordinator interface for editing Course Categories.
                   10404: 
                   10405: Inputs:
1.663     raeburn  10406: 
1.655     raeburn  10407: categories (reference to hash of category definitions).
1.663     raeburn  10408: 
1.655     raeburn  10409: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10410:       categories and subcategories).
1.663     raeburn  10411: 
1.655     raeburn  10412: idx (reference to hash of counters used in Domain Coordinator interface for 
                   10413:       editing Course Categories).
1.663     raeburn  10414: 
1.655     raeburn  10415: jsarray (reference to array of categories used to create Javascript arrays for
                   10416:          Domain Coordinator interface for editing Course Categories).
                   10417: 
                   10418: Returns: nothing
                   10419: 
                   10420: Side effects: populates cats, idx and jsarray. 
                   10421: 
                   10422: =cut
                   10423: 
                   10424: sub gather_categories {
                   10425:     my ($categories,$cats,$idx,$jsarray) = @_;
                   10426:     my %counters;
                   10427:     my $num = 0;
                   10428:     foreach my $item (keys(%{$categories})) {
                   10429:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   10430:         if ($container eq '' && $depth == 0) {
                   10431:             $cats->[$depth][$categories->{$item}] = $cat;
                   10432:         } else {
                   10433:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   10434:         }
                   10435:         my ($escitem,$tail) = split(/:/,$item,2);
                   10436:         if ($counters{$tail} eq '') {
                   10437:             $counters{$tail} = $num;
                   10438:             $num ++;
                   10439:         }
                   10440:         if (ref($idx) eq 'HASH') {
                   10441:             $idx->{$item} = $counters{$tail};
                   10442:         }
                   10443:         if (ref($jsarray) eq 'ARRAY') {
                   10444:             push(@{$jsarray->[$counters{$tail}]},$item);
                   10445:         }
                   10446:     }
                   10447:     return;
                   10448: }
                   10449: 
                   10450: =pod
                   10451: 
                   10452: =item * &extract_categories()
                   10453: 
                   10454: Used to generate breadcrumb trails for course categories.
                   10455: 
                   10456: Inputs:
1.663     raeburn  10457: 
1.655     raeburn  10458: categories (reference to hash of category definitions).
1.663     raeburn  10459: 
1.655     raeburn  10460: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10461:       categories and subcategories).
1.663     raeburn  10462: 
1.655     raeburn  10463: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  10464: 
1.655     raeburn  10465: allitems (reference to hash - key is category key 
                   10466:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10467: 
1.655     raeburn  10468: idx (reference to hash of counters used in Domain Coordinator interface for
                   10469:       editing Course Categories).
1.663     raeburn  10470: 
1.655     raeburn  10471: jsarray (reference to array of categories used to create Javascript arrays for
                   10472:          Domain Coordinator interface for editing Course Categories).
                   10473: 
1.665     raeburn  10474: subcats (reference to hash of arrays containing all subcategories within each 
                   10475:          category, -recursive)
                   10476: 
1.655     raeburn  10477: Returns: nothing
                   10478: 
                   10479: Side effects: populates trails and allitems hash references.
                   10480: 
                   10481: =cut
                   10482: 
                   10483: sub extract_categories {
1.665     raeburn  10484:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  10485:     if (ref($categories) eq 'HASH') {
                   10486:         &gather_categories($categories,$cats,$idx,$jsarray);
                   10487:         if (ref($cats->[0]) eq 'ARRAY') {
                   10488:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   10489:                 my $name = $cats->[0][$i];
                   10490:                 my $item = &escape($name).'::0';
                   10491:                 my $trailstr;
                   10492:                 if ($name eq 'instcode') {
                   10493:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  10494:                 } elsif ($name eq 'communities') {
                   10495:                     $trailstr = &mt('Communities');
1.655     raeburn  10496:                 } else {
                   10497:                     $trailstr = $name;
                   10498:                 }
                   10499:                 if ($allitems->{$item} eq '') {
                   10500:                     push(@{$trails},$trailstr);
                   10501:                     $allitems->{$item} = scalar(@{$trails})-1;
                   10502:                 }
                   10503:                 my @parents = ($name);
                   10504:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   10505:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   10506:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  10507:                         if (ref($subcats) eq 'HASH') {
                   10508:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   10509:                         }
                   10510:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   10511:                     }
                   10512:                 } else {
                   10513:                     if (ref($subcats) eq 'HASH') {
                   10514:                         $subcats->{$item} = [];
1.655     raeburn  10515:                     }
                   10516:                 }
                   10517:             }
                   10518:         }
                   10519:     }
                   10520:     return;
                   10521: }
                   10522: 
                   10523: =pod
                   10524: 
                   10525: =item *&recurse_categories()
                   10526: 
                   10527: Recursively used to generate breadcrumb trails for course categories.
                   10528: 
                   10529: Inputs:
1.663     raeburn  10530: 
1.655     raeburn  10531: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10532:       categories and subcategories).
1.663     raeburn  10533: 
1.655     raeburn  10534: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  10535: 
                   10536: category (current course category, for which breadcrumb trail is being generated).
                   10537: 
                   10538: trails (reference to array of breadcrumb trails for each category).
                   10539: 
1.655     raeburn  10540: allitems (reference to hash - key is category key
                   10541:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10542: 
1.655     raeburn  10543: parents (array containing containers directories for current category, 
                   10544:          back to top level). 
                   10545: 
                   10546: Returns: nothing
                   10547: 
                   10548: Side effects: populates trails and allitems hash references
                   10549: 
                   10550: =cut
                   10551: 
                   10552: sub recurse_categories {
1.665     raeburn  10553:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  10554:     my $shallower = $depth - 1;
                   10555:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   10556:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   10557:             my $name = $cats->[$depth]{$category}[$k];
                   10558:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10559:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10560:             if ($allitems->{$item} eq '') {
                   10561:                 push(@{$trails},$trailstr);
                   10562:                 $allitems->{$item} = scalar(@{$trails})-1;
                   10563:             }
                   10564:             my $deeper = $depth+1;
                   10565:             push(@{$parents},$category);
1.665     raeburn  10566:             if (ref($subcats) eq 'HASH') {
                   10567:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   10568:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   10569:                     my $higher;
                   10570:                     if ($j > 0) {
                   10571:                         $higher = &escape($parents->[$j]).':'.
                   10572:                                   &escape($parents->[$j-1]).':'.$j;
                   10573:                     } else {
                   10574:                         $higher = &escape($parents->[$j]).'::'.$j;
                   10575:                     }
                   10576:                     push(@{$subcats->{$higher}},$subcat);
                   10577:                 }
                   10578:             }
                   10579:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   10580:                                 $subcats);
1.655     raeburn  10581:             pop(@{$parents});
                   10582:         }
                   10583:     } else {
                   10584:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10585:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10586:         if ($allitems->{$item} eq '') {
                   10587:             push(@{$trails},$trailstr);
                   10588:             $allitems->{$item} = scalar(@{$trails})-1;
                   10589:         }
                   10590:     }
                   10591:     return;
                   10592: }
                   10593: 
1.663     raeburn  10594: =pod
                   10595: 
                   10596: =item *&assign_categories_table()
                   10597: 
                   10598: Create a datatable for display of hierarchical categories in a domain,
                   10599: with checkboxes to allow a course to be categorized. 
                   10600: 
                   10601: Inputs:
                   10602: 
                   10603: cathash - reference to hash of categories defined for the domain (from
                   10604:           configuration.db)
                   10605: 
                   10606: currcat - scalar with an & separated list of categories assigned to a course. 
                   10607: 
1.919     raeburn  10608: type    - scalar contains course type (Course or Community).
                   10609: 
1.663     raeburn  10610: Returns: $output (markup to be displayed) 
                   10611: 
                   10612: =cut
                   10613: 
                   10614: sub assign_categories_table {
1.919     raeburn  10615:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  10616:     my $output;
                   10617:     if (ref($cathash) eq 'HASH') {
                   10618:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   10619:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   10620:         $maxdepth = scalar(@cats);
                   10621:         if (@cats > 0) {
                   10622:             my $itemcount = 0;
                   10623:             if (ref($cats[0]) eq 'ARRAY') {
                   10624:                 my @currcategories;
                   10625:                 if ($currcat ne '') {
                   10626:                     @currcategories = split('&',$currcat);
                   10627:                 }
1.919     raeburn  10628:                 my $table;
1.663     raeburn  10629:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   10630:                     my $parent = $cats[0][$i];
1.919     raeburn  10631:                     next if ($parent eq 'instcode');
                   10632:                     if ($type eq 'Community') {
                   10633:                         next unless ($parent eq 'communities');
                   10634:                     } else {
                   10635:                         next if ($parent eq 'communities');
                   10636:                     }
1.663     raeburn  10637:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10638:                     my $item = &escape($parent).'::0';
                   10639:                     my $checked = '';
                   10640:                     if (@currcategories > 0) {
                   10641:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   10642:                             $checked = ' checked="checked"';
1.663     raeburn  10643:                         }
                   10644:                     }
1.919     raeburn  10645:                     my $parent_title = $parent;
                   10646:                     if ($parent eq 'communities') {
                   10647:                         $parent_title = &mt('Communities');
                   10648:                     }
                   10649:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   10650:                               '<input type="checkbox" name="usecategory" value="'.
                   10651:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   10652:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  10653:                     my $depth = 1;
                   10654:                     push(@path,$parent);
1.919     raeburn  10655:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  10656:                     pop(@path);
1.919     raeburn  10657:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  10658:                     $itemcount ++;
                   10659:                 }
1.919     raeburn  10660:                 if ($itemcount) {
                   10661:                     $output = &Apache::loncommon::start_data_table().
                   10662:                               $table.
                   10663:                               &Apache::loncommon::end_data_table();
                   10664:                 }
1.663     raeburn  10665:             }
                   10666:         }
                   10667:     }
                   10668:     return $output;
                   10669: }
                   10670: 
                   10671: =pod
                   10672: 
                   10673: =item *&assign_category_rows()
                   10674: 
                   10675: Create a datatable row for display of nested categories in a domain,
                   10676: with checkboxes to allow a course to be categorized,called recursively.
                   10677: 
                   10678: Inputs:
                   10679: 
                   10680: itemcount - track row number for alternating colors
                   10681: 
                   10682: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   10683:       categories and subcategories.
                   10684: 
                   10685: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   10686: 
                   10687: parent - parent of current category item
                   10688: 
                   10689: path - Array containing all categories back up through the hierarchy from the
                   10690:        current category to the top level.
                   10691: 
                   10692: currcategories - reference to array of current categories assigned to the course
                   10693: 
                   10694: Returns: $output (markup to be displayed).
                   10695: 
                   10696: =cut
                   10697: 
                   10698: sub assign_category_rows {
                   10699:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   10700:     my ($text,$name,$item,$chgstr);
                   10701:     if (ref($cats) eq 'ARRAY') {
                   10702:         my $maxdepth = scalar(@{$cats});
                   10703:         if (ref($cats->[$depth]) eq 'HASH') {
                   10704:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   10705:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   10706:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10707:                 $text .= '<td><table class="LC_datatable">';
                   10708:                 for (my $j=0; $j<$numchildren; $j++) {
                   10709:                     $name = $cats->[$depth]{$parent}[$j];
                   10710:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   10711:                     my $deeper = $depth+1;
                   10712:                     my $checked = '';
                   10713:                     if (ref($currcategories) eq 'ARRAY') {
                   10714:                         if (@{$currcategories} > 0) {
                   10715:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   10716:                                 $checked = ' checked="checked"';
1.663     raeburn  10717:                             }
                   10718:                         }
                   10719:                     }
1.664     raeburn  10720:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   10721:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  10722:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   10723:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   10724:                              '</td><td>';
1.663     raeburn  10725:                     if (ref($path) eq 'ARRAY') {
                   10726:                         push(@{$path},$name);
                   10727:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   10728:                         pop(@{$path});
                   10729:                     }
                   10730:                     $text .= '</td></tr>';
                   10731:                 }
                   10732:                 $text .= '</table></td>';
                   10733:             }
                   10734:         }
                   10735:     }
                   10736:     return $text;
                   10737: }
                   10738: 
1.655     raeburn  10739: ############################################################
                   10740: ############################################################
                   10741: 
                   10742: 
1.443     albertel 10743: sub commit_customrole {
1.664     raeburn  10744:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  10745:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 10746:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   10747:                          ($end?', ending '.localtime($end):'').': <b>'.
                   10748:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  10749:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 10750:                  '</b><br />';
                   10751:     return $output;
                   10752: }
                   10753: 
                   10754: sub commit_standardrole {
1.541     raeburn  10755:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   10756:     my ($output,$logmsg,$linefeed);
                   10757:     if ($context eq 'auto') {
                   10758:         $linefeed = "\n";
                   10759:     } else {
                   10760:         $linefeed = "<br />\n";
                   10761:     }  
1.443     albertel 10762:     if ($three eq 'st') {
1.541     raeburn  10763:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   10764:                                          $one,$two,$sec,$context);
                   10765:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  10766:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   10767:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 10768:         } else {
1.541     raeburn  10769:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 10770:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  10771:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   10772:             if ($context eq 'auto') {
                   10773:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   10774:             } else {
                   10775:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   10776:                &mt('Add to classlist').': <b>ok</b>';
                   10777:             }
                   10778:             $output .= $linefeed;
1.443     albertel 10779:         }
                   10780:     } else {
                   10781:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   10782:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  10783:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  10784:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  10785:         if ($context eq 'auto') {
                   10786:             $output .= $result.$linefeed;
                   10787:         } else {
                   10788:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   10789:         }
1.443     albertel 10790:     }
                   10791:     return $output;
                   10792: }
                   10793: 
                   10794: sub commit_studentrole {
1.541     raeburn  10795:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  10796:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  10797:     if ($context eq 'auto') {
                   10798:         $linefeed = "\n";
                   10799:     } else {
                   10800:         $linefeed = '<br />'."\n";
                   10801:     }
1.443     albertel 10802:     if (defined($one) && defined($two)) {
                   10803:         my $cid=$one.'_'.$two;
                   10804:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   10805:         my $secchange = 0;
                   10806:         my $expire_role_result;
                   10807:         my $modify_section_result;
1.628     raeburn  10808:         if ($oldsec ne '-1') { 
                   10809:             if ($oldsec ne $sec) {
1.443     albertel 10810:                 $secchange = 1;
1.628     raeburn  10811:                 my $now = time;
1.443     albertel 10812:                 my $uurl='/'.$cid;
                   10813:                 $uurl=~s/\_/\//g;
                   10814:                 if ($oldsec) {
                   10815:                     $uurl.='/'.$oldsec;
                   10816:                 }
1.626     raeburn  10817:                 $oldsecurl = $uurl;
1.628     raeburn  10818:                 $expire_role_result = 
1.652     raeburn  10819:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  10820:                 if ($env{'request.course.sec'} ne '') { 
                   10821:                     if ($expire_role_result eq 'refused') {
                   10822:                         my @roles = ('st');
                   10823:                         my @statuses = ('previous');
                   10824:                         my @roledoms = ($one);
                   10825:                         my $withsec = 1;
                   10826:                         my %roleshash = 
                   10827:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   10828:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   10829:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   10830:                             my ($oldstart,$oldend) = 
                   10831:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   10832:                             if ($oldend > 0 && $oldend <= $now) {
                   10833:                                 $expire_role_result = 'ok';
                   10834:                             }
                   10835:                         }
                   10836:                     }
                   10837:                 }
1.443     albertel 10838:                 $result = $expire_role_result;
                   10839:             }
                   10840:         }
                   10841:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  10842:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 10843:             if ($modify_section_result =~ /^ok/) {
                   10844:                 if ($secchange == 1) {
1.628     raeburn  10845:                     if ($sec eq '') {
                   10846:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   10847:                     } else {
                   10848:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   10849:                     }
1.443     albertel 10850:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  10851:                     if ($sec eq '') {
                   10852:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   10853:                     } else {
                   10854:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10855:                     }
1.443     albertel 10856:                 } else {
1.628     raeburn  10857:                     if ($sec eq '') {
                   10858:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   10859:                     } else {
                   10860:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10861:                     }
1.443     albertel 10862:                 }
                   10863:             } else {
1.628     raeburn  10864:                 if ($secchange) {       
                   10865:                     $$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;
                   10866:                 } else {
                   10867:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   10868:                 }
1.443     albertel 10869:             }
                   10870:             $result = $modify_section_result;
                   10871:         } elsif ($secchange == 1) {
1.628     raeburn  10872:             if ($oldsec eq '') {
                   10873:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   10874:             } else {
                   10875:                 $$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;
                   10876:             }
1.626     raeburn  10877:             if ($expire_role_result eq 'refused') {
                   10878:                 my $newsecurl = '/'.$cid;
                   10879:                 $newsecurl =~ s/\_/\//g;
                   10880:                 if ($sec ne '') {
                   10881:                     $newsecurl.='/'.$sec;
                   10882:                 }
                   10883:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   10884:                     if ($sec eq '') {
                   10885:                         $$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;
                   10886:                     } else {
                   10887:                         $$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;
                   10888:                     }
                   10889:                 }
                   10890:             }
1.443     albertel 10891:         }
                   10892:     } else {
1.626     raeburn  10893:         $$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 10894:         $result = "error: incomplete course id\n";
                   10895:     }
                   10896:     return $result;
                   10897: }
                   10898: 
                   10899: ############################################################
                   10900: ############################################################
                   10901: 
1.566     albertel 10902: sub check_clone {
1.578     raeburn  10903:     my ($args,$linefeed) = @_;
1.566     albertel 10904:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   10905:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   10906:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   10907:     my $clonemsg;
                   10908:     my $can_clone = 0;
1.944     raeburn  10909:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  10910:     if ($lctype ne 'community') {
                   10911:         $lctype = 'course';
                   10912:     }
1.566     albertel 10913:     if ($clonehome eq 'no_host') {
1.944     raeburn  10914:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10915:             $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'});
                   10916:         } else {
                   10917:             $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'});
                   10918:         }     
1.566     albertel 10919:     } else {
                   10920: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  10921:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10922:             if ($clonedesc{'type'} ne 'Community') {
                   10923:                  $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'});
                   10924:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10925:             }
                   10926:         }
1.882     raeburn  10927: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   10928:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 10929: 	    $can_clone = 1;
                   10930: 	} else {
                   10931: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   10932: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   10933: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  10934:             if (grep(/^\*$/,@cloners)) {
                   10935:                 $can_clone = 1;
                   10936:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   10937:                 $can_clone = 1;
                   10938:             } else {
1.908     raeburn  10939:                 my $ccrole = 'cc';
1.944     raeburn  10940:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10941:                     $ccrole = 'co';
                   10942:                 }
1.578     raeburn  10943: 	        my %roleshash =
                   10944: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   10945: 					 $args->{'ccdomain'},
1.908     raeburn  10946:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  10947: 					 [$args->{'clonedomain'}]);
1.908     raeburn  10948: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  10949:                     $can_clone = 1;
                   10950:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   10951:                     $can_clone = 1;
                   10952:                 } else {
1.944     raeburn  10953:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10954:                         $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'});
                   10955:                     } else {
                   10956:                         $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'});
                   10957:                     }
1.578     raeburn  10958: 	        }
1.566     albertel 10959: 	    }
1.578     raeburn  10960:         }
1.566     albertel 10961:     }
                   10962:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10963: }
                   10964: 
1.444     albertel 10965: sub construct_course {
1.885     raeburn  10966:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 10967:     my $outcome;
1.541     raeburn  10968:     my $linefeed =  '<br />'."\n";
                   10969:     if ($context eq 'auto') {
                   10970:         $linefeed = "\n";
                   10971:     }
1.566     albertel 10972: 
                   10973: #
                   10974: # Are we cloning?
                   10975: #
                   10976:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10977:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  10978: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 10979: 	if ($context ne 'auto') {
1.578     raeburn  10980:             if ($clonemsg ne '') {
                   10981: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   10982:             }
1.566     albertel 10983: 	}
                   10984: 	$outcome .= $clonemsg.$linefeed;
                   10985: 
                   10986:         if (!$can_clone) {
                   10987: 	    return (0,$outcome);
                   10988: 	}
                   10989:     }
                   10990: 
1.444     albertel 10991: #
                   10992: # Open course
                   10993: #
                   10994:     my $crstype = lc($args->{'crstype'});
                   10995:     my %cenv=();
                   10996:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   10997:                                              $args->{'cdescr'},
                   10998:                                              $args->{'curl'},
                   10999:                                              $args->{'course_home'},
                   11000:                                              $args->{'nonstandard'},
                   11001:                                              $args->{'crscode'},
                   11002:                                              $args->{'ccuname'}.':'.
                   11003:                                              $args->{'ccdomain'},
1.882     raeburn  11004:                                              $args->{'crstype'},
1.885     raeburn  11005:                                              $cnum,$context,$category);
1.444     albertel 11006: 
                   11007:     # Note: The testing routines depend on this being output; see 
                   11008:     # Utils::Course. This needs to at least be output as a comment
                   11009:     # if anyone ever decides to not show this, and Utils::Course::new
                   11010:     # will need to be suitably modified.
1.541     raeburn  11011:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  11012:     if ($$courseid =~ /^error:/) {
                   11013:         return (0,$outcome);
                   11014:     }
                   11015: 
1.444     albertel 11016: #
                   11017: # Check if created correctly
                   11018: #
1.479     albertel 11019:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 11020:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  11021:     if ($crsuhome eq 'no_host') {
                   11022:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   11023:         return (0,$outcome);
                   11024:     }
1.541     raeburn  11025:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 11026: 
1.444     albertel 11027: #
1.566     albertel 11028: # Do the cloning
                   11029: #   
                   11030:     if ($can_clone && $cloneid) {
                   11031: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   11032: 	if ($context ne 'auto') {
                   11033: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   11034: 	}
                   11035: 	$outcome .= $clonemsg.$linefeed;
                   11036: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 11037: # Copy all files
1.637     www      11038: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 11039: # Restore URL
1.566     albertel 11040: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 11041: # Restore title
1.566     albertel 11042: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  11043: # Restore creation date, creator and creation context.
                   11044:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   11045:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   11046:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 11047: # Mark as cloned
1.566     albertel 11048: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      11049: # Need to clone grading mode
                   11050:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   11051:         $cenv{'grading'}=$newenv{'grading'};
                   11052: # Do not clone these environment entries
                   11053:         &Apache::lonnet::del('environment',
                   11054:                   ['default_enrollment_start_date',
                   11055:                    'default_enrollment_end_date',
                   11056:                    'question.email',
                   11057:                    'policy.email',
                   11058:                    'comment.email',
                   11059:                    'pch.users.denied',
1.725     raeburn  11060:                    'plc.users.denied',
                   11061:                    'hidefromcat',
                   11062:                    'categories'],
1.638     www      11063:                    $$crsudom,$$crsunum);
1.444     albertel 11064:     }
1.566     albertel 11065: 
1.444     albertel 11066: #
                   11067: # Set environment (will override cloned, if existing)
                   11068: #
                   11069:     my @sections = ();
                   11070:     my @xlists = ();
                   11071:     if ($args->{'crstype'}) {
                   11072:         $cenv{'type'}=$args->{'crstype'};
                   11073:     }
                   11074:     if ($args->{'crsid'}) {
                   11075:         $cenv{'courseid'}=$args->{'crsid'};
                   11076:     }
                   11077:     if ($args->{'crscode'}) {
                   11078:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   11079:     }
                   11080:     if ($args->{'crsquota'} ne '') {
                   11081:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   11082:     } else {
                   11083:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   11084:     }
                   11085:     if ($args->{'ccuname'}) {
                   11086:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   11087:                                         ':'.$args->{'ccdomain'};
                   11088:     } else {
                   11089:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   11090:     }
                   11091:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   11092:     if ($args->{'crssections'}) {
                   11093:         $cenv{'internal.sectionnums'} = '';
                   11094:         if ($args->{'crssections'} =~ m/,/) {
                   11095:             @sections = split/,/,$args->{'crssections'};
                   11096:         } else {
                   11097:             $sections[0] = $args->{'crssections'};
                   11098:         }
                   11099:         if (@sections > 0) {
                   11100:             foreach my $item (@sections) {
                   11101:                 my ($sec,$gp) = split/:/,$item;
                   11102:                 my $class = $args->{'crscode'}.$sec;
                   11103:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   11104:                 $cenv{'internal.sectionnums'} .= $item.',';
                   11105:                 unless ($addcheck eq 'ok') {
                   11106:                     push @badclasses, $class;
                   11107:                 }
                   11108:             }
                   11109:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   11110:         }
                   11111:     }
                   11112: # do not hide course coordinator from staff listing, 
                   11113: # even if privileged
                   11114:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11115: # add crosslistings
                   11116:     if ($args->{'crsxlist'}) {
                   11117:         $cenv{'internal.crosslistings'}='';
                   11118:         if ($args->{'crsxlist'} =~ m/,/) {
                   11119:             @xlists = split/,/,$args->{'crsxlist'};
                   11120:         } else {
                   11121:             $xlists[0] = $args->{'crsxlist'};
                   11122:         }
                   11123:         if (@xlists > 0) {
                   11124:             foreach my $item (@xlists) {
                   11125:                 my ($xl,$gp) = split/:/,$item;
                   11126:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   11127:                 $cenv{'internal.crosslistings'} .= $item.',';
                   11128:                 unless ($addcheck eq 'ok') {
                   11129:                     push @badclasses, $xl;
                   11130:                 }
                   11131:             }
                   11132:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   11133:         }
                   11134:     }
                   11135:     if ($args->{'autoadds'}) {
                   11136:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   11137:     }
                   11138:     if ($args->{'autodrops'}) {
                   11139:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   11140:     }
                   11141: # check for notification of enrollment changes
                   11142:     my @notified = ();
                   11143:     if ($args->{'notify_owner'}) {
                   11144:         if ($args->{'ccuname'} ne '') {
                   11145:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   11146:         }
                   11147:     }
                   11148:     if ($args->{'notify_dc'}) {
                   11149:         if ($uname ne '') { 
1.630     raeburn  11150:             push(@notified,$uname.':'.$udom);
1.444     albertel 11151:         }
                   11152:     }
                   11153:     if (@notified > 0) {
                   11154:         my $notifylist;
                   11155:         if (@notified > 1) {
                   11156:             $notifylist = join(',',@notified);
                   11157:         } else {
                   11158:             $notifylist = $notified[0];
                   11159:         }
                   11160:         $cenv{'internal.notifylist'} = $notifylist;
                   11161:     }
                   11162:     if (@badclasses > 0) {
                   11163:         my %lt=&Apache::lonlocal::texthash(
                   11164:                 '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',
                   11165:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   11166:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   11167:         );
1.541     raeburn  11168:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   11169:                            ' ('.$lt{'adby'}.')';
                   11170:         if ($context eq 'auto') {
                   11171:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 11172:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  11173:             foreach my $item (@badclasses) {
                   11174:                 if ($context eq 'auto') {
                   11175:                     $outcome .= " - $item\n";
                   11176:                 } else {
                   11177:                     $outcome .= "<li>$item</li>\n";
                   11178:                 }
                   11179:             }
                   11180:             if ($context eq 'auto') {
                   11181:                 $outcome .= $linefeed;
                   11182:             } else {
1.566     albertel 11183:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  11184:             }
                   11185:         } 
1.444     albertel 11186:     }
                   11187:     if ($args->{'no_end_date'}) {
                   11188:         $args->{'endaccess'} = 0;
                   11189:     }
                   11190:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   11191:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   11192:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   11193:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   11194:     if ($args->{'showphotos'}) {
                   11195:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   11196:     }
                   11197:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   11198:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   11199:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   11200:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  11201:             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'); 
                   11202:             if ($context eq 'auto') {
                   11203:                 $outcome .= $krb_msg;
                   11204:             } else {
1.566     albertel 11205:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  11206:             }
                   11207:             $outcome .= $linefeed;
1.444     albertel 11208:         }
                   11209:     }
                   11210:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   11211:        if ($args->{'setpolicy'}) {
                   11212:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11213:        }
                   11214:        if ($args->{'setcontent'}) {
                   11215:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11216:        }
                   11217:     }
                   11218:     if ($args->{'reshome'}) {
                   11219: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   11220: 	$cenv{'reshome'}=~s/\/+$/\//;
                   11221:     }
                   11222: #
                   11223: # course has keyed access
                   11224: #
                   11225:     if ($args->{'setkeys'}) {
                   11226:        $cenv{'keyaccess'}='yes';
                   11227:     }
                   11228: # if specified, key authority is not course, but user
                   11229: # only active if keyaccess is yes
                   11230:     if ($args->{'keyauth'}) {
1.487     albertel 11231: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   11232: 	$user = &LONCAPA::clean_username($user);
                   11233: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     11234: 	if ($user ne '' && $domain ne '') {
1.487     albertel 11235: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 11236: 	}
                   11237:     }
                   11238: 
                   11239:     if ($args->{'disresdis'}) {
                   11240:         $cenv{'pch.roles.denied'}='st';
                   11241:     }
                   11242:     if ($args->{'disablechat'}) {
                   11243:         $cenv{'plc.roles.denied'}='st';
                   11244:     }
                   11245: 
                   11246:     # Record we've not yet viewed the Course Initialization Helper for this 
                   11247:     # course
                   11248:     $cenv{'course.helper.not.run'} = 1;
                   11249:     #
                   11250:     # Use new Randomseed
                   11251:     #
                   11252:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   11253:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   11254:     #
                   11255:     # The encryption code and receipt prefix for this course
                   11256:     #
                   11257:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   11258:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   11259:     #
                   11260:     # By default, use standard grading
                   11261:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   11262: 
1.541     raeburn  11263:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   11264:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 11265: #
                   11266: # Open all assignments
                   11267: #
                   11268:     if ($args->{'openall'}) {
                   11269:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   11270:        my %storecontent = ($storeunder         => time,
                   11271:                            $storeunder.'.type' => 'date_start');
                   11272:        
                   11273:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  11274:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 11275:    }
                   11276: #
                   11277: # Set first page
                   11278: #
                   11279:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   11280: 	    || ($cloneid)) {
1.445     albertel 11281: 	use LONCAPA::map;
1.444     albertel 11282: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 11283: 
                   11284: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   11285:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   11286: 
1.444     albertel 11287:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   11288:         my $title; my $url;
                   11289:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   11290: 	    $title=&mt('Syllabus');
1.444     albertel 11291:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   11292:         } else {
1.963     raeburn  11293:             $title=&mt('Table of Contents');
1.444     albertel 11294:             $url='/adm/navmaps';
                   11295:         }
1.445     albertel 11296: 
                   11297:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   11298: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   11299: 
                   11300: 	if ($errtext) { $fatal=2; }
1.541     raeburn  11301:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 11302:     }
1.566     albertel 11303: 
                   11304:     return (1,$outcome);
1.444     albertel 11305: }
                   11306: 
                   11307: ############################################################
                   11308: ############################################################
                   11309: 
1.953     droeschl 11310: #SD
                   11311: # only Community and Course, or anything else?
1.378     raeburn  11312: sub course_type {
                   11313:     my ($cid) = @_;
                   11314:     if (!defined($cid)) {
                   11315:         $cid = $env{'request.course.id'};
                   11316:     }
1.404     albertel 11317:     if (defined($env{'course.'.$cid.'.type'})) {
                   11318:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  11319:     } else {
                   11320:         return 'Course';
1.377     raeburn  11321:     }
                   11322: }
1.156     albertel 11323: 
1.406     raeburn  11324: sub group_term {
                   11325:     my $crstype = &course_type();
                   11326:     my %names = (
                   11327:                   'Course' => 'group',
1.865     raeburn  11328:                   'Community' => 'group',
1.406     raeburn  11329:                 );
                   11330:     return $names{$crstype};
                   11331: }
                   11332: 
1.902     raeburn  11333: sub course_types {
                   11334:     my @types = ('official','unofficial','community');
                   11335:     my %typename = (
                   11336:                          official   => 'Official course',
                   11337:                          unofficial => 'Unofficial course',
                   11338:                          community  => 'Community',
                   11339:                    );
                   11340:     return (\@types,\%typename);
                   11341: }
                   11342: 
1.156     albertel 11343: sub icon {
                   11344:     my ($file)=@_;
1.505     albertel 11345:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 11346:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 11347:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 11348:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   11349: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   11350: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11351: 	            $curfext.".gif") {
                   11352: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11353: 		$curfext.".gif";
                   11354: 	}
                   11355:     }
1.249     albertel 11356:     return &lonhttpdurl($iconname);
1.154     albertel 11357: } 
1.84      albertel 11358: 
1.575     albertel 11359: sub lonhttpdurl {
1.692     www      11360: #
                   11361: # Had been used for "small fry" static images on separate port 8080.
                   11362: # Modify here if lightweight http functionality desired again.
                   11363: # Currently eliminated due to increasing firewall issues.
                   11364: #
1.575     albertel 11365:     my ($url)=@_;
1.692     www      11366:     return $url;
1.215     albertel 11367: }
                   11368: 
1.213     albertel 11369: sub connection_aborted {
                   11370:     my ($r)=@_;
                   11371:     $r->print(" ");$r->rflush();
                   11372:     my $c = $r->connection;
                   11373:     return $c->aborted();
                   11374: }
                   11375: 
1.221     foxr     11376: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     11377: #    strings as 'strings'.
                   11378: sub escape_single {
1.221     foxr     11379:     my ($input) = @_;
1.223     albertel 11380:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     11381:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   11382:     return $input;
                   11383: }
1.223     albertel 11384: 
1.222     foxr     11385: #  Same as escape_single, but escape's "'s  This 
                   11386: #  can be used for  "strings"
                   11387: sub escape_double {
                   11388:     my ($input) = @_;
                   11389:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   11390:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   11391:     return $input;
                   11392: }
1.223     albertel 11393:  
1.222     foxr     11394: #   Escapes the last element of a full URL.
                   11395: sub escape_url {
                   11396:     my ($url)   = @_;
1.238     raeburn  11397:     my @urlslices = split(/\//, $url,-1);
1.369     www      11398:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 11399:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     11400: }
1.462     albertel 11401: 
1.820     raeburn  11402: sub compare_arrays {
                   11403:     my ($arrayref1,$arrayref2) = @_;
                   11404:     my (@difference,%count);
                   11405:     @difference = ();
                   11406:     %count = ();
                   11407:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   11408:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   11409:         foreach my $element (keys(%count)) {
                   11410:             if ($count{$element} == 1) {
                   11411:                 push(@difference,$element);
                   11412:             }
                   11413:         }
                   11414:     }
                   11415:     return @difference;
                   11416: }
                   11417: 
1.817     bisitz   11418: # -------------------------------------------------------- Initialize user login
1.462     albertel 11419: sub init_user_environment {
1.463     albertel 11420:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 11421:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   11422: 
                   11423:     my $public=($username eq 'public' && $domain eq 'public');
                   11424: 
                   11425: # See if old ID present, if so, remove
                   11426: 
                   11427:     my ($filename,$cookie,$userroles);
                   11428:     my $now=time;
                   11429: 
                   11430:     if ($public) {
                   11431: 	my $max_public=100;
                   11432: 	my $oldest;
                   11433: 	my $oldest_time=0;
                   11434: 	for(my $next=1;$next<=$max_public;$next++) {
                   11435: 	    if (-e $lonids."/publicuser_$next.id") {
                   11436: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   11437: 		if ($mtime<$oldest_time || !$oldest_time) {
                   11438: 		    $oldest_time=$mtime;
                   11439: 		    $oldest=$next;
                   11440: 		}
                   11441: 	    } else {
                   11442: 		$cookie="publicuser_$next";
                   11443: 		last;
                   11444: 	    }
                   11445: 	}
                   11446: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   11447:     } else {
1.463     albertel 11448: 	# if this isn't a robot, kill any existing non-robot sessions
                   11449: 	if (!$args->{'robot'}) {
                   11450: 	    opendir(DIR,$lonids);
                   11451: 	    while ($filename=readdir(DIR)) {
                   11452: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   11453: 		    unlink($lonids.'/'.$filename);
                   11454: 		}
1.462     albertel 11455: 	    }
1.463     albertel 11456: 	    closedir(DIR);
1.462     albertel 11457: 	}
                   11458: # Give them a new cookie
1.463     albertel 11459: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      11460: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 11461: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 11462:     
                   11463: # Initialize roles
                   11464: 
                   11465: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   11466:     }
                   11467: # ------------------------------------ Check browser type and MathML capability
                   11468: 
                   11469:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   11470:         $clientunicode,$clientos) = &decode_user_agent($r);
                   11471: 
                   11472: # ------------------------------------------------------------- Get environment
                   11473: 
                   11474:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   11475:     my ($tmp) = keys(%userenv);
                   11476:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   11477:     } else {
                   11478: 	undef(%userenv);
                   11479:     }
                   11480:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   11481: 	$form->{'interface'}=$userenv{'interface'};
                   11482:     }
                   11483:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   11484: 
                   11485: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   11486:     foreach my $option ('interface','localpath','localres') {
                   11487:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 11488:     }
                   11489: # --------------------------------------------------------- Write first profile
                   11490: 
                   11491:     {
                   11492: 	my %initial_env = 
                   11493: 	    ("user.name"          => $username,
                   11494: 	     "user.domain"        => $domain,
                   11495: 	     "user.home"          => $authhost,
                   11496: 	     "browser.type"       => $clientbrowser,
                   11497: 	     "browser.version"    => $clientversion,
                   11498: 	     "browser.mathml"     => $clientmathml,
                   11499: 	     "browser.unicode"    => $clientunicode,
                   11500: 	     "browser.os"         => $clientos,
                   11501: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   11502: 	     "request.course.fn"  => '',
                   11503: 	     "request.course.uri" => '',
                   11504: 	     "request.course.sec" => '',
                   11505: 	     "request.role"       => 'cm',
                   11506: 	     "request.role.adv"   => $env{'user.adv'},
                   11507: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   11508: 
                   11509:         if ($form->{'localpath'}) {
                   11510: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   11511: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   11512:         }
                   11513: 	
                   11514: 	if ($form->{'interface'}) {
                   11515: 	    $form->{'interface'}=~s/\W//gs;
                   11516: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   11517: 	    $env{'browser.interface'}=$form->{'interface'};
                   11518: 	}
                   11519: 
1.981     raeburn  11520:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  11521:         my %domdef;
                   11522:         unless ($domain eq 'public') {
                   11523:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   11524:         }
1.980     raeburn  11525: 
1.724     raeburn  11526:         foreach my $tool ('aboutme','blog','portfolio') {
                   11527:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  11528:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   11529:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  11530:         }
                   11531: 
1.864     raeburn  11532:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  11533:             $userenv{'canrequest.'.$crstype} =
                   11534:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  11535:                                                   'reload','requestcourses',
                   11536:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  11537:         }
                   11538: 
1.462     albertel 11539: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   11540: 	
                   11541: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   11542: 		 &GDBM_WRCREAT(),0640)) {
                   11543: 	    &_add_to_env(\%disk_env,\%initial_env);
                   11544: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   11545: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 11546: 	    if (ref($args->{'extra_env'})) {
                   11547: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   11548: 	    }
1.462     albertel 11549: 	    untie(%disk_env);
                   11550: 	} else {
1.705     tempelho 11551: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   11552: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 11553: 	    return 'error: '.$!;
                   11554: 	}
                   11555:     }
                   11556:     $env{'request.role'}='cm';
                   11557:     $env{'request.role.adv'}=$env{'user.adv'};
                   11558:     $env{'browser.type'}=$clientbrowser;
                   11559: 
                   11560:     return $cookie;
                   11561: 
                   11562: }
                   11563: 
                   11564: sub _add_to_env {
                   11565:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  11566:     if (ref($env_data) eq 'HASH') {
                   11567:         while (my ($key,$value) = each(%$env_data)) {
                   11568: 	    $idf->{$prefix.$key} = $value;
                   11569: 	    $env{$prefix.$key}   = $value;
                   11570:         }
1.462     albertel 11571:     }
                   11572: }
                   11573: 
1.685     tempelho 11574: # --- Get the symbolic name of a problem and the url
                   11575: sub get_symb {
                   11576:     my ($request,$silent) = @_;
1.726     raeburn  11577:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 11578:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   11579:     if ($symb eq '') {
                   11580:         if (!$silent) {
                   11581:             $request->print("Unable to handle ambiguous references:$url:.");
                   11582:             return ();
                   11583:         }
                   11584:     }
                   11585:     &Apache::lonenc::check_decrypt(\$symb);
                   11586:     return ($symb);
                   11587: }
                   11588: 
                   11589: # --------------------------------------------------------------Get annotation
                   11590: 
                   11591: sub get_annotation {
                   11592:     my ($symb,$enc) = @_;
                   11593: 
                   11594:     my $key = $symb;
                   11595:     if (!$enc) {
                   11596:         $key =
                   11597:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   11598:     }
                   11599:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   11600:     return $annotation{$key};
                   11601: }
                   11602: 
                   11603: sub clean_symb {
1.731     raeburn  11604:     my ($symb,$delete_enc) = @_;
1.685     tempelho 11605: 
                   11606:     &Apache::lonenc::check_decrypt(\$symb);
                   11607:     my $enc = $env{'request.enc'};
1.731     raeburn  11608:     if ($delete_enc) {
1.730     raeburn  11609:         delete($env{'request.enc'});
                   11610:     }
1.685     tempelho 11611: 
                   11612:     return ($symb,$enc);
                   11613: }
1.462     albertel 11614: 
1.990     raeburn  11615: sub build_release_hashes {
                   11616:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   11617:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   11618:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   11619:                   (ref($randomizetry) eq 'HASH'));
                   11620:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   11621:         my ($item,$name,$value) = split(/:/,$key);
                   11622:         if ($item eq 'parameter') {
                   11623:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   11624:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   11625:                     push(@{$checkparms->{$name}},$value);
                   11626:                 }
                   11627:             } else {
                   11628:                 push(@{$checkparms->{$name}},$value);
                   11629:             }
                   11630:         } elsif ($item eq 'resourcetag') {
                   11631:             if ($name eq 'responsetype') {
                   11632:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   11633:             }
                   11634:         } elsif ($item eq 'course') {
                   11635:             if ($name eq 'crstype') {
                   11636:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   11637:             }
                   11638:         }
                   11639:     }
                   11640:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   11641:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   11642:     return;
                   11643: }
                   11644: 
1.41      ng       11645: =pod
                   11646: 
                   11647: =back
                   11648: 
1.112     bowersj2 11649: =cut
1.41      ng       11650: 
1.112     bowersj2 11651: 1;
                   11652: __END__;
1.41      ng       11653: 

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