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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1041  ! www         4: # $Id: loncommon.pm,v 1.1040 2011/12/20 22:43:34 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.479     albertel   70: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    71: use DateTime::TimeZone;
1.687     raeburn    72: use DateTime::Locale::Catalog;
1.117     www        73: 
1.517     raeburn    74: # ---------------------------------------------- Designs
                     75: use vars qw(%defaultdesign);
                     76: 
1.22      www        77: my $readit;
                     78: 
1.517     raeburn    79: 
1.157     matthew    80: ##
                     81: ## Global Variables
                     82: ##
1.46      matthew    83: 
1.643     foxr       84: 
                     85: # ----------------------------------------------- SSI with retries:
                     86: #
                     87: 
                     88: =pod
                     89: 
1.648     raeburn    90: =head1 Server Side include with retries:
1.643     foxr       91: 
                     92: =over 4
                     93: 
1.648     raeburn    94: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       95: 
                     96: Performs an ssi with some number of retries.  Retries continue either
                     97: until the result is ok or until the retry count supplied by the
                     98: caller is exhausted.  
                     99: 
                    100: Inputs:
1.648     raeburn   101: 
                    102: =over 4
                    103: 
1.643     foxr      104: resource   - Identifies the resource to insert.
1.648     raeburn   105: 
1.643     foxr      106: retries    - Count of the number of retries allowed.
1.648     raeburn   107: 
1.643     foxr      108: form       - Hash that identifies the rendering options.
                    109: 
1.648     raeburn   110: =back
                    111: 
                    112: Returns:
                    113: 
                    114: =over 4
                    115: 
1.643     foxr      116: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   117: 
1.643     foxr      118: response   - The response from the last attempt (which may or may not have been successful.
                    119: 
1.648     raeburn   120: =back
                    121: 
                    122: =back
                    123: 
1.643     foxr      124: =cut
                    125: 
                    126: sub ssi_with_retries {
                    127:     my ($resource, $retries, %form) = @_;
                    128: 
                    129: 
                    130:     my $ok = 0;			# True if we got a good response.
                    131:     my $content;
                    132:     my $response;
                    133: 
                    134:     # Try to get the ssi done. within the retries count:
                    135: 
                    136:     do {
                    137: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    138: 	$ok      = $response->is_success;
1.650     www       139:         if (!$ok) {
                    140:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    141:         }
1.643     foxr      142: 	$retries--;
                    143:     } while (!$ok && ($retries > 0));
                    144: 
                    145:     if (!$ok) {
                    146: 	$content = '';		# On error return an empty content.
                    147:     }
                    148:     return ($content, $response);
                    149: 
                    150: }
                    151: 
                    152: 
                    153: 
1.20      www       154: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  155: my %language;
1.124     www       156: my %supported_language;
1.12      harris41  157: my %cprtag;
1.192     taceyjo1  158: my %scprtag;
1.351     www       159: my %fe; my %fd; my %fm;
1.41      ng        160: my %category_extensions;
1.12      harris41  161: 
1.46      matthew   162: # ---------------------------------------------- Thesaurus variables
1.144     matthew   163: #
                    164: # %Keywords:
                    165: #      A hash used by &keyword to determine if a word is considered a keyword.
                    166: # $thesaurus_db_file 
                    167: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   168: 
                    169: my %Keywords;
                    170: my $thesaurus_db_file;
                    171: 
1.144     matthew   172: #
                    173: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    174: # thesaurus.tab, and filecategories.tab.
                    175: #
1.18      www       176: BEGIN {
1.46      matthew   177:     # Variable initialization
                    178:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    179:     #
1.22      www       180:     unless ($readit) {
1.12      harris41  181: # ------------------------------------------------------------------- languages
                    182:     {
1.158     raeburn   183:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    184:                                    '/language.tab';
                    185:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  186:             while (my $line = <$fh>) {
                    187:                 next if ($line=~/^\#/);
                    188:                 chomp($line);
                    189:                 my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158     raeburn   190:                 $language{$key}=$val.' - '.$enc;
                    191:                 if ($sup) {
                    192:                     $supported_language{$key}=$sup;
                    193:                 }
                    194:             }
                    195:             close($fh);
                    196:         }
1.12      harris41  197:     }
                    198: # ------------------------------------------------------------------ copyrights
                    199:     {
1.158     raeburn   200:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    201:                                   '/copyright.tab';
                    202:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  203:             while (my $line = <$fh>) {
                    204:                 next if ($line=~/^\#/);
                    205:                 chomp($line);
                    206:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   207:                 $cprtag{$key}=$val;
                    208:             }
                    209:             close($fh);
                    210:         }
1.12      harris41  211:     }
1.351     www       212: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  213:     {
                    214:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    215:                                   '/source_copyright.tab';
                    216:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  217:             while (my $line = <$fh>) {
                    218:                 next if ($line =~ /^\#/);
                    219:                 chomp($line);
                    220:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  221:                 $scprtag{$key}=$val;
                    222:             }
                    223:             close($fh);
                    224:         }
                    225:     }
1.63      www       226: 
1.517     raeburn   227: # -------------------------------------------------------------- default domain designs
1.63      www       228:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   229:     my $designfile = $designdir.'/default.tab';
                    230:     if ( open (my $fh,"<$designfile") ) {
                    231:         while (my $line = <$fh>) {
                    232:             next if ($line =~ /^\#/);
                    233:             chomp($line);
                    234:             my ($key,$val)=(split(/\=/,$line));
                    235:             if ($val) { $defaultdesign{$key}=$val; }
                    236:         }
                    237:         close($fh);
1.63      www       238:     }
                    239: 
1.15      harris41  240: # ------------------------------------------------------------- file categories
                    241:     {
1.158     raeburn   242:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    243:                                   '/filecategories.tab';
                    244:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  245: 	    while (my $line = <$fh>) {
                    246: 		next if ($line =~ /^\#/);
                    247: 		chomp($line);
                    248:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   249:                 push @{$category_extensions{lc($category)}},$extension;
                    250:             }
                    251:             close($fh);
                    252:         }
                    253: 
1.15      harris41  254:     }
1.12      harris41  255: # ------------------------------------------------------------------ file types
                    256:     {
1.158     raeburn   257:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    258:                '/filetypes.tab';
                    259:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  260:             while (my $line = <$fh>) {
                    261: 		next if ($line =~ /^\#/);
                    262: 		chomp($line);
                    263:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   264:                 if ($descr ne '') {
                    265:                     $fe{$ending}=lc($emb);
                    266:                     $fd{$ending}=$descr;
1.351     www       267:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   268:                 }
                    269:             }
                    270:             close($fh);
                    271:         }
1.12      harris41  272:     }
1.22      www       273:     &Apache::lonnet::logthis(
1.705     tempelho  274:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       275:     $readit=1;
1.46      matthew   276:     }  # end of unless($readit) 
1.32      matthew   277:     
                    278: }
1.112     bowersj2  279: 
1.42      matthew   280: ###############################################################
                    281: ##           HTML and Javascript Helper Functions            ##
                    282: ###############################################################
                    283: 
                    284: =pod 
                    285: 
1.112     bowersj2  286: =head1 HTML and Javascript Functions
1.42      matthew   287: 
1.112     bowersj2  288: =over 4
                    289: 
1.648     raeburn   290: =item * &browser_and_searcher_javascript()
1.112     bowersj2  291: 
                    292: X<browsing, javascript>X<searching, javascript>Returns a string
                    293: containing javascript with two functions, C<openbrowser> and
                    294: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    295: tags.
1.42      matthew   296: 
1.648     raeburn   297: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   298: 
                    299: inputs: formname, elementname, only, omit
                    300: 
                    301: formname and elementname indicate the name of the html form and name of
                    302: the element that the results of the browsing selection are to be placed in. 
                    303: 
                    304: Specifying 'only' will restrict the browser to displaying only files
1.185     www       305: with the given extension.  Can be a comma separated list.
1.42      matthew   306: 
                    307: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       308: with the given extension.  Can be a comma separated list.
1.42      matthew   309: 
1.648     raeburn   310: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   311: 
                    312: Inputs: formname, elementname
                    313: 
                    314: formname and elementname specify the name of the html form and the name
                    315: of the element the selection from the search results will be placed in.
1.542     raeburn   316: 
1.42      matthew   317: =cut
                    318: 
                    319: sub browser_and_searcher_javascript {
1.199     albertel  320:     my ($mode)=@_;
                    321:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  322:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   323:     return <<END;
1.219     albertel  324: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   325:     var editbrowser = null;
1.135     albertel  326:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       327:         var url = '$resurl/?';
1.42      matthew   328:         if (editbrowser == null) {
                    329:             url += 'launch=1&';
                    330:         }
                    331:         url += 'catalogmode=interactive&';
1.199     albertel  332:         url += 'mode=$mode&';
1.611     albertel  333:         url += 'inhibitmenu=yes&';
1.42      matthew   334:         url += 'form=' + formname + '&';
                    335:         if (only != null) {
                    336:             url += 'only=' + only + '&';
1.217     albertel  337:         } else {
                    338:             url += 'only=&';
                    339: 	}
1.42      matthew   340:         if (omit != null) {
                    341:             url += 'omit=' + omit + '&';
1.217     albertel  342:         } else {
                    343:             url += 'omit=&';
                    344: 	}
1.135     albertel  345:         if (titleelement != null) {
                    346:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  347:         } else {
                    348: 	    url += 'titleelement=&';
                    349: 	}
1.42      matthew   350:         url += 'element=' + elementname + '';
                    351:         var title = 'Browser';
1.435     albertel  352:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   353:         options += ',width=700,height=600';
                    354:         editbrowser = open(url,title,options,'1');
                    355:         editbrowser.focus();
                    356:     }
                    357:     var editsearcher;
1.135     albertel  358:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   359:         var url = '/adm/searchcat?';
                    360:         if (editsearcher == null) {
                    361:             url += 'launch=1&';
                    362:         }
                    363:         url += 'catalogmode=interactive&';
1.199     albertel  364:         url += 'mode=$mode&';
1.42      matthew   365:         url += 'form=' + formname + '&';
1.135     albertel  366:         if (titleelement != null) {
                    367:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  368:         } else {
                    369: 	    url += 'titleelement=&';
                    370: 	}
1.42      matthew   371:         url += 'element=' + elementname + '';
                    372:         var title = 'Search';
1.435     albertel  373:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   374:         options += ',width=700,height=600';
                    375:         editsearcher = open(url,title,options,'1');
                    376:         editsearcher.focus();
                    377:     }
1.219     albertel  378: // END LON-CAPA Internal -->
1.42      matthew   379: END
1.170     www       380: }
                    381: 
                    382: sub lastresurl {
1.258     albertel  383:     if ($env{'environment.lastresurl'}) {
                    384: 	return $env{'environment.lastresurl'}
1.170     www       385:     } else {
                    386: 	return '/res';
                    387:     }
                    388: }
                    389: 
                    390: sub storeresurl {
                    391:     my $resurl=&Apache::lonnet::clutter(shift);
                    392:     unless ($resurl=~/^\/res/) { return 0; }
                    393:     $resurl=~s/\/$//;
                    394:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   395:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       396:     return 1;
1.42      matthew   397: }
                    398: 
1.74      www       399: sub studentbrowser_javascript {
1.111     www       400:    unless (
1.258     albertel  401:             (($env{'request.course.id'}) && 
1.302     albertel  402:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    403: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    404: 					  '/'.$env{'request.course.sec'})
                    405: 	      ))
1.258     albertel  406:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       407:           ) { return ''; }  
1.74      www       408:    return (<<'ENDSTDBRW');
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();
1.1041  ! www      6742:         $result.=&LCprogressbarUpdate_script();
1.1034    www      6743:     } else {
                   6744:         if ($args->{'add_modal'}) {
                   6745:            $result.=&modal_window();
                   6746:         }
                   6747:         if ($args->{'add_wishlist'}) {
                   6748:            $result.=&wishlist_window();
                   6749:         }
1.1038    www      6750:         if ($args->{'add_togglebox'}) {
                   6751:            $result.=&togglebox_script();
                   6752:         }
1.1041  ! www      6753:         if ($args->{'add_progressbar'}) {
        !          6754:            $result.=&LCprogressbarUpdate_script();
        !          6755:         }
1.436     albertel 6756:     }
1.314     albertel 6757:     if (ref($args->{'redirect'})) {
1.414     albertel 6758: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6759: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6760: 	if (!$inhibit_continue) {
                   6761: 	    $env{'internal.head.redirect'} = $url;
                   6762: 	}
1.313     albertel 6763: 	$result.=<<ADDMETA
                   6764: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6765: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6766: ADDMETA
                   6767:     }
1.306     albertel 6768:     if (!defined($title)) {
                   6769: 	$title = 'The LearningOnline Network with CAPA';
                   6770:     }
1.460     albertel 6771:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6772:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6773: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   6774: 	.$head_extra;
1.962     droeschl 6775:     return $result.'</head>';
1.306     albertel 6776: }
                   6777: 
                   6778: =pod
                   6779: 
1.340     albertel 6780: =item * &font_settings()
                   6781: 
                   6782: Returns neccessary <meta> to set the proper encoding
                   6783: 
                   6784: Inputs: none
                   6785: 
                   6786: =cut
                   6787: 
                   6788: sub font_settings {
                   6789:     my $headerstring='';
1.647     www      6790:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6791: 	$headerstring.=
                   6792: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6793:     }
                   6794:     return $headerstring;
                   6795: }
                   6796: 
1.341     albertel 6797: =pod
                   6798: 
                   6799: =item * &xml_begin()
                   6800: 
                   6801: Returns the needed doctype and <html>
                   6802: 
                   6803: Inputs: none
                   6804: 
                   6805: =cut
                   6806: 
                   6807: sub xml_begin {
                   6808:     my $output='';
                   6809: 
                   6810:     if ($env{'browser.mathml'}) {
                   6811: 	$output='<?xml version="1.0"?>'
                   6812:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   6813: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   6814:             
                   6815: #	    .'<!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">] >'
                   6816: 	    .'<!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">'
                   6817:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   6818: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   6819:     } else {
1.849     bisitz   6820: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   6821:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 6822:     }
                   6823:     return $output;
                   6824: }
1.340     albertel 6825: 
                   6826: =pod
                   6827: 
1.306     albertel 6828: =item * &start_page()
                   6829: 
                   6830: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6831: 
1.648     raeburn  6832: Inputs:
                   6833: 
                   6834: =over 4
                   6835: 
                   6836: $title - optional title for the page
                   6837: 
                   6838: $head_extra - optional extra HTML to incude inside the <head>
                   6839: 
                   6840: $args - additional optional args supported are:
                   6841: 
                   6842: =over 8
                   6843: 
                   6844:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6845:                                     arg on
1.814     bisitz   6846:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  6847:              add_entries    -> additional attributes to add to the  <body>
                   6848:              domain         -> force to color decorate a page for a 
1.317     albertel 6849:                                     specific domain
1.648     raeburn  6850:              function       -> force usage of a specific rolish color
1.317     albertel 6851:                                     scheme
1.648     raeburn  6852:              redirect       -> see &headtag()
                   6853:              bgcolor        -> override the default page bg color
                   6854:              js_ready       -> return a string ready for being used in 
1.317     albertel 6855:                                     a javascript writeln
1.648     raeburn  6856:              html_encode    -> return a string ready for being used in 
1.320     albertel 6857:                                     a html attribute
1.648     raeburn  6858:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6859:                                     $forcereg arg
1.648     raeburn  6860:              frameset       -> if true will start with a <frameset>
1.330     albertel 6861:                                     rather than <body>
1.648     raeburn  6862:              skip_phases    -> hash ref of 
1.338     albertel 6863:                                     head -> skip the <html><head> generation
                   6864:                                     body -> skip all <body> generation
1.648     raeburn  6865:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6866:              inherit_jsmath -> when creating popup window in a page,
                   6867:                                     should it have jsmath forced on by the
                   6868:                                     current page
1.867     kalberla 6869:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  6870:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 6871: 
1.648     raeburn  6872: =back
1.460     albertel 6873: 
1.648     raeburn  6874: =back
1.562     albertel 6875: 
1.306     albertel 6876: =cut
                   6877: 
                   6878: sub start_page {
1.309     albertel 6879:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6880:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 6881: 
1.315     albertel 6882:     $env{'internal.start_page'}++;
1.338     albertel 6883:     my $result;
1.964     droeschl 6884: 
1.338     albertel 6885:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      6886:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 6887:     }
                   6888:     
                   6889:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6890: 	if ($args->{'frameset'}) {
                   6891: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6892: 						$args->{'add_entries'});
                   6893: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   6894:         } else {
                   6895:             $result .=
                   6896:                 &bodytag($title, 
                   6897:                          $args->{'function'},       $args->{'add_entries'},
                   6898:                          $args->{'only_body'},      $args->{'domain'},
                   6899:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 6900:                          $args->{'bgcolor'},        $args);
1.831     bisitz   6901:         }
1.330     albertel 6902:     }
1.338     albertel 6903: 
1.315     albertel 6904:     if ($args->{'js_ready'}) {
1.713     kaisler  6905: 		$result = &js_ready($result);
1.315     albertel 6906:     }
1.320     albertel 6907:     if ($args->{'html_encode'}) {
1.713     kaisler  6908: 		$result = &html_encode($result);
                   6909:     }
                   6910: 
1.813     bisitz   6911:     # Preparation for new and consistent functionlist at top of screen
                   6912:     # if ($args->{'functionlist'}) {
                   6913:     #            $result .= &build_functionlist();
                   6914:     #}
                   6915: 
1.964     droeschl 6916:     # Don't add anything more if only_body wanted or in const space
                   6917:     return $result if    $args->{'only_body'} 
                   6918:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   6919: 
                   6920:     #Breadcrumbs
1.758     kaisler  6921:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   6922: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   6923: 		#if any br links exists, add them to the breadcrumbs
                   6924: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6925: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6926: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6927: 			}
                   6928: 		}
                   6929: 
                   6930: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   6931: 		if(exists($args->{'bread_crumbs_component'})){
                   6932: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   6933: 		}else{
                   6934: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   6935: 		}
1.320     albertel 6936:     }
1.315     albertel 6937:     return $result;
1.306     albertel 6938: }
                   6939: 
                   6940: sub end_page {
1.315     albertel 6941:     my ($args) = @_;
                   6942:     $env{'internal.end_page'}++;
1.330     albertel 6943:     my $result;
1.335     albertel 6944:     if ($args->{'discussion'}) {
                   6945: 	my ($target,$parser);
                   6946: 	if (ref($args->{'discussion'})) {
                   6947: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6948: 				$args->{'discussion'}{'parser'});
                   6949: 	}
                   6950: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6951:     }
1.330     albertel 6952:     if ($args->{'frameset'}) {
                   6953: 	$result .= '</frameset>';
                   6954:     } else {
1.635     raeburn  6955: 	$result .= &endbodytag($args);
1.330     albertel 6956:     }
                   6957:     $result .= "\n</html>";
                   6958: 
1.315     albertel 6959:     if ($args->{'js_ready'}) {
1.317     albertel 6960: 	$result = &js_ready($result);
1.315     albertel 6961:     }
1.335     albertel 6962: 
1.320     albertel 6963:     if ($args->{'html_encode'}) {
                   6964: 	$result = &html_encode($result);
                   6965:     }
1.335     albertel 6966: 
1.315     albertel 6967:     return $result;
                   6968: }
                   6969: 
1.1034    www      6970: sub wishlist_window {
                   6971:     return(<<'ENDWISHLIST');
                   6972: <script type="text/javascript" lang="javascript">
                   6973: // <![CDATA[
                   6974: // <!-- BEGIN LON-CAPA Internal
                   6975: function set_wishlistlink(title, path) {
                   6976:     if (!title) {
                   6977:         title = document.title;
                   6978:         title = title.replace(/^LON-CAPA /,'');
                   6979:     }
                   6980:     if (!path) {
                   6981:         path = location.pathname;
                   6982:     }
                   6983:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   6984:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   6985: }
                   6986: // END LON-CAPA Internal -->
                   6987: // ]]>
                   6988: </script>
                   6989: ENDWISHLIST
                   6990: }
                   6991: 
1.1030    www      6992: sub modal_window {
                   6993:     return(<<'ENDMODAL');
                   6994: <script type="text/javascript" lang="javascript">
                   6995: // <![CDATA[
                   6996: // <!-- BEGIN LON-CAPA Internal
                   6997: var modalWindow = {
                   6998: 	parent:"body",
                   6999: 	windowId:null,
                   7000: 	content:null,
                   7001: 	width:null,
                   7002: 	height:null,
                   7003: 	close:function()
                   7004: 	{
                   7005: 	        $(".LCmodal-window").remove();
                   7006: 	        $(".LCmodal-overlay").remove();
                   7007: 	},
                   7008: 	open:function()
                   7009: 	{
                   7010: 		var modal = "";
                   7011: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7012: 		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;\">";
                   7013: 		modal += this.content;
                   7014: 		modal += "</div>";	
                   7015: 
                   7016: 		$(this.parent).append(modal);
                   7017: 
                   7018: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7019: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7020: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7021: 	}
                   7022: };
1.1031    www      7023: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7024: 	{
                   7025: 		modalWindow.windowId = "myModal";
                   7026: 		modalWindow.width = width;
                   7027: 		modalWindow.height = height;
1.1031    www      7028: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7029: 		modalWindow.open();
                   7030: 	};	
                   7031: // END LON-CAPA Internal -->
                   7032: // ]]>
                   7033: </script>
                   7034: ENDMODAL
                   7035: }
                   7036: 
                   7037: sub modal_link {
1.1031    www      7038:     my ($link,$linktext,$width,$height,$target,$scrolling)=@_;
1.1030    www      7039:     unless ($width) { $width=480; }
                   7040:     unless ($height) { $height=400; }
1.1031    www      7041:     unless ($scrolling) { $scrolling='yes'; }
                   7042:     return '<a href="'.$link.'" target="'.$target.'" onclick="openMyModal(\''.$link.'\','.$width.','.$height.',\''.$scrolling.'\'); return false;">'.
                   7043:            $linktext.'</a>';
1.1030    www      7044: }
                   7045: 
1.1032    www      7046: sub modal_adhoc_script {
                   7047:     my ($funcname,$width,$height,$content)=@_;
                   7048:     return (<<ENDADHOC);
                   7049: <script type="text/javascript" lang="javascript">
                   7050: // <![CDATA[
                   7051:         var $funcname = function()
                   7052:         {
                   7053:                 modalWindow.windowId = "myModal";
                   7054:                 modalWindow.width = $width;
                   7055:                 modalWindow.height = $height;
                   7056:                 modalWindow.content = '$content';
                   7057:                 modalWindow.open();
                   7058:         };  
                   7059: // ]]>
                   7060: </script>
                   7061: ENDADHOC
                   7062: }
                   7063: 
1.1041  ! www      7064: sub modal_adhoc_inner {
        !          7065:     my ($funcname,$width,$height,$content)=@_;
        !          7066:     my $innerwidth=$width-20;
        !          7067:     $content=&js_ready(
        !          7068:                &start_page('Dialog',undef,{'only_body'=>1,'add_progressbar'=>1,'bgcolor'=>'#FFFFFF'}).
        !          7069:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
        !          7070:                     $content.
        !          7071:                  &end_scrollbox().
        !          7072:                &end_page()
        !          7073:              );
        !          7074:     return &modal_adhoc_script($funcname,$width,$height,$content);
        !          7075: }
        !          7076: 
        !          7077: sub modal_adhoc_window {
        !          7078:     my ($funcname,$width,$height,$content,$linktext)=@_;
        !          7079:     return &modal_adhoc_inner($funcname,$width,$height,$content).
        !          7080:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
        !          7081: }
        !          7082: 
        !          7083: sub modal_adhoc_launch {
        !          7084:     my ($funcname,$width,$height,$content)=@_;
        !          7085:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
        !          7086: <script type="text/javascript">
        !          7087: // <![CDATA[
        !          7088: $funcname();
        !          7089: // ]]>
        !          7090: </script>
        !          7091: ENDLAUNCH
        !          7092: }
        !          7093: 
        !          7094: sub modal_adhoc_close {
        !          7095:     return (<<ENDCLOSE);
        !          7096: <script type="text/javascript">
        !          7097: // <![CDATA[
        !          7098: modalWindow.close();
        !          7099: // ]]>
        !          7100: </script>
        !          7101: ENDCLOSE
        !          7102: }
        !          7103: 
