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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1040  ! raeburn     4: # $Id: loncommon.pm,v 1.1039 2011/12/19 18:18:28 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);
1.1033    www      1189:     $width = 500 if (not defined $width);
1.44      bowersj2 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.1033    www      1200: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1201:     } elsif ($stayOnPage eq 'popup') {
                   1202:         $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 1203:     } else {
1.48      bowersj2 1204: 	$link = "/adm/help/${filename}.hlp";
                   1205:     }
                   1206: 
                   1207:     # Add the text
1.755     neumanie 1208:     if ($text ne "") {	
1.763     bisitz   1209: 	$template.='<span class="LC_help_open_topic">'
                   1210:                   .'<a target="_top" href="'.$link.'">'
                   1211:                   .$text.'</a>';
1.48      bowersj2 1212:     }
                   1213: 
1.763     bisitz   1214:     # (Always) Add the graphic
1.179     matthew  1215:     my $title = &mt('Online Help');
1.667     raeburn  1216:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1217:     if ($imgid ne '') {
                   1218:         $imgid = ' id="'.$imgid.'"';
                   1219:     }
1.763     bisitz   1220:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1221:               .'<img src="'.$helpicon.'" border="0"'
                   1222:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1223:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1224:               .' /></a>';
                   1225:     if ($text ne "") {	
                   1226:         $template.='</span>';
                   1227:     }
1.44      bowersj2 1228:     return $template;
                   1229: 
1.106     bowersj2 1230: }
                   1231: 
                   1232: # This is a quicky function for Latex cheatsheet editing, since it 
                   1233: # appears in at least four places
                   1234: sub helpLatexCheatsheet {
1.1037    www      1235:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1236:     my $out;
1.106     bowersj2 1237:     my $addOther = '';
1.732     raeburn  1238:     if ($topic) {
1.1037    www      1239: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1240:     }
                   1241:     $out = '<span>' # Start cheatsheet
                   1242: 	  .$addOther
                   1243:           .'<span>'
1.1037    www      1244: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1245: 	  .'</span> <span>'
1.1037    www      1246: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1247: 	  .'</span>';
1.732     raeburn  1248:     unless ($not_author) {
1.763     bisitz   1249:         $out .= ' <span>'
1.1037    www      1250: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1251: 	       .'</span>';
1.732     raeburn  1252:     }
1.763     bisitz   1253:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1254:     return $out;
1.172     www      1255: }
                   1256: 
1.430     albertel 1257: sub general_help {
                   1258:     my $helptopic='Student_Intro';
                   1259:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1260: 	$helptopic='Authoring_Intro';
1.907     raeburn  1261:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1262: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1263:     } elsif ($env{'request.role'}=~/^dc/) {
                   1264:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1265:     }
                   1266:     return $helptopic;
                   1267: }
                   1268: 
                   1269: sub update_help_link {
                   1270:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1271:     my $origurl = $ENV{'REQUEST_URI'};
                   1272:     $origurl=~s|^/~|/priv/|;
                   1273:     my $timestamp = time;
                   1274:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1275:         $$datum = &escape($$datum);
                   1276:     }
                   1277: 
                   1278:     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";
                   1279:     my $output .= <<"ENDOUTPUT";
                   1280: <script type="text/javascript">
1.824     bisitz   1281: // <![CDATA[
1.430     albertel 1282: banner_link = '$banner_link';
1.824     bisitz   1283: // ]]>
1.430     albertel 1284: </script>
                   1285: ENDOUTPUT
                   1286:     return $output;
                   1287: }
                   1288: 
                   1289: # now just updates the help link and generates a blue icon
1.193     raeburn  1290: sub help_open_menu {
1.430     albertel 1291:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1292: 	= @_;    
1.949     droeschl 1293:     $stayOnPage = 1;
1.430     albertel 1294:     my $output;
                   1295:     if ($component_help) {
                   1296: 	if (!$text) {
                   1297: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1298: 				       $width,$height);
                   1299: 	} else {
                   1300: 	    my $help_text;
                   1301: 	    $help_text=&unescape($topic);
                   1302: 	    $output='<table><tr><td>'.
                   1303: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1304: 				 $width,$height).'</td></tr></table>';
                   1305: 	}
                   1306:     }
                   1307:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1308:     return $output.$banner_link;
                   1309: }
                   1310: 
                   1311: sub top_nav_help {
                   1312:     my ($text) = @_;
1.436     albertel 1313:     $text = &mt($text);
1.949     droeschl 1314:     my $stay_on_page = 1;
                   1315: 
1.572     banghart 1316:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1317: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1318:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1319: 
1.201     raeburn  1320:     my $title = &mt('Get help');
1.436     albertel 1321: 
                   1322:     return <<"END";
                   1323: $banner_link
                   1324:  <a href="$link" title="$title">$text</a>
                   1325: END
                   1326: }
                   1327: 
                   1328: sub help_menu_js {
                   1329:     my ($text) = @_;
1.949     droeschl 1330:     my $stayOnPage = 1;
1.436     albertel 1331:     my $width = 620;
                   1332:     my $height = 600;
1.430     albertel 1333:     my $helptopic=&general_help();
                   1334:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1335:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1336:     my $start_page =
                   1337:         &Apache::loncommon::start_page('Help Menu', undef,
                   1338: 				       {'frameset'    => 1,
                   1339: 					'js_ready'    => 1,
                   1340: 					'add_entries' => {
                   1341: 					    'border' => '0',
1.579     raeburn  1342: 					    'rows'   => "110,*",},});
1.331     albertel 1343:     my $end_page =
                   1344:         &Apache::loncommon::end_page({'frameset' => 1,
                   1345: 				      'js_ready' => 1,});
                   1346: 
1.436     albertel 1347:     my $template .= <<"ENDTEMPLATE";
                   1348: <script type="text/javascript">
1.877     bisitz   1349: // <![CDATA[
1.253     albertel 1350: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1351: var banner_link = '';
1.243     raeburn  1352: function helpMenu(target) {
                   1353:     var caller = this;
                   1354:     if (target == 'open') {
                   1355:         var newWindow = null;
                   1356:         try {
1.262     albertel 1357:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1358:         }
                   1359:         catch(error) {
                   1360:             writeHelp(caller);
                   1361:             return;
                   1362:         }
                   1363:         if (newWindow) {
                   1364:             caller = newWindow;
                   1365:         }
1.193     raeburn  1366:     }
1.243     raeburn  1367:     writeHelp(caller);
                   1368:     return;
                   1369: }
                   1370: function writeHelp(caller) {
1.430     albertel 1371:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn  1372:     caller.document.close()
                   1373:     caller.focus()
1.193     raeburn  1374: }
1.877     bisitz   1375: // END LON-CAPA Internal -->
1.253     albertel 1376: // ]]>
1.436     albertel 1377: </script>
1.193     raeburn  1378: ENDTEMPLATE
                   1379:     return $template;
                   1380: }
                   1381: 
1.172     www      1382: sub help_open_bug {
                   1383:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1384:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1385:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1386:     $text = "" if (not defined $text);
                   1387: 	$stayOnPage=1;
1.184     albertel 1388:     $width = 600 if (not defined $width);
                   1389:     $height = 600 if (not defined $height);
1.172     www      1390: 
                   1391:     $topic=~s/\W+/\+/g;
                   1392:     my $link='';
                   1393:     my $template='';
1.379     albertel 1394:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1395: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1396:     if (!$stayOnPage)
                   1397:     {
                   1398: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1399:     }
                   1400:     else
                   1401:     {
                   1402: 	$link = $url;
                   1403:     }
                   1404:     # Add the text
                   1405:     if ($text ne "")
                   1406:     {
                   1407: 	$template .= 
                   1408:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1409:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1410:     }
                   1411: 
                   1412:     # Add the graphic
1.179     matthew  1413:     my $title = &mt('Report a Bug');
1.215     albertel 1414:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1415:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1416:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1417: ENDTEMPLATE
                   1418:     if ($text ne '') { $template.='</td></tr></table>' };
                   1419:     return $template;
                   1420: 
                   1421: }
                   1422: 
                   1423: sub help_open_faq {
                   1424:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1425:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1426:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1427:     $text = "" if (not defined $text);
                   1428: 	$stayOnPage=1;
                   1429:     $width = 350 if (not defined $width);
                   1430:     $height = 400 if (not defined $height);
                   1431: 
                   1432:     $topic=~s/\W+/\+/g;
                   1433:     my $link='';
                   1434:     my $template='';
                   1435:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1436:     if (!$stayOnPage)
                   1437:     {
                   1438: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1439:     }
                   1440:     else
                   1441:     {
                   1442: 	$link = $url;
                   1443:     }
                   1444: 
                   1445:     # Add the text
                   1446:     if ($text ne "")
                   1447:     {
                   1448: 	$template .= 
1.173     www      1449:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1450:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1451:     }
                   1452: 
                   1453:     # Add the graphic
1.179     matthew  1454:     my $title = &mt('View the FAQ');
1.215     albertel 1455:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1456:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1457:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1458: ENDTEMPLATE
                   1459:     if ($text ne '') { $template.='</td></tr></table>' };
                   1460:     return $template;
                   1461: 
1.44      bowersj2 1462: }
1.37      matthew  1463: 
1.180     matthew  1464: ###############################################################
                   1465: ###############################################################
                   1466: 
1.45      matthew  1467: =pod
                   1468: 
1.648     raeburn  1469: =item * &change_content_javascript():
1.256     matthew  1470: 
                   1471: This and the next function allow you to create small sections of an
                   1472: otherwise static HTML page that you can update on the fly with
                   1473: Javascript, even in Netscape 4.
                   1474: 
                   1475: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1476: must be written to the HTML page once. It will prove the Javascript
                   1477: function "change(name, content)". Calling the change function with the
                   1478: name of the section 
                   1479: you want to update, matching the name passed to C<changable_area>, and
                   1480: the new content you want to put in there, will put the content into
                   1481: that area.
                   1482: 
                   1483: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1484: to contain room for the original contents. You need to "make space"
                   1485: for whatever changes you wish to make, and be B<sure> to check your
                   1486: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1487: it's adequate for updating a one-line status display, but little more.
                   1488: This script will set the space to 100% width, so you only need to
                   1489: worry about height in Netscape 4.
                   1490: 
                   1491: Modern browsers are much less limiting, and if you can commit to the
                   1492: user not using Netscape 4, this feature may be used freely with
                   1493: pretty much any HTML.
                   1494: 
                   1495: =cut
                   1496: 
                   1497: sub change_content_javascript {
                   1498:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1499:     if ($env{'browser.type'} eq 'netscape' &&
                   1500: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1501: 	return (<<NETSCAPE4);
                   1502: 	function change(name, content) {
                   1503: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1504: 	    doc.open();
                   1505: 	    doc.write(content);
                   1506: 	    doc.close();
                   1507: 	}
                   1508: NETSCAPE4
                   1509:     } else {
                   1510: 	# Otherwise, we need to use semi-standards-compliant code
                   1511: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1512: 	# is really scary, and every useful browser supports it
                   1513: 	return (<<DOMBASED);
                   1514: 	function change(name, content) {
                   1515: 	    element = document.getElementById(name);
                   1516: 	    element.innerHTML = content;
                   1517: 	}
                   1518: DOMBASED
                   1519:     }
                   1520: }
                   1521: 
                   1522: =pod
                   1523: 
1.648     raeburn  1524: =item * &changable_area($name,$origContent):
1.256     matthew  1525: 
                   1526: This provides a "changable area" that can be modified on the fly via
                   1527: the Javascript code provided in C<change_content_javascript>. $name is
                   1528: the name you will use to reference the area later; do not repeat the
                   1529: same name on a given HTML page more then once. $origContent is what
                   1530: the area will originally contain, which can be left blank.
                   1531: 
                   1532: =cut
                   1533: 
                   1534: sub changable_area {
                   1535:     my ($name, $origContent) = @_;
                   1536: 
1.258     albertel 1537:     if ($env{'browser.type'} eq 'netscape' &&
                   1538: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1539: 	# If this is netscape 4, we need to use the Layer tag
                   1540: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1541:     } else {
                   1542: 	return "<span id='$name'>$origContent</span>";
                   1543:     }
                   1544: }
                   1545: 
                   1546: =pod
                   1547: 
1.648     raeburn  1548: =item * &viewport_geometry_js 
1.590     raeburn  1549: 
                   1550: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1551: 
                   1552: =cut
                   1553: 
                   1554: 
                   1555: sub viewport_geometry_js { 
                   1556:     return <<"GEOMETRY";
                   1557: var Geometry = {};
                   1558: function init_geometry() {
                   1559:     if (Geometry.init) { return };
                   1560:     Geometry.init=1;
                   1561:     if (window.innerHeight) {
                   1562:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1563:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1564:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1565:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1566:     }
                   1567:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1568:         Geometry.getViewportHeight =
                   1569:             function() { return document.documentElement.clientHeight; };
                   1570:         Geometry.getViewportWidth =
                   1571:             function() { return document.documentElement.clientWidth; };
                   1572: 
                   1573:         Geometry.getHorizontalScroll =
                   1574:             function() { return document.documentElement.scrollLeft; };
                   1575:         Geometry.getVerticalScroll =
                   1576:             function() { return document.documentElement.scrollTop; };
                   1577:     }
                   1578:     else if (document.body.clientHeight) {
                   1579:         Geometry.getViewportHeight =
                   1580:             function() { return document.body.clientHeight; };
                   1581:         Geometry.getViewportWidth =
                   1582:             function() { return document.body.clientWidth; };
                   1583:         Geometry.getHorizontalScroll =
                   1584:             function() { return document.body.scrollLeft; };
                   1585:         Geometry.getVerticalScroll =
                   1586:             function() { return document.body.scrollTop; };
                   1587:     }
                   1588: }
                   1589: 
                   1590: GEOMETRY
                   1591: }
                   1592: 
                   1593: =pod
                   1594: 
1.648     raeburn  1595: =item * &viewport_size_js()
1.590     raeburn  1596: 
                   1597: 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. 
                   1598: 
                   1599: =cut
                   1600: 
                   1601: sub viewport_size_js {
                   1602:     my $geometry = &viewport_geometry_js();
                   1603:     return <<"DIMS";
                   1604: 
                   1605: $geometry
                   1606: 
                   1607: function getViewportDims(width,height) {
                   1608:     init_geometry();
                   1609:     width.value = Geometry.getViewportWidth();
                   1610:     height.value = Geometry.getViewportHeight();
                   1611:     return;
                   1612: }
                   1613: 
                   1614: DIMS
                   1615: }
                   1616: 
                   1617: =pod
                   1618: 
1.648     raeburn  1619: =item * &resize_textarea_js()
1.565     albertel 1620: 
                   1621: emits the needed javascript to resize a textarea to be as big as possible
                   1622: 
                   1623: creates a function resize_textrea that takes two IDs first should be
                   1624: the id of the element to resize, second should be the id of a div that
                   1625: surrounds everything that comes after the textarea, this routine needs
                   1626: to be attached to the <body> for the onload and onresize events.
                   1627: 
1.648     raeburn  1628: =back
1.565     albertel 1629: 
                   1630: =cut
                   1631: 
                   1632: sub resize_textarea_js {
1.590     raeburn  1633:     my $geometry = &viewport_geometry_js();
1.565     albertel 1634:     return <<"RESIZE";
                   1635:     <script type="text/javascript">
1.824     bisitz   1636: // <![CDATA[
1.590     raeburn  1637: $geometry
1.565     albertel 1638: 
1.588     albertel 1639: function getX(element) {
                   1640:     var x = 0;
                   1641:     while (element) {
                   1642: 	x += element.offsetLeft;
                   1643: 	element = element.offsetParent;
                   1644:     }
                   1645:     return x;
                   1646: }
                   1647: function getY(element) {
                   1648:     var y = 0;
                   1649:     while (element) {
                   1650: 	y += element.offsetTop;
                   1651: 	element = element.offsetParent;
                   1652:     }
                   1653:     return y;
                   1654: }
                   1655: 
                   1656: 
1.565     albertel 1657: function resize_textarea(textarea_id,bottom_id) {
                   1658:     init_geometry();
                   1659:     var textarea        = document.getElementById(textarea_id);
                   1660:     //alert(textarea);
                   1661: 
1.588     albertel 1662:     var textarea_top    = getY(textarea);
1.565     albertel 1663:     var textarea_height = textarea.offsetHeight;
                   1664:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1665:     var bottom_top      = getY(bottom);
1.565     albertel 1666:     var bottom_height   = bottom.offsetHeight;
                   1667:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1668:     var fudge           = 23;
1.565     albertel 1669:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1670:     if (new_height < 300) {
                   1671: 	new_height = 300;
                   1672:     }
                   1673:     textarea.style.height=new_height+'px';
                   1674: }
1.824     bisitz   1675: // ]]>
1.565     albertel 1676: </script>
                   1677: RESIZE
                   1678: 
                   1679: }
                   1680: 
                   1681: =pod
                   1682: 
1.256     matthew  1683: =head1 Excel and CSV file utility routines
                   1684: 
                   1685: =over 4
                   1686: 
                   1687: =cut
                   1688: 
                   1689: ###############################################################
                   1690: ###############################################################
                   1691: 
                   1692: =pod
                   1693: 
1.648     raeburn  1694: =item * &csv_translate($text) 
1.37      matthew  1695: 
1.185     www      1696: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1697: format.
                   1698: 
                   1699: =cut
                   1700: 
1.180     matthew  1701: ###############################################################
                   1702: ###############################################################
1.37      matthew  1703: sub csv_translate {
                   1704:     my $text = shift;
                   1705:     $text =~ s/\"/\"\"/g;
1.209     albertel 1706:     $text =~ s/\n/ /g;
1.37      matthew  1707:     return $text;
                   1708: }
1.180     matthew  1709: 
                   1710: ###############################################################
                   1711: ###############################################################
                   1712: 
                   1713: =pod
                   1714: 
1.648     raeburn  1715: =item * &define_excel_formats()
1.180     matthew  1716: 
                   1717: Define some commonly used Excel cell formats.
                   1718: 
                   1719: Currently supported formats:
                   1720: 
                   1721: =over 4
                   1722: 
                   1723: =item header
                   1724: 
                   1725: =item bold
                   1726: 
                   1727: =item h1
                   1728: 
                   1729: =item h2
                   1730: 
                   1731: =item h3
                   1732: 
1.256     matthew  1733: =item h4
                   1734: 
                   1735: =item i
                   1736: 
1.180     matthew  1737: =item date
                   1738: 
                   1739: =back
                   1740: 
                   1741: Inputs: $workbook
                   1742: 
                   1743: Returns: $format, a hash reference.
                   1744: 
                   1745: =cut
                   1746: 
                   1747: ###############################################################
                   1748: ###############################################################
                   1749: sub define_excel_formats {
                   1750:     my ($workbook) = @_;
                   1751:     my $format;
                   1752:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1753:                                                 bottom    => 1,
                   1754:                                                 align     => 'center');
                   1755:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1756:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1757:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1758:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1759:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1760:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1761:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1762:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1763:     return $format;
                   1764: }
                   1765: 
                   1766: ###############################################################
                   1767: ###############################################################
1.113     bowersj2 1768: 
                   1769: =pod
                   1770: 
1.648     raeburn  1771: =item * &create_workbook()
1.255     matthew  1772: 
                   1773: Create an Excel worksheet.  If it fails, output message on the
                   1774: request object and return undefs.
                   1775: 
                   1776: Inputs: Apache request object
                   1777: 
                   1778: Returns (undef) on failure, 
                   1779:     Excel worksheet object, scalar with filename, and formats 
                   1780:     from &Apache::loncommon::define_excel_formats on success
                   1781: 
                   1782: =cut
                   1783: 
                   1784: ###############################################################
                   1785: ###############################################################
                   1786: sub create_workbook {
                   1787:     my ($r) = @_;
                   1788:         #
                   1789:     # Create the excel spreadsheet
                   1790:     my $filename = '/prtspool/'.
1.258     albertel 1791:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1792:         time.'_'.rand(1000000000).'.xls';
                   1793:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1794:     if (! defined($workbook)) {
                   1795:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1796:         $r->print(
                   1797:             '<p class="LC_error">'
                   1798:            .&mt('Problems occurred in creating the new Excel file.')
                   1799:            .' '.&mt('This error has been logged.')
                   1800:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1801:            .'</p>'
                   1802:         );
1.255     matthew  1803:         return (undef);
                   1804:     }
                   1805:     #
1.1014    foxr     1806:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1807:     #
                   1808:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1809:     return ($workbook,$filename,$format);
                   1810: }
                   1811: 
                   1812: ###############################################################
                   1813: ###############################################################
                   1814: 
                   1815: =pod
                   1816: 
1.648     raeburn  1817: =item * &create_text_file()
1.113     bowersj2 1818: 
1.542     raeburn  1819: Create a file to write to and eventually make available to the user.
1.256     matthew  1820: If file creation fails, outputs an error message on the request object and 
                   1821: return undefs.
1.113     bowersj2 1822: 
1.256     matthew  1823: Inputs: Apache request object, and file suffix
1.113     bowersj2 1824: 
1.256     matthew  1825: Returns (undef) on failure, 
                   1826:     Filehandle and filename on success.
1.113     bowersj2 1827: 
                   1828: =cut
                   1829: 
1.256     matthew  1830: ###############################################################
                   1831: ###############################################################
                   1832: sub create_text_file {
                   1833:     my ($r,$suffix) = @_;
                   1834:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1835:     my $fh;
                   1836:     my $filename = '/prtspool/'.
1.258     albertel 1837:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1838:         time.'_'.rand(1000000000).'.'.$suffix;
                   1839:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1840:     if (! defined($fh)) {
                   1841:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1842:         $r->print(
                   1843:             '<p class="LC_error">'
                   1844:            .&mt('Problems occurred in creating the output file.')
                   1845:            .' '.&mt('This error has been logged.')
                   1846:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1847:            .'</p>'
                   1848:         );
1.113     bowersj2 1849:     }
1.256     matthew  1850:     return ($fh,$filename)
1.113     bowersj2 1851: }
                   1852: 
                   1853: 
1.256     matthew  1854: =pod 
1.113     bowersj2 1855: 
                   1856: =back
                   1857: 
                   1858: =cut
1.37      matthew  1859: 
                   1860: ###############################################################
1.33      matthew  1861: ##        Home server <option> list generating code          ##
                   1862: ###############################################################
1.35      matthew  1863: 
1.169     www      1864: # ------------------------------------------
                   1865: 
                   1866: sub domain_select {
                   1867:     my ($name,$value,$multiple)=@_;
                   1868:     my %domains=map { 
1.514     albertel 1869: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1870:     } &Apache::lonnet::all_domains();
1.169     www      1871:     if ($multiple) {
                   1872: 	$domains{''}=&mt('Any domain');
1.550     albertel 1873: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1874: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1875:     } else {
1.550     albertel 1876: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1877: 	return &select_form($name,$value,\%domains);
1.169     www      1878:     }
                   1879: }
                   1880: 
1.282     albertel 1881: #-------------------------------------------
                   1882: 
                   1883: =pod
                   1884: 
1.519     raeburn  1885: =head1 Routines for form select boxes
                   1886: 
                   1887: =over 4
                   1888: 
1.648     raeburn  1889: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1890: 
                   1891: Returns a string containing a <select> element int multiple mode
                   1892: 
                   1893: 
                   1894: Args:
                   1895:   $name - name of the <select> element
1.506     raeburn  1896:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1897:   $size - number of rows long the select element is
1.283     albertel 1898:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1899:           (shown text should already have been &mt())
1.506     raeburn  1900:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1901: 
1.282     albertel 1902: =cut
                   1903: 
                   1904: #-------------------------------------------
1.169     www      1905: sub multiple_select_form {
1.284     albertel 1906:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1907:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1908:     my $output='';
1.191     matthew  1909:     if (! defined($size)) {
                   1910:         $size = 4;
1.283     albertel 1911:         if (scalar(keys(%$hash))<4) {
                   1912:             $size = scalar(keys(%$hash));
1.191     matthew  1913:         }
                   1914:     }
1.734     bisitz   1915:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1916:     my @order;
1.506     raeburn  1917:     if (ref($order) eq 'ARRAY')  {
                   1918:         @order = @{$order};
                   1919:     } else {
                   1920:         @order = sort(keys(%$hash));
1.501     banghart 1921:     }
                   1922:     if (exists($$hash{'select_form_order'})) {
                   1923:         @order = @{$$hash{'select_form_order'}};
                   1924:     }
                   1925:         
1.284     albertel 1926:     foreach my $key (@order) {
1.356     albertel 1927:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1928:         $output.='selected="selected" ' if ($selected{$key});
                   1929:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1930:     }
                   1931:     $output.="</select>\n";
                   1932:     return $output;
                   1933: }
                   1934: 
1.88      www      1935: #-------------------------------------------
                   1936: 
                   1937: =pod
                   1938: 
1.970     raeburn  1939: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1940: 
                   1941: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1942: allow a user to select options from a ref to a hash containing:
                   1943: option_name => displayed text. An optional $onchange can include
                   1944: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1945: 
1.88      www      1946: See lonrights.pm for an example invocation and use.
                   1947: 
                   1948: =cut
                   1949: 
                   1950: #-------------------------------------------
                   1951: sub select_form {
1.970     raeburn  1952:     my ($def,$name,$hashref,$onchange) = @_;
                   1953:     return unless (ref($hashref) eq 'HASH');
                   1954:     if ($onchange) {
                   1955:         $onchange = ' onchange="'.$onchange.'"';
                   1956:     }
                   1957:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1958:     my @keys;
1.970     raeburn  1959:     if (exists($hashref->{'select_form_order'})) {
                   1960: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1961:     } else {
1.970     raeburn  1962: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1963:     }
1.356     albertel 1964:     foreach my $key (@keys) {
                   1965:         $selectform.=
                   1966: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1967:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1968:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1969:     }
                   1970:     $selectform.="</select>";
                   1971:     return $selectform;
                   1972: }
                   1973: 
1.475     www      1974: # For display filters
                   1975: 
                   1976: sub display_filter {
                   1977:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1978:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1979:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1980: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1981: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1982: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1983:            &mt('Filter [_1]',
1.477     www      1984: 	   &select_form($env{'form.displayfilter'},
                   1985: 			'displayfilter',
1.970     raeburn  1986: 			{'currentfolder' => 'Current folder/page',
1.477     www      1987: 			 'containing' => 'Containing phrase',
1.970     raeburn  1988: 			 'none' => 'None'})).
1.714     bisitz   1989: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1990: }
                   1991: 
1.167     www      1992: sub gradeleveldescription {
                   1993:     my $gradelevel=shift;
                   1994:     my %gradelevels=(0 => 'Not specified',
                   1995: 		     1 => 'Grade 1',
                   1996: 		     2 => 'Grade 2',
                   1997: 		     3 => 'Grade 3',
                   1998: 		     4 => 'Grade 4',
                   1999: 		     5 => 'Grade 5',
                   2000: 		     6 => 'Grade 6',
                   2001: 		     7 => 'Grade 7',
                   2002: 		     8 => 'Grade 8',
                   2003: 		     9 => 'Grade 9',
                   2004: 		     10 => 'Grade 10',
                   2005: 		     11 => 'Grade 11',
                   2006: 		     12 => 'Grade 12',
                   2007: 		     13 => 'Grade 13',
                   2008: 		     14 => '100 Level',
                   2009: 		     15 => '200 Level',
                   2010: 		     16 => '300 Level',
                   2011: 		     17 => '400 Level',
                   2012: 		     18 => 'Graduate Level');
                   2013:     return &mt($gradelevels{$gradelevel});
                   2014: }
                   2015: 
1.163     www      2016: sub select_level_form {
                   2017:     my ($deflevel,$name)=@_;
                   2018:     unless ($deflevel) { $deflevel=0; }
1.167     www      2019:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2020:     for (my $i=0; $i<=18; $i++) {
                   2021:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2022:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2023:                 ">".&gradeleveldescription($i)."</option>\n";
                   2024:     }
                   2025:     $selectform.="</select>";
                   2026:     return $selectform;
1.163     www      2027: }
1.167     www      2028: 
1.35      matthew  2029: #-------------------------------------------
                   2030: 
1.45      matthew  2031: =pod
                   2032: 
1.910     raeburn  2033: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2034: 
                   2035: Returns a string containing a <select name='$name' size='1'> form to 
                   2036: allow a user to select the domain to preform an operation in.  
                   2037: See loncreateuser.pm for an example invocation and use.
                   2038: 
1.90      www      2039: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2040: selected");
                   2041: 
1.743     raeburn  2042: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2043: 
1.910     raeburn  2044: 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.
                   2045: 
                   2046: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2047: 
1.35      matthew  2048: =cut
                   2049: 
                   2050: #-------------------------------------------
1.34      matthew  2051: sub select_dom_form {
1.910     raeburn  2052:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2053:     if ($onchange) {
1.874     raeburn  2054:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2055:     }
1.910     raeburn  2056:     my @domains;
                   2057:     if (ref($incdoms) eq 'ARRAY') {
                   2058:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2059:     } else {
                   2060:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2061:     }
1.90      www      2062:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2063:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2064:     foreach my $dom (@domains) {
                   2065:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2066:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2067:         if ($showdomdesc) {
                   2068:             if ($dom ne '') {
                   2069:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2070:                 if ($domdesc ne '') {
                   2071:                     $selectdomain .= ' ('.$domdesc.')';
                   2072:                 }
                   2073:             } 
                   2074:         }
                   2075:         $selectdomain .= "</option>\n";
1.34      matthew  2076:     }
                   2077:     $selectdomain.="</select>";
                   2078:     return $selectdomain;
                   2079: }
                   2080: 
1.35      matthew  2081: #-------------------------------------------
                   2082: 
1.45      matthew  2083: =pod
                   2084: 
1.648     raeburn  2085: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2086: 
1.586     raeburn  2087: input: 4 arguments (two required, two optional) - 
                   2088:     $domain - domain of new user
                   2089:     $name - name of form element
                   2090:     $default - Value of 'default' causes a default item to be first 
                   2091:                             option, and selected by default. 
                   2092:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2093:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2094: output: returns 2 items: 
1.586     raeburn  2095: (a) form element which contains either:
                   2096:    (i) <select name="$name">
                   2097:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2098:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2099:        </select>
                   2100:        form item if there are multiple library servers in $domain, or
                   2101:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2102:        if there is only one library server in $domain.
                   2103: 
                   2104: (b) number of library servers found.
                   2105: 
                   2106: See loncreateuser.pm for example of use.
1.35      matthew  2107: 
                   2108: =cut
                   2109: 
                   2110: #-------------------------------------------
1.586     raeburn  2111: sub home_server_form_item {
                   2112:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2113:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2114:     my $result;
                   2115:     my $numlib = keys(%servers);
                   2116:     if ($numlib > 1) {
                   2117:         $result .= '<select name="'.$name.'" />'."\n";
                   2118:         if ($default) {
1.804     bisitz   2119:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2120:                        '</option>'."\n";
                   2121:         }
                   2122:         foreach my $hostid (sort(keys(%servers))) {
                   2123:             $result.= '<option value="'.$hostid.'">'.
                   2124: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2125:         }
                   2126:         $result .= '</select>'."\n";
                   2127:     } elsif ($numlib == 1) {
                   2128:         my $hostid;
                   2129:         foreach my $item (keys(%servers)) {
                   2130:             $hostid = $item;
                   2131:         }
                   2132:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2133:                    $hostid.'" />';
                   2134:                    if (!$hide) {
                   2135:                        $result .= $hostid.' '.$servers{$hostid};
                   2136:                    }
                   2137:                    $result .= "\n";
                   2138:     } elsif ($default) {
                   2139:         $result .= '<input type="hidden" name="'.$name.
                   2140:                    '" value="default" />';
                   2141:                    if (!$hide) {
                   2142:                        $result .= &mt('default');
                   2143:                    }
                   2144:                    $result .= "\n";
1.33      matthew  2145:     }
1.586     raeburn  2146:     return ($result,$numlib);
1.33      matthew  2147: }
1.112     bowersj2 2148: 
                   2149: =pod
                   2150: 
1.534     albertel 2151: =back 
                   2152: 
1.112     bowersj2 2153: =cut
1.87      matthew  2154: 
                   2155: ###############################################################
1.112     bowersj2 2156: ##                  Decoding User Agent                      ##
1.87      matthew  2157: ###############################################################
                   2158: 
                   2159: =pod
                   2160: 
1.112     bowersj2 2161: =head1 Decoding the User Agent
                   2162: 
                   2163: =over 4
                   2164: 
                   2165: =item * &decode_user_agent()
1.87      matthew  2166: 
                   2167: Inputs: $r
                   2168: 
                   2169: Outputs:
                   2170: 
                   2171: =over 4
                   2172: 
1.112     bowersj2 2173: =item * $httpbrowser
1.87      matthew  2174: 
1.112     bowersj2 2175: =item * $clientbrowser
1.87      matthew  2176: 
1.112     bowersj2 2177: =item * $clientversion
1.87      matthew  2178: 
1.112     bowersj2 2179: =item * $clientmathml
1.87      matthew  2180: 
1.112     bowersj2 2181: =item * $clientunicode
1.87      matthew  2182: 
1.112     bowersj2 2183: =item * $clientos
1.87      matthew  2184: 
                   2185: =back
                   2186: 
1.157     matthew  2187: =back 
                   2188: 
1.87      matthew  2189: =cut
                   2190: 
                   2191: ###############################################################
                   2192: ###############################################################
                   2193: sub decode_user_agent {
1.247     albertel 2194:     my ($r)=@_;
1.87      matthew  2195:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2196:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2197:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2198:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2199:     my $clientbrowser='unknown';
                   2200:     my $clientversion='0';
                   2201:     my $clientmathml='';
                   2202:     my $clientunicode='0';
                   2203:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2204:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2205: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2206: 	    $clientbrowser=$bname;
                   2207:             $httpbrowser=~/$vreg/i;
                   2208: 	    $clientversion=$1;
                   2209:             $clientmathml=($clientversion>=$minv);
                   2210:             $clientunicode=($clientversion>=$univ);
                   2211: 	}
                   2212:     }
                   2213:     my $clientos='unknown';
                   2214:     if (($httpbrowser=~/linux/i) ||
                   2215:         ($httpbrowser=~/unix/i) ||
                   2216:         ($httpbrowser=~/ux/i) ||
                   2217:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2218:     if (($httpbrowser=~/vax/i) ||
                   2219:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2220:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2221:     if (($httpbrowser=~/mac/i) ||
                   2222:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2223:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2224:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2225:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2226:             $clientunicode,$clientos,);
                   2227: }
                   2228: 
1.32      matthew  2229: ###############################################################
                   2230: ##    Authentication changing form generation subroutines    ##
                   2231: ###############################################################
                   2232: ##
                   2233: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2234: ## hash, and have reasonable default values.
                   2235: ##
                   2236: ##    formname = the name given in the <form> tag.
1.35      matthew  2237: #-------------------------------------------
                   2238: 
1.45      matthew  2239: =pod
                   2240: 
1.112     bowersj2 2241: =head1 Authentication Routines
                   2242: 
                   2243: =over 4
                   2244: 
1.648     raeburn  2245: =item * &authform_xxxxxx()
1.35      matthew  2246: 
                   2247: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2248: handle some of the conveniences required for authentication forms.  
                   2249: This is not an optimal method, but it works.  
                   2250: 
                   2251: =over 4
                   2252: 
1.112     bowersj2 2253: =item * authform_header
1.35      matthew  2254: 
1.112     bowersj2 2255: =item * authform_authorwarning
1.35      matthew  2256: 
1.112     bowersj2 2257: =item * authform_nochange
1.35      matthew  2258: 
1.112     bowersj2 2259: =item * authform_kerberos
1.35      matthew  2260: 
1.112     bowersj2 2261: =item * authform_internal
1.35      matthew  2262: 
1.112     bowersj2 2263: =item * authform_filesystem
1.35      matthew  2264: 
                   2265: =back
                   2266: 
1.648     raeburn  2267: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2268: 
1.35      matthew  2269: =cut
                   2270: 
                   2271: #-------------------------------------------
1.32      matthew  2272: sub authform_header{  
                   2273:     my %in = (
                   2274:         formname => 'cu',
1.80      albertel 2275:         kerb_def_dom => '',
1.32      matthew  2276:         @_,
                   2277:     );
                   2278:     $in{'formname'} = 'document.' . $in{'formname'};
                   2279:     my $result='';
1.80      albertel 2280: 
                   2281: #---------------------------------------------- Code for upper case translation
                   2282:     my $Javascript_toUpperCase;
                   2283:     unless ($in{kerb_def_dom}) {
                   2284:         $Javascript_toUpperCase =<<"END";
                   2285:         switch (choice) {
                   2286:            case 'krb': currentform.elements[choicearg].value =
                   2287:                currentform.elements[choicearg].value.toUpperCase();
                   2288:                break;
                   2289:            default:
                   2290:         }
                   2291: END
                   2292:     } else {
                   2293:         $Javascript_toUpperCase = "";
                   2294:     }
                   2295: 
1.165     raeburn  2296:     my $radioval = "'nochange'";
1.591     raeburn  2297:     if (defined($in{'curr_authtype'})) {
                   2298:         if ($in{'curr_authtype'} ne '') {
                   2299:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2300:         }
1.174     matthew  2301:     }
1.165     raeburn  2302:     my $argfield = 'null';
1.591     raeburn  2303:     if (defined($in{'mode'})) {
1.165     raeburn  2304:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2305:             if (defined($in{'curr_autharg'})) {
                   2306:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2307:                     $argfield = "'$in{'curr_autharg'}'";
                   2308:                 }
                   2309:             }
                   2310:         }
                   2311:     }
                   2312: 
1.32      matthew  2313:     $result.=<<"END";
                   2314: var current = new Object();
1.165     raeburn  2315: current.radiovalue = $radioval;
                   2316: current.argfield = $argfield;
1.32      matthew  2317: 
                   2318: function changed_radio(choice,currentform) {
                   2319:     var choicearg = choice + 'arg';
                   2320:     // If a radio button in changed, we need to change the argfield
                   2321:     if (current.radiovalue != choice) {
                   2322:         current.radiovalue = choice;
                   2323:         if (current.argfield != null) {
                   2324:             currentform.elements[current.argfield].value = '';
                   2325:         }
                   2326:         if (choice == 'nochange') {
                   2327:             current.argfield = null;
                   2328:         } else {
                   2329:             current.argfield = choicearg;
                   2330:             switch(choice) {
                   2331:                 case 'krb': 
                   2332:                     currentform.elements[current.argfield].value = 
                   2333:                         "$in{'kerb_def_dom'}";
                   2334:                 break;
                   2335:               default:
                   2336:                 break;
                   2337:             }
                   2338:         }
                   2339:     }
                   2340:     return;
                   2341: }
1.22      www      2342: 
1.32      matthew  2343: function changed_text(choice,currentform) {
                   2344:     var choicearg = choice + 'arg';
                   2345:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2346:         $Javascript_toUpperCase
1.32      matthew  2347:         // clear old field
                   2348:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2349:             currentform.elements[current.argfield].value = '';
                   2350:         }
                   2351:         current.argfield = choicearg;
                   2352:     }
                   2353:     set_auth_radio_buttons(choice,currentform);
                   2354:     return;
1.20      www      2355: }
1.32      matthew  2356: 
                   2357: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2358:     var numauthchoices = currentform.login.length;
                   2359:     if (typeof numauthchoices  == "undefined") {
                   2360:         return;
                   2361:     } 
1.32      matthew  2362:     var i=0;
1.986     raeburn  2363:     while (i < numauthchoices) {
1.32      matthew  2364:         if (currentform.login[i].value == newvalue) { break; }
                   2365:         i++;
                   2366:     }
1.986     raeburn  2367:     if (i == numauthchoices) {
1.32      matthew  2368:         return;
                   2369:     }
                   2370:     current.radiovalue = newvalue;
                   2371:     currentform.login[i].checked = true;
                   2372:     return;
                   2373: }
                   2374: END
                   2375:     return $result;
                   2376: }
                   2377: 
                   2378: sub authform_authorwarning{
                   2379:     my $result='';
1.144     matthew  2380:     $result='<i>'.
                   2381:         &mt('As a general rule, only authors or co-authors should be '.
                   2382:             'filesystem authenticated '.
                   2383:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2384:     return $result;
                   2385: }
                   2386: 
                   2387: sub authform_nochange{  
                   2388:     my %in = (
                   2389:               formname => 'document.cu',
                   2390:               kerb_def_dom => 'MSU.EDU',
                   2391:               @_,
                   2392:           );
1.586     raeburn  2393:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2394:     my $result;
                   2395:     if (keys(%can_assign) == 0) {
                   2396:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2397:     } else {
                   2398:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2399:                   '<input type="radio" name="login" value="nochange" '.
                   2400:                   'checked="checked" onclick="'.
1.281     albertel 2401:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2402: 	    '</label>';
1.586     raeburn  2403:     }
1.32      matthew  2404:     return $result;
                   2405: }
                   2406: 
1.591     raeburn  2407: sub authform_kerberos {
1.32      matthew  2408:     my %in = (
                   2409:               formname => 'document.cu',
                   2410:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2411:               kerb_def_auth => 'krb4',
1.32      matthew  2412:               @_,
                   2413:               );
1.586     raeburn  2414:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2415:         $autharg,$jscall);
                   2416:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2417:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2418:        $check5 = ' checked="checked"';
1.80      albertel 2419:     } else {
1.772     bisitz   2420:        $check4 = ' checked="checked"';
1.80      albertel 2421:     }
1.165     raeburn  2422:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2423:     if (defined($in{'curr_authtype'})) {
                   2424:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2425:             $krbcheck = ' checked="checked"';
1.623     raeburn  2426:             if (defined($in{'mode'})) {
                   2427:                 if ($in{'mode'} eq 'modifyuser') {
                   2428:                     $krbcheck = '';
                   2429:                 }
                   2430:             }
1.591     raeburn  2431:             if (defined($in{'curr_kerb_ver'})) {
                   2432:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2433:                     $check5 = ' checked="checked"';
1.591     raeburn  2434:                     $check4 = '';
                   2435:                 } else {
1.772     bisitz   2436:                     $check4 = ' checked="checked"';
1.591     raeburn  2437:                     $check5 = '';
                   2438:                 }
1.586     raeburn  2439:             }
1.591     raeburn  2440:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2441:                 $krbarg = $in{'curr_autharg'};
                   2442:             }
1.586     raeburn  2443:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2444:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2445:                     $result = 
                   2446:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2447:         $in{'curr_autharg'},$krbver);
                   2448:                 } else {
                   2449:                     $result =
                   2450:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2451:                 }
                   2452:                 return $result; 
                   2453:             }
                   2454:         }
                   2455:     } else {
                   2456:         if ($authnum == 1) {
1.784     bisitz   2457:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2458:         }
                   2459:     }
1.586     raeburn  2460:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2461:         return;
1.587     raeburn  2462:     } elsif ($authtype eq '') {
1.591     raeburn  2463:         if (defined($in{'mode'})) {
1.587     raeburn  2464:             if ($in{'mode'} eq 'modifycourse') {
                   2465:                 if ($authnum == 1) {
1.784     bisitz   2466:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2467:                 }
                   2468:             }
                   2469:         }
1.586     raeburn  2470:     }
                   2471:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2472:     if ($authtype eq '') {
                   2473:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2474:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2475:                     $krbcheck.' />';
                   2476:     }
                   2477:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2478:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2479:          $in{'curr_authtype'} eq 'krb5') ||
                   2480:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2481:          $in{'curr_authtype'} eq 'krb4')) {
                   2482:         $result .= &mt
1.144     matthew  2483:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2484:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2485:          '<label>'.$authtype,
1.281     albertel 2486:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2487:              'value="'.$krbarg.'" '.
1.144     matthew  2488:              'onchange="'.$jscall.'" />',
1.281     albertel 2489:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2490:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2491: 	 '</label>');
1.586     raeburn  2492:     } elsif ($can_assign{'krb4'}) {
                   2493:         $result .= &mt
                   2494:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2495:          '[_3] Version 4 [_4]',
                   2496:          '<label>'.$authtype,
                   2497:          '</label><input type="text" size="10" name="krbarg" '.
                   2498:              'value="'.$krbarg.'" '.
                   2499:              'onchange="'.$jscall.'" />',
                   2500:          '<label><input type="hidden" name="krbver" value="4" />',
                   2501:          '</label>');
                   2502:     } elsif ($can_assign{'krb5'}) {
                   2503:         $result .= &mt
                   2504:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2505:          '[_3] Version 5 [_4]',
                   2506:          '<label>'.$authtype,
                   2507:          '</label><input type="text" size="10" name="krbarg" '.
                   2508:              'value="'.$krbarg.'" '.
                   2509:              'onchange="'.$jscall.'" />',
                   2510:          '<label><input type="hidden" name="krbver" value="5" />',
                   2511:          '</label>');
                   2512:     }
1.32      matthew  2513:     return $result;
                   2514: }
                   2515: 
                   2516: sub authform_internal{  
1.586     raeburn  2517:     my %in = (
1.32      matthew  2518:                 formname => 'document.cu',
                   2519:                 kerb_def_dom => 'MSU.EDU',
                   2520:                 @_,
                   2521:                 );
1.586     raeburn  2522:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2523:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2524:     if (defined($in{'curr_authtype'})) {
                   2525:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2526:             if ($can_assign{'int'}) {
1.772     bisitz   2527:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2528:                 if (defined($in{'mode'})) {
                   2529:                     if ($in{'mode'} eq 'modifyuser') {
                   2530:                         $intcheck = '';
                   2531:                     }
                   2532:                 }
1.591     raeburn  2533:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2534:                     $intarg = $in{'curr_autharg'};
                   2535:                 }
                   2536:             } else {
                   2537:                 $result = &mt('Currently internally authenticated.');
                   2538:                 return $result;
1.165     raeburn  2539:             }
                   2540:         }
1.586     raeburn  2541:     } else {
                   2542:         if ($authnum == 1) {
1.784     bisitz   2543:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2544:         }
                   2545:     }
                   2546:     if (!$can_assign{'int'}) {
                   2547:         return;
1.587     raeburn  2548:     } elsif ($authtype eq '') {
1.591     raeburn  2549:         if (defined($in{'mode'})) {
1.587     raeburn  2550:             if ($in{'mode'} eq 'modifycourse') {
                   2551:                 if ($authnum == 1) {
1.784     bisitz   2552:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2553:                 }
                   2554:             }
                   2555:         }
1.165     raeburn  2556:     }
1.586     raeburn  2557:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2558:     if ($authtype eq '') {
                   2559:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2560:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2561:     }
1.605     bisitz   2562:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2563:                $intarg.'" onchange="'.$jscall.'" />';
                   2564:     $result = &mt
1.144     matthew  2565:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2566:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2567:     $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  2568:     return $result;
                   2569: }
                   2570: 
                   2571: sub authform_local{  
                   2572:     my %in = (
                   2573:               formname => 'document.cu',
                   2574:               kerb_def_dom => 'MSU.EDU',
                   2575:               @_,
                   2576:               );
1.586     raeburn  2577:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2578:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2579:     if (defined($in{'curr_authtype'})) {
                   2580:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2581:             if ($can_assign{'loc'}) {
1.772     bisitz   2582:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2583:                 if (defined($in{'mode'})) {
                   2584:                     if ($in{'mode'} eq 'modifyuser') {
                   2585:                         $loccheck = '';
                   2586:                     }
                   2587:                 }
1.591     raeburn  2588:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2589:                     $locarg = $in{'curr_autharg'};
                   2590:                 }
                   2591:             } else {
                   2592:                 $result = &mt('Currently using local (institutional) authentication.');
                   2593:                 return $result;
1.165     raeburn  2594:             }
                   2595:         }
1.586     raeburn  2596:     } else {
                   2597:         if ($authnum == 1) {
1.784     bisitz   2598:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2599:         }
                   2600:     }
                   2601:     if (!$can_assign{'loc'}) {
                   2602:         return;
1.587     raeburn  2603:     } elsif ($authtype eq '') {
1.591     raeburn  2604:         if (defined($in{'mode'})) {
1.587     raeburn  2605:             if ($in{'mode'} eq 'modifycourse') {
                   2606:                 if ($authnum == 1) {
1.784     bisitz   2607:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2608:                 }
                   2609:             }
                   2610:         }
1.165     raeburn  2611:     }
1.586     raeburn  2612:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2613:     if ($authtype eq '') {
                   2614:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2615:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2616:                     $jscall.'" />';
                   2617:     }
                   2618:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2619:                $locarg.'" onchange="'.$jscall.'" />';
                   2620:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2621:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2622:     return $result;
                   2623: }
                   2624: 
                   2625: sub authform_filesystem{  
                   2626:     my %in = (
                   2627:               formname => 'document.cu',
                   2628:               kerb_def_dom => 'MSU.EDU',
                   2629:               @_,
                   2630:               );
1.586     raeburn  2631:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2632:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2633:     if (defined($in{'curr_authtype'})) {
                   2634:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2635:             if ($can_assign{'fsys'}) {
1.772     bisitz   2636:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2637:                 if (defined($in{'mode'})) {
                   2638:                     if ($in{'mode'} eq 'modifyuser') {
                   2639:                         $fsyscheck = '';
                   2640:                     }
                   2641:                 }
1.586     raeburn  2642:             } else {
                   2643:                 $result = &mt('Currently Filesystem Authenticated.');
                   2644:                 return $result;
                   2645:             }           
                   2646:         }
                   2647:     } else {
                   2648:         if ($authnum == 1) {
1.784     bisitz   2649:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2650:         }
                   2651:     }
                   2652:     if (!$can_assign{'fsys'}) {
                   2653:         return;
1.587     raeburn  2654:     } elsif ($authtype eq '') {
1.591     raeburn  2655:         if (defined($in{'mode'})) {
1.587     raeburn  2656:             if ($in{'mode'} eq 'modifycourse') {
                   2657:                 if ($authnum == 1) {
1.784     bisitz   2658:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2659:                 }
                   2660:             }
                   2661:         }
1.586     raeburn  2662:     }
                   2663:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2664:     if ($authtype eq '') {
                   2665:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2666:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2667:                     $jscall.'" />';
                   2668:     }
                   2669:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2670:                ' onchange="'.$jscall.'" />';
                   2671:     $result = &mt
1.144     matthew  2672:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2673:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2674:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2675:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2676:                   'onchange="'.$jscall.'" />');
1.32      matthew  2677:     return $result;
                   2678: }
                   2679: 
1.586     raeburn  2680: sub get_assignable_auth {
                   2681:     my ($dom) = @_;
                   2682:     if ($dom eq '') {
                   2683:         $dom = $env{'request.role.domain'};
                   2684:     }
                   2685:     my %can_assign = (
                   2686:                           krb4 => 1,
                   2687:                           krb5 => 1,
                   2688:                           int  => 1,
                   2689:                           loc  => 1,
                   2690:                      );
                   2691:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2692:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2693:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2694:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2695:             my $context;
                   2696:             if ($env{'request.role'} =~ /^au/) {
                   2697:                 $context = 'author';
                   2698:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2699:                 $context = 'domain';
                   2700:             } elsif ($env{'request.course.id'}) {
                   2701:                 $context = 'course';
                   2702:             }
                   2703:             if ($context) {
                   2704:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2705:                    %can_assign = %{$authhash->{$context}}; 
                   2706:                 }
                   2707:             }
                   2708:         }
                   2709:     }
                   2710:     my $authnum = 0;
                   2711:     foreach my $key (keys(%can_assign)) {
                   2712:         if ($can_assign{$key}) {
                   2713:             $authnum ++;
                   2714:         }
                   2715:     }
                   2716:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2717:         $authnum --;
                   2718:     }
                   2719:     return ($authnum,%can_assign);
                   2720: }
                   2721: 
1.80      albertel 2722: ###############################################################
                   2723: ##    Get Kerberos Defaults for Domain                 ##
                   2724: ###############################################################
                   2725: ##
                   2726: ## Returns default kerberos version and an associated argument
                   2727: ## as listed in file domain.tab. If not listed, provides
                   2728: ## appropriate default domain and kerberos version.
                   2729: ##
                   2730: #-------------------------------------------
                   2731: 
                   2732: =pod
                   2733: 
1.648     raeburn  2734: =item * &get_kerberos_defaults()
1.80      albertel 2735: 
                   2736: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2737: version and domain. If not found, it defaults to version 4 and the 
                   2738: domain of the server.
1.80      albertel 2739: 
1.648     raeburn  2740: =over 4
                   2741: 
1.80      albertel 2742: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2743: 
1.648     raeburn  2744: =back
                   2745: 
                   2746: =back
                   2747: 
1.80      albertel 2748: =cut
                   2749: 
                   2750: #-------------------------------------------
                   2751: sub get_kerberos_defaults {
                   2752:     my $domain=shift;
1.641     raeburn  2753:     my ($krbdef,$krbdefdom);
                   2754:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2755:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2756:         $krbdef = $domdefaults{'auth_def'};
                   2757:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2758:     } else {
1.80      albertel 2759:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2760:         my $krbdefdom=$1;
                   2761:         $krbdefdom=~tr/a-z/A-Z/;
                   2762:         $krbdef = "krb4";
                   2763:     }
                   2764:     return ($krbdef,$krbdefdom);
                   2765: }
1.112     bowersj2 2766: 
1.32      matthew  2767: 
1.46      matthew  2768: ###############################################################
                   2769: ##                Thesaurus Functions                        ##
                   2770: ###############################################################
1.20      www      2771: 
1.46      matthew  2772: =pod
1.20      www      2773: 
1.112     bowersj2 2774: =head1 Thesaurus Functions
                   2775: 
                   2776: =over 4
                   2777: 
1.648     raeburn  2778: =item * &initialize_keywords()
1.46      matthew  2779: 
                   2780: Initializes the package variable %Keywords if it is empty.  Uses the
                   2781: package variable $thesaurus_db_file.
                   2782: 
                   2783: =cut
                   2784: 
                   2785: ###################################################
                   2786: 
                   2787: sub initialize_keywords {
                   2788:     return 1 if (scalar keys(%Keywords));
                   2789:     # If we are here, %Keywords is empty, so fill it up
                   2790:     #   Make sure the file we need exists...
                   2791:     if (! -e $thesaurus_db_file) {
                   2792:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2793:                                  " failed because it does not exist");
                   2794:         return 0;
                   2795:     }
                   2796:     #   Set up the hash as a database
                   2797:     my %thesaurus_db;
                   2798:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2799:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2800:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2801:                                  $thesaurus_db_file);
                   2802:         return 0;
                   2803:     } 
                   2804:     #  Get the average number of appearances of a word.
                   2805:     my $avecount = $thesaurus_db{'average.count'};
                   2806:     #  Put keywords (those that appear > average) into %Keywords
                   2807:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2808:         my ($count,undef) = split /:/,$data;
                   2809:         $Keywords{$word}++ if ($count > $avecount);
                   2810:     }
                   2811:     untie %thesaurus_db;
                   2812:     # Remove special values from %Keywords.
1.356     albertel 2813:     foreach my $value ('total.count','average.count') {
                   2814:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2815:   }
1.46      matthew  2816:     return 1;
                   2817: }
                   2818: 
                   2819: ###################################################
                   2820: 
                   2821: =pod
                   2822: 
1.648     raeburn  2823: =item * &keyword($word)
1.46      matthew  2824: 
                   2825: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2826: than the average number of times in the thesaurus database.  Calls 
                   2827: &initialize_keywords
                   2828: 
                   2829: =cut
                   2830: 
                   2831: ###################################################
1.20      www      2832: 
                   2833: sub keyword {
1.46      matthew  2834:     return if (!&initialize_keywords());
                   2835:     my $word=lc(shift());
                   2836:     $word=~s/\W//g;
                   2837:     return exists($Keywords{$word});
1.20      www      2838: }
1.46      matthew  2839: 
                   2840: ###############################################################
                   2841: 
                   2842: =pod 
1.20      www      2843: 
1.648     raeburn  2844: =item * &get_related_words()
1.46      matthew  2845: 
1.160     matthew  2846: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2847: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2848: will be returned.  The order of the words returned is determined by the
                   2849: database which holds them.
                   2850: 
                   2851: Uses global $thesaurus_db_file.
                   2852: 
                   2853: =cut
                   2854: 
                   2855: ###############################################################
                   2856: sub get_related_words {
                   2857:     my $keyword = shift;
                   2858:     my %thesaurus_db;
                   2859:     if (! -e $thesaurus_db_file) {
                   2860:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2861:                                  "failed because the file does not exist");
                   2862:         return ();
                   2863:     }
                   2864:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2865:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2866:         return ();
                   2867:     } 
                   2868:     my @Words=();
1.429     www      2869:     my $count=0;
1.46      matthew  2870:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2871: 	# The first element is the number of times
                   2872: 	# the word appears.  We do not need it now.
1.429     www      2873: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2874: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2875: 	my $threshold=$mostfrequentcount/10;
                   2876:         foreach my $possibleword (@RelatedWords) {
                   2877:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2878:             if ($wordcount>$threshold) {
                   2879: 		push(@Words,$word);
                   2880:                 $count++;
                   2881:                 if ($count>10) { last; }
                   2882: 	    }
1.20      www      2883:         }
                   2884:     }
1.46      matthew  2885:     untie %thesaurus_db;
                   2886:     return @Words;
1.14      harris41 2887: }
1.46      matthew  2888: 
1.112     bowersj2 2889: =pod
                   2890: 
                   2891: =back
                   2892: 
                   2893: =cut
1.61      www      2894: 
                   2895: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2896: =pod
                   2897: 
1.112     bowersj2 2898: =head1 User Name Functions
                   2899: 
                   2900: =over 4
                   2901: 
1.648     raeburn  2902: =item * &plainname($uname,$udom,$first)
1.81      albertel 2903: 
1.112     bowersj2 2904: Takes a users logon name and returns it as a string in
1.226     albertel 2905: "first middle last generation" form 
                   2906: if $first is set to 'lastname' then it returns it as
                   2907: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2908: 
                   2909: =cut
1.61      www      2910: 
1.295     www      2911: 
1.81      albertel 2912: ###############################################################
1.61      www      2913: sub plainname {
1.226     albertel 2914:     my ($uname,$udom,$first)=@_;
1.537     albertel 2915:     return if (!defined($uname) || !defined($udom));
1.295     www      2916:     my %names=&getnames($uname,$udom);
1.226     albertel 2917:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2918: 					  $names{'middlename'},
                   2919: 					  $names{'lastname'},
                   2920: 					  $names{'generation'},$first);
                   2921:     $name=~s/^\s+//;
1.62      www      2922:     $name=~s/\s+$//;
                   2923:     $name=~s/\s+/ /g;
1.353     albertel 2924:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2925:     return $name;
1.61      www      2926: }
1.66      www      2927: 
                   2928: # -------------------------------------------------------------------- Nickname
1.81      albertel 2929: =pod
                   2930: 
1.648     raeburn  2931: =item * &nickname($uname,$udom)
1.81      albertel 2932: 
                   2933: Gets a users name and returns it as a string as
                   2934: 
                   2935: "&quot;nickname&quot;"
1.66      www      2936: 
1.81      albertel 2937: if the user has a nickname or
                   2938: 
                   2939: "first middle last generation"
                   2940: 
                   2941: if the user does not
                   2942: 
                   2943: =cut
1.66      www      2944: 
                   2945: sub nickname {
                   2946:     my ($uname,$udom)=@_;
1.537     albertel 2947:     return if (!defined($uname) || !defined($udom));
1.295     www      2948:     my %names=&getnames($uname,$udom);
1.68      albertel 2949:     my $name=$names{'nickname'};
1.66      www      2950:     if ($name) {
                   2951:        $name='&quot;'.$name.'&quot;'; 
                   2952:     } else {
                   2953:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2954: 	     $names{'lastname'}.' '.$names{'generation'};
                   2955:        $name=~s/\s+$//;
                   2956:        $name=~s/\s+/ /g;
                   2957:     }
                   2958:     return $name;
                   2959: }
                   2960: 
1.295     www      2961: sub getnames {
                   2962:     my ($uname,$udom)=@_;
1.537     albertel 2963:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2964:     if ($udom eq 'public' && $uname eq 'public') {
                   2965: 	return ('lastname' => &mt('Public'));
                   2966:     }
1.295     www      2967:     my $id=$uname.':'.$udom;
                   2968:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2969:     if ($cached) {
                   2970: 	return %{$names};
                   2971:     } else {
                   2972: 	my %loadnames=&Apache::lonnet::get('environment',
                   2973:                     ['firstname','middlename','lastname','generation','nickname'],
                   2974: 					 $udom,$uname);
                   2975: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2976: 	return %loadnames;
                   2977:     }
                   2978: }
1.61      www      2979: 
1.542     raeburn  2980: # -------------------------------------------------------------------- getemails
1.648     raeburn  2981: 
1.542     raeburn  2982: =pod
                   2983: 
1.648     raeburn  2984: =item * &getemails($uname,$udom)
1.542     raeburn  2985: 
                   2986: Gets a user's email information and returns it as a hash with keys:
                   2987: notification, critnotification, permanentemail
                   2988: 
                   2989: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2990: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2991:  
1.648     raeburn  2992: 
1.542     raeburn  2993: =cut
                   2994: 
1.648     raeburn  2995: 
1.466     albertel 2996: sub getemails {
                   2997:     my ($uname,$udom)=@_;
                   2998:     if ($udom eq 'public' && $uname eq 'public') {
                   2999: 	return;
                   3000:     }
1.467     www      3001:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3002:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3003:     my $id=$uname.':'.$udom;
                   3004:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3005:     if ($cached) {
                   3006: 	return %{$names};
                   3007:     } else {
                   3008: 	my %loadnames=&Apache::lonnet::get('environment',
                   3009:                     			   ['notification','critnotification',
                   3010: 					    'permanentemail'],
                   3011: 					   $udom,$uname);
                   3012: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3013: 	return %loadnames;
                   3014:     }
                   3015: }
                   3016: 
1.551     albertel 3017: sub flush_email_cache {
                   3018:     my ($uname,$udom)=@_;
                   3019:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3020:     if (!$uname) { $uname=$env{'user.name'};   }
                   3021:     return if ($udom eq 'public' && $uname eq 'public');
                   3022:     my $id=$uname.':'.$udom;
                   3023:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3024: }
                   3025: 
1.728     raeburn  3026: # -------------------------------------------------------------------- getlangs
                   3027: 
                   3028: =pod
                   3029: 
                   3030: =item * &getlangs($uname,$udom)
                   3031: 
                   3032: Gets a user's language preference and returns it as a hash with key:
                   3033: language.
                   3034: 
                   3035: =cut
                   3036: 
                   3037: 
                   3038: sub getlangs {
                   3039:     my ($uname,$udom) = @_;
                   3040:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3041:     if (!$uname) { $uname=$env{'user.name'};   }
                   3042:     my $id=$uname.':'.$udom;
                   3043:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3044:     if ($cached) {
                   3045:         return %{$langs};
                   3046:     } else {
                   3047:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3048:                                            $udom,$uname);
                   3049:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3050:         return %loadlangs;
                   3051:     }
                   3052: }
                   3053: 
                   3054: sub flush_langs_cache {
                   3055:     my ($uname,$udom)=@_;
                   3056:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3057:     if (!$uname) { $uname=$env{'user.name'};   }
                   3058:     return if ($udom eq 'public' && $uname eq 'public');
                   3059:     my $id=$uname.':'.$udom;
                   3060:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3061: }
                   3062: 
1.61      www      3063: # ------------------------------------------------------------------ Screenname
1.81      albertel 3064: 
                   3065: =pod
                   3066: 
1.648     raeburn  3067: =item * &screenname($uname,$udom)
1.81      albertel 3068: 
                   3069: Gets a users screenname and returns it as a string
                   3070: 
                   3071: =cut
1.61      www      3072: 
                   3073: sub screenname {
                   3074:     my ($uname,$udom)=@_;
1.258     albertel 3075:     if ($uname eq $env{'user.name'} &&
                   3076: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3077:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3078:     return $names{'screenname'};
1.62      www      3079: }
                   3080: 
1.212     albertel 3081: 
1.802     bisitz   3082: # ------------------------------------------------------------- Confirm Wrapper
                   3083: =pod
                   3084: 
                   3085: =item confirmwrapper
                   3086: 
                   3087: Wrap messages about completion of operation in box
                   3088: 
                   3089: =cut
                   3090: 
                   3091: sub confirmwrapper {
                   3092:     my ($message)=@_;
                   3093:     if ($message) {
                   3094:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3095:                .$message."\n"
                   3096:                .'</div>'."\n";
                   3097:     } else {
                   3098:         return $message;
                   3099:     }
                   3100: }
                   3101: 
1.62      www      3102: # ------------------------------------------------------------- Message Wrapper
                   3103: 
                   3104: sub messagewrapper {
1.369     www      3105:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3106:     return 
1.441     albertel 3107:         '<a href="/adm/email?compose=individual&amp;'.
                   3108:         'recname='.$username.'&amp;recdom='.$domain.
                   3109: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3110:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3111: }
1.802     bisitz   3112: 
1.74      www      3113: # --------------------------------------------------------------- Notes Wrapper
                   3114: 
                   3115: sub noteswrapper {
                   3116:     my ($link,$un,$do)=@_;
                   3117:     return 
1.896     amueller 3118: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3119: }
1.802     bisitz   3120: 
1.62      www      3121: # ------------------------------------------------------------- Aboutme Wrapper
                   3122: 
                   3123: sub aboutmewrapper {
1.166     www      3124:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  3125:     if (!defined($username)  && !defined($domain)) {
                   3126:         return;
                   3127:     }
1.892     amueller 3128:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756     weissno  3129: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3130: }
                   3131: 
                   3132: # ------------------------------------------------------------ Syllabus Wrapper
                   3133: 
                   3134: sub syllabuswrapper {
1.707     bisitz   3135:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3136:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3137: }
1.14      harris41 3138: 
1.802     bisitz   3139: # -----------------------------------------------------------------------------
                   3140: 
1.208     matthew  3141: sub track_student_link {
1.887     raeburn  3142:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3143:     my $link ="/adm/trackstudent?";
1.208     matthew  3144:     my $title = 'View recent activity';
                   3145:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3146:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3147:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3148:         $title .= ' of this student';
1.268     albertel 3149:     } 
1.208     matthew  3150:     if (defined($target) && $target !~ /^\s*$/) {
                   3151:         $target = qq{target="$target"};
                   3152:     } else {
                   3153:         $target = '';
                   3154:     }
1.268     albertel 3155:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3156:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3157:     $title = &mt($title);
                   3158:     $linktext = &mt($linktext);
1.448     albertel 3159:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3160: 	&help_open_topic('View_recent_activity');
1.208     matthew  3161: }
                   3162: 
1.781     raeburn  3163: sub slot_reservations_link {
                   3164:     my ($linktext,$sname,$sdom,$target) = @_;
                   3165:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3166:     my $title = 'View slot reservation history';
                   3167:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3168:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3169:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3170:         $title .= ' of this student';
                   3171:     }
                   3172:     if (defined($target) && $target !~ /^\s*$/) {
                   3173:         $target = qq{target="$target"};
                   3174:     } else {
                   3175:         $target = '';
                   3176:     }
                   3177:     $title = &mt($title);
                   3178:     $linktext = &mt($linktext);
                   3179:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3180: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3181: 
                   3182: }
                   3183: 
1.508     www      3184: # ===================================================== Display a student photo
                   3185: 
                   3186: 
1.509     albertel 3187: sub student_image_tag {
1.508     www      3188:     my ($domain,$user)=@_;
                   3189:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3190:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3191: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3192:     } else {
                   3193: 	return '';
                   3194:     }
                   3195: }
                   3196: 
1.112     bowersj2 3197: =pod
                   3198: 
                   3199: =back
                   3200: 
                   3201: =head1 Access .tab File Data
                   3202: 
                   3203: =over 4
                   3204: 
1.648     raeburn  3205: =item * &languageids() 
1.112     bowersj2 3206: 
                   3207: returns list of all language ids
                   3208: 
                   3209: =cut
                   3210: 
1.14      harris41 3211: sub languageids {
1.16      harris41 3212:     return sort(keys(%language));
1.14      harris41 3213: }
                   3214: 
1.112     bowersj2 3215: =pod
                   3216: 
1.648     raeburn  3217: =item * &languagedescription() 
1.112     bowersj2 3218: 
                   3219: returns description of a specified language id
                   3220: 
                   3221: =cut
                   3222: 
1.14      harris41 3223: sub languagedescription {
1.125     www      3224:     my $code=shift;
                   3225:     return  ($supported_language{$code}?'* ':'').
                   3226:             $language{$code}.
1.126     www      3227: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3228: }
                   3229: 
                   3230: sub plainlanguagedescription {
                   3231:     my $code=shift;
                   3232:     return $language{$code};
                   3233: }
                   3234: 
                   3235: sub supportedlanguagecode {
                   3236:     my $code=shift;
                   3237:     return $supported_language{$code};
1.97      www      3238: }
                   3239: 
1.112     bowersj2 3240: =pod
                   3241: 
1.648     raeburn  3242: =item * &copyrightids() 
1.112     bowersj2 3243: 
                   3244: returns list of all copyrights
                   3245: 
                   3246: =cut
                   3247: 
                   3248: sub copyrightids {
                   3249:     return sort(keys(%cprtag));
                   3250: }
                   3251: 
                   3252: =pod
                   3253: 
1.648     raeburn  3254: =item * &copyrightdescription() 
1.112     bowersj2 3255: 
                   3256: returns description of a specified copyright id
                   3257: 
                   3258: =cut
                   3259: 
                   3260: sub copyrightdescription {
1.166     www      3261:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3262: }
1.197     matthew  3263: 
                   3264: =pod
                   3265: 
1.648     raeburn  3266: =item * &source_copyrightids() 
1.192     taceyjo1 3267: 
                   3268: returns list of all source copyrights
                   3269: 
                   3270: =cut
                   3271: 
                   3272: sub source_copyrightids {
                   3273:     return sort(keys(%scprtag));
                   3274: }
                   3275: 
                   3276: =pod
                   3277: 
1.648     raeburn  3278: =item * &source_copyrightdescription() 
1.192     taceyjo1 3279: 
                   3280: returns description of a specified source copyright id
                   3281: 
                   3282: =cut
                   3283: 
                   3284: sub source_copyrightdescription {
                   3285:     return &mt($scprtag{shift(@_)});
                   3286: }
1.112     bowersj2 3287: 
                   3288: =pod
                   3289: 
1.648     raeburn  3290: =item * &filecategories() 
1.112     bowersj2 3291: 
                   3292: returns list of all file categories
                   3293: 
                   3294: =cut
                   3295: 
                   3296: sub filecategories {
                   3297:     return sort(keys(%category_extensions));
                   3298: }
                   3299: 
                   3300: =pod
                   3301: 
1.648     raeburn  3302: =item * &filecategorytypes() 
1.112     bowersj2 3303: 
                   3304: returns list of file types belonging to a given file
                   3305: category
                   3306: 
                   3307: =cut
                   3308: 
                   3309: sub filecategorytypes {
1.356     albertel 3310:     my ($cat) = @_;
                   3311:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3312: }
                   3313: 
                   3314: =pod
                   3315: 
1.648     raeburn  3316: =item * &fileembstyle() 
1.112     bowersj2 3317: 
                   3318: returns embedding style for a specified file type
                   3319: 
                   3320: =cut
                   3321: 
                   3322: sub fileembstyle {
                   3323:     return $fe{lc(shift(@_))};
1.169     www      3324: }
                   3325: 
1.351     www      3326: sub filemimetype {
                   3327:     return $fm{lc(shift(@_))};
                   3328: }
                   3329: 
1.169     www      3330: 
                   3331: sub filecategoryselect {
                   3332:     my ($name,$value)=@_;
1.189     matthew  3333:     return &select_form($value,$name,
1.970     raeburn  3334:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3335: }
                   3336: 
                   3337: =pod
                   3338: 
1.648     raeburn  3339: =item * &filedescription() 
1.112     bowersj2 3340: 
                   3341: returns description for a specified file type
                   3342: 
                   3343: =cut
                   3344: 
                   3345: sub filedescription {
1.188     matthew  3346:     my $file_description = $fd{lc(shift())};
                   3347:     $file_description =~ s:([\[\]]):~$1:g;
                   3348:     return &mt($file_description);
1.112     bowersj2 3349: }
                   3350: 
                   3351: =pod
                   3352: 
1.648     raeburn  3353: =item * &filedescriptionex() 
1.112     bowersj2 3354: 
                   3355: returns description for a specified file type with
                   3356: extra formatting
                   3357: 
                   3358: =cut
                   3359: 
                   3360: sub filedescriptionex {
                   3361:     my $ex=shift;
1.188     matthew  3362:     my $file_description = $fd{lc($ex)};
                   3363:     $file_description =~ s:([\[\]]):~$1:g;
                   3364:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3365: }
                   3366: 
                   3367: # End of .tab access
                   3368: =pod
                   3369: 
                   3370: =back
                   3371: 
                   3372: =cut
                   3373: 
                   3374: # ------------------------------------------------------------------ File Types
                   3375: sub fileextensions {
                   3376:     return sort(keys(%fe));
                   3377: }
                   3378: 
1.97      www      3379: # ----------------------------------------------------------- Display Languages
                   3380: # returns a hash with all desired display languages
                   3381: #
                   3382: 
                   3383: sub display_languages {
                   3384:     my %languages=();
1.695     raeburn  3385:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3386: 	$languages{$lang}=1;
1.97      www      3387:     }
                   3388:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3389:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3390: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3391: 	    $languages{$lang}=1;
1.97      www      3392:         }
                   3393:     }
                   3394:     return %languages;
1.14      harris41 3395: }
                   3396: 
1.582     albertel 3397: sub languages {
                   3398:     my ($possible_langs) = @_;
1.695     raeburn  3399:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3400:     if (!ref($possible_langs)) {
                   3401: 	if( wantarray ) {
                   3402: 	    return @preferred_langs;
                   3403: 	} else {
                   3404: 	    return $preferred_langs[0];
                   3405: 	}
                   3406:     }
                   3407:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3408:     my @preferred_possibilities;
                   3409:     foreach my $preferred_lang (@preferred_langs) {
                   3410: 	if (exists($possibilities{$preferred_lang})) {
                   3411: 	    push(@preferred_possibilities, $preferred_lang);
                   3412: 	}
                   3413:     }
                   3414:     if( wantarray ) {
                   3415: 	return @preferred_possibilities;
                   3416:     }
                   3417:     return $preferred_possibilities[0];
                   3418: }
                   3419: 
1.742     raeburn  3420: sub user_lang {
                   3421:     my ($touname,$toudom,$fromcid) = @_;
                   3422:     my @userlangs;
                   3423:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3424:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3425:                     $env{'course.'.$fromcid.'.languages'}));
                   3426:     } else {
                   3427:         my %langhash = &getlangs($touname,$toudom);
                   3428:         if ($langhash{'languages'} ne '') {
                   3429:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3430:         } else {
                   3431:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3432:             if ($domdefs{'lang_def'} ne '') {
                   3433:                 @userlangs = ($domdefs{'lang_def'});
                   3434:             }
                   3435:         }
                   3436:     }
                   3437:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3438:     my $user_lh = Apache::localize->get_handle(@languages);
                   3439:     return $user_lh;
                   3440: }
                   3441: 
                   3442: 
1.112     bowersj2 3443: ###############################################################
                   3444: ##               Student Answer Attempts                     ##
                   3445: ###############################################################
                   3446: 
                   3447: =pod
                   3448: 
                   3449: =head1 Alternate Problem Views
                   3450: 
                   3451: =over 4
                   3452: 
1.648     raeburn  3453: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3454:     $getattempt, $regexp, $gradesub)
                   3455: 
                   3456: Return string with previous attempt on problem. Arguments:
                   3457: 
                   3458: =over 4
                   3459: 
                   3460: =item * $symb: Problem, including path
                   3461: 
                   3462: =item * $username: username of the desired student
                   3463: 
                   3464: =item * $domain: domain of the desired student
1.14      harris41 3465: 
1.112     bowersj2 3466: =item * $course: Course ID
1.14      harris41 3467: 
1.112     bowersj2 3468: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3469:     something
1.14      harris41 3470: 
1.112     bowersj2 3471: =item * $regexp: if string matches this regexp, the string will be
                   3472:     sent to $gradesub
1.14      harris41 3473: 
1.112     bowersj2 3474: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3475: 
1.112     bowersj2 3476: =back
1.14      harris41 3477: 
1.112     bowersj2 3478: The output string is a table containing all desired attempts, if any.
1.16      harris41 3479: 
1.112     bowersj2 3480: =cut
1.1       albertel 3481: 
                   3482: sub get_previous_attempt {
1.43      ng       3483:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3484:   my $prevattempts='';
1.43      ng       3485:   no strict 'refs';
1.1       albertel 3486:   if ($symb) {
1.3       albertel 3487:     my (%returnhash)=
                   3488:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3489:     if ($returnhash{'version'}) {
                   3490:       my %lasthash=();
                   3491:       my $version;
                   3492:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3493:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3494: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3495:         }
1.1       albertel 3496:       }
1.596     albertel 3497:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3498:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3499:       my (%typeparts,%lasthidden);
1.945     raeburn  3500:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3501:       foreach my $key (sort(keys(%lasthash))) {
                   3502: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3503: 	if ($#parts > 0) {
1.31      albertel 3504: 	  my $data=$parts[-1];
1.989     raeburn  3505:           next if ($data eq 'foilorder');
1.31      albertel 3506: 	  pop(@parts);
1.1010    www      3507:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3508:           if ($data eq 'type') {
                   3509:               unless ($showsurv) {
                   3510:                   my $id = join(',',@parts);
                   3511:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3512:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3513:                       $lasthidden{$ign.'.'.$id} = 1;
                   3514:                   }
1.945     raeburn  3515:               }
1.1010    www      3516:           } 
1.31      albertel 3517: 	} else {
1.41      ng       3518: 	  if ($#parts == 0) {
                   3519: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3520: 	  } else {
                   3521: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3522: 	  }
1.31      albertel 3523: 	}
1.16      harris41 3524:       }
1.596     albertel 3525:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3526:       if ($getattempt eq '') {
                   3527: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3528:             my @hidden;
                   3529:             if (%typeparts) {
                   3530:                 foreach my $id (keys(%typeparts)) {
                   3531:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3532:                         push(@hidden,$id);
                   3533:                     }
                   3534:                 }
                   3535:             }
                   3536:             $prevattempts.=&start_data_table_row().
                   3537:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3538:             if (@hidden) {
                   3539:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3540:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3541:                     my $hide;
                   3542:                     foreach my $id (@hidden) {
                   3543:                         if ($key =~ /^\Q$id\E/) {
                   3544:                             $hide = 1;
                   3545:                             last;
                   3546:                         }
                   3547:                     }
                   3548:                     if ($hide) {
                   3549:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3550:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3551:                             my $value = &format_previous_attempt_value($key,
                   3552:                                              $returnhash{$version.':'.$key});
                   3553:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3554:                         } else {
                   3555:                             $prevattempts.='<td>&nbsp;</td>';
                   3556:                         }
                   3557:                     } else {
                   3558:                         if ($key =~ /\./) {
                   3559:                             my $value = &format_previous_attempt_value($key,
                   3560:                                               $returnhash{$version.':'.$key});
                   3561:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3562:                         } else {
                   3563:                             $prevattempts.='<td>&nbsp;</td>';
                   3564:                         }
                   3565:                     }
                   3566:                 }
                   3567:             } else {
                   3568: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3569:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3570: 		    my $value = &format_previous_attempt_value($key,
                   3571: 			            $returnhash{$version.':'.$key});
                   3572: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3573: 	        }
                   3574:             }
                   3575: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3576: 	 }
1.1       albertel 3577:       }
1.945     raeburn  3578:       my @currhidden = keys(%lasthidden);
1.596     albertel 3579:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3580:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3581:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3582:           if (%typeparts) {
                   3583:               my $hidden;
                   3584:               foreach my $id (@currhidden) {
                   3585:                   if ($key =~ /^\Q$id\E/) {
                   3586:                       $hidden = 1;
                   3587:                       last;
                   3588:                   }
                   3589:               }
                   3590:               if ($hidden) {
                   3591:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3592:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3593:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3594:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3595:                           $value = &$gradesub($value);
                   3596:                       }
                   3597:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3598:                   } else {
                   3599:                       $prevattempts.='<td>&nbsp;</td>';
                   3600:                   }
                   3601:               } else {
                   3602:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3603:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3604:                       $value = &$gradesub($value);
                   3605:                   }
                   3606:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3607:               }
                   3608:           } else {
                   3609: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3610: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3611:                   $value = &$gradesub($value);
                   3612:               }
                   3613: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3614:           }
1.16      harris41 3615:       }
1.596     albertel 3616:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3617:     } else {
1.596     albertel 3618:       $prevattempts=
                   3619: 	  &start_data_table().&start_data_table_row().
                   3620: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3621: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3622:     }
                   3623:   } else {
1.596     albertel 3624:     $prevattempts=
                   3625: 	  &start_data_table().&start_data_table_row().
                   3626: 	  '<td>'.&mt('No data.').'</td>'.
                   3627: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3628:   }
1.10      albertel 3629: }
                   3630: 
1.581     albertel 3631: sub format_previous_attempt_value {
                   3632:     my ($key,$value) = @_;
1.1011    www      3633:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3634: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3635:     } elsif (ref($value) eq 'ARRAY') {
                   3636: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3637:     } elsif ($key =~ /answerstring$/) {
                   3638:         my %answers = &Apache::lonnet::str2hash($value);
                   3639:         my @anskeys = sort(keys(%answers));
                   3640:         if (@anskeys == 1) {
                   3641:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3642:             if ($answer =~ m{\0}) {
                   3643:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3644:             }
                   3645:             my $tag_internal_answer_name = 'INTERNAL';
                   3646:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3647:                 $value = $answer; 
                   3648:             } else {
                   3649:                 $value = $anskeys[0].'='.$answer;
                   3650:             }
                   3651:         } else {
                   3652:             foreach my $ans (@anskeys) {
                   3653:                 my $answer = $answers{$ans};
1.1001    raeburn  3654:                 if ($answer =~ m{\0}) {
                   3655:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3656:                 }
                   3657:                 $value .=  $ans.'='.$answer.'<br />';;
                   3658:             } 
                   3659:         }
1.581     albertel 3660:     } else {
                   3661: 	$value = &unescape($value);
                   3662:     }
                   3663:     return $value;
                   3664: }
                   3665: 
                   3666: 
1.107     albertel 3667: sub relative_to_absolute {
                   3668:     my ($url,$output)=@_;
                   3669:     my $parser=HTML::TokeParser->new(\$output);
                   3670:     my $token;
                   3671:     my $thisdir=$url;
                   3672:     my @rlinks=();
                   3673:     while ($token=$parser->get_token) {
                   3674: 	if ($token->[0] eq 'S') {
                   3675: 	    if ($token->[1] eq 'a') {
                   3676: 		if ($token->[2]->{'href'}) {
                   3677: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3678: 		}
                   3679: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3680: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3681: 	    } elsif ($token->[1] eq 'base') {
                   3682: 		$thisdir=$token->[2]->{'href'};
                   3683: 	    }
                   3684: 	}
                   3685:     }
                   3686:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3687:     foreach my $link (@rlinks) {
1.726     raeburn  3688: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3689: 		($link=~/^\//) ||
                   3690: 		($link=~/^javascript:/i) ||
                   3691: 		($link=~/^mailto:/i) ||
                   3692: 		($link=~/^\#/)) {
                   3693: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3694: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3695: 	}
                   3696:     }
                   3697: # -------------------------------------------------- Deal with Applet codebases
                   3698:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3699:     return $output;
                   3700: }
                   3701: 
1.112     bowersj2 3702: =pod
                   3703: 
1.648     raeburn  3704: =item * &get_student_view()
1.112     bowersj2 3705: 
                   3706: show a snapshot of what student was looking at
                   3707: 
                   3708: =cut
                   3709: 
1.10      albertel 3710: sub get_student_view {
1.186     albertel 3711:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3712:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3713:   my (%form);
1.10      albertel 3714:   my @elements=('symb','courseid','domain','username');
                   3715:   foreach my $element (@elements) {
1.186     albertel 3716:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3717:   }
1.186     albertel 3718:   if (defined($moreenv)) {
                   3719:       %form=(%form,%{$moreenv});
                   3720:   }
1.236     albertel 3721:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3722:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3723:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3724:   $userview=~s/\<body[^\>]*\>//gi;
                   3725:   $userview=~s/\<\/body\>//gi;
                   3726:   $userview=~s/\<html\>//gi;
                   3727:   $userview=~s/\<\/html\>//gi;
                   3728:   $userview=~s/\<head\>//gi;
                   3729:   $userview=~s/\<\/head\>//gi;
                   3730:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3731:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3732:   if (wantarray) {
                   3733:      return ($userview,$response);
                   3734:   } else {
                   3735:      return $userview;
                   3736:   }
                   3737: }
                   3738: 
                   3739: sub get_student_view_with_retries {
                   3740:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3741: 
                   3742:     my $ok = 0;                 # True if we got a good response.
                   3743:     my $content;
                   3744:     my $response;
                   3745: 
                   3746:     # Try to get the student_view done. within the retries count:
                   3747:     
                   3748:     do {
                   3749:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3750:          $ok      = $response->is_success;
                   3751:          if (!$ok) {
                   3752:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3753:          }
                   3754:          $retries--;
                   3755:     } while (!$ok && ($retries > 0));
                   3756:     
                   3757:     if (!$ok) {
                   3758:        $content = '';          # On error return an empty content.
                   3759:     }
1.651     www      3760:     if (wantarray) {
                   3761:        return ($content, $response);
                   3762:     } else {
                   3763:        return $content;
                   3764:     }
1.11      albertel 3765: }
                   3766: 
1.112     bowersj2 3767: =pod
                   3768: 
1.648     raeburn  3769: =item * &get_student_answers() 
1.112     bowersj2 3770: 
                   3771: show a snapshot of how student was answering problem
                   3772: 
                   3773: =cut
                   3774: 
1.11      albertel 3775: sub get_student_answers {
1.100     sakharuk 3776:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3777:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3778:   my (%moreenv);
1.11      albertel 3779:   my @elements=('symb','courseid','domain','username');
                   3780:   foreach my $element (@elements) {
1.186     albertel 3781:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3782:   }
1.186     albertel 3783:   $moreenv{'grade_target'}='answer';
                   3784:   %moreenv=(%form,%moreenv);
1.497     raeburn  3785:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3786:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3787:   return $userview;
1.1       albertel 3788: }
1.116     albertel 3789: 
                   3790: =pod
                   3791: 
                   3792: =item * &submlink()
                   3793: 
1.242     albertel 3794: Inputs: $text $uname $udom $symb $target
1.116     albertel 3795: 
                   3796: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3797: 
                   3798: =cut
                   3799: 
                   3800: ###############################################
                   3801: sub submlink {
1.242     albertel 3802:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3803:     if (!($uname && $udom)) {
                   3804: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3805: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3806: 	if (!$symb) { $symb=$cursymb; }
                   3807:     }
1.254     matthew  3808:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3809:     $symb=&escape($symb);
1.960     bisitz   3810:     if ($target) { $target=" target=\"$target\""; }
                   3811:     return
                   3812:         '<a href="/adm/grades?command=submission'.
                   3813:         '&amp;symb='.$symb.
                   3814:         '&amp;student='.$uname.
                   3815:         '&amp;userdom='.$udom.'"'.
                   3816:         $target.'>'.$text.'</a>';
1.242     albertel 3817: }
                   3818: ##############################################
                   3819: 
                   3820: =pod
                   3821: 
                   3822: =item * &pgrdlink()
                   3823: 
                   3824: Inputs: $text $uname $udom $symb $target
                   3825: 
                   3826: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3827: 
                   3828: =cut
                   3829: 
                   3830: ###############################################
                   3831: sub pgrdlink {
                   3832:     my $link=&submlink(@_);
                   3833:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3834:     return $link;
                   3835: }
                   3836: ##############################################
                   3837: 
                   3838: =pod
                   3839: 
                   3840: =item * &pprmlink()
                   3841: 
                   3842: Inputs: $text $uname $udom $symb $target
                   3843: 
                   3844: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3845: student and a specific resource
1.242     albertel 3846: 
                   3847: =cut
                   3848: 
                   3849: ###############################################
                   3850: sub pprmlink {
                   3851:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3852:     if (!($uname && $udom)) {
                   3853: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3854: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3855: 	if (!$symb) { $symb=$cursymb; }
                   3856:     }
1.254     matthew  3857:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3858:     $symb=&escape($symb);
1.242     albertel 3859:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3860:     return '<a href="/adm/parmset?command=set&amp;'.
                   3861: 	'symb='.$symb.'&amp;uname='.$uname.
                   3862: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3863: }
                   3864: ##############################################
1.37      matthew  3865: 
1.112     bowersj2 3866: =pod
                   3867: 
                   3868: =back
                   3869: 
                   3870: =cut
                   3871: 
1.37      matthew  3872: ###############################################
1.51      www      3873: 
                   3874: 
                   3875: sub timehash {
1.687     raeburn  3876:     my ($thistime) = @_;
                   3877:     my $timezone = &Apache::lonlocal::gettimezone();
                   3878:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3879:                      ->set_time_zone($timezone);
                   3880:     my $wday = $dt->day_of_week();
                   3881:     if ($wday == 7) { $wday = 0; }
                   3882:     return ( 'second' => $dt->second(),
                   3883:              'minute' => $dt->minute(),
                   3884:              'hour'   => $dt->hour(),
                   3885:              'day'     => $dt->day_of_month(),
                   3886:              'month'   => $dt->month(),
                   3887:              'year'    => $dt->year(),
                   3888:              'weekday' => $wday,
                   3889:              'dayyear' => $dt->day_of_year(),
                   3890:              'dlsav'   => $dt->is_dst() );
1.51      www      3891: }
                   3892: 
1.370     www      3893: sub utc_string {
                   3894:     my ($date)=@_;
1.371     www      3895:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3896: }
                   3897: 
1.51      www      3898: sub maketime {
                   3899:     my %th=@_;
1.687     raeburn  3900:     my ($epoch_time,$timezone,$dt);
                   3901:     $timezone = &Apache::lonlocal::gettimezone();
                   3902:     eval {
                   3903:         $dt = DateTime->new( year   => $th{'year'},
                   3904:                              month  => $th{'month'},
                   3905:                              day    => $th{'day'},
                   3906:                              hour   => $th{'hour'},
                   3907:                              minute => $th{'minute'},
                   3908:                              second => $th{'second'},
                   3909:                              time_zone => $timezone,
                   3910:                          );
                   3911:     };
                   3912:     if (!$@) {
                   3913:         $epoch_time = $dt->epoch;
                   3914:         if ($epoch_time) {
                   3915:             return $epoch_time;
                   3916:         }
                   3917:     }
1.51      www      3918:     return POSIX::mktime(
                   3919:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3920:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3921: }
                   3922: 
                   3923: #########################################
1.51      www      3924: 
                   3925: sub findallcourses {
1.482     raeburn  3926:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3927:     my %roles;
                   3928:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3929:     my %courses;
1.51      www      3930:     my $now=time;
1.482     raeburn  3931:     if (!defined($uname)) {
                   3932:         $uname = $env{'user.name'};
                   3933:     }
                   3934:     if (!defined($udom)) {
                   3935:         $udom = $env{'user.domain'};
                   3936:     }
                   3937:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.982     raeburn  3938:         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   3939:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
                   3940:                                               $extra);
1.482     raeburn  3941:         if (!%roles) {
                   3942:             %roles = (
                   3943:                        cc => 1,
1.907     raeburn  3944:                        co => 1,
1.482     raeburn  3945:                        in => 1,
                   3946:                        ep => 1,
                   3947:                        ta => 1,
                   3948:                        cr => 1,
                   3949:                        st => 1,
                   3950:              );
                   3951:         }
                   3952:         foreach my $entry (keys(%roleshash)) {
                   3953:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3954:             if ($trole =~ /^cr/) { 
                   3955:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3956:             } else {
                   3957:                 next if (!exists($roles{$trole}));
                   3958:             }
                   3959:             if ($tend) {
                   3960:                 next if ($tend < $now);
                   3961:             }
                   3962:             if ($tstart) {
                   3963:                 next if ($tstart > $now);
                   3964:             }
                   3965:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3966:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3967:             if ($secpart eq '') {
                   3968:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3969:                 $sec = 'none';
                   3970:                 $realsec = '';
                   3971:             } else {
                   3972:                 $cnum = $cnumpart;
                   3973:                 ($sec,$role) = split(/_/,$secpart);
                   3974:                 $realsec = $sec;
1.490     raeburn  3975:             }
1.482     raeburn  3976:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3977:         }
                   3978:     } else {
                   3979:         foreach my $key (keys(%env)) {
1.483     albertel 3980: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3981:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3982: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3983: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3984: 	        next if (%roles && !exists($roles{$role}));
                   3985: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3986:                 my $active=1;
                   3987:                 if ($starttime) {
                   3988: 		    if ($now<$starttime) { $active=0; }
                   3989:                 }
                   3990:                 if ($endtime) {
                   3991:                     if ($now>$endtime) { $active=0; }
                   3992:                 }
                   3993:                 if ($active) {
                   3994:                     if ($sec eq '') {
                   3995:                         $sec = 'none';
                   3996:                     }
                   3997:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   3998:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  3999:                 }
                   4000:             }
1.51      www      4001:         }
                   4002:     }
1.474     raeburn  4003:     return %courses;
1.51      www      4004: }
1.37      matthew  4005: 
1.54      www      4006: ###############################################
1.474     raeburn  4007: 
                   4008: sub blockcheck {
1.482     raeburn  4009:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  4010: 
                   4011:     if (!defined($udom)) {
                   4012:         $udom = $env{'user.domain'};
                   4013:     }
                   4014:     if (!defined($uname)) {
                   4015:         $uname = $env{'user.name'};
                   4016:     }
                   4017: 
                   4018:     # If uname and udom are for a course, check for blocks in the course.
                   4019: 
                   4020:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   4021:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  4022:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  4023:         return ($startblock,$endblock);
                   4024:     }
1.474     raeburn  4025: 
1.502     raeburn  4026:     my $startblock = 0;
                   4027:     my $endblock = 0;
1.482     raeburn  4028:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4029: 
1.490     raeburn  4030:     # If uname is for a user, and activity is course-specific, i.e.,
                   4031:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4032: 
1.490     raeburn  4033:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4034:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4035:         foreach my $key (keys(%live_courses)) {
                   4036:             if ($key ne $env{'request.course.id'}) {
                   4037:                 delete($live_courses{$key});
                   4038:             }
                   4039:         }
                   4040:     }
                   4041: 
                   4042:     my $otheruser = 0;
                   4043:     my %own_courses;
                   4044:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4045:         # Resource belongs to user other than current user.
                   4046:         $otheruser = 1;
                   4047:         # Gather courses for current user
                   4048:         %own_courses = 
                   4049:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4050:     }
                   4051: 
                   4052:     # Gather active course roles - course coordinator, instructor, 
                   4053:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4054: 
                   4055:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4056:         my ($cdom,$cnum);
                   4057:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4058:             $cdom = $env{'course.'.$course.'.domain'};
                   4059:             $cnum = $env{'course.'.$course.'.num'};
                   4060:         } else {
1.490     raeburn  4061:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4062:         }
                   4063:         my $no_ownblock = 0;
                   4064:         my $no_userblock = 0;
1.533     raeburn  4065:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4066:             # Check if current user has 'evb' priv for this
                   4067:             if (defined($own_courses{$course})) {
                   4068:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4069:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4070:                     if ($sec ne 'none') {
                   4071:                         $checkrole .= '/'.$sec;
                   4072:                     }
                   4073:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4074:                         $no_ownblock = 1;
                   4075:                         last;
                   4076:                     }
                   4077:                 }
                   4078:             }
                   4079:             # if they have 'evb' priv and are currently not playing student
                   4080:             next if (($no_ownblock) &&
                   4081:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4082:         }
1.474     raeburn  4083:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4084:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4085:             if ($sec ne 'none') {
1.482     raeburn  4086:                 $checkrole .= '/'.$sec;
1.474     raeburn  4087:             }
1.490     raeburn  4088:             if ($otheruser) {
                   4089:                 # Resource belongs to user other than current user.
                   4090:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  4091:                 my ($trole,$tdom,$tnum,$tsec);
                   4092:                 my $entry = $live_courses{$course}{$sec};
                   4093:                 if ($entry =~ /^cr/) {
                   4094:                     ($trole,$tdom,$tnum,$tsec) = 
                   4095:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4096:                 } else {
                   4097:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4098:                 }
                   4099:                 my ($spec,$area,$trest,%allroles,%userroles);
                   4100:                 $area = '/'.$tdom.'/'.$tnum;
                   4101:                 $trest = $tnum;
                   4102:                 if ($tsec ne '') {
                   4103:                     $area .= '/'.$tsec;
                   4104:                     $trest .= '/'.$tsec;
                   4105:                 }
                   4106:                 $spec = $trole.'.'.$area;
                   4107:                 if ($trole =~ /^cr/) {
                   4108:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4109:                                                       $tdom,$spec,$trest,$area);
                   4110:                 } else {
                   4111:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4112:                                                        $tdom,$spec,$trest,$area);
                   4113:                 }
                   4114:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  4115:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4116:                     if ($1) {
                   4117:                         $no_userblock = 1;
                   4118:                         last;
                   4119:                     }
                   4120:                 }
1.490     raeburn  4121:             } else {
                   4122:                 # Resource belongs to current user
                   4123:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4124:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4125:                     $no_ownblock = 1;
                   4126:                     last;
                   4127:                 }
1.474     raeburn  4128:             }
                   4129:         }
                   4130:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4131:         next if (($no_ownblock) &&
1.491     albertel 4132:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4133:         next if ($no_userblock);
1.474     raeburn  4134: 
1.866     kalberla 4135:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4136:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4137:         
                   4138:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   4139:         if (($start != 0) && 
                   4140:             (($startblock == 0) || ($startblock > $start))) {
                   4141:             $startblock = $start;
                   4142:         }
                   4143:         if (($end != 0)  &&
                   4144:             (($endblock == 0) || ($endblock < $end))) {
                   4145:             $endblock = $end;
                   4146:         }
1.490     raeburn  4147:     }
                   4148:     return ($startblock,$endblock);
                   4149: }
                   4150: 
                   4151: sub get_blocks {
                   4152:     my ($setters,$activity,$cdom,$cnum) = @_;
                   4153:     my $startblock = 0;
                   4154:     my $endblock = 0;
                   4155:     my $course = $cdom.'_'.$cnum;
                   4156:     $setters->{$course} = {};
                   4157:     $setters->{$course}{'staff'} = [];
                   4158:     $setters->{$course}{'times'} = [];
                   4159:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   4160:     foreach my $record (keys(%records)) {
                   4161:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   4162:         if ($start <= time && $end >= time) {
                   4163:             my ($staff_name,$staff_dom,$title,$blocks) =
                   4164:                 &parse_block_record($records{$record});
                   4165:             if ($blocks->{$activity} eq 'on') {
                   4166:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4167:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 4168:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   4169:                     $startblock = $start;
1.490     raeburn  4170:                 }
1.491     albertel 4171:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   4172:                     $endblock = $end;
1.474     raeburn  4173:                 }
                   4174:             }
                   4175:         }
                   4176:     }
                   4177:     return ($startblock,$endblock);
                   4178: }
                   4179: 
                   4180: sub parse_block_record {
                   4181:     my ($record) = @_;
                   4182:     my ($setuname,$setudom,$title,$blocks);
                   4183:     if (ref($record) eq 'HASH') {
                   4184:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4185:         $title = &unescape($record->{'event'});
                   4186:         $blocks = $record->{'blocks'};
                   4187:     } else {
                   4188:         my @data = split(/:/,$record,3);
                   4189:         if (scalar(@data) eq 2) {
                   4190:             $title = $data[1];
                   4191:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4192:         } else {
                   4193:             ($setuname,$setudom,$title) = @data;
                   4194:         }
                   4195:         $blocks = { 'com' => 'on' };
                   4196:     }
                   4197:     return ($setuname,$setudom,$title,$blocks);
                   4198: }
                   4199: 
1.854     kalberla 4200: sub blocking_status {
                   4201:   my ($activity,$uname,$udom) = @_;
1.867     kalberla 4202:   my %setters;
1.890     droeschl 4203: 
                   4204:   # check for active blocking
1.867     kalberla 4205:   my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854     kalberla 4206: 
1.890     droeschl 4207:   my $blocked = $startblock && $endblock ? 1 : 0;
                   4208: 
                   4209:   # caller just wants to know whether a block is active
                   4210:   if (!wantarray) { return $blocked; }
                   4211: 
                   4212:   # build a link to a popup window containing the details
                   4213:   my $querystring  = "?activity=$activity";
                   4214:   # $uname and $udom decide whose portfolio the user is trying to look at
                   4215:      $querystring .= "&amp;udom=$udom"      if $udom;
                   4216:      $querystring .= "&amp;uname=$uname"    if $uname;
                   4217: 
                   4218:   my $output .= <<'END_MYBLOCK';
1.854     kalberla 4219:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4220:         var options = "width=" + w + ",height=" + h + ",";
                   4221:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4222:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4223:         var newWin = window.open(url, wdwName, options);
                   4224:         newWin.focus();
                   4225:     }
1.890     droeschl 4226: END_MYBLOCK
1.854     kalberla 4227: 
1.890     droeschl 4228:   $output = Apache::lonhtmlcommon::scripttag($output);
                   4229:   
1.854     kalberla 4230:   my $popupUrl = "/adm/blockingstatus/$querystring";
1.890     droeschl 4231:   my $text = mt('Communication Blocked');
                   4232: 
1.867     kalberla 4233:   $output .= <<"END_BLOCK";
                   4234: <div class='LC_comblock'>
1.869     kalberla 4235:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4236:   title='$text'>
                   4237:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
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'>$text</a>
1.867     kalberla 4240: </div>
                   4241: 
                   4242: END_BLOCK
1.474     raeburn  4243: 
1.854     kalberla 4244:   return ($blocked, $output);
                   4245: }
1.490     raeburn  4246: 
1.60      matthew  4247: ###############################################
                   4248: 
1.682     raeburn  4249: sub check_ip_acc {
                   4250:     my ($acc)=@_;
                   4251:     &Apache::lonxml::debug("acc is $acc");
                   4252:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4253:         return 1;
                   4254:     }
                   4255:     my $allowed=0;
                   4256:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4257: 
                   4258:     my $name;
                   4259:     foreach my $pattern (split(',',$acc)) {
                   4260:         $pattern =~ s/^\s*//;
                   4261:         $pattern =~ s/\s*$//;
                   4262:         if ($pattern =~ /\*$/) {
                   4263:             #35.8.*
                   4264:             $pattern=~s/\*//;
                   4265:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4266:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4267:             #35.8.3.[34-56]
                   4268:             my $low=$2;
                   4269:             my $high=$3;
                   4270:             $pattern=$1;
                   4271:             if ($ip =~ /^\Q$pattern\E/) {
                   4272:                 my $last=(split(/\./,$ip))[3];
                   4273:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4274:             }
                   4275:         } elsif ($pattern =~ /^\*/) {
                   4276:             #*.msu.edu
                   4277:             $pattern=~s/\*//;
                   4278:             if (!defined($name)) {
                   4279:                 use Socket;
                   4280:                 my $netaddr=inet_aton($ip);
                   4281:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4282:             }
                   4283:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4284:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4285:             #127.0.0.1
                   4286:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4287:         } else {
                   4288:             #some.name.com
                   4289:             if (!defined($name)) {
                   4290:                 use Socket;
                   4291:                 my $netaddr=inet_aton($ip);
                   4292:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4293:             }
                   4294:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4295:         }
                   4296:         if ($allowed) { last; }
                   4297:     }
                   4298:     return $allowed;
                   4299: }
                   4300: 
                   4301: ###############################################
                   4302: 
1.60      matthew  4303: =pod
                   4304: 
1.112     bowersj2 4305: =head1 Domain Template Functions
                   4306: 
                   4307: =over 4
                   4308: 
                   4309: =item * &determinedomain()
1.60      matthew  4310: 
                   4311: Inputs: $domain (usually will be undef)
                   4312: 
1.63      www      4313: Returns: Determines which domain should be used for designs
1.60      matthew  4314: 
                   4315: =cut
1.54      www      4316: 
1.60      matthew  4317: ###############################################
1.63      www      4318: sub determinedomain {
                   4319:     my $domain=shift;
1.531     albertel 4320:     if (! $domain) {
1.60      matthew  4321:         # Determine domain if we have not been given one
1.893     raeburn  4322:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4323:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4324:         if ($env{'request.role.domain'}) { 
                   4325:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4326:         }
                   4327:     }
1.63      www      4328:     return $domain;
                   4329: }
                   4330: ###############################################
1.517     raeburn  4331: 
1.518     albertel 4332: sub devalidate_domconfig_cache {
                   4333:     my ($udom)=@_;
                   4334:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4335: }
                   4336: 
                   4337: # ---------------------- Get domain configuration for a domain
                   4338: sub get_domainconf {
                   4339:     my ($udom) = @_;
                   4340:     my $cachetime=1800;
                   4341:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4342:     if (defined($cached)) { return %{$result}; }
                   4343: 
                   4344:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4345: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4346:     my (%designhash,%legacy);
1.518     albertel 4347:     if (keys(%domconfig) > 0) {
                   4348:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4349:             if (keys(%{$domconfig{'login'}})) {
                   4350:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4351:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4352:                         if ($key eq 'loginvia') {
                   4353:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4354:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4355:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4356:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4357:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4358:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4359:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4360: 
                   4361:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4362:                                             } else {
1.1013    raeburn  4363:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4364:                                             }
                   4365:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4366:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4367:                                             }
1.946     raeburn  4368:                                         }
                   4369:                                     }
                   4370:                                 }
                   4371:                             }
                   4372:                         } else {
                   4373:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4374:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4375:                                     $domconfig{'login'}{$key}{$img};
                   4376:                             }
1.699     raeburn  4377:                         }
                   4378:                     } else {
                   4379:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4380:                     }
1.632     raeburn  4381:                 }
                   4382:             } else {
                   4383:                 $legacy{'login'} = 1;
1.518     albertel 4384:             }
1.632     raeburn  4385:         } else {
                   4386:             $legacy{'login'} = 1;
1.518     albertel 4387:         }
                   4388:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4389:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4390:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4391:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4392:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4393:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4394:                         }
1.518     albertel 4395:                     }
                   4396:                 }
1.632     raeburn  4397:             } else {
                   4398:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4399:             }
1.632     raeburn  4400:         } else {
                   4401:             $legacy{'rolecolors'} = 1;
1.518     albertel 4402:         }
1.948     raeburn  4403:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4404:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4405:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4406:             }
                   4407:         }
1.632     raeburn  4408:         if (keys(%legacy) > 0) {
                   4409:             my %legacyhash = &get_legacy_domconf($udom);
                   4410:             foreach my $item (keys(%legacyhash)) {
                   4411:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4412:                     if ($legacy{'login'}) { 
                   4413:                         $designhash{$item} = $legacyhash{$item};
                   4414:                     }
                   4415:                 } else {
                   4416:                     if ($legacy{'rolecolors'}) {
                   4417:                         $designhash{$item} = $legacyhash{$item};
                   4418:                     }
1.518     albertel 4419:                 }
                   4420:             }
                   4421:         }
1.632     raeburn  4422:     } else {
                   4423:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4424:     }
                   4425:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4426: 				  $cachetime);
                   4427:     return %designhash;
                   4428: }
                   4429: 
1.632     raeburn  4430: sub get_legacy_domconf {
                   4431:     my ($udom) = @_;
                   4432:     my %legacyhash;
                   4433:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4434:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4435:     if (-e $designfile) {
                   4436:         if ( open (my $fh,"<$designfile") ) {
                   4437:             while (my $line = <$fh>) {
                   4438:                 next if ($line =~ /^\#/);
                   4439:                 chomp($line);
                   4440:                 my ($key,$val)=(split(/\=/,$line));
                   4441:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4442:             }
                   4443:             close($fh);
                   4444:         }
                   4445:     }
1.1026    raeburn  4446:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4447:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4448:     }
                   4449:     return %legacyhash;
                   4450: }
                   4451: 
1.63      www      4452: =pod
                   4453: 
1.112     bowersj2 4454: =item * &domainlogo()
1.63      www      4455: 
                   4456: Inputs: $domain (usually will be undef)
                   4457: 
                   4458: Returns: A link to a domain logo, if the domain logo exists.
                   4459: If the domain logo does not exist, a description of the domain.
                   4460: 
                   4461: =cut
1.112     bowersj2 4462: 
1.63      www      4463: ###############################################
                   4464: sub domainlogo {
1.517     raeburn  4465:     my $domain = &determinedomain(shift);
1.518     albertel 4466:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4467:     # See if there is a logo
                   4468:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4469:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4470:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4471: 	    if ($imgsrc =~ m{^/res/}) {
                   4472: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4473: 		&Apache::lonnet::repcopy($local_name);
                   4474: 	    }
                   4475: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4476:         } 
                   4477:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4478:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4479:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4480:     } else {
1.60      matthew  4481:         return '';
1.59      www      4482:     }
                   4483: }
1.63      www      4484: ##############################################
                   4485: 
                   4486: =pod
                   4487: 
1.112     bowersj2 4488: =item * &designparm()
1.63      www      4489: 
                   4490: Inputs: $which parameter; $domain (usually will be undef)
                   4491: 
                   4492: Returns: value of designparamter $which
                   4493: 
                   4494: =cut
1.112     bowersj2 4495: 
1.397     albertel 4496: 
1.400     albertel 4497: ##############################################
1.397     albertel 4498: sub designparm {
                   4499:     my ($which,$domain)=@_;
                   4500:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4501:         return $env{'environment.color.'.$which};
1.96      www      4502:     }
1.63      www      4503:     $domain=&determinedomain($domain);
1.1016    raeburn  4504:     my %domdesign;
                   4505:     unless ($domain eq 'public') {
                   4506:         %domdesign = &get_domainconf($domain);
                   4507:     }
1.520     raeburn  4508:     my $output;
1.517     raeburn  4509:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4510:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4511:     } else {
1.520     raeburn  4512:         $output = $defaultdesign{$which};
                   4513:     }
                   4514:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4515:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4516:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4517:             if ($output =~ m{^/res/}) {
                   4518:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4519:                 &Apache::lonnet::repcopy($local_name);
                   4520:             }
1.520     raeburn  4521:             $output = &lonhttpdurl($output);
                   4522:         }
1.63      www      4523:     }
1.520     raeburn  4524:     return $output;
1.63      www      4525: }
1.59      www      4526: 
1.822     bisitz   4527: ##############################################
                   4528: =pod
                   4529: 
1.832     bisitz   4530: =item * &authorspace()
                   4531: 
1.1028    raeburn  4532: Inputs: $url (usually will be undef).
1.832     bisitz   4533: 
1.1028    raeburn  4534: Returns: Path to Construction Space containing the resource or 
                   4535:          directory being viewed (or for which action is being taken). 
                   4536:          If $url is provided, and begins /priv/<domain>/<uname>
                   4537:          the path will be that portion of the $context argument.
                   4538:          Otherwise the path will be for the author space of the current
                   4539:          user when the current role is author, or for that of the 
                   4540:          co-author/assistant co-author space when the current role 
                   4541:          is co-author or assistant co-author.
1.832     bisitz   4542: 
                   4543: =cut
                   4544: 
                   4545: sub authorspace {
1.1028    raeburn  4546:     my ($url) = @_;
                   4547:     if ($url ne '') {
                   4548:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4549:            return $1;
                   4550:         }
                   4551:     }
1.832     bisitz   4552:     my $caname = '';
1.1024    www      4553:     my $cadom = '';
1.1028    raeburn  4554:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4555:         ($cadom,$caname) =
1.832     bisitz   4556:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4557:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4558:         $caname = $env{'user.name'};
1.1024    www      4559:         $cadom = $env{'user.domain'};
1.832     bisitz   4560:     }
1.1028    raeburn  4561:     if (($caname ne '') && ($cadom ne '')) {
                   4562:         return "/priv/$cadom/$caname/";
                   4563:     }
                   4564:     return;
1.832     bisitz   4565: }
                   4566: 
                   4567: ##############################################
                   4568: =pod
                   4569: 
1.822     bisitz   4570: =item * &head_subbox()
                   4571: 
                   4572: Inputs: $content (contains HTML code with page functions, etc.)
                   4573: 
                   4574: Returns: HTML div with $content
                   4575:          To be included in page header
                   4576: 
                   4577: =cut
                   4578: 
                   4579: sub head_subbox {
                   4580:     my ($content)=@_;
                   4581:     my $output =
1.993     raeburn  4582:         '<div class="LC_head_subbox">'
1.822     bisitz   4583:        .$content
                   4584:        .'</div>'
                   4585: }
                   4586: 
                   4587: ##############################################
                   4588: =pod
                   4589: 
                   4590: =item * &CSTR_pageheader()
                   4591: 
1.1026    raeburn  4592: Input: (optional) filename from which breadcrumb trail is built.
                   4593:        In most cases no input as needed, as $env{'request.filename'}
                   4594:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4595: 
                   4596: Returns: HTML div with CSTR path and recent box
                   4597:          To be included on Construction Space pages
                   4598: 
                   4599: =cut
                   4600: 
                   4601: sub CSTR_pageheader {
1.1026    raeburn  4602:     my ($trailfile) = @_;
                   4603:     if ($trailfile eq '') {
                   4604:         $trailfile = $env{'request.filename'};
                   4605:     }
                   4606: 
                   4607: # this is for resources; directories have customtitle, and crumbs
                   4608: # and select recent are created in lonpubdir.pm
                   4609: 
                   4610:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4611:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4612:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4613:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4614:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4615: 
                   4616:     my $parentpath = '';
                   4617:     my $lastitem = '';
                   4618:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4619:         $parentpath = $1;
                   4620:         $lastitem = $2;
                   4621:     } else {
                   4622:         $lastitem = $thisdisfn;
                   4623:     }
1.921     bisitz   4624: 
                   4625:     my $output =
1.822     bisitz   4626:          '<div>'
                   4627:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4628:         .'<b>'.&mt('Construction Space:').'</b> '
                   4629:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4630:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4631:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4632: 
                   4633:     if ($lastitem) {
                   4634:         $output .=
                   4635:              '<span class="LC_filename">'
                   4636:             .$lastitem
                   4637:             .'</span>';
                   4638:     }
                   4639:     $output .=
                   4640:          '<br />'
1.822     bisitz   4641:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4642:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4643:         .'</form>'
                   4644:         .&Apache::lonmenu::constspaceform()
                   4645:         .'</div>';
1.921     bisitz   4646: 
                   4647:     return $output;
1.822     bisitz   4648: }
                   4649: 
1.60      matthew  4650: ###############################################
                   4651: ###############################################
                   4652: 
                   4653: =pod
                   4654: 
1.112     bowersj2 4655: =back
                   4656: 
1.549     albertel 4657: =head1 HTML Helpers
1.112     bowersj2 4658: 
                   4659: =over 4
                   4660: 
                   4661: =item * &bodytag()
1.60      matthew  4662: 
                   4663: Returns a uniform header for LON-CAPA web pages.
                   4664: 
                   4665: Inputs: 
                   4666: 
1.112     bowersj2 4667: =over 4
                   4668: 
                   4669: =item * $title, A title to be displayed on the page.
                   4670: 
                   4671: =item * $function, the current role (can be undef).
                   4672: 
                   4673: =item * $addentries, extra parameters for the <body> tag.
                   4674: 
                   4675: =item * $bodyonly, if defined, only return the <body> tag.
                   4676: 
                   4677: =item * $domain, if defined, force a given domain.
                   4678: 
                   4679: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4680:             text interface only)
1.60      matthew  4681: 
1.814     bisitz   4682: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4683:                      navigational links
1.317     albertel 4684: 
1.338     albertel 4685: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4686: 
1.460     albertel 4687: =item * $args, optional argument valid values are
                   4688:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4689:             inherit_jsmath -> when creating popup window in a page,
                   4690:                               should it have jsmath forced on by the
                   4691:                               current page
1.460     albertel 4692: 
1.112     bowersj2 4693: =back
                   4694: 
1.60      matthew  4695: Returns: A uniform header for LON-CAPA web pages.  
                   4696: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4697: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4698: other decorations will be returned.
                   4699: 
                   4700: =cut
                   4701: 
1.54      www      4702: sub bodytag {
1.831     bisitz   4703:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962     droeschl 4704:         $no_nav_bar,$bgcolor,$args)=@_;
1.339     albertel 4705: 
1.954     raeburn  4706:     my $public;
                   4707:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4708:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4709:         $public = 1;
                   4710:     }
1.460     albertel 4711:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4712: 
1.183     matthew  4713:     $function = &get_users_function() if (!$function);
1.339     albertel 4714:     my $img =    &designparm($function.'.img',$domain);
                   4715:     my $font =   &designparm($function.'.font',$domain);
                   4716:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4717: 
1.803     bisitz   4718:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 4719: 		   'bgcolor' => $pgbg,
1.339     albertel 4720: 		   'text'    => $font,
                   4721:                    'alink'   => &designparm($function.'.alink',$domain),
                   4722: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4723: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4724:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4725: 
1.63      www      4726:  # role and realm
1.378     raeburn  4727:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4728:     if ($role  eq 'ca') {
1.479     albertel 4729:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4730:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4731:     } 
1.55      www      4732: # realm
1.258     albertel 4733:     if ($env{'request.course.id'}) {
1.378     raeburn  4734:         if ($env{'request.role'} !~ /^cr/) {
                   4735:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4736:         }
1.898     raeburn  4737:         if ($env{'request.course.sec'}) {
                   4738:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   4739:         }   
1.359     albertel 4740: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4741:     } else {
                   4742:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4743:     }
1.433     albertel 4744: 
1.359     albertel 4745:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 4746: 
1.438     albertel 4747:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4748: 
1.101     www      4749: # construct main body tag
1.359     albertel 4750:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4751: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4752: 
1.530     albertel 4753:     if ($bodyonly) {
1.60      matthew  4754:         return $bodytag;
1.798     tempelho 4755:     } 
1.359     albertel 4756: 
1.410     albertel 4757:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  4758:     if ($public) {
1.433     albertel 4759: 	undef($role);
1.434     albertel 4760:     } else {
                   4761: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 4762:     }
1.359     albertel 4763:     
1.762     bisitz   4764:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 4765:     #
                   4766:     # Extra info if you are the DC
                   4767:     my $dc_info = '';
                   4768:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4769:                         $env{'course.'.$env{'request.course.id'}.
                   4770:                                  '.domain'}.'/'})) {
                   4771:         my $cid = $env{'request.course.id'};
1.917     raeburn  4772:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4773:         $dc_info =~ s/\s+$//;
1.359     albertel 4774:     }
                   4775: 
1.898     raeburn  4776:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 4777:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   4778: 
1.916     droeschl 4779:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   4780:             return $bodytag; 
                   4781:         } 
1.903     droeschl 4782: 
                   4783:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   4784: 
                   4785:         #    if ($env{'request.state'} eq 'construct') {
                   4786:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   4787:         #    }
                   4788: 
1.359     albertel 4789: 
                   4790: 
1.916     droeschl 4791:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  4792:              if ($dc_info) {
                   4793:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   4794:              }
1.916     droeschl 4795:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   4796:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 4797:             return $bodytag;
                   4798:         }
1.894     droeschl 4799: 
1.927     raeburn  4800:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   4801:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   4802:         }
1.916     droeschl 4803: 
1.903     droeschl 4804:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   4805:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   4806: 
1.903     droeschl 4807:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 4808: 
1.917     raeburn  4809:         if ($dc_info) {
                   4810:             $dc_info = &dc_courseid_toggle($dc_info);
                   4811:         }
                   4812:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 4813: 
1.903     droeschl 4814:         #don't show menus for public users
1.954     raeburn  4815:         if (!$public){
1.903     droeschl 4816:             $bodytag .= Apache::lonmenu::secondary_menu();
                   4817:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  4818:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   4819:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 4820:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  4821:                                 $args->{'bread_crumbs'});
                   4822:             } elsif ($forcereg) { 
                   4823:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   4824:             }
1.903     droeschl 4825:         }else{
                   4826:             # this is to seperate menu from content when there's no secondary
                   4827:             # menu. Especially needed for public accessible ressources.
                   4828:             $bodytag .= '<hr style="clear:both" />';
                   4829:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  4830:         }
1.903     droeschl 4831: 
1.235     raeburn  4832:         return $bodytag;
1.182     matthew  4833: }
                   4834: 
1.917     raeburn  4835: sub dc_courseid_toggle {
                   4836:     my ($dc_info) = @_;
1.980     raeburn  4837:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.917     raeburn  4838:            '<a href="javascript:showCourseID();">'.
                   4839:            &mt('(More ...)').'</a></span>'.
                   4840:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   4841: }
                   4842: 
1.330     albertel 4843: sub make_attr_string {
                   4844:     my ($register,$attr_ref) = @_;
                   4845: 
                   4846:     if ($attr_ref && !ref($attr_ref)) {
                   4847: 	die("addentries Must be a hash ref ".
                   4848: 	    join(':',caller(1))." ".
                   4849: 	    join(':',caller(0))." ");
                   4850:     }
                   4851: 
                   4852:     if ($register) {
1.339     albertel 4853: 	my ($on_load,$on_unload);
                   4854: 	foreach my $key (keys(%{$attr_ref})) {
                   4855: 	    if      (lc($key) eq 'onload') {
                   4856: 		$on_load.=$attr_ref->{$key}.';';
                   4857: 		delete($attr_ref->{$key});
                   4858: 
                   4859: 	    } elsif (lc($key) eq 'onunload') {
                   4860: 		$on_unload.=$attr_ref->{$key}.';';
                   4861: 		delete($attr_ref->{$key});
                   4862: 	    }
                   4863: 	}
1.953     droeschl 4864: 	$attr_ref->{'onload'}  = $on_load;
                   4865: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 4866:     }
1.339     albertel 4867: 
1.330     albertel 4868:     my $attr_string;
                   4869:     foreach my $attr (keys(%$attr_ref)) {
                   4870: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4871:     }
                   4872:     return $attr_string;
                   4873: }
                   4874: 
                   4875: 
1.182     matthew  4876: ###############################################
1.251     albertel 4877: ###############################################
                   4878: 
                   4879: =pod
                   4880: 
                   4881: =item * &endbodytag()
                   4882: 
                   4883: Returns a uniform footer for LON-CAPA web pages.
                   4884: 
1.635     raeburn  4885: Inputs: 1 - optional reference to an args hash
                   4886: If in the hash, key for noredirectlink has a value which evaluates to true,
                   4887: a 'Continue' link is not displayed if the page contains an
                   4888: internal redirect in the <head></head> section,
                   4889: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 4890: 
                   4891: =cut
                   4892: 
                   4893: sub endbodytag {
1.635     raeburn  4894:     my ($args) = @_;
1.251     albertel 4895:     my $endbodytag='</body>';
1.269     albertel 4896:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4897:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  4898:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   4899: 	    $endbodytag=
                   4900: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4901: 	        &mt('Continue').'</a>'.
                   4902: 	        $endbodytag;
                   4903:         }
1.315     albertel 4904:     }
1.251     albertel 4905:     return $endbodytag;
                   4906: }
                   4907: 
1.352     albertel 4908: =pod
                   4909: 
                   4910: =item * &standard_css()
                   4911: 
                   4912: Returns a style sheet
                   4913: 
                   4914: Inputs: (all optional)
                   4915:             domain         -> force to color decorate a page for a specific
                   4916:                                domain
                   4917:             function       -> force usage of a specific rolish color scheme
                   4918:             bgcolor        -> override the default page bgcolor
                   4919: 
                   4920: =cut
                   4921: 
1.343     albertel 4922: sub standard_css {
1.345     albertel 4923:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4924:     $function  = &get_users_function() if (!$function);
                   4925:     my $img    = &designparm($function.'.img',   $domain);
                   4926:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4927:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 4928:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 4929: #second colour for later usage
1.345     albertel 4930:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4931:     my $pgbg_or_bgcolor =
                   4932: 	         $bgcolor ||
1.352     albertel 4933: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4934:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4935:     my $alink  = &designparm($function.'.alink', $domain);
                   4936:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4937:     my $link   = &designparm($function.'.link',  $domain);
                   4938: 
1.602     albertel 4939:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4940:     my $mono                 = 'monospace';
1.850     bisitz   4941:     my $data_table_head      = $sidebg;
                   4942:     my $data_table_light     = '#FAFAFA';
                   4943:     my $data_table_dark      = '#F0F0F0';
1.470     banghart 4944:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4945:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4946:     my $mail_new             = '#FFBB77';
                   4947:     my $mail_new_hover       = '#DD9955';
                   4948:     my $mail_read            = '#BBBB77';
                   4949:     my $mail_read_hover      = '#999944';
                   4950:     my $mail_replied         = '#AAAA88';
                   4951:     my $mail_replied_hover   = '#888855';
                   4952:     my $mail_other           = '#99BBBB';
                   4953:     my $mail_other_hover     = '#669999';
1.391     albertel 4954:     my $table_header         = '#DDDDDD';
1.489     raeburn  4955:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   4956:     my $lg_border_color      = '#C8C8C8';
1.952     onken    4957:     my $button_hover         = '#BF2317';
1.392     albertel 4958: 
1.608     albertel 4959:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   4960:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   4961:                                              : '0 3px 0 4px';
1.448     albertel 4962: 
1.523     albertel 4963: 
1.343     albertel 4964:     return <<END;
1.947     droeschl 4965: 
                   4966: /* needed for iframe to allow 100% height in FF */
                   4967: body, html { 
                   4968:     margin: 0;
                   4969:     padding: 0 0.5%;
                   4970:     height: 99%; /* to avoid scrollbars */
                   4971: }
                   4972: 
1.795     www      4973: body {
1.911     bisitz   4974:   font-family: $sans;
                   4975:   line-height:130%;
                   4976:   font-size:0.83em;
                   4977:   color:$font;
1.795     www      4978: }
                   4979: 
1.959     onken    4980: a:focus,
                   4981: a:focus img {
1.795     www      4982:   color: red;
1.911     bisitz   4983:   background: yellow;
1.795     www      4984: }
1.698     harmsja  4985: 
1.911     bisitz   4986: form, .inline {
                   4987:   display: inline;
1.795     www      4988: }
1.721     harmsja  4989: 
1.795     www      4990: .LC_right {
1.911     bisitz   4991:   text-align:right;
1.795     www      4992: }
                   4993: 
                   4994: .LC_middle {
1.911     bisitz   4995:   vertical-align:middle;
1.795     www      4996: }
1.721     harmsja  4997: 
1.911     bisitz   4998: .LC_400Box {
                   4999:   width:400px;
                   5000: }
1.721     harmsja  5001: 
1.947     droeschl 5002: .LC_iframecontainer {
                   5003:     width: 98%;
                   5004:     margin: 0;
                   5005:     position: fixed;
                   5006:     top: 8.5em;
                   5007:     bottom: 0;
                   5008: }
                   5009: 
                   5010: .LC_iframecontainer iframe{
                   5011:     border: none;
                   5012:     width: 100%;
                   5013:     height: 100%;
                   5014: }
                   5015: 
1.778     bisitz   5016: .LC_filename {
                   5017:   font-family: $mono;
                   5018:   white-space:pre;
1.921     bisitz   5019:   font-size: 120%;
1.778     bisitz   5020: }
                   5021: 
                   5022: .LC_fileicon {
                   5023:   border: none;
                   5024:   height: 1.3em;
                   5025:   vertical-align: text-bottom;
                   5026:   margin-right: 0.3em;
                   5027:   text-decoration:none;
                   5028: }
                   5029: 
1.1008    www      5030: .LC_setting {
                   5031:   text-decoration:underline;
                   5032: }
                   5033: 
1.350     albertel 5034: .LC_error {
                   5035:   color: red;
                   5036:   font-size: larger;
                   5037: }
1.795     www      5038: 
1.457     albertel 5039: .LC_warning,
                   5040: .LC_diff_removed {
1.733     bisitz   5041:   color: red;
1.394     albertel 5042: }
1.532     albertel 5043: 
                   5044: .LC_info,
1.457     albertel 5045: .LC_success,
                   5046: .LC_diff_added {
1.350     albertel 5047:   color: green;
                   5048: }
1.795     www      5049: 
1.802     bisitz   5050: div.LC_confirm_box {
                   5051:   background-color: #FAFAFA;
                   5052:   border: 1px solid $lg_border_color;
                   5053:   margin-right: 0;
                   5054:   padding: 5px;
                   5055: }
                   5056: 
                   5057: div.LC_confirm_box .LC_error img,
                   5058: div.LC_confirm_box .LC_success img {
                   5059:   vertical-align: middle;
                   5060: }
                   5061: 
1.440     albertel 5062: .LC_icon {
1.771     droeschl 5063:   border: none;
1.790     droeschl 5064:   vertical-align: middle;
1.771     droeschl 5065: }
                   5066: 
1.543     albertel 5067: .LC_docs_spacer {
                   5068:   width: 25px;
                   5069:   height: 1px;
1.771     droeschl 5070:   border: none;
1.543     albertel 5071: }
1.346     albertel 5072: 
1.532     albertel 5073: .LC_internal_info {
1.735     bisitz   5074:   color: #999999;
1.532     albertel 5075: }
                   5076: 
1.794     www      5077: .LC_discussion {
1.911     bisitz   5078:   background: $tabbg;
                   5079:   border: 1px solid black;
                   5080:   margin: 2px;
1.794     www      5081: }
                   5082: 
                   5083: .LC_disc_action_links_bar {
1.911     bisitz   5084:   background: $tabbg;
                   5085:   border: none;
                   5086:   margin: 4px;
1.794     www      5087: }
                   5088: 
                   5089: .LC_disc_action_left {
1.911     bisitz   5090:   text-align: left;
1.794     www      5091: }
                   5092: 
                   5093: .LC_disc_action_right {
1.911     bisitz   5094:   text-align: right;
1.794     www      5095: }
                   5096: 
                   5097: .LC_disc_new_item {
1.911     bisitz   5098:   background: white;
                   5099:   border: 2px solid red;
                   5100:   margin: 2px;
1.794     www      5101: }
                   5102: 
                   5103: .LC_disc_old_item {
1.911     bisitz   5104:   background: white;
                   5105:   border: 1px solid black;
                   5106:   margin: 2px;
1.794     www      5107: }
                   5108: 
1.458     albertel 5109: table.LC_pastsubmission {
                   5110:   border: 1px solid black;
                   5111:   margin: 2px;
                   5112: }
                   5113: 
1.924     bisitz   5114: table#LC_menubuttons {
1.345     albertel 5115:   width: 100%;
                   5116:   background: $pgbg;
1.392     albertel 5117:   border: 2px;
1.402     albertel 5118:   border-collapse: separate;
1.803     bisitz   5119:   padding: 0;
1.345     albertel 5120: }
1.392     albertel 5121: 
1.801     tempelho 5122: table#LC_title_bar a {
                   5123:   color: $fontmenu;
                   5124: }
1.836     bisitz   5125: 
1.807     droeschl 5126: table#LC_title_bar {
1.819     tempelho 5127:   clear: both;
1.836     bisitz   5128:   display: none;
1.807     droeschl 5129: }
                   5130: 
1.795     www      5131: table#LC_title_bar,
1.933     droeschl 5132: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5133: table#LC_title_bar.LC_with_remote {
1.359     albertel 5134:   width: 100%;
1.392     albertel 5135:   border-color: $pgbg;
                   5136:   border-style: solid;
                   5137:   border-width: $border;
1.379     albertel 5138:   background: $pgbg;
1.801     tempelho 5139:   color: $fontmenu;
1.392     albertel 5140:   border-collapse: collapse;
1.803     bisitz   5141:   padding: 0;
1.819     tempelho 5142:   margin: 0;
1.359     albertel 5143: }
1.795     www      5144: 
1.933     droeschl 5145: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5146:     margin: 0;
                   5147:     padding: 0;
1.933     droeschl 5148:     position: relative;
                   5149:     list-style: none;
1.913     droeschl 5150: }
1.933     droeschl 5151: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5152:     display: inline;
                   5153: }
1.933     droeschl 5154: 
                   5155: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5156:     padding: 0;
1.933     droeschl 5157:     margin: 0;
                   5158:     float: left;
1.913     droeschl 5159: }
1.933     droeschl 5160: .LC_breadcrumb_tools_tools {
                   5161:     padding: 0;
                   5162:     margin: 0;
1.913     droeschl 5163:     float: right;
                   5164: }
                   5165: 
1.359     albertel 5166: table#LC_title_bar td {
                   5167:   background: $tabbg;
                   5168: }
1.795     www      5169: 
1.911     bisitz   5170: table#LC_menubuttons img {
1.803     bisitz   5171:   border: none;
1.346     albertel 5172: }
1.795     www      5173: 
1.842     droeschl 5174: .LC_breadcrumbs_component {
1.911     bisitz   5175:   float: right;
                   5176:   margin: 0 1em;
1.357     albertel 5177: }
1.842     droeschl 5178: .LC_breadcrumbs_component img {
1.911     bisitz   5179:   vertical-align: middle;
1.777     tempelho 5180: }
1.795     www      5181: 
1.383     albertel 5182: td.LC_table_cell_checkbox {
                   5183:   text-align: center;
                   5184: }
1.795     www      5185: 
                   5186: .LC_fontsize_small {
1.911     bisitz   5187:   font-size: 70%;
1.705     tempelho 5188: }
                   5189: 
1.844     bisitz   5190: #LC_breadcrumbs {
1.911     bisitz   5191:   clear:both;
                   5192:   background: $sidebg;
                   5193:   border-bottom: 1px solid $lg_border_color;
                   5194:   line-height: 2.5em;
1.933     droeschl 5195:   overflow: hidden;
1.911     bisitz   5196:   margin: 0;
                   5197:   padding: 0;
1.995     raeburn  5198:   text-align: left;
1.819     tempelho 5199: }
1.862     bisitz   5200: 
1.993     raeburn  5201: .LC_head_subbox {
1.911     bisitz   5202:   clear:both;
                   5203:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5204:   border: 1px solid $sidebg;
                   5205:   margin: 0 0 10px 0;      
1.966     bisitz   5206:   padding: 3px;
1.995     raeburn  5207:   text-align: left;
1.822     bisitz   5208: }
                   5209: 
1.795     www      5210: .LC_fontsize_medium {
1.911     bisitz   5211:   font-size: 85%;
1.705     tempelho 5212: }
                   5213: 
1.795     www      5214: .LC_fontsize_large {
1.911     bisitz   5215:   font-size: 120%;
1.705     tempelho 5216: }
                   5217: 
1.346     albertel 5218: .LC_menubuttons_inline_text {
                   5219:   color: $font;
1.698     harmsja  5220:   font-size: 90%;
1.701     harmsja  5221:   padding-left:3px;
1.346     albertel 5222: }
                   5223: 
1.934     droeschl 5224: .LC_menubuttons_inline_text img{
                   5225:   vertical-align: middle;
                   5226: }
                   5227: 
1.951     onken    5228: li.LC_menubuttons_inline_text img,a {
                   5229:   cursor:pointer;
1.1002    droeschl 5230:   text-decoration: none;
1.951     onken    5231: }
                   5232: 
1.526     www      5233: .LC_menubuttons_link {
                   5234:   text-decoration: none;
                   5235: }
1.795     www      5236: 
1.522     albertel 5237: .LC_menubuttons_category {
1.521     www      5238:   color: $font;
1.526     www      5239:   background: $pgbg;
1.521     www      5240:   font-size: larger;
                   5241:   font-weight: bold;
                   5242: }
                   5243: 
1.346     albertel 5244: td.LC_menubuttons_text {
1.911     bisitz   5245:   color: $font;
1.346     albertel 5246: }
1.706     harmsja  5247: 
1.346     albertel 5248: .LC_current_location {
                   5249:   background: $tabbg;
                   5250: }
1.795     www      5251: 
1.938     bisitz   5252: table.LC_data_table {
1.347     albertel 5253:   border: 1px solid #000000;
1.402     albertel 5254:   border-collapse: separate;
1.426     albertel 5255:   border-spacing: 1px;
1.610     albertel 5256:   background: $pgbg;
1.347     albertel 5257: }
1.795     www      5258: 
1.422     albertel 5259: .LC_data_table_dense {
                   5260:   font-size: small;
                   5261: }
1.795     www      5262: 
1.507     raeburn  5263: table.LC_nested_outer {
                   5264:   border: 1px solid #000000;
1.589     raeburn  5265:   border-collapse: collapse;
1.803     bisitz   5266:   border-spacing: 0;
1.507     raeburn  5267:   width: 100%;
                   5268: }
1.795     www      5269: 
1.879     raeburn  5270: table.LC_innerpickbox,
1.507     raeburn  5271: table.LC_nested {
1.803     bisitz   5272:   border: none;
1.589     raeburn  5273:   border-collapse: collapse;
1.803     bisitz   5274:   border-spacing: 0;
1.507     raeburn  5275:   width: 100%;
                   5276: }
1.795     www      5277: 
1.911     bisitz   5278: table.LC_data_table tr th,
                   5279: table.LC_calendar tr th,
1.879     raeburn  5280: table.LC_prior_tries tr th,
                   5281: table.LC_innerpickbox tr th {
1.349     albertel 5282:   font-weight: bold;
                   5283:   background-color: $data_table_head;
1.801     tempelho 5284:   color:$fontmenu;
1.701     harmsja  5285:   font-size:90%;
1.347     albertel 5286: }
1.795     www      5287: 
1.879     raeburn  5288: table.LC_innerpickbox tr th,
                   5289: table.LC_innerpickbox tr td {
                   5290:   vertical-align: top;
                   5291: }
                   5292: 
1.711     raeburn  5293: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5294:   background-color: #CCCCCC;
1.711     raeburn  5295:   font-weight: bold;
                   5296:   text-align: left;
                   5297: }
1.795     www      5298: 
1.912     bisitz   5299: table.LC_data_table tr.LC_odd_row > td {
                   5300:   background-color: $data_table_light;
                   5301:   padding: 2px;
                   5302:   vertical-align: top;
                   5303: }
                   5304: 
1.809     bisitz   5305: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5306:   background-color: $data_table_light;
1.912     bisitz   5307:   vertical-align: top;
                   5308: }
                   5309: 
                   5310: table.LC_data_table tr.LC_even_row > td {
                   5311:   background-color: $data_table_dark;
1.425     albertel 5312:   padding: 2px;
1.900     bisitz   5313:   vertical-align: top;
1.347     albertel 5314: }
1.795     www      5315: 
1.809     bisitz   5316: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5317:   background-color: $data_table_dark;
1.900     bisitz   5318:   vertical-align: top;
1.347     albertel 5319: }
1.795     www      5320: 
1.425     albertel 5321: table.LC_data_table tr.LC_data_table_highlight td {
                   5322:   background-color: $data_table_darker;
                   5323: }
1.795     www      5324: 
1.639     raeburn  5325: table.LC_data_table tr td.LC_leftcol_header {
                   5326:   background-color: $data_table_head;
                   5327:   font-weight: bold;
                   5328: }
1.795     www      5329: 
1.451     albertel 5330: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5331: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5332:   font-weight: bold;
                   5333:   font-style: italic;
                   5334:   text-align: center;
                   5335:   padding: 8px;
1.347     albertel 5336: }
1.795     www      5337: 
1.940     bisitz   5338: table.LC_data_table tr.LC_empty_row td {
                   5339:   background-color: $sidebg;
                   5340: }
                   5341: 
                   5342: table.LC_nested tr.LC_empty_row td {
                   5343:   background-color: #FFFFFF;
                   5344: }
                   5345: 
1.890     droeschl 5346: table.LC_caption {
                   5347: }
                   5348: 
1.507     raeburn  5349: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5350:   padding: 4ex
                   5351: }
1.795     www      5352: 
1.507     raeburn  5353: table.LC_nested_outer tr th {
                   5354:   font-weight: bold;
1.801     tempelho 5355:   color:$fontmenu;
1.507     raeburn  5356:   background-color: $data_table_head;
1.701     harmsja  5357:   font-size: small;
1.507     raeburn  5358:   border-bottom: 1px solid #000000;
                   5359: }
1.795     www      5360: 
1.507     raeburn  5361: table.LC_nested_outer tr td.LC_subheader {
                   5362:   background-color: $data_table_head;
                   5363:   font-weight: bold;
                   5364:   font-size: small;
                   5365:   border-bottom: 1px solid #000000;
                   5366:   text-align: right;
1.451     albertel 5367: }
1.795     www      5368: 
1.507     raeburn  5369: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5370:   background-color: #CCCCCC;
1.451     albertel 5371:   font-weight: bold;
                   5372:   font-size: small;
1.507     raeburn  5373:   text-align: center;
                   5374: }
1.795     www      5375: 
1.589     raeburn  5376: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5377: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5378:   text-align: left;
1.451     albertel 5379: }
1.795     www      5380: 
1.507     raeburn  5381: table.LC_nested td {
1.735     bisitz   5382:   background-color: #FFFFFF;
1.451     albertel 5383:   font-size: small;
1.507     raeburn  5384: }
1.795     www      5385: 
1.507     raeburn  5386: table.LC_nested_outer tr th.LC_right_item,
                   5387: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5388: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5389: table.LC_nested tr td.LC_right_item {
1.451     albertel 5390:   text-align: right;
                   5391: }
                   5392: 
1.507     raeburn  5393: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5394:   background-color: #EEEEEE;
1.451     albertel 5395: }
                   5396: 
1.473     raeburn  5397: table.LC_createuser {
                   5398: }
                   5399: 
                   5400: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5401:   font-size: small;
1.473     raeburn  5402: }
                   5403: 
                   5404: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5405:   background-color: #CCCCCC;
1.473     raeburn  5406:   font-weight: bold;
                   5407:   text-align: center;
                   5408: }
                   5409: 
1.349     albertel 5410: table.LC_calendar {
                   5411:   border: 1px solid #000000;
                   5412:   border-collapse: collapse;
1.917     raeburn  5413:   width: 98%;
1.349     albertel 5414: }
1.795     www      5415: 
1.349     albertel 5416: table.LC_calendar_pickdate {
                   5417:   font-size: xx-small;
                   5418: }
1.795     www      5419: 
1.349     albertel 5420: table.LC_calendar tr td {
                   5421:   border: 1px solid #000000;
                   5422:   vertical-align: top;
1.917     raeburn  5423:   width: 14%;
1.349     albertel 5424: }
1.795     www      5425: 
1.349     albertel 5426: table.LC_calendar tr td.LC_calendar_day_empty {
                   5427:   background-color: $data_table_dark;
                   5428: }
1.795     www      5429: 
1.779     bisitz   5430: table.LC_calendar tr td.LC_calendar_day_current {
                   5431:   background-color: $data_table_highlight;
1.777     tempelho 5432: }
1.795     www      5433: 
1.938     bisitz   5434: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5435:   background-color: $mail_new;
                   5436: }
1.795     www      5437: 
1.938     bisitz   5438: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5439:   background-color: $mail_new_hover;
                   5440: }
1.795     www      5441: 
1.938     bisitz   5442: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5443:   background-color: $mail_read;
                   5444: }
1.795     www      5445: 
1.938     bisitz   5446: /*
                   5447: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5448:   background-color: $mail_read_hover;
                   5449: }
1.938     bisitz   5450: */
1.795     www      5451: 
1.938     bisitz   5452: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5453:   background-color: $mail_replied;
                   5454: }
1.795     www      5455: 
1.938     bisitz   5456: /*
                   5457: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5458:   background-color: $mail_replied_hover;
                   5459: }
1.938     bisitz   5460: */
1.795     www      5461: 
1.938     bisitz   5462: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5463:   background-color: $mail_other;
                   5464: }
1.795     www      5465: 
1.938     bisitz   5466: /*
                   5467: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5468:   background-color: $mail_other_hover;
                   5469: }
1.938     bisitz   5470: */
1.494     raeburn  5471: 
1.777     tempelho 5472: table.LC_data_table tr > td.LC_browser_file,
                   5473: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5474:   background: #AAEE77;
1.389     albertel 5475: }
1.795     www      5476: 
1.777     tempelho 5477: table.LC_data_table tr > td.LC_browser_file_locked,
                   5478: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5479:   background: #FFAA99;
1.387     albertel 5480: }
1.795     www      5481: 
1.777     tempelho 5482: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5483:   background: #888888;
1.779     bisitz   5484: }
1.795     www      5485: 
1.777     tempelho 5486: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5487: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5488:   background: #F8F866;
1.777     tempelho 5489: }
1.795     www      5490: 
1.696     bisitz   5491: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5492:   background: #E0E8FF;
1.387     albertel 5493: }
1.696     bisitz   5494: 
1.707     bisitz   5495: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5496:   /* background: #77FF77; */
1.707     bisitz   5497: }
1.795     www      5498: 
1.707     bisitz   5499: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5500:   border-right: 8px solid #FFFF77;
1.707     bisitz   5501: }
1.795     www      5502: 
1.707     bisitz   5503: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5504:   border-right: 8px solid #FFAA77;
1.707     bisitz   5505: }
1.795     www      5506: 
1.707     bisitz   5507: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5508:   border-right: 8px solid #FF7777;
1.707     bisitz   5509: }
1.795     www      5510: 
1.707     bisitz   5511: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5512:   border-right: 8px solid #AAFF77;
1.707     bisitz   5513: }
1.795     www      5514: 
1.707     bisitz   5515: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5516:   border-right: 8px solid #11CC55;
1.707     bisitz   5517: }
                   5518: 
1.388     albertel 5519: span.LC_current_location {
1.701     harmsja  5520:   font-size:larger;
1.388     albertel 5521:   background: $pgbg;
                   5522: }
1.387     albertel 5523: 
1.1029    www      5524: span.LC_current_nav_location {
                   5525:   font-weight:bold;
                   5526:   background: $sidebg;
                   5527: }
                   5528: 
1.395     albertel 5529: span.LC_parm_menu_item {
                   5530:   font-size: larger;
                   5531: }
1.795     www      5532: 
1.395     albertel 5533: span.LC_parm_scope_all {
                   5534:   color: red;
                   5535: }
1.795     www      5536: 
1.395     albertel 5537: span.LC_parm_scope_folder {
                   5538:   color: green;
                   5539: }
1.795     www      5540: 
1.395     albertel 5541: span.LC_parm_scope_resource {
                   5542:   color: orange;
                   5543: }
1.795     www      5544: 
1.395     albertel 5545: span.LC_parm_part {
                   5546:   color: blue;
                   5547: }
1.795     www      5548: 
1.911     bisitz   5549: span.LC_parm_folder,
                   5550: span.LC_parm_symb {
1.395     albertel 5551:   font-size: x-small;
                   5552:   font-family: $mono;
                   5553:   color: #AAAAAA;
                   5554: }
                   5555: 
1.977     bisitz   5556: ul.LC_parm_parmlist li {
                   5557:   display: inline-block;
                   5558:   padding: 0.3em 0.8em;
                   5559:   vertical-align: top;
                   5560:   width: 150px;
                   5561:   border-top:1px solid $lg_border_color;
                   5562: }
                   5563: 
1.795     www      5564: td.LC_parm_overview_level_menu,
                   5565: td.LC_parm_overview_map_menu,
                   5566: td.LC_parm_overview_parm_selectors,
                   5567: td.LC_parm_overview_restrictions  {
1.396     albertel 5568:   border: 1px solid black;
                   5569:   border-collapse: collapse;
                   5570: }
1.795     www      5571: 
1.396     albertel 5572: table.LC_parm_overview_restrictions td {
                   5573:   border-width: 1px 4px 1px 4px;
                   5574:   border-style: solid;
                   5575:   border-color: $pgbg;
                   5576:   text-align: center;
                   5577: }
1.795     www      5578: 
1.396     albertel 5579: table.LC_parm_overview_restrictions th {
                   5580:   background: $tabbg;
                   5581:   border-width: 1px 4px 1px 4px;
                   5582:   border-style: solid;
                   5583:   border-color: $pgbg;
                   5584: }
1.795     www      5585: 
1.398     albertel 5586: table#LC_helpmenu {
1.803     bisitz   5587:   border: none;
1.398     albertel 5588:   height: 55px;
1.803     bisitz   5589:   border-spacing: 0;
1.398     albertel 5590: }
                   5591: 
                   5592: table#LC_helpmenu fieldset legend {
                   5593:   font-size: larger;
                   5594: }
1.795     www      5595: 
1.397     albertel 5596: table#LC_helpmenu_links {
                   5597:   width: 100%;
                   5598:   border: 1px solid black;
                   5599:   background: $pgbg;
1.803     bisitz   5600:   padding: 0;
1.397     albertel 5601:   border-spacing: 1px;
                   5602: }
1.795     www      5603: 
1.397     albertel 5604: table#LC_helpmenu_links tr td {
                   5605:   padding: 1px;
                   5606:   background: $tabbg;
1.399     albertel 5607:   text-align: center;
                   5608:   font-weight: bold;
1.397     albertel 5609: }
1.396     albertel 5610: 
1.795     www      5611: table#LC_helpmenu_links a:link,
                   5612: table#LC_helpmenu_links a:visited,
1.397     albertel 5613: table#LC_helpmenu_links a:active {
                   5614:   text-decoration: none;
                   5615:   color: $font;
                   5616: }
1.795     www      5617: 
1.397     albertel 5618: table#LC_helpmenu_links a:hover {
                   5619:   text-decoration: underline;
                   5620:   color: $vlink;
                   5621: }
1.396     albertel 5622: 
1.417     albertel 5623: .LC_chrt_popup_exists {
                   5624:   border: 1px solid #339933;
                   5625:   margin: -1px;
                   5626: }
1.795     www      5627: 
1.417     albertel 5628: .LC_chrt_popup_up {
                   5629:   border: 1px solid yellow;
                   5630:   margin: -1px;
                   5631: }
1.795     www      5632: 
1.417     albertel 5633: .LC_chrt_popup {
                   5634:   border: 1px solid #8888FF;
                   5635:   background: #CCCCFF;
                   5636: }
1.795     www      5637: 
1.421     albertel 5638: table.LC_pick_box {
                   5639:   border-collapse: separate;
                   5640:   background: white;
                   5641:   border: 1px solid black;
                   5642:   border-spacing: 1px;
                   5643: }
1.795     www      5644: 
1.421     albertel 5645: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   5646:   background: $sidebg;
1.421     albertel 5647:   font-weight: bold;
1.900     bisitz   5648:   text-align: left;
1.740     bisitz   5649:   vertical-align: top;
1.421     albertel 5650:   width: 184px;
                   5651:   padding: 8px;
                   5652: }
1.795     www      5653: 
1.579     raeburn  5654: table.LC_pick_box td.LC_pick_box_value {
                   5655:   text-align: left;
                   5656:   padding: 8px;
                   5657: }
1.795     www      5658: 
1.579     raeburn  5659: table.LC_pick_box td.LC_pick_box_select {
                   5660:   text-align: left;
                   5661:   padding: 8px;
                   5662: }
1.795     www      5663: 
1.424     albertel 5664: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   5665:   padding: 0;
1.421     albertel 5666:   height: 1px;
                   5667:   background: black;
                   5668: }
1.795     www      5669: 
1.421     albertel 5670: table.LC_pick_box td.LC_pick_box_submit {
                   5671:   text-align: right;
                   5672: }
1.795     www      5673: 
1.579     raeburn  5674: table.LC_pick_box td.LC_evenrow_value {
                   5675:   text-align: left;
                   5676:   padding: 8px;
                   5677:   background-color: $data_table_light;
                   5678: }
1.795     www      5679: 
1.579     raeburn  5680: table.LC_pick_box td.LC_oddrow_value {
                   5681:   text-align: left;
                   5682:   padding: 8px;
                   5683:   background-color: $data_table_light;
                   5684: }
1.795     www      5685: 
1.579     raeburn  5686: span.LC_helpform_receipt_cat {
                   5687:   font-weight: bold;
                   5688: }
1.795     www      5689: 
1.424     albertel 5690: table.LC_group_priv_box {
                   5691:   background: white;
                   5692:   border: 1px solid black;
                   5693:   border-spacing: 1px;
                   5694: }
1.795     www      5695: 
1.424     albertel 5696: table.LC_group_priv_box td.LC_pick_box_title {
                   5697:   background: $tabbg;
                   5698:   font-weight: bold;
                   5699:   text-align: right;
                   5700:   width: 184px;
                   5701: }
1.795     www      5702: 
1.424     albertel 5703: table.LC_group_priv_box td.LC_groups_fixed {
                   5704:   background: $data_table_light;
                   5705:   text-align: center;
                   5706: }
1.795     www      5707: 
1.424     albertel 5708: table.LC_group_priv_box td.LC_groups_optional {
                   5709:   background: $data_table_dark;
                   5710:   text-align: center;
                   5711: }
1.795     www      5712: 
1.424     albertel 5713: table.LC_group_priv_box td.LC_groups_functionality {
                   5714:   background: $data_table_darker;
                   5715:   text-align: center;
                   5716:   font-weight: bold;
                   5717: }
1.795     www      5718: 
1.424     albertel 5719: table.LC_group_priv td {
                   5720:   text-align: left;
1.803     bisitz   5721:   padding: 0;
1.424     albertel 5722: }
                   5723: 
                   5724: .LC_navbuttons {
                   5725:   margin: 2ex 0ex 2ex 0ex;
                   5726: }
1.795     www      5727: 
1.423     albertel 5728: .LC_topic_bar {
                   5729:   font-weight: bold;
                   5730:   background: $tabbg;
1.918     wenzelju 5731:   margin: 1em 0em 1em 2em;
1.805     bisitz   5732:   padding: 3px;
1.918     wenzelju 5733:   font-size: 1.2em;
1.423     albertel 5734: }
1.795     www      5735: 
1.423     albertel 5736: .LC_topic_bar span {
1.918     wenzelju 5737:   left: 0.5em;
                   5738:   position: absolute;
1.423     albertel 5739:   vertical-align: middle;
1.918     wenzelju 5740:   font-size: 1.2em;
1.423     albertel 5741: }
1.795     www      5742: 
1.423     albertel 5743: table.LC_course_group_status {
                   5744:   margin: 20px;
                   5745: }
1.795     www      5746: 
1.423     albertel 5747: table.LC_status_selector td {
                   5748:   vertical-align: top;
                   5749:   text-align: center;
1.424     albertel 5750:   padding: 4px;
                   5751: }
1.795     www      5752: 
1.599     albertel 5753: div.LC_feedback_link {
1.616     albertel 5754:   clear: both;
1.829     kalberla 5755:   background: $sidebg;
1.779     bisitz   5756:   width: 100%;
1.829     kalberla 5757:   padding-bottom: 10px;
                   5758:   border: 1px $tabbg solid;
1.833     kalberla 5759:   height: 22px;
                   5760:   line-height: 22px;
                   5761:   padding-top: 5px;
                   5762: }
                   5763: 
                   5764: div.LC_feedback_link img {
                   5765:   height: 22px;
1.867     kalberla 5766:   vertical-align:middle;
1.829     kalberla 5767: }
                   5768: 
1.911     bisitz   5769: div.LC_feedback_link a {
1.829     kalberla 5770:   text-decoration: none;
1.489     raeburn  5771: }
1.795     www      5772: 
1.867     kalberla 5773: div.LC_comblock {
1.911     bisitz   5774:   display:inline;
1.867     kalberla 5775:   color:$font;
                   5776:   font-size:90%;
                   5777: }
                   5778: 
                   5779: div.LC_feedback_link div.LC_comblock {
                   5780:   padding-left:5px;
                   5781: }
                   5782: 
                   5783: div.LC_feedback_link div.LC_comblock a {
                   5784:   color:$font;
                   5785: }
                   5786: 
1.489     raeburn  5787: span.LC_feedback_link {
1.858     bisitz   5788:   /* background: $feedback_link_bg; */
1.599     albertel 5789:   font-size: larger;
                   5790: }
1.795     www      5791: 
1.599     albertel 5792: span.LC_message_link {
1.858     bisitz   5793:   /* background: $feedback_link_bg; */
1.599     albertel 5794:   font-size: larger;
                   5795:   position: absolute;
                   5796:   right: 1em;
1.489     raeburn  5797: }
1.421     albertel 5798: 
1.515     albertel 5799: table.LC_prior_tries {
1.524     albertel 5800:   border: 1px solid #000000;
                   5801:   border-collapse: separate;
                   5802:   border-spacing: 1px;
1.515     albertel 5803: }
1.523     albertel 5804: 
1.515     albertel 5805: table.LC_prior_tries td {
1.524     albertel 5806:   padding: 2px;
1.515     albertel 5807: }
1.523     albertel 5808: 
                   5809: .LC_answer_correct {
1.795     www      5810:   background: lightgreen;
                   5811:   color: darkgreen;
                   5812:   padding: 6px;
1.523     albertel 5813: }
1.795     www      5814: 
1.523     albertel 5815: .LC_answer_charged_try {
1.797     www      5816:   background: #FFAAAA;
1.795     www      5817:   color: darkred;
                   5818:   padding: 6px;
1.523     albertel 5819: }
1.795     www      5820: 
1.779     bisitz   5821: .LC_answer_not_charged_try,
1.523     albertel 5822: .LC_answer_no_grade,
                   5823: .LC_answer_late {
1.795     www      5824:   background: lightyellow;
1.523     albertel 5825:   color: black;
1.795     www      5826:   padding: 6px;
1.523     albertel 5827: }
1.795     www      5828: 
1.523     albertel 5829: .LC_answer_previous {
1.795     www      5830:   background: lightblue;
                   5831:   color: darkblue;
                   5832:   padding: 6px;
1.523     albertel 5833: }
1.795     www      5834: 
1.779     bisitz   5835: .LC_answer_no_message {
1.777     tempelho 5836:   background: #FFFFFF;
                   5837:   color: black;
1.795     www      5838:   padding: 6px;
1.779     bisitz   5839: }
1.795     www      5840: 
1.779     bisitz   5841: .LC_answer_unknown {
                   5842:   background: orange;
                   5843:   color: black;
1.795     www      5844:   padding: 6px;
1.777     tempelho 5845: }
1.795     www      5846: 
1.529     albertel 5847: span.LC_prior_numerical,
                   5848: span.LC_prior_string,
                   5849: span.LC_prior_custom,
                   5850: span.LC_prior_reaction,
                   5851: span.LC_prior_math {
1.925     bisitz   5852:   font-family: $mono;
1.523     albertel 5853:   white-space: pre;
                   5854: }
                   5855: 
1.525     albertel 5856: span.LC_prior_string {
1.925     bisitz   5857:   font-family: $mono;
1.525     albertel 5858:   white-space: pre;
                   5859: }
                   5860: 
1.523     albertel 5861: table.LC_prior_option {
                   5862:   width: 100%;
                   5863:   border-collapse: collapse;
                   5864: }
1.795     www      5865: 
1.911     bisitz   5866: table.LC_prior_rank,
1.795     www      5867: table.LC_prior_match {
1.528     albertel 5868:   border-collapse: collapse;
                   5869: }
1.795     www      5870: 
1.528     albertel 5871: table.LC_prior_option tr td,
                   5872: table.LC_prior_rank tr td,
                   5873: table.LC_prior_match tr td {
1.524     albertel 5874:   border: 1px solid #000000;
1.515     albertel 5875: }
                   5876: 
1.855     bisitz   5877: .LC_nobreak {
1.544     albertel 5878:   white-space: nowrap;
1.519     raeburn  5879: }
                   5880: 
1.576     raeburn  5881: span.LC_cusr_emph {
                   5882:   font-style: italic;
                   5883: }
                   5884: 
1.633     raeburn  5885: span.LC_cusr_subheading {
                   5886:   font-weight: normal;
                   5887:   font-size: 85%;
                   5888: }
                   5889: 
1.861     bisitz   5890: div.LC_docs_entry_move {
1.859     bisitz   5891:   border: 1px solid #BBBBBB;
1.545     albertel 5892:   background: #DDDDDD;
1.861     bisitz   5893:   width: 22px;
1.859     bisitz   5894:   padding: 1px;
                   5895:   margin: 0;
1.545     albertel 5896: }
                   5897: 
1.861     bisitz   5898: table.LC_data_table tr > td.LC_docs_entry_commands,
                   5899: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 5900:   background: #DDDDDD;
                   5901:   font-size: x-small;
                   5902: }
1.795     www      5903: 
1.861     bisitz   5904: .LC_docs_entry_parameter {
                   5905:   white-space: nowrap;
                   5906: }
                   5907: 
1.544     albertel 5908: .LC_docs_copy {
1.545     albertel 5909:   color: #000099;
1.544     albertel 5910: }
1.795     www      5911: 
1.544     albertel 5912: .LC_docs_cut {
1.545     albertel 5913:   color: #550044;
1.544     albertel 5914: }
1.795     www      5915: 
1.544     albertel 5916: .LC_docs_rename {
1.545     albertel 5917:   color: #009900;
1.544     albertel 5918: }
1.795     www      5919: 
1.544     albertel 5920: .LC_docs_remove {
1.545     albertel 5921:   color: #990000;
                   5922: }
                   5923: 
1.547     albertel 5924: .LC_docs_reinit_warn,
                   5925: .LC_docs_ext_edit {
                   5926:   font-size: x-small;
                   5927: }
                   5928: 
1.545     albertel 5929: table.LC_docs_adddocs td,
                   5930: table.LC_docs_adddocs th {
                   5931:   border: 1px solid #BBBBBB;
                   5932:   padding: 4px;
                   5933:   background: #DDDDDD;
1.543     albertel 5934: }
                   5935: 
1.584     albertel 5936: table.LC_sty_begin {
                   5937:   background: #BBFFBB;
                   5938: }
1.795     www      5939: 
1.584     albertel 5940: table.LC_sty_end {
                   5941:   background: #FFBBBB;
                   5942: }
                   5943: 
1.589     raeburn  5944: table.LC_double_column {
1.803     bisitz   5945:   border-width: 0;
1.589     raeburn  5946:   border-collapse: collapse;
                   5947:   width: 100%;
                   5948:   padding: 2px;
                   5949: }
                   5950: 
                   5951: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  5952:   top: 2px;
1.589     raeburn  5953:   left: 2px;
                   5954:   width: 47%;
                   5955:   vertical-align: top;
                   5956: }
                   5957: 
                   5958: table.LC_double_column tr td.LC_right_col {
                   5959:   top: 2px;
1.779     bisitz   5960:   right: 2px;
1.589     raeburn  5961:   width: 47%;
                   5962:   vertical-align: top;
                   5963: }
                   5964: 
1.591     raeburn  5965: div.LC_left_float {
                   5966:   float: left;
                   5967:   padding-right: 5%;
1.597     albertel 5968:   padding-bottom: 4px;
1.591     raeburn  5969: }
                   5970: 
                   5971: div.LC_clear_float_header {
1.597     albertel 5972:   padding-bottom: 2px;
1.591     raeburn  5973: }
                   5974: 
                   5975: div.LC_clear_float_footer {
1.597     albertel 5976:   padding-top: 10px;
1.591     raeburn  5977:   clear: both;
                   5978: }
                   5979: 
1.597     albertel 5980: div.LC_grade_show_user {
1.941     bisitz   5981: /*  border-left: 5px solid $sidebg; */
                   5982:   border-top: 5px solid #000000;
                   5983:   margin: 50px 0 0 0;
1.936     bisitz   5984:   padding: 15px 0 5px 10px;
1.597     albertel 5985: }
1.795     www      5986: 
1.936     bisitz   5987: div.LC_grade_show_user_odd_row {
1.941     bisitz   5988: /*  border-left: 5px solid #000000; */
                   5989: }
                   5990: 
                   5991: div.LC_grade_show_user div.LC_Box {
                   5992:   margin-right: 50px;
1.597     albertel 5993: }
                   5994: 
                   5995: div.LC_grade_submissions,
                   5996: div.LC_grade_message_center,
1.936     bisitz   5997: div.LC_grade_info_links {
1.597     albertel 5998:   margin: 5px;
                   5999:   width: 99%;
                   6000:   background: #FFFFFF;
                   6001: }
1.795     www      6002: 
1.597     albertel 6003: div.LC_grade_submissions_header,
1.936     bisitz   6004: div.LC_grade_message_center_header {
1.705     tempelho 6005:   font-weight: bold;
                   6006:   font-size: large;
1.597     albertel 6007: }
1.795     www      6008: 
1.597     albertel 6009: div.LC_grade_submissions_body,
1.936     bisitz   6010: div.LC_grade_message_center_body {
1.597     albertel 6011:   border: 1px solid black;
                   6012:   width: 99%;
                   6013:   background: #FFFFFF;
                   6014: }
1.795     www      6015: 
1.613     albertel 6016: table.LC_scantron_action {
                   6017:   width: 100%;
                   6018: }
1.795     www      6019: 
1.613     albertel 6020: table.LC_scantron_action tr th {
1.698     harmsja  6021:   font-weight:bold;
                   6022:   font-style:normal;
1.613     albertel 6023: }
1.795     www      6024: 
1.779     bisitz   6025: .LC_edit_problem_header,
1.614     albertel 6026: div.LC_edit_problem_footer {
1.705     tempelho 6027:   font-weight: normal;
                   6028:   font-size:  medium;
1.602     albertel 6029:   margin: 2px;
1.600     albertel 6030: }
1.795     www      6031: 
1.600     albertel 6032: div.LC_edit_problem_header,
1.602     albertel 6033: div.LC_edit_problem_header div,
1.614     albertel 6034: div.LC_edit_problem_footer,
                   6035: div.LC_edit_problem_footer div,
1.602     albertel 6036: div.LC_edit_problem_editxml_header,
                   6037: div.LC_edit_problem_editxml_header div {
1.600     albertel 6038:   margin-top: 5px;
                   6039: }
1.795     www      6040: 
1.600     albertel 6041: div.LC_edit_problem_header_title {
1.705     tempelho 6042:   font-weight: bold;
                   6043:   font-size: larger;
1.602     albertel 6044:   background: $tabbg;
                   6045:   padding: 3px;
                   6046: }
1.795     www      6047: 
1.602     albertel 6048: table.LC_edit_problem_header_title {
                   6049:   width: 100%;
1.600     albertel 6050:   background: $tabbg;
1.602     albertel 6051: }
                   6052: 
                   6053: div.LC_edit_problem_discards {
                   6054:   float: left;
                   6055:   padding-bottom: 5px;
                   6056: }
1.795     www      6057: 
1.602     albertel 6058: div.LC_edit_problem_saves {
                   6059:   float: right;
                   6060:   padding-bottom: 5px;
1.600     albertel 6061: }
1.795     www      6062: 
1.911     bisitz   6063: img.stift {
1.803     bisitz   6064:   border-width: 0;
                   6065:   vertical-align: middle;
1.677     riegler  6066: }
1.680     riegler  6067: 
1.923     bisitz   6068: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6069:   vertical-align: top;
1.777     tempelho 6070: }
1.795     www      6071: 
1.716     raeburn  6072: div.LC_createcourse {
1.911     bisitz   6073:   margin: 10px 10px 10px 10px;
1.716     raeburn  6074: }
                   6075: 
1.917     raeburn  6076: .LC_dccid {
                   6077:   margin: 0.2em 0 0 0;
                   6078:   padding: 0;
                   6079:   font-size: 90%;
                   6080:   display:none;
                   6081: }
                   6082: 
1.698     harmsja  6083: a:hover,
1.897     wenzelju 6084: ol.LC_primary_menu a:hover,
1.721     harmsja  6085: ol#LC_MenuBreadcrumbs a:hover,
                   6086: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6087: ul#LC_secondary_menu a:hover,
1.721     harmsja  6088: .LC_FormSectionClearButton input:hover
1.795     www      6089: ul.LC_TabContent   li:hover a {
1.952     onken    6090:   color:$button_hover;
1.911     bisitz   6091:   text-decoration:none;
1.693     droeschl 6092: }
                   6093: 
1.779     bisitz   6094: h1 {
1.911     bisitz   6095:   padding: 0;
                   6096:   line-height:130%;
1.693     droeschl 6097: }
1.698     harmsja  6098: 
1.911     bisitz   6099: h2,
                   6100: h3,
                   6101: h4,
                   6102: h5,
                   6103: h6 {
                   6104:   margin: 5px 0 5px 0;
                   6105:   padding: 0;
                   6106:   line-height:130%;
1.693     droeschl 6107: }
1.795     www      6108: 
                   6109: .LC_hcell {
1.911     bisitz   6110:   padding:3px 15px 3px 15px;
                   6111:   margin: 0;
                   6112:   background-color:$tabbg;
                   6113:   color:$fontmenu;
                   6114:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6115: }
1.795     www      6116: 
1.840     bisitz   6117: .LC_Box > .LC_hcell {
1.911     bisitz   6118:   margin: 0 -10px 10px -10px;
1.835     bisitz   6119: }
                   6120: 
1.721     harmsja  6121: .LC_noBorder {
1.911     bisitz   6122:   border: 0;
1.698     harmsja  6123: }
1.693     droeschl 6124: 
1.721     harmsja  6125: .LC_FormSectionClearButton input {
1.911     bisitz   6126:   background-color:transparent;
                   6127:   border: none;
                   6128:   cursor:pointer;
                   6129:   text-decoration:underline;
1.693     droeschl 6130: }
1.763     bisitz   6131: 
                   6132: .LC_help_open_topic {
1.911     bisitz   6133:   color: #FFFFFF;
                   6134:   background-color: #EEEEFF;
                   6135:   margin: 1px;
                   6136:   padding: 4px;
                   6137:   border: 1px solid #000033;
                   6138:   white-space: nowrap;
                   6139:   /* vertical-align: middle; */
1.759     neumanie 6140: }
1.693     droeschl 6141: 
1.911     bisitz   6142: dl,
                   6143: ul,
                   6144: div,
                   6145: fieldset {
                   6146:   margin: 10px 10px 10px 0;
                   6147:   /* overflow: hidden; */
1.693     droeschl 6148: }
1.795     www      6149: 
1.838     bisitz   6150: fieldset > legend {
1.911     bisitz   6151:   font-weight: bold;
                   6152:   padding: 0 5px 0 5px;
1.838     bisitz   6153: }
                   6154: 
1.813     bisitz   6155: #LC_nav_bar {
1.911     bisitz   6156:   float: left;
1.995     raeburn  6157:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6158:   margin: 0 0 2px 0;
1.807     droeschl 6159: }
                   6160: 
1.916     droeschl 6161: #LC_realm {
                   6162:   margin: 0.2em 0 0 0;
                   6163:   padding: 0;
                   6164:   font-weight: bold;
                   6165:   text-align: center;
1.995     raeburn  6166:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6167: }
                   6168: 
1.911     bisitz   6169: #LC_nav_bar em {
                   6170:   font-weight: bold;
                   6171:   font-style: normal;
1.807     droeschl 6172: }
                   6173: 
1.897     wenzelju 6174: ol.LC_primary_menu {
1.911     bisitz   6175:   float: right;
1.934     droeschl 6176:   margin: 0;
1.995     raeburn  6177:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6178: }
                   6179: 
1.852     droeschl 6180: ol#LC_PathBreadcrumbs {
1.911     bisitz   6181:   margin: 0;
1.693     droeschl 6182: }
                   6183: 
1.897     wenzelju 6184: ol.LC_primary_menu li {
1.911     bisitz   6185:   display: inline;
                   6186:   padding: 5px 5px 0 10px;
                   6187:   vertical-align: top;
1.693     droeschl 6188: }
                   6189: 
1.897     wenzelju 6190: ol.LC_primary_menu li img {
1.911     bisitz   6191:   vertical-align: bottom;
1.934     droeschl 6192:   height: 1.1em;
1.693     droeschl 6193: }
                   6194: 
1.897     wenzelju 6195: ol.LC_primary_menu a {
1.911     bisitz   6196:   color: RGB(80, 80, 80);
                   6197:   text-decoration: none;
1.693     droeschl 6198: }
1.795     www      6199: 
1.949     droeschl 6200: ol.LC_primary_menu a.LC_new_message {
                   6201:   font-weight:bold;
                   6202:   color: darkred;
                   6203: }
                   6204: 
1.975     raeburn  6205: ol.LC_docs_parameters {
                   6206:   margin-left: 0;
                   6207:   padding: 0;
                   6208:   list-style: none;
                   6209: }
                   6210: 
                   6211: ol.LC_docs_parameters li {
                   6212:   margin: 0;
                   6213:   padding-right: 20px;
                   6214:   display: inline;
                   6215: }
                   6216: 
1.976     raeburn  6217: ol.LC_docs_parameters li:before {
                   6218:   content: "\\002022 \\0020";
                   6219: }
                   6220: 
                   6221: li.LC_docs_parameters_title {
                   6222:   font-weight: bold;
                   6223: }
                   6224: 
                   6225: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6226:   content: "";
                   6227: }
                   6228: 
1.897     wenzelju 6229: ul#LC_secondary_menu {
1.911     bisitz   6230:   clear: both;
                   6231:   color: $fontmenu;
                   6232:   background: $tabbg;
                   6233:   list-style: none;
                   6234:   padding: 0;
                   6235:   margin: 0;
                   6236:   width: 100%;
1.995     raeburn  6237:   text-align: left;
1.808     droeschl 6238: }
                   6239: 
1.897     wenzelju 6240: ul#LC_secondary_menu li {
1.911     bisitz   6241:   font-weight: bold;
                   6242:   line-height: 1.8em;
                   6243:   padding: 0 0.8em;
                   6244:   border-right: 1px solid black;
                   6245:   display: inline;
                   6246:   vertical-align: middle;
1.807     droeschl 6247: }
                   6248: 
1.847     tempelho 6249: ul.LC_TabContent {
1.911     bisitz   6250:   display:block;
                   6251:   background: $sidebg;
                   6252:   border-bottom: solid 1px $lg_border_color;
                   6253:   list-style:none;
1.1020    raeburn  6254:   margin: -1px -10px 0 -10px;
1.911     bisitz   6255:   padding: 0;
1.693     droeschl 6256: }
                   6257: 
1.795     www      6258: ul.LC_TabContent li,
                   6259: ul.LC_TabContentBigger li {
1.911     bisitz   6260:   float:left;
1.741     harmsja  6261: }
1.795     www      6262: 
1.897     wenzelju 6263: ul#LC_secondary_menu li a {
1.911     bisitz   6264:   color: $fontmenu;
                   6265:   text-decoration: none;
1.693     droeschl 6266: }
1.795     www      6267: 
1.721     harmsja  6268: ul.LC_TabContent {
1.952     onken    6269:   min-height:20px;
1.721     harmsja  6270: }
1.795     www      6271: 
                   6272: ul.LC_TabContent li {
1.911     bisitz   6273:   vertical-align:middle;
1.959     onken    6274:   padding: 0 16px 0 10px;
1.911     bisitz   6275:   background-color:$tabbg;
                   6276:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6277:   border-left: solid 1px $font;
1.721     harmsja  6278: }
1.795     www      6279: 
1.847     tempelho 6280: ul.LC_TabContent .right {
1.911     bisitz   6281:   float:right;
1.847     tempelho 6282: }
                   6283: 
1.911     bisitz   6284: ul.LC_TabContent li a,
                   6285: ul.LC_TabContent li {
                   6286:   color:rgb(47,47,47);
                   6287:   text-decoration:none;
                   6288:   font-size:95%;
                   6289:   font-weight:bold;
1.952     onken    6290:   min-height:20px;
                   6291: }
                   6292: 
1.959     onken    6293: ul.LC_TabContent li a:hover,
                   6294: ul.LC_TabContent li a:focus {
1.952     onken    6295:   color: $button_hover;
1.959     onken    6296:   background:none;
                   6297:   outline:none;
1.952     onken    6298: }
                   6299: 
                   6300: ul.LC_TabContent li:hover {
                   6301:   color: $button_hover;
                   6302:   cursor:pointer;
1.721     harmsja  6303: }
1.795     www      6304: 
1.911     bisitz   6305: ul.LC_TabContent li.active {
1.952     onken    6306:   color: $font;
1.911     bisitz   6307:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6308:   border-bottom:solid 1px #FFFFFF;
                   6309:   cursor: default;
1.744     ehlerst  6310: }
1.795     www      6311: 
1.959     onken    6312: ul.LC_TabContent li.active a {
                   6313:   color:$font;
                   6314:   background:#FFFFFF;
                   6315:   outline: none;
                   6316: }
1.870     tempelho 6317: #maincoursedoc {
1.911     bisitz   6318:   clear:both;
1.870     tempelho 6319: }
                   6320: 
                   6321: ul.LC_TabContentBigger {
1.911     bisitz   6322:   display:block;
                   6323:   list-style:none;
                   6324:   padding: 0;
1.870     tempelho 6325: }
                   6326: 
1.795     www      6327: ul.LC_TabContentBigger li {
1.911     bisitz   6328:   vertical-align:bottom;
                   6329:   height: 30px;
                   6330:   font-size:110%;
                   6331:   font-weight:bold;
                   6332:   color: #737373;
1.841     tempelho 6333: }
                   6334: 
1.957     onken    6335: ul.LC_TabContentBigger li.active {
                   6336:   position: relative;
                   6337:   top: 1px;
                   6338: }
                   6339: 
1.870     tempelho 6340: ul.LC_TabContentBigger li a {
1.911     bisitz   6341:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6342:   height: 30px;
                   6343:   line-height: 30px;
                   6344:   text-align: center;
                   6345:   display: block;
                   6346:   text-decoration: none;
1.958     onken    6347:   outline: none;  
1.741     harmsja  6348: }
1.795     www      6349: 
1.870     tempelho 6350: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6351:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6352:   color:$font;
1.744     ehlerst  6353: }
1.795     www      6354: 
1.870     tempelho 6355: ul.LC_TabContentBigger li b {
1.911     bisitz   6356:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6357:   display: block;
                   6358:   float: left;
                   6359:   padding: 0 30px;
1.957     onken    6360:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6361: }
                   6362: 
1.956     onken    6363: ul.LC_TabContentBigger li:hover b {
                   6364:   color:$button_hover;
                   6365: }
                   6366: 
1.870     tempelho 6367: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6368:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6369:   color:$font;
1.957     onken    6370:   border: 0;
1.741     harmsja  6371: }
1.693     droeschl 6372: 
1.870     tempelho 6373: 
1.862     bisitz   6374: ul.LC_CourseBreadcrumbs {
                   6375:   background: $sidebg;
1.1020    raeburn  6376:   height: 2em;
1.862     bisitz   6377:   padding-left: 10px;
1.1020    raeburn  6378:   margin: 0;
1.862     bisitz   6379:   list-style-position: inside;
                   6380: }
                   6381: 
1.911     bisitz   6382: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6383: ol#LC_PathBreadcrumbs {
1.911     bisitz   6384:   padding-left: 10px;
                   6385:   margin: 0;
1.933     droeschl 6386:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6387: }
                   6388: 
1.911     bisitz   6389: ol#LC_MenuBreadcrumbs li,
                   6390: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6391: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6392:   display: inline;
1.933     droeschl 6393:   white-space: normal;  
1.693     droeschl 6394: }
                   6395: 
1.823     bisitz   6396: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6397: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6398:   text-decoration: none;
                   6399:   font-size:90%;
1.693     droeschl 6400: }
1.795     www      6401: 
1.969     droeschl 6402: ol#LC_MenuBreadcrumbs h1 {
                   6403:   display: inline;
                   6404:   font-size: 90%;
                   6405:   line-height: 2.5em;
                   6406:   margin: 0;
                   6407:   padding: 0;
                   6408: }
                   6409: 
1.795     www      6410: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6411:   text-decoration:none;
                   6412:   font-size:100%;
                   6413:   font-weight:bold;
1.693     droeschl 6414: }
1.795     www      6415: 
1.840     bisitz   6416: .LC_Box {
1.911     bisitz   6417:   border: solid 1px $lg_border_color;
                   6418:   padding: 0 10px 10px 10px;
1.746     neumanie 6419: }
1.795     www      6420: 
1.1020    raeburn  6421: .LC_DocsBox {
                   6422:   border: solid 1px $lg_border_color;
                   6423:   padding: 0 0 10px 10px;
                   6424: }
                   6425: 
1.795     www      6426: .LC_AboutMe_Image {
1.911     bisitz   6427:   float:left;
                   6428:   margin-right:10px;
1.747     neumanie 6429: }
1.795     www      6430: 
                   6431: .LC_Clear_AboutMe_Image {
1.911     bisitz   6432:   clear:left;
1.747     neumanie 6433: }
1.795     www      6434: 
1.721     harmsja  6435: dl.LC_ListStyleClean dt {
1.911     bisitz   6436:   padding-right: 5px;
                   6437:   display: table-header-group;
1.693     droeschl 6438: }
                   6439: 
1.721     harmsja  6440: dl.LC_ListStyleClean dd {
1.911     bisitz   6441:   display: table-row;
1.693     droeschl 6442: }
                   6443: 
1.721     harmsja  6444: .LC_ListStyleClean,
                   6445: .LC_ListStyleSimple,
                   6446: .LC_ListStyleNormal,
1.795     www      6447: .LC_ListStyleSpecial {
1.911     bisitz   6448:   /* display:block; */
                   6449:   list-style-position: inside;
                   6450:   list-style-type: none;
                   6451:   overflow: hidden;
                   6452:   padding: 0;
1.693     droeschl 6453: }
                   6454: 
1.721     harmsja  6455: .LC_ListStyleSimple li,
                   6456: .LC_ListStyleSimple dd,
                   6457: .LC_ListStyleNormal li,
                   6458: .LC_ListStyleNormal dd,
                   6459: .LC_ListStyleSpecial li,
1.795     www      6460: .LC_ListStyleSpecial dd {
1.911     bisitz   6461:   margin: 0;
                   6462:   padding: 5px 5px 5px 10px;
                   6463:   clear: both;
1.693     droeschl 6464: }
                   6465: 
1.721     harmsja  6466: .LC_ListStyleClean li,
                   6467: .LC_ListStyleClean dd {
1.911     bisitz   6468:   padding-top: 0;
                   6469:   padding-bottom: 0;
1.693     droeschl 6470: }
                   6471: 
1.721     harmsja  6472: .LC_ListStyleSimple dd,
1.795     www      6473: .LC_ListStyleSimple li {
1.911     bisitz   6474:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6475: }
                   6476: 
1.721     harmsja  6477: .LC_ListStyleSpecial li,
                   6478: .LC_ListStyleSpecial dd {
1.911     bisitz   6479:   list-style-type: none;
                   6480:   background-color: RGB(220, 220, 220);
                   6481:   margin-bottom: 4px;
1.693     droeschl 6482: }
                   6483: 
1.721     harmsja  6484: table.LC_SimpleTable {
1.911     bisitz   6485:   margin:5px;
                   6486:   border:solid 1px $lg_border_color;
1.795     www      6487: }
1.693     droeschl 6488: 
1.721     harmsja  6489: table.LC_SimpleTable tr {
1.911     bisitz   6490:   padding: 0;
                   6491:   border:solid 1px $lg_border_color;
1.693     droeschl 6492: }
1.795     www      6493: 
                   6494: table.LC_SimpleTable thead {
1.911     bisitz   6495:   background:rgb(220,220,220);
1.693     droeschl 6496: }
                   6497: 
1.721     harmsja  6498: div.LC_columnSection {
1.911     bisitz   6499:   display: block;
                   6500:   clear: both;
                   6501:   overflow: hidden;
                   6502:   margin: 0;
1.693     droeschl 6503: }
                   6504: 
1.721     harmsja  6505: div.LC_columnSection>* {
1.911     bisitz   6506:   float: left;
                   6507:   margin: 10px 20px 10px 0;
                   6508:   overflow:hidden;
1.693     droeschl 6509: }
1.721     harmsja  6510: 
1.795     www      6511: table em {
1.911     bisitz   6512:   font-weight: bold;
                   6513:   font-style: normal;
1.748     schulted 6514: }
1.795     www      6515: 
1.779     bisitz   6516: table.LC_tableBrowseRes,
1.795     www      6517: table.LC_tableOfContent {
1.911     bisitz   6518:   border:none;
                   6519:   border-spacing: 1px;
                   6520:   padding: 3px;
                   6521:   background-color: #FFFFFF;
                   6522:   font-size: 90%;
1.753     droeschl 6523: }
1.789     droeschl 6524: 
1.911     bisitz   6525: table.LC_tableOfContent {
                   6526:   border-collapse: collapse;
1.789     droeschl 6527: }
                   6528: 
1.771     droeschl 6529: table.LC_tableBrowseRes a,
1.768     schulted 6530: table.LC_tableOfContent a {
1.911     bisitz   6531:   background-color: transparent;
                   6532:   text-decoration: none;
1.753     droeschl 6533: }
                   6534: 
1.795     www      6535: table.LC_tableOfContent img {
1.911     bisitz   6536:   border: none;
                   6537:   height: 1.3em;
                   6538:   vertical-align: text-bottom;
                   6539:   margin-right: 0.3em;
1.753     droeschl 6540: }
1.757     schulted 6541: 
1.795     www      6542: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6543:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6544: }
                   6545: 
1.795     www      6546: a#LC_content_toolbar_everything {
1.911     bisitz   6547:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6548: }
                   6549: 
1.795     www      6550: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6551:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6552: }
                   6553: 
1.795     www      6554: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6555:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6556: }
                   6557: 
1.795     www      6558: a#LC_content_toolbar_changefolder {
1.911     bisitz   6559:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6560: }
                   6561: 
1.795     www      6562: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6563:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6564: }
                   6565: 
1.795     www      6566: ul#LC_toolbar li a:hover {
1.911     bisitz   6567:   background-position: bottom center;
1.757     schulted 6568: }
                   6569: 
1.795     www      6570: ul#LC_toolbar {
1.911     bisitz   6571:   padding: 0;
                   6572:   margin: 2px;
                   6573:   list-style:none;
                   6574:   position:relative;
                   6575:   background-color:white;
1.757     schulted 6576: }
                   6577: 
1.795     www      6578: ul#LC_toolbar li {
1.911     bisitz   6579:   border:1px solid white;
                   6580:   padding: 0;
                   6581:   margin: 0;
                   6582:   float: left;
                   6583:   display:inline;
                   6584:   vertical-align:middle;
                   6585: }
1.757     schulted 6586: 
1.783     amueller 6587: 
1.795     www      6588: a.LC_toolbarItem {
1.911     bisitz   6589:   display:block;
                   6590:   padding: 0;
                   6591:   margin: 0;
                   6592:   height: 32px;
                   6593:   width: 32px;
                   6594:   color:white;
                   6595:   border: none;
                   6596:   background-repeat:no-repeat;
                   6597:   background-color:transparent;
1.757     schulted 6598: }
                   6599: 
1.915     droeschl 6600: ul.LC_funclist {
                   6601:     margin: 0;
                   6602:     padding: 0.5em 1em 0.5em 0;
                   6603: }
                   6604: 
1.933     droeschl 6605: ul.LC_funclist > li:first-child {
                   6606:     font-weight:bold; 
                   6607:     margin-left:0.8em;
                   6608: }
                   6609: 
1.915     droeschl 6610: ul.LC_funclist + ul.LC_funclist {
                   6611:     /* 
                   6612:        left border as a seperator if we have more than
                   6613:        one list 
                   6614:     */
                   6615:     border-left: 1px solid $sidebg;
                   6616:     /* 
                   6617:        this hides the left border behind the border of the 
                   6618:        outer box if element is wrapped to the next 'line' 
                   6619:     */
                   6620:     margin-left: -1px;
                   6621: }
                   6622: 
1.843     bisitz   6623: ul.LC_funclist li {
1.915     droeschl 6624:   display: inline;
1.782     bisitz   6625:   white-space: nowrap;
1.915     droeschl 6626:   margin: 0 0 0 25px;
                   6627:   line-height: 150%;
1.782     bisitz   6628: }
                   6629: 
1.974     wenzelju 6630: .LC_hidden {
                   6631:   display: none;
                   6632: }
                   6633: 
1.1030    www      6634: .LCmodal-overlay {
                   6635: 		position:fixed;
                   6636: 		top:0;
                   6637: 		right:0;
                   6638: 		bottom:0;
                   6639: 		left:0;
                   6640: 		height:100%;
                   6641: 		width:100%;
                   6642: 		margin:0;
                   6643: 		padding:0;
                   6644: 		background:#999;
                   6645: 		opacity:.75;
                   6646: 		filter: alpha(opacity=75);
                   6647: 		-moz-opacity: 0.75;
                   6648: 		z-index:101;
                   6649: }
                   6650: 
                   6651: * html .LCmodal-overlay {   
                   6652: 		position: absolute;
                   6653: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   6654: }
                   6655: 
                   6656: .LCmodal-window {
                   6657: 		position:fixed;
                   6658: 		top:50%;
                   6659: 		left:50%;
                   6660: 		margin:0;
                   6661: 		padding:0;
                   6662: 		z-index:102;
                   6663: 	}
                   6664: 
                   6665: * html .LCmodal-window {
                   6666: 		position:absolute;
                   6667: }
                   6668: 
                   6669: .LCclose-window {
                   6670: 		position:absolute;
                   6671: 		width:32px;
                   6672: 		height:32px;
                   6673: 		right:8px;
                   6674: 		top:8px;
                   6675: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   6676: 		text-indent:-99999px;
                   6677: 		overflow:hidden;
                   6678: 		cursor:pointer;
                   6679: }
                   6680: 
1.343     albertel 6681: END
                   6682: }
                   6683: 
1.306     albertel 6684: =pod
                   6685: 
                   6686: =item * &headtag()
                   6687: 
                   6688: Returns a uniform footer for LON-CAPA web pages.
                   6689: 
1.307     albertel 6690: Inputs: $title - optional title for the head
                   6691:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 6692:         $args - optional arguments
1.319     albertel 6693:             force_register - if is true call registerurl so the remote is 
                   6694:                              informed
1.415     albertel 6695:             redirect       -> array ref of
                   6696:                                    1- seconds before redirect occurs
                   6697:                                    2- url to redirect to
                   6698:                                    3- whether the side effect should occur
1.315     albertel 6699:                            (side effect of setting 
                   6700:                                $env{'internal.head.redirect'} to the url 
                   6701:                                redirected too)
1.352     albertel 6702:             domain         -> force to color decorate a page for a specific
                   6703:                                domain
                   6704:             function       -> force usage of a specific rolish color scheme
                   6705:             bgcolor        -> override the default page bgcolor
1.460     albertel 6706:             no_auto_mt_title
                   6707:                            -> prevent &mt()ing the title arg
1.464     albertel 6708: 
1.306     albertel 6709: =cut
                   6710: 
                   6711: sub headtag {
1.313     albertel 6712:     my ($title,$head_extra,$args) = @_;
1.306     albertel 6713:     
1.363     albertel 6714:     my $function = $args->{'function'} || &get_users_function();
                   6715:     my $domain   = $args->{'domain'}   || &determinedomain();
                   6716:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 6717:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 6718: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 6719: 		   #time(),
1.418     albertel 6720: 		   $env{'environment.color.timestamp'},
1.363     albertel 6721: 		   $function,$domain,$bgcolor);
                   6722: 
1.369     www      6723:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 6724: 
1.308     albertel 6725:     my $result =
                   6726: 	'<head>'.
1.461     albertel 6727: 	&font_settings();
1.319     albertel 6728: 
1.461     albertel 6729:     if (!$args->{'frameset'}) {
                   6730: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   6731:     }
1.962     droeschl 6732:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   6733:         $result .= Apache::lonxml::display_title();
1.319     albertel 6734:     }
1.436     albertel 6735:     if (!$args->{'no_nav_bar'} 
                   6736: 	&& !$args->{'only_body'}
                   6737: 	&& !$args->{'frameset'}) {
                   6738: 	$result .= &help_menu_js();
1.1032    www      6739:         $result.=&modal_window();
1.1038    www      6740:         $result.=&togglebox_script();
1.1034    www      6741:         $result.=&wishlist_window();
                   6742:     } else {
                   6743:         if ($args->{'add_modal'}) {
                   6744:            $result.=&modal_window();
                   6745:         }
                   6746:         if ($args->{'add_wishlist'}) {
                   6747:            $result.=&wishlist_window();
                   6748:         }
1.1038    www      6749:         if ($args->{'add_togglebox'}) {
                   6750:            $result.=&togglebox_script();
                   6751:         }
1.436     albertel 6752:     }
1.314     albertel 6753:     if (ref($args->{'redirect'})) {
1.414     albertel 6754: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6755: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6756: 	if (!$inhibit_continue) {
                   6757: 	    $env{'internal.head.redirect'} = $url;
                   6758: 	}
1.313     albertel 6759: 	$result.=<<ADDMETA
                   6760: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6761: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6762: ADDMETA
                   6763:     }
1.306     albertel 6764:     if (!defined($title)) {
                   6765: 	$title = 'The LearningOnline Network with CAPA';
                   6766:     }
1.460     albertel 6767:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6768:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6769: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   6770: 	.$head_extra;
1.962     droeschl 6771:     return $result.'</head>';
1.306     albertel 6772: }
                   6773: 
                   6774: =pod
                   6775: 
1.340     albertel 6776: =item * &font_settings()
                   6777: 
                   6778: Returns neccessary <meta> to set the proper encoding
                   6779: 
                   6780: Inputs: none
                   6781: 
                   6782: =cut
                   6783: 
                   6784: sub font_settings {
                   6785:     my $headerstring='';
1.647     www      6786:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6787: 	$headerstring.=
                   6788: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6789:     }
                   6790:     return $headerstring;
                   6791: }
                   6792: 
1.341     albertel 6793: =pod
                   6794: 
                   6795: =item * &xml_begin()
                   6796: 
                   6797: Returns the needed doctype and <html>
                   6798: 
                   6799: Inputs: none
                   6800: 
                   6801: =cut
                   6802: 
                   6803: sub xml_begin {
                   6804:     my $output='';
                   6805: 
                   6806:     if ($env{'browser.mathml'}) {
                   6807: 	$output='<?xml version="1.0"?>'
                   6808:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   6809: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   6810:             
                   6811: #	    .'<!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">] >'
                   6812: 	    .'<!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">'
                   6813:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   6814: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   6815:     } else {
1.849     bisitz   6816: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   6817:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 6818:     }
                   6819:     return $output;
                   6820: }
1.340     albertel 6821: 
                   6822: =pod
                   6823: 
1.306     albertel 6824: =item * &start_page()
                   6825: 
                   6826: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6827: 
1.648     raeburn  6828: Inputs:
                   6829: 
                   6830: =over 4
                   6831: 
                   6832: $title - optional title for the page
                   6833: 
                   6834: $head_extra - optional extra HTML to incude inside the <head>
                   6835: 
                   6836: $args - additional optional args supported are:
                   6837: 
                   6838: =over 8
                   6839: 
                   6840:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6841:                                     arg on
1.814     bisitz   6842:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  6843:              add_entries    -> additional attributes to add to the  <body>
                   6844:              domain         -> force to color decorate a page for a 
1.317     albertel 6845:                                     specific domain
1.648     raeburn  6846:              function       -> force usage of a specific rolish color
1.317     albertel 6847:                                     scheme
1.648     raeburn  6848:              redirect       -> see &headtag()
                   6849:              bgcolor        -> override the default page bg color
                   6850:              js_ready       -> return a string ready for being used in 
1.317     albertel 6851:                                     a javascript writeln
1.648     raeburn  6852:              html_encode    -> return a string ready for being used in 
1.320     albertel 6853:                                     a html attribute
1.648     raeburn  6854:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6855:                                     $forcereg arg
1.648     raeburn  6856:              frameset       -> if true will start with a <frameset>
1.330     albertel 6857:                                     rather than <body>
1.648     raeburn  6858:              skip_phases    -> hash ref of 
1.338     albertel 6859:                                     head -> skip the <html><head> generation
                   6860:                                     body -> skip all <body> generation
1.648     raeburn  6861:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6862:              inherit_jsmath -> when creating popup window in a page,
                   6863:                                     should it have jsmath forced on by the
                   6864:                                     current page
1.867     kalberla 6865:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  6866:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 6867: 
1.648     raeburn  6868: =back
1.460     albertel 6869: 
1.648     raeburn  6870: =back
1.562     albertel 6871: 
1.306     albertel 6872: =cut
                   6873: 
                   6874: sub start_page {
1.309     albertel 6875:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6876:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 6877: 
1.315     albertel 6878:     $env{'internal.start_page'}++;
1.338     albertel 6879:     my $result;
1.964     droeschl 6880: 
1.338     albertel 6881:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      6882:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 6883:     }
                   6884:     
                   6885:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6886: 	if ($args->{'frameset'}) {
                   6887: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6888: 						$args->{'add_entries'});
                   6889: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   6890:         } else {
                   6891:             $result .=
                   6892:                 &bodytag($title, 
                   6893:                          $args->{'function'},       $args->{'add_entries'},
                   6894:                          $args->{'only_body'},      $args->{'domain'},
                   6895:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 6896:                          $args->{'bgcolor'},        $args);
1.831     bisitz   6897:         }
1.330     albertel 6898:     }
1.338     albertel 6899: 
1.315     albertel 6900:     if ($args->{'js_ready'}) {
1.713     kaisler  6901: 		$result = &js_ready($result);
1.315     albertel 6902:     }
1.320     albertel 6903:     if ($args->{'html_encode'}) {
1.713     kaisler  6904: 		$result = &html_encode($result);
                   6905:     }
                   6906: 
1.813     bisitz   6907:     # Preparation for new and consistent functionlist at top of screen
                   6908:     # if ($args->{'functionlist'}) {
                   6909:     #            $result .= &build_functionlist();
                   6910:     #}
                   6911: 
1.964     droeschl 6912:     # Don't add anything more if only_body wanted or in const space
                   6913:     return $result if    $args->{'only_body'} 
                   6914:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   6915: 
                   6916:     #Breadcrumbs
1.758     kaisler  6917:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   6918: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   6919: 		#if any br links exists, add them to the breadcrumbs
                   6920: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6921: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6922: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6923: 			}
                   6924: 		}
                   6925: 
                   6926: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   6927: 		if(exists($args->{'bread_crumbs_component'})){
                   6928: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   6929: 		}else{
                   6930: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   6931: 		}
1.320     albertel 6932:     }
1.315     albertel 6933:     return $result;
1.306     albertel 6934: }
                   6935: 
                   6936: sub end_page {
1.315     albertel 6937:     my ($args) = @_;
                   6938:     $env{'internal.end_page'}++;
1.330     albertel 6939:     my $result;
1.335     albertel 6940:     if ($args->{'discussion'}) {
                   6941: 	my ($target,$parser);
                   6942: 	if (ref($args->{'discussion'})) {
                   6943: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6944: 				$args->{'discussion'}{'parser'});
                   6945: 	}
                   6946: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6947:     }
1.330     albertel 6948:     if ($args->{'frameset'}) {
                   6949: 	$result .= '</frameset>';
                   6950:     } else {
1.635     raeburn  6951: 	$result .= &endbodytag($args);
1.330     albertel 6952:     }
                   6953:     $result .= "\n</html>";
                   6954: 
1.315     albertel 6955:     if ($args->{'js_ready'}) {
1.317     albertel 6956: 	$result = &js_ready($result);
1.315     albertel 6957:     }
1.335     albertel 6958: 
1.320     albertel 6959:     if ($args->{'html_encode'}) {
                   6960: 	$result = &html_encode($result);
                   6961:     }
1.335     albertel 6962: 
1.315     albertel 6963:     return $result;
                   6964: }
                   6965: 
1.1034    www      6966: sub wishlist_window {
                   6967:     return(<<'ENDWISHLIST');
                   6968: <script type="text/javascript" lang="javascript">
                   6969: // <![CDATA[
                   6970: // <!-- BEGIN LON-CAPA Internal
                   6971: function set_wishlistlink(title, path) {
                   6972:     if (!title) {
                   6973:         title = document.title;
                   6974:         title = title.replace(/^LON-CAPA /,'');
                   6975:     }
                   6976:     if (!path) {
                   6977:         path = location.pathname;
                   6978:     }
                   6979:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   6980:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   6981: }
                   6982: // END LON-CAPA Internal -->
                   6983: // ]]>
                   6984: </script>
                   6985: ENDWISHLIST
                   6986: }
                   6987: 
1.1030    www      6988: sub modal_window {
                   6989:     return(<<'ENDMODAL');
                   6990: <script type="text/javascript" lang="javascript">
                   6991: // <![CDATA[
                   6992: // <!-- BEGIN LON-CAPA Internal
                   6993: var modalWindow = {
                   6994: 	parent:"body",
                   6995: 	windowId:null,
                   6996: 	content:null,
                   6997: 	width:null,
                   6998: 	height:null,
                   6999: 	close:function()
                   7000: 	{
                   7001: 	        $(".LCmodal-window").remove();
                   7002: 	        $(".LCmodal-overlay").remove();
                   7003: 	},
                   7004: 	open:function()
                   7005: 	{
                   7006: 		var modal = "";
                   7007: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7008: 		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;\">";
                   7009: 		modal += this.content;
                   7010: 		modal += "</div>";	
                   7011: 
                   7012: 		$(this.parent).append(modal);
                   7013: 
                   7014: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7015: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7016: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7017: 	}
                   7018: };
1.1031    www      7019: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7020: 	{
                   7021: 		modalWindow.windowId = "myModal";
                   7022: 		modalWindow.width = width;
                   7023: 		modalWindow.height = height;
1.1031    www      7024: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7025: 		modalWindow.open();
                   7026: 	};	
                   7027: // END LON-CAPA Internal -->
                   7028: // ]]>
                   7029: </script>
                   7030: ENDMODAL
                   7031: }
                   7032: 
                   7033: sub modal_link {
1.1031    www      7034:     my ($link,$linktext,$width,$height,$target,$scrolling)=@_;
1.1030    www      7035:     unless ($width) { $width=480; }
                   7036:     unless ($height) { $height=400; }
1.1031    www      7037:     unless ($scrolling) { $scrolling='yes'; }
                   7038:     return '<a href="'.$link.'" target="'.$target.'" onclick="openMyModal(\''.$link.'\','.$width.','.$height.',\''.$scrolling.'\'); return false;">'.
                   7039:            $linktext.'</a>';
1.1030    www      7040: }
                   7041: 
1.1032    www      7042: sub modal_adhoc_script {
                   7043:     my ($funcname,$width,$height,$content)=@_;
                   7044:     return (<<ENDADHOC);
                   7045: <script type="text/javascript" lang="javascript">
                   7046: // <![CDATA[
                   7047:         var $funcname = function()
                   7048:         {
                   7049:                 modalWindow.windowId = "myModal";
                   7050:                 modalWindow.width = $width;
                   7051:                 modalWindow.height = $height;
                   7052:                 modalWindow.content = '$content';
                   7053:                 modalWindow.open();
                   7054:         };  
                   7055: // ]]>
                   7056: </script>
                   7057: ENDADHOC
                   7058: }
                   7059: 
1.1038    www      7060: sub togglebox_script {
                   7061:    return(<<ENDTOGGLE);
                   7062: <script type="text/javascript"> 
                   7063: // <![CDATA[
                   7064: function LCtoggleDisplay(id,hidetext,showtext) {
                   7065:    link = document.getElementById(id + "link").childNodes[0];
                   7066:    with (document.getElementById(id).style) {
                   7067:       if (display == "none" ) {
                   7068:           display = "inline";
                   7069:           link.nodeValue = hidetext;
                   7070:         } else {
                   7071:           display = "none";
                   7072:           link.nodeValue = showtext;
                   7073:        }
                   7074:    }
                   7075: }
                   7076: // ]]>
                   7077: </script>
                   7078: ENDTOGGLE
                   7079: }
                   7080: 
1.1039    www      7081: sub start_togglebox {
                   7082:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7083:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7084:     unless ($showtext) { $showtext=&mt('show'); }
                   7085:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7086:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7087:     return &start_data_table().
                   7088:            &start_data_table_header_row().
                   7089:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7090:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7091:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7092:            &end_data_table_header_row().
                   7093:            '<tr id="'.$id.'" style="display:none""><td>';
                   7094: }
                   7095: 
                   7096: sub end_togglebox {
                   7097:     return '</td></tr>'.&end_data_table();
                   7098: }
                   7099: 
1.1035    www      7100: sub modal_adhoc_window {
                   7101:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7102:     my $innerwidth=$width-20;
                   7103:     $content=&js_ready(
                   7104:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   7105:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7106:                     $content.
                   7107:                  &end_scrollbox().
                   7108:                &end_page()
                   7109:              );
                   7110:     return &modal_adhoc_script($funcname,$width,$height,$content).
                   7111:          "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7112: }
                   7113: 
1.320     albertel 7114: sub html_encode {
                   7115:     my ($result) = @_;
                   7116: 
1.322     albertel 7117:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7118:     
                   7119:     return $result;
                   7120: }
1.317     albertel 7121: sub js_ready {
                   7122:     my ($result) = @_;
                   7123: 
1.323     albertel 7124:     $result =~ s/[\n\r]/ /xmsg;
                   7125:     $result =~ s/\\/\\\\/xmsg;
                   7126:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7127:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7128:     
                   7129:     return $result;
                   7130: }
                   7131: 
1.315     albertel 7132: sub validate_page {
                   7133:     if (  exists($env{'internal.start_page'})
1.316     albertel 7134: 	  &&     $env{'internal.start_page'} > 1) {
                   7135: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7136: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7137: 				 $ENV{'request.filename'});
1.315     albertel 7138:     }
                   7139:     if (  exists($env{'internal.end_page'})
1.316     albertel 7140: 	  &&     $env{'internal.end_page'} > 1) {
                   7141: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7142: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7143: 				 $env{'request.filename'});
1.315     albertel 7144:     }
                   7145:     if (     exists($env{'internal.start_page'})
                   7146: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7147: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7148: 				 $env{'request.filename'});
1.315     albertel 7149:     }
                   7150:     if (   ! exists($env{'internal.start_page'})
                   7151: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7152: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7153: 				 $env{'request.filename'});
1.315     albertel 7154:     }
1.306     albertel 7155: }
1.315     albertel 7156: 
1.996     www      7157: 
                   7158: sub start_scrollbox {
1.1018    raeburn  7159:     my ($outerwidth,$width,$height,$id)=@_;
1.998     raeburn  7160:     unless ($outerwidth) { $outerwidth='520px'; }
                   7161:     unless ($width) { $width='500px'; }
                   7162:     unless ($height) { $height='200px'; }
1.1020    raeburn  7163:     my ($table_id,$div_id);
1.1018    raeburn  7164:     if ($id ne '') {
1.1020    raeburn  7165:         $table_id = " id='table_$id'";
                   7166:         $div_id = " id='div_$id'";
1.1018    raeburn  7167:     }
1.1020    raeburn  7168:     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      7169: }
                   7170: 
                   7171: sub end_scrollbox {
1.1036    www      7172:     return '</div></td></tr></table>';
1.996     www      7173: }
                   7174: 
1.318     albertel 7175: sub simple_error_page {
                   7176:     my ($r,$title,$msg) = @_;
                   7177:     my $page =
                   7178: 	&Apache::loncommon::start_page($title).
                   7179: 	&mt($msg).
                   7180: 	&Apache::loncommon::end_page();
                   7181:     if (ref($r)) {
                   7182: 	$r->print($page);
1.327     albertel 7183: 	return;
1.318     albertel 7184:     }
                   7185:     return $page;
                   7186: }
1.347     albertel 7187: 
                   7188: {
1.610     albertel 7189:     my @row_count;
1.961     onken    7190: 
                   7191:     sub start_data_table_count {
                   7192:         unshift(@row_count, 0);
                   7193:         return;
                   7194:     }
                   7195: 
                   7196:     sub end_data_table_count {
                   7197:         shift(@row_count);
                   7198:         return;
                   7199:     }
                   7200: 
1.347     albertel 7201:     sub start_data_table {
1.1018    raeburn  7202: 	my ($add_class,$id) = @_;
1.422     albertel 7203: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7204:         my $table_id;
                   7205:         if (defined($id)) {
                   7206:             $table_id = ' id="'.$id.'"';
                   7207:         }
1.961     onken    7208: 	&start_data_table_count();
1.1018    raeburn  7209: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7210:     }
                   7211: 
                   7212:     sub end_data_table {
1.961     onken    7213: 	&end_data_table_count();
1.389     albertel 7214: 	return '</table>'."\n";;
1.347     albertel 7215:     }
                   7216: 
                   7217:     sub start_data_table_row {
1.974     wenzelju 7218: 	my ($add_class, $id) = @_;
1.610     albertel 7219: 	$row_count[0]++;
                   7220: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7221: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7222:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7223:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7224:     }
1.471     banghart 7225:     
                   7226:     sub continue_data_table_row {
1.974     wenzelju 7227: 	my ($add_class, $id) = @_;
1.610     albertel 7228: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7229: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7230:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7231:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7232:     }
1.347     albertel 7233: 
                   7234:     sub end_data_table_row {
1.389     albertel 7235: 	return '</tr>'."\n";;
1.347     albertel 7236:     }
1.367     www      7237: 
1.421     albertel 7238:     sub start_data_table_empty_row {
1.707     bisitz   7239: #	$row_count[0]++;
1.421     albertel 7240: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7241:     }
                   7242: 
                   7243:     sub end_data_table_empty_row {
                   7244: 	return '</tr>'."\n";;
                   7245:     }
                   7246: 
1.367     www      7247:     sub start_data_table_header_row {
1.389     albertel 7248: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7249:     }
                   7250: 
                   7251:     sub end_data_table_header_row {
1.389     albertel 7252: 	return '</tr>'."\n";;
1.367     www      7253:     }
1.890     droeschl 7254: 
                   7255:     sub data_table_caption {
                   7256:         my $caption = shift;
                   7257:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7258:     }
1.347     albertel 7259: }
                   7260: 
1.548     albertel 7261: =pod
                   7262: 
                   7263: =item * &inhibit_menu_check($arg)
                   7264: 
                   7265: Checks for a inhibitmenu state and generates output to preserve it
                   7266: 
                   7267: Inputs:         $arg - can be any of
                   7268:                      - undef - in which case the return value is a string 
                   7269:                                to add  into arguments list of a uri
                   7270:                      - 'input' - in which case the return value is a HTML
                   7271:                                  <form> <input> field of type hidden to
                   7272:                                  preserve the value
                   7273:                      - a url - in which case the return value is the url with
                   7274:                                the neccesary cgi args added to preserve the
                   7275:                                inhibitmenu state
                   7276:                      - a ref to a url - no return value, but the string is
                   7277:                                         updated to include the neccessary cgi
                   7278:                                         args to preserve the inhibitmenu state
                   7279: 
                   7280: =cut
                   7281: 
                   7282: sub inhibit_menu_check {
                   7283:     my ($arg) = @_;
                   7284:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7285:     if ($arg eq 'input') {
                   7286: 	if ($env{'form.inhibitmenu'}) {
                   7287: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7288: 	} else {
                   7289: 	    return
                   7290: 	}
                   7291:     }
                   7292:     if ($env{'form.inhibitmenu'}) {
                   7293: 	if (ref($arg)) {
                   7294: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7295: 	} elsif ($arg eq '') {
                   7296: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7297: 	} else {
                   7298: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7299: 	}
                   7300:     }
                   7301:     if (!ref($arg)) {
                   7302: 	return $arg;
                   7303:     }
                   7304: }
                   7305: 
1.251     albertel 7306: ###############################################
1.182     matthew  7307: 
                   7308: =pod
                   7309: 
1.549     albertel 7310: =back
                   7311: 
                   7312: =head1 User Information Routines
                   7313: 
                   7314: =over 4
                   7315: 
1.405     albertel 7316: =item * &get_users_function()
1.182     matthew  7317: 
                   7318: Used by &bodytag to determine the current users primary role.
                   7319: Returns either 'student','coordinator','admin', or 'author'.
                   7320: 
                   7321: =cut
                   7322: 
                   7323: ###############################################
                   7324: sub get_users_function {
1.815     tempelho 7325:     my $function = 'norole';
1.818     tempelho 7326:     if ($env{'request.role'}=~/^(st)/) {
                   7327:         $function='student';
                   7328:     }
1.907     raeburn  7329:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7330:         $function='coordinator';
                   7331:     }
1.258     albertel 7332:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7333:         $function='admin';
                   7334:     }
1.826     bisitz   7335:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  7336:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  7337:         $function='author';
                   7338:     }
                   7339:     return $function;
1.54      www      7340: }
1.99      www      7341: 
                   7342: ###############################################
                   7343: 
1.233     raeburn  7344: =pod
                   7345: 
1.821     raeburn  7346: =item * &show_course()
                   7347: 
                   7348: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7349: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7350: 
                   7351: Inputs:
                   7352: None
                   7353: 
                   7354: Outputs:
                   7355: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7356: 
                   7357: =cut
                   7358: 
                   7359: ###############################################
                   7360: sub show_course {
                   7361:     my $course = !$env{'user.adv'};
                   7362:     if (!$env{'user.adv'}) {
                   7363:         foreach my $env (keys(%env)) {
                   7364:             next if ($env !~ m/^user\.priv\./);
                   7365:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7366:                 $course = 0;
                   7367:                 last;
                   7368:             }
                   7369:         }
                   7370:     }
                   7371:     return $course;
                   7372: }
                   7373: 
                   7374: ###############################################
                   7375: 
                   7376: =pod
                   7377: 
1.542     raeburn  7378: =item * &check_user_status()
1.274     raeburn  7379: 
                   7380: Determines current status of supplied role for a
                   7381: specific user. Roles can be active, previous or future.
                   7382: 
                   7383: Inputs: 
                   7384: user's domain, user's username, course's domain,
1.375     raeburn  7385: course's number, optional section ID.
1.274     raeburn  7386: 
                   7387: Outputs:
                   7388: role status: active, previous or future. 
                   7389: 
                   7390: =cut
                   7391: 
                   7392: sub check_user_status {
1.412     raeburn  7393:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.982     raeburn  7394:     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   7395:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
1.274     raeburn  7396:     my @uroles = keys %userinfo;
                   7397:     my $srchstr;
                   7398:     my $active_chk = 'none';
1.412     raeburn  7399:     my $now = time;
1.274     raeburn  7400:     if (@uroles > 0) {
1.908     raeburn  7401:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7402:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7403:         } else {
1.412     raeburn  7404:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7405:         }
                   7406:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7407:             my $role_end = 0;
                   7408:             my $role_start = 0;
                   7409:             $active_chk = 'active';
1.412     raeburn  7410:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7411:                 $role_end = $1;
                   7412:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7413:                     $role_start = $1;
1.274     raeburn  7414:                 }
                   7415:             }
                   7416:             if ($role_start > 0) {
1.412     raeburn  7417:                 if ($now < $role_start) {
1.274     raeburn  7418:                     $active_chk = 'future';
                   7419:                 }
                   7420:             }
                   7421:             if ($role_end > 0) {
1.412     raeburn  7422:                 if ($now > $role_end) {
1.274     raeburn  7423:                     $active_chk = 'previous';
                   7424:                 }
                   7425:             }
                   7426:         }
                   7427:     }
                   7428:     return $active_chk;
                   7429: }
                   7430: 
                   7431: ###############################################
                   7432: 
                   7433: =pod
                   7434: 
1.405     albertel 7435: =item * &get_sections()
1.233     raeburn  7436: 
                   7437: Determines all the sections for a course including
                   7438: sections with students and sections containing other roles.
1.419     raeburn  7439: Incoming parameters: 
                   7440: 
                   7441: 1. domain
                   7442: 2. course number 
                   7443: 3. reference to array containing roles for which sections should 
                   7444: be gathered (optional).
                   7445: 4. reference to array containing status types for which sections 
                   7446: should be gathered (optional).
                   7447: 
                   7448: If the third argument is undefined, sections are gathered for any role. 
                   7449: If the fourth argument is undefined, sections are gathered for any status.
                   7450: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7451:  
1.374     raeburn  7452: Returns section hash (keys are section IDs, values are
                   7453: number of users in each section), subject to the
1.419     raeburn  7454: optional roles filter, optional status filter 
1.233     raeburn  7455: 
                   7456: =cut
                   7457: 
                   7458: ###############################################
                   7459: sub get_sections {
1.419     raeburn  7460:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7461:     if (!defined($cdom) || !defined($cnum)) {
                   7462:         my $cid =  $env{'request.course.id'};
                   7463: 
                   7464: 	return if (!defined($cid));
                   7465: 
                   7466:         $cdom = $env{'course.'.$cid.'.domain'};
                   7467:         $cnum = $env{'course.'.$cid.'.num'};
                   7468:     }
                   7469: 
                   7470:     my %sectioncount;
1.419     raeburn  7471:     my $now = time;
1.240     albertel 7472: 
1.366     albertel 7473:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7474: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7475: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7476: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7477:         my $start_index = &Apache::loncoursedata::CL_START();
                   7478:         my $end_index = &Apache::loncoursedata::CL_END();
                   7479:         my $status;
1.366     albertel 7480: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7481: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7482: 				                     $data->[$status_index],
                   7483:                                                      $data->[$start_index],
                   7484:                                                      $data->[$end_index]);
                   7485:             if ($stu_status eq 'Active') {
                   7486:                 $status = 'active';
                   7487:             } elsif ($end < $now) {
                   7488:                 $status = 'previous';
                   7489:             } elsif ($start > $now) {
                   7490:                 $status = 'future';
                   7491:             } 
                   7492: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7493:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7494:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7495: 		    $sectioncount{$section}++;
                   7496:                 }
1.240     albertel 7497: 	    }
                   7498: 	}
                   7499:     }
                   7500:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7501:     foreach my $user (sort(keys(%courseroles))) {
                   7502: 	if ($user !~ /^(\w{2})/) { next; }
                   7503: 	my ($role) = ($user =~ /^(\w{2})/);
                   7504: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7505: 	my ($section,$status);
1.240     albertel 7506: 	if ($role eq 'cr' &&
                   7507: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7508: 	    $section=$1;
                   7509: 	}
                   7510: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7511: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7512:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7513:         if ($end == -1 && $start == -1) {
                   7514:             next; #deleted role
                   7515:         }
                   7516:         if (!defined($possible_status)) { 
                   7517:             $sectioncount{$section}++;
                   7518:         } else {
                   7519:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7520:                 $status = 'active';
                   7521:             } elsif ($end < $now) {
                   7522:                 $status = 'future';
                   7523:             } elsif ($start > $now) {
                   7524:                 $status = 'previous';
                   7525:             }
                   7526:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7527:                 $sectioncount{$section}++;
                   7528:             }
                   7529:         }
1.233     raeburn  7530:     }
1.366     albertel 7531:     return %sectioncount;
1.233     raeburn  7532: }
                   7533: 
1.274     raeburn  7534: ###############################################
1.294     raeburn  7535: 
                   7536: =pod
1.405     albertel 7537: 
                   7538: =item * &get_course_users()
                   7539: 
1.275     raeburn  7540: Retrieves usernames:domains for users in the specified course
                   7541: with specific role(s), and access status. 
                   7542: 
                   7543: Incoming parameters:
1.277     albertel 7544: 1. course domain
                   7545: 2. course number
                   7546: 3. access status: users must have - either active, 
1.275     raeburn  7547: previous, future, or all.
1.277     albertel 7548: 4. reference to array of permissible roles
1.288     raeburn  7549: 5. reference to array of section restrictions (optional)
                   7550: 6. reference to results object (hash of hashes).
                   7551: 7. reference to optional userdata hash
1.609     raeburn  7552: 8. reference to optional statushash
1.630     raeburn  7553: 9. flag if privileged users (except those set to unhide in
                   7554:    course settings) should be excluded    
1.609     raeburn  7555: Keys of top level results hash are roles.
1.275     raeburn  7556: Keys of inner hashes are username:domain, with 
                   7557: values set to access type.
1.288     raeburn  7558: Optional userdata hash returns an array with arguments in the 
                   7559: same order as loncoursedata::get_classlist() for student data.
                   7560: 
1.609     raeburn  7561: Optional statushash returns
                   7562: 
1.288     raeburn  7563: Entries for end, start, section and status are blank because
                   7564: of the possibility of multiple values for non-student roles.
                   7565: 
1.275     raeburn  7566: =cut
1.405     albertel 7567: 
1.275     raeburn  7568: ###############################################
1.405     albertel 7569: 
1.275     raeburn  7570: sub get_course_users {
1.630     raeburn  7571:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7572:     my %idx = ();
1.419     raeburn  7573:     my %seclists;
1.288     raeburn  7574: 
                   7575:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7576:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7577:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7578:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7579:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7580:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7581:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7582:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7583: 
1.290     albertel 7584:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7585:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7586:         my $now = time;
1.277     albertel 7587:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7588:             my $match = 0;
1.412     raeburn  7589:             my $secmatch = 0;
1.419     raeburn  7590:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7591:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7592:             if ($section eq '') {
                   7593:                 $section = 'none';
                   7594:             }
1.291     albertel 7595:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7596:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7597:                     $secmatch = 1;
                   7598:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 7599:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7600:                         $secmatch = 1;
                   7601:                     }
                   7602:                 } else {  
1.419     raeburn  7603: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  7604: 		        $secmatch = 1;
                   7605:                     }
1.290     albertel 7606: 		}
1.412     raeburn  7607:                 if (!$secmatch) {
                   7608:                     next;
                   7609:                 }
1.419     raeburn  7610:             }
1.275     raeburn  7611:             if (defined($$types{'active'})) {
1.288     raeburn  7612:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  7613:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  7614:                     $match = 1;
1.275     raeburn  7615:                 }
                   7616:             }
                   7617:             if (defined($$types{'previous'})) {
1.609     raeburn  7618:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  7619:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  7620:                     $match = 1;
1.275     raeburn  7621:                 }
                   7622:             }
                   7623:             if (defined($$types{'future'})) {
1.609     raeburn  7624:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  7625:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  7626:                     $match = 1;
1.275     raeburn  7627:                 }
                   7628:             }
1.609     raeburn  7629:             if ($match) {
                   7630:                 push(@{$seclists{$student}},$section);
                   7631:                 if (ref($userdata) eq 'HASH') {
                   7632:                     $$userdata{$student} = $$classlist{$student};
                   7633:                 }
                   7634:                 if (ref($statushash) eq 'HASH') {
                   7635:                     $statushash->{$student}{'st'}{$section} = $status;
                   7636:                 }
1.288     raeburn  7637:             }
1.275     raeburn  7638:         }
                   7639:     }
1.412     raeburn  7640:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  7641:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7642:         my $now = time;
1.609     raeburn  7643:         my %displaystatus = ( previous => 'Expired',
                   7644:                               active   => 'Active',
                   7645:                               future   => 'Future',
                   7646:                             );
1.630     raeburn  7647:         my %nothide;
                   7648:         if ($hidepriv) {
                   7649:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   7650:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   7651:                 if ($user !~ /:/) {
                   7652:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   7653:                 } else {
                   7654:                     $nothide{$user} = 1;
                   7655:                 }
                   7656:             }
                   7657:         }
1.439     raeburn  7658:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  7659:             my $match = 0;
1.412     raeburn  7660:             my $secmatch = 0;
1.439     raeburn  7661:             my $status;
1.412     raeburn  7662:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  7663:             $user =~ s/:$//;
1.439     raeburn  7664:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   7665:             if ($end == -1 || $start == -1) {
                   7666:                 next;
                   7667:             }
                   7668:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   7669:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  7670:                 my ($uname,$udom) = split(/:/,$user);
                   7671:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7672:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7673:                         $secmatch = 1;
                   7674:                     } elsif ($usec eq '') {
1.420     albertel 7675:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7676:                             $secmatch = 1;
                   7677:                         }
                   7678:                     } else {
                   7679:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   7680:                             $secmatch = 1;
                   7681:                         }
                   7682:                     }
                   7683:                     if (!$secmatch) {
                   7684:                         next;
                   7685:                     }
1.288     raeburn  7686:                 }
1.419     raeburn  7687:                 if ($usec eq '') {
                   7688:                     $usec = 'none';
                   7689:                 }
1.275     raeburn  7690:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  7691:                     if ($hidepriv) {
                   7692:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   7693:                             (!$nothide{$uname.':'.$udom})) {
                   7694:                             next;
                   7695:                         }
                   7696:                     }
1.503     raeburn  7697:                     if ($end > 0 && $end < $now) {
1.439     raeburn  7698:                         $status = 'previous';
                   7699:                     } elsif ($start > $now) {
                   7700:                         $status = 'future';
                   7701:                     } else {
                   7702:                         $status = 'active';
                   7703:                     }
1.277     albertel 7704:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  7705:                         if ($status eq $type) {
1.420     albertel 7706:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  7707:                                 push(@{$$users{$role}{$user}},$type);
                   7708:                             }
1.288     raeburn  7709:                             $match = 1;
                   7710:                         }
                   7711:                     }
1.419     raeburn  7712:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   7713:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   7714: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   7715:                         }
1.420     albertel 7716:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  7717:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   7718:                         }
1.609     raeburn  7719:                         if (ref($statushash) eq 'HASH') {
                   7720:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   7721:                         }
1.275     raeburn  7722:                     }
                   7723:                 }
                   7724:             }
                   7725:         }
1.290     albertel 7726:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  7727:             if ((defined($cdom)) && (defined($cnum))) {
                   7728:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   7729:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   7730:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  7731:                     next if ($owner eq '');
                   7732:                     my ($ownername,$ownerdom);
                   7733:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   7734:                         $ownername = $1;
                   7735:                         $ownerdom = $2;
                   7736:                     } else {
                   7737:                         $ownername = $owner;
                   7738:                         $ownerdom = $cdom;
                   7739:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  7740:                     }
                   7741:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 7742:                     if (defined($userdata) && 
1.609     raeburn  7743: 			!exists($$userdata{$owner})) {
                   7744: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   7745:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   7746:                             push(@{$seclists{$owner}},'none');
                   7747:                         }
                   7748:                         if (ref($statushash) eq 'HASH') {
                   7749:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  7750:                         }
1.290     albertel 7751: 		    }
1.279     raeburn  7752:                 }
                   7753:             }
                   7754:         }
1.419     raeburn  7755:         foreach my $user (keys(%seclists)) {
                   7756:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   7757:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   7758:         }
1.275     raeburn  7759:     }
                   7760:     return;
                   7761: }
                   7762: 
1.288     raeburn  7763: sub get_user_info {
                   7764:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 7765:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   7766: 	&plainname($uname,$udom,'lastname');
1.291     albertel 7767:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  7768:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  7769:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   7770:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  7771:     return;
                   7772: }
1.275     raeburn  7773: 
1.472     raeburn  7774: ###############################################
                   7775: 
                   7776: =pod
                   7777: 
                   7778: =item * &get_user_quota()
                   7779: 
                   7780: Retrieves quota assigned for storage of portfolio files for a user  
                   7781: 
                   7782: Incoming parameters:
                   7783: 1. user's username
                   7784: 2. user's domain
                   7785: 
                   7786: Returns:
1.536     raeburn  7787: 1. Disk quota (in Mb) assigned to student.
                   7788: 2. (Optional) Type of setting: custom or default
                   7789:    (individually assigned or default for user's 
                   7790:    institutional status).
                   7791: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   7792:    or student - types as defined in localenroll::inst_usertypes 
                   7793:    for user's domain, which determines default quota for user.
                   7794: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  7795: 
                   7796: If a value has been stored in the user's environment, 
1.536     raeburn  7797: it will return that, otherwise it returns the maximal default
                   7798: defined for the user's instituional status(es) in the domain.
1.472     raeburn  7799: 
                   7800: =cut
                   7801: 
                   7802: ###############################################
                   7803: 
                   7804: 
                   7805: sub get_user_quota {
                   7806:     my ($uname,$udom) = @_;
1.536     raeburn  7807:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  7808:     if (!defined($udom)) {
                   7809:         $udom = $env{'user.domain'};
                   7810:     }
                   7811:     if (!defined($uname)) {
                   7812:         $uname = $env{'user.name'};
                   7813:     }
                   7814:     if (($udom eq '' || $uname eq '') ||
                   7815:         ($udom eq 'public') && ($uname eq 'public')) {
                   7816:         $quota = 0;
1.536     raeburn  7817:         $quotatype = 'default';
                   7818:         $defquota = 0; 
1.472     raeburn  7819:     } else {
1.536     raeburn  7820:         my $inststatus;
1.472     raeburn  7821:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   7822:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  7823:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  7824:         } else {
1.536     raeburn  7825:             my %userenv = 
                   7826:                 &Apache::lonnet::get('environment',['portfolioquota',
                   7827:                                      'inststatus'],$udom,$uname);
1.472     raeburn  7828:             my ($tmp) = keys(%userenv);
                   7829:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   7830:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  7831:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  7832:             } else {
                   7833:                 undef(%userenv);
                   7834:             }
                   7835:         }
1.536     raeburn  7836:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  7837:         if ($quota eq '') {
1.536     raeburn  7838:             $quota = $defquota;
                   7839:             $quotatype = 'default';
                   7840:         } else {
                   7841:             $quotatype = 'custom';
1.472     raeburn  7842:         }
                   7843:     }
1.536     raeburn  7844:     if (wantarray) {
                   7845:         return ($quota,$quotatype,$settingstatus,$defquota);
                   7846:     } else {
                   7847:         return $quota;
                   7848:     }
1.472     raeburn  7849: }
                   7850: 
                   7851: ###############################################
                   7852: 
                   7853: =pod
                   7854: 
                   7855: =item * &default_quota()
                   7856: 
1.536     raeburn  7857: Retrieves default quota assigned for storage of user portfolio files,
                   7858: given an (optional) user's institutional status.
1.472     raeburn  7859: 
                   7860: Incoming parameters:
                   7861: 1. domain
1.536     raeburn  7862: 2. (Optional) institutional status(es).  This is a : separated list of 
                   7863:    status types (e.g., faculty, staff, student etc.)
                   7864:    which apply to the user for whom the default is being retrieved.
                   7865:    If the institutional status string in undefined, the domain
                   7866:    default quota will be returned. 
1.472     raeburn  7867: 
                   7868: Returns:
                   7869: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  7870: 2. (Optional) institutional type which determined the value of the
                   7871:    default quota.
1.472     raeburn  7872: 
                   7873: If a value has been stored in the domain's configuration db,
                   7874: it will return that, otherwise it returns 20 (for backwards 
                   7875: compatibility with domains which have not set up a configuration
                   7876: db file; the original statically defined portfolio quota was 20 Mb). 
                   7877: 
1.536     raeburn  7878: If the user's status includes multiple types (e.g., staff and student),
                   7879: the largest default quota which applies to the user determines the
                   7880: default quota returned.
                   7881: 
1.780     raeburn  7882: =back
                   7883: 
1.472     raeburn  7884: =cut
                   7885: 
                   7886: ###############################################
                   7887: 
                   7888: 
                   7889: sub default_quota {
1.536     raeburn  7890:     my ($udom,$inststatus) = @_;
                   7891:     my ($defquota,$settingstatus);
                   7892:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  7893:                                             ['quotas'],$udom);
                   7894:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  7895:         if ($inststatus ne '') {
1.765     raeburn  7896:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  7897:             foreach my $item (@statuses) {
1.711     raeburn  7898:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7899:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   7900:                         if ($defquota eq '') {
                   7901:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7902:                             $settingstatus = $item;
                   7903:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   7904:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7905:                             $settingstatus = $item;
                   7906:                         }
                   7907:                     }
                   7908:                 } else {
                   7909:                     if ($quotahash{'quotas'}{$item} ne '') {
                   7910:                         if ($defquota eq '') {
                   7911:                             $defquota = $quotahash{'quotas'}{$item};
                   7912:                             $settingstatus = $item;
                   7913:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   7914:                             $defquota = $quotahash{'quotas'}{$item};
                   7915:                             $settingstatus = $item;
                   7916:                         }
1.536     raeburn  7917:                     }
                   7918:                 }
                   7919:             }
                   7920:         }
                   7921:         if ($defquota eq '') {
1.711     raeburn  7922:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7923:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   7924:             } else {
                   7925:                 $defquota = $quotahash{'quotas'}{'default'};
                   7926:             }
1.536     raeburn  7927:             $settingstatus = 'default';
                   7928:         }
                   7929:     } else {
                   7930:         $settingstatus = 'default';
                   7931:         $defquota = 20;
                   7932:     }
                   7933:     if (wantarray) {
                   7934:         return ($defquota,$settingstatus);
1.472     raeburn  7935:     } else {
1.536     raeburn  7936:         return $defquota;
1.472     raeburn  7937:     }
                   7938: }
                   7939: 
1.384     raeburn  7940: sub get_secgrprole_info {
                   7941:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   7942:     my %sections_count = &get_sections($cdom,$cnum);
                   7943:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   7944:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   7945:     my @groups = sort(keys(%curr_groups));
                   7946:     my $allroles = [];
                   7947:     my $rolehash;
                   7948:     my $accesshash = {
                   7949:                      active => 'Currently has access',
                   7950:                      future => 'Will have future access',
                   7951:                      previous => 'Previously had access',
                   7952:                   };
                   7953:     if ($needroles) {
                   7954:         $rolehash = {'all' => 'all'};
1.385     albertel 7955:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7956: 	if (&Apache::lonnet::error(%user_roles)) {
                   7957: 	    undef(%user_roles);
                   7958: 	}
                   7959:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  7960:             my ($role)=split(/\:/,$item,2);
                   7961:             if ($role eq 'cr') { next; }
                   7962:             if ($role =~ /^cr/) {
                   7963:                 $$rolehash{$role} = (split('/',$role))[3];
                   7964:             } else {
                   7965:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   7966:             }
                   7967:         }
                   7968:         foreach my $key (sort(keys(%{$rolehash}))) {
                   7969:             push(@{$allroles},$key);
                   7970:         }
                   7971:         push (@{$allroles},'st');
                   7972:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   7973:     }
                   7974:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   7975: }
                   7976: 
1.555     raeburn  7977: sub user_picker {
1.994     raeburn  7978:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  7979:     my $currdom = $dom;
                   7980:     my %curr_selected = (
                   7981:                         srchin => 'dom',
1.580     raeburn  7982:                         srchby => 'lastname',
1.555     raeburn  7983:                       );
                   7984:     my $srchterm;
1.625     raeburn  7985:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  7986:         if ($srch->{'srchby'} ne '') {
                   7987:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   7988:         }
                   7989:         if ($srch->{'srchin'} ne '') {
                   7990:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   7991:         }
                   7992:         if ($srch->{'srchtype'} ne '') {
                   7993:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   7994:         }
                   7995:         if ($srch->{'srchdomain'} ne '') {
                   7996:             $currdom = $srch->{'srchdomain'};
                   7997:         }
                   7998:         $srchterm = $srch->{'srchterm'};
                   7999:     }
                   8000:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8001:                     'usr'       => 'Search criteria',
1.563     raeburn  8002:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8003:                     'uname'     => 'username',
                   8004:                     'lastname'  => 'last name',
1.555     raeburn  8005:                     'lastfirst' => 'last name, first name',
1.558     albertel 8006:                     'crs'       => 'in this course',
1.576     raeburn  8007:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8008:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8009:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8010:                     'exact'     => 'is',
                   8011:                     'contains'  => 'contains',
1.569     raeburn  8012:                     'begins'    => 'begins with',
1.571     raeburn  8013:                     'youm'      => "You must include some text to search for.",
                   8014:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8015:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8016:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8017:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8018:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8019:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8020:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8021:                                        );
1.563     raeburn  8022:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8023:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8024: 
                   8025:     my @srchins = ('crs','dom','alc','instd');
                   8026: 
                   8027:     foreach my $option (@srchins) {
                   8028:         # FIXME 'alc' option unavailable until 
                   8029:         #       loncreateuser::print_user_query_page()
                   8030:         #       has been completed.
                   8031:         next if ($option eq 'alc');
1.880     raeburn  8032:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8033:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8034:         if ($curr_selected{'srchin'} eq $option) {
                   8035:             $srchinsel .= ' 
                   8036:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8037:         } else {
                   8038:             $srchinsel .= '
                   8039:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8040:         }
1.555     raeburn  8041:     }
1.563     raeburn  8042:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8043: 
                   8044:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8045:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8046:         if ($curr_selected{'srchby'} eq $option) {
                   8047:             $srchbysel .= '
                   8048:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8049:         } else {
                   8050:             $srchbysel .= '
                   8051:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8052:          }
                   8053:     }
                   8054:     $srchbysel .= "\n  </select>\n";
                   8055: 
                   8056:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8057:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8058:         if ($curr_selected{'srchtype'} eq $option) {
                   8059:             $srchtypesel .= '
                   8060:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8061:         } else {
                   8062:             $srchtypesel .= '
                   8063:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8064:         }
                   8065:     }
                   8066:     $srchtypesel .= "\n  </select>\n";
                   8067: 
1.558     albertel 8068:     my ($newuserscript,$new_user_create);
1.994     raeburn  8069:     my $context_dom = $env{'request.role.domain'};
                   8070:     if ($context eq 'requestcrs') {
                   8071:         if ($env{'form.coursedom'} ne '') { 
                   8072:             $context_dom = $env{'form.coursedom'};
                   8073:         }
                   8074:     }
1.556     raeburn  8075:     if ($forcenewuser) {
1.576     raeburn  8076:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8077:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8078:                 if ($cancreate) {
                   8079:                     $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>';
                   8080:                 } else {
1.799     bisitz   8081:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8082:                     my %usertypetext = (
                   8083:                         official   => 'institutional',
                   8084:                         unofficial => 'non-institutional',
                   8085:                     );
1.799     bisitz   8086:                     $new_user_create = '<p class="LC_warning">'
                   8087:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8088:                                       .' '
                   8089:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8090:                                           ,'<a href="'.$helplink.'">','</a>')
                   8091:                                       .'</p><br />';
1.627     raeburn  8092:                 }
1.576     raeburn  8093:             }
                   8094:         }
                   8095: 
1.556     raeburn  8096:         $newuserscript = <<"ENDSCRIPT";
                   8097: 
1.570     raeburn  8098: function setSearch(createnew,callingForm) {
1.556     raeburn  8099:     if (createnew == 1) {
1.570     raeburn  8100:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8101:             if (callingForm.srchby.options[i].value == 'uname') {
                   8102:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8103:             }
                   8104:         }
1.570     raeburn  8105:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8106:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8107: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8108:             }
                   8109:         }
1.570     raeburn  8110:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8111:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8112:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8113:             }
                   8114:         }
1.570     raeburn  8115:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8116:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8117:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8118:             }
                   8119:         }
                   8120:     }
                   8121: }
                   8122: ENDSCRIPT
1.558     albertel 8123: 
1.556     raeburn  8124:     }
                   8125: 
1.555     raeburn  8126:     my $output = <<"END_BLOCK";
1.556     raeburn  8127: <script type="text/javascript">
1.824     bisitz   8128: // <![CDATA[
1.570     raeburn  8129: function validateEntry(callingForm) {
1.558     albertel 8130: 
1.556     raeburn  8131:     var checkok = 1;
1.558     albertel 8132:     var srchin;
1.570     raeburn  8133:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8134: 	if ( callingForm.srchin[i].checked ) {
                   8135: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8136: 	}
                   8137:     }
                   8138: 
1.570     raeburn  8139:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8140:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8141:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8142:     var srchterm =  callingForm.srchterm.value;
                   8143:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8144:     var msg = "";
                   8145: 
                   8146:     if (srchterm == "") {
                   8147:         checkok = 0;
1.571     raeburn  8148:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8149:     }
                   8150: 
1.569     raeburn  8151:     if (srchtype== 'begins') {
                   8152:         if (srchterm.length < 2) {
                   8153:             checkok = 0;
1.571     raeburn  8154:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8155:         }
                   8156:     }
                   8157: 
1.556     raeburn  8158:     if (srchtype== 'contains') {
                   8159:         if (srchterm.length < 3) {
                   8160:             checkok = 0;
1.571     raeburn  8161:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8162:         }
                   8163:     }
                   8164:     if (srchin == 'instd') {
                   8165:         if (srchdomain == '') {
                   8166:             checkok = 0;
1.571     raeburn  8167:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8168:         }
                   8169:     }
                   8170:     if (srchin == 'dom') {
                   8171:         if (srchdomain == '') {
                   8172:             checkok = 0;
1.571     raeburn  8173:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8174:         }
                   8175:     }
                   8176:     if (srchby == 'lastfirst') {
                   8177:         if (srchterm.indexOf(",") == -1) {
                   8178:             checkok = 0;
1.571     raeburn  8179:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8180:         }
                   8181:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8182:             checkok = 0;
1.571     raeburn  8183:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8184:         }
                   8185:     }
                   8186:     if (checkok == 0) {
1.571     raeburn  8187:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8188:         return;
                   8189:     }
                   8190:     if (checkok == 1) {
1.570     raeburn  8191:         callingForm.submit();
1.556     raeburn  8192:     }
                   8193: }
                   8194: 
                   8195: $newuserscript
                   8196: 
1.824     bisitz   8197: // ]]>
1.556     raeburn  8198: </script>
1.558     albertel 8199: 
                   8200: $new_user_create
                   8201: 
1.555     raeburn  8202: END_BLOCK
1.558     albertel 8203: 
1.876     raeburn  8204:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8205:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8206:                $domform.
                   8207:                &Apache::lonhtmlcommon::row_closure().
                   8208:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8209:                $srchbysel.
                   8210:                $srchtypesel. 
                   8211:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8212:                $srchinsel.
                   8213:                &Apache::lonhtmlcommon::row_closure(1). 
                   8214:                &Apache::lonhtmlcommon::end_pick_box().
                   8215:                '<br />';
1.555     raeburn  8216:     return $output;
                   8217: }
                   8218: 
1.612     raeburn  8219: sub user_rule_check {
1.615     raeburn  8220:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8221:     my $response;
                   8222:     if (ref($usershash) eq 'HASH') {
                   8223:         foreach my $user (keys(%{$usershash})) {
                   8224:             my ($uname,$udom) = split(/:/,$user);
                   8225:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8226:             my ($id,$newuser);
1.612     raeburn  8227:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8228:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8229:                 $id = $usershash->{$user}->{'id'};
                   8230:             }
                   8231:             my $inst_response;
                   8232:             if (ref($checks) eq 'HASH') {
                   8233:                 if (defined($checks->{'username'})) {
1.615     raeburn  8234:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8235:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8236:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8237:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8238:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8239:                 }
1.615     raeburn  8240:             } else {
                   8241:                 ($inst_response,%{$inst_results->{$user}}) =
                   8242:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8243:                 return;
1.612     raeburn  8244:             }
1.615     raeburn  8245:             if (!$got_rules->{$udom}) {
1.612     raeburn  8246:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8247:                                                   ['usercreation'],$udom);
                   8248:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8249:                     foreach my $item ('username','id') {
1.612     raeburn  8250:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8251:                             $$curr_rules{$udom}{$item} = 
                   8252:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8253:                         }
                   8254:                     }
                   8255:                 }
1.615     raeburn  8256:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8257:             }
1.612     raeburn  8258:             foreach my $item (keys(%{$checks})) {
                   8259:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8260:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8261:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8262:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8263:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8264:                                 if ($rule_check{$rule}) {
                   8265:                                     $$rulematch{$user}{$item} = $rule;
                   8266:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8267:                                         if (ref($inst_results) eq 'HASH') {
                   8268:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8269:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8270:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8271:                                                 }
1.612     raeburn  8272:                                             }
                   8273:                                         }
1.615     raeburn  8274:                                     }
                   8275:                                     last;
1.585     raeburn  8276:                                 }
                   8277:                             }
                   8278:                         }
                   8279:                     }
                   8280:                 }
                   8281:             }
                   8282:         }
                   8283:     }
1.612     raeburn  8284:     return;
                   8285: }
                   8286: 
                   8287: sub user_rule_formats {
                   8288:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8289:     my %text = ( 
                   8290:                  'username' => 'Usernames',
                   8291:                  'id'       => 'IDs',
                   8292:                );
                   8293:     my $output;
                   8294:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8295:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8296:         if (@{$ruleorder} > 0) {
                   8297:             $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>';
                   8298:             foreach my $rule (@{$ruleorder}) {
                   8299:                 if (ref($curr_rules) eq 'ARRAY') {
                   8300:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8301:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8302:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8303:                                         $rules->{$rule}{'desc'}.'</li>';
                   8304:                         }
                   8305:                     }
                   8306:                 }
                   8307:             }
                   8308:             $output .= '</ul>';
                   8309:         }
                   8310:     }
                   8311:     return $output;
                   8312: }
                   8313: 
                   8314: sub instrule_disallow_msg {
1.615     raeburn  8315:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8316:     my $response;
                   8317:     my %text = (
                   8318:                   item   => 'username',
                   8319:                   items  => 'usernames',
                   8320:                   match  => 'matches',
                   8321:                   do     => 'does',
                   8322:                   action => 'a username',
                   8323:                   one    => 'one',
                   8324:                );
                   8325:     if ($count > 1) {
                   8326:         $text{'item'} = 'usernames';
                   8327:         $text{'match'} ='match';
                   8328:         $text{'do'} = 'do';
                   8329:         $text{'action'} = 'usernames',
                   8330:         $text{'one'} = 'ones';
                   8331:     }
                   8332:     if ($checkitem eq 'id') {
                   8333:         $text{'items'} = 'IDs';
                   8334:         $text{'item'} = 'ID';
                   8335:         $text{'action'} = 'an ID';
1.615     raeburn  8336:         if ($count > 1) {
                   8337:             $text{'item'} = 'IDs';
                   8338:             $text{'action'} = 'IDs';
                   8339:         }
1.612     raeburn  8340:     }
1.674     bisitz   8341:     $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  8342:     if ($mode eq 'upload') {
                   8343:         if ($checkitem eq 'username') {
                   8344:             $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'}.");
                   8345:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8346:             $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  8347:         }
1.669     raeburn  8348:     } elsif ($mode eq 'selfcreate') {
                   8349:         if ($checkitem eq 'id') {
                   8350:             $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.");
                   8351:         }
1.615     raeburn  8352:     } else {
                   8353:         if ($checkitem eq 'username') {
                   8354:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8355:         } elsif ($checkitem eq 'id') {
                   8356:             $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.");
                   8357:         }
1.612     raeburn  8358:     }
                   8359:     return $response;
1.585     raeburn  8360: }
                   8361: 
1.624     raeburn  8362: sub personal_data_fieldtitles {
                   8363:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8364:                         id => 'Student/Employee ID',
                   8365:                         permanentemail => 'E-mail address',
                   8366:                         lastname => 'Last Name',
                   8367:                         firstname => 'First Name',
                   8368:                         middlename => 'Middle Name',
                   8369:                         generation => 'Generation',
                   8370:                         gen => 'Generation',
1.765     raeburn  8371:                         inststatus => 'Affiliation',
1.624     raeburn  8372:                    );
                   8373:     return %fieldtitles;
                   8374: }
                   8375: 
1.642     raeburn  8376: sub sorted_inst_types {
                   8377:     my ($dom) = @_;
                   8378:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8379:     my $othertitle = &mt('All users');
                   8380:     if ($env{'request.course.id'}) {
1.668     raeburn  8381:         $othertitle  = &mt('Any users');
1.642     raeburn  8382:     }
                   8383:     my @types;
                   8384:     if (ref($order) eq 'ARRAY') {
                   8385:         @types = @{$order};
                   8386:     }
                   8387:     if (@types == 0) {
                   8388:         if (ref($usertypes) eq 'HASH') {
                   8389:             @types = sort(keys(%{$usertypes}));
                   8390:         }
                   8391:     }
                   8392:     if (keys(%{$usertypes}) > 0) {
                   8393:         $othertitle = &mt('Other users');
                   8394:     }
                   8395:     return ($othertitle,$usertypes,\@types);
                   8396: }
                   8397: 
1.645     raeburn  8398: sub get_institutional_codes {
                   8399:     my ($settings,$allcourses,$LC_code) = @_;
                   8400: # Get complete list of course sections to update
                   8401:     my @currsections = ();
                   8402:     my @currxlists = ();
                   8403:     my $coursecode = $$settings{'internal.coursecode'};
                   8404: 
                   8405:     if ($$settings{'internal.sectionnums'} ne '') {
                   8406:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8407:     }
                   8408: 
                   8409:     if ($$settings{'internal.crosslistings'} ne '') {
                   8410:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8411:     }
                   8412: 
                   8413:     if (@currxlists > 0) {
                   8414:         foreach (@currxlists) {
                   8415:             if (m/^([^:]+):(\w*)$/) {
                   8416:                 unless (grep/^$1$/,@{$allcourses}) {
                   8417:                     push @{$allcourses},$1;
                   8418:                     $$LC_code{$1} = $2;
                   8419:                 }
                   8420:             }
                   8421:         }
                   8422:     }
                   8423:  
                   8424:     if (@currsections > 0) {
                   8425:         foreach (@currsections) {
                   8426:             if (m/^(\w+):(\w*)$/) {
                   8427:                 my $sec = $coursecode.$1;
                   8428:                 my $lc_sec = $2;
                   8429:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8430:                     push @{$allcourses},$sec;
                   8431:                     $$LC_code{$sec} = $lc_sec;
                   8432:                 }
                   8433:             }
                   8434:         }
                   8435:     }
                   8436:     return;
                   8437: }
                   8438: 
1.971     raeburn  8439: sub get_standard_codeitems {
                   8440:     return ('Year','Semester','Department','Number','Section');
                   8441: }
                   8442: 
1.112     bowersj2 8443: =pod
                   8444: 
1.780     raeburn  8445: =head1 Slot Helpers
                   8446: 
                   8447: =over 4
                   8448: 
                   8449: =item * sorted_slots()
                   8450: 
1.1040  ! raeburn  8451: Sorts an array of slot names in order of an optional sort key,
        !          8452: default sort is by slot start time (earliest first). 
1.780     raeburn  8453: 
                   8454: Inputs:
                   8455: 
                   8456: =over 4
                   8457: 
                   8458: slotsarr  - Reference to array of unsorted slot names.
                   8459: 
                   8460: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8461: 
1.1040  ! raeburn  8462: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
        !          8463: 
1.549     albertel 8464: =back
                   8465: 
1.780     raeburn  8466: Returns:
                   8467: 
                   8468: =over 4
                   8469: 
1.1040  ! raeburn  8470: sorted   - An array of slot names sorted by a specified sort key 
        !          8471:            (default sort key is start time of the slot).
1.780     raeburn  8472: 
                   8473: =back
                   8474: 
                   8475: =cut
                   8476: 
                   8477: 
                   8478: sub sorted_slots {
1.1040  ! raeburn  8479:     my ($slotsarr,$slots,$sortkey) = @_;
        !          8480:     if ($sortkey eq '') {
        !          8481:         $sortkey = 'starttime';
        !          8482:     }
1.780     raeburn  8483:     my @sorted;
                   8484:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8485:         @sorted =
                   8486:             sort {
                   8487:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040  ! raeburn  8488:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  8489:                      }
                   8490:                      if (ref($slots->{$a})) { return -1;}
                   8491:                      if (ref($slots->{$b})) { return 1;}
                   8492:                      return 0;
                   8493:                  } @{$slotsarr};
                   8494:     }
                   8495:     return @sorted;
                   8496: }
                   8497: 
1.1040  ! raeburn  8498: =pod
        !          8499: 
        !          8500: =item * get_future_slots()
        !          8501: 
        !          8502: Inputs:
        !          8503: 
        !          8504: =over 4
        !          8505: 
        !          8506: cnum - course number
        !          8507: 
        !          8508: cdom - course domain
        !          8509: 
        !          8510: now - current UNIX time
        !          8511: 
        !          8512: symb - optional symb
        !          8513: 
        !          8514: =back
        !          8515: 
        !          8516: Returns:
        !          8517: 
        !          8518: =over 4
        !          8519: 
        !          8520: sorted_reservable - ref to array of student_schedulable slots currently 
        !          8521:                     reservable, ordered by end date of reservation period.
        !          8522: 
        !          8523: reservable_now - ref to hash of student_schedulable slots currently
        !          8524:                  reservable.
        !          8525: 
        !          8526:     Keys in inner hash are:
        !          8527:     (a) symb: either blank or symb to which slot use is restricted.
        !          8528:     (b) endreserve: end date of reservation period. 
        !          8529: 
        !          8530: sorted_future - ref to array of student_schedulable slots reservable in
        !          8531:                 the future, ordered by start date of reservation period.
        !          8532: 
        !          8533: future_reservable - ref to hash of student_schedulable slots reservable
        !          8534:                     in the future.
        !          8535: 
        !          8536:     Keys in inner hash are:
        !          8537:     (a) symb: either blank or symb to which slot use is restricted.
        !          8538:     (b) startreserve:  start date of reservation period.
        !          8539: 
        !          8540: =back
        !          8541: 
        !          8542: =cut
        !          8543: 
        !          8544: sub get_future_slots {
        !          8545:     my ($cnum,$cdom,$now,$symb) = @_;
        !          8546:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
        !          8547:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
        !          8548:     foreach my $slot (keys(%slots)) {
        !          8549:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
        !          8550:         if ($symb) {
        !          8551:             next if (($slots{$slot}->{'symb'} ne '') && 
        !          8552:                      ($slots{$slot}->{'symb'} ne $symb));
        !          8553:         }
        !          8554:         if (($slots{$slot}->{'starttime'} > $now) &&
        !          8555:             ($slots{$slot}->{'endtime'} > $now)) {
        !          8556:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
        !          8557:                 my $userallowed = 0;
        !          8558:                 if ($slots{$slot}->{'allowedsections'}) {
        !          8559:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
        !          8560:                     if (!defined($env{'request.role.sec'})
        !          8561:                         && grep(/^No section assigned$/,@allowed_sec)) {
        !          8562:                         $userallowed=1;
        !          8563:                     } else {
        !          8564:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
        !          8565:                             $userallowed=1;
        !          8566:                         }
        !          8567:                     }
        !          8568:                     unless ($userallowed) {
        !          8569:                         if (defined($env{'request.course.groups'})) {
        !          8570:                             my @groups = split(/:/,$env{'request.course.groups'});
        !          8571:                             foreach my $group (@groups) {
        !          8572:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
        !          8573:                                     $userallowed=1;
        !          8574:                                     last;
        !          8575:                                 }
        !          8576:                             }
        !          8577:                         }
        !          8578:                     }
        !          8579:                 }
        !          8580:                 if ($slots{$slot}->{'allowedusers'}) {
        !          8581:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
        !          8582:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
        !          8583:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
        !          8584:                         $userallowed = 1;
        !          8585:                     }
        !          8586:                 }
        !          8587:                 next unless($userallowed);
        !          8588:             }
        !          8589:             my $startreserve = $slots{$slot}->{'startreserve'};
        !          8590:             my $endreserve = $slots{$slot}->{'endreserve'};
        !          8591:             my $symb = $slots{$slot}->{'symb'};
        !          8592:             if (($startreserve < $now) &&
        !          8593:                 (!$endreserve || $endreserve > $now)) {
        !          8594:                 my $lastres = $endreserve;
        !          8595:                 if (!$lastres) {
        !          8596:                     $lastres = $slots{$slot}->{'starttime'};
        !          8597:                 }
        !          8598:                 $reservable_now{$slot} = {
        !          8599:                                            symb       => $symb,
        !          8600:                                            endreserve => $lastres
        !          8601:                                          };
        !          8602:             } elsif (($startreserve > $now) &&
        !          8603:                      (!$endreserve || $endreserve > $startreserve)) {
        !          8604:                 $future_reservable{$slot} = {
        !          8605:                                               symb         => $symb,
        !          8606:                                               startreserve => $startreserve
        !          8607:                                             };
        !          8608:             }
        !          8609:         }
        !          8610:     }
        !          8611:     my @unsorted_reservable = keys(%reservable_now);
        !          8612:     if (@unsorted_reservable > 0) {
        !          8613:         @sorted_reservable = 
        !          8614:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
        !          8615:     }
        !          8616:     my @unsorted_future = keys(%future_reservable);
        !          8617:     if (@unsorted_future > 0) {
        !          8618:         @sorted_future =
        !          8619:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
        !          8620:     }
        !          8621:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
        !          8622: }
1.780     raeburn  8623: 
                   8624: =pod
                   8625: 
1.549     albertel 8626: =head1 HTTP Helpers
                   8627: 
                   8628: =over 4
                   8629: 
1.648     raeburn  8630: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 8631: 
1.258     albertel 8632: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 8633: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 8634: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 8635: 
                   8636: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   8637: $possible_names is an ref to an array of form element names.  As an example:
                   8638: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 8639: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 8640: 
                   8641: =cut
1.1       albertel 8642: 
1.6       albertel 8643: sub get_unprocessed_cgi {
1.25      albertel 8644:   my ($query,$possible_names)= @_;
1.26      matthew  8645:   # $Apache::lonxml::debug=1;
1.356     albertel 8646:   foreach my $pair (split(/&/,$query)) {
                   8647:     my ($name, $value) = split(/=/,$pair);
1.369     www      8648:     $name = &unescape($name);
1.25      albertel 8649:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   8650:       $value =~ tr/+/ /;
                   8651:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 8652:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 8653:     }
1.16      harris41 8654:   }
1.6       albertel 8655: }
                   8656: 
1.112     bowersj2 8657: =pod
                   8658: 
1.648     raeburn  8659: =item * &cacheheader() 
1.112     bowersj2 8660: 
                   8661: returns cache-controlling header code
                   8662: 
                   8663: =cut
                   8664: 
1.7       albertel 8665: sub cacheheader {
1.258     albertel 8666:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 8667:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   8668:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 8669:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   8670:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 8671:     return $output;
1.7       albertel 8672: }
                   8673: 
1.112     bowersj2 8674: =pod
                   8675: 
1.648     raeburn  8676: =item * &no_cache($r) 
1.112     bowersj2 8677: 
                   8678: specifies header code to not have cache
                   8679: 
                   8680: =cut
                   8681: 
1.9       albertel 8682: sub no_cache {
1.216     albertel 8683:     my ($r) = @_;
                   8684:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 8685: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 8686:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   8687:     $r->no_cache(1);
                   8688:     $r->header_out("Expires" => $date);
                   8689:     $r->header_out("Pragma" => "no-cache");
1.123     www      8690: }
                   8691: 
                   8692: sub content_type {
1.181     albertel 8693:     my ($r,$type,$charset) = @_;
1.299     foxr     8694:     if ($r) {
                   8695: 	#  Note that printout.pl calls this with undef for $r.
                   8696: 	&no_cache($r);
                   8697:     }
1.258     albertel 8698:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 8699:     unless ($charset) {
                   8700: 	$charset=&Apache::lonlocal::current_encoding;
                   8701:     }
                   8702:     if ($charset) { $type.='; charset='.$charset; }
                   8703:     if ($r) {
                   8704: 	$r->content_type($type);
                   8705:     } else {
                   8706: 	print("Content-type: $type\n\n");
                   8707:     }
1.9       albertel 8708: }
1.25      albertel 8709: 
1.112     bowersj2 8710: =pod
                   8711: 
1.648     raeburn  8712: =item * &add_to_env($name,$value) 
1.112     bowersj2 8713: 
1.258     albertel 8714: adds $name to the %env hash with value
1.112     bowersj2 8715: $value, if $name already exists, the entry is converted to an array
                   8716: reference and $value is added to the array.
                   8717: 
                   8718: =cut
                   8719: 
1.25      albertel 8720: sub add_to_env {
                   8721:   my ($name,$value)=@_;
1.258     albertel 8722:   if (defined($env{$name})) {
                   8723:     if (ref($env{$name})) {
1.25      albertel 8724:       #already have multiple values
1.258     albertel 8725:       push(@{ $env{$name} },$value);
1.25      albertel 8726:     } else {
                   8727:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 8728:       my $first=$env{$name};
                   8729:       undef($env{$name});
                   8730:       push(@{ $env{$name} },$first,$value);
1.25      albertel 8731:     }
                   8732:   } else {
1.258     albertel 8733:     $env{$name}=$value;
1.25      albertel 8734:   }
1.31      albertel 8735: }
1.149     albertel 8736: 
                   8737: =pod
                   8738: 
1.648     raeburn  8739: =item * &get_env_multiple($name) 
1.149     albertel 8740: 
1.258     albertel 8741: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 8742: values may be defined and end up as an array ref.
                   8743: 
                   8744: returns an array of values
                   8745: 
                   8746: =cut
                   8747: 
                   8748: sub get_env_multiple {
                   8749:     my ($name) = @_;
                   8750:     my @values;
1.258     albertel 8751:     if (defined($env{$name})) {
1.149     albertel 8752:         # exists is it an array
1.258     albertel 8753:         if (ref($env{$name})) {
                   8754:             @values=@{ $env{$name} };
1.149     albertel 8755:         } else {
1.258     albertel 8756:             $values[0]=$env{$name};
1.149     albertel 8757:         }
                   8758:     }
                   8759:     return(@values);
                   8760: }
                   8761: 
1.660     raeburn  8762: sub ask_for_embedded_content {
                   8763:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.987     raeburn  8764:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
1.660     raeburn  8765:     my $num = 0;
1.987     raeburn  8766:     my $numremref = 0;
                   8767:     my $numinvalid = 0;
                   8768:     my $numpathchg = 0;
                   8769:     my $numexisting = 0;
                   8770:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
1.984     raeburn  8771:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8772:         my $current_path='/';
                   8773:         if ($env{'form.currentpath'}) {
                   8774:             $current_path = $env{'form.currentpath'};
                   8775:         }
                   8776:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   8777:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8778:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   8779:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   8780:         } else {
                   8781:             $udom = $env{'user.domain'};
                   8782:             $uname = $env{'user.name'};
                   8783:             $url = '/userfiles/portfolio';
                   8784:         }
1.987     raeburn  8785:         $toplevel = $url.'/';
1.984     raeburn  8786:         $url .= $current_path;
                   8787:         $getpropath = 1;
1.987     raeburn  8788:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   8789:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      8790:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  8791:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  8792:         $toplevel = $url;
1.984     raeburn  8793:         if ($rest ne '') {
1.987     raeburn  8794:             $url .= $rest;
                   8795:         }
                   8796:     } elsif ($actionurl eq '/adm/coursedocs') {
                   8797:         if (ref($args) eq 'HASH') {
                   8798:            $url = $args->{'docs_url'};
                   8799:            $toplevel = $url;
                   8800:         }
                   8801:     }
                   8802:     my $now = time();
                   8803:     foreach my $embed_file (keys(%{$allfiles})) {
                   8804:         my $absolutepath;
                   8805:         if ($embed_file =~ m{^\w+://}) {
                   8806:             $newfiles{$embed_file} = 1;
                   8807:             $mapping{$embed_file} = $embed_file;
                   8808:         } else {
                   8809:             if ($embed_file =~ m{^/}) {
                   8810:                 $absolutepath = $embed_file;
                   8811:                 $embed_file =~ s{^(/+)}{};
                   8812:             }
                   8813:             if ($embed_file =~ m{/}) {
                   8814:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   8815:                 $path = &check_for_traversal($path,$url,$toplevel);
                   8816:                 my $item = $fname;
                   8817:                 if ($path ne '') {
                   8818:                     $item = $path.'/'.$fname;
                   8819:                     $subdependencies{$path}{$fname} = 1;
                   8820:                 } else {
                   8821:                     $dependencies{$item} = 1;
                   8822:                 }
                   8823:                 if ($absolutepath) {
                   8824:                     $mapping{$item} = $absolutepath;
                   8825:                 } else {
                   8826:                     $mapping{$item} = $embed_file;
                   8827:                 }
                   8828:             } else {
                   8829:                 $dependencies{$embed_file} = 1;
                   8830:                 if ($absolutepath) {
                   8831:                     $mapping{$embed_file} = $absolutepath;
                   8832:                 } else {
                   8833:                     $mapping{$embed_file} = $embed_file;
                   8834:                 }
                   8835:             }
1.984     raeburn  8836:         }
                   8837:     }
                   8838:     foreach my $path (keys(%subdependencies)) {
                   8839:         my %currsubfile;
                   8840:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  8841:             my ($sublistref,$listerror) =
                   8842:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   8843:             if (ref($sublistref) eq 'ARRAY') {
                   8844:                 foreach my $line (@{$sublistref}) {
                   8845:                     my ($file_name,$rest) = split(/\&/,$line,2);
                   8846:                     $currsubfile{$file_name} = 1;
                   8847:                 }
1.984     raeburn  8848:             }
1.987     raeburn  8849:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8850:             if (opendir(my $dir,$url.'/'.$path)) {
                   8851:                 my @subdir_list = grep(!/^\./,readdir($dir));
                   8852:                 map {$currsubfile{$_} = 1;} @subdir_list;
                   8853:             }
                   8854:         }
                   8855:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.987     raeburn  8856:             if ($currsubfile{$file}) {
                   8857:                 my $item = $path.'/'.$file;
                   8858:                 unless ($mapping{$item} eq $item) {
                   8859:                     $pathchanges{$item} = 1;
                   8860:                 }
                   8861:                 $existing{$item} = 1;
                   8862:                 $numexisting ++;
                   8863:             } else {
                   8864:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  8865:             }
                   8866:         }
                   8867:     }
1.987     raeburn  8868:     my %currfile;
1.984     raeburn  8869:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  8870:         my ($dirlistref,$listerror) =
                   8871:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   8872:         if (ref($dirlistref) eq 'ARRAY') {
                   8873:             foreach my $line (@{$dirlistref}) {
                   8874:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   8875:                 $currfile{$file_name} = 1;
                   8876:             }
1.984     raeburn  8877:         }
1.987     raeburn  8878:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8879:         if (opendir(my $dir,$url)) {
1.987     raeburn  8880:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  8881:             map {$currfile{$_} = 1;} @dir_list;
                   8882:         }
                   8883:     }
                   8884:     foreach my $file (keys(%dependencies)) {
1.987     raeburn  8885:         if ($currfile{$file}) {
                   8886:             unless ($mapping{$file} eq $file) {
                   8887:                 $pathchanges{$file} = 1;
                   8888:             }
                   8889:             $existing{$file} = 1;
                   8890:             $numexisting ++;
                   8891:         } else {
1.984     raeburn  8892:             $newfiles{$file} = 1;
                   8893:         }
                   8894:     }
                   8895:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.660     raeburn  8896:         $upload_output .= &start_data_table_row().
1.987     raeburn  8897:                           '<td><span class="LC_filename">'.$embed_file.'</span>';
                   8898:         unless ($mapping{$embed_file} eq $embed_file) {
                   8899:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   8900:         }
                   8901:         $upload_output .= '</td><td>';
1.660     raeburn  8902:         if ($args->{'ignore_remote_references'}
                   8903:             && $embed_file =~ m{^\w+://}) {
                   8904:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  8905:             $numremref++;
1.660     raeburn  8906:         } elsif ($args->{'error_on_invalid_names'}
                   8907:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   8908: 
1.987     raeburn  8909:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   8910:             $numinvalid++;
1.660     raeburn  8911:         } else {
1.987     raeburn  8912:             $upload_output .= &embedded_file_element('upload_embedded',$num,
                   8913:                                                      $embed_file,\%mapping,
                   8914:                                                      $allfiles,$codebase);
                   8915:             $num++;
                   8916:         }
                   8917:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   8918:     }
                   8919:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
                   8920:         $upload_output .= &start_data_table_row().
                   8921:                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.
                   8922:                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   8923:                           &Apache::loncommon::end_data_table_row()."\n";
                   8924:     }
                   8925:     if ($upload_output) {
                   8926:         $upload_output = &start_data_table().
                   8927:                          $upload_output.
                   8928:                          &end_data_table()."\n";
                   8929:     }
                   8930:     my $applies = 0;
                   8931:     if ($numremref) {
                   8932:         $applies ++;
                   8933:     }
                   8934:     if ($numinvalid) {
                   8935:         $applies ++;
                   8936:     }
                   8937:     if ($numexisting) {
                   8938:         $applies ++;
                   8939:     }
                   8940:     if ($num) {
                   8941:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   8942:                   ' method="post" enctype="multipart/form-data">'."\n".
                   8943:                   $state.
                   8944:                   '<h3>'.&mt('Upload embedded files').
                   8945:                   ':</h3>'.$upload_output.'<br />'."\n".
                   8946:                   '<input type ="hidden" name="number_embedded_items" value="'.
                   8947:                   $num.'" />'."\n";
                   8948:         if ($actionurl eq '') {
                   8949:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   8950:         }
                   8951:     } elsif ($applies) {
                   8952:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   8953:         if ($applies > 1) {
                   8954:             $output .=  
                   8955:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   8956:             if ($numremref) {
                   8957:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   8958:             }
                   8959:             if ($numinvalid) {
                   8960:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   8961:             }
                   8962:             if ($numexisting) {
                   8963:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   8964:             }
                   8965:             $output .= '</ul><br />';
                   8966:         } elsif ($numremref) {
                   8967:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   8968:         } elsif ($numinvalid) {
                   8969:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   8970:         } elsif ($numexisting) {
                   8971:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   8972:         }
                   8973:         $output .= $upload_output.'<br />';
                   8974:     }
                   8975:     my ($pathchange_output,$chgcount);
                   8976:     $chgcount = $num;
                   8977:     if (keys(%pathchanges) > 0) {
                   8978:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
                   8979:             if ($num) {
                   8980:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   8981:                                                   $embed_file,\%mapping,
                   8982:                                                   $allfiles,$codebase);
                   8983:             } else {
                   8984:                 $pathchange_output .= 
                   8985:                     &start_data_table_row().
                   8986:                     '<td><input type ="checkbox" name="namechange" value="'.
                   8987:                     $chgcount.'" checked="checked" /></td>'.
                   8988:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   8989:                     '<td>'.$embed_file.
                   8990:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
                   8991:                                            \%mapping,$allfiles,$codebase).
                   8992:                     '</td>'.&end_data_table_row();
1.660     raeburn  8993:             }
1.987     raeburn  8994:             $numpathchg ++;
                   8995:             $chgcount ++;
1.660     raeburn  8996:         }
                   8997:     }
1.984     raeburn  8998:     if ($num) {
1.987     raeburn  8999:         if ($numpathchg) {
                   9000:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9001:                        $numpathchg.'" />'."\n";
                   9002:         }
                   9003:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9004:             ($actionurl eq '/adm/imsimport')) {
                   9005:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9006:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9007:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
                   9008:         }
                   9009:         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".
                   9010:                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";
                   9011:     } elsif ($numpathchg) {
                   9012:         my %pathchange = ();
                   9013:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9014:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9015:             $output .= '<p>'.&mt('or').'</p>'; 
                   9016:         } 
                   9017:     }
                   9018:     return ($output,$num,$numpathchg);
                   9019: }
                   9020: 
                   9021: sub embedded_file_element {
                   9022:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
                   9023:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9024:                    (ref($codebase) eq 'HASH'));
                   9025:     my $output;
                   9026:     if ($context eq 'upload_embedded') {
                   9027:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9028:     }
                   9029:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9030:                &escape($embed_file).'" />';
                   9031:     unless (($context eq 'upload_embedded') && 
                   9032:             ($mapping->{$embed_file} eq $embed_file)) {
                   9033:         $output .='
                   9034:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9035:     }
                   9036:     my $attrib;
                   9037:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9038:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9039:     }
                   9040:     $output .=
                   9041:         "\n\t\t".
                   9042:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9043:         $attrib.'" />';
                   9044:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9045:         $output .=
                   9046:             "\n\t\t".
                   9047:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9048:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9049:     }
1.987     raeburn  9050:     return $output;
1.660     raeburn  9051: }
                   9052: 
1.661     raeburn  9053: sub upload_embedded {
                   9054:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  9055:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   9056:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  9057:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   9058:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   9059:         my $orig_uploaded_filename =
                   9060:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  9061:         foreach my $type ('orig','ref','attrib','codebase') {
                   9062:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   9063:                 $env{'form.embedded_'.$type.'_'.$i} =
                   9064:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   9065:             }
                   9066:         }
1.661     raeburn  9067:         my ($path,$fname) =
                   9068:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   9069:         # no path, whole string is fname
                   9070:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   9071:         $fname = &Apache::lonnet::clean_filename($fname);
                   9072:         # See if there is anything left
                   9073:         next if ($fname eq '');
                   9074: 
                   9075:         # Check if file already exists as a file or directory.
                   9076:         my ($state,$msg);
                   9077:         if ($context eq 'portfolio') {
                   9078:             my $port_path = $dirpath;
                   9079:             if ($group ne '') {
                   9080:                 $port_path = "groups/$group/$port_path";
                   9081:             }
1.987     raeburn  9082:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   9083:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  9084:                                               $dir_root,$port_path,$disk_quota,
                   9085:                                               $current_disk_usage,$uname,$udom);
                   9086:             if ($state eq 'will_exceed_quota'
1.984     raeburn  9087:                 || $state eq 'file_locked') {
1.661     raeburn  9088:                 $output .= $msg;
                   9089:                 next;
                   9090:             }
                   9091:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   9092:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   9093:             if ($state eq 'exists') {
                   9094:                 $output .= $msg;
                   9095:                 next;
                   9096:             }
                   9097:         }
                   9098:         # Check if extension is valid
                   9099:         if (($fname =~ /\.(\w+)$/) &&
                   9100:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  9101:             $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  9102:             next;
                   9103:         } elsif (($fname =~ /\.(\w+)$/) &&
                   9104:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  9105:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  9106:             next;
                   9107:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  9108:             $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  9109:             next;
                   9110:         }
                   9111: 
                   9112:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   9113:         if ($context eq 'portfolio') {
1.984     raeburn  9114:             my $result;
                   9115:             if ($state eq 'existingfile') {
                   9116:                 $result=
                   9117:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  9118:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  9119:             } else {
1.984     raeburn  9120:                 $result=
                   9121:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  9122:                                                     $dirpath.
                   9123:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  9124:                 if ($result !~ m|^/uploaded/|) {
                   9125:                     $output .= '<span class="LC_error">'
                   9126:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   9127:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   9128:                                .'</span><br />';
                   9129:                     next;
                   9130:                 } else {
1.987     raeburn  9131:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9132:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  9133:                 }
1.661     raeburn  9134:             }
1.987     raeburn  9135:         } elsif ($context eq 'coursedoc') {
                   9136:             my $result =
                   9137:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   9138:                                                 $dirpath.'/'.$path);
                   9139:             if ($result !~ m|^/uploaded/|) {
                   9140:                 $output .= '<span class="LC_error">'
                   9141:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   9142:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   9143:                            .'</span><br />';
                   9144:                     next;
                   9145:             } else {
                   9146:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9147:                            $path.$fname.'</span>').'<br />';
                   9148:             }
1.661     raeburn  9149:         } else {
                   9150: # Save the file
                   9151:             my $target = $env{'form.embedded_item_'.$i};
                   9152:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   9153:             my $dest = $fullpath.$fname;
                   9154:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  9155:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  9156:             my $count;
                   9157:             my $filepath = $dir_root;
1.1027    raeburn  9158:             foreach my $subdir (@parts) {
                   9159:                 $filepath .= "/$subdir";
                   9160:                 if (!-e $filepath) {
1.661     raeburn  9161:                     mkdir($filepath,0770);
                   9162:                 }
                   9163:             }
                   9164:             my $fh;
                   9165:             if (!open($fh,'>'.$dest)) {
                   9166:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   9167:                 $output .= '<span class="LC_error">'.
                   9168:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   9169:                            '</span><br />';
                   9170:             } else {
                   9171:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   9172:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   9173:                     $output .= '<span class="LC_error">'.
                   9174:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   9175:                               '</span><br />';
                   9176:                 } else {
1.987     raeburn  9177:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9178:                                $url.'</span>').'<br />';
                   9179:                     unless ($context eq 'testbank') {
                   9180:                         $footer .= &mt('View embedded file: [_1]',
                   9181:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   9182:                     }
                   9183:                 }
                   9184:                 close($fh);
                   9185:             }
                   9186:         }
                   9187:         if ($env{'form.embedded_ref_'.$i}) {
                   9188:             $pathchange{$i} = 1;
                   9189:         }
                   9190:     }
                   9191:     if ($output) {
                   9192:         $output = '<p>'.$output.'</p>';
                   9193:     }
                   9194:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   9195:     $returnflag = 'ok';
                   9196:     if (keys(%pathchange) > 0) {
                   9197:         if ($context eq 'portfolio') {
                   9198:             $output .= '<p>'.&mt('or').'</p>';
                   9199:         } elsif ($context eq 'testbank') {
1.988     raeburn  9200:             $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  9201:             $returnflag = 'modify_orightml';
                   9202:         }
                   9203:     }
                   9204:     return ($output.$footer,$returnflag);
                   9205: }
                   9206: 
                   9207: sub modify_html_form {
                   9208:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   9209:     my $end = 0;
                   9210:     my $modifyform;
                   9211:     if ($context eq 'upload_embedded') {
                   9212:         return unless (ref($pathchange) eq 'HASH');
                   9213:         if ($env{'form.number_embedded_items'}) {
                   9214:             $end += $env{'form.number_embedded_items'};
                   9215:         }
                   9216:         if ($env{'form.number_pathchange_items'}) {
                   9217:             $end += $env{'form.number_pathchange_items'};
                   9218:         }
                   9219:         if ($end) {
                   9220:             for (my $i=0; $i<$end; $i++) {
                   9221:                 if ($i < $env{'form.number_embedded_items'}) {
                   9222:                     next unless($pathchange->{$i});
                   9223:                 }
                   9224:                 $modifyform .=
                   9225:                     &start_data_table_row().
                   9226:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   9227:                     'checked="checked" /></td>'.
                   9228:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   9229:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   9230:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   9231:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   9232:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   9233:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   9234:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   9235:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   9236:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   9237:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   9238:                     &end_data_table_row();
                   9239:             } 
                   9240:         }
                   9241:     } else {
                   9242:         $modifyform = $pathchgtable;
                   9243:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   9244:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   9245:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9246:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   9247:         }
                   9248:     }
                   9249:     if ($modifyform) {
                   9250:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   9251:                '<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".
                   9252:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   9253:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   9254:                '</ol></p>'."\n".'<p>'.
                   9255:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   9256:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   9257:                &start_data_table()."\n".
                   9258:                &start_data_table_header_row().
                   9259:                '<th>'.&mt('Change?').'</th>'.
                   9260:                '<th>'.&mt('Current reference').'</th>'.
                   9261:                '<th>'.&mt('Required reference').'</th>'.
                   9262:                &end_data_table_header_row()."\n".
                   9263:                $modifyform.
                   9264:                &end_data_table().'<br />'."\n".$hiddenstate.
                   9265:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   9266:                '</form>'."\n";
                   9267:     }
                   9268:     return;
                   9269: }
                   9270: 
                   9271: sub modify_html_refs {
                   9272:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   9273:     my $container;
                   9274:     if ($context eq 'portfolio') {
                   9275:         $container = $env{'form.container'};
                   9276:     } elsif ($context eq 'coursedoc') {
                   9277:         $container = $env{'form.primaryurl'};
                   9278:     } else {
1.1027    raeburn  9279:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  9280:     }
                   9281:     my (%allfiles,%codebase,$output,$content);
                   9282:     my @changes = &get_env_multiple('form.namechange');
                   9283:     return unless (@changes > 0);
                   9284:     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {
                   9285:         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});
                   9286:         $content = &Apache::lonnet::getfile($container);
                   9287:         return if ($content eq '-1');
                   9288:     } else {
                   9289:         return unless ($container =~ /^\Q$dir_root\E/); 
                   9290:         if (open(my $fh,"<$container")) {
                   9291:             $content = join('', <$fh>);
                   9292:             close($fh);
                   9293:         } else {
                   9294:             return;
                   9295:         }
                   9296:     }
                   9297:     my ($count,$codebasecount) = (0,0);
                   9298:     my $mm = new File::MMagic;
                   9299:     my $mime_type = $mm->checktype_contents($content);
                   9300:     if ($mime_type eq 'text/html') {
                   9301:         my $parse_result = 
                   9302:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   9303:                                                     \%codebase,\$content);
                   9304:         if ($parse_result eq 'ok') {
                   9305:             foreach my $i (@changes) {
                   9306:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   9307:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   9308:                 if ($allfiles{$ref}) {
                   9309:                     my $newname =  $orig;
                   9310:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  9311:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  9312:                     if ($attrib_regexp =~ /:/) {
                   9313:                         $attrib_regexp =~ s/\:/|/g;
                   9314:                     }
                   9315:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   9316:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   9317:                         $count += $numchg;
                   9318:                     }
                   9319:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  9320:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  9321:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   9322:                         $codebasecount ++;
                   9323:                     }
                   9324:                 }
                   9325:             }
                   9326:             if ($count || $codebasecount) {
                   9327:                 my $saveresult;
                   9328:                 if ($context eq 'portfolio' || $context eq 'coursedoc') {
                   9329:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   9330:                     if ($url eq $container) {
                   9331:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   9332:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9333:                                             $count,'<span class="LC_filename">'.
                   9334:                                             $fname.'</span>').'</p>'; 
                   9335:                     } else {
                   9336:                          $output = '<p class="LC_error">'.
                   9337:                                    &mt('Error: update failed for: [_1].',
                   9338:                                    '<span class="LC_filename">'.
                   9339:                                    $container.'</span>').'</p>';
                   9340:                     }
                   9341:                 } else {
                   9342:                     if (open(my $fh,">$container")) {
                   9343:                         print $fh $content;
                   9344:                         close($fh);
                   9345:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9346:                                   $count,'<span class="LC_filename">'.
                   9347:                                   $container.'</span>').'</p>';
1.661     raeburn  9348:                     } else {
1.987     raeburn  9349:                          $output = '<p class="LC_error">'.
                   9350:                                    &mt('Error: could not update [_1].',
                   9351:                                    '<span class="LC_filename">'.
                   9352:                                    $container.'</span>').'</p>';
1.661     raeburn  9353:                     }
                   9354:                 }
                   9355:             }
1.987     raeburn  9356:         } else {
                   9357:             &logthis('Failed to parse '.$container.
                   9358:                      ' to modify references: '.$parse_result);
1.661     raeburn  9359:         }
                   9360:     }
                   9361:     return $output;
                   9362: }
                   9363: 
                   9364: sub check_for_existing {
                   9365:     my ($path,$fname,$element) = @_;
                   9366:     my ($state,$msg);
                   9367:     if (-d $path.'/'.$fname) {
                   9368:         $state = 'exists';
                   9369:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   9370:     } elsif (-e $path.'/'.$fname) {
                   9371:         $state = 'exists';
                   9372:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   9373:     }
                   9374:     if ($state eq 'exists') {
                   9375:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   9376:     }
                   9377:     return ($state,$msg);
                   9378: }
                   9379: 
                   9380: sub check_for_upload {
                   9381:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   9382:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  9383:     my $filesize = length($env{'form.'.$element});
                   9384:     if (!$filesize) {
                   9385:         my $msg = '<span class="LC_error">'.
                   9386:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   9387:                       '<span class="LC_filename">'.$fname.'</span>',
                   9388:                       $filesize).'<br />'.
1.1007    raeburn  9389:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  9390:                   '</span>';
                   9391:         return ('zero_bytes',$msg);
                   9392:     }
                   9393:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  9394:     my $getpropath = 1;
1.1021    raeburn  9395:     my ($dirlistref,$listerror) =
                   9396:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  9397:     my $found_file = 0;
                   9398:     my $locked_file = 0;
1.991     raeburn  9399:     my @lockers;
                   9400:     my $navmap;
                   9401:     if ($env{'request.course.id'}) {
                   9402:         $navmap = Apache::lonnavmaps::navmap->new();
                   9403:     }
1.1021    raeburn  9404:     if (ref($dirlistref) eq 'ARRAY') {
                   9405:         foreach my $line (@{$dirlistref}) {
                   9406:             my ($file_name,$rest)=split(/\&/,$line,2);
                   9407:             if ($file_name eq $fname){
                   9408:                 $file_name = $path.$file_name;
                   9409:                 if ($group ne '') {
                   9410:                     $file_name = $group.$file_name;
                   9411:                 }
                   9412:                 $found_file = 1;
                   9413:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   9414:                     foreach my $lock (@lockers) {
                   9415:                         if (ref($lock) eq 'ARRAY') {
                   9416:                             my ($symb,$crsid) = @{$lock};
                   9417:                             if ($crsid eq $env{'request.course.id'}) {
                   9418:                                 if (ref($navmap)) {
                   9419:                                     my $res = $navmap->getBySymb($symb);
                   9420:                                     foreach my $part (@{$res->parts()}) { 
                   9421:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   9422:                                         unless (($slot_status == $res->RESERVED) ||
                   9423:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   9424:                                             $locked_file = 1;
                   9425:                                         }
1.991     raeburn  9426:                                     }
1.1021    raeburn  9427:                                 } else {
                   9428:                                     $locked_file = 1;
1.991     raeburn  9429:                                 }
                   9430:                             } else {
                   9431:                                 $locked_file = 1;
                   9432:                             }
                   9433:                         }
1.1021    raeburn  9434:                    }
                   9435:                 } else {
                   9436:                     my @info = split(/\&/,$rest);
                   9437:                     my $currsize = $info[6]/1000;
                   9438:                     if ($currsize < $filesize) {
                   9439:                         my $extra = $filesize - $currsize;
                   9440:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   9441:                             my $msg = '<span class="LC_error">'.
                   9442:                                       &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.',
                   9443:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   9444:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   9445:                                                    $disk_quota,$current_disk_usage);
                   9446:                             return ('will_exceed_quota',$msg);
                   9447:                         }
1.984     raeburn  9448:                     }
                   9449:                 }
1.661     raeburn  9450:             }
                   9451:         }
                   9452:     }
                   9453:     if (($current_disk_usage + $filesize) > $disk_quota){
                   9454:         my $msg = '<span class="LC_error">'.
                   9455:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   9456:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   9457:         return ('will_exceed_quota',$msg);
                   9458:     } elsif ($found_file) {
                   9459:         if ($locked_file) {
                   9460:             my $msg = '<span class="LC_error">';
                   9461:             $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>');
                   9462:             $msg .= '</span><br />';
                   9463:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   9464:             return ('file_locked',$msg);
                   9465:         } else {
                   9466:             my $msg = '<span class="LC_error">';
1.984     raeburn  9467:             $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  9468:             $msg .= '</span>';
1.984     raeburn  9469:             return ('existingfile',$msg);
1.661     raeburn  9470:         }
                   9471:     }
                   9472: }
                   9473: 
1.987     raeburn  9474: sub check_for_traversal {
                   9475:     my ($path,$url,$toplevel) = @_;
                   9476:     my @parts=split(/\//,$path);
                   9477:     my $cleanpath;
                   9478:     my $fullpath = $url;
                   9479:     for (my $i=0;$i<@parts;$i++) {
                   9480:         next if ($parts[$i] eq '.');
                   9481:         if ($parts[$i] eq '..') {
                   9482:             $fullpath =~ s{([^/]+/)$}{};
                   9483:         } else {
                   9484:             $fullpath .= $parts[$i].'/';
                   9485:         }
                   9486:     }
                   9487:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   9488:         $cleanpath = $1;
                   9489:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   9490:         my $curr_toprel = $1;
                   9491:         my @parts = split(/\//,$curr_toprel);
                   9492:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   9493:         my @urlparts = split(/\//,$url_toprel);
                   9494:         my $doubledots;
                   9495:         my $startdiff = -1;
                   9496:         for (my $i=0; $i<@urlparts; $i++) {
                   9497:             if ($startdiff == -1) {
                   9498:                 unless ($urlparts[$i] eq $parts[$i]) {
                   9499:                     $startdiff = $i;
                   9500:                     $doubledots .= '../';
                   9501:                 }
                   9502:             } else {
                   9503:                 $doubledots .= '../';
                   9504:             }
                   9505:         }
                   9506:         if ($startdiff > -1) {
                   9507:             $cleanpath = $doubledots;
                   9508:             for (my $i=$startdiff; $i<@parts; $i++) {
                   9509:                 $cleanpath .= $parts[$i].'/';
                   9510:             }
                   9511:         }
                   9512:     }
                   9513:     $cleanpath =~ s{(/)$}{};
                   9514:     return $cleanpath;
                   9515: }
1.31      albertel 9516: 
1.41      ng       9517: =pod
1.45      matthew  9518: 
1.1015    raeburn  9519: =item * &get_turnedin_filepath()
                   9520: 
                   9521: Determines path in a user's portfolio file for storage of files uploaded
                   9522: to a specific essayresponse or dropbox item.
                   9523: 
                   9524: Inputs: 3 required + 1 optional.
                   9525: $symb is symb for resource, $uname and $udom are for current user (required).
                   9526: $caller is optional (can be "submission", if routine is called when storing
                   9527: an upoaded file when "Submit Answer" button was pressed).
                   9528: 
                   9529: Returns array containing $path and $multiresp. 
                   9530: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   9531: than one file upload item.  Callers of routine should append partid as a 
                   9532: subdirectory to $path in cases where $multiresp is 1.
                   9533: 
                   9534: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   9535: 
                   9536: =cut
                   9537: 
                   9538: sub get_turnedin_filepath {
                   9539:     my ($symb,$uname,$udom,$caller) = @_;
                   9540:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   9541:     my $turnindir;
                   9542:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   9543:     $turnindir = $userhash{'turnindir'};
                   9544:     my ($path,$multiresp);
                   9545:     if ($turnindir eq '') {
                   9546:         if ($caller eq 'submission') {
                   9547:             $turnindir = &mt('turned in');
                   9548:             $turnindir =~ s/\W+/_/g;
                   9549:             my %newhash = (
                   9550:                             'turnindir' => $turnindir,
                   9551:                           );
                   9552:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   9553:         }
                   9554:     }
                   9555:     if ($turnindir ne '') {
                   9556:         $path = '/'.$turnindir.'/';
                   9557:         my ($multipart,$turnin,@pathitems);
                   9558:         my $navmap = Apache::lonnavmaps::navmap->new();
                   9559:         if (defined($navmap)) {
                   9560:             my $mapres = $navmap->getResourceByUrl($map);
                   9561:             if (ref($mapres)) {
                   9562:                 my $pcslist = $mapres->map_hierarchy();
                   9563:                 if ($pcslist ne '') {
                   9564:                     foreach my $pc (split(/,/,$pcslist)) {
                   9565:                         my $res = $navmap->getByMapPc($pc);
                   9566:                         if (ref($res)) {
                   9567:                             my $title = $res->compTitle();
                   9568:                             $title =~ s/\W+/_/g;
                   9569:                             if ($title ne '') {
                   9570:                                 push(@pathitems,$title);
                   9571:                             }
                   9572:                         }
                   9573:                     }
                   9574:                 }
                   9575:                 my $maptitle = $mapres->compTitle();
                   9576:                 $maptitle =~ s/\W+/_/g;
                   9577:                 if ($maptitle ne '') {
                   9578:                     push(@pathitems,$maptitle);
                   9579:                 }
                   9580:                 unless ($env{'request.state'} eq 'construct') {
                   9581:                     my $res = $navmap->getBySymb($symb);
                   9582:                     if (ref($res)) {
                   9583:                         my $partlist = $res->parts();
                   9584:                         my $totaluploads = 0;
                   9585:                         if (ref($partlist) eq 'ARRAY') {
                   9586:                             foreach my $part (@{$partlist}) {
                   9587:                                 my @types = $res->responseType($part);
                   9588:                                 my @ids = $res->responseIds($part);
                   9589:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   9590:                                     if ($types[$i] eq 'essay') {
                   9591:                                         my $partid = $part.'_'.$ids[$i];
                   9592:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   9593:                                             $totaluploads ++;
                   9594:                                         }
                   9595:                                     }
                   9596:                                 }
                   9597:                             }
                   9598:                             if ($totaluploads > 1) {
                   9599:                                 $multiresp = 1;
                   9600:                             }
                   9601:                         }
                   9602:                     }
                   9603:                 }
                   9604:             } else {
                   9605:                 return;
                   9606:             }
                   9607:         } else {
                   9608:             return;
                   9609:         }
                   9610:         my $restitle=&Apache::lonnet::gettitle($symb);
                   9611:         $restitle =~ s/\W+/_/g;
                   9612:         if ($restitle eq '') {
                   9613:             $restitle = ($resurl =~ m{/[^/]+$});
                   9614:             if ($restitle eq '') {
                   9615:                 $restitle = time;
                   9616:             }
                   9617:         }
                   9618:         push(@pathitems,$restitle);
                   9619:         $path .= join('/',@pathitems);
                   9620:     }
                   9621:     return ($path,$multiresp);
                   9622: }
                   9623: 
                   9624: =pod
                   9625: 
1.464     albertel 9626: =back
1.41      ng       9627: 
1.112     bowersj2 9628: =head1 CSV Upload/Handling functions
1.38      albertel 9629: 
1.41      ng       9630: =over 4
                   9631: 
1.648     raeburn  9632: =item * &upfile_store($r)
1.41      ng       9633: 
                   9634: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 9635: needs $env{'form.upfile'}
1.41      ng       9636: returns $datatoken to be put into hidden field
                   9637: 
                   9638: =cut
1.31      albertel 9639: 
                   9640: sub upfile_store {
                   9641:     my $r=shift;
1.258     albertel 9642:     $env{'form.upfile'}=~s/\r/\n/gs;
                   9643:     $env{'form.upfile'}=~s/\f/\n/gs;
                   9644:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   9645:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 9646: 
1.258     albertel 9647:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   9648: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 9649:     {
1.158     raeburn  9650:         my $datafile = $r->dir_config('lonDaemons').
                   9651:                            '/tmp/'.$datatoken.'.tmp';
                   9652:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 9653:             print $fh $env{'form.upfile'};
1.158     raeburn  9654:             close($fh);
                   9655:         }
1.31      albertel 9656:     }
                   9657:     return $datatoken;
                   9658: }
                   9659: 
1.56      matthew  9660: =pod
                   9661: 
1.648     raeburn  9662: =item * &load_tmp_file($r)
1.41      ng       9663: 
                   9664: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 9665: needs $env{'form.datatoken'},
                   9666: sets $env{'form.upfile'} to the contents of the file
1.41      ng       9667: 
                   9668: =cut
1.31      albertel 9669: 
                   9670: sub load_tmp_file {
                   9671:     my $r=shift;
                   9672:     my @studentdata=();
                   9673:     {
1.158     raeburn  9674:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 9675:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  9676:         if ( open(my $fh,"<$studentfile") ) {
                   9677:             @studentdata=<$fh>;
                   9678:             close($fh);
                   9679:         }
1.31      albertel 9680:     }
1.258     albertel 9681:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 9682: }
                   9683: 
1.56      matthew  9684: =pod
                   9685: 
1.648     raeburn  9686: =item * &upfile_record_sep()
1.41      ng       9687: 
                   9688: Separate uploaded file into records
                   9689: returns array of records,
1.258     albertel 9690: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       9691: 
                   9692: =cut
1.31      albertel 9693: 
                   9694: sub upfile_record_sep {
1.258     albertel 9695:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 9696:     } else {
1.248     albertel 9697: 	my @records;
1.258     albertel 9698: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 9699: 	    if ($line=~/^\s*$/) { next; }
                   9700: 	    push(@records,$line);
                   9701: 	}
                   9702: 	return @records;
1.31      albertel 9703:     }
                   9704: }
                   9705: 
1.56      matthew  9706: =pod
                   9707: 
1.648     raeburn  9708: =item * &record_sep($record)
1.41      ng       9709: 
1.258     albertel 9710: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       9711: 
                   9712: =cut
                   9713: 
1.263     www      9714: sub takeleft {
                   9715:     my $index=shift;
                   9716:     return substr('0000'.$index,-4,4);
                   9717: }
                   9718: 
1.31      albertel 9719: sub record_sep {
                   9720:     my $record=shift;
                   9721:     my %components=();
1.258     albertel 9722:     if ($env{'form.upfiletype'} eq 'xml') {
                   9723:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 9724:         my $i=0;
1.356     albertel 9725:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 9726:             $field=~s/^(\"|\')//;
                   9727:             $field=~s/(\"|\')$//;
1.263     www      9728:             $components{&takeleft($i)}=$field;
1.31      albertel 9729:             $i++;
                   9730:         }
1.258     albertel 9731:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 9732:         my $i=0;
1.356     albertel 9733:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 9734:             $field=~s/^(\"|\')//;
                   9735:             $field=~s/(\"|\')$//;
1.263     www      9736:             $components{&takeleft($i)}=$field;
1.31      albertel 9737:             $i++;
                   9738:         }
                   9739:     } else {
1.561     www      9740:         my $separator=',';
1.480     banghart 9741:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      9742:             $separator=';';
1.480     banghart 9743:         }
1.31      albertel 9744:         my $i=0;
1.561     www      9745: # the character we are looking for to indicate the end of a quote or a record 
                   9746:         my $looking_for=$separator;
                   9747: # do not add the characters to the fields
                   9748:         my $ignore=0;
                   9749: # we just encountered a separator (or the beginning of the record)
                   9750:         my $just_found_separator=1;
                   9751: # store the field we are working on here
                   9752:         my $field='';
                   9753: # work our way through all characters in record
                   9754:         foreach my $character ($record=~/(.)/g) {
                   9755:             if ($character eq $looking_for) {
                   9756:                if ($character ne $separator) {
                   9757: # Found the end of a quote, again looking for separator
                   9758:                   $looking_for=$separator;
                   9759:                   $ignore=1;
                   9760:                } else {
                   9761: # Found a separator, store away what we got
                   9762:                   $components{&takeleft($i)}=$field;
                   9763: 	          $i++;
                   9764:                   $just_found_separator=1;
                   9765:                   $ignore=0;
                   9766:                   $field='';
                   9767:                }
                   9768:                next;
                   9769:             }
                   9770: # single or double quotation marks after a separator indicate beginning of a quote
                   9771: # we are now looking for the end of the quote and need to ignore separators
                   9772:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   9773:                $looking_for=$character;
                   9774:                next;
                   9775:             }
                   9776: # ignore would be true after we reached the end of a quote
                   9777:             if ($ignore) { next; }
                   9778:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   9779:             $field.=$character;
                   9780:             $just_found_separator=0; 
1.31      albertel 9781:         }
1.561     www      9782: # catch the very last entry, since we never encountered the separator
                   9783:         $components{&takeleft($i)}=$field;
1.31      albertel 9784:     }
                   9785:     return %components;
                   9786: }
                   9787: 
1.144     matthew  9788: ######################################################
                   9789: ######################################################
                   9790: 
1.56      matthew  9791: =pod
                   9792: 
1.648     raeburn  9793: =item * &upfile_select_html()
1.41      ng       9794: 
1.144     matthew  9795: Return HTML code to select a file from the users machine and specify 
                   9796: the file type.
1.41      ng       9797: 
                   9798: =cut
                   9799: 
1.144     matthew  9800: ######################################################
                   9801: ######################################################
1.31      albertel 9802: sub upfile_select_html {
1.144     matthew  9803:     my %Types = (
                   9804:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 9805:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  9806:                  space => &mt('Space separated'),
                   9807:                  tab   => &mt('Tabulator separated'),
                   9808: #                 xml   => &mt('HTML/XML'),
                   9809:                  );
                   9810:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  9811:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  9812:     foreach my $type (sort(keys(%Types))) {
                   9813:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   9814:     }
                   9815:     $Str .= "</select>\n";
                   9816:     return $Str;
1.31      albertel 9817: }
                   9818: 
1.301     albertel 9819: sub get_samples {
                   9820:     my ($records,$toget) = @_;
                   9821:     my @samples=({});
                   9822:     my $got=0;
                   9823:     foreach my $rec (@$records) {
                   9824: 	my %temp = &record_sep($rec);
                   9825: 	if (! grep(/\S/, values(%temp))) { next; }
                   9826: 	if (%temp) {
                   9827: 	    $samples[$got]=\%temp;
                   9828: 	    $got++;
                   9829: 	    if ($got == $toget) { last; }
                   9830: 	}
                   9831:     }
                   9832:     return \@samples;
                   9833: }
                   9834: 
1.144     matthew  9835: ######################################################
                   9836: ######################################################
                   9837: 
1.56      matthew  9838: =pod
                   9839: 
1.648     raeburn  9840: =item * &csv_print_samples($r,$records)
1.41      ng       9841: 
                   9842: Prints a table of sample values from each column uploaded $r is an
                   9843: Apache Request ref, $records is an arrayref from
                   9844: &Apache::loncommon::upfile_record_sep
                   9845: 
                   9846: =cut
                   9847: 
1.144     matthew  9848: ######################################################
                   9849: ######################################################
1.31      albertel 9850: sub csv_print_samples {
                   9851:     my ($r,$records) = @_;
1.662     bisitz   9852:     my $samples = &get_samples($records,5);
1.301     albertel 9853: 
1.594     raeburn  9854:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   9855:               &start_data_table_header_row());
1.356     albertel 9856:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   9857:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  9858:     $r->print(&end_data_table_header_row());
1.301     albertel 9859:     foreach my $hash (@$samples) {
1.594     raeburn  9860: 	$r->print(&start_data_table_row());
1.356     albertel 9861: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 9862: 	    $r->print('<td>');
1.356     albertel 9863: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 9864: 	    $r->print('</td>');
                   9865: 	}
1.594     raeburn  9866: 	$r->print(&end_data_table_row());
1.31      albertel 9867:     }
1.594     raeburn  9868:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 9869: }
                   9870: 
1.144     matthew  9871: ######################################################
                   9872: ######################################################
                   9873: 
1.56      matthew  9874: =pod
                   9875: 
1.648     raeburn  9876: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       9877: 
                   9878: Prints a table to create associations between values and table columns.
1.144     matthew  9879: 
1.41      ng       9880: $r is an Apache Request ref,
                   9881: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  9882: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       9883: 
                   9884: =cut
                   9885: 
1.144     matthew  9886: ######################################################
                   9887: ######################################################
1.31      albertel 9888: sub csv_print_select_table {
                   9889:     my ($r,$records,$d) = @_;
1.301     albertel 9890:     my $i=0;
                   9891:     my $samples = &get_samples($records,1);
1.144     matthew  9892:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  9893: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  9894:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  9895:               '<th>'.&mt('Column').'</th>'.
                   9896:               &end_data_table_header_row()."\n");
1.356     albertel 9897:     foreach my $array_ref (@$d) {
                   9898: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  9899: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 9900: 
1.875     bisitz   9901: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  9902: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 9903: 	$r->print('<option value="none"></option>');
1.356     albertel 9904: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   9905: 	    $r->print('<option value="'.$sample.'"'.
                   9906:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   9907:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 9908: 	}
1.594     raeburn  9909: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 9910: 	$i++;
                   9911:     }
1.594     raeburn  9912:     $r->print(&end_data_table());
1.31      albertel 9913:     $i--;
                   9914:     return $i;
                   9915: }
1.56      matthew  9916: 
1.144     matthew  9917: ######################################################
                   9918: ######################################################
                   9919: 
1.56      matthew  9920: =pod
1.31      albertel 9921: 
1.648     raeburn  9922: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       9923: 
                   9924: Prints a table of sample values from the upload and can make associate samples to internal names.
                   9925: 
                   9926: $r is an Apache Request ref,
                   9927: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   9928: $d is an array of 2 element arrays (internal name, displayed name)
                   9929: 
                   9930: =cut
                   9931: 
1.144     matthew  9932: ######################################################
                   9933: ######################################################
1.31      albertel 9934: sub csv_samples_select_table {
                   9935:     my ($r,$records,$d) = @_;
                   9936:     my $i=0;
1.144     matthew  9937:     #
1.662     bisitz   9938:     my $max_samples = 5;
                   9939:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  9940:     $r->print(&start_data_table().
                   9941:               &start_data_table_header_row().'<th>'.
                   9942:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   9943:               &end_data_table_header_row());
1.301     albertel 9944: 
                   9945:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  9946: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  9947: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 9948: 	foreach my $option (@$d) {
                   9949: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  9950: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 9951:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  9952:                       $display.'</option>');
1.31      albertel 9953: 	}
                   9954: 	$r->print('</select></td><td>');
1.662     bisitz   9955: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 9956: 	    if (defined($samples->[$line]{$key})) { 
                   9957: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   9958: 	    }
                   9959: 	}
1.594     raeburn  9960: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 9961: 	$i++;
                   9962:     }
1.594     raeburn  9963:     $r->print(&end_data_table());
1.31      albertel 9964:     $i--;
                   9965:     return($i);
1.115     matthew  9966: }
                   9967: 
1.144     matthew  9968: ######################################################
                   9969: ######################################################
                   9970: 
1.115     matthew  9971: =pod
                   9972: 
1.648     raeburn  9973: =item * &clean_excel_name($name)
1.115     matthew  9974: 
                   9975: Returns a replacement for $name which does not contain any illegal characters.
                   9976: 
                   9977: =cut
                   9978: 
1.144     matthew  9979: ######################################################
                   9980: ######################################################
1.115     matthew  9981: sub clean_excel_name {
                   9982:     my ($name) = @_;
                   9983:     $name =~ s/[:\*\?\/\\]//g;
                   9984:     if (length($name) > 31) {
                   9985:         $name = substr($name,0,31);
                   9986:     }
                   9987:     return $name;
1.25      albertel 9988: }
1.84      albertel 9989: 
1.85      albertel 9990: =pod
                   9991: 
1.648     raeburn  9992: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 9993: 
                   9994: Returns either 1 or undef
                   9995: 
                   9996: 1 if the part is to be hidden, undef if it is to be shown
                   9997: 
                   9998: Arguments are:
                   9999: 
                   10000: $id the id of the part to be checked
                   10001: $symb, optional the symb of the resource to check
                   10002: $udom, optional the domain of the user to check for
                   10003: $uname, optional the username of the user to check for
                   10004: 
                   10005: =cut
1.84      albertel 10006: 
                   10007: sub check_if_partid_hidden {
                   10008:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 10009:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 10010: 					 $symb,$udom,$uname);
1.141     albertel 10011:     my $truth=1;
                   10012:     #if the string starts with !, then the list is the list to show not hide
                   10013:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 10014:     my @hiddenlist=split(/,/,$hiddenparts);
                   10015:     foreach my $checkid (@hiddenlist) {
1.141     albertel 10016: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 10017:     }
1.141     albertel 10018:     return !$truth;
1.84      albertel 10019: }
1.127     matthew  10020: 
1.138     matthew  10021: 
                   10022: ############################################################
                   10023: ############################################################
                   10024: 
                   10025: =pod
                   10026: 
1.157     matthew  10027: =back 
                   10028: 
1.138     matthew  10029: =head1 cgi-bin script and graphing routines
                   10030: 
1.157     matthew  10031: =over 4
                   10032: 
1.648     raeburn  10033: =item * &get_cgi_id()
1.138     matthew  10034: 
                   10035: Inputs: none
                   10036: 
                   10037: Returns an id which can be used to pass environment variables
                   10038: to various cgi-bin scripts.  These environment variables will
                   10039: be removed from the users environment after a given time by
                   10040: the routine &Apache::lonnet::transfer_profile_to_env.
                   10041: 
                   10042: =cut
                   10043: 
                   10044: ############################################################
                   10045: ############################################################
1.152     albertel 10046: my $uniq=0;
1.136     matthew  10047: sub get_cgi_id {
1.154     albertel 10048:     $uniq=($uniq+1)%100000;
1.280     albertel 10049:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  10050: }
                   10051: 
1.127     matthew  10052: ############################################################
                   10053: ############################################################
                   10054: 
                   10055: =pod
                   10056: 
1.648     raeburn  10057: =item * &DrawBarGraph()
1.127     matthew  10058: 
1.138     matthew  10059: Facilitates the plotting of data in a (stacked) bar graph.
                   10060: Puts plot definition data into the users environment in order for 
                   10061: graph.png to plot it.  Returns an <img> tag for the plot.
                   10062: The bars on the plot are labeled '1','2',...,'n'.
                   10063: 
                   10064: Inputs:
                   10065: 
                   10066: =over 4
                   10067: 
                   10068: =item $Title: string, the title of the plot
                   10069: 
                   10070: =item $xlabel: string, text describing the X-axis of the plot
                   10071: 
                   10072: =item $ylabel: string, text describing the Y-axis of the plot
                   10073: 
                   10074: =item $Max: scalar, the maximum Y value to use in the plot
                   10075: If $Max is < any data point, the graph will not be rendered.
                   10076: 
1.140     matthew  10077: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  10078: they are plotted.  If undefined, default values will be used.
                   10079: 
1.178     matthew  10080: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   10081: 
1.138     matthew  10082: =item @Values: An array of array references.  Each array reference holds data
                   10083: to be plotted in a stacked bar chart.
                   10084: 
1.239     matthew  10085: =item If the final element of @Values is a hash reference the key/value
                   10086: pairs will be added to the graph definition.
                   10087: 
1.138     matthew  10088: =back
                   10089: 
                   10090: Returns:
                   10091: 
                   10092: An <img> tag which references graph.png and the appropriate identifying
                   10093: information for the plot.
                   10094: 
1.127     matthew  10095: =cut
                   10096: 
                   10097: ############################################################
                   10098: ############################################################
1.134     matthew  10099: sub DrawBarGraph {
1.178     matthew  10100:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  10101:     #
                   10102:     if (! defined($colors)) {
                   10103:         $colors = ['#33ff00', 
                   10104:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   10105:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   10106:                   ]; 
                   10107:     }
1.228     matthew  10108:     my $extra_settings = {};
                   10109:     if (ref($Values[-1]) eq 'HASH') {
                   10110:         $extra_settings = pop(@Values);
                   10111:     }
1.127     matthew  10112:     #
1.136     matthew  10113:     my $identifier = &get_cgi_id();
                   10114:     my $id = 'cgi.'.$identifier;        
1.129     matthew  10115:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  10116:         return '';
                   10117:     }
1.225     matthew  10118:     #
                   10119:     my @Labels;
                   10120:     if (defined($labels)) {
                   10121:         @Labels = @$labels;
                   10122:     } else {
                   10123:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   10124:             push (@Labels,$i+1);
                   10125:         }
                   10126:     }
                   10127:     #
1.129     matthew  10128:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  10129:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  10130:     my %ValuesHash;
                   10131:     my $NumSets=1;
                   10132:     foreach my $array (@Values) {
                   10133:         next if (! ref($array));
1.136     matthew  10134:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  10135:             join(',',@$array);
1.129     matthew  10136:     }
1.127     matthew  10137:     #
1.136     matthew  10138:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  10139:     if ($NumBars < 3) {
                   10140:         $width = 120+$NumBars*32;
1.220     matthew  10141:         $xskip = 1;
1.225     matthew  10142:         $bar_width = 30;
                   10143:     } elsif ($NumBars < 5) {
                   10144:         $width = 120+$NumBars*20;
                   10145:         $xskip = 1;
                   10146:         $bar_width = 20;
1.220     matthew  10147:     } elsif ($NumBars < 10) {
1.136     matthew  10148:         $width = 120+$NumBars*15;
                   10149:         $xskip = 1;
                   10150:         $bar_width = 15;
                   10151:     } elsif ($NumBars <= 25) {
                   10152:         $width = 120+$NumBars*11;
                   10153:         $xskip = 5;
                   10154:         $bar_width = 8;
                   10155:     } elsif ($NumBars <= 50) {
                   10156:         $width = 120+$NumBars*8;
                   10157:         $xskip = 5;
                   10158:         $bar_width = 4;
                   10159:     } else {
                   10160:         $width = 120+$NumBars*8;
                   10161:         $xskip = 5;
                   10162:         $bar_width = 4;
                   10163:     }
                   10164:     #
1.137     matthew  10165:     $Max = 1 if ($Max < 1);
                   10166:     if ( int($Max) < $Max ) {
                   10167:         $Max++;
                   10168:         $Max = int($Max);
                   10169:     }
1.127     matthew  10170:     $Title  = '' if (! defined($Title));
                   10171:     $xlabel = '' if (! defined($xlabel));
                   10172:     $ylabel = '' if (! defined($ylabel));
1.369     www      10173:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   10174:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   10175:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  10176:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  10177:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   10178:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   10179:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   10180:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10181:     $ValuesHash{$id.'.height'}   = $height;
                   10182:     $ValuesHash{$id.'.width'}    = $width;
                   10183:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   10184:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   10185:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  10186:     #
1.228     matthew  10187:     # Deal with other parameters
                   10188:     while (my ($key,$value) = each(%$extra_settings)) {
                   10189:         $ValuesHash{$id.'.'.$key} = $value;
                   10190:     }
                   10191:     #
1.646     raeburn  10192:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  10193:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   10194: }
                   10195: 
                   10196: ############################################################
                   10197: ############################################################
                   10198: 
                   10199: =pod
                   10200: 
1.648     raeburn  10201: =item * &DrawXYGraph()
1.137     matthew  10202: 
1.138     matthew  10203: Facilitates the plotting of data in an XY graph.
                   10204: Puts plot definition data into the users environment in order for 
                   10205: graph.png to plot it.  Returns an <img> tag for the plot.
                   10206: 
                   10207: Inputs:
                   10208: 
                   10209: =over 4
                   10210: 
                   10211: =item $Title: string, the title of the plot
                   10212: 
                   10213: =item $xlabel: string, text describing the X-axis of the plot
                   10214: 
                   10215: =item $ylabel: string, text describing the Y-axis of the plot
                   10216: 
                   10217: =item $Max: scalar, the maximum Y value to use in the plot
                   10218: If $Max is < any data point, the graph will not be rendered.
                   10219: 
                   10220: =item $colors: Array ref containing the hex color codes for the data to be 
                   10221: plotted in.  If undefined, default values will be used.
                   10222: 
                   10223: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   10224: 
                   10225: =item $Ydata: Array ref containing Array refs.  
1.185     www      10226: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  10227: 
                   10228: =item %Values: hash indicating or overriding any default values which are 
                   10229: passed to graph.png.  
                   10230: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   10231: 
                   10232: =back
                   10233: 
                   10234: Returns:
                   10235: 
                   10236: An <img> tag which references graph.png and the appropriate identifying
                   10237: information for the plot.
                   10238: 
1.137     matthew  10239: =cut
                   10240: 
                   10241: ############################################################
                   10242: ############################################################
                   10243: sub DrawXYGraph {
                   10244:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   10245:     #
                   10246:     # Create the identifier for the graph
                   10247:     my $identifier = &get_cgi_id();
                   10248:     my $id = 'cgi.'.$identifier;
                   10249:     #
                   10250:     $Title  = '' if (! defined($Title));
                   10251:     $xlabel = '' if (! defined($xlabel));
                   10252:     $ylabel = '' if (! defined($ylabel));
                   10253:     my %ValuesHash = 
                   10254:         (
1.369     www      10255:          $id.'.title'  => &escape($Title),
                   10256:          $id.'.xlabel' => &escape($xlabel),
                   10257:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  10258:          $id.'.y_max_value'=> $Max,
                   10259:          $id.'.labels'     => join(',',@$Xlabels),
                   10260:          $id.'.PlotType'   => 'XY',
                   10261:          );
                   10262:     #
                   10263:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   10264:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10265:     }
                   10266:     #
                   10267:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   10268:         return '';
                   10269:     }
                   10270:     my $NumSets=1;
1.138     matthew  10271:     foreach my $array (@{$Ydata}){
1.137     matthew  10272:         next if (! ref($array));
                   10273:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   10274:     }
1.138     matthew  10275:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  10276:     #
                   10277:     # Deal with other parameters
                   10278:     while (my ($key,$value) = each(%Values)) {
                   10279:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  10280:     }
                   10281:     #
1.646     raeburn  10282:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  10283:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   10284: }
                   10285: 
                   10286: ############################################################
                   10287: ############################################################
                   10288: 
                   10289: =pod
                   10290: 
1.648     raeburn  10291: =item * &DrawXYYGraph()
1.138     matthew  10292: 
                   10293: Facilitates the plotting of data in an XY graph with two Y axes.
                   10294: Puts plot definition data into the users environment in order for 
                   10295: graph.png to plot it.  Returns an <img> tag for the plot.
                   10296: 
                   10297: Inputs:
                   10298: 
                   10299: =over 4
                   10300: 
                   10301: =item $Title: string, the title of the plot
                   10302: 
                   10303: =item $xlabel: string, text describing the X-axis of the plot
                   10304: 
                   10305: =item $ylabel: string, text describing the Y-axis of the plot
                   10306: 
                   10307: =item $colors: Array ref containing the hex color codes for the data to be 
                   10308: plotted in.  If undefined, default values will be used.
                   10309: 
                   10310: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   10311: 
                   10312: =item $Ydata1: The first data set
                   10313: 
                   10314: =item $Min1: The minimum value of the left Y-axis
                   10315: 
                   10316: =item $Max1: The maximum value of the left Y-axis
                   10317: 
                   10318: =item $Ydata2: The second data set
                   10319: 
                   10320: =item $Min2: The minimum value of the right Y-axis
                   10321: 
                   10322: =item $Max2: The maximum value of the left Y-axis
                   10323: 
                   10324: =item %Values: hash indicating or overriding any default values which are 
                   10325: passed to graph.png.  
                   10326: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   10327: 
                   10328: =back
                   10329: 
                   10330: Returns:
                   10331: 
                   10332: An <img> tag which references graph.png and the appropriate identifying
                   10333: information for the plot.
1.136     matthew  10334: 
                   10335: =cut
                   10336: 
                   10337: ############################################################
                   10338: ############################################################
1.137     matthew  10339: sub DrawXYYGraph {
                   10340:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   10341:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  10342:     #
                   10343:     # Create the identifier for the graph
                   10344:     my $identifier = &get_cgi_id();
                   10345:     my $id = 'cgi.'.$identifier;
                   10346:     #
                   10347:     $Title  = '' if (! defined($Title));
                   10348:     $xlabel = '' if (! defined($xlabel));
                   10349:     $ylabel = '' if (! defined($ylabel));
                   10350:     my %ValuesHash = 
                   10351:         (
1.369     www      10352:          $id.'.title'  => &escape($Title),
                   10353:          $id.'.xlabel' => &escape($xlabel),
                   10354:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  10355:          $id.'.labels' => join(',',@$Xlabels),
                   10356:          $id.'.PlotType' => 'XY',
                   10357:          $id.'.NumSets' => 2,
1.137     matthew  10358:          $id.'.two_axes' => 1,
                   10359:          $id.'.y1_max_value' => $Max1,
                   10360:          $id.'.y1_min_value' => $Min1,
                   10361:          $id.'.y2_max_value' => $Max2,
                   10362:          $id.'.y2_min_value' => $Min2,
1.136     matthew  10363:          );
                   10364:     #
1.137     matthew  10365:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   10366:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10367:     }
                   10368:     #
                   10369:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   10370:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  10371:         return '';
                   10372:     }
                   10373:     my $NumSets=1;
1.137     matthew  10374:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  10375:         next if (! ref($array));
                   10376:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  10377:     }
                   10378:     #
                   10379:     # Deal with other parameters
                   10380:     while (my ($key,$value) = each(%Values)) {
                   10381:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  10382:     }
                   10383:     #
1.646     raeburn  10384:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 10385:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  10386: }
                   10387: 
                   10388: ############################################################
                   10389: ############################################################
                   10390: 
                   10391: =pod
                   10392: 
1.157     matthew  10393: =back 
                   10394: 
1.139     matthew  10395: =head1 Statistics helper routines?  
                   10396: 
                   10397: Bad place for them but what the hell.
                   10398: 
1.157     matthew  10399: =over 4
                   10400: 
1.648     raeburn  10401: =item * &chartlink()
1.139     matthew  10402: 
                   10403: Returns a link to the chart for a specific student.  
                   10404: 
                   10405: Inputs:
                   10406: 
                   10407: =over 4
                   10408: 
                   10409: =item $linktext: The text of the link
                   10410: 
                   10411: =item $sname: The students username
                   10412: 
                   10413: =item $sdomain: The students domain
                   10414: 
                   10415: =back
                   10416: 
1.157     matthew  10417: =back
                   10418: 
1.139     matthew  10419: =cut
                   10420: 
                   10421: ############################################################
                   10422: ############################################################
                   10423: sub chartlink {
                   10424:     my ($linktext, $sname, $sdomain) = @_;
                   10425:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      10426:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 10427:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  10428:        '">'.$linktext.'</a>';
1.153     matthew  10429: }
                   10430: 
                   10431: #######################################################
                   10432: #######################################################
                   10433: 
                   10434: =pod
                   10435: 
                   10436: =head1 Course Environment Routines
1.157     matthew  10437: 
                   10438: =over 4
1.153     matthew  10439: 
1.648     raeburn  10440: =item * &restore_course_settings()
1.153     matthew  10441: 
1.648     raeburn  10442: =item * &store_course_settings()
1.153     matthew  10443: 
                   10444: Restores/Store indicated form parameters from the course environment.
                   10445: Will not overwrite existing values of the form parameters.
                   10446: 
                   10447: Inputs: 
                   10448: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   10449: 
                   10450: a hash ref describing the data to be stored.  For example:
                   10451:    
                   10452: %Save_Parameters = ('Status' => 'scalar',
                   10453:     'chartoutputmode' => 'scalar',
                   10454:     'chartoutputdata' => 'scalar',
                   10455:     'Section' => 'array',
1.373     raeburn  10456:     'Group' => 'array',
1.153     matthew  10457:     'StudentData' => 'array',
                   10458:     'Maps' => 'array');
                   10459: 
                   10460: Returns: both routines return nothing
                   10461: 
1.631     raeburn  10462: =back
                   10463: 
1.153     matthew  10464: =cut
                   10465: 
                   10466: #######################################################
                   10467: #######################################################
                   10468: sub store_course_settings {
1.496     albertel 10469:     return &store_settings($env{'request.course.id'},@_);
                   10470: }
                   10471: 
                   10472: sub store_settings {
1.153     matthew  10473:     # save to the environment
                   10474:     # appenv the same items, just to be safe
1.300     albertel 10475:     my $udom  = $env{'user.domain'};
                   10476:     my $uname = $env{'user.name'};
1.496     albertel 10477:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10478:     my %SaveHash;
                   10479:     my %AppHash;
                   10480:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 10481:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 10482:         my $envname = 'environment.'.$basename;
1.258     albertel 10483:         if (exists($env{'form.'.$setting})) {
1.153     matthew  10484:             # Save this value away
                   10485:             if ($type eq 'scalar' &&
1.258     albertel 10486:                 (! exists($env{$envname}) || 
                   10487:                  $env{$envname} ne $env{'form.'.$setting})) {
                   10488:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   10489:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  10490:             } elsif ($type eq 'array') {
                   10491:                 my $stored_form;
1.258     albertel 10492:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  10493:                     $stored_form = join(',',
                   10494:                                         map {
1.369     www      10495:                                             &escape($_);
1.258     albertel 10496:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  10497:                 } else {
                   10498:                     $stored_form = 
1.369     www      10499:                         &escape($env{'form.'.$setting});
1.153     matthew  10500:                 }
                   10501:                 # Determine if the array contents are the same.
1.258     albertel 10502:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  10503:                     $SaveHash{$basename} = $stored_form;
                   10504:                     $AppHash{$envname}   = $stored_form;
                   10505:                 }
                   10506:             }
                   10507:         }
                   10508:     }
                   10509:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 10510:                                           $udom,$uname);
1.153     matthew  10511:     if ($put_result !~ /^(ok|delayed)/) {
                   10512:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   10513:                                  'got error:'.$put_result);
                   10514:     }
                   10515:     # Make sure these settings stick around in this session, too
1.646     raeburn  10516:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  10517:     return;
                   10518: }
                   10519: 
                   10520: sub restore_course_settings {
1.499     albertel 10521:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 10522: }
                   10523: 
                   10524: sub restore_settings {
                   10525:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10526:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 10527:         next if (exists($env{'form.'.$setting}));
1.496     albertel 10528:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  10529:             '.'.$setting;
1.258     albertel 10530:         if (exists($env{$envname})) {
1.153     matthew  10531:             if ($type eq 'scalar') {
1.258     albertel 10532:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  10533:             } elsif ($type eq 'array') {
1.258     albertel 10534:                 $env{'form.'.$setting} = [ 
1.153     matthew  10535:                                            map { 
1.369     www      10536:                                                &unescape($_); 
1.258     albertel 10537:                                            } split(',',$env{$envname})
1.153     matthew  10538:                                            ];
                   10539:             }
                   10540:         }
                   10541:     }
1.127     matthew  10542: }
                   10543: 
1.618     raeburn  10544: #######################################################
                   10545: #######################################################
                   10546: 
                   10547: =pod
                   10548: 
                   10549: =head1 Domain E-mail Routines  
                   10550: 
                   10551: =over 4
                   10552: 
1.648     raeburn  10553: =item * &build_recipient_list()
1.618     raeburn  10554: 
1.884     raeburn  10555: Build recipient lists for five types of e-mail:
1.766     raeburn  10556: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  10557: (d) Help requests, (e) Course requests needing approval,  generated by
                   10558: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   10559: loncoursequeueadmin.pm respectively.
1.618     raeburn  10560: 
                   10561: Inputs:
1.619     raeburn  10562: defmail (scalar - email address of default recipient), 
1.618     raeburn  10563: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  10564: defdom (domain for which to retrieve configuration settings),
                   10565: origmail (scalar - email address of recipient from loncapa.conf, 
                   10566: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  10567: 
1.655     raeburn  10568: Returns: comma separated list of addresses to which to send e-mail.
                   10569: 
                   10570: =back
1.618     raeburn  10571: 
                   10572: =cut
                   10573: 
                   10574: ############################################################
                   10575: ############################################################
                   10576: sub build_recipient_list {
1.619     raeburn  10577:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  10578:     my @recipients;
                   10579:     my $otheremails;
                   10580:     my %domconfig =
                   10581:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   10582:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  10583:         if (exists($domconfig{'contacts'}{$mailing})) {
                   10584:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   10585:                 my @contacts = ('adminemail','supportemail');
                   10586:                 foreach my $item (@contacts) {
                   10587:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   10588:                         my $addr = $domconfig{'contacts'}{$item}; 
                   10589:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10590:                             push(@recipients,$addr);
                   10591:                         }
1.619     raeburn  10592:                     }
1.766     raeburn  10593:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  10594:                 }
                   10595:             }
1.766     raeburn  10596:         } elsif ($origmail ne '') {
                   10597:             push(@recipients,$origmail);
1.618     raeburn  10598:         }
1.619     raeburn  10599:     } elsif ($origmail ne '') {
                   10600:         push(@recipients,$origmail);
1.618     raeburn  10601:     }
1.688     raeburn  10602:     if (defined($defmail)) {
                   10603:         if ($defmail ne '') {
                   10604:             push(@recipients,$defmail);
                   10605:         }
1.618     raeburn  10606:     }
                   10607:     if ($otheremails) {
1.619     raeburn  10608:         my @others;
                   10609:         if ($otheremails =~ /,/) {
                   10610:             @others = split(/,/,$otheremails);
1.618     raeburn  10611:         } else {
1.619     raeburn  10612:             push(@others,$otheremails);
                   10613:         }
                   10614:         foreach my $addr (@others) {
                   10615:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10616:                 push(@recipients,$addr);
                   10617:             }
1.618     raeburn  10618:         }
                   10619:     }
1.619     raeburn  10620:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  10621:     return $recipientlist;
                   10622: }
                   10623: 
1.127     matthew  10624: ############################################################
                   10625: ############################################################
1.154     albertel 10626: 
1.655     raeburn  10627: =pod
                   10628: 
                   10629: =head1 Course Catalog Routines
                   10630: 
                   10631: =over 4
                   10632: 
                   10633: =item * &gather_categories()
                   10634: 
                   10635: Converts category definitions - keys of categories hash stored in  
                   10636: coursecategories in configuration.db on the primary library server in a 
                   10637: domain - to an array.  Also generates javascript and idx hash used to 
                   10638: generate Domain Coordinator interface for editing Course Categories.
                   10639: 
                   10640: Inputs:
1.663     raeburn  10641: 
1.655     raeburn  10642: categories (reference to hash of category definitions).
1.663     raeburn  10643: 
1.655     raeburn  10644: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10645:       categories and subcategories).
1.663     raeburn  10646: 
1.655     raeburn  10647: idx (reference to hash of counters used in Domain Coordinator interface for 
                   10648:       editing Course Categories).
1.663     raeburn  10649: 
1.655     raeburn  10650: jsarray (reference to array of categories used to create Javascript arrays for
                   10651:          Domain Coordinator interface for editing Course Categories).
                   10652: 
                   10653: Returns: nothing
                   10654: 
                   10655: Side effects: populates cats, idx and jsarray. 
                   10656: 
                   10657: =cut
                   10658: 
                   10659: sub gather_categories {
                   10660:     my ($categories,$cats,$idx,$jsarray) = @_;
                   10661:     my %counters;
                   10662:     my $num = 0;
                   10663:     foreach my $item (keys(%{$categories})) {
                   10664:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   10665:         if ($container eq '' && $depth == 0) {
                   10666:             $cats->[$depth][$categories->{$item}] = $cat;
                   10667:         } else {
                   10668:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   10669:         }
                   10670:         my ($escitem,$tail) = split(/:/,$item,2);
                   10671:         if ($counters{$tail} eq '') {
                   10672:             $counters{$tail} = $num;
                   10673:             $num ++;
                   10674:         }
                   10675:         if (ref($idx) eq 'HASH') {
                   10676:             $idx->{$item} = $counters{$tail};
                   10677:         }
                   10678:         if (ref($jsarray) eq 'ARRAY') {
                   10679:             push(@{$jsarray->[$counters{$tail}]},$item);
                   10680:         }
                   10681:     }
                   10682:     return;
                   10683: }
                   10684: 
                   10685: =pod
                   10686: 
                   10687: =item * &extract_categories()
                   10688: 
                   10689: Used to generate breadcrumb trails for course categories.
                   10690: 
                   10691: Inputs:
1.663     raeburn  10692: 
1.655     raeburn  10693: categories (reference to hash of category definitions).
1.663     raeburn  10694: 
1.655     raeburn  10695: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10696:       categories and subcategories).
1.663     raeburn  10697: 
1.655     raeburn  10698: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  10699: 
1.655     raeburn  10700: allitems (reference to hash - key is category key 
                   10701:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10702: 
1.655     raeburn  10703: idx (reference to hash of counters used in Domain Coordinator interface for
                   10704:       editing Course Categories).
1.663     raeburn  10705: 
1.655     raeburn  10706: jsarray (reference to array of categories used to create Javascript arrays for
                   10707:          Domain Coordinator interface for editing Course Categories).
                   10708: 
1.665     raeburn  10709: subcats (reference to hash of arrays containing all subcategories within each 
                   10710:          category, -recursive)
                   10711: 
1.655     raeburn  10712: Returns: nothing
                   10713: 
                   10714: Side effects: populates trails and allitems hash references.
                   10715: 
                   10716: =cut
                   10717: 
                   10718: sub extract_categories {
1.665     raeburn  10719:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  10720:     if (ref($categories) eq 'HASH') {
                   10721:         &gather_categories($categories,$cats,$idx,$jsarray);
                   10722:         if (ref($cats->[0]) eq 'ARRAY') {
                   10723:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   10724:                 my $name = $cats->[0][$i];
                   10725:                 my $item = &escape($name).'::0';
                   10726:                 my $trailstr;
                   10727:                 if ($name eq 'instcode') {
                   10728:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  10729:                 } elsif ($name eq 'communities') {
                   10730:                     $trailstr = &mt('Communities');
1.655     raeburn  10731:                 } else {
                   10732:                     $trailstr = $name;
                   10733:                 }
                   10734:                 if ($allitems->{$item} eq '') {
                   10735:                     push(@{$trails},$trailstr);
                   10736:                     $allitems->{$item} = scalar(@{$trails})-1;
                   10737:                 }
                   10738:                 my @parents = ($name);
                   10739:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   10740:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   10741:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  10742:                         if (ref($subcats) eq 'HASH') {
                   10743:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   10744:                         }
                   10745:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   10746:                     }
                   10747:                 } else {
                   10748:                     if (ref($subcats) eq 'HASH') {
                   10749:                         $subcats->{$item} = [];
1.655     raeburn  10750:                     }
                   10751:                 }
                   10752:             }
                   10753:         }
                   10754:     }
                   10755:     return;
                   10756: }
                   10757: 
                   10758: =pod
                   10759: 
                   10760: =item *&recurse_categories()
                   10761: 
                   10762: Recursively used to generate breadcrumb trails for course categories.
                   10763: 
                   10764: Inputs:
1.663     raeburn  10765: 
1.655     raeburn  10766: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10767:       categories and subcategories).
1.663     raeburn  10768: 
1.655     raeburn  10769: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  10770: 
                   10771: category (current course category, for which breadcrumb trail is being generated).
                   10772: 
                   10773: trails (reference to array of breadcrumb trails for each category).
                   10774: 
1.655     raeburn  10775: allitems (reference to hash - key is category key
                   10776:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10777: 
1.655     raeburn  10778: parents (array containing containers directories for current category, 
                   10779:          back to top level). 
                   10780: 
                   10781: Returns: nothing
                   10782: 
                   10783: Side effects: populates trails and allitems hash references
                   10784: 
                   10785: =cut
                   10786: 
                   10787: sub recurse_categories {
1.665     raeburn  10788:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  10789:     my $shallower = $depth - 1;
                   10790:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   10791:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   10792:             my $name = $cats->[$depth]{$category}[$k];
                   10793:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10794:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10795:             if ($allitems->{$item} eq '') {
                   10796:                 push(@{$trails},$trailstr);
                   10797:                 $allitems->{$item} = scalar(@{$trails})-1;
                   10798:             }
                   10799:             my $deeper = $depth+1;
                   10800:             push(@{$parents},$category);
1.665     raeburn  10801:             if (ref($subcats) eq 'HASH') {
                   10802:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   10803:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   10804:                     my $higher;
                   10805:                     if ($j > 0) {
                   10806:                         $higher = &escape($parents->[$j]).':'.
                   10807:                                   &escape($parents->[$j-1]).':'.$j;
                   10808:                     } else {
                   10809:                         $higher = &escape($parents->[$j]).'::'.$j;
                   10810:                     }
                   10811:                     push(@{$subcats->{$higher}},$subcat);
                   10812:                 }
                   10813:             }
                   10814:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   10815:                                 $subcats);
1.655     raeburn  10816:             pop(@{$parents});
                   10817:         }
                   10818:     } else {
                   10819:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10820:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10821:         if ($allitems->{$item} eq '') {
                   10822:             push(@{$trails},$trailstr);
                   10823:             $allitems->{$item} = scalar(@{$trails})-1;
                   10824:         }
                   10825:     }
                   10826:     return;
                   10827: }
                   10828: 
1.663     raeburn  10829: =pod
                   10830: 
                   10831: =item *&assign_categories_table()
                   10832: 
                   10833: Create a datatable for display of hierarchical categories in a domain,
                   10834: with checkboxes to allow a course to be categorized. 
                   10835: 
                   10836: Inputs:
                   10837: 
                   10838: cathash - reference to hash of categories defined for the domain (from
                   10839:           configuration.db)
                   10840: 
                   10841: currcat - scalar with an & separated list of categories assigned to a course. 
                   10842: 
1.919     raeburn  10843: type    - scalar contains course type (Course or Community).
                   10844: 
1.663     raeburn  10845: Returns: $output (markup to be displayed) 
                   10846: 
                   10847: =cut
                   10848: 
                   10849: sub assign_categories_table {
1.919     raeburn  10850:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  10851:     my $output;
                   10852:     if (ref($cathash) eq 'HASH') {
                   10853:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   10854:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   10855:         $maxdepth = scalar(@cats);
                   10856:         if (@cats > 0) {
                   10857:             my $itemcount = 0;
                   10858:             if (ref($cats[0]) eq 'ARRAY') {
                   10859:                 my @currcategories;
                   10860:                 if ($currcat ne '') {
                   10861:                     @currcategories = split('&',$currcat);
                   10862:                 }
1.919     raeburn  10863:                 my $table;
1.663     raeburn  10864:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   10865:                     my $parent = $cats[0][$i];
1.919     raeburn  10866:                     next if ($parent eq 'instcode');
                   10867:                     if ($type eq 'Community') {
                   10868:                         next unless ($parent eq 'communities');
                   10869:                     } else {
                   10870:                         next if ($parent eq 'communities');
                   10871:                     }
1.663     raeburn  10872:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10873:                     my $item = &escape($parent).'::0';
                   10874:                     my $checked = '';
                   10875:                     if (@currcategories > 0) {
                   10876:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   10877:                             $checked = ' checked="checked"';
1.663     raeburn  10878:                         }
                   10879:                     }
1.919     raeburn  10880:                     my $parent_title = $parent;
                   10881:                     if ($parent eq 'communities') {
                   10882:                         $parent_title = &mt('Communities');
                   10883:                     }
                   10884:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   10885:                               '<input type="checkbox" name="usecategory" value="'.
                   10886:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   10887:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  10888:                     my $depth = 1;
                   10889:                     push(@path,$parent);
1.919     raeburn  10890:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  10891:                     pop(@path);
1.919     raeburn  10892:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  10893:                     $itemcount ++;
                   10894:                 }
1.919     raeburn  10895:                 if ($itemcount) {
                   10896:                     $output = &Apache::loncommon::start_data_table().
                   10897:                               $table.
                   10898:                               &Apache::loncommon::end_data_table();
                   10899:                 }
1.663     raeburn  10900:             }
                   10901:         }
                   10902:     }
                   10903:     return $output;
                   10904: }
                   10905: 
                   10906: =pod
                   10907: 
                   10908: =item *&assign_category_rows()
                   10909: 
                   10910: Create a datatable row for display of nested categories in a domain,
                   10911: with checkboxes to allow a course to be categorized,called recursively.
                   10912: 
                   10913: Inputs:
                   10914: 
                   10915: itemcount - track row number for alternating colors
                   10916: 
                   10917: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   10918:       categories and subcategories.
                   10919: 
                   10920: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   10921: 
                   10922: parent - parent of current category item
                   10923: 
                   10924: path - Array containing all categories back up through the hierarchy from the
                   10925:        current category to the top level.
                   10926: 
                   10927: currcategories - reference to array of current categories assigned to the course
                   10928: 
                   10929: Returns: $output (markup to be displayed).
                   10930: 
                   10931: =cut
                   10932: 
                   10933: sub assign_category_rows {
                   10934:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   10935:     my ($text,$name,$item,$chgstr);
                   10936:     if (ref($cats) eq 'ARRAY') {
                   10937:         my $maxdepth = scalar(@{$cats});
                   10938:         if (ref($cats->[$depth]) eq 'HASH') {
                   10939:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   10940:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   10941:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10942:                 $text .= '<td><table class="LC_datatable">';
                   10943:                 for (my $j=0; $j<$numchildren; $j++) {
                   10944:                     $name = $cats->[$depth]{$parent}[$j];
                   10945:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   10946:                     my $deeper = $depth+1;
                   10947:                     my $checked = '';
                   10948:                     if (ref($currcategories) eq 'ARRAY') {
                   10949:                         if (@{$currcategories} > 0) {
                   10950:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   10951:                                 $checked = ' checked="checked"';
1.663     raeburn  10952:                             }
                   10953:                         }
                   10954:                     }
1.664     raeburn  10955:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   10956:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  10957:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   10958:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   10959:                              '</td><td>';
1.663     raeburn  10960:                     if (ref($path) eq 'ARRAY') {
                   10961:                         push(@{$path},$name);
                   10962:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   10963:                         pop(@{$path});
                   10964:                     }
                   10965:                     $text .= '</td></tr>';
                   10966:                 }
                   10967:                 $text .= '</table></td>';
                   10968:             }
                   10969:         }
                   10970:     }
                   10971:     return $text;
                   10972: }
                   10973: 
1.655     raeburn  10974: ############################################################
                   10975: ############################################################
                   10976: 
                   10977: 
1.443     albertel 10978: sub commit_customrole {
1.664     raeburn  10979:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  10980:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 10981:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   10982:                          ($end?', ending '.localtime($end):'').': <b>'.
                   10983:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  10984:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 10985:                  '</b><br />';
                   10986:     return $output;
                   10987: }
                   10988: 
                   10989: sub commit_standardrole {
1.541     raeburn  10990:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   10991:     my ($output,$logmsg,$linefeed);
                   10992:     if ($context eq 'auto') {
                   10993:         $linefeed = "\n";
                   10994:     } else {
                   10995:         $linefeed = "<br />\n";
                   10996:     }  
1.443     albertel 10997:     if ($three eq 'st') {
1.541     raeburn  10998:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   10999:                                          $one,$two,$sec,$context);
                   11000:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  11001:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   11002:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 11003:         } else {
1.541     raeburn  11004:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 11005:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  11006:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   11007:             if ($context eq 'auto') {
                   11008:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   11009:             } else {
                   11010:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   11011:                &mt('Add to classlist').': <b>ok</b>';
                   11012:             }
                   11013:             $output .= $linefeed;
1.443     albertel 11014:         }
                   11015:     } else {
                   11016:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   11017:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  11018:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  11019:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  11020:         if ($context eq 'auto') {
                   11021:             $output .= $result.$linefeed;
                   11022:         } else {
                   11023:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   11024:         }
1.443     albertel 11025:     }
                   11026:     return $output;
                   11027: }
                   11028: 
                   11029: sub commit_studentrole {
1.541     raeburn  11030:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  11031:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  11032:     if ($context eq 'auto') {
                   11033:         $linefeed = "\n";
                   11034:     } else {
                   11035:         $linefeed = '<br />'."\n";
                   11036:     }
1.443     albertel 11037:     if (defined($one) && defined($two)) {
                   11038:         my $cid=$one.'_'.$two;
                   11039:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   11040:         my $secchange = 0;
                   11041:         my $expire_role_result;
                   11042:         my $modify_section_result;
1.628     raeburn  11043:         if ($oldsec ne '-1') { 
                   11044:             if ($oldsec ne $sec) {
1.443     albertel 11045:                 $secchange = 1;
1.628     raeburn  11046:                 my $now = time;
1.443     albertel 11047:                 my $uurl='/'.$cid;
                   11048:                 $uurl=~s/\_/\//g;
                   11049:                 if ($oldsec) {
                   11050:                     $uurl.='/'.$oldsec;
                   11051:                 }
1.626     raeburn  11052:                 $oldsecurl = $uurl;
1.628     raeburn  11053:                 $expire_role_result = 
1.652     raeburn  11054:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  11055:                 if ($env{'request.course.sec'} ne '') { 
                   11056:                     if ($expire_role_result eq 'refused') {
                   11057:                         my @roles = ('st');
                   11058:                         my @statuses = ('previous');
                   11059:                         my @roledoms = ($one);
                   11060:                         my $withsec = 1;
                   11061:                         my %roleshash = 
                   11062:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   11063:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   11064:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   11065:                             my ($oldstart,$oldend) = 
                   11066:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   11067:                             if ($oldend > 0 && $oldend <= $now) {
                   11068:                                 $expire_role_result = 'ok';
                   11069:                             }
                   11070:                         }
                   11071:                     }
                   11072:                 }
1.443     albertel 11073:                 $result = $expire_role_result;
                   11074:             }
                   11075:         }
                   11076:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  11077:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 11078:             if ($modify_section_result =~ /^ok/) {
                   11079:                 if ($secchange == 1) {
1.628     raeburn  11080:                     if ($sec eq '') {
                   11081:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   11082:                     } else {
                   11083:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   11084:                     }
1.443     albertel 11085:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  11086:                     if ($sec eq '') {
                   11087:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   11088:                     } else {
                   11089:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   11090:                     }
1.443     albertel 11091:                 } else {
1.628     raeburn  11092:                     if ($sec eq '') {
                   11093:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   11094:                     } else {
                   11095:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   11096:                     }
1.443     albertel 11097:                 }
                   11098:             } else {
1.628     raeburn  11099:                 if ($secchange) {       
                   11100:                     $$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;
                   11101:                 } else {
                   11102:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   11103:                 }
1.443     albertel 11104:             }
                   11105:             $result = $modify_section_result;
                   11106:         } elsif ($secchange == 1) {
1.628     raeburn  11107:             if ($oldsec eq '') {
                   11108:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   11109:             } else {
                   11110:                 $$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;
                   11111:             }
1.626     raeburn  11112:             if ($expire_role_result eq 'refused') {
                   11113:                 my $newsecurl = '/'.$cid;
                   11114:                 $newsecurl =~ s/\_/\//g;
                   11115:                 if ($sec ne '') {
                   11116:                     $newsecurl.='/'.$sec;
                   11117:                 }
                   11118:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   11119:                     if ($sec eq '') {
                   11120:                         $$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;
                   11121:                     } else {
                   11122:                         $$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;
                   11123:                     }
                   11124:                 }
                   11125:             }
1.443     albertel 11126:         }
                   11127:     } else {
1.626     raeburn  11128:         $$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 11129:         $result = "error: incomplete course id\n";
                   11130:     }
                   11131:     return $result;
                   11132: }
                   11133: 
                   11134: ############################################################
                   11135: ############################################################
                   11136: 
1.566     albertel 11137: sub check_clone {
1.578     raeburn  11138:     my ($args,$linefeed) = @_;
1.566     albertel 11139:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   11140:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   11141:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   11142:     my $clonemsg;
                   11143:     my $can_clone = 0;
1.944     raeburn  11144:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  11145:     if ($lctype ne 'community') {
                   11146:         $lctype = 'course';
                   11147:     }
1.566     albertel 11148:     if ($clonehome eq 'no_host') {
1.944     raeburn  11149:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11150:             $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'});
                   11151:         } else {
                   11152:             $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'});
                   11153:         }     
1.566     albertel 11154:     } else {
                   11155: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  11156:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11157:             if ($clonedesc{'type'} ne 'Community') {
                   11158:                  $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'});
                   11159:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   11160:             }
                   11161:         }
1.882     raeburn  11162: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   11163:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 11164: 	    $can_clone = 1;
                   11165: 	} else {
                   11166: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   11167: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   11168: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  11169:             if (grep(/^\*$/,@cloners)) {
                   11170:                 $can_clone = 1;
                   11171:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   11172:                 $can_clone = 1;
                   11173:             } else {
1.908     raeburn  11174:                 my $ccrole = 'cc';
1.944     raeburn  11175:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11176:                     $ccrole = 'co';
                   11177:                 }
1.578     raeburn  11178: 	        my %roleshash =
                   11179: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   11180: 					 $args->{'ccdomain'},
1.908     raeburn  11181:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  11182: 					 [$args->{'clonedomain'}]);
1.908     raeburn  11183: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  11184:                     $can_clone = 1;
                   11185:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   11186:                     $can_clone = 1;
                   11187:                 } else {
1.944     raeburn  11188:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11189:                         $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'});
                   11190:                     } else {
                   11191:                         $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'});
                   11192:                     }
1.578     raeburn  11193: 	        }
1.566     albertel 11194: 	    }
1.578     raeburn  11195:         }
1.566     albertel 11196:     }
                   11197:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   11198: }
                   11199: 
1.444     albertel 11200: sub construct_course {
1.885     raeburn  11201:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 11202:     my $outcome;
1.541     raeburn  11203:     my $linefeed =  '<br />'."\n";
                   11204:     if ($context eq 'auto') {
                   11205:         $linefeed = "\n";
                   11206:     }
1.566     albertel 11207: 
                   11208: #
                   11209: # Are we cloning?
                   11210: #
                   11211:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   11212:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  11213: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 11214: 	if ($context ne 'auto') {
1.578     raeburn  11215:             if ($clonemsg ne '') {
                   11216: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   11217:             }
1.566     albertel 11218: 	}
                   11219: 	$outcome .= $clonemsg.$linefeed;
                   11220: 
                   11221:         if (!$can_clone) {
                   11222: 	    return (0,$outcome);
                   11223: 	}
                   11224:     }
                   11225: 
1.444     albertel 11226: #
                   11227: # Open course
                   11228: #
                   11229:     my $crstype = lc($args->{'crstype'});
                   11230:     my %cenv=();
                   11231:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   11232:                                              $args->{'cdescr'},
                   11233:                                              $args->{'curl'},
                   11234:                                              $args->{'course_home'},
                   11235:                                              $args->{'nonstandard'},
                   11236:                                              $args->{'crscode'},
                   11237:                                              $args->{'ccuname'}.':'.
                   11238:                                              $args->{'ccdomain'},
1.882     raeburn  11239:                                              $args->{'crstype'},
1.885     raeburn  11240:                                              $cnum,$context,$category);
1.444     albertel 11241: 
                   11242:     # Note: The testing routines depend on this being output; see 
                   11243:     # Utils::Course. This needs to at least be output as a comment
                   11244:     # if anyone ever decides to not show this, and Utils::Course::new
                   11245:     # will need to be suitably modified.
1.541     raeburn  11246:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  11247:     if ($$courseid =~ /^error:/) {
                   11248:         return (0,$outcome);
                   11249:     }
                   11250: 
1.444     albertel 11251: #
                   11252: # Check if created correctly
                   11253: #
1.479     albertel 11254:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 11255:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  11256:     if ($crsuhome eq 'no_host') {
                   11257:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   11258:         return (0,$outcome);
                   11259:     }
1.541     raeburn  11260:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 11261: 
1.444     albertel 11262: #
1.566     albertel 11263: # Do the cloning
                   11264: #   
                   11265:     if ($can_clone && $cloneid) {
                   11266: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   11267: 	if ($context ne 'auto') {
                   11268: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   11269: 	}
                   11270: 	$outcome .= $clonemsg.$linefeed;
                   11271: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 11272: # Copy all files
1.637     www      11273: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 11274: # Restore URL
1.566     albertel 11275: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 11276: # Restore title
1.566     albertel 11277: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  11278: # Restore creation date, creator and creation context.
                   11279:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   11280:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   11281:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 11282: # Mark as cloned
1.566     albertel 11283: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      11284: # Need to clone grading mode
                   11285:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   11286:         $cenv{'grading'}=$newenv{'grading'};
                   11287: # Do not clone these environment entries
                   11288:         &Apache::lonnet::del('environment',
                   11289:                   ['default_enrollment_start_date',
                   11290:                    'default_enrollment_end_date',
                   11291:                    'question.email',
                   11292:                    'policy.email',
                   11293:                    'comment.email',
                   11294:                    'pch.users.denied',
1.725     raeburn  11295:                    'plc.users.denied',
                   11296:                    'hidefromcat',
                   11297:                    'categories'],
1.638     www      11298:                    $$crsudom,$$crsunum);
1.444     albertel 11299:     }
1.566     albertel 11300: 
1.444     albertel 11301: #
                   11302: # Set environment (will override cloned, if existing)
                   11303: #
                   11304:     my @sections = ();
                   11305:     my @xlists = ();
                   11306:     if ($args->{'crstype'}) {
                   11307:         $cenv{'type'}=$args->{'crstype'};
                   11308:     }
                   11309:     if ($args->{'crsid'}) {
                   11310:         $cenv{'courseid'}=$args->{'crsid'};
                   11311:     }
                   11312:     if ($args->{'crscode'}) {
                   11313:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   11314:     }
                   11315:     if ($args->{'crsquota'} ne '') {
                   11316:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   11317:     } else {
                   11318:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   11319:     }
                   11320:     if ($args->{'ccuname'}) {
                   11321:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   11322:                                         ':'.$args->{'ccdomain'};
                   11323:     } else {
                   11324:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   11325:     }
                   11326:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   11327:     if ($args->{'crssections'}) {
                   11328:         $cenv{'internal.sectionnums'} = '';
                   11329:         if ($args->{'crssections'} =~ m/,/) {
                   11330:             @sections = split/,/,$args->{'crssections'};
                   11331:         } else {
                   11332:             $sections[0] = $args->{'crssections'};
                   11333:         }
                   11334:         if (@sections > 0) {
                   11335:             foreach my $item (@sections) {
                   11336:                 my ($sec,$gp) = split/:/,$item;
                   11337:                 my $class = $args->{'crscode'}.$sec;
                   11338:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   11339:                 $cenv{'internal.sectionnums'} .= $item.',';
                   11340:                 unless ($addcheck eq 'ok') {
                   11341:                     push @badclasses, $class;
                   11342:                 }
                   11343:             }
                   11344:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   11345:         }
                   11346:     }
                   11347: # do not hide course coordinator from staff listing, 
                   11348: # even if privileged
                   11349:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11350: # add crosslistings
                   11351:     if ($args->{'crsxlist'}) {
                   11352:         $cenv{'internal.crosslistings'}='';
                   11353:         if ($args->{'crsxlist'} =~ m/,/) {
                   11354:             @xlists = split/,/,$args->{'crsxlist'};
                   11355:         } else {
                   11356:             $xlists[0] = $args->{'crsxlist'};
                   11357:         }
                   11358:         if (@xlists > 0) {
                   11359:             foreach my $item (@xlists) {
                   11360:                 my ($xl,$gp) = split/:/,$item;
                   11361:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   11362:                 $cenv{'internal.crosslistings'} .= $item.',';
                   11363:                 unless ($addcheck eq 'ok') {
                   11364:                     push @badclasses, $xl;
                   11365:                 }
                   11366:             }
                   11367:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   11368:         }
                   11369:     }
                   11370:     if ($args->{'autoadds'}) {
                   11371:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   11372:     }
                   11373:     if ($args->{'autodrops'}) {
                   11374:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   11375:     }
                   11376: # check for notification of enrollment changes
                   11377:     my @notified = ();
                   11378:     if ($args->{'notify_owner'}) {
                   11379:         if ($args->{'ccuname'} ne '') {
                   11380:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   11381:         }
                   11382:     }
                   11383:     if ($args->{'notify_dc'}) {
                   11384:         if ($uname ne '') { 
1.630     raeburn  11385:             push(@notified,$uname.':'.$udom);
1.444     albertel 11386:         }
                   11387:     }
                   11388:     if (@notified > 0) {
                   11389:         my $notifylist;
                   11390:         if (@notified > 1) {
                   11391:             $notifylist = join(',',@notified);
                   11392:         } else {
                   11393:             $notifylist = $notified[0];
                   11394:         }
                   11395:         $cenv{'internal.notifylist'} = $notifylist;
                   11396:     }
                   11397:     if (@badclasses > 0) {
                   11398:         my %lt=&Apache::lonlocal::texthash(
                   11399:                 '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',
                   11400:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   11401:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   11402:         );
1.541     raeburn  11403:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   11404:                            ' ('.$lt{'adby'}.')';
                   11405:         if ($context eq 'auto') {
                   11406:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 11407:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  11408:             foreach my $item (@badclasses) {
                   11409:                 if ($context eq 'auto') {
                   11410:                     $outcome .= " - $item\n";
                   11411:                 } else {
                   11412:                     $outcome .= "<li>$item</li>\n";
                   11413:                 }
                   11414:             }
                   11415:             if ($context eq 'auto') {
                   11416:                 $outcome .= $linefeed;
                   11417:             } else {
1.566     albertel 11418:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  11419:             }
                   11420:         } 
1.444     albertel 11421:     }
                   11422:     if ($args->{'no_end_date'}) {
                   11423:         $args->{'endaccess'} = 0;
                   11424:     }
                   11425:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   11426:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   11427:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   11428:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   11429:     if ($args->{'showphotos'}) {
                   11430:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   11431:     }
                   11432:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   11433:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   11434:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   11435:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  11436:             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'); 
                   11437:             if ($context eq 'auto') {
                   11438:                 $outcome .= $krb_msg;
                   11439:             } else {
1.566     albertel 11440:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  11441:             }
                   11442:             $outcome .= $linefeed;
1.444     albertel 11443:         }
                   11444:     }
                   11445:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   11446:        if ($args->{'setpolicy'}) {
                   11447:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11448:        }
                   11449:        if ($args->{'setcontent'}) {
                   11450:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11451:        }
                   11452:     }
                   11453:     if ($args->{'reshome'}) {
                   11454: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   11455: 	$cenv{'reshome'}=~s/\/+$/\//;
                   11456:     }
                   11457: #
                   11458: # course has keyed access
                   11459: #
                   11460:     if ($args->{'setkeys'}) {
                   11461:        $cenv{'keyaccess'}='yes';
                   11462:     }
                   11463: # if specified, key authority is not course, but user
                   11464: # only active if keyaccess is yes
                   11465:     if ($args->{'keyauth'}) {
1.487     albertel 11466: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   11467: 	$user = &LONCAPA::clean_username($user);
                   11468: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     11469: 	if ($user ne '' && $domain ne '') {
1.487     albertel 11470: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 11471: 	}
                   11472:     }
                   11473: 
                   11474:     if ($args->{'disresdis'}) {
                   11475:         $cenv{'pch.roles.denied'}='st';
                   11476:     }
                   11477:     if ($args->{'disablechat'}) {
                   11478:         $cenv{'plc.roles.denied'}='st';
                   11479:     }
                   11480: 
                   11481:     # Record we've not yet viewed the Course Initialization Helper for this 
                   11482:     # course
                   11483:     $cenv{'course.helper.not.run'} = 1;
                   11484:     #
                   11485:     # Use new Randomseed
                   11486:     #
                   11487:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   11488:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   11489:     #
                   11490:     # The encryption code and receipt prefix for this course
                   11491:     #
                   11492:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   11493:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   11494:     #
                   11495:     # By default, use standard grading
                   11496:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   11497: 
1.541     raeburn  11498:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   11499:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 11500: #
                   11501: # Open all assignments
                   11502: #
                   11503:     if ($args->{'openall'}) {
                   11504:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   11505:        my %storecontent = ($storeunder         => time,
                   11506:                            $storeunder.'.type' => 'date_start');
                   11507:        
                   11508:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  11509:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 11510:    }
                   11511: #
                   11512: # Set first page
                   11513: #
                   11514:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   11515: 	    || ($cloneid)) {
1.445     albertel 11516: 	use LONCAPA::map;
1.444     albertel 11517: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 11518: 
                   11519: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   11520:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   11521: 
1.444     albertel 11522:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   11523:         my $title; my $url;
                   11524:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   11525: 	    $title=&mt('Syllabus');
1.444     albertel 11526:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   11527:         } else {
1.963     raeburn  11528:             $title=&mt('Table of Contents');
1.444     albertel 11529:             $url='/adm/navmaps';
                   11530:         }
1.445     albertel 11531: 
                   11532:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   11533: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   11534: 
                   11535: 	if ($errtext) { $fatal=2; }
1.541     raeburn  11536:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 11537:     }
1.566     albertel 11538: 
                   11539:     return (1,$outcome);
1.444     albertel 11540: }
                   11541: 
                   11542: ############################################################
                   11543: ############################################################
                   11544: 
1.953     droeschl 11545: #SD
                   11546: # only Community and Course, or anything else?
1.378     raeburn  11547: sub course_type {
                   11548:     my ($cid) = @_;
                   11549:     if (!defined($cid)) {
                   11550:         $cid = $env{'request.course.id'};
                   11551:     }
1.404     albertel 11552:     if (defined($env{'course.'.$cid.'.type'})) {
                   11553:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  11554:     } else {
                   11555:         return 'Course';
1.377     raeburn  11556:     }
                   11557: }
1.156     albertel 11558: 
1.406     raeburn  11559: sub group_term {
                   11560:     my $crstype = &course_type();
                   11561:     my %names = (
                   11562:                   'Course' => 'group',
1.865     raeburn  11563:                   'Community' => 'group',
1.406     raeburn  11564:                 );
                   11565:     return $names{$crstype};
                   11566: }
                   11567: 
1.902     raeburn  11568: sub course_types {
                   11569:     my @types = ('official','unofficial','community');
                   11570:     my %typename = (
                   11571:                          official   => 'Official course',
                   11572:                          unofficial => 'Unofficial course',
                   11573:                          community  => 'Community',
                   11574:                    );
                   11575:     return (\@types,\%typename);
                   11576: }
                   11577: 
1.156     albertel 11578: sub icon {
                   11579:     my ($file)=@_;
1.505     albertel 11580:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 11581:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 11582:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 11583:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   11584: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   11585: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11586: 	            $curfext.".gif") {
                   11587: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11588: 		$curfext.".gif";
                   11589: 	}
                   11590:     }
1.249     albertel 11591:     return &lonhttpdurl($iconname);
1.154     albertel 11592: } 
1.84      albertel 11593: 
1.575     albertel 11594: sub lonhttpdurl {
1.692     www      11595: #
                   11596: # Had been used for "small fry" static images on separate port 8080.
                   11597: # Modify here if lightweight http functionality desired again.
                   11598: # Currently eliminated due to increasing firewall issues.
                   11599: #
1.575     albertel 11600:     my ($url)=@_;
1.692     www      11601:     return $url;
1.215     albertel 11602: }
                   11603: 
1.213     albertel 11604: sub connection_aborted {
                   11605:     my ($r)=@_;
                   11606:     $r->print(" ");$r->rflush();
                   11607:     my $c = $r->connection;
                   11608:     return $c->aborted();
                   11609: }
                   11610: 
1.221     foxr     11611: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     11612: #    strings as 'strings'.
                   11613: sub escape_single {
1.221     foxr     11614:     my ($input) = @_;
1.223     albertel 11615:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     11616:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   11617:     return $input;
                   11618: }
1.223     albertel 11619: 
1.222     foxr     11620: #  Same as escape_single, but escape's "'s  This 
                   11621: #  can be used for  "strings"
                   11622: sub escape_double {
                   11623:     my ($input) = @_;
                   11624:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   11625:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   11626:     return $input;
                   11627: }
1.223     albertel 11628:  
1.222     foxr     11629: #   Escapes the last element of a full URL.
                   11630: sub escape_url {
                   11631:     my ($url)   = @_;
1.238     raeburn  11632:     my @urlslices = split(/\//, $url,-1);
1.369     www      11633:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 11634:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     11635: }
1.462     albertel 11636: 
1.820     raeburn  11637: sub compare_arrays {
                   11638:     my ($arrayref1,$arrayref2) = @_;
                   11639:     my (@difference,%count);
                   11640:     @difference = ();
                   11641:     %count = ();
                   11642:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   11643:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   11644:         foreach my $element (keys(%count)) {
                   11645:             if ($count{$element} == 1) {
                   11646:                 push(@difference,$element);
                   11647:             }
                   11648:         }
                   11649:     }
                   11650:     return @difference;
                   11651: }
                   11652: 
1.817     bisitz   11653: # -------------------------------------------------------- Initialize user login
1.462     albertel 11654: sub init_user_environment {
1.463     albertel 11655:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 11656:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   11657: 
                   11658:     my $public=($username eq 'public' && $domain eq 'public');
                   11659: 
                   11660: # See if old ID present, if so, remove
                   11661: 
                   11662:     my ($filename,$cookie,$userroles);
                   11663:     my $now=time;
                   11664: 
                   11665:     if ($public) {
                   11666: 	my $max_public=100;
                   11667: 	my $oldest;
                   11668: 	my $oldest_time=0;
                   11669: 	for(my $next=1;$next<=$max_public;$next++) {
                   11670: 	    if (-e $lonids."/publicuser_$next.id") {
                   11671: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   11672: 		if ($mtime<$oldest_time || !$oldest_time) {
                   11673: 		    $oldest_time=$mtime;
                   11674: 		    $oldest=$next;
                   11675: 		}
                   11676: 	    } else {
                   11677: 		$cookie="publicuser_$next";
                   11678: 		last;
                   11679: 	    }
                   11680: 	}
                   11681: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   11682:     } else {
1.463     albertel 11683: 	# if this isn't a robot, kill any existing non-robot sessions
                   11684: 	if (!$args->{'robot'}) {
                   11685: 	    opendir(DIR,$lonids);
                   11686: 	    while ($filename=readdir(DIR)) {
                   11687: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   11688: 		    unlink($lonids.'/'.$filename);
                   11689: 		}
1.462     albertel 11690: 	    }
1.463     albertel 11691: 	    closedir(DIR);
1.462     albertel 11692: 	}
                   11693: # Give them a new cookie
1.463     albertel 11694: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      11695: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 11696: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 11697:     
                   11698: # Initialize roles
                   11699: 
                   11700: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   11701:     }
                   11702: # ------------------------------------ Check browser type and MathML capability
                   11703: 
                   11704:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   11705:         $clientunicode,$clientos) = &decode_user_agent($r);
                   11706: 
                   11707: # ------------------------------------------------------------- Get environment
                   11708: 
                   11709:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   11710:     my ($tmp) = keys(%userenv);
                   11711:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   11712:     } else {
                   11713: 	undef(%userenv);
                   11714:     }
                   11715:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   11716: 	$form->{'interface'}=$userenv{'interface'};
                   11717:     }
                   11718:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   11719: 
                   11720: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   11721:     foreach my $option ('interface','localpath','localres') {
                   11722:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 11723:     }
                   11724: # --------------------------------------------------------- Write first profile
                   11725: 
                   11726:     {
                   11727: 	my %initial_env = 
                   11728: 	    ("user.name"          => $username,
                   11729: 	     "user.domain"        => $domain,
                   11730: 	     "user.home"          => $authhost,
                   11731: 	     "browser.type"       => $clientbrowser,
                   11732: 	     "browser.version"    => $clientversion,
                   11733: 	     "browser.mathml"     => $clientmathml,
                   11734: 	     "browser.unicode"    => $clientunicode,
                   11735: 	     "browser.os"         => $clientos,
                   11736: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   11737: 	     "request.course.fn"  => '',
                   11738: 	     "request.course.uri" => '',
                   11739: 	     "request.course.sec" => '',
                   11740: 	     "request.role"       => 'cm',
                   11741: 	     "request.role.adv"   => $env{'user.adv'},
                   11742: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   11743: 
                   11744:         if ($form->{'localpath'}) {
                   11745: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   11746: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   11747:         }
                   11748: 	
                   11749: 	if ($form->{'interface'}) {
                   11750: 	    $form->{'interface'}=~s/\W//gs;
                   11751: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   11752: 	    $env{'browser.interface'}=$form->{'interface'};
                   11753: 	}
                   11754: 
1.981     raeburn  11755:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  11756:         my %domdef;
                   11757:         unless ($domain eq 'public') {
                   11758:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   11759:         }
1.980     raeburn  11760: 
1.724     raeburn  11761:         foreach my $tool ('aboutme','blog','portfolio') {
                   11762:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  11763:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   11764:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  11765:         }
                   11766: 
1.864     raeburn  11767:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  11768:             $userenv{'canrequest.'.$crstype} =
                   11769:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  11770:                                                   'reload','requestcourses',
                   11771:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  11772:         }
                   11773: 
1.462     albertel 11774: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   11775: 	
                   11776: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   11777: 		 &GDBM_WRCREAT(),0640)) {
                   11778: 	    &_add_to_env(\%disk_env,\%initial_env);
                   11779: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   11780: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 11781: 	    if (ref($args->{'extra_env'})) {
                   11782: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   11783: 	    }
1.462     albertel 11784: 	    untie(%disk_env);
                   11785: 	} else {
1.705     tempelho 11786: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   11787: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 11788: 	    return 'error: '.$!;
                   11789: 	}
                   11790:     }
                   11791:     $env{'request.role'}='cm';
                   11792:     $env{'request.role.adv'}=$env{'user.adv'};
                   11793:     $env{'browser.type'}=$clientbrowser;
                   11794: 
                   11795:     return $cookie;
                   11796: 
                   11797: }
                   11798: 
                   11799: sub _add_to_env {
                   11800:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  11801:     if (ref($env_data) eq 'HASH') {
                   11802:         while (my ($key,$value) = each(%$env_data)) {
                   11803: 	    $idf->{$prefix.$key} = $value;
                   11804: 	    $env{$prefix.$key}   = $value;
                   11805:         }
1.462     albertel 11806:     }
                   11807: }
                   11808: 
1.685     tempelho 11809: # --- Get the symbolic name of a problem and the url
                   11810: sub get_symb {
                   11811:     my ($request,$silent) = @_;
1.726     raeburn  11812:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 11813:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   11814:     if ($symb eq '') {
                   11815:         if (!$silent) {
                   11816:             $request->print("Unable to handle ambiguous references:$url:.");
                   11817:             return ();
                   11818:         }
                   11819:     }
                   11820:     &Apache::lonenc::check_decrypt(\$symb);
                   11821:     return ($symb);
                   11822: }
                   11823: 
                   11824: # --------------------------------------------------------------Get annotation
                   11825: 
                   11826: sub get_annotation {
                   11827:     my ($symb,$enc) = @_;
                   11828: 
                   11829:     my $key = $symb;
                   11830:     if (!$enc) {
                   11831:         $key =
                   11832:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   11833:     }
                   11834:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   11835:     return $annotation{$key};
                   11836: }
                   11837: 
                   11838: sub clean_symb {
1.731     raeburn  11839:     my ($symb,$delete_enc) = @_;
1.685     tempelho 11840: 
                   11841:     &Apache::lonenc::check_decrypt(\$symb);
                   11842:     my $enc = $env{'request.enc'};
1.731     raeburn  11843:     if ($delete_enc) {
1.730     raeburn  11844:         delete($env{'request.enc'});
                   11845:     }
1.685     tempelho 11846: 
                   11847:     return ($symb,$enc);
                   11848: }
1.462     albertel 11849: 
1.990     raeburn  11850: sub build_release_hashes {
                   11851:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   11852:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   11853:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   11854:                   (ref($randomizetry) eq 'HASH'));
                   11855:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   11856:         my ($item,$name,$value) = split(/:/,$key);
                   11857:         if ($item eq 'parameter') {
                   11858:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   11859:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   11860:                     push(@{$checkparms->{$name}},$value);
                   11861:                 }
                   11862:             } else {
                   11863:                 push(@{$checkparms->{$name}},$value);
                   11864:             }
                   11865:         } elsif ($item eq 'resourcetag') {
                   11866:             if ($name eq 'responsetype') {
                   11867:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   11868:             }
                   11869:         } elsif ($item eq 'course') {
                   11870:             if ($name eq 'crstype') {
                   11871:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   11872:             }
                   11873:         }
                   11874:     }
                   11875:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   11876:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   11877:     return;
                   11878: }
                   11879: 
1.41      ng       11880: =pod
                   11881: 
                   11882: =back
                   11883: 
1.112     bowersj2 11884: =cut
1.41      ng       11885: 
1.112     bowersj2 11886: 1;
                   11887: __END__;
1.41      ng       11888: 

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