1.1038    www      7104: sub togglebox_script {
                   7105:    return(<<ENDTOGGLE);
                   7106: <script type="text/javascript"> 
                   7107: // <![CDATA[
                   7108: function LCtoggleDisplay(id,hidetext,showtext) {
                   7109:    link = document.getElementById(id + "link").childNodes[0];
                   7110:    with (document.getElementById(id).style) {
                   7111:       if (display == "none" ) {
                   7112:           display = "inline";
                   7113:           link.nodeValue = hidetext;
                   7114:         } else {
                   7115:           display = "none";
                   7116:           link.nodeValue = showtext;
                   7117:        }
                   7118:    }
                   7119: }
                   7120: // ]]>
                   7121: </script>
                   7122: ENDTOGGLE
                   7123: }
                   7124: 
1.1039    www      7125: sub start_togglebox {
                   7126:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7127:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7128:     unless ($showtext) { $showtext=&mt('show'); }
                   7129:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7130:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7131:     return &start_data_table().
                   7132:            &start_data_table_header_row().
                   7133:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7134:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7135:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7136:            &end_data_table_header_row().
                   7137:            '<tr id="'.$id.'" style="display:none""><td>';
                   7138: }
                   7139: 
                   7140: sub end_togglebox {
                   7141:     return '</td></tr>'.&end_data_table();
                   7142: }
                   7143: 
1.1041  ! www      7144: sub LCprogressbar_script {
        !          7145:    return(<<ENDPROGRESS);
        !          7146: <script type="text/javascript">
        !          7147: // <![CDATA[
        !          7148: var LCprogressTxt='---';
        !          7149: 
        !          7150: \$('#progressbar').progressbar({
        !          7151:   value: 0,
        !          7152:   change: function(event, ui) {
        !          7153:     var newVal = \$(this).progressbar('option', 'value');
        !          7154:     \$('.pblabel', this).text(LCprogressTxt);
        !          7155:   }
        !          7156: });
        !          7157: // ]]>
        !          7158: </script>
        !          7159: ENDPROGRESS
        !          7160: }
        !          7161: 
        !          7162: sub LCprogressbarUpdate_script {
        !          7163:    return(<<ENDPROGRESSUPDATE);
        !          7164: <style type="text/css">
        !          7165: .ui-progressbar { position:relative; }
        !          7166: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
        !          7167: </style>
        !          7168: <script type="text/javascript">
        !          7169: // <![CDATA[
        !          7170: function LCupdateProgress(percent,progresstext) {
        !          7171:    LCprogressTxt=progresstext;
        !          7172:    \$('#progressbar').progressbar('value',percent);
        !          7173: }
        !          7174: // ]]>
        !          7175: </script>
        !          7176: ENDPROGRESSUPDATE
        !          7177: }
        !          7178: 
        !          7179: sub LCprogressbar {
        !          7180:     my ($r,$mode)=(@_);
        !          7181:     my $starting=&mt('Starting');
        !          7182:     my $content=(<<ENDPROGBAR);
        !          7183: <p>
        !          7184:   <div id="progressbar">
        !          7185:     <span class="pblabel">$starting</span>
        !          7186:   </div>
        !          7187: </p>
        !          7188: ENDPROGBAR
        !          7189:     $content.=&LCprogressbar_script();
        !          7190:     if ($mode eq 'popup') {
        !          7191:        $r->print(&modal_adhoc_launch('LCprogwin',500,50,$content));
        !          7192:     } else {
        !          7193:        $r->print($content);
        !          7194:     }
        !          7195:     $r->rflush();
        !          7196: }
        !          7197: 
        !          7198: sub LCprogressbarUpdate {
        !          7199:     my ($r,$val,$text,$mode)=@_;
        !          7200:     unless ($val) { $val=0; }
        !          7201:     if ($val<0) { $val=0; }
        !          7202:     if ($val>100) { $val=0; }
        !          7203:     unless ($text) { $text=$val.'%'; }
        !          7204:     my $function='';
        !          7205:     if ($mode eq 'popup') { $function='modalWindow.'; }
        !          7206:     $function.='LCupdateProgress';
        !          7207:     $text=&js_ready($text);
        !          7208:     $r->print(<<ENDUPDATE);
        !          7209: <script type="text/javascript">
        !          7210: // <![CDATA[
        !          7211: $function($val,'$text');
        !          7212: // ]]>
        !          7213: </script>
        !          7214: ENDUPDATE
        !          7215:     $r->rflush();
1.1035    www      7216: }
                   7217: 
1.320     albertel 7218: sub html_encode {
                   7219:     my ($result) = @_;
                   7220: 
1.322     albertel 7221:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7222:     
                   7223:     return $result;
                   7224: }
1.317     albertel 7225: sub js_ready {
                   7226:     my ($result) = @_;
                   7227: 
1.323     albertel 7228:     $result =~ s/[\n\r]/ /xmsg;
                   7229:     $result =~ s/\\/\\\\/xmsg;
                   7230:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7231:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7232:     
                   7233:     return $result;
                   7234: }
                   7235: 
1.315     albertel 7236: sub validate_page {
                   7237:     if (  exists($env{'internal.start_page'})
1.316     albertel 7238: 	  &&     $env{'internal.start_page'} > 1) {
                   7239: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7240: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7241: 				 $ENV{'request.filename'});
1.315     albertel 7242:     }
                   7243:     if (  exists($env{'internal.end_page'})
1.316     albertel 7244: 	  &&     $env{'internal.end_page'} > 1) {
                   7245: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7246: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7247: 				 $env{'request.filename'});
1.315     albertel 7248:     }
                   7249:     if (     exists($env{'internal.start_page'})
                   7250: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7251: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7252: 				 $env{'request.filename'});
1.315     albertel 7253:     }
                   7254:     if (   ! exists($env{'internal.start_page'})
                   7255: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7256: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7257: 				 $env{'request.filename'});
1.315     albertel 7258:     }
1.306     albertel 7259: }
1.315     albertel 7260: 
1.996     www      7261: 
                   7262: sub start_scrollbox {
1.1018    raeburn  7263:     my ($outerwidth,$width,$height,$id)=@_;
1.998     raeburn  7264:     unless ($outerwidth) { $outerwidth='520px'; }
                   7265:     unless ($width) { $width='500px'; }
                   7266:     unless ($height) { $height='200px'; }
1.1020    raeburn  7267:     my ($table_id,$div_id);
1.1018    raeburn  7268:     if ($id ne '') {
1.1020    raeburn  7269:         $table_id = " id='table_$id'";
                   7270:         $div_id = " id='div_$id'";
1.1018    raeburn  7271:     }
1.1020    raeburn  7272:     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      7273: }
                   7274: 
                   7275: sub end_scrollbox {
1.1036    www      7276:     return '</div></td></tr></table>';
1.996     www      7277: }
                   7278: 
1.318     albertel 7279: sub simple_error_page {
                   7280:     my ($r,$title,$msg) = @_;
                   7281:     my $page =
                   7282: 	&Apache::loncommon::start_page($title).
                   7283: 	&mt($msg).
                   7284: 	&Apache::loncommon::end_page();
                   7285:     if (ref($r)) {
                   7286: 	$r->print($page);
1.327     albertel 7287: 	return;
1.318     albertel 7288:     }
                   7289:     return $page;
                   7290: }
1.347     albertel 7291: 
                   7292: {
1.610     albertel 7293:     my @row_count;
1.961     onken    7294: 
                   7295:     sub start_data_table_count {
                   7296:         unshift(@row_count, 0);
                   7297:         return;
                   7298:     }
                   7299: 
                   7300:     sub end_data_table_count {
                   7301:         shift(@row_count);
                   7302:         return;
                   7303:     }
                   7304: 
1.347     albertel 7305:     sub start_data_table {
1.1018    raeburn  7306: 	my ($add_class,$id) = @_;
1.422     albertel 7307: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7308:         my $table_id;
                   7309:         if (defined($id)) {
                   7310:             $table_id = ' id="'.$id.'"';
                   7311:         }
1.961     onken    7312: 	&start_data_table_count();
1.1018    raeburn  7313: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7314:     }
                   7315: 
                   7316:     sub end_data_table {
1.961     onken    7317: 	&end_data_table_count();
1.389     albertel 7318: 	return '</table>'."\n";;
1.347     albertel 7319:     }
                   7320: 
                   7321:     sub start_data_table_row {
1.974     wenzelju 7322: 	my ($add_class, $id) = @_;
1.610     albertel 7323: 	$row_count[0]++;
                   7324: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7325: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7326:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7327:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7328:     }
1.471     banghart 7329:     
                   7330:     sub continue_data_table_row {
1.974     wenzelju 7331: 	my ($add_class, $id) = @_;
1.610     albertel 7332: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7333: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7334:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7335:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7336:     }
1.347     albertel 7337: 
                   7338:     sub end_data_table_row {
1.389     albertel 7339: 	return '</tr>'."\n";;
1.347     albertel 7340:     }
1.367     www      7341: 
1.421     albertel 7342:     sub start_data_table_empty_row {
1.707     bisitz   7343: #	$row_count[0]++;
1.421     albertel 7344: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7345:     }
                   7346: 
                   7347:     sub end_data_table_empty_row {
                   7348: 	return '</tr>'."\n";;
                   7349:     }
                   7350: 
1.367     www      7351:     sub start_data_table_header_row {
1.389     albertel 7352: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7353:     }
                   7354: 
                   7355:     sub end_data_table_header_row {
1.389     albertel 7356: 	return '</tr>'."\n";;
1.367     www      7357:     }
1.890     droeschl 7358: 
                   7359:     sub data_table_caption {
                   7360:         my $caption = shift;
                   7361:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7362:     }
1.347     albertel 7363: }
                   7364: 
1.548     albertel 7365: =pod
                   7366: 
                   7367: =item * &inhibit_menu_check($arg)
                   7368: 
                   7369: Checks for a inhibitmenu state and generates output to preserve it
                   7370: 
                   7371: Inputs:         $arg - can be any of
                   7372:                      - undef - in which case the return value is a string 
                   7373:                                to add  into arguments list of a uri
                   7374:                      - 'input' - in which case the return value is a HTML
                   7375:                                  <form> <input> field of type hidden to
                   7376:                                  preserve the value
                   7377:                      - a url - in which case the return value is the url with
                   7378:                                the neccesary cgi args added to preserve the
                   7379:                                inhibitmenu state
                   7380:                      - a ref to a url - no return value, but the string is
                   7381:                                         updated to include the neccessary cgi
                   7382:                                         args to preserve the inhibitmenu state
                   7383: 
                   7384: =cut
                   7385: 
                   7386: sub inhibit_menu_check {
                   7387:     my ($arg) = @_;
                   7388:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7389:     if ($arg eq 'input') {
                   7390: 	if ($env{'form.inhibitmenu'}) {
                   7391: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7392: 	} else {
                   7393: 	    return
                   7394: 	}
                   7395:     }
                   7396:     if ($env{'form.inhibitmenu'}) {
                   7397: 	if (ref($arg)) {
                   7398: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7399: 	} elsif ($arg eq '') {
                   7400: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7401: 	} else {
                   7402: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7403: 	}
                   7404:     }
                   7405:     if (!ref($arg)) {
                   7406: 	return $arg;
                   7407:     }
                   7408: }
                   7409: 
1.251     albertel 7410: ###############################################
1.182     matthew  7411: 
                   7412: =pod
                   7413: 
1.549     albertel 7414: =back
                   7415: 
                   7416: =head1 User Information Routines
                   7417: 
                   7418: =over 4
                   7419: 
1.405     albertel 7420: =item * &get_users_function()
1.182     matthew  7421: 
                   7422: Used by &bodytag to determine the current users primary role.
                   7423: Returns either 'student','coordinator','admin', or 'author'.
                   7424: 
                   7425: =cut
                   7426: 
                   7427: ###############################################
                   7428: sub get_users_function {
1.815     tempelho 7429:     my $function = 'norole';
1.818     tempelho 7430:     if ($env{'request.role'}=~/^(st)/) {
                   7431:         $function='student';
                   7432:     }
1.907     raeburn  7433:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7434:         $function='coordinator';
                   7435:     }
1.258     albertel 7436:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7437:         $function='admin';
                   7438:     }
1.826     bisitz   7439:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  7440:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  7441:         $function='author';
                   7442:     }
                   7443:     return $function;
1.54      www      7444: }
1.99      www      7445: 
                   7446: ###############################################
                   7447: 
1.233     raeburn  7448: =pod
                   7449: 
1.821     raeburn  7450: =item * &show_course()
                   7451: 
                   7452: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7453: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7454: 
                   7455: Inputs:
                   7456: None
                   7457: 
                   7458: Outputs:
                   7459: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7460: 
                   7461: =cut
                   7462: 
                   7463: ###############################################
                   7464: sub show_course {
                   7465:     my $course = !$env{'user.adv'};
                   7466:     if (!$env{'user.adv'}) {
                   7467:         foreach my $env (keys(%env)) {
                   7468:             next if ($env !~ m/^user\.priv\./);
                   7469:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7470:                 $course = 0;
                   7471:                 last;
                   7472:             }
                   7473:         }
                   7474:     }
                   7475:     return $course;
                   7476: }
                   7477: 
                   7478: ###############################################
                   7479: 
                   7480: =pod
                   7481: 
1.542     raeburn  7482: =item * &check_user_status()
1.274     raeburn  7483: 
                   7484: Determines current status of supplied role for a
                   7485: specific user. Roles can be active, previous or future.
                   7486: 
                   7487: Inputs: 
                   7488: user's domain, user's username, course's domain,
1.375     raeburn  7489: course's number, optional section ID.
1.274     raeburn  7490: 
                   7491: Outputs:
                   7492: role status: active, previous or future. 
                   7493: 
                   7494: =cut
                   7495: 
                   7496: sub check_user_status {
1.412     raeburn  7497:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.982     raeburn  7498:     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   7499:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
1.274     raeburn  7500:     my @uroles = keys %userinfo;
                   7501:     my $srchstr;
                   7502:     my $active_chk = 'none';
1.412     raeburn  7503:     my $now = time;
1.274     raeburn  7504:     if (@uroles > 0) {
1.908     raeburn  7505:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7506:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7507:         } else {
1.412     raeburn  7508:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7509:         }
                   7510:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7511:             my $role_end = 0;
                   7512:             my $role_start = 0;
                   7513:             $active_chk = 'active';
1.412     raeburn  7514:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7515:                 $role_end = $1;
                   7516:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7517:                     $role_start = $1;
1.274     raeburn  7518:                 }
                   7519:             }
                   7520:             if ($role_start > 0) {
1.412     raeburn  7521:                 if ($now < $role_start) {
1.274     raeburn  7522:                     $active_chk = 'future';
                   7523:                 }
                   7524:             }
                   7525:             if ($role_end > 0) {
1.412     raeburn  7526:                 if ($now > $role_end) {
1.274     raeburn  7527:                     $active_chk = 'previous';
                   7528:                 }
                   7529:             }
                   7530:         }
                   7531:     }
                   7532:     return $active_chk;
                   7533: }
                   7534: 
                   7535: ###############################################
                   7536: 
                   7537: =pod
                   7538: 
1.405     albertel 7539: =item * &get_sections()
1.233     raeburn  7540: 
                   7541: Determines all the sections for a course including
                   7542: sections with students and sections containing other roles.
1.419     raeburn  7543: Incoming parameters: 
                   7544: 
                   7545: 1. domain
                   7546: 2. course number 
                   7547: 3. reference to array containing roles for which sections should 
                   7548: be gathered (optional).
                   7549: 4. reference to array containing status types for which sections 
                   7550: should be gathered (optional).
                   7551: 
                   7552: If the third argument is undefined, sections are gathered for any role. 
                   7553: If the fourth argument is undefined, sections are gathered for any status.
                   7554: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7555:  
1.374     raeburn  7556: Returns section hash (keys are section IDs, values are
                   7557: number of users in each section), subject to the
1.419     raeburn  7558: optional roles filter, optional status filter 
1.233     raeburn  7559: 
                   7560: =cut
                   7561: 
                   7562: ###############################################
                   7563: sub get_sections {
1.419     raeburn  7564:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7565:     if (!defined($cdom) || !defined($cnum)) {
                   7566:         my $cid =  $env{'request.course.id'};
                   7567: 
                   7568: 	return if (!defined($cid));
                   7569: 
                   7570:         $cdom = $env{'course.'.$cid.'.domain'};
                   7571:         $cnum = $env{'course.'.$cid.'.num'};
                   7572:     }
                   7573: 
                   7574:     my %sectioncount;
1.419     raeburn  7575:     my $now = time;
1.240     albertel 7576: 
1.366     albertel 7577:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7578: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7579: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7580: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7581:         my $start_index = &Apache::loncoursedata::CL_START();
                   7582:         my $end_index = &Apache::loncoursedata::CL_END();
                   7583:         my $status;
1.366     albertel 7584: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7585: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7586: 				                     $data->[$status_index],
                   7587:                                                      $data->[$start_index],
                   7588:                                                      $data->[$end_index]);
                   7589:             if ($stu_status eq 'Active') {
                   7590:                 $status = 'active';
                   7591:             } elsif ($end < $now) {
                   7592:                 $status = 'previous';
                   7593:             } elsif ($start > $now) {
                   7594:                 $status = 'future';
                   7595:             } 
                   7596: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7597:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7598:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7599: 		    $sectioncount{$section}++;
                   7600:                 }
1.240     albertel 7601: 	    }
                   7602: 	}
                   7603:     }
                   7604:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7605:     foreach my $user (sort(keys(%courseroles))) {
                   7606: 	if ($user !~ /^(\w{2})/) { next; }
                   7607: 	my ($role) = ($user =~ /^(\w{2})/);
                   7608: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7609: 	my ($section,$status);
1.240     albertel 7610: 	if ($role eq 'cr' &&
                   7611: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7612: 	    $section=$1;
                   7613: 	}
                   7614: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7615: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7616:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7617:         if ($end == -1 && $start == -1) {
                   7618:             next; #deleted role
                   7619:         }
                   7620:         if (!defined($possible_status)) { 
                   7621:             $sectioncount{$section}++;
                   7622:         } else {
                   7623:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7624:                 $status = 'active';
                   7625:             } elsif ($end < $now) {
                   7626:                 $status = 'future';
                   7627:             } elsif ($start > $now) {
                   7628:                 $status = 'previous';
                   7629:             }
                   7630:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7631:                 $sectioncount{$section}++;
                   7632:             }
                   7633:         }
1.233     raeburn  7634:     }
1.366     albertel 7635:     return %sectioncount;
1.233     raeburn  7636: }
                   7637: 
1.274     raeburn  7638: ###############################################
1.294     raeburn  7639: 
                   7640: =pod
1.405     albertel 7641: 
                   7642: =item * &get_course_users()
                   7643: 
1.275     raeburn  7644: Retrieves usernames:domains for users in the specified course
                   7645: with specific role(s), and access status. 
                   7646: 
                   7647: Incoming parameters:
1.277     albertel 7648: 1. course domain
                   7649: 2. course number
                   7650: 3. access status: users must have - either active, 
1.275     raeburn  7651: previous, future, or all.
1.277     albertel 7652: 4. reference to array of permissible roles
1.288     raeburn  7653: 5. reference to array of section restrictions (optional)
                   7654: 6. reference to results object (hash of hashes).
                   7655: 7. reference to optional userdata hash
1.609     raeburn  7656: 8. reference to optional statushash
1.630     raeburn  7657: 9. flag if privileged users (except those set to unhide in
                   7658:    course settings) should be excluded    
1.609     raeburn  7659: Keys of top level results hash are roles.
1.275     raeburn  7660: Keys of inner hashes are username:domain, with 
                   7661: values set to access type.
1.288     raeburn  7662: Optional userdata hash returns an array with arguments in the 
                   7663: same order as loncoursedata::get_classlist() for student data.
                   7664: 
1.609     raeburn  7665: Optional statushash returns
                   7666: 
1.288     raeburn  7667: Entries for end, start, section and status are blank because
                   7668: of the possibility of multiple values for non-student roles.
                   7669: 
1.275     raeburn  7670: =cut
1.405     albertel 7671: 
1.275     raeburn  7672: ###############################################
1.405     albertel 7673: 
1.275     raeburn  7674: sub get_course_users {
1.630     raeburn  7675:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7676:     my %idx = ();
1.419     raeburn  7677:     my %seclists;
1.288     raeburn  7678: 
                   7679:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7680:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7681:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7682:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7683:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7684:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7685:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7686:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7687: 
1.290     albertel 7688:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7689:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7690:         my $now = time;
1.277     albertel 7691:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7692:             my $match = 0;
1.412     raeburn  7693:             my $secmatch = 0;
1.419     raeburn  7694:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7695:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7696:             if ($section eq '') {
                   7697:                 $section = 'none';
                   7698:             }
1.291     albertel 7699:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7700:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7701:                     $secmatch = 1;
                   7702:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 7703:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7704:                         $secmatch = 1;
                   7705:                     }
                   7706:                 } else {  
1.419     raeburn  7707: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  7708: 		        $secmatch = 1;
                   7709:                     }
1.290     albertel 7710: 		}
1.412     raeburn  7711:                 if (!$secmatch) {
                   7712:                     next;
                   7713:                 }
1.419     raeburn  7714:             }
1.275     raeburn  7715:             if (defined($$types{'active'})) {
1.288     raeburn  7716:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  7717:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  7718:                     $match = 1;
1.275     raeburn  7719:                 }
                   7720:             }
                   7721:             if (defined($$types{'previous'})) {
1.609     raeburn  7722:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  7723:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  7724:                     $match = 1;
1.275     raeburn  7725:                 }
                   7726:             }
                   7727:             if (defined($$types{'future'})) {
1.609     raeburn  7728:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  7729:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  7730:                     $match = 1;
1.275     raeburn  7731:                 }
                   7732:             }
1.609     raeburn  7733:             if ($match) {
                   7734:                 push(@{$seclists{$student}},$section);
                   7735:                 if (ref($userdata) eq 'HASH') {
                   7736:                     $$userdata{$student} = $$classlist{$student};
                   7737:                 }
                   7738:                 if (ref($statushash) eq 'HASH') {
                   7739:                     $statushash->{$student}{'st'}{$section} = $status;
                   7740:                 }
1.288     raeburn  7741:             }
1.275     raeburn  7742:         }
                   7743:     }
1.412     raeburn  7744:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  7745:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7746:         my $now = time;
1.609     raeburn  7747:         my %displaystatus = ( previous => 'Expired',
                   7748:                               active   => 'Active',
                   7749:                               future   => 'Future',
                   7750:                             );
1.630     raeburn  7751:         my %nothide;
                   7752:         if ($hidepriv) {
                   7753:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   7754:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   7755:                 if ($user !~ /:/) {
                   7756:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   7757:                 } else {
                   7758:                     $nothide{$user} = 1;
                   7759:                 }
                   7760:             }
                   7761:         }
1.439     raeburn  7762:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  7763:             my $match = 0;
1.412     raeburn  7764:             my $secmatch = 0;
1.439     raeburn  7765:             my $status;
1.412     raeburn  7766:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  7767:             $user =~ s/:$//;
1.439     raeburn  7768:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   7769:             if ($end == -1 || $start == -1) {
                   7770:                 next;
                   7771:             }
                   7772:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   7773:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  7774:                 my ($uname,$udom) = split(/:/,$user);
                   7775:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7776:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7777:                         $secmatch = 1;
                   7778:                     } elsif ($usec eq '') {
1.420     albertel 7779:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7780:                             $secmatch = 1;
                   7781:                         }
                   7782:                     } else {
                   7783:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   7784:                             $secmatch = 1;
                   7785:                         }
                   7786:                     }
                   7787:                     if (!$secmatch) {
                   7788:                         next;
                   7789:                     }
1.288     raeburn  7790:                 }
1.419     raeburn  7791:                 if ($usec eq '') {
                   7792:                     $usec = 'none';
                   7793:                 }
1.275     raeburn  7794:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  7795:                     if ($hidepriv) {
                   7796:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   7797:                             (!$nothide{$uname.':'.$udom})) {
                   7798:                             next;
                   7799:                         }
                   7800:                     }
1.503     raeburn  7801:                     if ($end > 0 && $end < $now) {
1.439     raeburn  7802:                         $status = 'previous';
                   7803:                     } elsif ($start > $now) {
                   7804:                         $status = 'future';
                   7805:                     } else {
                   7806:                         $status = 'active';
                   7807:                     }
1.277     albertel 7808:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  7809:                         if ($status eq $type) {
1.420     albertel 7810:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  7811:                                 push(@{$$users{$role}{$user}},$type);
                   7812:                             }
1.288     raeburn  7813:                             $match = 1;
                   7814:                         }
                   7815:                     }
1.419     raeburn  7816:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   7817:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   7818: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   7819:                         }
1.420     albertel 7820:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  7821:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   7822:                         }
1.609     raeburn  7823:                         if (ref($statushash) eq 'HASH') {
                   7824:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   7825:                         }
1.275     raeburn  7826:                     }
                   7827:                 }
                   7828:             }
                   7829:         }
1.290     albertel 7830:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  7831:             if ((defined($cdom)) && (defined($cnum))) {
                   7832:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   7833:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   7834:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  7835:                     next if ($owner eq '');
                   7836:                     my ($ownername,$ownerdom);
                   7837:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   7838:                         $ownername = $1;
                   7839:                         $ownerdom = $2;
                   7840:                     } else {
                   7841:                         $ownername = $owner;
                   7842:                         $ownerdom = $cdom;
                   7843:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  7844:                     }
                   7845:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 7846:                     if (defined($userdata) && 
1.609     raeburn  7847: 			!exists($$userdata{$owner})) {
                   7848: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   7849:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   7850:                             push(@{$seclists{$owner}},'none');
                   7851:                         }
                   7852:                         if (ref($statushash) eq 'HASH') {
                   7853:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  7854:                         }
1.290     albertel 7855: 		    }
1.279     raeburn  7856:                 }
                   7857:             }
                   7858:         }
1.419     raeburn  7859:         foreach my $user (keys(%seclists)) {
                   7860:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   7861:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   7862:         }
1.275     raeburn  7863:     }
                   7864:     return;
                   7865: }
                   7866: 
1.288     raeburn  7867: sub get_user_info {
                   7868:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 7869:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   7870: 	&plainname($uname,$udom,'lastname');
1.291     albertel 7871:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  7872:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  7873:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   7874:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  7875:     return;
                   7876: }
1.275     raeburn  7877: 
1.472     raeburn  7878: ###############################################
                   7879: 
                   7880: =pod
                   7881: 
                   7882: =item * &get_user_quota()
                   7883: 
                   7884: Retrieves quota assigned for storage of portfolio files for a user  
                   7885: 
                   7886: Incoming parameters:
                   7887: 1. user's username
                   7888: 2. user's domain
                   7889: 
                   7890: Returns:
1.536     raeburn  7891: 1. Disk quota (in Mb) assigned to student.
                   7892: 2. (Optional) Type of setting: custom or default
                   7893:    (individually assigned or default for user's 
                   7894:    institutional status).
                   7895: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   7896:    or student - types as defined in localenroll::inst_usertypes 
                   7897:    for user's domain, which determines default quota for user.
                   7898: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  7899: 
                   7900: If a value has been stored in the user's environment, 
1.536     raeburn  7901: it will return that, otherwise it returns the maximal default
                   7902: defined for the user's instituional status(es) in the domain.
1.472     raeburn  7903: 
                   7904: =cut
                   7905: 
                   7906: ###############################################
                   7907: 
                   7908: 
                   7909: sub get_user_quota {
                   7910:     my ($uname,$udom) = @_;
1.536     raeburn  7911:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  7912:     if (!defined($udom)) {
                   7913:         $udom = $env{'user.domain'};
                   7914:     }
                   7915:     if (!defined($uname)) {
                   7916:         $uname = $env{'user.name'};
                   7917:     }
                   7918:     if (($udom eq '' || $uname eq '') ||
                   7919:         ($udom eq 'public') && ($uname eq 'public')) {
                   7920:         $quota = 0;
1.536     raeburn  7921:         $quotatype = 'default';
                   7922:         $defquota = 0; 
1.472     raeburn  7923:     } else {
1.536     raeburn  7924:         my $inststatus;
1.472     raeburn  7925:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   7926:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  7927:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  7928:         } else {
1.536     raeburn  7929:             my %userenv = 
                   7930:                 &Apache::lonnet::get('environment',['portfolioquota',
                   7931:                                      'inststatus'],$udom,$uname);
1.472     raeburn  7932:             my ($tmp) = keys(%userenv);
                   7933:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   7934:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  7935:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  7936:             } else {
                   7937:                 undef(%userenv);
                   7938:             }
                   7939:         }
1.536     raeburn  7940:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  7941:         if ($quota eq '') {
1.536     raeburn  7942:             $quota = $defquota;
                   7943:             $quotatype = 'default';
                   7944:         } else {
                   7945:             $quotatype = 'custom';
1.472     raeburn  7946:         }
                   7947:     }
1.536     raeburn  7948:     if (wantarray) {
                   7949:         return ($quota,$quotatype,$settingstatus,$defquota);
                   7950:     } else {
                   7951:         return $quota;
                   7952:     }
1.472     raeburn  7953: }
                   7954: 
                   7955: ###############################################
                   7956: 
                   7957: =pod
                   7958: 
                   7959: =item * &default_quota()
                   7960: 
1.536     raeburn  7961: Retrieves default quota assigned for storage of user portfolio files,
                   7962: given an (optional) user's institutional status.
1.472     raeburn  7963: 
                   7964: Incoming parameters:
                   7965: 1. domain
1.536     raeburn  7966: 2. (Optional) institutional status(es).  This is a : separated list of 
                   7967:    status types (e.g., faculty, staff, student etc.)
                   7968:    which apply to the user for whom the default is being retrieved.
                   7969:    If the institutional status string in undefined, the domain
                   7970:    default quota will be returned. 
1.472     raeburn  7971: 
                   7972: Returns:
                   7973: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  7974: 2. (Optional) institutional type which determined the value of the
                   7975:    default quota.
1.472     raeburn  7976: 
                   7977: If a value has been stored in the domain's configuration db,
                   7978: it will return that, otherwise it returns 20 (for backwards 
                   7979: compatibility with domains which have not set up a configuration
                   7980: db file; the original statically defined portfolio quota was 20 Mb). 
                   7981: 
1.536     raeburn  7982: If the user's status includes multiple types (e.g., staff and student),
                   7983: the largest default quota which applies to the user determines the
                   7984: default quota returned.
                   7985: 
1.780     raeburn  7986: =back
                   7987: 
1.472     raeburn  7988: =cut
                   7989: 
                   7990: ###############################################
                   7991: 
                   7992: 
                   7993: sub default_quota {
1.536     raeburn  7994:     my ($udom,$inststatus) = @_;
                   7995:     my ($defquota,$settingstatus);
                   7996:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  7997:                                             ['quotas'],$udom);
                   7998:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  7999:         if ($inststatus ne '') {
1.765     raeburn  8000:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8001:             foreach my $item (@statuses) {
1.711     raeburn  8002:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8003:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8004:                         if ($defquota eq '') {
                   8005:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8006:                             $settingstatus = $item;
                   8007:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8008:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8009:                             $settingstatus = $item;
                   8010:                         }
                   8011:                     }
                   8012:                 } else {
                   8013:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8014:                         if ($defquota eq '') {
                   8015:                             $defquota = $quotahash{'quotas'}{$item};
                   8016:                             $settingstatus = $item;
                   8017:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8018:                             $defquota = $quotahash{'quotas'}{$item};
                   8019:                             $settingstatus = $item;
                   8020:                         }
1.536     raeburn  8021:                     }
                   8022:                 }
                   8023:             }
                   8024:         }
                   8025:         if ($defquota eq '') {
1.711     raeburn  8026:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8027:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8028:             } else {
                   8029:                 $defquota = $quotahash{'quotas'}{'default'};
                   8030:             }
1.536     raeburn  8031:             $settingstatus = 'default';
                   8032:         }
                   8033:     } else {
                   8034:         $settingstatus = 'default';
                   8035:         $defquota = 20;
                   8036:     }
                   8037:     if (wantarray) {
                   8038:         return ($defquota,$settingstatus);
1.472     raeburn  8039:     } else {
1.536     raeburn  8040:         return $defquota;
1.472     raeburn  8041:     }
                   8042: }
                   8043: 
1.384     raeburn  8044: sub get_secgrprole_info {
                   8045:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8046:     my %sections_count = &get_sections($cdom,$cnum);
                   8047:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8048:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8049:     my @groups = sort(keys(%curr_groups));
                   8050:     my $allroles = [];
                   8051:     my $rolehash;
                   8052:     my $accesshash = {
                   8053:                      active => 'Currently has access',
                   8054:                      future => 'Will have future access',
                   8055:                      previous => 'Previously had access',
                   8056:                   };
                   8057:     if ($needroles) {
                   8058:         $rolehash = {'all' => 'all'};
1.385     albertel 8059:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8060: 	if (&Apache::lonnet::error(%user_roles)) {
                   8061: 	    undef(%user_roles);
                   8062: 	}
                   8063:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8064:             my ($role)=split(/\:/,$item,2);
                   8065:             if ($role eq 'cr') { next; }
                   8066:             if ($role =~ /^cr/) {
                   8067:                 $$rolehash{$role} = (split('/',$role))[3];
                   8068:             } else {
                   8069:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8070:             }
                   8071:         }
                   8072:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8073:             push(@{$allroles},$key);
                   8074:         }
                   8075:         push (@{$allroles},'st');
                   8076:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8077:     }
                   8078:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8079: }
                   8080: 
1.555     raeburn  8081: sub user_picker {
1.994     raeburn  8082:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8083:     my $currdom = $dom;
                   8084:     my %curr_selected = (
                   8085:                         srchin => 'dom',
1.580     raeburn  8086:                         srchby => 'lastname',
1.555     raeburn  8087:                       );
                   8088:     my $srchterm;
1.625     raeburn  8089:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8090:         if ($srch->{'srchby'} ne '') {
                   8091:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8092:         }
                   8093:         if ($srch->{'srchin'} ne '') {
                   8094:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8095:         }
                   8096:         if ($srch->{'srchtype'} ne '') {
                   8097:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8098:         }
                   8099:         if ($srch->{'srchdomain'} ne '') {
                   8100:             $currdom = $srch->{'srchdomain'};
                   8101:         }
                   8102:         $srchterm = $srch->{'srchterm'};
                   8103:     }
                   8104:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8105:                     'usr'       => 'Search criteria',
1.563     raeburn  8106:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8107:                     'uname'     => 'username',
                   8108:                     'lastname'  => 'last name',
1.555     raeburn  8109:                     'lastfirst' => 'last name, first name',
1.558     albertel 8110:                     'crs'       => 'in this course',
1.576     raeburn  8111:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8112:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8113:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8114:                     'exact'     => 'is',
                   8115:                     'contains'  => 'contains',
1.569     raeburn  8116:                     'begins'    => 'begins with',
1.571     raeburn  8117:                     'youm'      => "You must include some text to search for.",
                   8118:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8119:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8120:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8121:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8122:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8123:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8124:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8125:                                        );
1.563     raeburn  8126:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8127:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8128: 
                   8129:     my @srchins = ('crs','dom','alc','instd');
                   8130: 
                   8131:     foreach my $option (@srchins) {
                   8132:         # FIXME 'alc' option unavailable until 
                   8133:         #       loncreateuser::print_user_query_page()
                   8134:         #       has been completed.
                   8135:         next if ($option eq 'alc');
1.880     raeburn  8136:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8137:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8138:         if ($curr_selected{'srchin'} eq $option) {
                   8139:             $srchinsel .= ' 
                   8140:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8141:         } else {
                   8142:             $srchinsel .= '
                   8143:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8144:         }
1.555     raeburn  8145:     }
1.563     raeburn  8146:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8147: 
                   8148:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8149:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8150:         if ($curr_selected{'srchby'} eq $option) {
                   8151:             $srchbysel .= '
                   8152:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8153:         } else {
                   8154:             $srchbysel .= '
                   8155:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8156:          }
                   8157:     }
                   8158:     $srchbysel .= "\n  </select>\n";
                   8159: 
                   8160:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8161:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8162:         if ($curr_selected{'srchtype'} eq $option) {
                   8163:             $srchtypesel .= '
                   8164:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8165:         } else {
                   8166:             $srchtypesel .= '
                   8167:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8168:         }
                   8169:     }
                   8170:     $srchtypesel .= "\n  </select>\n";
                   8171: 
1.558     albertel 8172:     my ($newuserscript,$new_user_create);
1.994     raeburn  8173:     my $context_dom = $env{'request.role.domain'};
                   8174:     if ($context eq 'requestcrs') {
                   8175:         if ($env{'form.coursedom'} ne '') { 
                   8176:             $context_dom = $env{'form.coursedom'};
                   8177:         }
                   8178:     }
1.556     raeburn  8179:     if ($forcenewuser) {
1.576     raeburn  8180:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8181:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8182:                 if ($cancreate) {
                   8183:                     $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>';
                   8184:                 } else {
1.799     bisitz   8185:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8186:                     my %usertypetext = (
                   8187:                         official   => 'institutional',
                   8188:                         unofficial => 'non-institutional',
                   8189:                     );
1.799     bisitz   8190:                     $new_user_create = '<p class="LC_warning">'
                   8191:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8192:                                       .' '
                   8193:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8194:                                           ,'<a href="'.$helplink.'">','</a>')
                   8195:                                       .'</p><br />';
1.627     raeburn  8196:                 }
1.576     raeburn  8197:             }
                   8198:         }
                   8199: 
1.556     raeburn  8200:         $newuserscript = <<"ENDSCRIPT";
                   8201: 
1.570     raeburn  8202: function setSearch(createnew,callingForm) {
1.556     raeburn  8203:     if (createnew == 1) {
1.570     raeburn  8204:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8205:             if (callingForm.srchby.options[i].value == 'uname') {
                   8206:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8207:             }
                   8208:         }
1.570     raeburn  8209:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8210:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8211: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8212:             }
                   8213:         }
1.570     raeburn  8214:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8215:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8216:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8217:             }
                   8218:         }
1.570     raeburn  8219:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8220:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8221:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8222:             }
                   8223:         }
                   8224:     }
                   8225: }
                   8226: ENDSCRIPT
1.558     albertel 8227: 
1.556     raeburn  8228:     }
                   8229: 
1.555     raeburn  8230:     my $output = <<"END_BLOCK";
1.556     raeburn  8231: <script type="text/javascript">
1.824     bisitz   8232: // <![CDATA[
1.570     raeburn  8233: function validateEntry(callingForm) {
1.558     albertel 8234: 
1.556     raeburn  8235:     var checkok = 1;
1.558     albertel 8236:     var srchin;
1.570     raeburn  8237:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8238: 	if ( callingForm.srchin[i].checked ) {
                   8239: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8240: 	}
                   8241:     }
                   8242: 
1.570     raeburn  8243:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8244:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8245:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8246:     var srchterm =  callingForm.srchterm.value;
                   8247:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8248:     var msg = "";
                   8249: 
                   8250:     if (srchterm == "") {
                   8251:         checkok = 0;
1.571     raeburn  8252:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8253:     }
                   8254: 
1.569     raeburn  8255:     if (srchtype== 'begins') {
                   8256:         if (srchterm.length < 2) {
                   8257:             checkok = 0;
1.571     raeburn  8258:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8259:         }
                   8260:     }
                   8261: 
1.556     raeburn  8262:     if (srchtype== 'contains') {
                   8263:         if (srchterm.length < 3) {
                   8264:             checkok = 0;
1.571     raeburn  8265:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8266:         }
                   8267:     }
                   8268:     if (srchin == 'instd') {
                   8269:         if (srchdomain == '') {
                   8270:             checkok = 0;
1.571     raeburn  8271:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8272:         }
                   8273:     }
                   8274:     if (srchin == 'dom') {
                   8275:         if (srchdomain == '') {
                   8276:             checkok = 0;
1.571     raeburn  8277:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8278:         }
                   8279:     }
                   8280:     if (srchby == 'lastfirst') {
                   8281:         if (srchterm.indexOf(",") == -1) {
                   8282:             checkok = 0;
1.571     raeburn  8283:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8284:         }
                   8285:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8286:             checkok = 0;
1.571     raeburn  8287:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8288:         }
                   8289:     }
                   8290:     if (checkok == 0) {
1.571     raeburn  8291:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8292:         return;
                   8293:     }
                   8294:     if (checkok == 1) {
1.570     raeburn  8295:         callingForm.submit();
1.556     raeburn  8296:     }
                   8297: }
                   8298: 
                   8299: $newuserscript
                   8300: 
1.824     bisitz   8301: // ]]>
1.556     raeburn  8302: </script>
1.558     albertel 8303: 
                   8304: $new_user_create
                   8305: 
1.555     raeburn  8306: END_BLOCK
1.558     albertel 8307: 
1.876     raeburn  8308:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8309:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8310:                $domform.
                   8311:                &Apache::lonhtmlcommon::row_closure().
                   8312:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8313:                $srchbysel.
                   8314:                $srchtypesel. 
                   8315:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8316:                $srchinsel.
                   8317:                &Apache::lonhtmlcommon::row_closure(1). 
                   8318:                &Apache::lonhtmlcommon::end_pick_box().
                   8319:                '<br />';
1.555     raeburn  8320:     return $output;
                   8321: }
                   8322: 
1.612     raeburn  8323: sub user_rule_check {
1.615     raeburn  8324:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8325:     my $response;
                   8326:     if (ref($usershash) eq 'HASH') {
                   8327:         foreach my $user (keys(%{$usershash})) {
                   8328:             my ($uname,$udom) = split(/:/,$user);
                   8329:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8330:             my ($id,$newuser);
1.612     raeburn  8331:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8332:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8333:                 $id = $usershash->{$user}->{'id'};
                   8334:             }
                   8335:             my $inst_response;
                   8336:             if (ref($checks) eq 'HASH') {
                   8337:                 if (defined($checks->{'username'})) {
1.615     raeburn  8338:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8339:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8340:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8341:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8342:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8343:                 }
1.615     raeburn  8344:             } else {
                   8345:                 ($inst_response,%{$inst_results->{$user}}) =
                   8346:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8347:                 return;
1.612     raeburn  8348:             }
1.615     raeburn  8349:             if (!$got_rules->{$udom}) {
1.612     raeburn  8350:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8351:                                                   ['usercreation'],$udom);
                   8352:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8353:                     foreach my $item ('username','id') {
1.612     raeburn  8354:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8355:                             $$curr_rules{$udom}{$item} = 
                   8356:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8357:                         }
                   8358:                     }
                   8359:                 }
1.615     raeburn  8360:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8361:             }
1.612     raeburn  8362:             foreach my $item (keys(%{$checks})) {
                   8363:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8364:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8365:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8366:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8367:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8368:                                 if ($rule_check{$rule}) {
                   8369:                                     $$rulematch{$user}{$item} = $rule;
                   8370:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8371:                                         if (ref($inst_results) eq 'HASH') {
                   8372:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8373:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8374:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8375:                                                 }
1.612     raeburn  8376:                                             }
                   8377:                                         }
1.615     raeburn  8378:                                     }
                   8379:                                     last;
1.585     raeburn  8380:                                 }
                   8381:                             }
                   8382:                         }
                   8383:                     }
                   8384:                 }
                   8385:             }
                   8386:         }
                   8387:     }
1.612     raeburn  8388:     return;
                   8389: }
                   8390: 
                   8391: sub user_rule_formats {
                   8392:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8393:     my %text = ( 
                   8394:                  'username' => 'Usernames',
                   8395:                  'id'       => 'IDs',
                   8396:                );
                   8397:     my $output;
                   8398:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8399:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8400:         if (@{$ruleorder} > 0) {
                   8401:             $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>';
                   8402:             foreach my $rule (@{$ruleorder}) {
                   8403:                 if (ref($curr_rules) eq 'ARRAY') {
                   8404:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8405:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8406:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8407:                                         $rules->{$rule}{'desc'}.'</li>';
                   8408:                         }
                   8409:                     }
                   8410:                 }
                   8411:             }
                   8412:             $output .= '</ul>';
                   8413:         }
                   8414:     }
                   8415:     return $output;
                   8416: }
                   8417: 
                   8418: sub instrule_disallow_msg {
1.615     raeburn  8419:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8420:     my $response;
                   8421:     my %text = (
                   8422:                   item   => 'username',
                   8423:                   items  => 'usernames',
                   8424:                   match  => 'matches',
                   8425:                   do     => 'does',
                   8426:                   action => 'a username',
                   8427:                   one    => 'one',
                   8428:                );
                   8429:     if ($count > 1) {
                   8430:         $text{'item'} = 'usernames';
                   8431:         $text{'match'} ='match';
                   8432:         $text{'do'} = 'do';
                   8433:         $text{'action'} = 'usernames',
                   8434:         $text{'one'} = 'ones';
                   8435:     }
                   8436:     if ($checkitem eq 'id') {
                   8437:         $text{'items'} = 'IDs';
                   8438:         $text{'item'} = 'ID';
                   8439:         $text{'action'} = 'an ID';
1.615     raeburn  8440:         if ($count > 1) {
                   8441:             $text{'item'} = 'IDs';
                   8442:             $text{'action'} = 'IDs';
                   8443:         }
1.612     raeburn  8444:     }
1.674     bisitz   8445:     $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  8446:     if ($mode eq 'upload') {
                   8447:         if ($checkitem eq 'username') {
                   8448:             $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'}.");
                   8449:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8450:             $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  8451:         }
1.669     raeburn  8452:     } elsif ($mode eq 'selfcreate') {
                   8453:         if ($checkitem eq 'id') {
                   8454:             $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.");
                   8455:         }
1.615     raeburn  8456:     } else {
                   8457:         if ($checkitem eq 'username') {
                   8458:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8459:         } elsif ($checkitem eq 'id') {
                   8460:             $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.");
                   8461:         }
1.612     raeburn  8462:     }
                   8463:     return $response;
1.585     raeburn  8464: }
                   8465: 
1.624     raeburn  8466: sub personal_data_fieldtitles {
                   8467:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8468:                         id => 'Student/Employee ID',
                   8469:                         permanentemail => 'E-mail address',
                   8470:                         lastname => 'Last Name',
                   8471:                         firstname => 'First Name',
                   8472:                         middlename => 'Middle Name',
                   8473:                         generation => 'Generation',
                   8474:                         gen => 'Generation',
1.765     raeburn  8475:                         inststatus => 'Affiliation',
1.624     raeburn  8476:                    );
                   8477:     return %fieldtitles;
                   8478: }
                   8479: 
1.642     raeburn  8480: sub sorted_inst_types {
                   8481:     my ($dom) = @_;
                   8482:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8483:     my $othertitle = &mt('All users');
                   8484:     if ($env{'request.course.id'}) {
1.668     raeburn  8485:         $othertitle  = &mt('Any users');
1.642     raeburn  8486:     }
                   8487:     my @types;
                   8488:     if (ref($order) eq 'ARRAY') {
                   8489:         @types = @{$order};
                   8490:     }
                   8491:     if (@types == 0) {
                   8492:         if (ref($usertypes) eq 'HASH') {
                   8493:             @types = sort(keys(%{$usertypes}));
                   8494:         }
                   8495:     }
                   8496:     if (keys(%{$usertypes}) > 0) {
                   8497:         $othertitle = &mt('Other users');
                   8498:     }
                   8499:     return ($othertitle,$usertypes,\@types);
                   8500: }
                   8501: 
1.645     raeburn  8502: sub get_institutional_codes {
                   8503:     my ($settings,$allcourses,$LC_code) = @_;
                   8504: # Get complete list of course sections to update
                   8505:     my @currsections = ();
                   8506:     my @currxlists = ();
                   8507:     my $coursecode = $$settings{'internal.coursecode'};
                   8508: 
                   8509:     if ($$settings{'internal.sectionnums'} ne '') {
                   8510:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8511:     }
                   8512: 
                   8513:     if ($$settings{'internal.crosslistings'} ne '') {
                   8514:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8515:     }
                   8516: 
                   8517:     if (@currxlists > 0) {
                   8518:         foreach (@currxlists) {
                   8519:             if (m/^([^:]+):(\w*)$/) {
                   8520:                 unless (grep/^$1$/,@{$allcourses}) {
                   8521:                     push @{$allcourses},$1;
                   8522:                     $$LC_code{$1} = $2;
                   8523:                 }
                   8524:             }
                   8525:         }
                   8526:     }
                   8527:  
                   8528:     if (@currsections > 0) {
                   8529:         foreach (@currsections) {
                   8530:             if (m/^(\w+):(\w*)$/) {
                   8531:                 my $sec = $coursecode.$1;
                   8532:                 my $lc_sec = $2;
                   8533:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8534:                     push @{$allcourses},$sec;
                   8535:                     $$LC_code{$sec} = $lc_sec;
                   8536:                 }
                   8537:             }
                   8538:         }
                   8539:     }
                   8540:     return;
                   8541: }
                   8542: 
1.971     raeburn  8543: sub get_standard_codeitems {
                   8544:     return ('Year','Semester','Department','Number','Section');
                   8545: }
                   8546: 
1.112     bowersj2 8547: =pod
                   8548: 
1.780     raeburn  8549: =head1 Slot Helpers
                   8550: 
                   8551: =over 4
                   8552: 
                   8553: =item * sorted_slots()
                   8554: 
1.1040    raeburn  8555: Sorts an array of slot names in order of an optional sort key,
                   8556: default sort is by slot start time (earliest first). 
1.780     raeburn  8557: 
                   8558: Inputs:
                   8559: 
                   8560: =over 4
                   8561: 
                   8562: slotsarr  - Reference to array of unsorted slot names.
                   8563: 
                   8564: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8565: 
1.1040    raeburn  8566: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   8567: 
1.549     albertel 8568: =back
                   8569: 
1.780     raeburn  8570: Returns:
                   8571: 
                   8572: =over 4
                   8573: 
1.1040    raeburn  8574: sorted   - An array of slot names sorted by a specified sort key 
                   8575:            (default sort key is start time of the slot).
1.780     raeburn  8576: 
                   8577: =back
                   8578: 
                   8579: =cut
                   8580: 
                   8581: 
                   8582: sub sorted_slots {
1.1040    raeburn  8583:     my ($slotsarr,$slots,$sortkey) = @_;
                   8584:     if ($sortkey eq '') {
                   8585:         $sortkey = 'starttime';
                   8586:     }
1.780     raeburn  8587:     my @sorted;
                   8588:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8589:         @sorted =
                   8590:             sort {
                   8591:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  8592:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  8593:                      }
                   8594:                      if (ref($slots->{$a})) { return -1;}
                   8595:                      if (ref($slots->{$b})) { return 1;}
                   8596:                      return 0;
                   8597:                  } @{$slotsarr};
                   8598:     }
                   8599:     return @sorted;
                   8600: }
                   8601: 
1.1040    raeburn  8602: =pod
                   8603: 
                   8604: =item * get_future_slots()
                   8605: 
                   8606: Inputs:
                   8607: 
                   8608: =over 4
                   8609: 
                   8610: cnum - course number
                   8611: 
                   8612: cdom - course domain
                   8613: 
                   8614: now - current UNIX time
                   8615: 
                   8616: symb - optional symb
                   8617: 
                   8618: =back
                   8619: 
                   8620: Returns:
                   8621: 
                   8622: =over 4
                   8623: 
                   8624: sorted_reservable - ref to array of student_schedulable slots currently 
                   8625:                     reservable, ordered by end date of reservation period.
                   8626: 
                   8627: reservable_now - ref to hash of student_schedulable slots currently
                   8628:                  reservable.
                   8629: 
                   8630:     Keys in inner hash are:
                   8631:     (a) symb: either blank or symb to which slot use is restricted.
                   8632:     (b) endreserve: end date of reservation period. 
                   8633: 
                   8634: sorted_future - ref to array of student_schedulable slots reservable in
                   8635:                 the future, ordered by start date of reservation period.
                   8636: 
                   8637: future_reservable - ref to hash of student_schedulable slots reservable
                   8638:                     in the future.
                   8639: 
                   8640:     Keys in inner hash are:
                   8641:     (a) symb: either blank or symb to which slot use is restricted.
                   8642:     (b) startreserve:  start date of reservation period.
                   8643: 
                   8644: =back
                   8645: 
                   8646: =cut
                   8647: 
                   8648: sub get_future_slots {
                   8649:     my ($cnum,$cdom,$now,$symb) = @_;
                   8650:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   8651:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   8652:     foreach my $slot (keys(%slots)) {
                   8653:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   8654:         if ($symb) {
                   8655:             next if (($slots{$slot}->{'symb'} ne '') && 
                   8656:                      ($slots{$slot}->{'symb'} ne $symb));
                   8657:         }
                   8658:         if (($slots{$slot}->{'starttime'} > $now) &&
                   8659:             ($slots{$slot}->{'endtime'} > $now)) {
                   8660:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   8661:                 my $userallowed = 0;
                   8662:                 if ($slots{$slot}->{'allowedsections'}) {
                   8663:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   8664:                     if (!defined($env{'request.role.sec'})
                   8665:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   8666:                         $userallowed=1;
                   8667:                     } else {
                   8668:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   8669:                             $userallowed=1;
                   8670:                         }
                   8671:                     }
                   8672:                     unless ($userallowed) {
                   8673:                         if (defined($env{'request.course.groups'})) {
                   8674:                             my @groups = split(/:/,$env{'request.course.groups'});
                   8675:                             foreach my $group (@groups) {
                   8676:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   8677:                                     $userallowed=1;
                   8678:                                     last;
                   8679:                                 }
                   8680:                             }
                   8681:                         }
                   8682:                     }
                   8683:                 }
                   8684:                 if ($slots{$slot}->{'allowedusers'}) {
                   8685:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   8686:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   8687:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   8688:                         $userallowed = 1;
                   8689:                     }
                   8690:                 }
                   8691:                 next unless($userallowed);
                   8692:             }
                   8693:             my $startreserve = $slots{$slot}->{'startreserve'};
                   8694:             my $endreserve = $slots{$slot}->{'endreserve'};
                   8695:             my $symb = $slots{$slot}->{'symb'};
                   8696:             if (($startreserve < $now) &&
                   8697:                 (!$endreserve || $endreserve > $now)) {
                   8698:                 my $lastres = $endreserve;
                   8699:                 if (!$lastres) {
                   8700:                     $lastres = $slots{$slot}->{'starttime'};
                   8701:                 }
                   8702:                 $reservable_now{$slot} = {
                   8703:                                            symb       => $symb,
                   8704:                                            endreserve => $lastres
                   8705:                                          };
                   8706:             } elsif (($startreserve > $now) &&
                   8707:                      (!$endreserve || $endreserve > $startreserve)) {
                   8708:                 $future_reservable{$slot} = {
                   8709:                                               symb         => $symb,
                   8710:                                               startreserve => $startreserve
                   8711:                                             };
                   8712:             }
                   8713:         }
                   8714:     }
                   8715:     my @unsorted_reservable = keys(%reservable_now);
                   8716:     if (@unsorted_reservable > 0) {
                   8717:         @sorted_reservable = 
                   8718:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   8719:     }
                   8720:     my @unsorted_future = keys(%future_reservable);
                   8721:     if (@unsorted_future > 0) {
                   8722:         @sorted_future =
                   8723:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   8724:     }
                   8725:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   8726: }
1.780     raeburn  8727: 
                   8728: =pod
                   8729: 
1.549     albertel 8730: =head1 HTTP Helpers
                   8731: 
                   8732: =over 4
                   8733: 
1.648     raeburn  8734: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 8735: 
1.258     albertel 8736: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 8737: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 8738: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 8739: 
                   8740: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   8741: $possible_names is an ref to an array of form element names.  As an example:
                   8742: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 8743: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 8744: 
                   8745: =cut
1.1       albertel 8746: 
1.6       albertel 8747: sub get_unprocessed_cgi {
1.25      albertel 8748:   my ($query,$possible_names)= @_;
1.26      matthew  8749:   # $Apache::lonxml::debug=1;
1.356     albertel 8750:   foreach my $pair (split(/&/,$query)) {
                   8751:     my ($name, $value) = split(/=/,$pair);
1.369     www      8752:     $name = &unescape($name);
1.25      albertel 8753:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   8754:       $value =~ tr/+/ /;
                   8755:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 8756:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 8757:     }
1.16      harris41 8758:   }
1.6       albertel 8759: }
                   8760: 
1.112     bowersj2 8761: =pod
                   8762: 
1.648     raeburn  8763: =item * &cacheheader() 
1.112     bowersj2 8764: 
                   8765: returns cache-controlling header code
                   8766: 
                   8767: =cut
                   8768: 
1.7       albertel 8769: sub cacheheader {
1.258     albertel 8770:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 8771:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   8772:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 8773:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   8774:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 8775:     return $output;
1.7       albertel 8776: }
                   8777: 
1.112     bowersj2 8778: =pod
                   8779: 
1.648     raeburn  8780: =item * &no_cache($r) 
1.112     bowersj2 8781: 
                   8782: specifies header code to not have cache
                   8783: 
                   8784: =cut
                   8785: 
1.9       albertel 8786: sub no_cache {
1.216     albertel 8787:     my ($r) = @_;
                   8788:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 8789: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 8790:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   8791:     $r->no_cache(1);
                   8792:     $r->header_out("Expires" => $date);
                   8793:     $r->header_out("Pragma" => "no-cache");
1.123     www      8794: }
                   8795: 
                   8796: sub content_type {
1.181     albertel 8797:     my ($r,$type,$charset) = @_;
1.299     foxr     8798:     if ($r) {
                   8799: 	#  Note that printout.pl calls this with undef for $r.
                   8800: 	&no_cache($r);
                   8801:     }
1.258     albertel 8802:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 8803:     unless ($charset) {
                   8804: 	$charset=&Apache::lonlocal::current_encoding;
                   8805:     }
                   8806:     if ($charset) { $type.='; charset='.$charset; }
                   8807:     if ($r) {
                   8808: 	$r->content_type($type);
                   8809:     } else {
                   8810: 	print("Content-type: $type\n\n");
                   8811:     }
1.9       albertel 8812: }
1.25      albertel 8813: 
1.112     bowersj2 8814: =pod
                   8815: 
1.648     raeburn  8816: =item * &add_to_env($name,$value) 
1.112     bowersj2 8817: 
1.258     albertel 8818: adds $name to the %env hash with value
1.112     bowersj2 8819: $value, if $name already exists, the entry is converted to an array
                   8820: reference and $value is added to the array.
                   8821: 
                   8822: =cut
                   8823: 
1.25      albertel 8824: sub add_to_env {
                   8825:   my ($name,$value)=@_;
1.258     albertel 8826:   if (defined($env{$name})) {
                   8827:     if (ref($env{$name})) {
1.25      albertel 8828:       #already have multiple values
1.258     albertel 8829:       push(@{ $env{$name} },$value);
1.25      albertel 8830:     } else {
                   8831:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 8832:       my $first=$env{$name};
                   8833:       undef($env{$name});
                   8834:       push(@{ $env{$name} },$first,$value);
1.25      albertel 8835:     }
                   8836:   } else {
1.258     albertel 8837:     $env{$name}=$value;
1.25      albertel 8838:   }
1.31      albertel 8839: }
1.149     albertel 8840: 
                   8841: =pod
                   8842: 
1.648     raeburn  8843: =item * &get_env_multiple($name) 
1.149     albertel 8844: 
1.258     albertel 8845: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 8846: values may be defined and end up as an array ref.
                   8847: 
                   8848: returns an array of values
                   8849: 
                   8850: =cut
                   8851: 
                   8852: sub get_env_multiple {
                   8853:     my ($name) = @_;
                   8854:     my @values;
1.258     albertel 8855:     if (defined($env{$name})) {
1.149     albertel 8856:         # exists is it an array
1.258     albertel 8857:         if (ref($env{$name})) {
                   8858:             @values=@{ $env{$name} };
1.149     albertel 8859:         } else {
1.258     albertel 8860:             $values[0]=$env{$name};
1.149     albertel 8861:         }
                   8862:     }
                   8863:     return(@values);
                   8864: }
                   8865: 
1.660     raeburn  8866: sub ask_for_embedded_content {
                   8867:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.987     raeburn  8868:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
1.660     raeburn  8869:     my $num = 0;
1.987     raeburn  8870:     my $numremref = 0;
                   8871:     my $numinvalid = 0;
                   8872:     my $numpathchg = 0;
                   8873:     my $numexisting = 0;
                   8874:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
1.984     raeburn  8875:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8876:         my $current_path='/';
                   8877:         if ($env{'form.currentpath'}) {
                   8878:             $current_path = $env{'form.currentpath'};
                   8879:         }
                   8880:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   8881:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8882:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   8883:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   8884:         } else {
                   8885:             $udom = $env{'user.domain'};
                   8886:             $uname = $env{'user.name'};
                   8887:             $url = '/userfiles/portfolio';
                   8888:         }
1.987     raeburn  8889:         $toplevel = $url.'/';
1.984     raeburn  8890:         $url .= $current_path;
                   8891:         $getpropath = 1;
1.987     raeburn  8892:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   8893:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      8894:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  8895:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  8896:         $toplevel = $url;
1.984     raeburn  8897:         if ($rest ne '') {
1.987     raeburn  8898:             $url .= $rest;
                   8899:         }
                   8900:     } elsif ($actionurl eq '/adm/coursedocs') {
                   8901:         if (ref($args) eq 'HASH') {
                   8902:            $url = $args->{'docs_url'};
                   8903:            $toplevel = $url;
                   8904:         }
                   8905:     }
                   8906:     my $now = time();
                   8907:     foreach my $embed_file (keys(%{$allfiles})) {
                   8908:         my $absolutepath;
                   8909:         if ($embed_file =~ m{^\w+://}) {
                   8910:             $newfiles{$embed_file} = 1;
                   8911:             $mapping{$embed_file} = $embed_file;
                   8912:         } else {
                   8913:             if ($embed_file =~ m{^/}) {
                   8914:                 $absolutepath = $embed_file;
                   8915:                 $embed_file =~ s{^(/+)}{};
                   8916:             }
                   8917:             if ($embed_file =~ m{/}) {
                   8918:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   8919:                 $path = &check_for_traversal($path,$url,$toplevel);
                   8920:                 my $item = $fname;
                   8921:                 if ($path ne '') {
                   8922:                     $item = $path.'/'.$fname;
                   8923:                     $subdependencies{$path}{$fname} = 1;
                   8924:                 } else {
                   8925:                     $dependencies{$item} = 1;
                   8926:                 }
                   8927:                 if ($absolutepath) {
                   8928:                     $mapping{$item} = $absolutepath;
                   8929:                 } else {
                   8930:                     $mapping{$item} = $embed_file;
                   8931:                 }
                   8932:             } else {
                   8933:                 $dependencies{$embed_file} = 1;
                   8934:                 if ($absolutepath) {
                   8935:                     $mapping{$embed_file} = $absolutepath;
                   8936:                 } else {
                   8937:                     $mapping{$embed_file} = $embed_file;
                   8938:                 }
                   8939:             }
1.984     raeburn  8940:         }
                   8941:     }
                   8942:     foreach my $path (keys(%subdependencies)) {
                   8943:         my %currsubfile;
                   8944:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  8945:             my ($sublistref,$listerror) =
                   8946:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   8947:             if (ref($sublistref) eq 'ARRAY') {
                   8948:                 foreach my $line (@{$sublistref}) {
                   8949:                     my ($file_name,$rest) = split(/\&/,$line,2);
                   8950:                     $currsubfile{$file_name} = 1;
                   8951:                 }
1.984     raeburn  8952:             }
1.987     raeburn  8953:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8954:             if (opendir(my $dir,$url.'/'.$path)) {
                   8955:                 my @subdir_list = grep(!/^\./,readdir($dir));
                   8956:                 map {$currsubfile{$_} = 1;} @subdir_list;
                   8957:             }
                   8958:         }
                   8959:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.987     raeburn  8960:             if ($currsubfile{$file}) {
                   8961:                 my $item = $path.'/'.$file;
                   8962:                 unless ($mapping{$item} eq $item) {
                   8963:                     $pathchanges{$item} = 1;
                   8964:                 }
                   8965:                 $existing{$item} = 1;
                   8966:                 $numexisting ++;
                   8967:             } else {
                   8968:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  8969:             }
                   8970:         }
                   8971:     }
1.987     raeburn  8972:     my %currfile;
1.984     raeburn  8973:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  8974:         my ($dirlistref,$listerror) =
                   8975:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   8976:         if (ref($dirlistref) eq 'ARRAY') {
                   8977:             foreach my $line (@{$dirlistref}) {
                   8978:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   8979:                 $currfile{$file_name} = 1;
                   8980:             }
1.984     raeburn  8981:         }
1.987     raeburn  8982:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8983:         if (opendir(my $dir,$url)) {
1.987     raeburn  8984:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  8985:             map {$currfile{$_} = 1;} @dir_list;
                   8986:         }
                   8987:     }
                   8988:     foreach my $file (keys(%dependencies)) {
1.987     raeburn  8989:         if ($currfile{$file}) {
                   8990:             unless ($mapping{$file} eq $file) {
                   8991:                 $pathchanges{$file} = 1;
                   8992:             }
                   8993:             $existing{$file} = 1;
                   8994:             $numexisting ++;
                   8995:         } else {
1.984     raeburn  8996:             $newfiles{$file} = 1;
                   8997:         }
                   8998:     }
                   8999:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.660     raeburn  9000:         $upload_output .= &start_data_table_row().
1.987     raeburn  9001:                           '<td><span class="LC_filename">'.$embed_file.'</span>';
                   9002:         unless ($mapping{$embed_file} eq $embed_file) {
                   9003:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9004:         }
                   9005:         $upload_output .= '</td><td>';
1.660     raeburn  9006:         if ($args->{'ignore_remote_references'}
                   9007:             && $embed_file =~ m{^\w+://}) {
                   9008:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9009:             $numremref++;
1.660     raeburn  9010:         } elsif ($args->{'error_on_invalid_names'}
                   9011:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   9012: 
1.987     raeburn  9013:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9014:             $numinvalid++;
1.660     raeburn  9015:         } else {
1.987     raeburn  9016:             $upload_output .= &embedded_file_element('upload_embedded',$num,
                   9017:                                                      $embed_file,\%mapping,
                   9018:                                                      $allfiles,$codebase);
                   9019:             $num++;
                   9020:         }
                   9021:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9022:     }
                   9023:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
                   9024:         $upload_output .= &start_data_table_row().
                   9025:                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.
                   9026:                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9027:                           &Apache::loncommon::end_data_table_row()."\n";
                   9028:     }
                   9029:     if ($upload_output) {
                   9030:         $upload_output = &start_data_table().
                   9031:                          $upload_output.
                   9032:                          &end_data_table()."\n";
                   9033:     }
                   9034:     my $applies = 0;
                   9035:     if ($numremref) {
                   9036:         $applies ++;
                   9037:     }
                   9038:     if ($numinvalid) {
                   9039:         $applies ++;
                   9040:     }
                   9041:     if ($numexisting) {
                   9042:         $applies ++;
                   9043:     }
                   9044:     if ($num) {
                   9045:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9046:                   ' method="post" enctype="multipart/form-data">'."\n".
                   9047:                   $state.
                   9048:                   '<h3>'.&mt('Upload embedded files').
                   9049:                   ':</h3>'.$upload_output.'<br />'."\n".
                   9050:                   '<input type ="hidden" name="number_embedded_items" value="'.
                   9051:                   $num.'" />'."\n";
                   9052:         if ($actionurl eq '') {
                   9053:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9054:         }
                   9055:     } elsif ($applies) {
                   9056:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9057:         if ($applies > 1) {
                   9058:             $output .=  
                   9059:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9060:             if ($numremref) {
                   9061:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9062:             }
                   9063:             if ($numinvalid) {
                   9064:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9065:             }
                   9066:             if ($numexisting) {
                   9067:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9068:             }
                   9069:             $output .= '</ul><br />';
                   9070:         } elsif ($numremref) {
                   9071:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9072:         } elsif ($numinvalid) {
                   9073:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9074:         } elsif ($numexisting) {
                   9075:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9076:         }
                   9077:         $output .= $upload_output.'<br />';
                   9078:     }
                   9079:     my ($pathchange_output,$chgcount);
                   9080:     $chgcount = $num;
                   9081:     if (keys(%pathchanges) > 0) {
                   9082:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
                   9083:             if ($num) {
                   9084:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9085:                                                   $embed_file,\%mapping,
                   9086:                                                   $allfiles,$codebase);
                   9087:             } else {
                   9088:                 $pathchange_output .= 
                   9089:                     &start_data_table_row().
                   9090:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9091:                     $chgcount.'" checked="checked" /></td>'.
                   9092:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9093:                     '<td>'.$embed_file.
                   9094:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
                   9095:                                            \%mapping,$allfiles,$codebase).
                   9096:                     '</td>'.&end_data_table_row();
1.660     raeburn  9097:             }
1.987     raeburn  9098:             $numpathchg ++;
                   9099:             $chgcount ++;
1.660     raeburn  9100:         }
                   9101:     }
1.984     raeburn  9102:     if ($num) {
1.987     raeburn  9103:         if ($numpathchg) {
                   9104:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9105:                        $numpathchg.'" />'."\n";
                   9106:         }
                   9107:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9108:             ($actionurl eq '/adm/imsimport')) {
                   9109:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9110:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9111:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
                   9112:         }
                   9113:         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".
                   9114:                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";
                   9115:     } elsif ($numpathchg) {
                   9116:         my %pathchange = ();
                   9117:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9118:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9119:             $output .= '<p>'.&mt('or').'</p>'; 
                   9120:         } 
                   9121:     }
                   9122:     return ($output,$num,$numpathchg);
                   9123: }
                   9124: 
                   9125: sub embedded_file_element {
                   9126:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
                   9127:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9128:                    (ref($codebase) eq 'HASH'));
                   9129:     my $output;
                   9130:     if ($context eq 'upload_embedded') {
                   9131:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9132:     }
                   9133:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9134:                &escape($embed_file).'" />';
                   9135:     unless (($context eq 'upload_embedded') && 
                   9136:             ($mapping->{$embed_file} eq $embed_file)) {
                   9137:         $output .='
                   9138:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9139:     }
                   9140:     my $attrib;
                   9141:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9142:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9143:     }
                   9144:     $output .=
                   9145:         "\n\t\t".
                   9146:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9147:         $attrib.'" />';
                   9148:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9149:         $output .=
                   9150:             "\n\t\t".
                   9151:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9152:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9153:     }
1.987     raeburn  9154:     return $output;
1.660     raeburn  9155: }
                   9156: 
1.661     raeburn  9157: sub upload_embedded {
                   9158:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  9159:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   9160:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  9161:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   9162:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   9163:         my $orig_uploaded_filename =
                   9164:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  9165:         foreach my $type ('orig','ref','attrib','codebase') {
                   9166:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   9167:                 $env{'form.embedded_'.$type.'_'.$i} =
                   9168:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   9169:             }
                   9170:         }
1.661     raeburn  9171:         my ($path,$fname) =
                   9172:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   9173:         # no path, whole string is fname
                   9174:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   9175:         $fname = &Apache::lonnet::clean_filename($fname);
                   9176:         # See if there is anything left
                   9177:         next if ($fname eq '');
                   9178: 
                   9179:         # Check if file already exists as a file or directory.
                   9180:         my ($state,$msg);
                   9181:         if ($context eq 'portfolio') {
                   9182:             my $port_path = $dirpath;
                   9183:             if ($group ne '') {
                   9184:                 $port_path = "groups/$group/$port_path";
                   9185:             }
1.987     raeburn  9186:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   9187:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  9188:                                               $dir_root,$port_path,$disk_quota,
                   9189:                                               $current_disk_usage,$uname,$udom);
                   9190:             if ($state eq 'will_exceed_quota'
1.984     raeburn  9191:                 || $state eq 'file_locked') {
1.661     raeburn  9192:                 $output .= $msg;
                   9193:                 next;
                   9194:             }
                   9195:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   9196:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   9197:             if ($state eq 'exists') {
                   9198:                 $output .= $msg;
                   9199:                 next;
                   9200:             }
                   9201:         }
                   9202:         # Check if extension is valid
                   9203:         if (($fname =~ /\.(\w+)$/) &&
                   9204:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  9205:             $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  9206:             next;
                   9207:         } elsif (($fname =~ /\.(\w+)$/) &&
                   9208:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  9209:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  9210:             next;
                   9211:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  9212:             $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  9213:             next;
                   9214:         }
                   9215: 
                   9216:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   9217:         if ($context eq 'portfolio') {
1.984     raeburn  9218:             my $result;
                   9219:             if ($state eq 'existingfile') {
                   9220:                 $result=
                   9221:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  9222:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  9223:             } else {
1.984     raeburn  9224:                 $result=
                   9225:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  9226:                                                     $dirpath.
                   9227:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  9228:                 if ($result !~ m|^/uploaded/|) {
                   9229:                     $output .= '<span class="LC_error">'
                   9230:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   9231:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   9232:                                .'</span><br />';
                   9233:                     next;
                   9234:                 } else {
1.987     raeburn  9235:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9236:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  9237:                 }
1.661     raeburn  9238:             }
1.987     raeburn  9239:         } elsif ($context eq 'coursedoc') {
                   9240:             my $result =
                   9241:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   9242:                                                 $dirpath.'/'.$path);
                   9243:             if ($result !~ m|^/uploaded/|) {
                   9244:                 $output .= '<span class="LC_error">'
                   9245:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   9246:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   9247:                            .'</span><br />';
                   9248:                     next;
                   9249:             } else {
                   9250:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9251:                            $path.$fname.'</span>').'<br />';
                   9252:             }
1.661     raeburn  9253:         } else {
                   9254: # Save the file
                   9255:             my $target = $env{'form.embedded_item_'.$i};
                   9256:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   9257:             my $dest = $fullpath.$fname;
                   9258:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  9259:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  9260:             my $count;
                   9261:             my $filepath = $dir_root;
1.1027    raeburn  9262:             foreach my $subdir (@parts) {
                   9263:                 $filepath .= "/$subdir";
                   9264:                 if (!-e $filepath) {
1.661     raeburn  9265:                     mkdir($filepath,0770);
                   9266:                 }
                   9267:             }
                   9268:             my $fh;
                   9269:             if (!open($fh,'>'.$dest)) {
                   9270:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   9271:                 $output .= '<span class="LC_error">'.
                   9272:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   9273:                            '</span><br />';
                   9274:             } else {
                   9275:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   9276:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   9277:                     $output .= '<span class="LC_error">'.
                   9278:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   9279:                               '</span><br />';
                   9280:                 } else {
1.987     raeburn  9281:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9282:                                $url.'</span>').'<br />';
                   9283:                     unless ($context eq 'testbank') {
                   9284:                         $footer .= &mt('View embedded file: [_1]',
                   9285:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   9286:                     }
                   9287:                 }
                   9288:                 close($fh);
                   9289:             }
                   9290:         }
                   9291:         if ($env{'form.embedded_ref_'.$i}) {
                   9292:             $pathchange{$i} = 1;
                   9293:         }
                   9294:     }
                   9295:     if ($output) {
                   9296:         $output = '<p>'.$output.'</p>';
                   9297:     }
                   9298:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   9299:     $returnflag = 'ok';
                   9300:     if (keys(%pathchange) > 0) {
                   9301:         if ($context eq 'portfolio') {
                   9302:             $output .= '<p>'.&mt('or').'</p>';
                   9303:         } elsif ($context eq 'testbank') {
1.988     raeburn  9304:             $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  9305:             $returnflag = 'modify_orightml';
                   9306:         }
                   9307:     }
                   9308:     return ($output.$footer,$returnflag);
                   9309: }
                   9310: 
                   9311: sub modify_html_form {
                   9312:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   9313:     my $end = 0;
                   9314:     my $modifyform;
                   9315:     if ($context eq 'upload_embedded') {
                   9316:         return unless (ref($pathchange) eq 'HASH');
                   9317:         if ($env{'form.number_embedded_items'}) {
                   9318:             $end += $env{'form.number_embedded_items'};
                   9319:         }
                   9320:         if ($env{'form.number_pathchange_items'}) {
                   9321:             $end += $env{'form.number_pathchange_items'};
                   9322:         }
                   9323:         if ($end) {
                   9324:             for (my $i=0; $i<$end; $i++) {
                   9325:                 if ($i < $env{'form.number_embedded_items'}) {
                   9326:                     next unless($pathchange->{$i});
                   9327:                 }
                   9328:                 $modifyform .=
                   9329:                     &start_data_table_row().
                   9330:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   9331:                     'checked="checked" /></td>'.
                   9332:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   9333:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   9334:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   9335:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   9336:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   9337:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   9338:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   9339:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   9340:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   9341:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   9342:                     &end_data_table_row();
                   9343:             } 
                   9344:         }
                   9345:     } else {
                   9346:         $modifyform = $pathchgtable;
                   9347:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   9348:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   9349:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9350:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   9351:         }
                   9352:     }
                   9353:     if ($modifyform) {
                   9354:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   9355:                '<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".
                   9356:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   9357:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   9358:                '</ol></p>'."\n".'<p>'.
                   9359:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   9360:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   9361:                &start_data_table()."\n".
                   9362:                &start_data_table_header_row().
                   9363:                '<th>'.&mt('Change?').'</th>'.
                   9364:                '<th>'.&mt('Current reference').'</th>'.
                   9365:                '<th>'.&mt('Required reference').'</th>'.
                   9366:                &end_data_table_header_row()."\n".
                   9367:                $modifyform.
                   9368:                &end_data_table().'<br />'."\n".$hiddenstate.
                   9369:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   9370:                '</form>'."\n";
                   9371:     }
                   9372:     return;
                   9373: }
                   9374: 
                   9375: sub modify_html_refs {
                   9376:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   9377:     my $container;
                   9378:     if ($context eq 'portfolio') {
                   9379:         $container = $env{'form.container'};
                   9380:     } elsif ($context eq 'coursedoc') {
                   9381:         $container = $env{'form.primaryurl'};
                   9382:     } else {
1.1027    raeburn  9383:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  9384:     }
                   9385:     my (%allfiles,%codebase,$output,$content);
                   9386:     my @changes = &get_env_multiple('form.namechange');
                   9387:     return unless (@changes > 0);
                   9388:     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {
                   9389:         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});
                   9390:         $content = &Apache::lonnet::getfile($container);
                   9391:         return if ($content eq '-1');
                   9392:     } else {
                   9393:         return unless ($container =~ /^\Q$dir_root\E/); 
                   9394:         if (open(my $fh,"<$container")) {
                   9395:             $content = join('', <$fh>);
                   9396:             close($fh);
                   9397:         } else {
                   9398:             return;
                   9399:         }
                   9400:     }
                   9401:     my ($count,$codebasecount) = (0,0);
                   9402:     my $mm = new File::MMagic;
                   9403:     my $mime_type = $mm->checktype_contents($content);
                   9404:     if ($mime_type eq 'text/html') {
                   9405:         my $parse_result = 
                   9406:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   9407:                                                     \%codebase,\$content);
                   9408:         if ($parse_result eq 'ok') {
                   9409:             foreach my $i (@changes) {
                   9410:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   9411:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   9412:                 if ($allfiles{$ref}) {
                   9413:                     my $newname =  $orig;
                   9414:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  9415:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  9416:                     if ($attrib_regexp =~ /:/) {
                   9417:                         $attrib_regexp =~ s/\:/|/g;
                   9418:                     }
                   9419:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   9420:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   9421:                         $count += $numchg;
                   9422:                     }
                   9423:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  9424:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  9425:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   9426:                         $codebasecount ++;
                   9427:                     }
                   9428:                 }
                   9429:             }
                   9430:             if ($count || $codebasecount) {
                   9431:                 my $saveresult;
                   9432:                 if ($context eq 'portfolio' || $context eq 'coursedoc') {
                   9433:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   9434:                     if ($url eq $container) {
                   9435:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   9436:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9437:                                             $count,'<span class="LC_filename">'.
                   9438:                                             $fname.'</span>').'</p>'; 
                   9439:                     } else {
                   9440:                          $output = '<p class="LC_error">'.
                   9441:                                    &mt('Error: update failed for: [_1].',
                   9442:                                    '<span class="LC_filename">'.
                   9443:                                    $container.'</span>').'</p>';
                   9444:                     }
                   9445:                 } else {
                   9446:                     if (open(my $fh,">$container")) {
                   9447:                         print $fh $content;
                   9448:                         close($fh);
                   9449:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9450:                                   $count,'<span class="LC_filename">'.
                   9451:                                   $container.'</span>').'</p>';
1.661     raeburn  9452:                     } else {
1.987     raeburn  9453:                          $output = '<p class="LC_error">'.
                   9454:                                    &mt('Error: could not update [_1].',
                   9455:                                    '<span class="LC_filename">'.
                   9456:                                    $container.'</span>').'</p>';
1.661     raeburn  9457:                     }
                   9458:                 }
                   9459:             }
1.987     raeburn  9460:         } else {
                   9461:             &logthis('Failed to parse '.$container.
                   9462:                      ' to modify references: '.$parse_result);
1.661     raeburn  9463:         }
                   9464:     }
                   9465:     return $output;
                   9466: }
                   9467: 
                   9468: sub check_for_existing {
                   9469:     my ($path,$fname,$element) = @_;
                   9470:     my ($state,$msg);
                   9471:     if (-d $path.'/'.$fname) {
                   9472:         $state = 'exists';
                   9473:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   9474:     } elsif (-e $path.'/'.$fname) {
                   9475:         $state = 'exists';
                   9476:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   9477:     }
                   9478:     if ($state eq 'exists') {
                   9479:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   9480:     }
                   9481:     return ($state,$msg);
                   9482: }
                   9483: 
                   9484: sub check_for_upload {
                   9485:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   9486:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  9487:     my $filesize = length($env{'form.'.$element});
                   9488:     if (!$filesize) {
                   9489:         my $msg = '<span class="LC_error">'.
                   9490:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   9491:                       '<span class="LC_filename">'.$fname.'</span>',
                   9492:                       $filesize).'<br />'.
1.1007    raeburn  9493:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  9494:                   '</span>';
                   9495:         return ('zero_bytes',$msg);
                   9496:     }
                   9497:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  9498:     my $getpropath = 1;
1.1021    raeburn  9499:     my ($dirlistref,$listerror) =
                   9500:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  9501:     my $found_file = 0;
                   9502:     my $locked_file = 0;
1.991     raeburn  9503:     my @lockers;
                   9504:     my $navmap;
                   9505:     if ($env{'request.course.id'}) {
                   9506:         $navmap = Apache::lonnavmaps::navmap->new();
                   9507:     }
1.1021    raeburn  9508:     if (ref($dirlistref) eq 'ARRAY') {
                   9509:         foreach my $line (@{$dirlistref}) {
                   9510:             my ($file_name,$rest)=split(/\&/,$line,2);
                   9511:             if ($file_name eq $fname){
                   9512:                 $file_name = $path.$file_name;
                   9513:                 if ($group ne '') {
                   9514:                     $file_name = $group.$file_name;
                   9515:                 }
                   9516:                 $found_file = 1;
                   9517:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   9518:                     foreach my $lock (@lockers) {
                   9519:                         if (ref($lock) eq 'ARRAY') {
                   9520:                             my ($symb,$crsid) = @{$lock};
                   9521:                             if ($crsid eq $env{'request.course.id'}) {
                   9522:                                 if (ref($navmap)) {
                   9523:                                     my $res = $navmap->getBySymb($symb);
                   9524:                                     foreach my $part (@{$res->parts()}) { 
                   9525:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   9526:                                         unless (($slot_status == $res->RESERVED) ||
                   9527:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   9528:                                             $locked_file = 1;
                   9529:                                         }
1.991     raeburn  9530:                                     }
1.1021    raeburn  9531:                                 } else {
                   9532:                                     $locked_file = 1;
1.991     raeburn  9533:                                 }
                   9534:                             } else {
                   9535:                                 $locked_file = 1;
                   9536:                             }
                   9537:                         }
1.1021    raeburn  9538:                    }
                   9539:                 } else {
                   9540:                     my @info = split(/\&/,$rest);
                   9541:                     my $currsize = $info[6]/1000;
                   9542:                     if ($currsize < $filesize) {
                   9543:                         my $extra = $filesize - $currsize;
                   9544:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   9545:                             my $msg = '<span class="LC_error">'.
                   9546:                                       &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.',
                   9547:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   9548:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   9549:                                                    $disk_quota,$current_disk_usage);
                   9550:                             return ('will_exceed_quota',$msg);
                   9551:                         }
1.984     raeburn  9552:                     }
                   9553:                 }
1.661     raeburn  9554:             }
                   9555:         }
                   9556:     }
                   9557:     if (($current_disk_usage + $filesize) > $disk_quota){
                   9558:         my $msg = '<span class="LC_error">'.
                   9559:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   9560:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   9561:         return ('will_exceed_quota',$msg);
                   9562:     } elsif ($found_file) {
                   9563:         if ($locked_file) {
                   9564:             my $msg = '<span class="LC_error">';
                   9565:             $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>');
                   9566:             $msg .= '</span><br />';
                   9567:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   9568:             return ('file_locked',$msg);
                   9569:         } else {
                   9570:             my $msg = '<span class="LC_error">';
1.984     raeburn  9571:             $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  9572:             $msg .= '</span>';
1.984     raeburn  9573:             return ('existingfile',$msg);
1.661     raeburn  9574:         }
                   9575:     }
                   9576: }
                   9577: 
1.987     raeburn  9578: sub check_for_traversal {
                   9579:     my ($path,$url,$toplevel) = @_;
                   9580:     my @parts=split(/\//,$path);
                   9581:     my $cleanpath;
                   9582:     my $fullpath = $url;
                   9583:     for (my $i=0;$i<@parts;$i++) {
                   9584:         next if ($parts[$i] eq '.');
                   9585:         if ($parts[$i] eq '..') {
                   9586:             $fullpath =~ s{([^/]+/)$}{};
                   9587:         } else {
                   9588:             $fullpath .= $parts[$i].'/';
                   9589:         }
                   9590:     }
                   9591:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   9592:         $cleanpath = $1;
                   9593:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   9594:         my $curr_toprel = $1;
                   9595:         my @parts = split(/\//,$curr_toprel);
                   9596:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   9597:         my @urlparts = split(/\//,$url_toprel);
                   9598:         my $doubledots;
                   9599:         my $startdiff = -1;
                   9600:         for (my $i=0; $i<@urlparts; $i++) {
                   9601:             if ($startdiff == -1) {
                   9602:                 unless ($urlparts[$i] eq $parts[$i]) {
                   9603:                     $startdiff = $i;
                   9604:                     $doubledots .= '../';
                   9605:                 }
                   9606:             } else {
                   9607:                 $doubledots .= '../';
                   9608:             }
                   9609:         }
                   9610:         if ($startdiff > -1) {
                   9611:             $cleanpath = $doubledots;
                   9612:             for (my $i=$startdiff; $i<@parts; $i++) {
                   9613:                 $cleanpath .= $parts[$i].'/';
                   9614:             }
                   9615:         }
                   9616:     }
                   9617:     $cleanpath =~ s{(/)$}{};
                   9618:     return $cleanpath;
                   9619: }
1.31      albertel 9620: 
1.41      ng       9621: =pod
1.45      matthew  9622: 
1.1015    raeburn  9623: =item * &get_turnedin_filepath()
                   9624: 
                   9625: Determines path in a user's portfolio file for storage of files uploaded
                   9626: to a specific essayresponse or dropbox item.
                   9627: 
                   9628: Inputs: 3 required + 1 optional.
                   9629: $symb is symb for resource, $uname and $udom are for current user (required).
                   9630: $caller is optional (can be "submission", if routine is called when storing
                   9631: an upoaded file when "Submit Answer" button was pressed).
                   9632: 
                   9633: Returns array containing $path and $multiresp. 
                   9634: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   9635: than one file upload item.  Callers of routine should append partid as a 
                   9636: subdirectory to $path in cases where $multiresp is 1.
                   9637: 
                   9638: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   9639: 
                   9640: =cut
                   9641: 
                   9642: sub get_turnedin_filepath {
                   9643:     my ($symb,$uname,$udom,$caller) = @_;
                   9644:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   9645:     my $turnindir;
                   9646:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   9647:     $turnindir = $userhash{'turnindir'};
                   9648:     my ($path,$multiresp);
                   9649:     if ($turnindir eq '') {
                   9650:         if ($caller eq 'submission') {
                   9651:             $turnindir = &mt('turned in');
                   9652:             $turnindir =~ s/\W+/_/g;
                   9653:             my %newhash = (
                   9654:                             'turnindir' => $turnindir,
                   9655:                           );
                   9656:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   9657:         }
                   9658:     }
                   9659:     if ($turnindir ne '') {
                   9660:         $path = '/'.$turnindir.'/';
                   9661:         my ($multipart,$turnin,@pathitems);
                   9662:         my $navmap = Apache::lonnavmaps::navmap->new();
                   9663:         if (defined($navmap)) {
                   9664:             my $mapres = $navmap->getResourceByUrl($map);
                   9665:             if (ref($mapres)) {
                   9666:                 my $pcslist = $mapres->map_hierarchy();
                   9667:                 if ($pcslist ne '') {
                   9668:                     foreach my $pc (split(/,/,$pcslist)) {
                   9669:                         my $res = $navmap->getByMapPc($pc);
                   9670:                         if (ref($res)) {
                   9671:                             my $title = $res->compTitle();
                   9672:                             $title =~ s/\W+/_/g;
                   9673:                             if ($title ne '') {
                   9674:                                 push(@pathitems,$title);
                   9675:                             }
                   9676:                         }
                   9677:                     }
                   9678:                 }
                   9679:                 my $maptitle = $mapres->compTitle();
                   9680:                 $maptitle =~ s/\W+/_/g;
                   9681:                 if ($maptitle ne '') {
                   9682:                     push(@pathitems,$maptitle);
                   9683:                 }
                   9684:                 unless ($env{'request.state'} eq 'construct') {
                   9685:                     my $res = $navmap->getBySymb($symb);
                   9686:                     if (ref($res)) {
                   9687:                         my $partlist = $res->parts();
                   9688:                         my $totaluploads = 0;
                   9689:                         if (ref($partlist) eq 'ARRAY') {
                   9690:                             foreach my $part (@{$partlist}) {
                   9691:                                 my @types = $res->responseType($part);
                   9692:                                 my @ids = $res->responseIds($part);
                   9693:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   9694:                                     if ($types[$i] eq 'essay') {
                   9695:                                         my $partid = $part.'_'.$ids[$i];
                   9696:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   9697:                                             $totaluploads ++;
                   9698:                                         }
                   9699:                                     }
                   9700:                                 }
                   9701:                             }
                   9702:                             if ($totaluploads > 1) {
                   9703:                                 $multiresp = 1;
                   9704:                             }
                   9705:                         }
                   9706:                     }
                   9707:                 }
                   9708:             } else {
                   9709:                 return;
                   9710:             }
                   9711:         } else {
                   9712:             return;
                   9713:         }
                   9714:         my $restitle=&Apache::lonnet::gettitle($symb);
                   9715:         $restitle =~ s/\W+/_/g;
                   9716:         if ($restitle eq '') {
                   9717:             $restitle = ($resurl =~ m{/[^/]+$});
                   9718:             if ($restitle eq '') {
                   9719:                 $restitle = time;
                   9720:             }
                   9721:         }
                   9722:         push(@pathitems,$restitle);
                   9723:         $path .= join('/',@pathitems);
                   9724:     }
                   9725:     return ($path,$multiresp);
                   9726: }
                   9727: 
                   9728: =pod
                   9729: 
1.464     albertel 9730: =back
1.41      ng       9731: 
1.112     bowersj2 9732: =head1 CSV Upload/Handling functions
1.38      albertel 9733: 
1.41      ng       9734: =over 4
                   9735: 
1.648     raeburn  9736: =item * &upfile_store($r)
1.41      ng       9737: 
                   9738: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 9739: needs $env{'form.upfile'}
1.41      ng       9740: returns $datatoken to be put into hidden field
                   9741: 
                   9742: =cut
1.31      albertel 9743: 
                   9744: sub upfile_store {
                   9745:     my $r=shift;
1.258     albertel 9746:     $env{'form.upfile'}=~s/\r/\n/gs;
                   9747:     $env{'form.upfile'}=~s/\f/\n/gs;
                   9748:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   9749:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 9750: 
1.258     albertel 9751:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   9752: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 9753:     {
1.158     raeburn  9754:         my $datafile = $r->dir_config('lonDaemons').
                   9755:                            '/tmp/'.$datatoken.'.tmp';
                   9756:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 9757:             print $fh $env{'form.upfile'};
1.158     raeburn  9758:             close($fh);
                   9759:         }
1.31      albertel 9760:     }
                   9761:     return $datatoken;
                   9762: }
                   9763: 
1.56      matthew  9764: =pod
                   9765: 
1.648     raeburn  9766: =item * &load_tmp_file($r)
1.41      ng       9767: 
                   9768: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 9769: needs $env{'form.datatoken'},
                   9770: sets $env{'form.upfile'} to the contents of the file
1.41      ng       9771: 
                   9772: =cut
1.31      albertel 9773: 
                   9774: sub load_tmp_file {
                   9775:     my $r=shift;
                   9776:     my @studentdata=();
                   9777:     {
1.158     raeburn  9778:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 9779:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  9780:         if ( open(my $fh,"<$studentfile") ) {
                   9781:             @studentdata=<$fh>;
                   9782:             close($fh);
                   9783:         }
1.31      albertel 9784:     }
1.258     albertel 9785:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 9786: }
                   9787: 
1.56      matthew  9788: =pod
                   9789: 
1.648     raeburn  9790: =item * &upfile_record_sep()
1.41      ng       9791: 
                   9792: Separate uploaded file into records
                   9793: returns array of records,
1.258     albertel 9794: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       9795: 
                   9796: =cut
1.31      albertel 9797: 
                   9798: sub upfile_record_sep {
1.258     albertel 9799:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 9800:     } else {
1.248     albertel 9801: 	my @records;
1.258     albertel 9802: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 9803: 	    if ($line=~/^\s*$/) { next; }
                   9804: 	    push(@records,$line);
                   9805: 	}
                   9806: 	return @records;
1.31      albertel 9807:     }
                   9808: }
                   9809: 
1.56      matthew  9810: =pod
                   9811: 
1.648     raeburn  9812: =item * &record_sep($record)
1.41      ng       9813: 
1.258     albertel 9814: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       9815: 
                   9816: =cut
                   9817: 
1.263     www      9818: sub takeleft {
                   9819:     my $index=shift;
                   9820:     return substr('0000'.$index,-4,4);
                   9821: }
                   9822: 
1.31      albertel 9823: sub record_sep {
                   9824:     my $record=shift;
                   9825:     my %components=();
1.258     albertel 9826:     if ($env{'form.upfiletype'} eq 'xml') {
                   9827:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 9828:         my $i=0;
1.356     albertel 9829:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 9830:             $field=~s/^(\"|\')//;
                   9831:             $field=~s/(\"|\')$//;
1.263     www      9832:             $components{&takeleft($i)}=$field;
1.31      albertel 9833:             $i++;
                   9834:         }
1.258     albertel 9835:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 9836:         my $i=0;
1.356     albertel 9837:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 9838:             $field=~s/^(\"|\')//;
                   9839:             $field=~s/(\"|\')$//;
1.263     www      9840:             $components{&takeleft($i)}=$field;
1.31      albertel 9841:             $i++;
                   9842:         }
                   9843:     } else {
1.561     www      9844:         my $separator=',';
1.480     banghart 9845:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      9846:             $separator=';';
1.480     banghart 9847:         }
1.31      albertel 9848:         my $i=0;
1.561     www      9849: # the character we are looking for to indicate the end of a quote or a record 
                   9850:         my $looking_for=$separator;
                   9851: # do not add the characters to the fields
                   9852:         my $ignore=0;
                   9853: # we just encountered a separator (or the beginning of the record)
                   9854:         my $just_found_separator=1;
                   9855: # store the field we are working on here
                   9856:         my $field='';
                   9857: # work our way through all characters in record
                   9858:         foreach my $character ($record=~/(.)/g) {
                   9859:             if ($character eq $looking_for) {
                   9860:                if ($character ne $separator) {
                   9861: # Found the end of a quote, again looking for separator
                   9862:                   $looking_for=$separator;
                   9863:                   $ignore=1;
                   9864:                } else {
                   9865: # Found a separator, store away what we got
                   9866:                   $components{&takeleft($i)}=$field;
                   9867: 	          $i++;
                   9868:                   $just_found_separator=1;
                   9869:                   $ignore=0;
                   9870:                   $field='';
                   9871:                }
                   9872:                next;
                   9873:             }
                   9874: # single or double quotation marks after a separator indicate beginning of a quote
                   9875: # we are now looking for the end of the quote and need to ignore separators
                   9876:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   9877:                $looking_for=$character;
                   9878:                next;
                   9879:             }
                   9880: # ignore would be true after we reached the end of a quote
                   9881:             if ($ignore) { next; }
                   9882:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   9883:             $field.=$character;
                   9884:             $just_found_separator=0; 
1.31      albertel 9885:         }
1.561     www      9886: # catch the very last entry, since we never encountered the separator
                   9887:         $components{&takeleft($i)}=$field;
1.31      albertel 9888:     }
                   9889:     return %components;
                   9890: }
                   9891: 
1.144     matthew  9892: ######################################################
                   9893: ######################################################
                   9894: 
1.56      matthew  9895: =pod
                   9896: 
1.648     raeburn  9897: =item * &upfile_select_html()
1.41      ng       9898: 
1.144     matthew  9899: Return HTML code to select a file from the users machine and specify 
                   9900: the file type.
1.41      ng       9901: 
                   9902: =cut
                   9903: 
1.144     matthew  9904: ######################################################
                   9905: ######################################################
1.31      albertel 9906: sub upfile_select_html {
1.144     matthew  9907:     my %Types = (
                   9908:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 9909:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  9910:                  space => &mt('Space separated'),
                   9911:                  tab   => &mt('Tabulator separated'),
                   9912: #                 xml   => &mt('HTML/XML'),
                   9913:                  );
                   9914:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  9915:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  9916:     foreach my $type (sort(keys(%Types))) {
                   9917:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   9918:     }
                   9919:     $Str .= "</select>\n";
                   9920:     return $Str;
1.31      albertel 9921: }
                   9922: 
1.301     albertel 9923: sub get_samples {
                   9924:     my ($records,$toget) = @_;
                   9925:     my @samples=({});
                   9926:     my $got=0;
                   9927:     foreach my $rec (@$records) {
                   9928: 	my %temp = &record_sep($rec);
                   9929: 	if (! grep(/\S/, values(%temp))) { next; }
                   9930: 	if (%temp) {
                   9931: 	    $samples[$got]=\%temp;
                   9932: 	    $got++;
                   9933: 	    if ($got == $toget) { last; }
                   9934: 	}
                   9935:     }
                   9936:     return \@samples;
                   9937: }
                   9938: 
1.144     matthew  9939: ######################################################
                   9940: ######################################################
                   9941: 
1.56      matthew  9942: =pod
                   9943: 
1.648     raeburn  9944: =item * &csv_print_samples($r,$records)
1.41      ng       9945: 
                   9946: Prints a table of sample values from each column uploaded $r is an
                   9947: Apache Request ref, $records is an arrayref from
                   9948: &Apache::loncommon::upfile_record_sep
                   9949: 
                   9950: =cut
                   9951: 
1.144     matthew  9952: ######################################################
                   9953: ######################################################
1.31      albertel 9954: sub csv_print_samples {
                   9955:     my ($r,$records) = @_;
1.662     bisitz   9956:     my $samples = &get_samples($records,5);
1.301     albertel 9957: 
1.594     raeburn  9958:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   9959:               &start_data_table_header_row());
1.356     albertel 9960:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   9961:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  9962:     $r->print(&end_data_table_header_row());
1.301     albertel 9963:     foreach my $hash (@$samples) {
1.594     raeburn  9964: 	$r->print(&start_data_table_row());
1.356     albertel 9965: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 9966: 	    $r->print('<td>');
1.356     albertel 9967: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 9968: 	    $r->print('</td>');
                   9969: 	}
1.594     raeburn  9970: 	$r->print(&end_data_table_row());
1.31      albertel 9971:     }
1.594     raeburn  9972:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 9973: }
                   9974: 
1.144     matthew  9975: ######################################################
                   9976: ######################################################
                   9977: 
1.56      matthew  9978: =pod
                   9979: 
1.648     raeburn  9980: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       9981: 
                   9982: Prints a table to create associations between values and table columns.
1.144     matthew  9983: 
1.41      ng       9984: $r is an Apache Request ref,
                   9985: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  9986: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       9987: 
                   9988: =cut
                   9989: 
1.144     matthew  9990: ######################################################
                   9991: ######################################################
1.31      albertel 9992: sub csv_print_select_table {
                   9993:     my ($r,$records,$d) = @_;
1.301     albertel 9994:     my $i=0;
                   9995:     my $samples = &get_samples($records,1);
1.144     matthew  9996:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  9997: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  9998:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  9999:               '<th>'.&mt('Column').'</th>'.
                   10000:               &end_data_table_header_row()."\n");
1.356     albertel 10001:     foreach my $array_ref (@$d) {
                   10002: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  10003: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 10004: 
1.875     bisitz   10005: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  10006: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 10007: 	$r->print('<option value="none"></option>');
1.356     albertel 10008: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   10009: 	    $r->print('<option value="'.$sample.'"'.
                   10010:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   10011:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 10012: 	}
1.594     raeburn  10013: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 10014: 	$i++;
                   10015:     }
1.594     raeburn  10016:     $r->print(&end_data_table());
1.31      albertel 10017:     $i--;
                   10018:     return $i;
                   10019: }
1.56      matthew  10020: 
1.144     matthew  10021: ######################################################
                   10022: ######################################################
                   10023: 
1.56      matthew  10024: =pod
1.31      albertel 10025: 
1.648     raeburn  10026: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       10027: 
                   10028: Prints a table of sample values from the upload and can make associate samples to internal names.
                   10029: 
                   10030: $r is an Apache Request ref,
                   10031: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   10032: $d is an array of 2 element arrays (internal name, displayed name)
                   10033: 
                   10034: =cut
                   10035: 
1.144     matthew  10036: ######################################################
                   10037: ######################################################
1.31      albertel 10038: sub csv_samples_select_table {
                   10039:     my ($r,$records,$d) = @_;
                   10040:     my $i=0;
1.144     matthew  10041:     #
1.662     bisitz   10042:     my $max_samples = 5;
                   10043:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  10044:     $r->print(&start_data_table().
                   10045:               &start_data_table_header_row().'<th>'.
                   10046:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   10047:               &end_data_table_header_row());
1.301     albertel 10048: 
                   10049:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  10050: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  10051: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 10052: 	foreach my $option (@$d) {
                   10053: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  10054: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 10055:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  10056:                       $display.'</option>');
1.31      albertel 10057: 	}
                   10058: 	$r->print('</select></td><td>');
1.662     bisitz   10059: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 10060: 	    if (defined($samples->[$line]{$key})) { 
                   10061: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   10062: 	    }
                   10063: 	}
1.594     raeburn  10064: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 10065: 	$i++;
                   10066:     }
1.594     raeburn  10067:     $r->print(&end_data_table());
1.31      albertel 10068:     $i--;
                   10069:     return($i);
1.115     matthew  10070: }
                   10071: 
1.144     matthew  10072: ######################################################
                   10073: ######################################################
                   10074: 
1.115     matthew  10075: =pod
                   10076: 
1.648     raeburn  10077: =item * &clean_excel_name($name)
1.115     matthew  10078: 
                   10079: Returns a replacement for $name which does not contain any illegal characters.
                   10080: 
                   10081: =cut
                   10082: 
1.144     matthew  10083: ######################################################
                   10084: ######################################################
1.115     matthew  10085: sub clean_excel_name {
                   10086:     my ($name) = @_;
                   10087:     $name =~ s/[:\*\?\/\\]//g;
                   10088:     if (length($name) > 31) {
                   10089:         $name = substr($name,0,31);
                   10090:     }
                   10091:     return $name;
1.25      albertel 10092: }
1.84      albertel 10093: 
1.85      albertel 10094: =pod
                   10095: 
1.648     raeburn  10096: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 10097: 
                   10098: Returns either 1 or undef
                   10099: 
                   10100: 1 if the part is to be hidden, undef if it is to be shown
                   10101: 
                   10102: Arguments are:
                   10103: 
                   10104: $id the id of the part to be checked
                   10105: $symb, optional the symb of the resource to check
                   10106: $udom, optional the domain of the user to check for
                   10107: $uname, optional the username of the user to check for
                   10108: 
                   10109: =cut
1.84      albertel 10110: 
                   10111: sub check_if_partid_hidden {
                   10112:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 10113:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 10114: 					 $symb,$udom,$uname);
1.141     albertel 10115:     my $truth=1;
                   10116:     #if the string starts with !, then the list is the list to show not hide
                   10117:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 10118:     my @hiddenlist=split(/,/,$hiddenparts);
                   10119:     foreach my $checkid (@hiddenlist) {
1.141     albertel 10120: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 10121:     }
1.141     albertel 10122:     return !$truth;
1.84      albertel 10123: }
1.127     matthew  10124: 
1.138     matthew  10125: 
                   10126: ############################################################
                   10127: ############################################################
                   10128: 
                   10129: =pod
                   10130: 
1.157     matthew  10131: =back 
                   10132: 
1.138     matthew  10133: =head1 cgi-bin script and graphing routines
                   10134: 
1.157     matthew  10135: =over 4
                   10136: 
1.648     raeburn  10137: =item * &get_cgi_id()
1.138     matthew  10138: 
                   10139: Inputs: none
                   10140: 
                   10141: Returns an id which can be used to pass environment variables
                   10142: to various cgi-bin scripts.  These environment variables will
                   10143: be removed from the users environment after a given time by
                   10144: the routine &Apache::lonnet::transfer_profile_to_env.
                   10145: 
                   10146: =cut
                   10147: 
                   10148: ############################################################
                   10149: ############################################################
1.152     albertel 10150: my $uniq=0;
1.136     matthew  10151: sub get_cgi_id {
1.154     albertel 10152:     $uniq=($uniq+1)%100000;
1.280     albertel 10153:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  10154: }
                   10155: 
1.127     matthew  10156: ############################################################
                   10157: ############################################################
                   10158: 
                   10159: =pod
                   10160: 
1.648     raeburn  10161: =item * &DrawBarGraph()
1.127     matthew  10162: 
1.138     matthew  10163: Facilitates the plotting of data in a (stacked) bar graph.
                   10164: Puts plot definition data into the users environment in order for 
                   10165: graph.png to plot it.  Returns an <img> tag for the plot.
                   10166: The bars on the plot are labeled '1','2',...,'n'.
                   10167: 
                   10168: Inputs:
                   10169: 
                   10170: =over 4
                   10171: 
                   10172: =item $Title: string, the title of the plot
                   10173: 
                   10174: =item $xlabel: string, text describing the X-axis of the plot
                   10175: 
                   10176: =item $ylabel: string, text describing the Y-axis of the plot
                   10177: 
                   10178: =item $Max: scalar, the maximum Y value to use in the plot
                   10179: If $Max is < any data point, the graph will not be rendered.
                   10180: 
1.140     matthew  10181: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  10182: they are plotted.  If undefined, default values will be used.
                   10183: 
1.178     matthew  10184: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   10185: 
1.138     matthew  10186: =item @Values: An array of array references.  Each array reference holds data
                   10187: to be plotted in a stacked bar chart.
                   10188: 
1.239     matthew  10189: =item If the final element of @Values is a hash reference the key/value
                   10190: pairs will be added to the graph definition.
                   10191: 
1.138     matthew  10192: =back
                   10193: 
                   10194: Returns:
                   10195: 
                   10196: An <img> tag which references graph.png and the appropriate identifying
                   10197: information for the plot.
                   10198: 
1.127     matthew  10199: =cut
                   10200: 
                   10201: ############################################################
                   10202: ############################################################
1.134     matthew  10203: sub DrawBarGraph {
1.178     matthew  10204:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  10205:     #
                   10206:     if (! defined($colors)) {
                   10207:         $colors = ['#33ff00', 
                   10208:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   10209:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   10210:                   ]; 
                   10211:     }
1.228     matthew  10212:     my $extra_settings = {};
                   10213:     if (ref($Values[-1]) eq 'HASH') {
                   10214:         $extra_settings = pop(@Values);
                   10215:     }
1.127     matthew  10216:     #
1.136     matthew  10217:     my $identifier = &get_cgi_id();
                   10218:     my $id = 'cgi.'.$identifier;        
1.129     matthew  10219:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  10220:         return '';
                   10221:     }
1.225     matthew  10222:     #
                   10223:     my @Labels;
                   10224:     if (defined($labels)) {
                   10225:         @Labels = @$labels;
                   10226:     } else {
                   10227:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   10228:             push (@Labels,$i+1);
                   10229:         }
                   10230:     }
                   10231:     #
1.129     matthew  10232:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  10233:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  10234:     my %ValuesHash;
                   10235:     my $NumSets=1;
                   10236:     foreach my $array (@Values) {
                   10237:         next if (! ref($array));
1.136     matthew  10238:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  10239:             join(',',@$array);
1.129     matthew  10240:     }
1.127     matthew  10241:     #
1.136     matthew  10242:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  10243:     if ($NumBars < 3) {
                   10244:         $width = 120+$NumBars*32;
1.220     matthew  10245:         $xskip = 1;
1.225     matthew  10246:         $bar_width = 30;
                   10247:     } elsif ($NumBars < 5) {
                   10248:         $width = 120+$NumBars*20;
                   10249:         $xskip = 1;
                   10250:         $bar_width = 20;
1.220     matthew  10251:     } elsif ($NumBars < 10) {
1.136     matthew  10252:         $width = 120+$NumBars*15;
                   10253:         $xskip = 1;
                   10254:         $bar_width = 15;
                   10255:     } elsif ($NumBars <= 25) {
                   10256:         $width = 120+$NumBars*11;
                   10257:         $xskip = 5;
                   10258:         $bar_width = 8;
                   10259:     } elsif ($NumBars <= 50) {
                   10260:         $width = 120+$NumBars*8;
                   10261:         $xskip = 5;
                   10262:         $bar_width = 4;
                   10263:     } else {
                   10264:         $width = 120+$NumBars*8;
                   10265:         $xskip = 5;
                   10266:         $bar_width = 4;
                   10267:     }
                   10268:     #
1.137     matthew  10269:     $Max = 1 if ($Max < 1);
                   10270:     if ( int($Max) < $Max ) {
                   10271:         $Max++;
                   10272:         $Max = int($Max);
                   10273:     }
1.127     matthew  10274:     $Title  = '' if (! defined($Title));
                   10275:     $xlabel = '' if (! defined($xlabel));
                   10276:     $ylabel = '' if (! defined($ylabel));
1.369     www      10277:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   10278:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   10279:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  10280:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  10281:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   10282:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   10283:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   10284:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10285:     $ValuesHash{$id.'.height'}   = $height;
                   10286:     $ValuesHash{$id.'.width'}    = $width;
                   10287:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   10288:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   10289:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  10290:     #
1.228     matthew  10291:     # Deal with other parameters
                   10292:     while (my ($key,$value) = each(%$extra_settings)) {
                   10293:         $ValuesHash{$id.'.'.$key} = $value;
                   10294:     }
                   10295:     #
1.646     raeburn  10296:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  10297:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   10298: }
                   10299: 
                   10300: ############################################################
                   10301: ############################################################
                   10302: 
                   10303: =pod
                   10304: 
1.648     raeburn  10305: =item * &DrawXYGraph()
1.137     matthew  10306: 
1.138     matthew  10307: Facilitates the plotting of data in an XY graph.
                   10308: Puts plot definition data into the users environment in order for 
                   10309: graph.png to plot it.  Returns an <img> tag for the plot.
                   10310: 
                   10311: Inputs:
                   10312: 
                   10313: =over 4
                   10314: 
                   10315: =item $Title: string, the title of the plot
                   10316: 
                   10317: =item $xlabel: string, text describing the X-axis of the plot
                   10318: 
                   10319: =item $ylabel: string, text describing the Y-axis of the plot
                   10320: 
                   10321: =item $Max: scalar, the maximum Y value to use in the plot
                   10322: If $Max is < any data point, the graph will not be rendered.
                   10323: 
                   10324: =item $colors: Array ref containing the hex color codes for the data to be 
                   10325: plotted in.  If undefined, default values will be used.
                   10326: 
                   10327: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   10328: 
                   10329: =item $Ydata: Array ref containing Array refs.  
1.185     www      10330: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  10331: 
                   10332: =item %Values: hash indicating or overriding any default values which are 
                   10333: passed to graph.png.  
                   10334: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   10335: 
                   10336: =back
                   10337: 
                   10338: Returns:
                   10339: 
                   10340: An <img> tag which references graph.png and the appropriate identifying
                   10341: information for the plot.
                   10342: 
1.137     matthew  10343: =cut
                   10344: 
                   10345: ############################################################
                   10346: ############################################################
                   10347: sub DrawXYGraph {
                   10348:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   10349:     #
                   10350:     # Create the identifier for the graph
                   10351:     my $identifier = &get_cgi_id();
                   10352:     my $id = 'cgi.'.$identifier;
                   10353:     #
                   10354:     $Title  = '' if (! defined($Title));
                   10355:     $xlabel = '' if (! defined($xlabel));
                   10356:     $ylabel = '' if (! defined($ylabel));
                   10357:     my %ValuesHash = 
                   10358:         (
1.369     www      10359:          $id.'.title'  => &escape($Title),
                   10360:          $id.'.xlabel' => &escape($xlabel),
                   10361:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  10362:          $id.'.y_max_value'=> $Max,
                   10363:          $id.'.labels'     => join(',',@$Xlabels),
                   10364:          $id.'.PlotType'   => 'XY',
                   10365:          );
                   10366:     #
                   10367:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   10368:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10369:     }
                   10370:     #
                   10371:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   10372:         return '';
                   10373:     }
                   10374:     my $NumSets=1;
1.138     matthew  10375:     foreach my $array (@{$Ydata}){
1.137     matthew  10376:         next if (! ref($array));
                   10377:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   10378:     }
1.138     matthew  10379:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  10380:     #
                   10381:     # Deal with other parameters
                   10382:     while (my ($key,$value) = each(%Values)) {
                   10383:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  10384:     }
                   10385:     #
1.646     raeburn  10386:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  10387:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   10388: }
                   10389: 
                   10390: ############################################################
                   10391: ############################################################
                   10392: 
                   10393: =pod
                   10394: 
1.648     raeburn  10395: =item * &DrawXYYGraph()
1.138     matthew  10396: 
                   10397: Facilitates the plotting of data in an XY graph with two Y axes.
                   10398: Puts plot definition data into the users environment in order for 
                   10399: graph.png to plot it.  Returns an <img> tag for the plot.
                   10400: 
                   10401: Inputs:
                   10402: 
                   10403: =over 4
                   10404: 
                   10405: =item $Title: string, the title of the plot
                   10406: 
                   10407: =item $xlabel: string, text describing the X-axis of the plot
                   10408: 
                   10409: =item $ylabel: string, text describing the Y-axis of the plot
                   10410: 
                   10411: =item $colors: Array ref containing the hex color codes for the data to be 
                   10412: plotted in.  If undefined, default values will be used.
                   10413: 
                   10414: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   10415: 
                   10416: =item $Ydata1: The first data set
                   10417: 
                   10418: =item $Min1: The minimum value of the left Y-axis
                   10419: 
                   10420: =item $Max1: The maximum value of the left Y-axis
                   10421: 
                   10422: =item $Ydata2: The second data set
                   10423: 
                   10424: =item $Min2: The minimum value of the right Y-axis
                   10425: 
                   10426: =item $Max2: The maximum value of the left Y-axis
                   10427: 
                   10428: =item %Values: hash indicating or overriding any default values which are 
                   10429: passed to graph.png.  
                   10430: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   10431: 
                   10432: =back
                   10433: 
                   10434: Returns:
                   10435: 
                   10436: An <img> tag which references graph.png and the appropriate identifying
                   10437: information for the plot.
1.136     matthew  10438: 
                   10439: =cut
                   10440: 
                   10441: ############################################################
                   10442: ############################################################
1.137     matthew  10443: sub DrawXYYGraph {
                   10444:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   10445:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  10446:     #
                   10447:     # Create the identifier for the graph
                   10448:     my $identifier = &get_cgi_id();
                   10449:     my $id = 'cgi.'.$identifier;
                   10450:     #
                   10451:     $Title  = '' if (! defined($Title));
                   10452:     $xlabel = '' if (! defined($xlabel));
                   10453:     $ylabel = '' if (! defined($ylabel));
                   10454:     my %ValuesHash = 
                   10455:         (
1.369     www      10456:          $id.'.title'  => &escape($Title),
                   10457:          $id.'.xlabel' => &escape($xlabel),
                   10458:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  10459:          $id.'.labels' => join(',',@$Xlabels),
                   10460:          $id.'.PlotType' => 'XY',
                   10461:          $id.'.NumSets' => 2,
1.137     matthew  10462:          $id.'.two_axes' => 1,
                   10463:          $id.'.y1_max_value' => $Max1,
                   10464:          $id.'.y1_min_value' => $Min1,
                   10465:          $id.'.y2_max_value' => $Max2,
                   10466:          $id.'.y2_min_value' => $Min2,
1.136     matthew  10467:          );
                   10468:     #
1.137     matthew  10469:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   10470:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   10471:     }
                   10472:     #
                   10473:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   10474:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  10475:         return '';
                   10476:     }
                   10477:     my $NumSets=1;
1.137     matthew  10478:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  10479:         next if (! ref($array));
                   10480:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  10481:     }
                   10482:     #
                   10483:     # Deal with other parameters
                   10484:     while (my ($key,$value) = each(%Values)) {
                   10485:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  10486:     }
                   10487:     #
1.646     raeburn  10488:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 10489:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  10490: }
                   10491: 
                   10492: ############################################################
                   10493: ############################################################
                   10494: 
                   10495: =pod
                   10496: 
1.157     matthew  10497: =back 
                   10498: 
1.139     matthew  10499: =head1 Statistics helper routines?  
                   10500: 
                   10501: Bad place for them but what the hell.
                   10502: 
1.157     matthew  10503: =over 4
                   10504: 
1.648     raeburn  10505: =item * &chartlink()
1.139     matthew  10506: 
                   10507: Returns a link to the chart for a specific student.  
                   10508: 
                   10509: Inputs:
                   10510: 
                   10511: =over 4
                   10512: 
                   10513: =item $linktext: The text of the link
                   10514: 
                   10515: =item $sname: The students username
                   10516: 
                   10517: =item $sdomain: The students domain
                   10518: 
                   10519: =back
                   10520: 
1.157     matthew  10521: =back
                   10522: 
1.139     matthew  10523: =cut
                   10524: 
                   10525: ############################################################
                   10526: ############################################################
                   10527: sub chartlink {
                   10528:     my ($linktext, $sname, $sdomain) = @_;
                   10529:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      10530:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 10531:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  10532:        '">'.$linktext.'</a>';
1.153     matthew  10533: }
                   10534: 
                   10535: #######################################################
                   10536: #######################################################
                   10537: 
                   10538: =pod
                   10539: 
                   10540: =head1 Course Environment Routines
1.157     matthew  10541: 
                   10542: =over 4
1.153     matthew  10543: 
1.648     raeburn  10544: =item * &restore_course_settings()
1.153     matthew  10545: 
1.648     raeburn  10546: =item * &store_course_settings()
1.153     matthew  10547: 
                   10548: Restores/Store indicated form parameters from the course environment.
                   10549: Will not overwrite existing values of the form parameters.
                   10550: 
                   10551: Inputs: 
                   10552: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   10553: 
                   10554: a hash ref describing the data to be stored.  For example:
                   10555:    
                   10556: %Save_Parameters = ('Status' => 'scalar',
                   10557:     'chartoutputmode' => 'scalar',
                   10558:     'chartoutputdata' => 'scalar',
                   10559:     'Section' => 'array',
1.373     raeburn  10560:     'Group' => 'array',
1.153     matthew  10561:     'StudentData' => 'array',
                   10562:     'Maps' => 'array');
                   10563: 
                   10564: Returns: both routines return nothing
                   10565: 
1.631     raeburn  10566: =back
                   10567: 
1.153     matthew  10568: =cut
                   10569: 
                   10570: #######################################################
                   10571: #######################################################
                   10572: sub store_course_settings {
1.496     albertel 10573:     return &store_settings($env{'request.course.id'},@_);
                   10574: }
                   10575: 
                   10576: sub store_settings {
1.153     matthew  10577:     # save to the environment
                   10578:     # appenv the same items, just to be safe
1.300     albertel 10579:     my $udom  = $env{'user.domain'};
                   10580:     my $uname = $env{'user.name'};
1.496     albertel 10581:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10582:     my %SaveHash;
                   10583:     my %AppHash;
                   10584:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 10585:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 10586:         my $envname = 'environment.'.$basename;
1.258     albertel 10587:         if (exists($env{'form.'.$setting})) {
1.153     matthew  10588:             # Save this value away
                   10589:             if ($type eq 'scalar' &&
1.258     albertel 10590:                 (! exists($env{$envname}) || 
                   10591:                  $env{$envname} ne $env{'form.'.$setting})) {
                   10592:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   10593:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  10594:             } elsif ($type eq 'array') {
                   10595:                 my $stored_form;
1.258     albertel 10596:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  10597:                     $stored_form = join(',',
                   10598:                                         map {
1.369     www      10599:                                             &escape($_);
1.258     albertel 10600:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  10601:                 } else {
                   10602:                     $stored_form = 
1.369     www      10603:                         &escape($env{'form.'.$setting});
1.153     matthew  10604:                 }
                   10605:                 # Determine if the array contents are the same.
1.258     albertel 10606:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  10607:                     $SaveHash{$basename} = $stored_form;
                   10608:                     $AppHash{$envname}   = $stored_form;
                   10609:                 }
                   10610:             }
                   10611:         }
                   10612:     }
                   10613:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 10614:                                           $udom,$uname);
1.153     matthew  10615:     if ($put_result !~ /^(ok|delayed)/) {
                   10616:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   10617:                                  'got error:'.$put_result);
                   10618:     }
                   10619:     # Make sure these settings stick around in this session, too
1.646     raeburn  10620:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  10621:     return;
                   10622: }
                   10623: 
                   10624: sub restore_course_settings {
1.499     albertel 10625:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 10626: }
                   10627: 
                   10628: sub restore_settings {
                   10629:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10630:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 10631:         next if (exists($env{'form.'.$setting}));
1.496     albertel 10632:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  10633:             '.'.$setting;
1.258     albertel 10634:         if (exists($env{$envname})) {
1.153     matthew  10635:             if ($type eq 'scalar') {
1.258     albertel 10636:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  10637:             } elsif ($type eq 'array') {
1.258     albertel 10638:                 $env{'form.'.$setting} = [ 
1.153     matthew  10639:                                            map { 
1.369     www      10640:                                                &unescape($_); 
1.258     albertel 10641:                                            } split(',',$env{$envname})
1.153     matthew  10642:                                            ];
                   10643:             }
                   10644:         }
                   10645:     }
1.127     matthew  10646: }
                   10647: 
1.618     raeburn  10648: #######################################################
                   10649: #######################################################
                   10650: 
                   10651: =pod
                   10652: 
                   10653: =head1 Domain E-mail Routines  
                   10654: 
                   10655: =over 4
                   10656: 
1.648     raeburn  10657: =item * &build_recipient_list()
1.618     raeburn  10658: 
1.884     raeburn  10659: Build recipient lists for five types of e-mail:
1.766     raeburn  10660: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  10661: (d) Help requests, (e) Course requests needing approval,  generated by
                   10662: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   10663: loncoursequeueadmin.pm respectively.
1.618     raeburn  10664: 
                   10665: Inputs:
1.619     raeburn  10666: defmail (scalar - email address of default recipient), 
1.618     raeburn  10667: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  10668: defdom (domain for which to retrieve configuration settings),
                   10669: origmail (scalar - email address of recipient from loncapa.conf, 
                   10670: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  10671: 
1.655     raeburn  10672: Returns: comma separated list of addresses to which to send e-mail.
                   10673: 
                   10674: =back
1.618     raeburn  10675: 
                   10676: =cut
                   10677: 
                   10678: ############################################################
                   10679: ############################################################
                   10680: sub build_recipient_list {
1.619     raeburn  10681:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  10682:     my @recipients;
                   10683:     my $otheremails;
                   10684:     my %domconfig =
                   10685:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   10686:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  10687:         if (exists($domconfig{'contacts'}{$mailing})) {
                   10688:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   10689:                 my @contacts = ('adminemail','supportemail');
                   10690:                 foreach my $item (@contacts) {
                   10691:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   10692:                         my $addr = $domconfig{'contacts'}{$item}; 
                   10693:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10694:                             push(@recipients,$addr);
                   10695:                         }
1.619     raeburn  10696:                     }
1.766     raeburn  10697:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  10698:                 }
                   10699:             }
1.766     raeburn  10700:         } elsif ($origmail ne '') {
                   10701:             push(@recipients,$origmail);
1.618     raeburn  10702:         }
1.619     raeburn  10703:     } elsif ($origmail ne '') {
                   10704:         push(@recipients,$origmail);
1.618     raeburn  10705:     }
1.688     raeburn  10706:     if (defined($defmail)) {
                   10707:         if ($defmail ne '') {
                   10708:             push(@recipients,$defmail);
                   10709:         }
1.618     raeburn  10710:     }
                   10711:     if ($otheremails) {
1.619     raeburn  10712:         my @others;
                   10713:         if ($otheremails =~ /,/) {
                   10714:             @others = split(/,/,$otheremails);
1.618     raeburn  10715:         } else {
1.619     raeburn  10716:             push(@others,$otheremails);
                   10717:         }
                   10718:         foreach my $addr (@others) {
                   10719:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10720:                 push(@recipients,$addr);
                   10721:             }
1.618     raeburn  10722:         }
                   10723:     }
1.619     raeburn  10724:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  10725:     return $recipientlist;
                   10726: }
                   10727: 
1.127     matthew  10728: ############################################################
                   10729: ############################################################
1.154     albertel 10730: 
1.655     raeburn  10731: =pod
                   10732: 
                   10733: =head1 Course Catalog Routines
                   10734: 
                   10735: =over 4
                   10736: 
                   10737: =item * &gather_categories()
                   10738: 
                   10739: Converts category definitions - keys of categories hash stored in  
                   10740: coursecategories in configuration.db on the primary library server in a 
                   10741: domain - to an array.  Also generates javascript and idx hash used to 
                   10742: generate Domain Coordinator interface for editing Course Categories.
                   10743: 
                   10744: Inputs:
1.663     raeburn  10745: 
1.655     raeburn  10746: categories (reference to hash of category definitions).
1.663     raeburn  10747: 
1.655     raeburn  10748: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10749:       categories and subcategories).
1.663     raeburn  10750: 
1.655     raeburn  10751: idx (reference to hash of counters used in Domain Coordinator interface for 
                   10752:       editing Course Categories).
1.663     raeburn  10753: 
1.655     raeburn  10754: jsarray (reference to array of categories used to create Javascript arrays for
                   10755:          Domain Coordinator interface for editing Course Categories).
                   10756: 
                   10757: Returns: nothing
                   10758: 
                   10759: Side effects: populates cats, idx and jsarray. 
                   10760: 
                   10761: =cut
                   10762: 
                   10763: sub gather_categories {
                   10764:     my ($categories,$cats,$idx,$jsarray) = @_;
                   10765:     my %counters;
                   10766:     my $num = 0;
                   10767:     foreach my $item (keys(%{$categories})) {
                   10768:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   10769:         if ($container eq '' && $depth == 0) {
                   10770:             $cats->[$depth][$categories->{$item}] = $cat;
                   10771:         } else {
                   10772:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   10773:         }
                   10774:         my ($escitem,$tail) = split(/:/,$item,2);
                   10775:         if ($counters{$tail} eq '') {
                   10776:             $counters{$tail} = $num;
                   10777:             $num ++;
                   10778:         }
                   10779:         if (ref($idx) eq 'HASH') {
                   10780:             $idx->{$item} = $counters{$tail};
                   10781:         }
                   10782:         if (ref($jsarray) eq 'ARRAY') {
                   10783:             push(@{$jsarray->[$counters{$tail}]},$item);
                   10784:         }
                   10785:     }
                   10786:     return;
                   10787: }
                   10788: 
                   10789: =pod
                   10790: 
                   10791: =item * &extract_categories()
                   10792: 
                   10793: Used to generate breadcrumb trails for course categories.
                   10794: 
                   10795: Inputs:
1.663     raeburn  10796: 
1.655     raeburn  10797: categories (reference to hash of category definitions).
1.663     raeburn  10798: 
1.655     raeburn  10799: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10800:       categories and subcategories).
1.663     raeburn  10801: 
1.655     raeburn  10802: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  10803: 
1.655     raeburn  10804: allitems (reference to hash - key is category key 
                   10805:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10806: 
1.655     raeburn  10807: idx (reference to hash of counters used in Domain Coordinator interface for
                   10808:       editing Course Categories).
1.663     raeburn  10809: 
1.655     raeburn  10810: jsarray (reference to array of categories used to create Javascript arrays for
                   10811:          Domain Coordinator interface for editing Course Categories).
                   10812: 
1.665     raeburn  10813: subcats (reference to hash of arrays containing all subcategories within each 
                   10814:          category, -recursive)
                   10815: 
1.655     raeburn  10816: Returns: nothing
                   10817: 
                   10818: Side effects: populates trails and allitems hash references.
                   10819: 
                   10820: =cut
                   10821: 
                   10822: sub extract_categories {
1.665     raeburn  10823:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  10824:     if (ref($categories) eq 'HASH') {
                   10825:         &gather_categories($categories,$cats,$idx,$jsarray);
                   10826:         if (ref($cats->[0]) eq 'ARRAY') {
                   10827:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   10828:                 my $name = $cats->[0][$i];
                   10829:                 my $item = &escape($name).'::0';
                   10830:                 my $trailstr;
                   10831:                 if ($name eq 'instcode') {
                   10832:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  10833:                 } elsif ($name eq 'communities') {
                   10834:                     $trailstr = &mt('Communities');
1.655     raeburn  10835:                 } else {
                   10836:                     $trailstr = $name;
                   10837:                 }
                   10838:                 if ($allitems->{$item} eq '') {
                   10839:                     push(@{$trails},$trailstr);
                   10840:                     $allitems->{$item} = scalar(@{$trails})-1;
                   10841:                 }
                   10842:                 my @parents = ($name);
                   10843:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   10844:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   10845:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  10846:                         if (ref($subcats) eq 'HASH') {
                   10847:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   10848:                         }
                   10849:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   10850:                     }
                   10851:                 } else {
                   10852:                     if (ref($subcats) eq 'HASH') {
                   10853:                         $subcats->{$item} = [];
1.655     raeburn  10854:                     }
                   10855:                 }
                   10856:             }
                   10857:         }
                   10858:     }
                   10859:     return;
                   10860: }
                   10861: 
                   10862: =pod
                   10863: 
                   10864: =item *&recurse_categories()
                   10865: 
                   10866: Recursively used to generate breadcrumb trails for course categories.
                   10867: 
                   10868: Inputs:
1.663     raeburn  10869: 
1.655     raeburn  10870: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10871:       categories and subcategories).
1.663     raeburn  10872: 
1.655     raeburn  10873: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  10874: 
                   10875: category (current course category, for which breadcrumb trail is being generated).
                   10876: 
                   10877: trails (reference to array of breadcrumb trails for each category).
                   10878: 
1.655     raeburn  10879: allitems (reference to hash - key is category key
                   10880:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10881: 
1.655     raeburn  10882: parents (array containing containers directories for current category, 
                   10883:          back to top level). 
                   10884: 
                   10885: Returns: nothing
                   10886: 
                   10887: Side effects: populates trails and allitems hash references
                   10888: 
                   10889: =cut
                   10890: 
                   10891: sub recurse_categories {
1.665     raeburn  10892:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  10893:     my $shallower = $depth - 1;
                   10894:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   10895:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   10896:             my $name = $cats->[$depth]{$category}[$k];
                   10897:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10898:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10899:             if ($allitems->{$item} eq '') {
                   10900:                 push(@{$trails},$trailstr);
                   10901:                 $allitems->{$item} = scalar(@{$trails})-1;
                   10902:             }
                   10903:             my $deeper = $depth+1;
                   10904:             push(@{$parents},$category);
1.665     raeburn  10905:             if (ref($subcats) eq 'HASH') {
                   10906:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   10907:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   10908:                     my $higher;
                   10909:                     if ($j > 0) {
                   10910:                         $higher = &escape($parents->[$j]).':'.
                   10911:                                   &escape($parents->[$j-1]).':'.$j;
                   10912:                     } else {
                   10913:                         $higher = &escape($parents->[$j]).'::'.$j;
                   10914:                     }
                   10915:                     push(@{$subcats->{$higher}},$subcat);
                   10916:                 }
                   10917:             }
                   10918:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   10919:                                 $subcats);
1.655     raeburn  10920:             pop(@{$parents});
                   10921:         }
                   10922:     } else {
                   10923:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10924:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10925:         if ($allitems->{$item} eq '') {
                   10926:             push(@{$trails},$trailstr);
                   10927:             $allitems->{$item} = scalar(@{$trails})-1;
                   10928:         }
                   10929:     }
                   10930:     return;
                   10931: }
                   10932: 
1.663     raeburn  10933: =pod
                   10934: 
                   10935: =item *&assign_categories_table()
                   10936: 
                   10937: Create a datatable for display of hierarchical categories in a domain,
                   10938: with checkboxes to allow a course to be categorized. 
                   10939: 
                   10940: Inputs:
                   10941: 
                   10942: cathash - reference to hash of categories defined for the domain (from
                   10943:           configuration.db)
                   10944: 
                   10945: currcat - scalar with an & separated list of categories assigned to a course. 
                   10946: 
1.919     raeburn  10947: type    - scalar contains course type (Course or Community).
                   10948: 
1.663     raeburn  10949: Returns: $output (markup to be displayed) 
                   10950: 
                   10951: =cut
                   10952: 
                   10953: sub assign_categories_table {
1.919     raeburn  10954:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  10955:     my $output;
                   10956:     if (ref($cathash) eq 'HASH') {
                   10957:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   10958:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   10959:         $maxdepth = scalar(@cats);
                   10960:         if (@cats > 0) {
                   10961:             my $itemcount = 0;
                   10962:             if (ref($cats[0]) eq 'ARRAY') {
                   10963:                 my @currcategories;
                   10964:                 if ($currcat ne '') {
                   10965:                     @currcategories = split('&',$currcat);
                   10966:                 }
1.919     raeburn  10967:                 my $table;
1.663     raeburn  10968:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   10969:                     my $parent = $cats[0][$i];
1.919     raeburn  10970:                     next if ($parent eq 'instcode');
                   10971:                     if ($type eq 'Community') {
                   10972:                         next unless ($parent eq 'communities');
                   10973:                     } else {
                   10974:                         next if ($parent eq 'communities');
                   10975:                     }
1.663     raeburn  10976:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10977:                     my $item = &escape($parent).'::0';
                   10978:                     my $checked = '';
                   10979:                     if (@currcategories > 0) {
                   10980:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   10981:                             $checked = ' checked="checked"';
1.663     raeburn  10982:                         }
                   10983:                     }
1.919     raeburn  10984:                     my $parent_title = $parent;
                   10985:                     if ($parent eq 'communities') {
                   10986:                         $parent_title = &mt('Communities');
                   10987:                     }
                   10988:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   10989:                               '<input type="checkbox" name="usecategory" value="'.
                   10990:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   10991:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  10992:                     my $depth = 1;
                   10993:                     push(@path,$parent);
1.919     raeburn  10994:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  10995:                     pop(@path);
1.919     raeburn  10996:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  10997:                     $itemcount ++;
                   10998:                 }
1.919     raeburn  10999:                 if ($itemcount) {
                   11000:                     $output = &Apache::loncommon::start_data_table().
                   11001:                               $table.
                   11002:                               &Apache::loncommon::end_data_table();
                   11003:                 }
1.663     raeburn  11004:             }
                   11005:         }
                   11006:     }
                   11007:     return $output;
                   11008: }
                   11009: 
                   11010: =pod
                   11011: 
                   11012: =item *&assign_category_rows()
                   11013: 
                   11014: Create a datatable row for display of nested categories in a domain,
                   11015: with checkboxes to allow a course to be categorized,called recursively.
                   11016: 
                   11017: Inputs:
                   11018: 
                   11019: itemcount - track row number for alternating colors
                   11020: 
                   11021: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   11022:       categories and subcategories.
                   11023: 
                   11024: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   11025: 
                   11026: parent - parent of current category item
                   11027: 
                   11028: path - Array containing all categories back up through the hierarchy from the
                   11029:        current category to the top level.
                   11030: 
                   11031: currcategories - reference to array of current categories assigned to the course
                   11032: 
                   11033: Returns: $output (markup to be displayed).
                   11034: 
                   11035: =cut
                   11036: 
                   11037: sub assign_category_rows {
                   11038:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   11039:     my ($text,$name,$item,$chgstr);
                   11040:     if (ref($cats) eq 'ARRAY') {
                   11041:         my $maxdepth = scalar(@{$cats});
                   11042:         if (ref($cats->[$depth]) eq 'HASH') {
                   11043:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   11044:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   11045:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   11046:                 $text .= '<td><table class="LC_datatable">';
                   11047:                 for (my $j=0; $j<$numchildren; $j++) {
                   11048:                     $name = $cats->[$depth]{$parent}[$j];
                   11049:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   11050:                     my $deeper = $depth+1;
                   11051:                     my $checked = '';
                   11052:                     if (ref($currcategories) eq 'ARRAY') {
                   11053:                         if (@{$currcategories} > 0) {
                   11054:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   11055:                                 $checked = ' checked="checked"';
1.663     raeburn  11056:                             }
                   11057:                         }
                   11058:                     }
1.664     raeburn  11059:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   11060:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  11061:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   11062:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   11063:                              '</td><td>';
1.663     raeburn  11064:                     if (ref($path) eq 'ARRAY') {
                   11065:                         push(@{$path},$name);
                   11066:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   11067:                         pop(@{$path});
                   11068:                     }
                   11069:                     $text .= '</td></tr>';
                   11070:                 }
                   11071:                 $text .= '</table></td>';
                   11072:             }
                   11073:         }
                   11074:     }
                   11075:     return $text;
                   11076: }
                   11077: 
1.655     raeburn  11078: ############################################################
                   11079: ############################################################
                   11080: 
                   11081: 
1.443     albertel 11082: sub commit_customrole {
1.664     raeburn  11083:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  11084:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 11085:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   11086:                          ($end?', ending '.localtime($end):'').': <b>'.
                   11087:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  11088:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 11089:                  '</b><br />';
                   11090:     return $output;
                   11091: }
                   11092: 
                   11093: sub commit_standardrole {
1.541     raeburn  11094:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   11095:     my ($output,$logmsg,$linefeed);
                   11096:     if ($context eq 'auto') {
                   11097:         $linefeed = "\n";
                   11098:     } else {
                   11099:         $linefeed = "<br />\n";
                   11100:     }  
1.443     albertel 11101:     if ($three eq 'st') {
1.541     raeburn  11102:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   11103:                                          $one,$two,$sec,$context);
                   11104:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  11105:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   11106:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 11107:         } else {
1.541     raeburn  11108:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 11109:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  11110:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   11111:             if ($context eq 'auto') {
                   11112:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   11113:             } else {
                   11114:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   11115:                &mt('Add to classlist').': <b>ok</b>';
                   11116:             }
                   11117:             $output .= $linefeed;
1.443     albertel 11118:         }
                   11119:     } else {
                   11120:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   11121:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  11122:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  11123:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  11124:         if ($context eq 'auto') {
                   11125:             $output .= $result.$linefeed;
                   11126:         } else {
                   11127:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   11128:         }
1.443     albertel 11129:     }
                   11130:     return $output;
                   11131: }
                   11132: 
                   11133: sub commit_studentrole {
1.541     raeburn  11134:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  11135:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  11136:     if ($context eq 'auto') {
                   11137:         $linefeed = "\n";
                   11138:     } else {
                   11139:         $linefeed = '<br />'."\n";
                   11140:     }
1.443     albertel 11141:     if (defined($one) && defined($two)) {
                   11142:         my $cid=$one.'_'.$two;
                   11143:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   11144:         my $secchange = 0;
                   11145:         my $expire_role_result;
                   11146:         my $modify_section_result;
1.628     raeburn  11147:         if ($oldsec ne '-1') { 
                   11148:             if ($oldsec ne $sec) {
1.443     albertel 11149:                 $secchange = 1;
1.628     raeburn  11150:                 my $now = time;
1.443     albertel 11151:                 my $uurl='/'.$cid;
                   11152:                 $uurl=~s/\_/\//g;
                   11153:                 if ($oldsec) {
                   11154:                     $uurl.='/'.$oldsec;
                   11155:                 }
1.626     raeburn  11156:                 $oldsecurl = $uurl;
1.628     raeburn  11157:                 $expire_role_result = 
1.652     raeburn  11158:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  11159:                 if ($env{'request.course.sec'} ne '') { 
                   11160:                     if ($expire_role_result eq 'refused') {
                   11161:                         my @roles = ('st');
                   11162:                         my @statuses = ('previous');
                   11163:                         my @roledoms = ($one);
                   11164:                         my $withsec = 1;
                   11165:                         my %roleshash = 
                   11166:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   11167:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   11168:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   11169:                             my ($oldstart,$oldend) = 
                   11170:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   11171:                             if ($oldend > 0 && $oldend <= $now) {
                   11172:                                 $expire_role_result = 'ok';
                   11173:                             }
                   11174:                         }
                   11175:                     }
                   11176:                 }
1.443     albertel 11177:                 $result = $expire_role_result;
                   11178:             }
                   11179:         }
                   11180:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  11181:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 11182:             if ($modify_section_result =~ /^ok/) {
                   11183:                 if ($secchange == 1) {
1.628     raeburn  11184:                     if ($sec eq '') {
                   11185:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   11186:                     } else {
                   11187:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   11188:                     }
1.443     albertel 11189:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  11190:                     if ($sec eq '') {
                   11191:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   11192:                     } else {
                   11193:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   11194:                     }
1.443     albertel 11195:                 } else {
1.628     raeburn  11196:                     if ($sec eq '') {
                   11197:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   11198:                     } else {
                   11199:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   11200:                     }
1.443     albertel 11201:                 }
                   11202:             } else {
1.628     raeburn  11203:                 if ($secchange) {       
                   11204:                     $$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;
                   11205:                 } else {
                   11206:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   11207:                 }
1.443     albertel 11208:             }
                   11209:             $result = $modify_section_result;
                   11210:         } elsif ($secchange == 1) {
1.628     raeburn  11211:             if ($oldsec eq '') {
                   11212:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   11213:             } else {
                   11214:                 $$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;
                   11215:             }
1.626     raeburn  11216:             if ($expire_role_result eq 'refused') {
                   11217:                 my $newsecurl = '/'.$cid;
                   11218:                 $newsecurl =~ s/\_/\//g;
                   11219:                 if ($sec ne '') {
                   11220:                     $newsecurl.='/'.$sec;
                   11221:                 }
                   11222:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   11223:                     if ($sec eq '') {
                   11224:                         $$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;
                   11225:                     } else {
                   11226:                         $$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;
                   11227:                     }
                   11228:                 }
                   11229:             }
1.443     albertel 11230:         }
                   11231:     } else {
1.626     raeburn  11232:         $$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 11233:         $result = "error: incomplete course id\n";
                   11234:     }
                   11235:     return $result;
                   11236: }
                   11237: 
                   11238: ############################################################
                   11239: ############################################################
                   11240: 
1.566     albertel 11241: sub check_clone {
1.578     raeburn  11242:     my ($args,$linefeed) = @_;
1.566     albertel 11243:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   11244:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   11245:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   11246:     my $clonemsg;
                   11247:     my $can_clone = 0;
1.944     raeburn  11248:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  11249:     if ($lctype ne 'community') {
                   11250:         $lctype = 'course';
                   11251:     }
1.566     albertel 11252:     if ($clonehome eq 'no_host') {
1.944     raeburn  11253:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11254:             $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'});
                   11255:         } else {
                   11256:             $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'});
                   11257:         }     
1.566     albertel 11258:     } else {
                   11259: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  11260:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11261:             if ($clonedesc{'type'} ne 'Community') {
                   11262:                  $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'});
                   11263:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   11264:             }
                   11265:         }
1.882     raeburn  11266: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   11267:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 11268: 	    $can_clone = 1;
                   11269: 	} else {
                   11270: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   11271: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   11272: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  11273:             if (grep(/^\*$/,@cloners)) {
                   11274:                 $can_clone = 1;
                   11275:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   11276:                 $can_clone = 1;
                   11277:             } else {
1.908     raeburn  11278:                 my $ccrole = 'cc';
1.944     raeburn  11279:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11280:                     $ccrole = 'co';
                   11281:                 }
1.578     raeburn  11282: 	        my %roleshash =
                   11283: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   11284: 					 $args->{'ccdomain'},
1.908     raeburn  11285:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  11286: 					 [$args->{'clonedomain'}]);
1.908     raeburn  11287: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  11288:                     $can_clone = 1;
                   11289:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   11290:                     $can_clone = 1;
                   11291:                 } else {
1.944     raeburn  11292:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  11293:                         $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'});
                   11294:                     } else {
                   11295:                         $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'});
                   11296:                     }
1.578     raeburn  11297: 	        }
1.566     albertel 11298: 	    }
1.578     raeburn  11299:         }
1.566     albertel 11300:     }
                   11301:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   11302: }
                   11303: 
1.444     albertel 11304: sub construct_course {
1.885     raeburn  11305:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 11306:     my $outcome;
1.541     raeburn  11307:     my $linefeed =  '<br />'."\n";
                   11308:     if ($context eq 'auto') {
                   11309:         $linefeed = "\n";
                   11310:     }
1.566     albertel 11311: 
                   11312: #
                   11313: # Are we cloning?
                   11314: #
                   11315:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   11316:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  11317: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 11318: 	if ($context ne 'auto') {
1.578     raeburn  11319:             if ($clonemsg ne '') {
                   11320: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   11321:             }
1.566     albertel 11322: 	}
                   11323: 	$outcome .= $clonemsg.$linefeed;
                   11324: 
                   11325:         if (!$can_clone) {
                   11326: 	    return (0,$outcome);
                   11327: 	}
                   11328:     }
                   11329: 
1.444     albertel 11330: #
                   11331: # Open course
                   11332: #
                   11333:     my $crstype = lc($args->{'crstype'});
                   11334:     my %cenv=();
                   11335:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   11336:                                              $args->{'cdescr'},
                   11337:                                              $args->{'curl'},
                   11338:                                              $args->{'course_home'},
                   11339:                                              $args->{'nonstandard'},
                   11340:                                              $args->{'crscode'},
                   11341:                                              $args->{'ccuname'}.':'.
                   11342:                                              $args->{'ccdomain'},
1.882     raeburn  11343:                                              $args->{'crstype'},
1.885     raeburn  11344:                                              $cnum,$context,$category);
1.444     albertel 11345: 
                   11346:     # Note: The testing routines depend on this being output; see 
                   11347:     # Utils::Course. This needs to at least be output as a comment
                   11348:     # if anyone ever decides to not show this, and Utils::Course::new
                   11349:     # will need to be suitably modified.
1.541     raeburn  11350:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  11351:     if ($$courseid =~ /^error:/) {
                   11352:         return (0,$outcome);
                   11353:     }
                   11354: 
1.444     albertel 11355: #
                   11356: # Check if created correctly
                   11357: #
1.479     albertel 11358:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 11359:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  11360:     if ($crsuhome eq 'no_host') {
                   11361:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   11362:         return (0,$outcome);
                   11363:     }
1.541     raeburn  11364:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 11365: 
1.444     albertel 11366: #
1.566     albertel 11367: # Do the cloning
                   11368: #   
                   11369:     if ($can_clone && $cloneid) {
                   11370: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   11371: 	if ($context ne 'auto') {
                   11372: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   11373: 	}
                   11374: 	$outcome .= $clonemsg.$linefeed;
                   11375: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 11376: # Copy all files
1.637     www      11377: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 11378: # Restore URL
1.566     albertel 11379: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 11380: # Restore title
1.566     albertel 11381: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  11382: # Restore creation date, creator and creation context.
                   11383:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   11384:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   11385:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 11386: # Mark as cloned
1.566     albertel 11387: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      11388: # Need to clone grading mode
                   11389:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   11390:         $cenv{'grading'}=$newenv{'grading'};
                   11391: # Do not clone these environment entries
                   11392:         &Apache::lonnet::del('environment',
                   11393:                   ['default_enrollment_start_date',
                   11394:                    'default_enrollment_end_date',
                   11395:                    'question.email',
                   11396:                    'policy.email',
                   11397:                    'comment.email',
                   11398:                    'pch.users.denied',
1.725     raeburn  11399:                    'plc.users.denied',
                   11400:                    'hidefromcat',
                   11401:                    'categories'],
1.638     www      11402:                    $$crsudom,$$crsunum);
1.444     albertel 11403:     }
1.566     albertel 11404: 
1.444     albertel 11405: #
                   11406: # Set environment (will override cloned, if existing)
                   11407: #
                   11408:     my @sections = ();
                   11409:     my @xlists = ();
                   11410:     if ($args->{'crstype'}) {
                   11411:         $cenv{'type'}=$args->{'crstype'};
                   11412:     }
                   11413:     if ($args->{'crsid'}) {
                   11414:         $cenv{'courseid'}=$args->{'crsid'};
                   11415:     }
                   11416:     if ($args->{'crscode'}) {
                   11417:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   11418:     }
                   11419:     if ($args->{'crsquota'} ne '') {
                   11420:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   11421:     } else {
                   11422:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   11423:     }
                   11424:     if ($args->{'ccuname'}) {
                   11425:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   11426:                                         ':'.$args->{'ccdomain'};
                   11427:     } else {
                   11428:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   11429:     }
                   11430:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   11431:     if ($args->{'crssections'}) {
                   11432:         $cenv{'internal.sectionnums'} = '';
                   11433:         if ($args->{'crssections'} =~ m/,/) {
                   11434:             @sections = split/,/,$args->{'crssections'};
                   11435:         } else {
                   11436:             $sections[0] = $args->{'crssections'};
                   11437:         }
                   11438:         if (@sections > 0) {
                   11439:             foreach my $item (@sections) {
                   11440:                 my ($sec,$gp) = split/:/,$item;
                   11441:                 my $class = $args->{'crscode'}.$sec;
                   11442:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   11443:                 $cenv{'internal.sectionnums'} .= $item.',';
                   11444:                 unless ($addcheck eq 'ok') {
                   11445:                     push @badclasses, $class;
                   11446:                 }
                   11447:             }
                   11448:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   11449:         }
                   11450:     }
                   11451: # do not hide course coordinator from staff listing, 
                   11452: # even if privileged
                   11453:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11454: # add crosslistings
                   11455:     if ($args->{'crsxlist'}) {
                   11456:         $cenv{'internal.crosslistings'}='';
                   11457:         if ($args->{'crsxlist'} =~ m/,/) {
                   11458:             @xlists = split/,/,$args->{'crsxlist'};
                   11459:         } else {
                   11460:             $xlists[0] = $args->{'crsxlist'};
                   11461:         }
                   11462:         if (@xlists > 0) {
                   11463:             foreach my $item (@xlists) {
                   11464:                 my ($xl,$gp) = split/:/,$item;
                   11465:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   11466:                 $cenv{'internal.crosslistings'} .= $item.',';
                   11467:                 unless ($addcheck eq 'ok') {
                   11468:                     push @badclasses, $xl;
                   11469:                 }
                   11470:             }
                   11471:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   11472:         }
                   11473:     }
                   11474:     if ($args->{'autoadds'}) {
                   11475:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   11476:     }
                   11477:     if ($args->{'autodrops'}) {
                   11478:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   11479:     }
                   11480: # check for notification of enrollment changes
                   11481:     my @notified = ();
                   11482:     if ($args->{'notify_owner'}) {
                   11483:         if ($args->{'ccuname'} ne '') {
                   11484:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   11485:         }
                   11486:     }
                   11487:     if ($args->{'notify_dc'}) {
                   11488:         if ($uname ne '') { 
1.630     raeburn  11489:             push(@notified,$uname.':'.$udom);
1.444     albertel 11490:         }
                   11491:     }
                   11492:     if (@notified > 0) {
                   11493:         my $notifylist;
                   11494:         if (@notified > 1) {
                   11495:             $notifylist = join(',',@notified);
                   11496:         } else {
                   11497:             $notifylist = $notified[0];
                   11498:         }
                   11499:         $cenv{'internal.notifylist'} = $notifylist;
                   11500:     }
                   11501:     if (@badclasses > 0) {
                   11502:         my %lt=&Apache::lonlocal::texthash(
                   11503:                 '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',
                   11504:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   11505:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   11506:         );
1.541     raeburn  11507:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   11508:                            ' ('.$lt{'adby'}.')';
                   11509:         if ($context eq 'auto') {
                   11510:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 11511:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  11512:             foreach my $item (@badclasses) {
                   11513:                 if ($context eq 'auto') {
                   11514:                     $outcome .= " - $item\n";
                   11515:                 } else {
                   11516:                     $outcome .= "<li>$item</li>\n";
                   11517:                 }
                   11518:             }
                   11519:             if ($context eq 'auto') {
                   11520:                 $outcome .= $linefeed;
                   11521:             } else {
1.566     albertel 11522:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  11523:             }
                   11524:         } 
1.444     albertel 11525:     }
                   11526:     if ($args->{'no_end_date'}) {
                   11527:         $args->{'endaccess'} = 0;
                   11528:     }
                   11529:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   11530:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   11531:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   11532:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   11533:     if ($args->{'showphotos'}) {
                   11534:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   11535:     }
                   11536:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   11537:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   11538:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   11539:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  11540:             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'); 
                   11541:             if ($context eq 'auto') {
                   11542:                 $outcome .= $krb_msg;
                   11543:             } else {
1.566     albertel 11544:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  11545:             }
                   11546:             $outcome .= $linefeed;
1.444     albertel 11547:         }
                   11548:     }
                   11549:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   11550:        if ($args->{'setpolicy'}) {
                   11551:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11552:        }
                   11553:        if ($args->{'setcontent'}) {
                   11554:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   11555:        }
                   11556:     }
                   11557:     if ($args->{'reshome'}) {
                   11558: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   11559: 	$cenv{'reshome'}=~s/\/+$/\//;
                   11560:     }
                   11561: #
                   11562: # course has keyed access
                   11563: #
                   11564:     if ($args->{'setkeys'}) {
                   11565:        $cenv{'keyaccess'}='yes';
                   11566:     }
                   11567: # if specified, key authority is not course, but user
                   11568: # only active if keyaccess is yes
                   11569:     if ($args->{'keyauth'}) {
1.487     albertel 11570: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   11571: 	$user = &LONCAPA::clean_username($user);
                   11572: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     11573: 	if ($user ne '' && $domain ne '') {
1.487     albertel 11574: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 11575: 	}
                   11576:     }
                   11577: 
                   11578:     if ($args->{'disresdis'}) {
                   11579:         $cenv{'pch.roles.denied'}='st';
                   11580:     }
                   11581:     if ($args->{'disablechat'}) {
                   11582:         $cenv{'plc.roles.denied'}='st';
                   11583:     }
                   11584: 
                   11585:     # Record we've not yet viewed the Course Initialization Helper for this 
                   11586:     # course
                   11587:     $cenv{'course.helper.not.run'} = 1;
                   11588:     #
                   11589:     # Use new Randomseed
                   11590:     #
                   11591:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   11592:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   11593:     #
                   11594:     # The encryption code and receipt prefix for this course
                   11595:     #
                   11596:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   11597:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   11598:     #
                   11599:     # By default, use standard grading
                   11600:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   11601: 
1.541     raeburn  11602:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   11603:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 11604: #
                   11605: # Open all assignments
                   11606: #
                   11607:     if ($args->{'openall'}) {
                   11608:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   11609:        my %storecontent = ($storeunder         => time,
                   11610:                            $storeunder.'.type' => 'date_start');
                   11611:        
                   11612:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  11613:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 11614:    }
                   11615: #
                   11616: # Set first page
                   11617: #
                   11618:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   11619: 	    || ($cloneid)) {
1.445     albertel 11620: 	use LONCAPA::map;
1.444     albertel 11621: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 11622: 
                   11623: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   11624:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   11625: 
1.444     albertel 11626:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   11627:         my $title; my $url;
                   11628:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   11629: 	    $title=&mt('Syllabus');
1.444     albertel 11630:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   11631:         } else {
1.963     raeburn  11632:             $title=&mt('Table of Contents');
1.444     albertel 11633:             $url='/adm/navmaps';
                   11634:         }
1.445     albertel 11635: 
                   11636:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   11637: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   11638: 
                   11639: 	if ($errtext) { $fatal=2; }
1.541     raeburn  11640:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 11641:     }
1.566     albertel 11642: 
                   11643:     return (1,$outcome);
1.444     albertel 11644: }
                   11645: 
                   11646: ############################################################
                   11647: ############################################################
                   11648: 
1.953     droeschl 11649: #SD
                   11650: # only Community and Course, or anything else?
1.378     raeburn  11651: sub course_type {
                   11652:     my ($cid) = @_;
                   11653:     if (!defined($cid)) {
                   11654:         $cid = $env{'request.course.id'};
                   11655:     }
1.404     albertel 11656:     if (defined($env{'course.'.$cid.'.type'})) {
                   11657:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  11658:     } else {
                   11659:         return 'Course';
1.377     raeburn  11660:     }
                   11661: }
1.156     albertel 11662: 
1.406     raeburn  11663: sub group_term {
                   11664:     my $crstype = &course_type();
                   11665:     my %names = (
                   11666:                   'Course' => 'group',
1.865     raeburn  11667:                   'Community' => 'group',
1.406     raeburn  11668:                 );
                   11669:     return $names{$crstype};
                   11670: }
                   11671: 
1.902     raeburn  11672: sub course_types {
                   11673:     my @types = ('official','unofficial','community');
                   11674:     my %typename = (
                   11675:                          official   => 'Official course',
                   11676:                          unofficial => 'Unofficial course',
                   11677:                          community  => 'Community',
                   11678:                    );
                   11679:     return (\@types,\%typename);
                   11680: }
                   11681: 
1.156     albertel 11682: sub icon {
                   11683:     my ($file)=@_;
1.505     albertel 11684:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 11685:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 11686:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 11687:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   11688: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   11689: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11690: 	            $curfext.".gif") {
                   11691: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11692: 		$curfext.".gif";
                   11693: 	}
                   11694:     }
1.249     albertel 11695:     return &lonhttpdurl($iconname);
1.154     albertel 11696: } 
1.84      albertel 11697: 
1.575     albertel 11698: sub lonhttpdurl {
1.692     www      11699: #
                   11700: # Had been used for "small fry" static images on separate port 8080.
                   11701: # Modify here if lightweight http functionality desired again.
                   11702: # Currently eliminated due to increasing firewall issues.
                   11703: #
1.575     albertel 11704:     my ($url)=@_;
1.692     www      11705:     return $url;
1.215     albertel 11706: }
                   11707: 
1.213     albertel 11708: sub connection_aborted {
                   11709:     my ($r)=@_;
                   11710:     $r->print(" ");$r->rflush();
                   11711:     my $c = $r->connection;
                   11712:     return $c->aborted();
                   11713: }
                   11714: 
1.221     foxr     11715: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     11716: #    strings as 'strings'.
                   11717: sub escape_single {
1.221     foxr     11718:     my ($input) = @_;
1.223     albertel 11719:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     11720:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   11721:     return $input;
                   11722: }
1.223     albertel 11723: 
1.222     foxr     11724: #  Same as escape_single, but escape's "'s  This 
                   11725: #  can be used for  "strings"
                   11726: sub escape_double {
                   11727:     my ($input) = @_;
                   11728:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   11729:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   11730:     return $input;
                   11731: }
1.223     albertel 11732:  
1.222     foxr     11733: #   Escapes the last element of a full URL.
                   11734: sub escape_url {
                   11735:     my ($url)   = @_;
1.238     raeburn  11736:     my @urlslices = split(/\//, $url,-1);
1.369     www      11737:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 11738:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     11739: }
1.462     albertel 11740: 
1.820     raeburn  11741: sub compare_arrays {
                   11742:     my ($arrayref1,$arrayref2) = @_;
                   11743:     my (@difference,%count);
                   11744:     @difference = ();
                   11745:     %count = ();
                   11746:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   11747:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   11748:         foreach my $element (keys(%count)) {
                   11749:             if ($count{$element} == 1) {
                   11750:                 push(@difference,$element);
                   11751:             }
                   11752:         }
                   11753:     }
                   11754:     return @difference;
                   11755: }
                   11756: 
1.817     bisitz   11757: # -------------------------------------------------------- Initialize user login
1.462     albertel 11758: sub init_user_environment {
1.463     albertel 11759:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 11760:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   11761: 
                   11762:     my $public=($username eq 'public' && $domain eq 'public');
                   11763: 
                   11764: # See if old ID present, if so, remove
                   11765: 
                   11766:     my ($filename,$cookie,$userroles);
                   11767:     my $now=time;
                   11768: 
                   11769:     if ($public) {
                   11770: 	my $max_public=100;
                   11771: 	my $oldest;
                   11772: 	my $oldest_time=0;
                   11773: 	for(my $next=1;$next<=$max_public;$next++) {
                   11774: 	    if (-e $lonids."/publicuser_$next.id") {
                   11775: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   11776: 		if ($mtime<$oldest_time || !$oldest_time) {
                   11777: 		    $oldest_time=$mtime;
                   11778: 		    $oldest=$next;
                   11779: 		}
                   11780: 	    } else {
                   11781: 		$cookie="publicuser_$next";
                   11782: 		last;
                   11783: 	    }
                   11784: 	}
                   11785: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   11786:     } else {
1.463     albertel 11787: 	# if this isn't a robot, kill any existing non-robot sessions
                   11788: 	if (!$args->{'robot'}) {
                   11789: 	    opendir(DIR,$lonids);
                   11790: 	    while ($filename=readdir(DIR)) {
                   11791: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   11792: 		    unlink($lonids.'/'.$filename);
                   11793: 		}
1.462     albertel 11794: 	    }
1.463     albertel 11795: 	    closedir(DIR);
1.462     albertel 11796: 	}
                   11797: # Give them a new cookie
1.463     albertel 11798: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      11799: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 11800: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 11801:     
                   11802: # Initialize roles
                   11803: 
                   11804: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   11805:     }
                   11806: # ------------------------------------ Check browser type and MathML capability
                   11807: 
                   11808:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   11809:         $clientunicode,$clientos) = &decode_user_agent($r);
                   11810: 
                   11811: # ------------------------------------------------------------- Get environment
                   11812: 
                   11813:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   11814:     my ($tmp) = keys(%userenv);
                   11815:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   11816:     } else {
                   11817: 	undef(%userenv);
                   11818:     }
                   11819:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   11820: 	$form->{'interface'}=$userenv{'interface'};
                   11821:     }
                   11822:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   11823: 
                   11824: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   11825:     foreach my $option ('interface','localpath','localres') {
                   11826:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 11827:     }
                   11828: # --------------------------------------------------------- Write first profile
                   11829: 
                   11830:     {
                   11831: 	my %initial_env = 
                   11832: 	    ("user.name"          => $username,
                   11833: 	     "user.domain"        => $domain,
                   11834: 	     "user.home"          => $authhost,
                   11835: 	     "browser.type"       => $clientbrowser,
                   11836: 	     "browser.version"    => $clientversion,
                   11837: 	     "browser.mathml"     => $clientmathml,
                   11838: 	     "browser.unicode"    => $clientunicode,
                   11839: 	     "browser.os"         => $clientos,
                   11840: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   11841: 	     "request.course.fn"  => '',
                   11842: 	     "request.course.uri" => '',
                   11843: 	     "request.course.sec" => '',
                   11844: 	     "request.role"       => 'cm',
                   11845: 	     "request.role.adv"   => $env{'user.adv'},
                   11846: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   11847: 
                   11848:         if ($form->{'localpath'}) {
                   11849: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   11850: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   11851:         }
                   11852: 	
                   11853: 	if ($form->{'interface'}) {
                   11854: 	    $form->{'interface'}=~s/\W//gs;
                   11855: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   11856: 	    $env{'browser.interface'}=$form->{'interface'};
                   11857: 	}
                   11858: 
1.981     raeburn  11859:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  11860:         my %domdef;
                   11861:         unless ($domain eq 'public') {
                   11862:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   11863:         }
1.980     raeburn  11864: 
1.724     raeburn  11865:         foreach my $tool ('aboutme','blog','portfolio') {
                   11866:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  11867:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   11868:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  11869:         }
                   11870: 
1.864     raeburn  11871:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  11872:             $userenv{'canrequest.'.$crstype} =
                   11873:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  11874:                                                   'reload','requestcourses',
                   11875:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  11876:         }
                   11877: 
1.462     albertel 11878: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   11879: 	
                   11880: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   11881: 		 &GDBM_WRCREAT(),0640)) {
                   11882: 	    &_add_to_env(\%disk_env,\%initial_env);
                   11883: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   11884: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 11885: 	    if (ref($args->{'extra_env'})) {
                   11886: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   11887: 	    }
1.462     albertel 11888: 	    untie(%disk_env);
                   11889: 	} else {
1.705     tempelho 11890: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   11891: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 11892: 	    return 'error: '.$!;
                   11893: 	}
                   11894:     }
                   11895:     $env{'request.role'}='cm';
                   11896:     $env{'request.role.adv'}=$env{'user.adv'};
                   11897:     $env{'browser.type'}=$clientbrowser;
                   11898: 
                   11899:     return $cookie;
                   11900: 
                   11901: }
                   11902: 
                   11903: sub _add_to_env {
                   11904:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  11905:     if (ref($env_data) eq 'HASH') {
                   11906:         while (my ($key,$value) = each(%$env_data)) {
                   11907: 	    $idf->{$prefix.$key} = $value;
                   11908: 	    $env{$prefix.$key}   = $value;
                   11909:         }
1.462     albertel 11910:     }
                   11911: }
                   11912: 
1.685     tempelho 11913: # --- Get the symbolic name of a problem and the url
                   11914: sub get_symb {
                   11915:     my ($request,$silent) = @_;
1.726     raeburn  11916:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 11917:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   11918:     if ($symb eq '') {
                   11919:         if (!$silent) {
                   11920:             $request->print("Unable to handle ambiguous references:$url:.");
                   11921:             return ();
                   11922:         }
                   11923:     }
                   11924:     &Apache::lonenc::check_decrypt(\$symb);
                   11925:     return ($symb);
                   11926: }
                   11927: 
                   11928: # --------------------------------------------------------------Get annotation
                   11929: 
                   11930: sub get_annotation {
                   11931:     my ($symb,$enc) = @_;
                   11932: 
                   11933:     my $key = $symb;
                   11934:     if (!$enc) {
                   11935:         $key =
                   11936:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   11937:     }
                   11938:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   11939:     return $annotation{$key};
                   11940: }
                   11941: 
                   11942: sub clean_symb {
1.731     raeburn  11943:     my ($symb,$delete_enc) = @_;
1.685     tempelho 11944: 
                   11945:     &Apache::lonenc::check_decrypt(\$symb);
                   11946:     my $enc = $env{'request.enc'};
1.731     raeburn  11947:     if ($delete_enc) {
1.730     raeburn  11948:         delete($env{'request.enc'});
                   11949:     }
1.685     tempelho 11950: 
                   11951:     return ($symb,$enc);
                   11952: }
1.462     albertel 11953: 
1.990     raeburn  11954: sub build_release_hashes {
                   11955:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   11956:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   11957:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   11958:                   (ref($randomizetry) eq 'HASH'));
                   11959:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   11960:         my ($item,$name,$value) = split(/:/,$key);
                   11961:         if ($item eq 'parameter') {
                   11962:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   11963:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   11964:                     push(@{$checkparms->{$name}},$value);
                   11965:                 }
                   11966:             } else {
                   11967:                 push(@{$checkparms->{$name}},$value);
                   11968:             }
                   11969:         } elsif ($item eq 'resourcetag') {
                   11970:             if ($name eq 'responsetype') {
                   11971:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   11972:             }
                   11973:         } elsif ($item eq 'course') {
                   11974:             if ($name eq 'crstype') {
                   11975:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   11976:             }
                   11977:         }
                   11978:     }
                   11979:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   11980:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   11981:     return;
                   11982: }
                   11983: 
1.41      ng       11984: =pod
                   11985: 
                   11986: =back
                   11987: 
1.112     bowersj2 11988: =cut
1.41      ng       11989: 
1.112     bowersj2 11990: 1;
                   11991: __END__;
1.41      ng       11992: 

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