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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.999   ! www         4: # $Id: loncommon.pm,v 1.998 2011/01/16 03:50:12 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.74      www       439: sub selectstudent_link {
1.999   ! www       440:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
        !           441:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
        !           442:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
        !           443:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  444:    if ($env{'request.course.id'}) {  
1.302     albertel  445:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    446: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    447: 					'/'.$env{'request.course.sec'})) {
1.111     www       448: 	   return '';
                    449:        }
1.999   ! www       450:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   451:        if ($courseadvonly)  {
                    452:            $callargs .= ",'',1,1";
                    453:        }
                    454:        return '<span class="LC_nobreak">'.
                    455:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    456:               &mt('Select User').'</a></span>';
1.74      www       457:    }
1.258     albertel  458:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.793     raeburn   459:        $callargs .= ",1"; 
                    460:        return '<span class="LC_nobreak">'.
                    461:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    462:               &mt('Select User').'</a></span>';
1.111     www       463:    }
                    464:    return '';
1.91      www       465: }
                    466: 
1.653     raeburn   467: sub authorbrowser_javascript {
                    468:     return <<"ENDAUTHORBRW";
1.776     bisitz    469: <script type="text/javascript" language="JavaScript">
1.824     bisitz    470: // <![CDATA[
1.653     raeburn   471: var stdeditbrowser;
                    472: 
                    473: function openauthorbrowser(formname,udom) {
                    474:     var url = '/adm/pickauthor?';
                    475:     url += 'form='+formname+'&roledom='+udom;
                    476:     var title = 'Author_Browser';
                    477:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    478:     options += ',width=700,height=600';
                    479:     stdeditbrowser = open(url,title,options,'1');
                    480:     stdeditbrowser.focus();
                    481: }
                    482: 
1.824     bisitz    483: // ]]>
1.653     raeburn   484: </script>
                    485: ENDAUTHORBRW
                    486: }
                    487: 
1.91      www       488: sub coursebrowser_javascript {
1.909     raeburn   489:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   490:     my $wintitle = 'Course_Browser';
1.931     raeburn   491:     if ($crstype eq 'Community') {
1.932     raeburn   492:         $wintitle = 'Community_Browser';
1.909     raeburn   493:     }
1.876     raeburn   494:     my $id_functions = &javascript_index_functions();
                    495:     my $output = '
1.776     bisitz    496: <script type="text/javascript" language="JavaScript">
1.824     bisitz    497: // <![CDATA[
1.468     raeburn   498:     var stdeditbrowser;'."\n";
1.876     raeburn   499: 
                    500:     $output .= <<"ENDSTDBRW";
1.909     raeburn   501:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       502:         var url = '/adm/pickcourse?';
1.895     raeburn   503:         var formid = getFormIdByName(formname);
1.876     raeburn   504:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  505:         if (domainfilter != null) {
                    506:            if (domainfilter != '') {
                    507:                url += 'domainfilter='+domainfilter+'&';
                    508: 	   }
                    509:         }
1.91      www       510:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  511: 	                            '&cdomelement='+udom+
                    512:                                     '&cnameelement='+desc;
1.468     raeburn   513:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   514:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   515:                 url += '&roleelement='+extra_element;
                    516:                 if (domainfilter == null || domainfilter == '') {
                    517:                     url += '&domainfilter='+extra_element;
                    518:                 }
1.234     raeburn   519:             }
1.468     raeburn   520:             else {
                    521:                 if (formname == 'portform') {
                    522:                     url += '&setroles='+extra_element;
1.800     raeburn   523:                 } else {
                    524:                     if (formname == 'rules') {
                    525:                         url += '&fixeddom='+extra_element; 
                    526:                     }
1.468     raeburn   527:                 }
                    528:             }     
1.230     raeburn   529:         }
1.909     raeburn   530:         if (type != null && type != '') {
                    531:             url += '&type='+type;
                    532:         }
                    533:         if (type_elem != null && type_elem != '') {
                    534:             url += '&typeelement='+type_elem;
                    535:         }
1.872     raeburn   536:         if (formname == 'ccrs') {
                    537:             var ownername = document.forms[formid].ccuname.value;
                    538:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    539:             url += '&cloner='+ownername+':'+ownerdom;
                    540:         }
1.293     raeburn   541:         if (multflag !=null && multflag != '') {
                    542:             url += '&multiple='+multflag;
                    543:         }
1.909     raeburn   544:         var title = '$wintitle';
1.91      www       545:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    546:         options += ',width=700,height=600';
                    547:         stdeditbrowser = open(url,title,options,'1');
                    548:         stdeditbrowser.focus();
                    549:     }
1.876     raeburn   550: $id_functions
                    551: ENDSTDBRW
1.905     raeburn   552:     if (($sec_element ne '') || ($role_element ne '')) {
                    553:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   554:     }
                    555:     $output .= '
                    556: // ]]>
                    557: </script>';
                    558:     return $output;
                    559: }
                    560: 
                    561: sub javascript_index_functions {
                    562:     return <<"ENDJS";
                    563: 
                    564: function getFormIdByName(formname) {
                    565:     for (var i=0;i<document.forms.length;i++) {
                    566:         if (document.forms[i].name == formname) {
                    567:             return i;
                    568:         }
                    569:     }
                    570:     return -1;
                    571: }
                    572: 
                    573: function getIndexByName(formid,item) {
                    574:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    575:         if (document.forms[formid].elements[i].name == item) {
                    576:             return i;
                    577:         }
                    578:     }
                    579:     return -1;
                    580: }
1.468     raeburn   581: 
1.876     raeburn   582: function getDomainFromSelectbox(formname,udom) {
                    583:     var userdom;
                    584:     var formid = getFormIdByName(formname);
                    585:     if (formid > -1) {
                    586:         var domid = getIndexByName(formid,udom);
                    587:         if (domid > -1) {
                    588:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    589:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    590:             }
                    591:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    592:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   593:             }
                    594:         }
                    595:     }
1.876     raeburn   596:     return userdom;
                    597: }
                    598: 
                    599: ENDJS
1.468     raeburn   600: 
1.876     raeburn   601: }
                    602: 
                    603: sub userbrowser_javascript {
                    604:     my $id_functions = &javascript_index_functions();
                    605:     return <<"ENDUSERBRW";
                    606: 
1.888     raeburn   607: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   608:     var url = '/adm/pickuser?';
                    609:     var userdom = getDomainFromSelectbox(formname,udom);
                    610:     if (userdom != null) {
                    611:        if (userdom != '') {
                    612:            url += 'srchdom='+userdom+'&';
                    613:        }
                    614:     }
                    615:     url += 'form=' + formname + '&unameelement='+uname+
                    616:                                 '&udomelement='+udom+
                    617:                                 '&ulastelement='+ulast+
                    618:                                 '&ufirstelement='+ufirst+
                    619:                                 '&uemailelement='+uemail+
1.881     raeburn   620:                                 '&hideudomelement='+hideudom+
                    621:                                 '&coursedom='+crsdom;
1.888     raeburn   622:     if ((caller != null) && (caller != undefined)) {
                    623:         url += '&caller='+caller;
                    624:     }
1.876     raeburn   625:     var title = 'User_Browser';
                    626:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    627:     options += ',width=700,height=600';
                    628:     var stdeditbrowser = open(url,title,options,'1');
                    629:     stdeditbrowser.focus();
                    630: }
                    631: 
1.888     raeburn   632: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   633:     var formid = getFormIdByName(formname);
                    634:     if (formid > -1) {
1.888     raeburn   635:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   636:         var domid = getIndexByName(formid,udom);
                    637:         var hidedomid = getIndexByName(formid,origdom);
                    638:         if (hidedomid > -1) {
                    639:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   640:             var unameval = document.forms[formid].elements[unameid].value;
                    641:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    642:                 if (domid > -1) {
                    643:                     var slct = document.forms[formid].elements[domid];
                    644:                     if (slct.type == 'select-one') {
                    645:                         var i;
                    646:                         for (i=0;i<slct.length;i++) {
                    647:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    648:                         }
                    649:                     }
                    650:                     if (slct.type == 'hidden') {
                    651:                         slct.value = fixeddom;
1.876     raeburn   652:                     }
                    653:                 }
1.468     raeburn   654:             }
                    655:         }
                    656:     }
1.876     raeburn   657:     return;
                    658: }
                    659: 
                    660: $id_functions
                    661: ENDUSERBRW
1.468     raeburn   662: }
                    663: 
                    664: sub setsec_javascript {
1.905     raeburn   665:     my ($sec_element,$formname,$role_element) = @_;
                    666:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    667:         $communityrolestr);
                    668:     if ($role_element ne '') {
                    669:         my @allroles = ('st','ta','ep','in','ad');
                    670:         foreach my $crstype ('Course','Community') {
                    671:             if ($crstype eq 'Community') {
                    672:                 foreach my $role (@allroles) {
                    673:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    674:                 }
                    675:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    676:             } else {
                    677:                 foreach my $role (@allroles) {
                    678:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    679:                 }
                    680:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    681:             }
                    682:         }
                    683:         $rolestr = '"'.join('","',@allroles).'"';
                    684:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    685:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    686:     }
1.468     raeburn   687:     my $setsections = qq|
                    688: function setSect(sectionlist) {
1.629     raeburn   689:     var sectionsArray = new Array();
                    690:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    691:         sectionsArray = sectionlist.split(",");
                    692:     }
1.468     raeburn   693:     var numSections = sectionsArray.length;
                    694:     document.$formname.$sec_element.length = 0;
                    695:     if (numSections == 0) {
                    696:         document.$formname.$sec_element.multiple=false;
                    697:         document.$formname.$sec_element.size=1;
                    698:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    699:     } else {
                    700:         if (numSections == 1) {
                    701:             document.$formname.$sec_element.multiple=false;
                    702:             document.$formname.$sec_element.size=1;
                    703:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    704:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    705:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    706:         } else {
                    707:             for (var i=0; i<numSections; i++) {
                    708:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    709:             }
                    710:             document.$formname.$sec_element.multiple=true
                    711:             if (numSections < 3) {
                    712:                 document.$formname.$sec_element.size=numSections;
                    713:             } else {
                    714:                 document.$formname.$sec_element.size=3;
                    715:             }
                    716:             document.$formname.$sec_element.options[0].selected = false
                    717:         }
                    718:     }
1.91      www       719: }
1.905     raeburn   720: 
                    721: function setRole(crstype) {
1.468     raeburn   722: |;
1.905     raeburn   723:     if ($role_element eq '') {
                    724:         $setsections .= '    return;
                    725: }
                    726: ';
                    727:     } else {
                    728:         $setsections .= qq|
                    729:     var elementLength = document.$formname.$role_element.length;
                    730:     var allroles = Array($rolestr);
                    731:     var courserolenames = Array($courserolestr);
                    732:     var communityrolenames = Array($communityrolestr);
                    733:     if (elementLength != undefined) {
                    734:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    735:             if (crstype == 'Course') {
                    736:                 return;
                    737:             } else {
                    738:                 allroles[5] = 'co';
                    739:                 for (var i=0; i<6; i++) {
                    740:                     document.$formname.$role_element.options[i].value = allroles[i];
                    741:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    742:                 }
                    743:             }
                    744:         } else {
                    745:             if (crstype == 'Community') {
                    746:                 return;
                    747:             } else {
                    748:                 allroles[5] = 'cc';
                    749:                 for (var i=0; i<6; i++) {
                    750:                     document.$formname.$role_element.options[i].value = allroles[i];
                    751:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    752:                 }
                    753:             }
                    754:         }
                    755:     }
                    756:     return;
                    757: }
                    758: |;
                    759:     }
1.468     raeburn   760:     return $setsections;
                    761: }
                    762: 
1.91      www       763: sub selectcourse_link {
1.909     raeburn   764:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    765:        $typeelement) = @_;
                    766:    my $type = $selecttype;
1.871     raeburn   767:    my $linktext = &mt('Select Course');
                    768:    if ($selecttype eq 'Community') {
1.909     raeburn   769:        $linktext = &mt('Select Community');
1.906     raeburn   770:    } elsif ($selecttype eq 'Course/Community') {
                    771:        $linktext = &mt('Select Course/Community');
1.909     raeburn   772:        $type = '';
1.871     raeburn   773:    }
1.787     bisitz    774:    return '<span class="LC_nobreak">'
                    775:          ."<a href='"
                    776:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    777:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   778:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   779:          ."'>".$linktext.'</a>'
1.787     bisitz    780:          .'</span>';
1.74      www       781: }
1.42      matthew   782: 
1.653     raeburn   783: sub selectauthor_link {
                    784:    my ($form,$udom)=@_;
                    785:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    786:           &mt('Select Author').'</a>';
                    787: }
                    788: 
1.876     raeburn   789: sub selectuser_link {
1.881     raeburn   790:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   791:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   792:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   793:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   794:            ');">'.$linktext.'</a>';
1.876     raeburn   795: }
                    796: 
1.273     raeburn   797: sub check_uncheck_jscript {
                    798:     my $jscript = <<"ENDSCRT";
                    799: function checkAll(field) {
                    800:     if (field.length > 0) {
                    801:         for (i = 0; i < field.length; i++) {
                    802:             field[i].checked = true ;
                    803:         }
                    804:     } else {
                    805:         field.checked = true
                    806:     }
                    807: }
                    808:  
                    809: function uncheckAll(field) {
                    810:     if (field.length > 0) {
                    811:         for (i = 0; i < field.length; i++) {
                    812:             field[i].checked = false ;
1.543     albertel  813:         }
                    814:     } else {
1.273     raeburn   815:         field.checked = false ;
                    816:     }
                    817: }
                    818: ENDSCRT
                    819:     return $jscript;
                    820: }
                    821: 
1.656     www       822: sub select_timezone {
1.659     raeburn   823:    my ($name,$selected,$onchange,$includeempty)=@_;
                    824:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    825:    if ($includeempty) {
                    826:        $output .= '<option value=""';
                    827:        if (($selected eq '') || ($selected eq 'local')) {
                    828:            $output .= ' selected="selected" ';
                    829:        }
                    830:        $output .= '> </option>';
                    831:    }
1.657     raeburn   832:    my @timezones = DateTime::TimeZone->all_names;
                    833:    foreach my $tzone (@timezones) {
                    834:        $output.= '<option value="'.$tzone.'"';
                    835:        if ($tzone eq $selected) {
                    836:            $output.=' selected="selected"';
                    837:        }
                    838:        $output.=">$tzone</option>\n";
1.656     www       839:    }
                    840:    $output.="</select>";
                    841:    return $output;
                    842: }
1.273     raeburn   843: 
1.687     raeburn   844: sub select_datelocale {
                    845:     my ($name,$selected,$onchange,$includeempty)=@_;
                    846:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    847:     if ($includeempty) {
                    848:         $output .= '<option value=""';
                    849:         if ($selected eq '') {
                    850:             $output .= ' selected="selected" ';
                    851:         }
                    852:         $output .= '> </option>';
                    853:     }
                    854:     my (@possibles,%locale_names);
                    855:     my @locales = DateTime::Locale::Catalog::Locales;
                    856:     foreach my $locale (@locales) {
                    857:         if (ref($locale) eq 'HASH') {
                    858:             my $id = $locale->{'id'};
                    859:             if ($id ne '') {
                    860:                 my $en_terr = $locale->{'en_territory'};
                    861:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   862:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   863:                 if (grep(/^en$/,@languages) || !@languages) {
                    864:                     if ($en_terr ne '') {
                    865:                         $locale_names{$id} = '('.$en_terr.')';
                    866:                     } elsif ($native_terr ne '') {
                    867:                         $locale_names{$id} = $native_terr;
                    868:                     }
                    869:                 } else {
                    870:                     if ($native_terr ne '') {
                    871:                         $locale_names{$id} = $native_terr.' ';
                    872:                     } elsif ($en_terr ne '') {
                    873:                         $locale_names{$id} = '('.$en_terr.')';
                    874:                     }
                    875:                 }
                    876:                 push (@possibles,$id);
                    877:             }
                    878:         }
                    879:     }
                    880:     foreach my $item (sort(@possibles)) {
                    881:         $output.= '<option value="'.$item.'"';
                    882:         if ($item eq $selected) {
                    883:             $output.=' selected="selected"';
                    884:         }
                    885:         $output.=">$item";
                    886:         if ($locale_names{$item} ne '') {
                    887:             $output.="  $locale_names{$item}</option>\n";
                    888:         }
                    889:         $output.="</option>\n";
                    890:     }
                    891:     $output.="</select>";
                    892:     return $output;
                    893: }
                    894: 
1.792     raeburn   895: sub select_language {
                    896:     my ($name,$selected,$includeempty) = @_;
                    897:     my %langchoices;
                    898:     if ($includeempty) {
                    899:         %langchoices = ('' => 'No language preference');
                    900:     }
                    901:     foreach my $id (&languageids()) {
                    902:         my $code = &supportedlanguagecode($id);
                    903:         if ($code) {
                    904:             $langchoices{$code} = &plainlanguagedescription($id);
                    905:         }
                    906:     }
1.970     raeburn   907:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn   908: }
                    909: 
1.42      matthew   910: =pod
1.36      matthew   911: 
1.648     raeburn   912: =item * &linked_select_forms(...)
1.36      matthew   913: 
                    914: linked_select_forms returns a string containing a <script></script> block
                    915: and html for two <select> menus.  The select menus will be linked in that
                    916: changing the value of the first menu will result in new values being placed
                    917: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn   918: order unless a defined order is provided.
1.36      matthew   919: 
                    920: linked_select_forms takes the following ordered inputs:
                    921: 
                    922: =over 4
                    923: 
1.112     bowersj2  924: =item * $formname, the name of the <form> tag
1.36      matthew   925: 
1.112     bowersj2  926: =item * $middletext, the text which appears between the <select> tags
1.36      matthew   927: 
1.112     bowersj2  928: =item * $firstdefault, the default value for the first menu
1.36      matthew   929: 
1.112     bowersj2  930: =item * $firstselectname, the name of the first <select> tag
1.36      matthew   931: 
1.112     bowersj2  932: =item * $secondselectname, the name of the second <select> tag
1.36      matthew   933: 
1.112     bowersj2  934: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew   935: 
1.609     raeburn   936: =item * $menuorder, the order of values in the first menu
                    937: 
1.41      ng        938: =back 
                    939: 
1.36      matthew   940: Below is an example of such a hash.  Only the 'text', 'default', and 
                    941: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                    942: values for the first select menu.  The text that coincides with the 
1.41      ng        943: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew   944: and text for the second menu are given in the hash pointed to by 
                    945: $menu{$choice1}->{'select2'}.  
                    946: 
1.112     bowersj2  947:  my %menu = ( A1 => { text =>"Choice A1" ,
                    948:                        default => "B3",
                    949:                        select2 => { 
                    950:                            B1 => "Choice B1",
                    951:                            B2 => "Choice B2",
                    952:                            B3 => "Choice B3",
                    953:                            B4 => "Choice B4"
1.609     raeburn   954:                            },
                    955:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2  956:                    },
                    957:                A2 => { text =>"Choice A2" ,
                    958:                        default => "C2",
                    959:                        select2 => { 
                    960:                            C1 => "Choice C1",
                    961:                            C2 => "Choice C2",
                    962:                            C3 => "Choice C3"
1.609     raeburn   963:                            },
                    964:                        order => ['C2','C1','C3'],
1.112     bowersj2  965:                    },
                    966:                A3 => { text =>"Choice A3" ,
                    967:                        default => "D6",
                    968:                        select2 => { 
                    969:                            D1 => "Choice D1",
                    970:                            D2 => "Choice D2",
                    971:                            D3 => "Choice D3",
                    972:                            D4 => "Choice D4",
                    973:                            D5 => "Choice D5",
                    974:                            D6 => "Choice D6",
                    975:                            D7 => "Choice D7"
1.609     raeburn   976:                            },
                    977:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2  978:                    }
                    979:                );
1.36      matthew   980: 
                    981: =cut
                    982: 
                    983: sub linked_select_forms {
                    984:     my ($formname,
                    985:         $middletext,
                    986:         $firstdefault,
                    987:         $firstselectname,
                    988:         $secondselectname, 
1.609     raeburn   989:         $hashref,
                    990:         $menuorder,
1.36      matthew   991:         ) = @_;
                    992:     my $second = "document.$formname.$secondselectname";
                    993:     my $first = "document.$formname.$firstselectname";
                    994:     # output the javascript to do the changing
                    995:     my $result = '';
1.776     bisitz    996:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz    997:     $result.="// <![CDATA[\n";
1.36      matthew   998:     $result.="var select2data = new Object();\n";
                    999:     $" = '","';
                   1000:     my $debug = '';
                   1001:     foreach my $s1 (sort(keys(%$hashref))) {
                   1002:         $result.="select2data.d_$s1 = new Object();\n";        
                   1003:         $result.="select2data.d_$s1.def = new String('".
                   1004:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1005:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1006:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1007:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1008:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1009:         }
1.36      matthew  1010:         $result.="\"@s2values\");\n";
                   1011:         $result.="select2data.d_$s1.texts = new Array(";        
                   1012:         my @s2texts;
                   1013:         foreach my $value (@s2values) {
                   1014:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1015:         }
                   1016:         $result.="\"@s2texts\");\n";
                   1017:     }
                   1018:     $"=' ';
                   1019:     $result.= <<"END";
                   1020: 
                   1021: function select1_changed() {
                   1022:     // Determine new choice
                   1023:     var newvalue = "d_" + $first.value;
                   1024:     // update select2
                   1025:     var values     = select2data[newvalue].values;
                   1026:     var texts      = select2data[newvalue].texts;
                   1027:     var select2def = select2data[newvalue].def;
                   1028:     var i;
                   1029:     // out with the old
                   1030:     for (i = 0; i < $second.options.length; i++) {
                   1031:         $second.options[i] = null;
                   1032:     }
                   1033:     // in with the nuclear
                   1034:     for (i=0;i<values.length; i++) {
                   1035:         $second.options[i] = new Option(values[i]);
1.143     matthew  1036:         $second.options[i].value = values[i];
1.36      matthew  1037:         $second.options[i].text = texts[i];
                   1038:         if (values[i] == select2def) {
                   1039:             $second.options[i].selected = true;
                   1040:         }
                   1041:     }
                   1042: }
1.824     bisitz   1043: // ]]>
1.36      matthew  1044: </script>
                   1045: END
                   1046:     # output the initial values for the selection lists
                   1047:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1048:     my @order = sort(keys(%{$hashref}));
                   1049:     if (ref($menuorder) eq 'ARRAY') {
                   1050:         @order = @{$menuorder};
                   1051:     }
                   1052:     foreach my $value (@order) {
1.36      matthew  1053:         $result.="    <option value=\"$value\" ";
1.253     albertel 1054:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1055:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1056:     }
                   1057:     $result .= "</select>\n";
                   1058:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1059:     $result .= $middletext;
                   1060:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1061:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1062:     
                   1063:     my @secondorder = sort(keys(%select2));
                   1064:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1065:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1066:     }
                   1067:     foreach my $value (@secondorder) {
1.36      matthew  1068:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1069:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1070:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1071:     }
                   1072:     $result .= "</select>\n";
                   1073:     #    return $debug;
                   1074:     return $result;
                   1075: }   #  end of sub linked_select_forms {
                   1076: 
1.45      matthew  1077: =pod
1.44      bowersj2 1078: 
1.973     raeburn  1079: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1080: 
1.112     bowersj2 1081: Returns a string corresponding to an HTML link to the given help
                   1082: $topic, where $topic corresponds to the name of a .tex file in
                   1083: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1084: spaces. 
                   1085: 
                   1086: $text will optionally be linked to the same topic, allowing you to
                   1087: link text in addition to the graphic. If you do not want to link
                   1088: text, but wish to specify one of the later parameters, pass an
                   1089: empty string. 
                   1090: 
                   1091: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1092: the link will not open a new window. If false, the link will open
                   1093: a new window using Javascript. (Default is false.) 
                   1094: 
                   1095: $width and $height are optional numerical parameters that will
                   1096: override the width and height of the popped up window, which may
1.973     raeburn  1097: be useful for certain help topics with big pictures included.
                   1098: 
                   1099: $imgid is the id of the img tag used for the help icon. This may be
                   1100: used in a javascript call to switch the image src.  See 
                   1101: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1102: 
                   1103: =cut
                   1104: 
                   1105: sub help_open_topic {
1.973     raeburn  1106:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1107:     $text = "" if (not defined $text);
1.44      bowersj2 1108:     $stayOnPage = 0 if (not defined $stayOnPage);
                   1109:     $width = 350 if (not defined $width);
                   1110:     $height = 400 if (not defined $height);
                   1111:     my $filename = $topic;
                   1112:     $filename =~ s/ /_/g;
                   1113: 
1.48      bowersj2 1114:     my $template = "";
                   1115:     my $link;
1.572     banghart 1116:     
1.159     www      1117:     $topic=~s/\W/\_/g;
1.44      bowersj2 1118: 
1.572     banghart 1119:     if (!$stayOnPage) {
1.72      bowersj2 1120: 	$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 1121:     } else {
1.48      bowersj2 1122: 	$link = "/adm/help/${filename}.hlp";
                   1123:     }
                   1124: 
                   1125:     # Add the text
1.755     neumanie 1126:     if ($text ne "") {	
1.763     bisitz   1127: 	$template.='<span class="LC_help_open_topic">'
                   1128:                   .'<a target="_top" href="'.$link.'">'
                   1129:                   .$text.'</a>';
1.48      bowersj2 1130:     }
                   1131: 
1.763     bisitz   1132:     # (Always) Add the graphic
1.179     matthew  1133:     my $title = &mt('Online Help');
1.667     raeburn  1134:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1135:     if ($imgid ne '') {
                   1136:         $imgid = ' id="'.$imgid.'"';
                   1137:     }
1.763     bisitz   1138:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1139:               .'<img src="'.$helpicon.'" border="0"'
                   1140:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1141:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1142:               .' /></a>';
                   1143:     if ($text ne "") {	
                   1144:         $template.='</span>';
                   1145:     }
1.44      bowersj2 1146:     return $template;
                   1147: 
1.106     bowersj2 1148: }
                   1149: 
                   1150: # This is a quicky function for Latex cheatsheet editing, since it 
                   1151: # appears in at least four places
                   1152: sub helpLatexCheatsheet {
1.732     raeburn  1153:     my ($topic,$text,$not_author) = @_;
                   1154:     my $out;
1.106     bowersj2 1155:     my $addOther = '';
1.732     raeburn  1156:     if ($topic) {
1.763     bisitz   1157: 	$addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),
                   1158: 							       undef, undef, 600).
                   1159: 								   '</span> ';
                   1160:     }
                   1161:     $out = '<span>' # Start cheatsheet
                   1162: 	  .$addOther
                   1163:           .'<span>'
                   1164: 	  .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
                   1165: 					       undef,undef,600)
                   1166: 	  .'</span> <span>'
                   1167: 	  .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
                   1168: 					       undef,undef,600)
                   1169: 	  .'</span>';
1.732     raeburn  1170:     unless ($not_author) {
1.763     bisitz   1171:         $out .= ' <span>'
                   1172: 	       .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
                   1173: 	                                            undef,undef,600)
                   1174: 	       .'</span>';
1.732     raeburn  1175:     }
1.763     bisitz   1176:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1177:     return $out;
1.172     www      1178: }
                   1179: 
1.430     albertel 1180: sub general_help {
                   1181:     my $helptopic='Student_Intro';
                   1182:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1183: 	$helptopic='Authoring_Intro';
1.907     raeburn  1184:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1185: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1186:     } elsif ($env{'request.role'}=~/^dc/) {
                   1187:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1188:     }
                   1189:     return $helptopic;
                   1190: }
                   1191: 
                   1192: sub update_help_link {
                   1193:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1194:     my $origurl = $ENV{'REQUEST_URI'};
                   1195:     $origurl=~s|^/~|/priv/|;
                   1196:     my $timestamp = time;
                   1197:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1198:         $$datum = &escape($$datum);
                   1199:     }
                   1200: 
                   1201:     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";
                   1202:     my $output .= <<"ENDOUTPUT";
                   1203: <script type="text/javascript">
1.824     bisitz   1204: // <![CDATA[
1.430     albertel 1205: banner_link = '$banner_link';
1.824     bisitz   1206: // ]]>
1.430     albertel 1207: </script>
                   1208: ENDOUTPUT
                   1209:     return $output;
                   1210: }
                   1211: 
                   1212: # now just updates the help link and generates a blue icon
1.193     raeburn  1213: sub help_open_menu {
1.430     albertel 1214:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1215: 	= @_;    
1.949     droeschl 1216:     $stayOnPage = 1;
1.430     albertel 1217:     my $output;
                   1218:     if ($component_help) {
                   1219: 	if (!$text) {
                   1220: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1221: 				       $width,$height);
                   1222: 	} else {
                   1223: 	    my $help_text;
                   1224: 	    $help_text=&unescape($topic);
                   1225: 	    $output='<table><tr><td>'.
                   1226: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1227: 				 $width,$height).'</td></tr></table>';
                   1228: 	}
                   1229:     }
                   1230:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1231:     return $output.$banner_link;
                   1232: }
                   1233: 
                   1234: sub top_nav_help {
                   1235:     my ($text) = @_;
1.436     albertel 1236:     $text = &mt($text);
1.949     droeschl 1237:     my $stay_on_page = 1;
                   1238: 
1.572     banghart 1239:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1240: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1241:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1242: 
1.201     raeburn  1243:     my $title = &mt('Get help');
1.436     albertel 1244: 
                   1245:     return <<"END";
                   1246: $banner_link
                   1247:  <a href="$link" title="$title">$text</a>
                   1248: END
                   1249: }
                   1250: 
                   1251: sub help_menu_js {
                   1252:     my ($text) = @_;
1.949     droeschl 1253:     my $stayOnPage = 1;
1.436     albertel 1254:     my $width = 620;
                   1255:     my $height = 600;
1.430     albertel 1256:     my $helptopic=&general_help();
                   1257:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1258:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1259:     my $start_page =
                   1260:         &Apache::loncommon::start_page('Help Menu', undef,
                   1261: 				       {'frameset'    => 1,
                   1262: 					'js_ready'    => 1,
                   1263: 					'add_entries' => {
                   1264: 					    'border' => '0',
1.579     raeburn  1265: 					    'rows'   => "110,*",},});
1.331     albertel 1266:     my $end_page =
                   1267:         &Apache::loncommon::end_page({'frameset' => 1,
                   1268: 				      'js_ready' => 1,});
                   1269: 
1.436     albertel 1270:     my $template .= <<"ENDTEMPLATE";
                   1271: <script type="text/javascript">
1.877     bisitz   1272: // <![CDATA[
1.253     albertel 1273: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1274: var banner_link = '';
1.243     raeburn  1275: function helpMenu(target) {
                   1276:     var caller = this;
                   1277:     if (target == 'open') {
                   1278:         var newWindow = null;
                   1279:         try {
1.262     albertel 1280:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1281:         }
                   1282:         catch(error) {
                   1283:             writeHelp(caller);
                   1284:             return;
                   1285:         }
                   1286:         if (newWindow) {
                   1287:             caller = newWindow;
                   1288:         }
1.193     raeburn  1289:     }
1.243     raeburn  1290:     writeHelp(caller);
                   1291:     return;
                   1292: }
                   1293: function writeHelp(caller) {
1.430     albertel 1294:     caller.document.writeln('$start_page<frame name="bannerframe"  src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243     raeburn  1295:     caller.document.close()
                   1296:     caller.focus()
1.193     raeburn  1297: }
1.877     bisitz   1298: // END LON-CAPA Internal -->
1.253     albertel 1299: // ]]>
1.436     albertel 1300: </script>
1.193     raeburn  1301: ENDTEMPLATE
                   1302:     return $template;
                   1303: }
                   1304: 
1.172     www      1305: sub help_open_bug {
                   1306:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1307:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1308:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1309:     $text = "" if (not defined $text);
                   1310: 	$stayOnPage=1;
1.184     albertel 1311:     $width = 600 if (not defined $width);
                   1312:     $height = 600 if (not defined $height);
1.172     www      1313: 
                   1314:     $topic=~s/\W+/\+/g;
                   1315:     my $link='';
                   1316:     my $template='';
1.379     albertel 1317:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1318: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1319:     if (!$stayOnPage)
                   1320:     {
                   1321: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1322:     }
                   1323:     else
                   1324:     {
                   1325: 	$link = $url;
                   1326:     }
                   1327:     # Add the text
                   1328:     if ($text ne "")
                   1329:     {
                   1330: 	$template .= 
                   1331:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1332:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1333:     }
                   1334: 
                   1335:     # Add the graphic
1.179     matthew  1336:     my $title = &mt('Report a Bug');
1.215     albertel 1337:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1338:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1339:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1340: ENDTEMPLATE
                   1341:     if ($text ne '') { $template.='</td></tr></table>' };
                   1342:     return $template;
                   1343: 
                   1344: }
                   1345: 
                   1346: sub help_open_faq {
                   1347:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1348:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1349:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1350:     $text = "" if (not defined $text);
                   1351: 	$stayOnPage=1;
                   1352:     $width = 350 if (not defined $width);
                   1353:     $height = 400 if (not defined $height);
                   1354: 
                   1355:     $topic=~s/\W+/\+/g;
                   1356:     my $link='';
                   1357:     my $template='';
                   1358:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1359:     if (!$stayOnPage)
                   1360:     {
                   1361: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1362:     }
                   1363:     else
                   1364:     {
                   1365: 	$link = $url;
                   1366:     }
                   1367: 
                   1368:     # Add the text
                   1369:     if ($text ne "")
                   1370:     {
                   1371: 	$template .= 
1.173     www      1372:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1373:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1374:     }
                   1375: 
                   1376:     # Add the graphic
1.179     matthew  1377:     my $title = &mt('View the FAQ');
1.215     albertel 1378:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1379:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1380:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1381: ENDTEMPLATE
                   1382:     if ($text ne '') { $template.='</td></tr></table>' };
                   1383:     return $template;
                   1384: 
1.44      bowersj2 1385: }
1.37      matthew  1386: 
1.180     matthew  1387: ###############################################################
                   1388: ###############################################################
                   1389: 
1.45      matthew  1390: =pod
                   1391: 
1.648     raeburn  1392: =item * &change_content_javascript():
1.256     matthew  1393: 
                   1394: This and the next function allow you to create small sections of an
                   1395: otherwise static HTML page that you can update on the fly with
                   1396: Javascript, even in Netscape 4.
                   1397: 
                   1398: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1399: must be written to the HTML page once. It will prove the Javascript
                   1400: function "change(name, content)". Calling the change function with the
                   1401: name of the section 
                   1402: you want to update, matching the name passed to C<changable_area>, and
                   1403: the new content you want to put in there, will put the content into
                   1404: that area.
                   1405: 
                   1406: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1407: to contain room for the original contents. You need to "make space"
                   1408: for whatever changes you wish to make, and be B<sure> to check your
                   1409: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1410: it's adequate for updating a one-line status display, but little more.
                   1411: This script will set the space to 100% width, so you only need to
                   1412: worry about height in Netscape 4.
                   1413: 
                   1414: Modern browsers are much less limiting, and if you can commit to the
                   1415: user not using Netscape 4, this feature may be used freely with
                   1416: pretty much any HTML.
                   1417: 
                   1418: =cut
                   1419: 
                   1420: sub change_content_javascript {
                   1421:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1422:     if ($env{'browser.type'} eq 'netscape' &&
                   1423: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1424: 	return (<<NETSCAPE4);
                   1425: 	function change(name, content) {
                   1426: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1427: 	    doc.open();
                   1428: 	    doc.write(content);
                   1429: 	    doc.close();
                   1430: 	}
                   1431: NETSCAPE4
                   1432:     } else {
                   1433: 	# Otherwise, we need to use semi-standards-compliant code
                   1434: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1435: 	# is really scary, and every useful browser supports it
                   1436: 	return (<<DOMBASED);
                   1437: 	function change(name, content) {
                   1438: 	    element = document.getElementById(name);
                   1439: 	    element.innerHTML = content;
                   1440: 	}
                   1441: DOMBASED
                   1442:     }
                   1443: }
                   1444: 
                   1445: =pod
                   1446: 
1.648     raeburn  1447: =item * &changable_area($name,$origContent):
1.256     matthew  1448: 
                   1449: This provides a "changable area" that can be modified on the fly via
                   1450: the Javascript code provided in C<change_content_javascript>. $name is
                   1451: the name you will use to reference the area later; do not repeat the
                   1452: same name on a given HTML page more then once. $origContent is what
                   1453: the area will originally contain, which can be left blank.
                   1454: 
                   1455: =cut
                   1456: 
                   1457: sub changable_area {
                   1458:     my ($name, $origContent) = @_;
                   1459: 
1.258     albertel 1460:     if ($env{'browser.type'} eq 'netscape' &&
                   1461: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1462: 	# If this is netscape 4, we need to use the Layer tag
                   1463: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1464:     } else {
                   1465: 	return "<span id='$name'>$origContent</span>";
                   1466:     }
                   1467: }
                   1468: 
                   1469: =pod
                   1470: 
1.648     raeburn  1471: =item * &viewport_geometry_js 
1.590     raeburn  1472: 
                   1473: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1474: 
                   1475: =cut
                   1476: 
                   1477: 
                   1478: sub viewport_geometry_js { 
                   1479:     return <<"GEOMETRY";
                   1480: var Geometry = {};
                   1481: function init_geometry() {
                   1482:     if (Geometry.init) { return };
                   1483:     Geometry.init=1;
                   1484:     if (window.innerHeight) {
                   1485:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1486:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1487:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1488:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1489:     }
                   1490:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1491:         Geometry.getViewportHeight =
                   1492:             function() { return document.documentElement.clientHeight; };
                   1493:         Geometry.getViewportWidth =
                   1494:             function() { return document.documentElement.clientWidth; };
                   1495: 
                   1496:         Geometry.getHorizontalScroll =
                   1497:             function() { return document.documentElement.scrollLeft; };
                   1498:         Geometry.getVerticalScroll =
                   1499:             function() { return document.documentElement.scrollTop; };
                   1500:     }
                   1501:     else if (document.body.clientHeight) {
                   1502:         Geometry.getViewportHeight =
                   1503:             function() { return document.body.clientHeight; };
                   1504:         Geometry.getViewportWidth =
                   1505:             function() { return document.body.clientWidth; };
                   1506:         Geometry.getHorizontalScroll =
                   1507:             function() { return document.body.scrollLeft; };
                   1508:         Geometry.getVerticalScroll =
                   1509:             function() { return document.body.scrollTop; };
                   1510:     }
                   1511: }
                   1512: 
                   1513: GEOMETRY
                   1514: }
                   1515: 
                   1516: =pod
                   1517: 
1.648     raeburn  1518: =item * &viewport_size_js()
1.590     raeburn  1519: 
                   1520: 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. 
                   1521: 
                   1522: =cut
                   1523: 
                   1524: sub viewport_size_js {
                   1525:     my $geometry = &viewport_geometry_js();
                   1526:     return <<"DIMS";
                   1527: 
                   1528: $geometry
                   1529: 
                   1530: function getViewportDims(width,height) {
                   1531:     init_geometry();
                   1532:     width.value = Geometry.getViewportWidth();
                   1533:     height.value = Geometry.getViewportHeight();
                   1534:     return;
                   1535: }
                   1536: 
                   1537: DIMS
                   1538: }
                   1539: 
                   1540: =pod
                   1541: 
1.648     raeburn  1542: =item * &resize_textarea_js()
1.565     albertel 1543: 
                   1544: emits the needed javascript to resize a textarea to be as big as possible
                   1545: 
                   1546: creates a function resize_textrea that takes two IDs first should be
                   1547: the id of the element to resize, second should be the id of a div that
                   1548: surrounds everything that comes after the textarea, this routine needs
                   1549: to be attached to the <body> for the onload and onresize events.
                   1550: 
1.648     raeburn  1551: =back
1.565     albertel 1552: 
                   1553: =cut
                   1554: 
                   1555: sub resize_textarea_js {
1.590     raeburn  1556:     my $geometry = &viewport_geometry_js();
1.565     albertel 1557:     return <<"RESIZE";
                   1558:     <script type="text/javascript">
1.824     bisitz   1559: // <![CDATA[
1.590     raeburn  1560: $geometry
1.565     albertel 1561: 
1.588     albertel 1562: function getX(element) {
                   1563:     var x = 0;
                   1564:     while (element) {
                   1565: 	x += element.offsetLeft;
                   1566: 	element = element.offsetParent;
                   1567:     }
                   1568:     return x;
                   1569: }
                   1570: function getY(element) {
                   1571:     var y = 0;
                   1572:     while (element) {
                   1573: 	y += element.offsetTop;
                   1574: 	element = element.offsetParent;
                   1575:     }
                   1576:     return y;
                   1577: }
                   1578: 
                   1579: 
1.565     albertel 1580: function resize_textarea(textarea_id,bottom_id) {
                   1581:     init_geometry();
                   1582:     var textarea        = document.getElementById(textarea_id);
                   1583:     //alert(textarea);
                   1584: 
1.588     albertel 1585:     var textarea_top    = getY(textarea);
1.565     albertel 1586:     var textarea_height = textarea.offsetHeight;
                   1587:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1588:     var bottom_top      = getY(bottom);
1.565     albertel 1589:     var bottom_height   = bottom.offsetHeight;
                   1590:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1591:     var fudge           = 23;
1.565     albertel 1592:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1593:     if (new_height < 300) {
                   1594: 	new_height = 300;
                   1595:     }
                   1596:     textarea.style.height=new_height+'px';
                   1597: }
1.824     bisitz   1598: // ]]>
1.565     albertel 1599: </script>
                   1600: RESIZE
                   1601: 
                   1602: }
                   1603: 
                   1604: =pod
                   1605: 
1.256     matthew  1606: =head1 Excel and CSV file utility routines
                   1607: 
                   1608: =over 4
                   1609: 
                   1610: =cut
                   1611: 
                   1612: ###############################################################
                   1613: ###############################################################
                   1614: 
                   1615: =pod
                   1616: 
1.648     raeburn  1617: =item * &csv_translate($text) 
1.37      matthew  1618: 
1.185     www      1619: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1620: format.
                   1621: 
                   1622: =cut
                   1623: 
1.180     matthew  1624: ###############################################################
                   1625: ###############################################################
1.37      matthew  1626: sub csv_translate {
                   1627:     my $text = shift;
                   1628:     $text =~ s/\"/\"\"/g;
1.209     albertel 1629:     $text =~ s/\n/ /g;
1.37      matthew  1630:     return $text;
                   1631: }
1.180     matthew  1632: 
                   1633: ###############################################################
                   1634: ###############################################################
                   1635: 
                   1636: =pod
                   1637: 
1.648     raeburn  1638: =item * &define_excel_formats()
1.180     matthew  1639: 
                   1640: Define some commonly used Excel cell formats.
                   1641: 
                   1642: Currently supported formats:
                   1643: 
                   1644: =over 4
                   1645: 
                   1646: =item header
                   1647: 
                   1648: =item bold
                   1649: 
                   1650: =item h1
                   1651: 
                   1652: =item h2
                   1653: 
                   1654: =item h3
                   1655: 
1.256     matthew  1656: =item h4
                   1657: 
                   1658: =item i
                   1659: 
1.180     matthew  1660: =item date
                   1661: 
                   1662: =back
                   1663: 
                   1664: Inputs: $workbook
                   1665: 
                   1666: Returns: $format, a hash reference.
                   1667: 
                   1668: =cut
                   1669: 
                   1670: ###############################################################
                   1671: ###############################################################
                   1672: sub define_excel_formats {
                   1673:     my ($workbook) = @_;
                   1674:     my $format;
                   1675:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1676:                                                 bottom    => 1,
                   1677:                                                 align     => 'center');
                   1678:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1679:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1680:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1681:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1682:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1683:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1684:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1685:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1686:     return $format;
                   1687: }
                   1688: 
                   1689: ###############################################################
                   1690: ###############################################################
1.113     bowersj2 1691: 
                   1692: =pod
                   1693: 
1.648     raeburn  1694: =item * &create_workbook()
1.255     matthew  1695: 
                   1696: Create an Excel worksheet.  If it fails, output message on the
                   1697: request object and return undefs.
                   1698: 
                   1699: Inputs: Apache request object
                   1700: 
                   1701: Returns (undef) on failure, 
                   1702:     Excel worksheet object, scalar with filename, and formats 
                   1703:     from &Apache::loncommon::define_excel_formats on success
                   1704: 
                   1705: =cut
                   1706: 
                   1707: ###############################################################
                   1708: ###############################################################
                   1709: sub create_workbook {
                   1710:     my ($r) = @_;
                   1711:         #
                   1712:     # Create the excel spreadsheet
                   1713:     my $filename = '/prtspool/'.
1.258     albertel 1714:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1715:         time.'_'.rand(1000000000).'.xls';
                   1716:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1717:     if (! defined($workbook)) {
                   1718:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1719:         $r->print(
                   1720:             '<p class="LC_error">'
                   1721:            .&mt('Problems occurred in creating the new Excel file.')
                   1722:            .' '.&mt('This error has been logged.')
                   1723:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1724:            .'</p>'
                   1725:         );
1.255     matthew  1726:         return (undef);
                   1727:     }
                   1728:     #
                   1729:     $workbook->set_tempdir('/home/httpd/perl/tmp');
                   1730:     #
                   1731:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1732:     return ($workbook,$filename,$format);
                   1733: }
                   1734: 
                   1735: ###############################################################
                   1736: ###############################################################
                   1737: 
                   1738: =pod
                   1739: 
1.648     raeburn  1740: =item * &create_text_file()
1.113     bowersj2 1741: 
1.542     raeburn  1742: Create a file to write to and eventually make available to the user.
1.256     matthew  1743: If file creation fails, outputs an error message on the request object and 
                   1744: return undefs.
1.113     bowersj2 1745: 
1.256     matthew  1746: Inputs: Apache request object, and file suffix
1.113     bowersj2 1747: 
1.256     matthew  1748: Returns (undef) on failure, 
                   1749:     Filehandle and filename on success.
1.113     bowersj2 1750: 
                   1751: =cut
                   1752: 
1.256     matthew  1753: ###############################################################
                   1754: ###############################################################
                   1755: sub create_text_file {
                   1756:     my ($r,$suffix) = @_;
                   1757:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1758:     my $fh;
                   1759:     my $filename = '/prtspool/'.
1.258     albertel 1760:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1761:         time.'_'.rand(1000000000).'.'.$suffix;
                   1762:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1763:     if (! defined($fh)) {
                   1764:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1765:         $r->print(
                   1766:             '<p class="LC_error">'
                   1767:            .&mt('Problems occurred in creating the output file.')
                   1768:            .' '.&mt('This error has been logged.')
                   1769:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1770:            .'</p>'
                   1771:         );
1.113     bowersj2 1772:     }
1.256     matthew  1773:     return ($fh,$filename)
1.113     bowersj2 1774: }
                   1775: 
                   1776: 
1.256     matthew  1777: =pod 
1.113     bowersj2 1778: 
                   1779: =back
                   1780: 
                   1781: =cut
1.37      matthew  1782: 
                   1783: ###############################################################
1.33      matthew  1784: ##        Home server <option> list generating code          ##
                   1785: ###############################################################
1.35      matthew  1786: 
1.169     www      1787: # ------------------------------------------
                   1788: 
                   1789: sub domain_select {
                   1790:     my ($name,$value,$multiple)=@_;
                   1791:     my %domains=map { 
1.514     albertel 1792: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1793:     } &Apache::lonnet::all_domains();
1.169     www      1794:     if ($multiple) {
                   1795: 	$domains{''}=&mt('Any domain');
1.550     albertel 1796: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1797: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1798:     } else {
1.550     albertel 1799: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1800: 	return &select_form($name,$value,\%domains);
1.169     www      1801:     }
                   1802: }
                   1803: 
1.282     albertel 1804: #-------------------------------------------
                   1805: 
                   1806: =pod
                   1807: 
1.519     raeburn  1808: =head1 Routines for form select boxes
                   1809: 
                   1810: =over 4
                   1811: 
1.648     raeburn  1812: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1813: 
                   1814: Returns a string containing a <select> element int multiple mode
                   1815: 
                   1816: 
                   1817: Args:
                   1818:   $name - name of the <select> element
1.506     raeburn  1819:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1820:   $size - number of rows long the select element is
1.283     albertel 1821:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1822:           (shown text should already have been &mt())
1.506     raeburn  1823:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1824: 
1.282     albertel 1825: =cut
                   1826: 
                   1827: #-------------------------------------------
1.169     www      1828: sub multiple_select_form {
1.284     albertel 1829:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1830:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1831:     my $output='';
1.191     matthew  1832:     if (! defined($size)) {
                   1833:         $size = 4;
1.283     albertel 1834:         if (scalar(keys(%$hash))<4) {
                   1835:             $size = scalar(keys(%$hash));
1.191     matthew  1836:         }
                   1837:     }
1.734     bisitz   1838:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1839:     my @order;
1.506     raeburn  1840:     if (ref($order) eq 'ARRAY')  {
                   1841:         @order = @{$order};
                   1842:     } else {
                   1843:         @order = sort(keys(%$hash));
1.501     banghart 1844:     }
                   1845:     if (exists($$hash{'select_form_order'})) {
                   1846:         @order = @{$$hash{'select_form_order'}};
                   1847:     }
                   1848:         
1.284     albertel 1849:     foreach my $key (@order) {
1.356     albertel 1850:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1851:         $output.='selected="selected" ' if ($selected{$key});
                   1852:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1853:     }
                   1854:     $output.="</select>\n";
                   1855:     return $output;
                   1856: }
                   1857: 
1.88      www      1858: #-------------------------------------------
                   1859: 
                   1860: =pod
                   1861: 
1.970     raeburn  1862: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1863: 
                   1864: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1865: allow a user to select options from a ref to a hash containing:
                   1866: option_name => displayed text. An optional $onchange can include
                   1867: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1868: 
1.88      www      1869: See lonrights.pm for an example invocation and use.
                   1870: 
                   1871: =cut
                   1872: 
                   1873: #-------------------------------------------
                   1874: sub select_form {
1.970     raeburn  1875:     my ($def,$name,$hashref,$onchange) = @_;
                   1876:     return unless (ref($hashref) eq 'HASH');
                   1877:     if ($onchange) {
                   1878:         $onchange = ' onchange="'.$onchange.'"';
                   1879:     }
                   1880:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1881:     my @keys;
1.970     raeburn  1882:     if (exists($hashref->{'select_form_order'})) {
                   1883: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1884:     } else {
1.970     raeburn  1885: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1886:     }
1.356     albertel 1887:     foreach my $key (@keys) {
                   1888:         $selectform.=
                   1889: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1890:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1891:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1892:     }
                   1893:     $selectform.="</select>";
                   1894:     return $selectform;
                   1895: }
                   1896: 
1.475     www      1897: # For display filters
                   1898: 
                   1899: sub display_filter {
                   1900:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1901:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1902:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1903: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1904: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1905: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1906:            &mt('Filter [_1]',
1.477     www      1907: 	   &select_form($env{'form.displayfilter'},
                   1908: 			'displayfilter',
1.970     raeburn  1909: 			{'currentfolder' => 'Current folder/page',
1.477     www      1910: 			 'containing' => 'Containing phrase',
1.970     raeburn  1911: 			 'none' => 'None'})).
1.714     bisitz   1912: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1913: }
                   1914: 
1.167     www      1915: sub gradeleveldescription {
                   1916:     my $gradelevel=shift;
                   1917:     my %gradelevels=(0 => 'Not specified',
                   1918: 		     1 => 'Grade 1',
                   1919: 		     2 => 'Grade 2',
                   1920: 		     3 => 'Grade 3',
                   1921: 		     4 => 'Grade 4',
                   1922: 		     5 => 'Grade 5',
                   1923: 		     6 => 'Grade 6',
                   1924: 		     7 => 'Grade 7',
                   1925: 		     8 => 'Grade 8',
                   1926: 		     9 => 'Grade 9',
                   1927: 		     10 => 'Grade 10',
                   1928: 		     11 => 'Grade 11',
                   1929: 		     12 => 'Grade 12',
                   1930: 		     13 => 'Grade 13',
                   1931: 		     14 => '100 Level',
                   1932: 		     15 => '200 Level',
                   1933: 		     16 => '300 Level',
                   1934: 		     17 => '400 Level',
                   1935: 		     18 => 'Graduate Level');
                   1936:     return &mt($gradelevels{$gradelevel});
                   1937: }
                   1938: 
1.163     www      1939: sub select_level_form {
                   1940:     my ($deflevel,$name)=@_;
                   1941:     unless ($deflevel) { $deflevel=0; }
1.167     www      1942:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   1943:     for (my $i=0; $i<=18; $i++) {
                   1944:         $selectform.="<option value=\"$i\" ".
1.253     albertel 1945:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      1946:                 ">".&gradeleveldescription($i)."</option>\n";
                   1947:     }
                   1948:     $selectform.="</select>";
                   1949:     return $selectform;
1.163     www      1950: }
1.167     www      1951: 
1.35      matthew  1952: #-------------------------------------------
                   1953: 
1.45      matthew  1954: =pod
                   1955: 
1.910     raeburn  1956: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  1957: 
                   1958: Returns a string containing a <select name='$name' size='1'> form to 
                   1959: allow a user to select the domain to preform an operation in.  
                   1960: See loncreateuser.pm for an example invocation and use.
                   1961: 
1.90      www      1962: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   1963: selected");
                   1964: 
1.743     raeburn  1965: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   1966: 
1.910     raeburn  1967: 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.
                   1968: 
                   1969: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  1970: 
1.35      matthew  1971: =cut
                   1972: 
                   1973: #-------------------------------------------
1.34      matthew  1974: sub select_dom_form {
1.910     raeburn  1975:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  1976:     if ($onchange) {
1.874     raeburn  1977:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  1978:     }
1.910     raeburn  1979:     my @domains;
                   1980:     if (ref($incdoms) eq 'ARRAY') {
                   1981:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   1982:     } else {
                   1983:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   1984:     }
1.90      www      1985:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  1986:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 1987:     foreach my $dom (@domains) {
                   1988:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  1989:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   1990:         if ($showdomdesc) {
                   1991:             if ($dom ne '') {
                   1992:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   1993:                 if ($domdesc ne '') {
                   1994:                     $selectdomain .= ' ('.$domdesc.')';
                   1995:                 }
                   1996:             } 
                   1997:         }
                   1998:         $selectdomain .= "</option>\n";
1.34      matthew  1999:     }
                   2000:     $selectdomain.="</select>";
                   2001:     return $selectdomain;
                   2002: }
                   2003: 
1.35      matthew  2004: #-------------------------------------------
                   2005: 
1.45      matthew  2006: =pod
                   2007: 
1.648     raeburn  2008: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2009: 
1.586     raeburn  2010: input: 4 arguments (two required, two optional) - 
                   2011:     $domain - domain of new user
                   2012:     $name - name of form element
                   2013:     $default - Value of 'default' causes a default item to be first 
                   2014:                             option, and selected by default. 
                   2015:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2016:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2017: output: returns 2 items: 
1.586     raeburn  2018: (a) form element which contains either:
                   2019:    (i) <select name="$name">
                   2020:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2021:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2022:        </select>
                   2023:        form item if there are multiple library servers in $domain, or
                   2024:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2025:        if there is only one library server in $domain.
                   2026: 
                   2027: (b) number of library servers found.
                   2028: 
                   2029: See loncreateuser.pm for example of use.
1.35      matthew  2030: 
                   2031: =cut
                   2032: 
                   2033: #-------------------------------------------
1.586     raeburn  2034: sub home_server_form_item {
                   2035:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2036:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2037:     my $result;
                   2038:     my $numlib = keys(%servers);
                   2039:     if ($numlib > 1) {
                   2040:         $result .= '<select name="'.$name.'" />'."\n";
                   2041:         if ($default) {
1.804     bisitz   2042:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2043:                        '</option>'."\n";
                   2044:         }
                   2045:         foreach my $hostid (sort(keys(%servers))) {
                   2046:             $result.= '<option value="'.$hostid.'">'.
                   2047: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2048:         }
                   2049:         $result .= '</select>'."\n";
                   2050:     } elsif ($numlib == 1) {
                   2051:         my $hostid;
                   2052:         foreach my $item (keys(%servers)) {
                   2053:             $hostid = $item;
                   2054:         }
                   2055:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2056:                    $hostid.'" />';
                   2057:                    if (!$hide) {
                   2058:                        $result .= $hostid.' '.$servers{$hostid};
                   2059:                    }
                   2060:                    $result .= "\n";
                   2061:     } elsif ($default) {
                   2062:         $result .= '<input type="hidden" name="'.$name.
                   2063:                    '" value="default" />';
                   2064:                    if (!$hide) {
                   2065:                        $result .= &mt('default');
                   2066:                    }
                   2067:                    $result .= "\n";
1.33      matthew  2068:     }
1.586     raeburn  2069:     return ($result,$numlib);
1.33      matthew  2070: }
1.112     bowersj2 2071: 
                   2072: =pod
                   2073: 
1.534     albertel 2074: =back 
                   2075: 
1.112     bowersj2 2076: =cut
1.87      matthew  2077: 
                   2078: ###############################################################
1.112     bowersj2 2079: ##                  Decoding User Agent                      ##
1.87      matthew  2080: ###############################################################
                   2081: 
                   2082: =pod
                   2083: 
1.112     bowersj2 2084: =head1 Decoding the User Agent
                   2085: 
                   2086: =over 4
                   2087: 
                   2088: =item * &decode_user_agent()
1.87      matthew  2089: 
                   2090: Inputs: $r
                   2091: 
                   2092: Outputs:
                   2093: 
                   2094: =over 4
                   2095: 
1.112     bowersj2 2096: =item * $httpbrowser
1.87      matthew  2097: 
1.112     bowersj2 2098: =item * $clientbrowser
1.87      matthew  2099: 
1.112     bowersj2 2100: =item * $clientversion
1.87      matthew  2101: 
1.112     bowersj2 2102: =item * $clientmathml
1.87      matthew  2103: 
1.112     bowersj2 2104: =item * $clientunicode
1.87      matthew  2105: 
1.112     bowersj2 2106: =item * $clientos
1.87      matthew  2107: 
                   2108: =back
                   2109: 
1.157     matthew  2110: =back 
                   2111: 
1.87      matthew  2112: =cut
                   2113: 
                   2114: ###############################################################
                   2115: ###############################################################
                   2116: sub decode_user_agent {
1.247     albertel 2117:     my ($r)=@_;
1.87      matthew  2118:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2119:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2120:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2121:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2122:     my $clientbrowser='unknown';
                   2123:     my $clientversion='0';
                   2124:     my $clientmathml='';
                   2125:     my $clientunicode='0';
                   2126:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2127:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2128: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2129: 	    $clientbrowser=$bname;
                   2130:             $httpbrowser=~/$vreg/i;
                   2131: 	    $clientversion=$1;
                   2132:             $clientmathml=($clientversion>=$minv);
                   2133:             $clientunicode=($clientversion>=$univ);
                   2134: 	}
                   2135:     }
                   2136:     my $clientos='unknown';
                   2137:     if (($httpbrowser=~/linux/i) ||
                   2138:         ($httpbrowser=~/unix/i) ||
                   2139:         ($httpbrowser=~/ux/i) ||
                   2140:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2141:     if (($httpbrowser=~/vax/i) ||
                   2142:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2143:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2144:     if (($httpbrowser=~/mac/i) ||
                   2145:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2146:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2147:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2148:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2149:             $clientunicode,$clientos,);
                   2150: }
                   2151: 
1.32      matthew  2152: ###############################################################
                   2153: ##    Authentication changing form generation subroutines    ##
                   2154: ###############################################################
                   2155: ##
                   2156: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2157: ## hash, and have reasonable default values.
                   2158: ##
                   2159: ##    formname = the name given in the <form> tag.
1.35      matthew  2160: #-------------------------------------------
                   2161: 
1.45      matthew  2162: =pod
                   2163: 
1.112     bowersj2 2164: =head1 Authentication Routines
                   2165: 
                   2166: =over 4
                   2167: 
1.648     raeburn  2168: =item * &authform_xxxxxx()
1.35      matthew  2169: 
                   2170: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2171: handle some of the conveniences required for authentication forms.  
                   2172: This is not an optimal method, but it works.  
                   2173: 
                   2174: =over 4
                   2175: 
1.112     bowersj2 2176: =item * authform_header
1.35      matthew  2177: 
1.112     bowersj2 2178: =item * authform_authorwarning
1.35      matthew  2179: 
1.112     bowersj2 2180: =item * authform_nochange
1.35      matthew  2181: 
1.112     bowersj2 2182: =item * authform_kerberos
1.35      matthew  2183: 
1.112     bowersj2 2184: =item * authform_internal
1.35      matthew  2185: 
1.112     bowersj2 2186: =item * authform_filesystem
1.35      matthew  2187: 
                   2188: =back
                   2189: 
1.648     raeburn  2190: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2191: 
1.35      matthew  2192: =cut
                   2193: 
                   2194: #-------------------------------------------
1.32      matthew  2195: sub authform_header{  
                   2196:     my %in = (
                   2197:         formname => 'cu',
1.80      albertel 2198:         kerb_def_dom => '',
1.32      matthew  2199:         @_,
                   2200:     );
                   2201:     $in{'formname'} = 'document.' . $in{'formname'};
                   2202:     my $result='';
1.80      albertel 2203: 
                   2204: #---------------------------------------------- Code for upper case translation
                   2205:     my $Javascript_toUpperCase;
                   2206:     unless ($in{kerb_def_dom}) {
                   2207:         $Javascript_toUpperCase =<<"END";
                   2208:         switch (choice) {
                   2209:            case 'krb': currentform.elements[choicearg].value =
                   2210:                currentform.elements[choicearg].value.toUpperCase();
                   2211:                break;
                   2212:            default:
                   2213:         }
                   2214: END
                   2215:     } else {
                   2216:         $Javascript_toUpperCase = "";
                   2217:     }
                   2218: 
1.165     raeburn  2219:     my $radioval = "'nochange'";
1.591     raeburn  2220:     if (defined($in{'curr_authtype'})) {
                   2221:         if ($in{'curr_authtype'} ne '') {
                   2222:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2223:         }
1.174     matthew  2224:     }
1.165     raeburn  2225:     my $argfield = 'null';
1.591     raeburn  2226:     if (defined($in{'mode'})) {
1.165     raeburn  2227:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2228:             if (defined($in{'curr_autharg'})) {
                   2229:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2230:                     $argfield = "'$in{'curr_autharg'}'";
                   2231:                 }
                   2232:             }
                   2233:         }
                   2234:     }
                   2235: 
1.32      matthew  2236:     $result.=<<"END";
                   2237: var current = new Object();
1.165     raeburn  2238: current.radiovalue = $radioval;
                   2239: current.argfield = $argfield;
1.32      matthew  2240: 
                   2241: function changed_radio(choice,currentform) {
                   2242:     var choicearg = choice + 'arg';
                   2243:     // If a radio button in changed, we need to change the argfield
                   2244:     if (current.radiovalue != choice) {
                   2245:         current.radiovalue = choice;
                   2246:         if (current.argfield != null) {
                   2247:             currentform.elements[current.argfield].value = '';
                   2248:         }
                   2249:         if (choice == 'nochange') {
                   2250:             current.argfield = null;
                   2251:         } else {
                   2252:             current.argfield = choicearg;
                   2253:             switch(choice) {
                   2254:                 case 'krb': 
                   2255:                     currentform.elements[current.argfield].value = 
                   2256:                         "$in{'kerb_def_dom'}";
                   2257:                 break;
                   2258:               default:
                   2259:                 break;
                   2260:             }
                   2261:         }
                   2262:     }
                   2263:     return;
                   2264: }
1.22      www      2265: 
1.32      matthew  2266: function changed_text(choice,currentform) {
                   2267:     var choicearg = choice + 'arg';
                   2268:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2269:         $Javascript_toUpperCase
1.32      matthew  2270:         // clear old field
                   2271:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2272:             currentform.elements[current.argfield].value = '';
                   2273:         }
                   2274:         current.argfield = choicearg;
                   2275:     }
                   2276:     set_auth_radio_buttons(choice,currentform);
                   2277:     return;
1.20      www      2278: }
1.32      matthew  2279: 
                   2280: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2281:     var numauthchoices = currentform.login.length;
                   2282:     if (typeof numauthchoices  == "undefined") {
                   2283:         return;
                   2284:     } 
1.32      matthew  2285:     var i=0;
1.986     raeburn  2286:     while (i < numauthchoices) {
1.32      matthew  2287:         if (currentform.login[i].value == newvalue) { break; }
                   2288:         i++;
                   2289:     }
1.986     raeburn  2290:     if (i == numauthchoices) {
1.32      matthew  2291:         return;
                   2292:     }
                   2293:     current.radiovalue = newvalue;
                   2294:     currentform.login[i].checked = true;
                   2295:     return;
                   2296: }
                   2297: END
                   2298:     return $result;
                   2299: }
                   2300: 
                   2301: sub authform_authorwarning{
                   2302:     my $result='';
1.144     matthew  2303:     $result='<i>'.
                   2304:         &mt('As a general rule, only authors or co-authors should be '.
                   2305:             'filesystem authenticated '.
                   2306:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2307:     return $result;
                   2308: }
                   2309: 
                   2310: sub authform_nochange{  
                   2311:     my %in = (
                   2312:               formname => 'document.cu',
                   2313:               kerb_def_dom => 'MSU.EDU',
                   2314:               @_,
                   2315:           );
1.586     raeburn  2316:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2317:     my $result;
                   2318:     if (keys(%can_assign) == 0) {
                   2319:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2320:     } else {
                   2321:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2322:                   '<input type="radio" name="login" value="nochange" '.
                   2323:                   'checked="checked" onclick="'.
1.281     albertel 2324:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2325: 	    '</label>';
1.586     raeburn  2326:     }
1.32      matthew  2327:     return $result;
                   2328: }
                   2329: 
1.591     raeburn  2330: sub authform_kerberos {
1.32      matthew  2331:     my %in = (
                   2332:               formname => 'document.cu',
                   2333:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2334:               kerb_def_auth => 'krb4',
1.32      matthew  2335:               @_,
                   2336:               );
1.586     raeburn  2337:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2338:         $autharg,$jscall);
                   2339:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2340:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2341:        $check5 = ' checked="checked"';
1.80      albertel 2342:     } else {
1.772     bisitz   2343:        $check4 = ' checked="checked"';
1.80      albertel 2344:     }
1.165     raeburn  2345:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2346:     if (defined($in{'curr_authtype'})) {
                   2347:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2348:             $krbcheck = ' checked="checked"';
1.623     raeburn  2349:             if (defined($in{'mode'})) {
                   2350:                 if ($in{'mode'} eq 'modifyuser') {
                   2351:                     $krbcheck = '';
                   2352:                 }
                   2353:             }
1.591     raeburn  2354:             if (defined($in{'curr_kerb_ver'})) {
                   2355:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2356:                     $check5 = ' checked="checked"';
1.591     raeburn  2357:                     $check4 = '';
                   2358:                 } else {
1.772     bisitz   2359:                     $check4 = ' checked="checked"';
1.591     raeburn  2360:                     $check5 = '';
                   2361:                 }
1.586     raeburn  2362:             }
1.591     raeburn  2363:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2364:                 $krbarg = $in{'curr_autharg'};
                   2365:             }
1.586     raeburn  2366:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2367:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2368:                     $result = 
                   2369:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2370:         $in{'curr_autharg'},$krbver);
                   2371:                 } else {
                   2372:                     $result =
                   2373:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2374:                 }
                   2375:                 return $result; 
                   2376:             }
                   2377:         }
                   2378:     } else {
                   2379:         if ($authnum == 1) {
1.784     bisitz   2380:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2381:         }
                   2382:     }
1.586     raeburn  2383:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2384:         return;
1.587     raeburn  2385:     } elsif ($authtype eq '') {
1.591     raeburn  2386:         if (defined($in{'mode'})) {
1.587     raeburn  2387:             if ($in{'mode'} eq 'modifycourse') {
                   2388:                 if ($authnum == 1) {
1.784     bisitz   2389:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2390:                 }
                   2391:             }
                   2392:         }
1.586     raeburn  2393:     }
                   2394:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2395:     if ($authtype eq '') {
                   2396:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2397:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2398:                     $krbcheck.' />';
                   2399:     }
                   2400:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2401:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2402:          $in{'curr_authtype'} eq 'krb5') ||
                   2403:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2404:          $in{'curr_authtype'} eq 'krb4')) {
                   2405:         $result .= &mt
1.144     matthew  2406:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2407:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2408:          '<label>'.$authtype,
1.281     albertel 2409:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2410:              'value="'.$krbarg.'" '.
1.144     matthew  2411:              'onchange="'.$jscall.'" />',
1.281     albertel 2412:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2413:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2414: 	 '</label>');
1.586     raeburn  2415:     } elsif ($can_assign{'krb4'}) {
                   2416:         $result .= &mt
                   2417:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2418:          '[_3] Version 4 [_4]',
                   2419:          '<label>'.$authtype,
                   2420:          '</label><input type="text" size="10" name="krbarg" '.
                   2421:              'value="'.$krbarg.'" '.
                   2422:              'onchange="'.$jscall.'" />',
                   2423:          '<label><input type="hidden" name="krbver" value="4" />',
                   2424:          '</label>');
                   2425:     } elsif ($can_assign{'krb5'}) {
                   2426:         $result .= &mt
                   2427:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2428:          '[_3] Version 5 [_4]',
                   2429:          '<label>'.$authtype,
                   2430:          '</label><input type="text" size="10" name="krbarg" '.
                   2431:              'value="'.$krbarg.'" '.
                   2432:              'onchange="'.$jscall.'" />',
                   2433:          '<label><input type="hidden" name="krbver" value="5" />',
                   2434:          '</label>');
                   2435:     }
1.32      matthew  2436:     return $result;
                   2437: }
                   2438: 
                   2439: sub authform_internal{  
1.586     raeburn  2440:     my %in = (
1.32      matthew  2441:                 formname => 'document.cu',
                   2442:                 kerb_def_dom => 'MSU.EDU',
                   2443:                 @_,
                   2444:                 );
1.586     raeburn  2445:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2446:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2447:     if (defined($in{'curr_authtype'})) {
                   2448:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2449:             if ($can_assign{'int'}) {
1.772     bisitz   2450:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2451:                 if (defined($in{'mode'})) {
                   2452:                     if ($in{'mode'} eq 'modifyuser') {
                   2453:                         $intcheck = '';
                   2454:                     }
                   2455:                 }
1.591     raeburn  2456:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2457:                     $intarg = $in{'curr_autharg'};
                   2458:                 }
                   2459:             } else {
                   2460:                 $result = &mt('Currently internally authenticated.');
                   2461:                 return $result;
1.165     raeburn  2462:             }
                   2463:         }
1.586     raeburn  2464:     } else {
                   2465:         if ($authnum == 1) {
1.784     bisitz   2466:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2467:         }
                   2468:     }
                   2469:     if (!$can_assign{'int'}) {
                   2470:         return;
1.587     raeburn  2471:     } elsif ($authtype eq '') {
1.591     raeburn  2472:         if (defined($in{'mode'})) {
1.587     raeburn  2473:             if ($in{'mode'} eq 'modifycourse') {
                   2474:                 if ($authnum == 1) {
1.784     bisitz   2475:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2476:                 }
                   2477:             }
                   2478:         }
1.165     raeburn  2479:     }
1.586     raeburn  2480:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2481:     if ($authtype eq '') {
                   2482:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2483:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2484:     }
1.605     bisitz   2485:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2486:                $intarg.'" onchange="'.$jscall.'" />';
                   2487:     $result = &mt
1.144     matthew  2488:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2489:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2490:     $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  2491:     return $result;
                   2492: }
                   2493: 
                   2494: sub authform_local{  
                   2495:     my %in = (
                   2496:               formname => 'document.cu',
                   2497:               kerb_def_dom => 'MSU.EDU',
                   2498:               @_,
                   2499:               );
1.586     raeburn  2500:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2501:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2502:     if (defined($in{'curr_authtype'})) {
                   2503:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2504:             if ($can_assign{'loc'}) {
1.772     bisitz   2505:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2506:                 if (defined($in{'mode'})) {
                   2507:                     if ($in{'mode'} eq 'modifyuser') {
                   2508:                         $loccheck = '';
                   2509:                     }
                   2510:                 }
1.591     raeburn  2511:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2512:                     $locarg = $in{'curr_autharg'};
                   2513:                 }
                   2514:             } else {
                   2515:                 $result = &mt('Currently using local (institutional) authentication.');
                   2516:                 return $result;
1.165     raeburn  2517:             }
                   2518:         }
1.586     raeburn  2519:     } else {
                   2520:         if ($authnum == 1) {
1.784     bisitz   2521:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2522:         }
                   2523:     }
                   2524:     if (!$can_assign{'loc'}) {
                   2525:         return;
1.587     raeburn  2526:     } elsif ($authtype eq '') {
1.591     raeburn  2527:         if (defined($in{'mode'})) {
1.587     raeburn  2528:             if ($in{'mode'} eq 'modifycourse') {
                   2529:                 if ($authnum == 1) {
1.784     bisitz   2530:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2531:                 }
                   2532:             }
                   2533:         }
1.165     raeburn  2534:     }
1.586     raeburn  2535:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2536:     if ($authtype eq '') {
                   2537:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2538:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2539:                     $jscall.'" />';
                   2540:     }
                   2541:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2542:                $locarg.'" onchange="'.$jscall.'" />';
                   2543:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2544:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2545:     return $result;
                   2546: }
                   2547: 
                   2548: sub authform_filesystem{  
                   2549:     my %in = (
                   2550:               formname => 'document.cu',
                   2551:               kerb_def_dom => 'MSU.EDU',
                   2552:               @_,
                   2553:               );
1.586     raeburn  2554:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2555:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2556:     if (defined($in{'curr_authtype'})) {
                   2557:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2558:             if ($can_assign{'fsys'}) {
1.772     bisitz   2559:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2560:                 if (defined($in{'mode'})) {
                   2561:                     if ($in{'mode'} eq 'modifyuser') {
                   2562:                         $fsyscheck = '';
                   2563:                     }
                   2564:                 }
1.586     raeburn  2565:             } else {
                   2566:                 $result = &mt('Currently Filesystem Authenticated.');
                   2567:                 return $result;
                   2568:             }           
                   2569:         }
                   2570:     } else {
                   2571:         if ($authnum == 1) {
1.784     bisitz   2572:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2573:         }
                   2574:     }
                   2575:     if (!$can_assign{'fsys'}) {
                   2576:         return;
1.587     raeburn  2577:     } elsif ($authtype eq '') {
1.591     raeburn  2578:         if (defined($in{'mode'})) {
1.587     raeburn  2579:             if ($in{'mode'} eq 'modifycourse') {
                   2580:                 if ($authnum == 1) {
1.784     bisitz   2581:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2582:                 }
                   2583:             }
                   2584:         }
1.586     raeburn  2585:     }
                   2586:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2587:     if ($authtype eq '') {
                   2588:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2589:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2590:                     $jscall.'" />';
                   2591:     }
                   2592:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2593:                ' onchange="'.$jscall.'" />';
                   2594:     $result = &mt
1.144     matthew  2595:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2596:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2597:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2598:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2599:                   'onchange="'.$jscall.'" />');
1.32      matthew  2600:     return $result;
                   2601: }
                   2602: 
1.586     raeburn  2603: sub get_assignable_auth {
                   2604:     my ($dom) = @_;
                   2605:     if ($dom eq '') {
                   2606:         $dom = $env{'request.role.domain'};
                   2607:     }
                   2608:     my %can_assign = (
                   2609:                           krb4 => 1,
                   2610:                           krb5 => 1,
                   2611:                           int  => 1,
                   2612:                           loc  => 1,
                   2613:                      );
                   2614:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2615:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2616:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2617:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2618:             my $context;
                   2619:             if ($env{'request.role'} =~ /^au/) {
                   2620:                 $context = 'author';
                   2621:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2622:                 $context = 'domain';
                   2623:             } elsif ($env{'request.course.id'}) {
                   2624:                 $context = 'course';
                   2625:             }
                   2626:             if ($context) {
                   2627:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2628:                    %can_assign = %{$authhash->{$context}}; 
                   2629:                 }
                   2630:             }
                   2631:         }
                   2632:     }
                   2633:     my $authnum = 0;
                   2634:     foreach my $key (keys(%can_assign)) {
                   2635:         if ($can_assign{$key}) {
                   2636:             $authnum ++;
                   2637:         }
                   2638:     }
                   2639:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2640:         $authnum --;
                   2641:     }
                   2642:     return ($authnum,%can_assign);
                   2643: }
                   2644: 
1.80      albertel 2645: ###############################################################
                   2646: ##    Get Kerberos Defaults for Domain                 ##
                   2647: ###############################################################
                   2648: ##
                   2649: ## Returns default kerberos version and an associated argument
                   2650: ## as listed in file domain.tab. If not listed, provides
                   2651: ## appropriate default domain and kerberos version.
                   2652: ##
                   2653: #-------------------------------------------
                   2654: 
                   2655: =pod
                   2656: 
1.648     raeburn  2657: =item * &get_kerberos_defaults()
1.80      albertel 2658: 
                   2659: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2660: version and domain. If not found, it defaults to version 4 and the 
                   2661: domain of the server.
1.80      albertel 2662: 
1.648     raeburn  2663: =over 4
                   2664: 
1.80      albertel 2665: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2666: 
1.648     raeburn  2667: =back
                   2668: 
                   2669: =back
                   2670: 
1.80      albertel 2671: =cut
                   2672: 
                   2673: #-------------------------------------------
                   2674: sub get_kerberos_defaults {
                   2675:     my $domain=shift;
1.641     raeburn  2676:     my ($krbdef,$krbdefdom);
                   2677:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2678:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2679:         $krbdef = $domdefaults{'auth_def'};
                   2680:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2681:     } else {
1.80      albertel 2682:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2683:         my $krbdefdom=$1;
                   2684:         $krbdefdom=~tr/a-z/A-Z/;
                   2685:         $krbdef = "krb4";
                   2686:     }
                   2687:     return ($krbdef,$krbdefdom);
                   2688: }
1.112     bowersj2 2689: 
1.32      matthew  2690: 
1.46      matthew  2691: ###############################################################
                   2692: ##                Thesaurus Functions                        ##
                   2693: ###############################################################
1.20      www      2694: 
1.46      matthew  2695: =pod
1.20      www      2696: 
1.112     bowersj2 2697: =head1 Thesaurus Functions
                   2698: 
                   2699: =over 4
                   2700: 
1.648     raeburn  2701: =item * &initialize_keywords()
1.46      matthew  2702: 
                   2703: Initializes the package variable %Keywords if it is empty.  Uses the
                   2704: package variable $thesaurus_db_file.
                   2705: 
                   2706: =cut
                   2707: 
                   2708: ###################################################
                   2709: 
                   2710: sub initialize_keywords {
                   2711:     return 1 if (scalar keys(%Keywords));
                   2712:     # If we are here, %Keywords is empty, so fill it up
                   2713:     #   Make sure the file we need exists...
                   2714:     if (! -e $thesaurus_db_file) {
                   2715:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2716:                                  " failed because it does not exist");
                   2717:         return 0;
                   2718:     }
                   2719:     #   Set up the hash as a database
                   2720:     my %thesaurus_db;
                   2721:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2722:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2723:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2724:                                  $thesaurus_db_file);
                   2725:         return 0;
                   2726:     } 
                   2727:     #  Get the average number of appearances of a word.
                   2728:     my $avecount = $thesaurus_db{'average.count'};
                   2729:     #  Put keywords (those that appear > average) into %Keywords
                   2730:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2731:         my ($count,undef) = split /:/,$data;
                   2732:         $Keywords{$word}++ if ($count > $avecount);
                   2733:     }
                   2734:     untie %thesaurus_db;
                   2735:     # Remove special values from %Keywords.
1.356     albertel 2736:     foreach my $value ('total.count','average.count') {
                   2737:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2738:   }
1.46      matthew  2739:     return 1;
                   2740: }
                   2741: 
                   2742: ###################################################
                   2743: 
                   2744: =pod
                   2745: 
1.648     raeburn  2746: =item * &keyword($word)
1.46      matthew  2747: 
                   2748: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2749: than the average number of times in the thesaurus database.  Calls 
                   2750: &initialize_keywords
                   2751: 
                   2752: =cut
                   2753: 
                   2754: ###################################################
1.20      www      2755: 
                   2756: sub keyword {
1.46      matthew  2757:     return if (!&initialize_keywords());
                   2758:     my $word=lc(shift());
                   2759:     $word=~s/\W//g;
                   2760:     return exists($Keywords{$word});
1.20      www      2761: }
1.46      matthew  2762: 
                   2763: ###############################################################
                   2764: 
                   2765: =pod 
1.20      www      2766: 
1.648     raeburn  2767: =item * &get_related_words()
1.46      matthew  2768: 
1.160     matthew  2769: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2770: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2771: will be returned.  The order of the words returned is determined by the
                   2772: database which holds them.
                   2773: 
                   2774: Uses global $thesaurus_db_file.
                   2775: 
                   2776: =cut
                   2777: 
                   2778: ###############################################################
                   2779: sub get_related_words {
                   2780:     my $keyword = shift;
                   2781:     my %thesaurus_db;
                   2782:     if (! -e $thesaurus_db_file) {
                   2783:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2784:                                  "failed because the file does not exist");
                   2785:         return ();
                   2786:     }
                   2787:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2788:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2789:         return ();
                   2790:     } 
                   2791:     my @Words=();
1.429     www      2792:     my $count=0;
1.46      matthew  2793:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2794: 	# The first element is the number of times
                   2795: 	# the word appears.  We do not need it now.
1.429     www      2796: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2797: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2798: 	my $threshold=$mostfrequentcount/10;
                   2799:         foreach my $possibleword (@RelatedWords) {
                   2800:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2801:             if ($wordcount>$threshold) {
                   2802: 		push(@Words,$word);
                   2803:                 $count++;
                   2804:                 if ($count>10) { last; }
                   2805: 	    }
1.20      www      2806:         }
                   2807:     }
1.46      matthew  2808:     untie %thesaurus_db;
                   2809:     return @Words;
1.14      harris41 2810: }
1.46      matthew  2811: 
1.112     bowersj2 2812: =pod
                   2813: 
                   2814: =back
                   2815: 
                   2816: =cut
1.61      www      2817: 
                   2818: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2819: =pod
                   2820: 
1.112     bowersj2 2821: =head1 User Name Functions
                   2822: 
                   2823: =over 4
                   2824: 
1.648     raeburn  2825: =item * &plainname($uname,$udom,$first)
1.81      albertel 2826: 
1.112     bowersj2 2827: Takes a users logon name and returns it as a string in
1.226     albertel 2828: "first middle last generation" form 
                   2829: if $first is set to 'lastname' then it returns it as
                   2830: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2831: 
                   2832: =cut
1.61      www      2833: 
1.295     www      2834: 
1.81      albertel 2835: ###############################################################
1.61      www      2836: sub plainname {
1.226     albertel 2837:     my ($uname,$udom,$first)=@_;
1.537     albertel 2838:     return if (!defined($uname) || !defined($udom));
1.295     www      2839:     my %names=&getnames($uname,$udom);
1.226     albertel 2840:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2841: 					  $names{'middlename'},
                   2842: 					  $names{'lastname'},
                   2843: 					  $names{'generation'},$first);
                   2844:     $name=~s/^\s+//;
1.62      www      2845:     $name=~s/\s+$//;
                   2846:     $name=~s/\s+/ /g;
1.353     albertel 2847:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2848:     return $name;
1.61      www      2849: }
1.66      www      2850: 
                   2851: # -------------------------------------------------------------------- Nickname
1.81      albertel 2852: =pod
                   2853: 
1.648     raeburn  2854: =item * &nickname($uname,$udom)
1.81      albertel 2855: 
                   2856: Gets a users name and returns it as a string as
                   2857: 
                   2858: "&quot;nickname&quot;"
1.66      www      2859: 
1.81      albertel 2860: if the user has a nickname or
                   2861: 
                   2862: "first middle last generation"
                   2863: 
                   2864: if the user does not
                   2865: 
                   2866: =cut
1.66      www      2867: 
                   2868: sub nickname {
                   2869:     my ($uname,$udom)=@_;
1.537     albertel 2870:     return if (!defined($uname) || !defined($udom));
1.295     www      2871:     my %names=&getnames($uname,$udom);
1.68      albertel 2872:     my $name=$names{'nickname'};
1.66      www      2873:     if ($name) {
                   2874:        $name='&quot;'.$name.'&quot;'; 
                   2875:     } else {
                   2876:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2877: 	     $names{'lastname'}.' '.$names{'generation'};
                   2878:        $name=~s/\s+$//;
                   2879:        $name=~s/\s+/ /g;
                   2880:     }
                   2881:     return $name;
                   2882: }
                   2883: 
1.295     www      2884: sub getnames {
                   2885:     my ($uname,$udom)=@_;
1.537     albertel 2886:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2887:     if ($udom eq 'public' && $uname eq 'public') {
                   2888: 	return ('lastname' => &mt('Public'));
                   2889:     }
1.295     www      2890:     my $id=$uname.':'.$udom;
                   2891:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2892:     if ($cached) {
                   2893: 	return %{$names};
                   2894:     } else {
                   2895: 	my %loadnames=&Apache::lonnet::get('environment',
                   2896:                     ['firstname','middlename','lastname','generation','nickname'],
                   2897: 					 $udom,$uname);
                   2898: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2899: 	return %loadnames;
                   2900:     }
                   2901: }
1.61      www      2902: 
1.542     raeburn  2903: # -------------------------------------------------------------------- getemails
1.648     raeburn  2904: 
1.542     raeburn  2905: =pod
                   2906: 
1.648     raeburn  2907: =item * &getemails($uname,$udom)
1.542     raeburn  2908: 
                   2909: Gets a user's email information and returns it as a hash with keys:
                   2910: notification, critnotification, permanentemail
                   2911: 
                   2912: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2913: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2914:  
1.648     raeburn  2915: 
1.542     raeburn  2916: =cut
                   2917: 
1.648     raeburn  2918: 
1.466     albertel 2919: sub getemails {
                   2920:     my ($uname,$udom)=@_;
                   2921:     if ($udom eq 'public' && $uname eq 'public') {
                   2922: 	return;
                   2923:     }
1.467     www      2924:     if (!$udom) { $udom=$env{'user.domain'}; }
                   2925:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 2926:     my $id=$uname.':'.$udom;
                   2927:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   2928:     if ($cached) {
                   2929: 	return %{$names};
                   2930:     } else {
                   2931: 	my %loadnames=&Apache::lonnet::get('environment',
                   2932:                     			   ['notification','critnotification',
                   2933: 					    'permanentemail'],
                   2934: 					   $udom,$uname);
                   2935: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   2936: 	return %loadnames;
                   2937:     }
                   2938: }
                   2939: 
1.551     albertel 2940: sub flush_email_cache {
                   2941:     my ($uname,$udom)=@_;
                   2942:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2943:     if (!$uname) { $uname=$env{'user.name'};   }
                   2944:     return if ($udom eq 'public' && $uname eq 'public');
                   2945:     my $id=$uname.':'.$udom;
                   2946:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   2947: }
                   2948: 
1.728     raeburn  2949: # -------------------------------------------------------------------- getlangs
                   2950: 
                   2951: =pod
                   2952: 
                   2953: =item * &getlangs($uname,$udom)
                   2954: 
                   2955: Gets a user's language preference and returns it as a hash with key:
                   2956: language.
                   2957: 
                   2958: =cut
                   2959: 
                   2960: 
                   2961: sub getlangs {
                   2962:     my ($uname,$udom) = @_;
                   2963:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2964:     if (!$uname) { $uname=$env{'user.name'};   }
                   2965:     my $id=$uname.':'.$udom;
                   2966:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   2967:     if ($cached) {
                   2968:         return %{$langs};
                   2969:     } else {
                   2970:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   2971:                                            $udom,$uname);
                   2972:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   2973:         return %loadlangs;
                   2974:     }
                   2975: }
                   2976: 
                   2977: sub flush_langs_cache {
                   2978:     my ($uname,$udom)=@_;
                   2979:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   2980:     if (!$uname) { $uname=$env{'user.name'};   }
                   2981:     return if ($udom eq 'public' && $uname eq 'public');
                   2982:     my $id=$uname.':'.$udom;
                   2983:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   2984: }
                   2985: 
1.61      www      2986: # ------------------------------------------------------------------ Screenname
1.81      albertel 2987: 
                   2988: =pod
                   2989: 
1.648     raeburn  2990: =item * &screenname($uname,$udom)
1.81      albertel 2991: 
                   2992: Gets a users screenname and returns it as a string
                   2993: 
                   2994: =cut
1.61      www      2995: 
                   2996: sub screenname {
                   2997:     my ($uname,$udom)=@_;
1.258     albertel 2998:     if ($uname eq $env{'user.name'} &&
                   2999: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3000:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3001:     return $names{'screenname'};
1.62      www      3002: }
                   3003: 
1.212     albertel 3004: 
1.802     bisitz   3005: # ------------------------------------------------------------- Confirm Wrapper
                   3006: =pod
                   3007: 
                   3008: =item confirmwrapper
                   3009: 
                   3010: Wrap messages about completion of operation in box
                   3011: 
                   3012: =cut
                   3013: 
                   3014: sub confirmwrapper {
                   3015:     my ($message)=@_;
                   3016:     if ($message) {
                   3017:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3018:                .$message."\n"
                   3019:                .'</div>'."\n";
                   3020:     } else {
                   3021:         return $message;
                   3022:     }
                   3023: }
                   3024: 
1.62      www      3025: # ------------------------------------------------------------- Message Wrapper
                   3026: 
                   3027: sub messagewrapper {
1.369     www      3028:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3029:     return 
1.441     albertel 3030:         '<a href="/adm/email?compose=individual&amp;'.
                   3031:         'recname='.$username.'&amp;recdom='.$domain.
                   3032: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3033:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3034: }
1.802     bisitz   3035: 
1.74      www      3036: # --------------------------------------------------------------- Notes Wrapper
                   3037: 
                   3038: sub noteswrapper {
                   3039:     my ($link,$un,$do)=@_;
                   3040:     return 
1.896     amueller 3041: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3042: }
1.802     bisitz   3043: 
1.62      www      3044: # ------------------------------------------------------------- Aboutme Wrapper
                   3045: 
                   3046: sub aboutmewrapper {
1.166     www      3047:     my ($link,$username,$domain,$target)=@_;
1.447     raeburn  3048:     if (!defined($username)  && !defined($domain)) {
                   3049:         return;
                   3050:     }
1.892     amueller 3051:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756     weissno  3052: 	($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3053: }
                   3054: 
                   3055: # ------------------------------------------------------------ Syllabus Wrapper
                   3056: 
                   3057: sub syllabuswrapper {
1.707     bisitz   3058:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3059:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3060: }
1.14      harris41 3061: 
1.802     bisitz   3062: # -----------------------------------------------------------------------------
                   3063: 
1.208     matthew  3064: sub track_student_link {
1.887     raeburn  3065:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3066:     my $link ="/adm/trackstudent?";
1.208     matthew  3067:     my $title = 'View recent activity';
                   3068:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3069:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3070:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3071:         $title .= ' of this student';
1.268     albertel 3072:     } 
1.208     matthew  3073:     if (defined($target) && $target !~ /^\s*$/) {
                   3074:         $target = qq{target="$target"};
                   3075:     } else {
                   3076:         $target = '';
                   3077:     }
1.268     albertel 3078:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3079:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3080:     $title = &mt($title);
                   3081:     $linktext = &mt($linktext);
1.448     albertel 3082:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3083: 	&help_open_topic('View_recent_activity');
1.208     matthew  3084: }
                   3085: 
1.781     raeburn  3086: sub slot_reservations_link {
                   3087:     my ($linktext,$sname,$sdom,$target) = @_;
                   3088:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3089:     my $title = 'View slot reservation history';
                   3090:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3091:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3092:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3093:         $title .= ' of this student';
                   3094:     }
                   3095:     if (defined($target) && $target !~ /^\s*$/) {
                   3096:         $target = qq{target="$target"};
                   3097:     } else {
                   3098:         $target = '';
                   3099:     }
                   3100:     $title = &mt($title);
                   3101:     $linktext = &mt($linktext);
                   3102:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3103: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3104: 
                   3105: }
                   3106: 
1.508     www      3107: # ===================================================== Display a student photo
                   3108: 
                   3109: 
1.509     albertel 3110: sub student_image_tag {
1.508     www      3111:     my ($domain,$user)=@_;
                   3112:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3113:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3114: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3115:     } else {
                   3116: 	return '';
                   3117:     }
                   3118: }
                   3119: 
1.112     bowersj2 3120: =pod
                   3121: 
                   3122: =back
                   3123: 
                   3124: =head1 Access .tab File Data
                   3125: 
                   3126: =over 4
                   3127: 
1.648     raeburn  3128: =item * &languageids() 
1.112     bowersj2 3129: 
                   3130: returns list of all language ids
                   3131: 
                   3132: =cut
                   3133: 
1.14      harris41 3134: sub languageids {
1.16      harris41 3135:     return sort(keys(%language));
1.14      harris41 3136: }
                   3137: 
1.112     bowersj2 3138: =pod
                   3139: 
1.648     raeburn  3140: =item * &languagedescription() 
1.112     bowersj2 3141: 
                   3142: returns description of a specified language id
                   3143: 
                   3144: =cut
                   3145: 
1.14      harris41 3146: sub languagedescription {
1.125     www      3147:     my $code=shift;
                   3148:     return  ($supported_language{$code}?'* ':'').
                   3149:             $language{$code}.
1.126     www      3150: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3151: }
                   3152: 
                   3153: sub plainlanguagedescription {
                   3154:     my $code=shift;
                   3155:     return $language{$code};
                   3156: }
                   3157: 
                   3158: sub supportedlanguagecode {
                   3159:     my $code=shift;
                   3160:     return $supported_language{$code};
1.97      www      3161: }
                   3162: 
1.112     bowersj2 3163: =pod
                   3164: 
1.648     raeburn  3165: =item * &copyrightids() 
1.112     bowersj2 3166: 
                   3167: returns list of all copyrights
                   3168: 
                   3169: =cut
                   3170: 
                   3171: sub copyrightids {
                   3172:     return sort(keys(%cprtag));
                   3173: }
                   3174: 
                   3175: =pod
                   3176: 
1.648     raeburn  3177: =item * &copyrightdescription() 
1.112     bowersj2 3178: 
                   3179: returns description of a specified copyright id
                   3180: 
                   3181: =cut
                   3182: 
                   3183: sub copyrightdescription {
1.166     www      3184:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3185: }
1.197     matthew  3186: 
                   3187: =pod
                   3188: 
1.648     raeburn  3189: =item * &source_copyrightids() 
1.192     taceyjo1 3190: 
                   3191: returns list of all source copyrights
                   3192: 
                   3193: =cut
                   3194: 
                   3195: sub source_copyrightids {
                   3196:     return sort(keys(%scprtag));
                   3197: }
                   3198: 
                   3199: =pod
                   3200: 
1.648     raeburn  3201: =item * &source_copyrightdescription() 
1.192     taceyjo1 3202: 
                   3203: returns description of a specified source copyright id
                   3204: 
                   3205: =cut
                   3206: 
                   3207: sub source_copyrightdescription {
                   3208:     return &mt($scprtag{shift(@_)});
                   3209: }
1.112     bowersj2 3210: 
                   3211: =pod
                   3212: 
1.648     raeburn  3213: =item * &filecategories() 
1.112     bowersj2 3214: 
                   3215: returns list of all file categories
                   3216: 
                   3217: =cut
                   3218: 
                   3219: sub filecategories {
                   3220:     return sort(keys(%category_extensions));
                   3221: }
                   3222: 
                   3223: =pod
                   3224: 
1.648     raeburn  3225: =item * &filecategorytypes() 
1.112     bowersj2 3226: 
                   3227: returns list of file types belonging to a given file
                   3228: category
                   3229: 
                   3230: =cut
                   3231: 
                   3232: sub filecategorytypes {
1.356     albertel 3233:     my ($cat) = @_;
                   3234:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3235: }
                   3236: 
                   3237: =pod
                   3238: 
1.648     raeburn  3239: =item * &fileembstyle() 
1.112     bowersj2 3240: 
                   3241: returns embedding style for a specified file type
                   3242: 
                   3243: =cut
                   3244: 
                   3245: sub fileembstyle {
                   3246:     return $fe{lc(shift(@_))};
1.169     www      3247: }
                   3248: 
1.351     www      3249: sub filemimetype {
                   3250:     return $fm{lc(shift(@_))};
                   3251: }
                   3252: 
1.169     www      3253: 
                   3254: sub filecategoryselect {
                   3255:     my ($name,$value)=@_;
1.189     matthew  3256:     return &select_form($value,$name,
1.970     raeburn  3257:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3258: }
                   3259: 
                   3260: =pod
                   3261: 
1.648     raeburn  3262: =item * &filedescription() 
1.112     bowersj2 3263: 
                   3264: returns description for a specified file type
                   3265: 
                   3266: =cut
                   3267: 
                   3268: sub filedescription {
1.188     matthew  3269:     my $file_description = $fd{lc(shift())};
                   3270:     $file_description =~ s:([\[\]]):~$1:g;
                   3271:     return &mt($file_description);
1.112     bowersj2 3272: }
                   3273: 
                   3274: =pod
                   3275: 
1.648     raeburn  3276: =item * &filedescriptionex() 
1.112     bowersj2 3277: 
                   3278: returns description for a specified file type with
                   3279: extra formatting
                   3280: 
                   3281: =cut
                   3282: 
                   3283: sub filedescriptionex {
                   3284:     my $ex=shift;
1.188     matthew  3285:     my $file_description = $fd{lc($ex)};
                   3286:     $file_description =~ s:([\[\]]):~$1:g;
                   3287:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3288: }
                   3289: 
                   3290: # End of .tab access
                   3291: =pod
                   3292: 
                   3293: =back
                   3294: 
                   3295: =cut
                   3296: 
                   3297: # ------------------------------------------------------------------ File Types
                   3298: sub fileextensions {
                   3299:     return sort(keys(%fe));
                   3300: }
                   3301: 
1.97      www      3302: # ----------------------------------------------------------- Display Languages
                   3303: # returns a hash with all desired display languages
                   3304: #
                   3305: 
                   3306: sub display_languages {
                   3307:     my %languages=();
1.695     raeburn  3308:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3309: 	$languages{$lang}=1;
1.97      www      3310:     }
                   3311:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3312:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3313: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3314: 	    $languages{$lang}=1;
1.97      www      3315:         }
                   3316:     }
                   3317:     return %languages;
1.14      harris41 3318: }
                   3319: 
1.582     albertel 3320: sub languages {
                   3321:     my ($possible_langs) = @_;
1.695     raeburn  3322:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3323:     if (!ref($possible_langs)) {
                   3324: 	if( wantarray ) {
                   3325: 	    return @preferred_langs;
                   3326: 	} else {
                   3327: 	    return $preferred_langs[0];
                   3328: 	}
                   3329:     }
                   3330:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3331:     my @preferred_possibilities;
                   3332:     foreach my $preferred_lang (@preferred_langs) {
                   3333: 	if (exists($possibilities{$preferred_lang})) {
                   3334: 	    push(@preferred_possibilities, $preferred_lang);
                   3335: 	}
                   3336:     }
                   3337:     if( wantarray ) {
                   3338: 	return @preferred_possibilities;
                   3339:     }
                   3340:     return $preferred_possibilities[0];
                   3341: }
                   3342: 
1.742     raeburn  3343: sub user_lang {
                   3344:     my ($touname,$toudom,$fromcid) = @_;
                   3345:     my @userlangs;
                   3346:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3347:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3348:                     $env{'course.'.$fromcid.'.languages'}));
                   3349:     } else {
                   3350:         my %langhash = &getlangs($touname,$toudom);
                   3351:         if ($langhash{'languages'} ne '') {
                   3352:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3353:         } else {
                   3354:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3355:             if ($domdefs{'lang_def'} ne '') {
                   3356:                 @userlangs = ($domdefs{'lang_def'});
                   3357:             }
                   3358:         }
                   3359:     }
                   3360:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3361:     my $user_lh = Apache::localize->get_handle(@languages);
                   3362:     return $user_lh;
                   3363: }
                   3364: 
                   3365: 
1.112     bowersj2 3366: ###############################################################
                   3367: ##               Student Answer Attempts                     ##
                   3368: ###############################################################
                   3369: 
                   3370: =pod
                   3371: 
                   3372: =head1 Alternate Problem Views
                   3373: 
                   3374: =over 4
                   3375: 
1.648     raeburn  3376: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3377:     $getattempt, $regexp, $gradesub)
                   3378: 
                   3379: Return string with previous attempt on problem. Arguments:
                   3380: 
                   3381: =over 4
                   3382: 
                   3383: =item * $symb: Problem, including path
                   3384: 
                   3385: =item * $username: username of the desired student
                   3386: 
                   3387: =item * $domain: domain of the desired student
1.14      harris41 3388: 
1.112     bowersj2 3389: =item * $course: Course ID
1.14      harris41 3390: 
1.112     bowersj2 3391: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3392:     something
1.14      harris41 3393: 
1.112     bowersj2 3394: =item * $regexp: if string matches this regexp, the string will be
                   3395:     sent to $gradesub
1.14      harris41 3396: 
1.112     bowersj2 3397: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3398: 
1.112     bowersj2 3399: =back
1.14      harris41 3400: 
1.112     bowersj2 3401: The output string is a table containing all desired attempts, if any.
1.16      harris41 3402: 
1.112     bowersj2 3403: =cut
1.1       albertel 3404: 
                   3405: sub get_previous_attempt {
1.43      ng       3406:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3407:   my $prevattempts='';
1.43      ng       3408:   no strict 'refs';
1.1       albertel 3409:   if ($symb) {
1.3       albertel 3410:     my (%returnhash)=
                   3411:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3412:     if ($returnhash{'version'}) {
                   3413:       my %lasthash=();
                   3414:       my $version;
                   3415:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3416:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3417: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3418:         }
1.1       albertel 3419:       }
1.596     albertel 3420:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3421:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3422:       my (%typeparts,%lasthidden);
1.945     raeburn  3423:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3424:       foreach my $key (sort(keys(%lasthash))) {
                   3425: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3426: 	if ($#parts > 0) {
1.31      albertel 3427: 	  my $data=$parts[-1];
1.989     raeburn  3428:           next if ($data eq 'foilorder');
1.31      albertel 3429: 	  pop(@parts);
1.945     raeburn  3430:           if ($data eq 'type') {
                   3431:               unless ($showsurv) {
                   3432:                   my $id = join(',',@parts);
                   3433:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3434:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3435:                       $lasthidden{$ign.'.'.$id} = 1;
                   3436:                   }
1.945     raeburn  3437:               }
                   3438:               delete($lasthash{$key});
                   3439:           } else {
                   3440: 	      $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
                   3441:           }
1.31      albertel 3442: 	} else {
1.41      ng       3443: 	  if ($#parts == 0) {
                   3444: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3445: 	  } else {
                   3446: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3447: 	  }
1.31      albertel 3448: 	}
1.16      harris41 3449:       }
1.596     albertel 3450:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3451:       if ($getattempt eq '') {
                   3452: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3453:             my @hidden;
                   3454:             if (%typeparts) {
                   3455:                 foreach my $id (keys(%typeparts)) {
                   3456:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3457:                         push(@hidden,$id);
                   3458:                     }
                   3459:                 }
                   3460:             }
                   3461:             $prevattempts.=&start_data_table_row().
                   3462:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3463:             if (@hidden) {
                   3464:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3465:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3466:                     my $hide;
                   3467:                     foreach my $id (@hidden) {
                   3468:                         if ($key =~ /^\Q$id\E/) {
                   3469:                             $hide = 1;
                   3470:                             last;
                   3471:                         }
                   3472:                     }
                   3473:                     if ($hide) {
                   3474:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3475:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3476:                             my $value = &format_previous_attempt_value($key,
                   3477:                                              $returnhash{$version.':'.$key});
                   3478:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3479:                         } else {
                   3480:                             $prevattempts.='<td>&nbsp;</td>';
                   3481:                         }
                   3482:                     } else {
                   3483:                         if ($key =~ /\./) {
                   3484:                             my $value = &format_previous_attempt_value($key,
                   3485:                                               $returnhash{$version.':'.$key});
                   3486:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3487:                         } else {
                   3488:                             $prevattempts.='<td>&nbsp;</td>';
                   3489:                         }
                   3490:                     }
                   3491:                 }
                   3492:             } else {
                   3493: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3494:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3495: 		    my $value = &format_previous_attempt_value($key,
                   3496: 			            $returnhash{$version.':'.$key});
                   3497: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3498: 	        }
                   3499:             }
                   3500: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3501: 	 }
1.1       albertel 3502:       }
1.945     raeburn  3503:       my @currhidden = keys(%lasthidden);
1.596     albertel 3504:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3505:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3506:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3507:           if (%typeparts) {
                   3508:               my $hidden;
                   3509:               foreach my $id (@currhidden) {
                   3510:                   if ($key =~ /^\Q$id\E/) {
                   3511:                       $hidden = 1;
                   3512:                       last;
                   3513:                   }
                   3514:               }
                   3515:               if ($hidden) {
                   3516:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3517:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3518:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3519:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3520:                           $value = &$gradesub($value);
                   3521:                       }
                   3522:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3523:                   } else {
                   3524:                       $prevattempts.='<td>&nbsp;</td>';
                   3525:                   }
                   3526:               } else {
                   3527:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3528:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3529:                       $value = &$gradesub($value);
                   3530:                   }
                   3531:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3532:               }
                   3533:           } else {
                   3534: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3535: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3536:                   $value = &$gradesub($value);
                   3537:               }
                   3538: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3539:           }
1.16      harris41 3540:       }
1.596     albertel 3541:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3542:     } else {
1.596     albertel 3543:       $prevattempts=
                   3544: 	  &start_data_table().&start_data_table_row().
                   3545: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3546: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3547:     }
                   3548:   } else {
1.596     albertel 3549:     $prevattempts=
                   3550: 	  &start_data_table().&start_data_table_row().
                   3551: 	  '<td>'.&mt('No data.').'</td>'.
                   3552: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3553:   }
1.10      albertel 3554: }
                   3555: 
1.581     albertel 3556: sub format_previous_attempt_value {
                   3557:     my ($key,$value) = @_;
                   3558:     if ($key =~ /timestamp/) {
                   3559: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3560:     } elsif (ref($value) eq 'ARRAY') {
                   3561: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3562:     } elsif ($key =~ /answerstring$/) {
                   3563:         my %answers = &Apache::lonnet::str2hash($value);
                   3564:         my @anskeys = sort(keys(%answers));
                   3565:         if (@anskeys == 1) {
                   3566:             my $answer = $answers{$anskeys[0]};
                   3567:             if ($answer =~ m{\Q\0\E}) {
                   3568:                 $answer =~ s{\Q\0\E}{, }g;
                   3569:             }
                   3570:             my $tag_internal_answer_name = 'INTERNAL';
                   3571:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3572:                 $value = $answer; 
                   3573:             } else {
                   3574:                 $value = $anskeys[0].'='.$answer;
                   3575:             }
                   3576:         } else {
                   3577:             foreach my $ans (@anskeys) {
                   3578:                 my $answer = $answers{$ans};
                   3579:                 if ($answer =~ m{\Q\0\E}) {
                   3580:                     $answer =~ s{\Q\0\E}{, }g;
                   3581:                 }
                   3582:                 $value .=  $ans.'='.$answer.'<br />';;
                   3583:             } 
                   3584:         }
1.581     albertel 3585:     } else {
                   3586: 	$value = &unescape($value);
                   3587:     }
                   3588:     return $value;
                   3589: }
                   3590: 
                   3591: 
1.107     albertel 3592: sub relative_to_absolute {
                   3593:     my ($url,$output)=@_;
                   3594:     my $parser=HTML::TokeParser->new(\$output);
                   3595:     my $token;
                   3596:     my $thisdir=$url;
                   3597:     my @rlinks=();
                   3598:     while ($token=$parser->get_token) {
                   3599: 	if ($token->[0] eq 'S') {
                   3600: 	    if ($token->[1] eq 'a') {
                   3601: 		if ($token->[2]->{'href'}) {
                   3602: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3603: 		}
                   3604: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3605: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3606: 	    } elsif ($token->[1] eq 'base') {
                   3607: 		$thisdir=$token->[2]->{'href'};
                   3608: 	    }
                   3609: 	}
                   3610:     }
                   3611:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3612:     foreach my $link (@rlinks) {
1.726     raeburn  3613: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3614: 		($link=~/^\//) ||
                   3615: 		($link=~/^javascript:/i) ||
                   3616: 		($link=~/^mailto:/i) ||
                   3617: 		($link=~/^\#/)) {
                   3618: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3619: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3620: 	}
                   3621:     }
                   3622: # -------------------------------------------------- Deal with Applet codebases
                   3623:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3624:     return $output;
                   3625: }
                   3626: 
1.112     bowersj2 3627: =pod
                   3628: 
1.648     raeburn  3629: =item * &get_student_view()
1.112     bowersj2 3630: 
                   3631: show a snapshot of what student was looking at
                   3632: 
                   3633: =cut
                   3634: 
1.10      albertel 3635: sub get_student_view {
1.186     albertel 3636:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3637:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3638:   my (%form);
1.10      albertel 3639:   my @elements=('symb','courseid','domain','username');
                   3640:   foreach my $element (@elements) {
1.186     albertel 3641:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3642:   }
1.186     albertel 3643:   if (defined($moreenv)) {
                   3644:       %form=(%form,%{$moreenv});
                   3645:   }
1.236     albertel 3646:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3647:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3648:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3649:   $userview=~s/\<body[^\>]*\>//gi;
                   3650:   $userview=~s/\<\/body\>//gi;
                   3651:   $userview=~s/\<html\>//gi;
                   3652:   $userview=~s/\<\/html\>//gi;
                   3653:   $userview=~s/\<head\>//gi;
                   3654:   $userview=~s/\<\/head\>//gi;
                   3655:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3656:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3657:   if (wantarray) {
                   3658:      return ($userview,$response);
                   3659:   } else {
                   3660:      return $userview;
                   3661:   }
                   3662: }
                   3663: 
                   3664: sub get_student_view_with_retries {
                   3665:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3666: 
                   3667:     my $ok = 0;                 # True if we got a good response.
                   3668:     my $content;
                   3669:     my $response;
                   3670: 
                   3671:     # Try to get the student_view done. within the retries count:
                   3672:     
                   3673:     do {
                   3674:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3675:          $ok      = $response->is_success;
                   3676:          if (!$ok) {
                   3677:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3678:          }
                   3679:          $retries--;
                   3680:     } while (!$ok && ($retries > 0));
                   3681:     
                   3682:     if (!$ok) {
                   3683:        $content = '';          # On error return an empty content.
                   3684:     }
1.651     www      3685:     if (wantarray) {
                   3686:        return ($content, $response);
                   3687:     } else {
                   3688:        return $content;
                   3689:     }
1.11      albertel 3690: }
                   3691: 
1.112     bowersj2 3692: =pod
                   3693: 
1.648     raeburn  3694: =item * &get_student_answers() 
1.112     bowersj2 3695: 
                   3696: show a snapshot of how student was answering problem
                   3697: 
                   3698: =cut
                   3699: 
1.11      albertel 3700: sub get_student_answers {
1.100     sakharuk 3701:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3702:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3703:   my (%moreenv);
1.11      albertel 3704:   my @elements=('symb','courseid','domain','username');
                   3705:   foreach my $element (@elements) {
1.186     albertel 3706:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3707:   }
1.186     albertel 3708:   $moreenv{'grade_target'}='answer';
                   3709:   %moreenv=(%form,%moreenv);
1.497     raeburn  3710:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3711:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3712:   return $userview;
1.1       albertel 3713: }
1.116     albertel 3714: 
                   3715: =pod
                   3716: 
                   3717: =item * &submlink()
                   3718: 
1.242     albertel 3719: Inputs: $text $uname $udom $symb $target
1.116     albertel 3720: 
                   3721: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3722: 
                   3723: =cut
                   3724: 
                   3725: ###############################################
                   3726: sub submlink {
1.242     albertel 3727:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3728:     if (!($uname && $udom)) {
                   3729: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3730: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3731: 	if (!$symb) { $symb=$cursymb; }
                   3732:     }
1.254     matthew  3733:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3734:     $symb=&escape($symb);
1.960     bisitz   3735:     if ($target) { $target=" target=\"$target\""; }
                   3736:     return
                   3737:         '<a href="/adm/grades?command=submission'.
                   3738:         '&amp;symb='.$symb.
                   3739:         '&amp;student='.$uname.
                   3740:         '&amp;userdom='.$udom.'"'.
                   3741:         $target.'>'.$text.'</a>';
1.242     albertel 3742: }
                   3743: ##############################################
                   3744: 
                   3745: =pod
                   3746: 
                   3747: =item * &pgrdlink()
                   3748: 
                   3749: Inputs: $text $uname $udom $symb $target
                   3750: 
                   3751: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3752: 
                   3753: =cut
                   3754: 
                   3755: ###############################################
                   3756: sub pgrdlink {
                   3757:     my $link=&submlink(@_);
                   3758:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3759:     return $link;
                   3760: }
                   3761: ##############################################
                   3762: 
                   3763: =pod
                   3764: 
                   3765: =item * &pprmlink()
                   3766: 
                   3767: Inputs: $text $uname $udom $symb $target
                   3768: 
                   3769: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3770: student and a specific resource
1.242     albertel 3771: 
                   3772: =cut
                   3773: 
                   3774: ###############################################
                   3775: sub pprmlink {
                   3776:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3777:     if (!($uname && $udom)) {
                   3778: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3779: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3780: 	if (!$symb) { $symb=$cursymb; }
                   3781:     }
1.254     matthew  3782:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3783:     $symb=&escape($symb);
1.242     albertel 3784:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3785:     return '<a href="/adm/parmset?command=set&amp;'.
                   3786: 	'symb='.$symb.'&amp;uname='.$uname.
                   3787: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3788: }
                   3789: ##############################################
1.37      matthew  3790: 
1.112     bowersj2 3791: =pod
                   3792: 
                   3793: =back
                   3794: 
                   3795: =cut
                   3796: 
1.37      matthew  3797: ###############################################
1.51      www      3798: 
                   3799: 
                   3800: sub timehash {
1.687     raeburn  3801:     my ($thistime) = @_;
                   3802:     my $timezone = &Apache::lonlocal::gettimezone();
                   3803:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3804:                      ->set_time_zone($timezone);
                   3805:     my $wday = $dt->day_of_week();
                   3806:     if ($wday == 7) { $wday = 0; }
                   3807:     return ( 'second' => $dt->second(),
                   3808:              'minute' => $dt->minute(),
                   3809:              'hour'   => $dt->hour(),
                   3810:              'day'     => $dt->day_of_month(),
                   3811:              'month'   => $dt->month(),
                   3812:              'year'    => $dt->year(),
                   3813:              'weekday' => $wday,
                   3814:              'dayyear' => $dt->day_of_year(),
                   3815:              'dlsav'   => $dt->is_dst() );
1.51      www      3816: }
                   3817: 
1.370     www      3818: sub utc_string {
                   3819:     my ($date)=@_;
1.371     www      3820:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3821: }
                   3822: 
1.51      www      3823: sub maketime {
                   3824:     my %th=@_;
1.687     raeburn  3825:     my ($epoch_time,$timezone,$dt);
                   3826:     $timezone = &Apache::lonlocal::gettimezone();
                   3827:     eval {
                   3828:         $dt = DateTime->new( year   => $th{'year'},
                   3829:                              month  => $th{'month'},
                   3830:                              day    => $th{'day'},
                   3831:                              hour   => $th{'hour'},
                   3832:                              minute => $th{'minute'},
                   3833:                              second => $th{'second'},
                   3834:                              time_zone => $timezone,
                   3835:                          );
                   3836:     };
                   3837:     if (!$@) {
                   3838:         $epoch_time = $dt->epoch;
                   3839:         if ($epoch_time) {
                   3840:             return $epoch_time;
                   3841:         }
                   3842:     }
1.51      www      3843:     return POSIX::mktime(
                   3844:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3845:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3846: }
                   3847: 
                   3848: #########################################
1.51      www      3849: 
                   3850: sub findallcourses {
1.482     raeburn  3851:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3852:     my %roles;
                   3853:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3854:     my %courses;
1.51      www      3855:     my $now=time;
1.482     raeburn  3856:     if (!defined($uname)) {
                   3857:         $uname = $env{'user.name'};
                   3858:     }
                   3859:     if (!defined($udom)) {
                   3860:         $udom = $env{'user.domain'};
                   3861:     }
                   3862:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.982     raeburn  3863:         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   3864:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
                   3865:                                               $extra);
1.482     raeburn  3866:         if (!%roles) {
                   3867:             %roles = (
                   3868:                        cc => 1,
1.907     raeburn  3869:                        co => 1,
1.482     raeburn  3870:                        in => 1,
                   3871:                        ep => 1,
                   3872:                        ta => 1,
                   3873:                        cr => 1,
                   3874:                        st => 1,
                   3875:              );
                   3876:         }
                   3877:         foreach my $entry (keys(%roleshash)) {
                   3878:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   3879:             if ($trole =~ /^cr/) { 
                   3880:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   3881:             } else {
                   3882:                 next if (!exists($roles{$trole}));
                   3883:             }
                   3884:             if ($tend) {
                   3885:                 next if ($tend < $now);
                   3886:             }
                   3887:             if ($tstart) {
                   3888:                 next if ($tstart > $now);
                   3889:             }
                   3890:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
                   3891:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
                   3892:             if ($secpart eq '') {
                   3893:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   3894:                 $sec = 'none';
                   3895:                 $realsec = '';
                   3896:             } else {
                   3897:                 $cnum = $cnumpart;
                   3898:                 ($sec,$role) = split(/_/,$secpart);
                   3899:                 $realsec = $sec;
1.490     raeburn  3900:             }
1.482     raeburn  3901:             $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
                   3902:         }
                   3903:     } else {
                   3904:         foreach my $key (keys(%env)) {
1.483     albertel 3905: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   3906:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  3907: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   3908: 	        next if ($role eq 'ca' || $role eq 'aa');
                   3909: 	        next if (%roles && !exists($roles{$role}));
                   3910: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   3911:                 my $active=1;
                   3912:                 if ($starttime) {
                   3913: 		    if ($now<$starttime) { $active=0; }
                   3914:                 }
                   3915:                 if ($endtime) {
                   3916:                     if ($now>$endtime) { $active=0; }
                   3917:                 }
                   3918:                 if ($active) {
                   3919:                     if ($sec eq '') {
                   3920:                         $sec = 'none';
                   3921:                     }
                   3922:                     $courses{$cdom.'_'.$cnum}{$sec} = 
                   3923:                                      $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474     raeburn  3924:                 }
                   3925:             }
1.51      www      3926:         }
                   3927:     }
1.474     raeburn  3928:     return %courses;
1.51      www      3929: }
1.37      matthew  3930: 
1.54      www      3931: ###############################################
1.474     raeburn  3932: 
                   3933: sub blockcheck {
1.482     raeburn  3934:     my ($setters,$activity,$uname,$udom) = @_;
1.490     raeburn  3935: 
                   3936:     if (!defined($udom)) {
                   3937:         $udom = $env{'user.domain'};
                   3938:     }
                   3939:     if (!defined($uname)) {
                   3940:         $uname = $env{'user.name'};
                   3941:     }
                   3942: 
                   3943:     # If uname and udom are for a course, check for blocks in the course.
                   3944: 
                   3945:     if (&Apache::lonnet::is_course($udom,$uname)) {
                   3946:         my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502     raeburn  3947:         my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490     raeburn  3948:         return ($startblock,$endblock);
                   3949:     }
1.474     raeburn  3950: 
1.502     raeburn  3951:     my $startblock = 0;
                   3952:     my $endblock = 0;
1.482     raeburn  3953:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  3954: 
1.490     raeburn  3955:     # If uname is for a user, and activity is course-specific, i.e.,
                   3956:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  3957: 
1.490     raeburn  3958:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   3959:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   3960:         foreach my $key (keys(%live_courses)) {
                   3961:             if ($key ne $env{'request.course.id'}) {
                   3962:                 delete($live_courses{$key});
                   3963:             }
                   3964:         }
                   3965:     }
                   3966: 
                   3967:     my $otheruser = 0;
                   3968:     my %own_courses;
                   3969:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   3970:         # Resource belongs to user other than current user.
                   3971:         $otheruser = 1;
                   3972:         # Gather courses for current user
                   3973:         %own_courses = 
                   3974:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   3975:     }
                   3976: 
                   3977:     # Gather active course roles - course coordinator, instructor, 
                   3978:     # exam proctor, ta, student, or custom role.
1.474     raeburn  3979: 
                   3980:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  3981:         my ($cdom,$cnum);
                   3982:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   3983:             $cdom = $env{'course.'.$course.'.domain'};
                   3984:             $cnum = $env{'course.'.$course.'.num'};
                   3985:         } else {
1.490     raeburn  3986:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  3987:         }
                   3988:         my $no_ownblock = 0;
                   3989:         my $no_userblock = 0;
1.533     raeburn  3990:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  3991:             # Check if current user has 'evb' priv for this
                   3992:             if (defined($own_courses{$course})) {
                   3993:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   3994:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   3995:                     if ($sec ne 'none') {
                   3996:                         $checkrole .= '/'.$sec;
                   3997:                     }
                   3998:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   3999:                         $no_ownblock = 1;
                   4000:                         last;
                   4001:                     }
                   4002:                 }
                   4003:             }
                   4004:             # if they have 'evb' priv and are currently not playing student
                   4005:             next if (($no_ownblock) &&
                   4006:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4007:         }
1.474     raeburn  4008:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4009:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4010:             if ($sec ne 'none') {
1.482     raeburn  4011:                 $checkrole .= '/'.$sec;
1.474     raeburn  4012:             }
1.490     raeburn  4013:             if ($otheruser) {
                   4014:                 # Resource belongs to user other than current user.
                   4015:                 # Assemble privs for that user, and check for 'evb' priv.
1.482     raeburn  4016:                 my ($trole,$tdom,$tnum,$tsec);
                   4017:                 my $entry = $live_courses{$course}{$sec};
                   4018:                 if ($entry =~ /^cr/) {
                   4019:                     ($trole,$tdom,$tnum,$tsec) = 
                   4020:                       ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4021:                 } else {
                   4022:                     ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4023:                 }
                   4024:                 my ($spec,$area,$trest,%allroles,%userroles);
                   4025:                 $area = '/'.$tdom.'/'.$tnum;
                   4026:                 $trest = $tnum;
                   4027:                 if ($tsec ne '') {
                   4028:                     $area .= '/'.$tsec;
                   4029:                     $trest .= '/'.$tsec;
                   4030:                 }
                   4031:                 $spec = $trole.'.'.$area;
                   4032:                 if ($trole =~ /^cr/) {
                   4033:                     &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4034:                                                       $tdom,$spec,$trest,$area);
                   4035:                 } else {
                   4036:                     &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4037:                                                        $tdom,$spec,$trest,$area);
                   4038:                 }
                   4039:                 my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486     raeburn  4040:                 if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4041:                     if ($1) {
                   4042:                         $no_userblock = 1;
                   4043:                         last;
                   4044:                     }
                   4045:                 }
1.490     raeburn  4046:             } else {
                   4047:                 # Resource belongs to current user
                   4048:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4049:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4050:                     $no_ownblock = 1;
                   4051:                     last;
                   4052:                 }
1.474     raeburn  4053:             }
                   4054:         }
                   4055:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4056:         next if (($no_ownblock) &&
1.491     albertel 4057:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4058:         next if ($no_userblock);
1.474     raeburn  4059: 
1.866     kalberla 4060:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4061:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4062:         
                   4063:         my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
                   4064:         if (($start != 0) && 
                   4065:             (($startblock == 0) || ($startblock > $start))) {
                   4066:             $startblock = $start;
                   4067:         }
                   4068:         if (($end != 0)  &&
                   4069:             (($endblock == 0) || ($endblock < $end))) {
                   4070:             $endblock = $end;
                   4071:         }
1.490     raeburn  4072:     }
                   4073:     return ($startblock,$endblock);
                   4074: }
                   4075: 
                   4076: sub get_blocks {
                   4077:     my ($setters,$activity,$cdom,$cnum) = @_;
                   4078:     my $startblock = 0;
                   4079:     my $endblock = 0;
                   4080:     my $course = $cdom.'_'.$cnum;
                   4081:     $setters->{$course} = {};
                   4082:     $setters->{$course}{'staff'} = [];
                   4083:     $setters->{$course}{'times'} = [];
                   4084:     my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
                   4085:     foreach my $record (keys(%records)) {
                   4086:         my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
                   4087:         if ($start <= time && $end >= time) {
                   4088:             my ($staff_name,$staff_dom,$title,$blocks) =
                   4089:                 &parse_block_record($records{$record});
                   4090:             if ($blocks->{$activity} eq 'on') {
                   4091:                 push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4092:                 push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491     albertel 4093:                 if ( ($startblock == 0) || ($startblock > $start) ) {
                   4094:                     $startblock = $start;
1.490     raeburn  4095:                 }
1.491     albertel 4096:                 if ( ($endblock == 0) || ($endblock < $end) ) {
                   4097:                     $endblock = $end;
1.474     raeburn  4098:                 }
                   4099:             }
                   4100:         }
                   4101:     }
                   4102:     return ($startblock,$endblock);
                   4103: }
                   4104: 
                   4105: sub parse_block_record {
                   4106:     my ($record) = @_;
                   4107:     my ($setuname,$setudom,$title,$blocks);
                   4108:     if (ref($record) eq 'HASH') {
                   4109:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4110:         $title = &unescape($record->{'event'});
                   4111:         $blocks = $record->{'blocks'};
                   4112:     } else {
                   4113:         my @data = split(/:/,$record,3);
                   4114:         if (scalar(@data) eq 2) {
                   4115:             $title = $data[1];
                   4116:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4117:         } else {
                   4118:             ($setuname,$setudom,$title) = @data;
                   4119:         }
                   4120:         $blocks = { 'com' => 'on' };
                   4121:     }
                   4122:     return ($setuname,$setudom,$title,$blocks);
                   4123: }
                   4124: 
1.854     kalberla 4125: sub blocking_status {
                   4126:   my ($activity,$uname,$udom) = @_;
1.867     kalberla 4127:   my %setters;
1.890     droeschl 4128: 
                   4129:   # check for active blocking
1.867     kalberla 4130:   my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854     kalberla 4131: 
1.890     droeschl 4132:   my $blocked = $startblock && $endblock ? 1 : 0;
                   4133: 
                   4134:   # caller just wants to know whether a block is active
                   4135:   if (!wantarray) { return $blocked; }
                   4136: 
                   4137:   # build a link to a popup window containing the details
                   4138:   my $querystring  = "?activity=$activity";
                   4139:   # $uname and $udom decide whose portfolio the user is trying to look at
                   4140:      $querystring .= "&amp;udom=$udom"      if $udom;
                   4141:      $querystring .= "&amp;uname=$uname"    if $uname;
                   4142: 
                   4143:   my $output .= <<'END_MYBLOCK';
1.854     kalberla 4144:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4145:         var options = "width=" + w + ",height=" + h + ",";
                   4146:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4147:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4148:         var newWin = window.open(url, wdwName, options);
                   4149:         newWin.focus();
                   4150:     }
1.890     droeschl 4151: END_MYBLOCK
1.854     kalberla 4152: 
1.890     droeschl 4153:   $output = Apache::lonhtmlcommon::scripttag($output);
                   4154:   
1.854     kalberla 4155:   my $popupUrl = "/adm/blockingstatus/$querystring";
1.890     droeschl 4156:   my $text = mt('Communication Blocked');
                   4157: 
1.867     kalberla 4158:   $output .= <<"END_BLOCK";
                   4159: <div class='LC_comblock'>
1.869     kalberla 4160:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4161:   title='$text'>
                   4162:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4163:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4164:   title='$text'>$text</a>
1.867     kalberla 4165: </div>
                   4166: 
                   4167: END_BLOCK
1.474     raeburn  4168: 
1.854     kalberla 4169:   return ($blocked, $output);
                   4170: }
1.490     raeburn  4171: 
1.60      matthew  4172: ###############################################
                   4173: 
1.682     raeburn  4174: sub check_ip_acc {
                   4175:     my ($acc)=@_;
                   4176:     &Apache::lonxml::debug("acc is $acc");
                   4177:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4178:         return 1;
                   4179:     }
                   4180:     my $allowed=0;
                   4181:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4182: 
                   4183:     my $name;
                   4184:     foreach my $pattern (split(',',$acc)) {
                   4185:         $pattern =~ s/^\s*//;
                   4186:         $pattern =~ s/\s*$//;
                   4187:         if ($pattern =~ /\*$/) {
                   4188:             #35.8.*
                   4189:             $pattern=~s/\*//;
                   4190:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4191:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4192:             #35.8.3.[34-56]
                   4193:             my $low=$2;
                   4194:             my $high=$3;
                   4195:             $pattern=$1;
                   4196:             if ($ip =~ /^\Q$pattern\E/) {
                   4197:                 my $last=(split(/\./,$ip))[3];
                   4198:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4199:             }
                   4200:         } elsif ($pattern =~ /^\*/) {
                   4201:             #*.msu.edu
                   4202:             $pattern=~s/\*//;
                   4203:             if (!defined($name)) {
                   4204:                 use Socket;
                   4205:                 my $netaddr=inet_aton($ip);
                   4206:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4207:             }
                   4208:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4209:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4210:             #127.0.0.1
                   4211:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4212:         } else {
                   4213:             #some.name.com
                   4214:             if (!defined($name)) {
                   4215:                 use Socket;
                   4216:                 my $netaddr=inet_aton($ip);
                   4217:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4218:             }
                   4219:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4220:         }
                   4221:         if ($allowed) { last; }
                   4222:     }
                   4223:     return $allowed;
                   4224: }
                   4225: 
                   4226: ###############################################
                   4227: 
1.60      matthew  4228: =pod
                   4229: 
1.112     bowersj2 4230: =head1 Domain Template Functions
                   4231: 
                   4232: =over 4
                   4233: 
                   4234: =item * &determinedomain()
1.60      matthew  4235: 
                   4236: Inputs: $domain (usually will be undef)
                   4237: 
1.63      www      4238: Returns: Determines which domain should be used for designs
1.60      matthew  4239: 
                   4240: =cut
1.54      www      4241: 
1.60      matthew  4242: ###############################################
1.63      www      4243: sub determinedomain {
                   4244:     my $domain=shift;
1.531     albertel 4245:     if (! $domain) {
1.60      matthew  4246:         # Determine domain if we have not been given one
1.893     raeburn  4247:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4248:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4249:         if ($env{'request.role.domain'}) { 
                   4250:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4251:         }
                   4252:     }
1.63      www      4253:     return $domain;
                   4254: }
                   4255: ###############################################
1.517     raeburn  4256: 
1.518     albertel 4257: sub devalidate_domconfig_cache {
                   4258:     my ($udom)=@_;
                   4259:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4260: }
                   4261: 
                   4262: # ---------------------- Get domain configuration for a domain
                   4263: sub get_domainconf {
                   4264:     my ($udom) = @_;
                   4265:     my $cachetime=1800;
                   4266:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4267:     if (defined($cached)) { return %{$result}; }
                   4268: 
                   4269:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4270: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4271:     my (%designhash,%legacy);
1.518     albertel 4272:     if (keys(%domconfig) > 0) {
                   4273:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4274:             if (keys(%{$domconfig{'login'}})) {
                   4275:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4276:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4277:                         if ($key eq 'loginvia') {
                   4278:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
                   4279:                                 my @ids = &Apache::lonnet::current_machine_ids();
                   4280:                                 foreach my $hostname (@ids) {
1.948     raeburn  4281:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4282:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4283:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4284:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4285:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4286: 
                   4287:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4288:                                             } else {
                   4289:                                                  $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   4290:                                             }
                   4291:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4292:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4293:                                             }
1.946     raeburn  4294:                                         }
                   4295:                                     }
                   4296:                                 }
                   4297:                             }
                   4298:                         } else {
                   4299:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4300:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4301:                                     $domconfig{'login'}{$key}{$img};
                   4302:                             }
1.699     raeburn  4303:                         }
                   4304:                     } else {
                   4305:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4306:                     }
1.632     raeburn  4307:                 }
                   4308:             } else {
                   4309:                 $legacy{'login'} = 1;
1.518     albertel 4310:             }
1.632     raeburn  4311:         } else {
                   4312:             $legacy{'login'} = 1;
1.518     albertel 4313:         }
                   4314:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4315:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4316:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4317:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4318:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4319:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4320:                         }
1.518     albertel 4321:                     }
                   4322:                 }
1.632     raeburn  4323:             } else {
                   4324:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4325:             }
1.632     raeburn  4326:         } else {
                   4327:             $legacy{'rolecolors'} = 1;
1.518     albertel 4328:         }
1.948     raeburn  4329:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4330:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4331:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4332:             }
                   4333:         }
1.632     raeburn  4334:         if (keys(%legacy) > 0) {
                   4335:             my %legacyhash = &get_legacy_domconf($udom);
                   4336:             foreach my $item (keys(%legacyhash)) {
                   4337:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4338:                     if ($legacy{'login'}) { 
                   4339:                         $designhash{$item} = $legacyhash{$item};
                   4340:                     }
                   4341:                 } else {
                   4342:                     if ($legacy{'rolecolors'}) {
                   4343:                         $designhash{$item} = $legacyhash{$item};
                   4344:                     }
1.518     albertel 4345:                 }
                   4346:             }
                   4347:         }
1.632     raeburn  4348:     } else {
                   4349:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4350:     }
                   4351:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4352: 				  $cachetime);
                   4353:     return %designhash;
                   4354: }
                   4355: 
1.632     raeburn  4356: sub get_legacy_domconf {
                   4357:     my ($udom) = @_;
                   4358:     my %legacyhash;
                   4359:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4360:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4361:     if (-e $designfile) {
                   4362:         if ( open (my $fh,"<$designfile") ) {
                   4363:             while (my $line = <$fh>) {
                   4364:                 next if ($line =~ /^\#/);
                   4365:                 chomp($line);
                   4366:                 my ($key,$val)=(split(/\=/,$line));
                   4367:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4368:             }
                   4369:             close($fh);
                   4370:         }
                   4371:     }
                   4372:     if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
                   4373:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4374:     }
                   4375:     return %legacyhash;
                   4376: }
                   4377: 
1.63      www      4378: =pod
                   4379: 
1.112     bowersj2 4380: =item * &domainlogo()
1.63      www      4381: 
                   4382: Inputs: $domain (usually will be undef)
                   4383: 
                   4384: Returns: A link to a domain logo, if the domain logo exists.
                   4385: If the domain logo does not exist, a description of the domain.
                   4386: 
                   4387: =cut
1.112     bowersj2 4388: 
1.63      www      4389: ###############################################
                   4390: sub domainlogo {
1.517     raeburn  4391:     my $domain = &determinedomain(shift);
1.518     albertel 4392:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4393:     # See if there is a logo
                   4394:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4395:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4396:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4397: 	    if ($imgsrc =~ m{^/res/}) {
                   4398: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4399: 		&Apache::lonnet::repcopy($local_name);
                   4400: 	    }
                   4401: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4402:         } 
                   4403:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4404:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4405:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4406:     } else {
1.60      matthew  4407:         return '';
1.59      www      4408:     }
                   4409: }
1.63      www      4410: ##############################################
                   4411: 
                   4412: =pod
                   4413: 
1.112     bowersj2 4414: =item * &designparm()
1.63      www      4415: 
                   4416: Inputs: $which parameter; $domain (usually will be undef)
                   4417: 
                   4418: Returns: value of designparamter $which
                   4419: 
                   4420: =cut
1.112     bowersj2 4421: 
1.397     albertel 4422: 
1.400     albertel 4423: ##############################################
1.397     albertel 4424: sub designparm {
                   4425:     my ($which,$domain)=@_;
                   4426:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4427:         return $env{'environment.color.'.$which};
1.96      www      4428:     }
1.63      www      4429:     $domain=&determinedomain($domain);
1.518     albertel 4430:     my %domdesign = &get_domainconf($domain);
1.520     raeburn  4431:     my $output;
1.517     raeburn  4432:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4433:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4434:     } else {
1.520     raeburn  4435:         $output = $defaultdesign{$which};
                   4436:     }
                   4437:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4438:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4439:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4440:             if ($output =~ m{^/res/}) {
                   4441:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4442:                 &Apache::lonnet::repcopy($local_name);
                   4443:             }
1.520     raeburn  4444:             $output = &lonhttpdurl($output);
                   4445:         }
1.63      www      4446:     }
1.520     raeburn  4447:     return $output;
1.63      www      4448: }
1.59      www      4449: 
1.822     bisitz   4450: ##############################################
                   4451: =pod
                   4452: 
1.832     bisitz   4453: =item * &authorspace()
                   4454: 
                   4455: Inputs: ./.
                   4456: 
                   4457: Returns: Path to the Construction Space of the current user's
                   4458:          accessed author space
                   4459:          The author space will be that of the current user
                   4460:          when accessing the own author space
                   4461:          and that of the co-author/assistent co-author
                   4462:          when accessing the co-author's/assistent co-author's
                   4463:          space
                   4464: 
                   4465: =cut
                   4466: 
                   4467: sub authorspace {
                   4468:     my $caname = '';
                   4469:     if ($env{'request.role'} =~ /^ca|^aa/) {
                   4470:         (undef,$caname) =
                   4471:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
                   4472:     } else {
                   4473:         $caname = $env{'user.name'};
                   4474:     }
                   4475:     return '/priv/'.$caname.'/';
                   4476: }
                   4477: 
                   4478: ##############################################
                   4479: =pod
                   4480: 
1.822     bisitz   4481: =item * &head_subbox()
                   4482: 
                   4483: Inputs: $content (contains HTML code with page functions, etc.)
                   4484: 
                   4485: Returns: HTML div with $content
                   4486:          To be included in page header
                   4487: 
                   4488: =cut
                   4489: 
                   4490: sub head_subbox {
                   4491:     my ($content)=@_;
                   4492:     my $output =
1.993     raeburn  4493:         '<div class="LC_head_subbox">'
1.822     bisitz   4494:        .$content
                   4495:        .'</div>'
                   4496: }
                   4497: 
                   4498: ##############################################
                   4499: =pod
                   4500: 
                   4501: =item * &CSTR_pageheader()
                   4502: 
                   4503: Inputs: ./.
                   4504: 
                   4505: Returns: HTML div with CSTR path and recent box
                   4506:          To be included on Construction Space pages
                   4507: 
                   4508: =cut
                   4509: 
                   4510: sub CSTR_pageheader {
                   4511:     # this is for resources; directories have customtitle, and crumbs
                   4512:             # and select recent are created in lonpubdir.pm  
                   4513:     my ($uname,$thisdisfn)=
                   4514:         ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
                   4515:     my $formaction='/priv/'.$uname.'/'.$thisdisfn;
                   4516:     $formaction=~s/\/+/\//g;
                   4517: 
                   4518:     my $parentpath = '';
                   4519:     my $lastitem = '';
                   4520:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4521:         $parentpath = $1;
                   4522:         $lastitem = $2;
                   4523:     } else {
                   4524:         $lastitem = $thisdisfn;
                   4525:     }
1.921     bisitz   4526: 
                   4527:     my $output =
1.822     bisitz   4528:          '<div>'
                   4529:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4530:         .'<b>'.&mt('Construction Space:').'</b> '
                   4531:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4532:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
                   4533:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef);
                   4534: 
                   4535:     if ($lastitem) {
                   4536:         $output .=
                   4537:              '<span class="LC_filename">'
                   4538:             .$lastitem
                   4539:             .'</span>';
                   4540:     }
                   4541:     $output .=
                   4542:          '<br />'
1.822     bisitz   4543:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4544:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4545:         .'</form>'
                   4546:         .&Apache::lonmenu::constspaceform()
                   4547:         .'</div>';
1.921     bisitz   4548: 
                   4549:     return $output;
1.822     bisitz   4550: }
                   4551: 
1.60      matthew  4552: ###############################################
                   4553: ###############################################
                   4554: 
                   4555: =pod
                   4556: 
1.112     bowersj2 4557: =back
                   4558: 
1.549     albertel 4559: =head1 HTML Helpers
1.112     bowersj2 4560: 
                   4561: =over 4
                   4562: 
                   4563: =item * &bodytag()
1.60      matthew  4564: 
                   4565: Returns a uniform header for LON-CAPA web pages.
                   4566: 
                   4567: Inputs: 
                   4568: 
1.112     bowersj2 4569: =over 4
                   4570: 
                   4571: =item * $title, A title to be displayed on the page.
                   4572: 
                   4573: =item * $function, the current role (can be undef).
                   4574: 
                   4575: =item * $addentries, extra parameters for the <body> tag.
                   4576: 
                   4577: =item * $bodyonly, if defined, only return the <body> tag.
                   4578: 
                   4579: =item * $domain, if defined, force a given domain.
                   4580: 
                   4581: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4582:             text interface only)
1.60      matthew  4583: 
1.814     bisitz   4584: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4585:                      navigational links
1.317     albertel 4586: 
1.338     albertel 4587: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4588: 
1.460     albertel 4589: =item * $args, optional argument valid values are
                   4590:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4591:             inherit_jsmath -> when creating popup window in a page,
                   4592:                               should it have jsmath forced on by the
                   4593:                               current page
1.460     albertel 4594: 
1.112     bowersj2 4595: =back
                   4596: 
1.60      matthew  4597: Returns: A uniform header for LON-CAPA web pages.  
                   4598: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4599: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4600: other decorations will be returned.
                   4601: 
                   4602: =cut
                   4603: 
1.54      www      4604: sub bodytag {
1.831     bisitz   4605:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962     droeschl 4606:         $no_nav_bar,$bgcolor,$args)=@_;
1.339     albertel 4607: 
1.954     raeburn  4608:     my $public;
                   4609:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4610:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4611:         $public = 1;
                   4612:     }
1.460     albertel 4613:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4614: 
1.183     matthew  4615:     $function = &get_users_function() if (!$function);
1.339     albertel 4616:     my $img =    &designparm($function.'.img',$domain);
                   4617:     my $font =   &designparm($function.'.font',$domain);
                   4618:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4619: 
1.803     bisitz   4620:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 4621: 		   'bgcolor' => $pgbg,
1.339     albertel 4622: 		   'text'    => $font,
                   4623:                    'alink'   => &designparm($function.'.alink',$domain),
                   4624: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4625: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4626:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4627: 
1.63      www      4628:  # role and realm
1.378     raeburn  4629:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4630:     if ($role  eq 'ca') {
1.479     albertel 4631:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4632:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4633:     } 
1.55      www      4634: # realm
1.258     albertel 4635:     if ($env{'request.course.id'}) {
1.378     raeburn  4636:         if ($env{'request.role'} !~ /^cr/) {
                   4637:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4638:         }
1.898     raeburn  4639:         if ($env{'request.course.sec'}) {
                   4640:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   4641:         }   
1.359     albertel 4642: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4643:     } else {
                   4644:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4645:     }
1.433     albertel 4646: 
1.359     albertel 4647:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 4648: 
1.438     albertel 4649:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4650: 
1.101     www      4651: # construct main body tag
1.359     albertel 4652:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4653: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4654: 
1.530     albertel 4655:     if ($bodyonly) {
1.60      matthew  4656:         return $bodytag;
1.798     tempelho 4657:     } 
1.359     albertel 4658: 
1.410     albertel 4659:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  4660:     if ($public) {
1.433     albertel 4661: 	undef($role);
1.434     albertel 4662:     } else {
                   4663: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433     albertel 4664:     }
1.359     albertel 4665:     
1.762     bisitz   4666:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 4667:     #
                   4668:     # Extra info if you are the DC
                   4669:     my $dc_info = '';
                   4670:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4671:                         $env{'course.'.$env{'request.course.id'}.
                   4672:                                  '.domain'}.'/'})) {
                   4673:         my $cid = $env{'request.course.id'};
1.917     raeburn  4674:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4675:         $dc_info =~ s/\s+$//;
1.359     albertel 4676:     }
                   4677: 
1.898     raeburn  4678:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 4679:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   4680: 
1.916     droeschl 4681:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   4682:             return $bodytag; 
                   4683:         } 
1.903     droeschl 4684: 
                   4685:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   4686: 
                   4687:         #    if ($env{'request.state'} eq 'construct') {
                   4688:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   4689:         #    }
                   4690: 
1.359     albertel 4691: 
                   4692: 
1.916     droeschl 4693:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  4694:              if ($dc_info) {
                   4695:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   4696:              }
1.916     droeschl 4697:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   4698:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 4699:             return $bodytag;
                   4700:         }
1.894     droeschl 4701: 
1.927     raeburn  4702:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   4703:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   4704:         }
1.916     droeschl 4705: 
1.903     droeschl 4706:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   4707:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   4708: 
1.903     droeschl 4709:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 4710: 
1.917     raeburn  4711:         if ($dc_info) {
                   4712:             $dc_info = &dc_courseid_toggle($dc_info);
                   4713:         }
                   4714:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 4715: 
1.903     droeschl 4716:         #don't show menus for public users
1.954     raeburn  4717:         if (!$public){
1.903     droeschl 4718:             $bodytag .= Apache::lonmenu::secondary_menu();
                   4719:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  4720:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   4721:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 4722:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  4723:                                 $args->{'bread_crumbs'});
                   4724:             } elsif ($forcereg) { 
                   4725:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   4726:             }
1.903     droeschl 4727:         }else{
                   4728:             # this is to seperate menu from content when there's no secondary
                   4729:             # menu. Especially needed for public accessible ressources.
                   4730:             $bodytag .= '<hr style="clear:both" />';
                   4731:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  4732:         }
1.903     droeschl 4733: 
1.235     raeburn  4734:         return $bodytag;
1.182     matthew  4735: }
                   4736: 
1.917     raeburn  4737: sub dc_courseid_toggle {
                   4738:     my ($dc_info) = @_;
1.980     raeburn  4739:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.917     raeburn  4740:            '<a href="javascript:showCourseID();">'.
                   4741:            &mt('(More ...)').'</a></span>'.
                   4742:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   4743: }
                   4744: 
1.330     albertel 4745: sub make_attr_string {
                   4746:     my ($register,$attr_ref) = @_;
                   4747: 
                   4748:     if ($attr_ref && !ref($attr_ref)) {
                   4749: 	die("addentries Must be a hash ref ".
                   4750: 	    join(':',caller(1))." ".
                   4751: 	    join(':',caller(0))." ");
                   4752:     }
                   4753: 
                   4754:     if ($register) {
1.339     albertel 4755: 	my ($on_load,$on_unload);
                   4756: 	foreach my $key (keys(%{$attr_ref})) {
                   4757: 	    if      (lc($key) eq 'onload') {
                   4758: 		$on_load.=$attr_ref->{$key}.';';
                   4759: 		delete($attr_ref->{$key});
                   4760: 
                   4761: 	    } elsif (lc($key) eq 'onunload') {
                   4762: 		$on_unload.=$attr_ref->{$key}.';';
                   4763: 		delete($attr_ref->{$key});
                   4764: 	    }
                   4765: 	}
1.953     droeschl 4766: 	$attr_ref->{'onload'}  = $on_load;
                   4767: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 4768:     }
1.339     albertel 4769: 
1.330     albertel 4770:     my $attr_string;
                   4771:     foreach my $attr (keys(%$attr_ref)) {
                   4772: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   4773:     }
                   4774:     return $attr_string;
                   4775: }
                   4776: 
                   4777: 
1.182     matthew  4778: ###############################################
1.251     albertel 4779: ###############################################
                   4780: 
                   4781: =pod
                   4782: 
                   4783: =item * &endbodytag()
                   4784: 
                   4785: Returns a uniform footer for LON-CAPA web pages.
                   4786: 
1.635     raeburn  4787: Inputs: 1 - optional reference to an args hash
                   4788: If in the hash, key for noredirectlink has a value which evaluates to true,
                   4789: a 'Continue' link is not displayed if the page contains an
                   4790: internal redirect in the <head></head> section,
                   4791: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 4792: 
                   4793: =cut
                   4794: 
                   4795: sub endbodytag {
1.635     raeburn  4796:     my ($args) = @_;
1.251     albertel 4797:     my $endbodytag='</body>';
1.269     albertel 4798:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 4799:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  4800:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   4801: 	    $endbodytag=
                   4802: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   4803: 	        &mt('Continue').'</a>'.
                   4804: 	        $endbodytag;
                   4805:         }
1.315     albertel 4806:     }
1.251     albertel 4807:     return $endbodytag;
                   4808: }
                   4809: 
1.352     albertel 4810: =pod
                   4811: 
                   4812: =item * &standard_css()
                   4813: 
                   4814: Returns a style sheet
                   4815: 
                   4816: Inputs: (all optional)
                   4817:             domain         -> force to color decorate a page for a specific
                   4818:                                domain
                   4819:             function       -> force usage of a specific rolish color scheme
                   4820:             bgcolor        -> override the default page bgcolor
                   4821: 
                   4822: =cut
                   4823: 
1.343     albertel 4824: sub standard_css {
1.345     albertel 4825:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 4826:     $function  = &get_users_function() if (!$function);
                   4827:     my $img    = &designparm($function.'.img',   $domain);
                   4828:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   4829:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 4830:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 4831: #second colour for later usage
1.345     albertel 4832:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 4833:     my $pgbg_or_bgcolor =
                   4834: 	         $bgcolor ||
1.352     albertel 4835: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 4836:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 4837:     my $alink  = &designparm($function.'.alink', $domain);
                   4838:     my $vlink  = &designparm($function.'.vlink', $domain);
                   4839:     my $link   = &designparm($function.'.link',  $domain);
                   4840: 
1.602     albertel 4841:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 4842:     my $mono                 = 'monospace';
1.850     bisitz   4843:     my $data_table_head      = $sidebg;
                   4844:     my $data_table_light     = '#FAFAFA';
                   4845:     my $data_table_dark      = '#F0F0F0';
1.470     banghart 4846:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 4847:     my $data_table_highlight = '#FFFF00';
1.352     albertel 4848:     my $mail_new             = '#FFBB77';
                   4849:     my $mail_new_hover       = '#DD9955';
                   4850:     my $mail_read            = '#BBBB77';
                   4851:     my $mail_read_hover      = '#999944';
                   4852:     my $mail_replied         = '#AAAA88';
                   4853:     my $mail_replied_hover   = '#888855';
                   4854:     my $mail_other           = '#99BBBB';
                   4855:     my $mail_other_hover     = '#669999';
1.391     albertel 4856:     my $table_header         = '#DDDDDD';
1.489     raeburn  4857:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   4858:     my $lg_border_color      = '#C8C8C8';
1.952     onken    4859:     my $button_hover         = '#BF2317';
1.392     albertel 4860: 
1.608     albertel 4861:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   4862:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   4863:                                              : '0 3px 0 4px';
1.448     albertel 4864: 
1.523     albertel 4865: 
1.343     albertel 4866:     return <<END;
1.947     droeschl 4867: 
                   4868: /* needed for iframe to allow 100% height in FF */
                   4869: body, html { 
                   4870:     margin: 0;
                   4871:     padding: 0 0.5%;
                   4872:     height: 99%; /* to avoid scrollbars */
                   4873: }
                   4874: 
1.795     www      4875: body {
1.911     bisitz   4876:   font-family: $sans;
                   4877:   line-height:130%;
                   4878:   font-size:0.83em;
                   4879:   color:$font;
1.795     www      4880: }
                   4881: 
1.959     onken    4882: a:focus,
                   4883: a:focus img {
1.795     www      4884:   color: red;
1.911     bisitz   4885:   background: yellow;
1.795     www      4886: }
1.698     harmsja  4887: 
1.911     bisitz   4888: form, .inline {
                   4889:   display: inline;
1.795     www      4890: }
1.721     harmsja  4891: 
1.795     www      4892: .LC_right {
1.911     bisitz   4893:   text-align:right;
1.795     www      4894: }
                   4895: 
                   4896: .LC_middle {
1.911     bisitz   4897:   vertical-align:middle;
1.795     www      4898: }
1.721     harmsja  4899: 
1.911     bisitz   4900: .LC_400Box {
                   4901:   width:400px;
                   4902: }
1.721     harmsja  4903: 
1.947     droeschl 4904: .LC_iframecontainer {
                   4905:     width: 98%;
                   4906:     margin: 0;
                   4907:     position: fixed;
                   4908:     top: 8.5em;
                   4909:     bottom: 0;
                   4910: }
                   4911: 
                   4912: .LC_iframecontainer iframe{
                   4913:     border: none;
                   4914:     width: 100%;
                   4915:     height: 100%;
                   4916: }
                   4917: 
1.778     bisitz   4918: .LC_filename {
                   4919:   font-family: $mono;
                   4920:   white-space:pre;
1.921     bisitz   4921:   font-size: 120%;
1.778     bisitz   4922: }
                   4923: 
                   4924: .LC_fileicon {
                   4925:   border: none;
                   4926:   height: 1.3em;
                   4927:   vertical-align: text-bottom;
                   4928:   margin-right: 0.3em;
                   4929:   text-decoration:none;
                   4930: }
                   4931: 
1.350     albertel 4932: .LC_error {
                   4933:   color: red;
                   4934:   font-size: larger;
                   4935: }
1.795     www      4936: 
1.457     albertel 4937: .LC_warning,
                   4938: .LC_diff_removed {
1.733     bisitz   4939:   color: red;
1.394     albertel 4940: }
1.532     albertel 4941: 
                   4942: .LC_info,
1.457     albertel 4943: .LC_success,
                   4944: .LC_diff_added {
1.350     albertel 4945:   color: green;
                   4946: }
1.795     www      4947: 
1.802     bisitz   4948: div.LC_confirm_box {
                   4949:   background-color: #FAFAFA;
                   4950:   border: 1px solid $lg_border_color;
                   4951:   margin-right: 0;
                   4952:   padding: 5px;
                   4953: }
                   4954: 
                   4955: div.LC_confirm_box .LC_error img,
                   4956: div.LC_confirm_box .LC_success img {
                   4957:   vertical-align: middle;
                   4958: }
                   4959: 
1.440     albertel 4960: .LC_icon {
1.771     droeschl 4961:   border: none;
1.790     droeschl 4962:   vertical-align: middle;
1.771     droeschl 4963: }
                   4964: 
1.543     albertel 4965: .LC_docs_spacer {
                   4966:   width: 25px;
                   4967:   height: 1px;
1.771     droeschl 4968:   border: none;
1.543     albertel 4969: }
1.346     albertel 4970: 
1.532     albertel 4971: .LC_internal_info {
1.735     bisitz   4972:   color: #999999;
1.532     albertel 4973: }
                   4974: 
1.794     www      4975: .LC_discussion {
1.911     bisitz   4976:   background: $tabbg;
                   4977:   border: 1px solid black;
                   4978:   margin: 2px;
1.794     www      4979: }
                   4980: 
                   4981: .LC_disc_action_links_bar {
1.911     bisitz   4982:   background: $tabbg;
                   4983:   border: none;
                   4984:   margin: 4px;
1.794     www      4985: }
                   4986: 
                   4987: .LC_disc_action_left {
1.911     bisitz   4988:   text-align: left;
1.794     www      4989: }
                   4990: 
                   4991: .LC_disc_action_right {
1.911     bisitz   4992:   text-align: right;
1.794     www      4993: }
                   4994: 
                   4995: .LC_disc_new_item {
1.911     bisitz   4996:   background: white;
                   4997:   border: 2px solid red;
                   4998:   margin: 2px;
1.794     www      4999: }
                   5000: 
                   5001: .LC_disc_old_item {
1.911     bisitz   5002:   background: white;
                   5003:   border: 1px solid black;
                   5004:   margin: 2px;
1.794     www      5005: }
                   5006: 
1.458     albertel 5007: table.LC_pastsubmission {
                   5008:   border: 1px solid black;
                   5009:   margin: 2px;
                   5010: }
                   5011: 
1.924     bisitz   5012: table#LC_menubuttons {
1.345     albertel 5013:   width: 100%;
                   5014:   background: $pgbg;
1.392     albertel 5015:   border: 2px;
1.402     albertel 5016:   border-collapse: separate;
1.803     bisitz   5017:   padding: 0;
1.345     albertel 5018: }
1.392     albertel 5019: 
1.801     tempelho 5020: table#LC_title_bar a {
                   5021:   color: $fontmenu;
                   5022: }
1.836     bisitz   5023: 
1.807     droeschl 5024: table#LC_title_bar {
1.819     tempelho 5025:   clear: both;
1.836     bisitz   5026:   display: none;
1.807     droeschl 5027: }
                   5028: 
1.795     www      5029: table#LC_title_bar,
1.933     droeschl 5030: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5031: table#LC_title_bar.LC_with_remote {
1.359     albertel 5032:   width: 100%;
1.392     albertel 5033:   border-color: $pgbg;
                   5034:   border-style: solid;
                   5035:   border-width: $border;
1.379     albertel 5036:   background: $pgbg;
1.801     tempelho 5037:   color: $fontmenu;
1.392     albertel 5038:   border-collapse: collapse;
1.803     bisitz   5039:   padding: 0;
1.819     tempelho 5040:   margin: 0;
1.359     albertel 5041: }
1.795     www      5042: 
1.933     droeschl 5043: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5044:     margin: 0;
                   5045:     padding: 0;
1.933     droeschl 5046:     position: relative;
                   5047:     list-style: none;
1.913     droeschl 5048: }
1.933     droeschl 5049: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5050:     display: inline;
                   5051: }
1.933     droeschl 5052: 
                   5053: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5054:     padding: 0;
1.933     droeschl 5055:     margin: 0;
                   5056:     float: left;
1.913     droeschl 5057: }
1.933     droeschl 5058: .LC_breadcrumb_tools_tools {
                   5059:     padding: 0;
                   5060:     margin: 0;
1.913     droeschl 5061:     float: right;
                   5062: }
                   5063: 
1.359     albertel 5064: table#LC_title_bar td {
                   5065:   background: $tabbg;
                   5066: }
1.795     www      5067: 
1.911     bisitz   5068: table#LC_menubuttons img {
1.803     bisitz   5069:   border: none;
1.346     albertel 5070: }
1.795     www      5071: 
1.842     droeschl 5072: .LC_breadcrumbs_component {
1.911     bisitz   5073:   float: right;
                   5074:   margin: 0 1em;
1.357     albertel 5075: }
1.842     droeschl 5076: .LC_breadcrumbs_component img {
1.911     bisitz   5077:   vertical-align: middle;
1.777     tempelho 5078: }
1.795     www      5079: 
1.383     albertel 5080: td.LC_table_cell_checkbox {
                   5081:   text-align: center;
                   5082: }
1.795     www      5083: 
                   5084: .LC_fontsize_small {
1.911     bisitz   5085:   font-size: 70%;
1.705     tempelho 5086: }
                   5087: 
1.844     bisitz   5088: #LC_breadcrumbs {
1.911     bisitz   5089:   clear:both;
                   5090:   background: $sidebg;
                   5091:   border-bottom: 1px solid $lg_border_color;
                   5092:   line-height: 2.5em;
1.933     droeschl 5093:   overflow: hidden;
1.911     bisitz   5094:   margin: 0;
                   5095:   padding: 0;
1.995     raeburn  5096:   text-align: left;
1.819     tempelho 5097: }
1.862     bisitz   5098: 
1.993     raeburn  5099: .LC_head_subbox {
1.911     bisitz   5100:   clear:both;
                   5101:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5102:   border: 1px solid $sidebg;
                   5103:   margin: 0 0 10px 0;      
1.966     bisitz   5104:   padding: 3px;
1.995     raeburn  5105:   text-align: left;
1.822     bisitz   5106: }
                   5107: 
1.795     www      5108: .LC_fontsize_medium {
1.911     bisitz   5109:   font-size: 85%;
1.705     tempelho 5110: }
                   5111: 
1.795     www      5112: .LC_fontsize_large {
1.911     bisitz   5113:   font-size: 120%;
1.705     tempelho 5114: }
                   5115: 
1.346     albertel 5116: .LC_menubuttons_inline_text {
                   5117:   color: $font;
1.698     harmsja  5118:   font-size: 90%;
1.701     harmsja  5119:   padding-left:3px;
1.346     albertel 5120: }
                   5121: 
1.934     droeschl 5122: .LC_menubuttons_inline_text img{
                   5123:   vertical-align: middle;
                   5124: }
                   5125: 
1.951     onken    5126: li.LC_menubuttons_inline_text img,a {
                   5127:   cursor:pointer;
                   5128: }
                   5129: 
1.526     www      5130: .LC_menubuttons_link {
                   5131:   text-decoration: none;
                   5132: }
1.795     www      5133: 
1.522     albertel 5134: .LC_menubuttons_category {
1.521     www      5135:   color: $font;
1.526     www      5136:   background: $pgbg;
1.521     www      5137:   font-size: larger;
                   5138:   font-weight: bold;
                   5139: }
                   5140: 
1.346     albertel 5141: td.LC_menubuttons_text {
1.911     bisitz   5142:   color: $font;
1.346     albertel 5143: }
1.706     harmsja  5144: 
1.346     albertel 5145: .LC_current_location {
                   5146:   background: $tabbg;
                   5147: }
1.795     www      5148: 
1.938     bisitz   5149: table.LC_data_table {
1.347     albertel 5150:   border: 1px solid #000000;
1.402     albertel 5151:   border-collapse: separate;
1.426     albertel 5152:   border-spacing: 1px;
1.610     albertel 5153:   background: $pgbg;
1.347     albertel 5154: }
1.795     www      5155: 
1.422     albertel 5156: .LC_data_table_dense {
                   5157:   font-size: small;
                   5158: }
1.795     www      5159: 
1.507     raeburn  5160: table.LC_nested_outer {
                   5161:   border: 1px solid #000000;
1.589     raeburn  5162:   border-collapse: collapse;
1.803     bisitz   5163:   border-spacing: 0;
1.507     raeburn  5164:   width: 100%;
                   5165: }
1.795     www      5166: 
1.879     raeburn  5167: table.LC_innerpickbox,
1.507     raeburn  5168: table.LC_nested {
1.803     bisitz   5169:   border: none;
1.589     raeburn  5170:   border-collapse: collapse;
1.803     bisitz   5171:   border-spacing: 0;
1.507     raeburn  5172:   width: 100%;
                   5173: }
1.795     www      5174: 
1.930     faziophi 5175: .ui-accordion,
                   5176: .ui-accordion table.LC_data_table,
                   5177: .ui-accordion table.LC_nested_outer{
                   5178:   border: 0px;
                   5179:   border-spacing: 0px;
                   5180:   margin: 3px;
                   5181: }
                   5182: 
1.911     bisitz   5183: table.LC_data_table tr th,
                   5184: table.LC_calendar tr th,
1.879     raeburn  5185: table.LC_prior_tries tr th,
                   5186: table.LC_innerpickbox tr th {
1.349     albertel 5187:   font-weight: bold;
                   5188:   background-color: $data_table_head;
1.801     tempelho 5189:   color:$fontmenu;
1.701     harmsja  5190:   font-size:90%;
1.347     albertel 5191: }
1.795     www      5192: 
1.879     raeburn  5193: table.LC_innerpickbox tr th,
                   5194: table.LC_innerpickbox tr td {
                   5195:   vertical-align: top;
                   5196: }
                   5197: 
1.711     raeburn  5198: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5199:   background-color: #CCCCCC;
1.711     raeburn  5200:   font-weight: bold;
                   5201:   text-align: left;
                   5202: }
1.795     www      5203: 
1.912     bisitz   5204: table.LC_data_table tr.LC_odd_row > td {
                   5205:   background-color: $data_table_light;
                   5206:   padding: 2px;
                   5207:   vertical-align: top;
                   5208: }
                   5209: 
1.809     bisitz   5210: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5211:   background-color: $data_table_light;
1.912     bisitz   5212:   vertical-align: top;
                   5213: }
                   5214: 
                   5215: table.LC_data_table tr.LC_even_row > td {
                   5216:   background-color: $data_table_dark;
1.425     albertel 5217:   padding: 2px;
1.900     bisitz   5218:   vertical-align: top;
1.347     albertel 5219: }
1.795     www      5220: 
1.809     bisitz   5221: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5222:   background-color: $data_table_dark;
1.900     bisitz   5223:   vertical-align: top;
1.347     albertel 5224: }
1.795     www      5225: 
1.425     albertel 5226: table.LC_data_table tr.LC_data_table_highlight td {
                   5227:   background-color: $data_table_darker;
                   5228: }
1.795     www      5229: 
1.639     raeburn  5230: table.LC_data_table tr td.LC_leftcol_header {
                   5231:   background-color: $data_table_head;
                   5232:   font-weight: bold;
                   5233: }
1.795     www      5234: 
1.451     albertel 5235: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5236: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5237:   font-weight: bold;
                   5238:   font-style: italic;
                   5239:   text-align: center;
                   5240:   padding: 8px;
1.347     albertel 5241: }
1.795     www      5242: 
1.940     bisitz   5243: table.LC_data_table tr.LC_empty_row td {
                   5244:   background-color: $sidebg;
                   5245: }
                   5246: 
                   5247: table.LC_nested tr.LC_empty_row td {
                   5248:   background-color: #FFFFFF;
                   5249: }
                   5250: 
1.890     droeschl 5251: table.LC_caption {
                   5252: }
                   5253: 
1.507     raeburn  5254: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5255:   padding: 4ex
                   5256: }
1.795     www      5257: 
1.507     raeburn  5258: table.LC_nested_outer tr th {
                   5259:   font-weight: bold;
1.801     tempelho 5260:   color:$fontmenu;
1.507     raeburn  5261:   background-color: $data_table_head;
1.701     harmsja  5262:   font-size: small;
1.507     raeburn  5263:   border-bottom: 1px solid #000000;
                   5264: }
1.795     www      5265: 
1.507     raeburn  5266: table.LC_nested_outer tr td.LC_subheader {
                   5267:   background-color: $data_table_head;
                   5268:   font-weight: bold;
                   5269:   font-size: small;
                   5270:   border-bottom: 1px solid #000000;
                   5271:   text-align: right;
1.451     albertel 5272: }
1.795     www      5273: 
1.507     raeburn  5274: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5275:   background-color: #CCCCCC;
1.451     albertel 5276:   font-weight: bold;
                   5277:   font-size: small;
1.507     raeburn  5278:   text-align: center;
                   5279: }
1.795     www      5280: 
1.589     raeburn  5281: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5282: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5283:   text-align: left;
1.451     albertel 5284: }
1.795     www      5285: 
1.507     raeburn  5286: table.LC_nested td {
1.735     bisitz   5287:   background-color: #FFFFFF;
1.451     albertel 5288:   font-size: small;
1.507     raeburn  5289: }
1.795     www      5290: 
1.507     raeburn  5291: table.LC_nested_outer tr th.LC_right_item,
                   5292: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5293: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5294: table.LC_nested tr td.LC_right_item {
1.451     albertel 5295:   text-align: right;
                   5296: }
                   5297: 
1.930     faziophi 5298: .ui-accordion table.LC_nested tr.LC_odd_row td.LC_left_item,
                   5299: .ui-accordion table.LC_nested tr.LC_even_row td.LC_left_item {
                   5300:   text-align: right;
                   5301:   width: 40%;
                   5302:   padding-right:10px;
                   5303:   vertical-align: top;
                   5304:   padding: 5px;
                   5305: }
                   5306: 
                   5307: .ui-accordion table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5308: .ui-accordion table.LC_nested tr.LC_even_row td.LC_right_item {
                   5309:   text-align: left;
                   5310:   width: 60%;
                   5311:   padding: 2px 4px;
                   5312: }
                   5313: 
1.507     raeburn  5314: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5315:   background-color: #EEEEEE;
1.451     albertel 5316: }
                   5317: 
1.473     raeburn  5318: table.LC_createuser {
                   5319: }
                   5320: 
                   5321: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5322:   font-size: small;
1.473     raeburn  5323: }
                   5324: 
                   5325: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5326:   background-color: #CCCCCC;
1.473     raeburn  5327:   font-weight: bold;
                   5328:   text-align: center;
                   5329: }
                   5330: 
1.349     albertel 5331: table.LC_calendar {
                   5332:   border: 1px solid #000000;
                   5333:   border-collapse: collapse;
1.917     raeburn  5334:   width: 98%;
1.349     albertel 5335: }
1.795     www      5336: 
1.349     albertel 5337: table.LC_calendar_pickdate {
                   5338:   font-size: xx-small;
                   5339: }
1.795     www      5340: 
1.349     albertel 5341: table.LC_calendar tr td {
                   5342:   border: 1px solid #000000;
                   5343:   vertical-align: top;
1.917     raeburn  5344:   width: 14%;
1.349     albertel 5345: }
1.795     www      5346: 
1.349     albertel 5347: table.LC_calendar tr td.LC_calendar_day_empty {
                   5348:   background-color: $data_table_dark;
                   5349: }
1.795     www      5350: 
1.779     bisitz   5351: table.LC_calendar tr td.LC_calendar_day_current {
                   5352:   background-color: $data_table_highlight;
1.777     tempelho 5353: }
1.795     www      5354: 
1.938     bisitz   5355: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5356:   background-color: $mail_new;
                   5357: }
1.795     www      5358: 
1.938     bisitz   5359: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5360:   background-color: $mail_new_hover;
                   5361: }
1.795     www      5362: 
1.938     bisitz   5363: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5364:   background-color: $mail_read;
                   5365: }
1.795     www      5366: 
1.938     bisitz   5367: /*
                   5368: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5369:   background-color: $mail_read_hover;
                   5370: }
1.938     bisitz   5371: */
1.795     www      5372: 
1.938     bisitz   5373: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5374:   background-color: $mail_replied;
                   5375: }
1.795     www      5376: 
1.938     bisitz   5377: /*
                   5378: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5379:   background-color: $mail_replied_hover;
                   5380: }
1.938     bisitz   5381: */
1.795     www      5382: 
1.938     bisitz   5383: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5384:   background-color: $mail_other;
                   5385: }
1.795     www      5386: 
1.938     bisitz   5387: /*
                   5388: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5389:   background-color: $mail_other_hover;
                   5390: }
1.938     bisitz   5391: */
1.494     raeburn  5392: 
1.777     tempelho 5393: table.LC_data_table tr > td.LC_browser_file,
                   5394: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5395:   background: #AAEE77;
1.389     albertel 5396: }
1.795     www      5397: 
1.777     tempelho 5398: table.LC_data_table tr > td.LC_browser_file_locked,
                   5399: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5400:   background: #FFAA99;
1.387     albertel 5401: }
1.795     www      5402: 
1.777     tempelho 5403: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5404:   background: #888888;
1.779     bisitz   5405: }
1.795     www      5406: 
1.777     tempelho 5407: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5408: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5409:   background: #F8F866;
1.777     tempelho 5410: }
1.795     www      5411: 
1.696     bisitz   5412: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5413:   background: #E0E8FF;
1.387     albertel 5414: }
1.696     bisitz   5415: 
1.707     bisitz   5416: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5417:   /* background: #77FF77; */
1.707     bisitz   5418: }
1.795     www      5419: 
1.707     bisitz   5420: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5421:   border-right: 8px solid #FFFF77;
1.707     bisitz   5422: }
1.795     www      5423: 
1.707     bisitz   5424: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5425:   border-right: 8px solid #FFAA77;
1.707     bisitz   5426: }
1.795     www      5427: 
1.707     bisitz   5428: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5429:   border-right: 8px solid #FF7777;
1.707     bisitz   5430: }
1.795     www      5431: 
1.707     bisitz   5432: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5433:   border-right: 8px solid #AAFF77;
1.707     bisitz   5434: }
1.795     www      5435: 
1.707     bisitz   5436: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5437:   border-right: 8px solid #11CC55;
1.707     bisitz   5438: }
                   5439: 
1.388     albertel 5440: span.LC_current_location {
1.701     harmsja  5441:   font-size:larger;
1.388     albertel 5442:   background: $pgbg;
                   5443: }
1.387     albertel 5444: 
1.395     albertel 5445: span.LC_parm_menu_item {
                   5446:   font-size: larger;
                   5447: }
1.795     www      5448: 
1.395     albertel 5449: span.LC_parm_scope_all {
                   5450:   color: red;
                   5451: }
1.795     www      5452: 
1.395     albertel 5453: span.LC_parm_scope_folder {
                   5454:   color: green;
                   5455: }
1.795     www      5456: 
1.395     albertel 5457: span.LC_parm_scope_resource {
                   5458:   color: orange;
                   5459: }
1.795     www      5460: 
1.395     albertel 5461: span.LC_parm_part {
                   5462:   color: blue;
                   5463: }
1.795     www      5464: 
1.911     bisitz   5465: span.LC_parm_folder,
                   5466: span.LC_parm_symb {
1.395     albertel 5467:   font-size: x-small;
                   5468:   font-family: $mono;
                   5469:   color: #AAAAAA;
                   5470: }
                   5471: 
1.977     bisitz   5472: ul.LC_parm_parmlist li {
                   5473:   display: inline-block;
                   5474:   padding: 0.3em 0.8em;
                   5475:   vertical-align: top;
                   5476:   width: 150px;
                   5477:   border-top:1px solid $lg_border_color;
                   5478: }
                   5479: 
1.795     www      5480: td.LC_parm_overview_level_menu,
                   5481: td.LC_parm_overview_map_menu,
                   5482: td.LC_parm_overview_parm_selectors,
                   5483: td.LC_parm_overview_restrictions  {
1.396     albertel 5484:   border: 1px solid black;
                   5485:   border-collapse: collapse;
                   5486: }
1.795     www      5487: 
1.396     albertel 5488: table.LC_parm_overview_restrictions td {
                   5489:   border-width: 1px 4px 1px 4px;
                   5490:   border-style: solid;
                   5491:   border-color: $pgbg;
                   5492:   text-align: center;
                   5493: }
1.795     www      5494: 
1.396     albertel 5495: table.LC_parm_overview_restrictions th {
                   5496:   background: $tabbg;
                   5497:   border-width: 1px 4px 1px 4px;
                   5498:   border-style: solid;
                   5499:   border-color: $pgbg;
                   5500: }
1.795     www      5501: 
1.398     albertel 5502: table#LC_helpmenu {
1.803     bisitz   5503:   border: none;
1.398     albertel 5504:   height: 55px;
1.803     bisitz   5505:   border-spacing: 0;
1.398     albertel 5506: }
                   5507: 
                   5508: table#LC_helpmenu fieldset legend {
                   5509:   font-size: larger;
                   5510: }
1.795     www      5511: 
1.397     albertel 5512: table#LC_helpmenu_links {
                   5513:   width: 100%;
                   5514:   border: 1px solid black;
                   5515:   background: $pgbg;
1.803     bisitz   5516:   padding: 0;
1.397     albertel 5517:   border-spacing: 1px;
                   5518: }
1.795     www      5519: 
1.397     albertel 5520: table#LC_helpmenu_links tr td {
                   5521:   padding: 1px;
                   5522:   background: $tabbg;
1.399     albertel 5523:   text-align: center;
                   5524:   font-weight: bold;
1.397     albertel 5525: }
1.396     albertel 5526: 
1.795     www      5527: table#LC_helpmenu_links a:link,
                   5528: table#LC_helpmenu_links a:visited,
1.397     albertel 5529: table#LC_helpmenu_links a:active {
                   5530:   text-decoration: none;
                   5531:   color: $font;
                   5532: }
1.795     www      5533: 
1.397     albertel 5534: table#LC_helpmenu_links a:hover {
                   5535:   text-decoration: underline;
                   5536:   color: $vlink;
                   5537: }
1.396     albertel 5538: 
1.417     albertel 5539: .LC_chrt_popup_exists {
                   5540:   border: 1px solid #339933;
                   5541:   margin: -1px;
                   5542: }
1.795     www      5543: 
1.417     albertel 5544: .LC_chrt_popup_up {
                   5545:   border: 1px solid yellow;
                   5546:   margin: -1px;
                   5547: }
1.795     www      5548: 
1.417     albertel 5549: .LC_chrt_popup {
                   5550:   border: 1px solid #8888FF;
                   5551:   background: #CCCCFF;
                   5552: }
1.795     www      5553: 
1.421     albertel 5554: table.LC_pick_box {
                   5555:   border-collapse: separate;
                   5556:   background: white;
                   5557:   border: 1px solid black;
                   5558:   border-spacing: 1px;
                   5559: }
1.795     www      5560: 
1.421     albertel 5561: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   5562:   background: $sidebg;
1.421     albertel 5563:   font-weight: bold;
1.900     bisitz   5564:   text-align: left;
1.740     bisitz   5565:   vertical-align: top;
1.421     albertel 5566:   width: 184px;
                   5567:   padding: 8px;
                   5568: }
1.795     www      5569: 
1.579     raeburn  5570: table.LC_pick_box td.LC_pick_box_value {
                   5571:   text-align: left;
                   5572:   padding: 8px;
                   5573: }
1.795     www      5574: 
1.579     raeburn  5575: table.LC_pick_box td.LC_pick_box_select {
                   5576:   text-align: left;
                   5577:   padding: 8px;
                   5578: }
1.795     www      5579: 
1.424     albertel 5580: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   5581:   padding: 0;
1.421     albertel 5582:   height: 1px;
                   5583:   background: black;
                   5584: }
1.795     www      5585: 
1.421     albertel 5586: table.LC_pick_box td.LC_pick_box_submit {
                   5587:   text-align: right;
                   5588: }
1.795     www      5589: 
1.579     raeburn  5590: table.LC_pick_box td.LC_evenrow_value {
                   5591:   text-align: left;
                   5592:   padding: 8px;
                   5593:   background-color: $data_table_light;
                   5594: }
1.795     www      5595: 
1.579     raeburn  5596: table.LC_pick_box td.LC_oddrow_value {
                   5597:   text-align: left;
                   5598:   padding: 8px;
                   5599:   background-color: $data_table_light;
                   5600: }
1.795     www      5601: 
1.579     raeburn  5602: span.LC_helpform_receipt_cat {
                   5603:   font-weight: bold;
                   5604: }
1.795     www      5605: 
1.424     albertel 5606: table.LC_group_priv_box {
                   5607:   background: white;
                   5608:   border: 1px solid black;
                   5609:   border-spacing: 1px;
                   5610: }
1.795     www      5611: 
1.424     albertel 5612: table.LC_group_priv_box td.LC_pick_box_title {
                   5613:   background: $tabbg;
                   5614:   font-weight: bold;
                   5615:   text-align: right;
                   5616:   width: 184px;
                   5617: }
1.795     www      5618: 
1.424     albertel 5619: table.LC_group_priv_box td.LC_groups_fixed {
                   5620:   background: $data_table_light;
                   5621:   text-align: center;
                   5622: }
1.795     www      5623: 
1.424     albertel 5624: table.LC_group_priv_box td.LC_groups_optional {
                   5625:   background: $data_table_dark;
                   5626:   text-align: center;
                   5627: }
1.795     www      5628: 
1.424     albertel 5629: table.LC_group_priv_box td.LC_groups_functionality {
                   5630:   background: $data_table_darker;
                   5631:   text-align: center;
                   5632:   font-weight: bold;
                   5633: }
1.795     www      5634: 
1.424     albertel 5635: table.LC_group_priv td {
                   5636:   text-align: left;
1.803     bisitz   5637:   padding: 0;
1.424     albertel 5638: }
                   5639: 
                   5640: .LC_navbuttons {
                   5641:   margin: 2ex 0ex 2ex 0ex;
                   5642: }
1.795     www      5643: 
1.423     albertel 5644: .LC_topic_bar {
                   5645:   font-weight: bold;
                   5646:   background: $tabbg;
1.918     wenzelju 5647:   margin: 1em 0em 1em 2em;
1.805     bisitz   5648:   padding: 3px;
1.918     wenzelju 5649:   font-size: 1.2em;
1.423     albertel 5650: }
1.795     www      5651: 
1.423     albertel 5652: .LC_topic_bar span {
1.918     wenzelju 5653:   left: 0.5em;
                   5654:   position: absolute;
1.423     albertel 5655:   vertical-align: middle;
1.918     wenzelju 5656:   font-size: 1.2em;
1.423     albertel 5657: }
1.795     www      5658: 
1.423     albertel 5659: table.LC_course_group_status {
                   5660:   margin: 20px;
                   5661: }
1.795     www      5662: 
1.423     albertel 5663: table.LC_status_selector td {
                   5664:   vertical-align: top;
                   5665:   text-align: center;
1.424     albertel 5666:   padding: 4px;
                   5667: }
1.795     www      5668: 
1.599     albertel 5669: div.LC_feedback_link {
1.616     albertel 5670:   clear: both;
1.829     kalberla 5671:   background: $sidebg;
1.779     bisitz   5672:   width: 100%;
1.829     kalberla 5673:   padding-bottom: 10px;
                   5674:   border: 1px $tabbg solid;
1.833     kalberla 5675:   height: 22px;
                   5676:   line-height: 22px;
                   5677:   padding-top: 5px;
                   5678: }
                   5679: 
                   5680: div.LC_feedback_link img {
                   5681:   height: 22px;
1.867     kalberla 5682:   vertical-align:middle;
1.829     kalberla 5683: }
                   5684: 
1.911     bisitz   5685: div.LC_feedback_link a {
1.829     kalberla 5686:   text-decoration: none;
1.489     raeburn  5687: }
1.795     www      5688: 
1.867     kalberla 5689: div.LC_comblock {
1.911     bisitz   5690:   display:inline;
1.867     kalberla 5691:   color:$font;
                   5692:   font-size:90%;
                   5693: }
                   5694: 
                   5695: div.LC_feedback_link div.LC_comblock {
                   5696:   padding-left:5px;
                   5697: }
                   5698: 
                   5699: div.LC_feedback_link div.LC_comblock a {
                   5700:   color:$font;
                   5701: }
                   5702: 
1.489     raeburn  5703: span.LC_feedback_link {
1.858     bisitz   5704:   /* background: $feedback_link_bg; */
1.599     albertel 5705:   font-size: larger;
                   5706: }
1.795     www      5707: 
1.599     albertel 5708: span.LC_message_link {
1.858     bisitz   5709:   /* background: $feedback_link_bg; */
1.599     albertel 5710:   font-size: larger;
                   5711:   position: absolute;
                   5712:   right: 1em;
1.489     raeburn  5713: }
1.421     albertel 5714: 
1.515     albertel 5715: table.LC_prior_tries {
1.524     albertel 5716:   border: 1px solid #000000;
                   5717:   border-collapse: separate;
                   5718:   border-spacing: 1px;
1.515     albertel 5719: }
1.523     albertel 5720: 
1.515     albertel 5721: table.LC_prior_tries td {
1.524     albertel 5722:   padding: 2px;
1.515     albertel 5723: }
1.523     albertel 5724: 
                   5725: .LC_answer_correct {
1.795     www      5726:   background: lightgreen;
                   5727:   color: darkgreen;
                   5728:   padding: 6px;
1.523     albertel 5729: }
1.795     www      5730: 
1.523     albertel 5731: .LC_answer_charged_try {
1.797     www      5732:   background: #FFAAAA;
1.795     www      5733:   color: darkred;
                   5734:   padding: 6px;
1.523     albertel 5735: }
1.795     www      5736: 
1.779     bisitz   5737: .LC_answer_not_charged_try,
1.523     albertel 5738: .LC_answer_no_grade,
                   5739: .LC_answer_late {
1.795     www      5740:   background: lightyellow;
1.523     albertel 5741:   color: black;
1.795     www      5742:   padding: 6px;
1.523     albertel 5743: }
1.795     www      5744: 
1.523     albertel 5745: .LC_answer_previous {
1.795     www      5746:   background: lightblue;
                   5747:   color: darkblue;
                   5748:   padding: 6px;
1.523     albertel 5749: }
1.795     www      5750: 
1.779     bisitz   5751: .LC_answer_no_message {
1.777     tempelho 5752:   background: #FFFFFF;
                   5753:   color: black;
1.795     www      5754:   padding: 6px;
1.779     bisitz   5755: }
1.795     www      5756: 
1.779     bisitz   5757: .LC_answer_unknown {
                   5758:   background: orange;
                   5759:   color: black;
1.795     www      5760:   padding: 6px;
1.777     tempelho 5761: }
1.795     www      5762: 
1.529     albertel 5763: span.LC_prior_numerical,
                   5764: span.LC_prior_string,
                   5765: span.LC_prior_custom,
                   5766: span.LC_prior_reaction,
                   5767: span.LC_prior_math {
1.925     bisitz   5768:   font-family: $mono;
1.523     albertel 5769:   white-space: pre;
                   5770: }
                   5771: 
1.525     albertel 5772: span.LC_prior_string {
1.925     bisitz   5773:   font-family: $mono;
1.525     albertel 5774:   white-space: pre;
                   5775: }
                   5776: 
1.523     albertel 5777: table.LC_prior_option {
                   5778:   width: 100%;
                   5779:   border-collapse: collapse;
                   5780: }
1.795     www      5781: 
1.911     bisitz   5782: table.LC_prior_rank,
1.795     www      5783: table.LC_prior_match {
1.528     albertel 5784:   border-collapse: collapse;
                   5785: }
1.795     www      5786: 
1.528     albertel 5787: table.LC_prior_option tr td,
                   5788: table.LC_prior_rank tr td,
                   5789: table.LC_prior_match tr td {
1.524     albertel 5790:   border: 1px solid #000000;
1.515     albertel 5791: }
                   5792: 
1.855     bisitz   5793: .LC_nobreak {
1.544     albertel 5794:   white-space: nowrap;
1.519     raeburn  5795: }
                   5796: 
1.576     raeburn  5797: span.LC_cusr_emph {
                   5798:   font-style: italic;
                   5799: }
                   5800: 
1.633     raeburn  5801: span.LC_cusr_subheading {
                   5802:   font-weight: normal;
                   5803:   font-size: 85%;
                   5804: }
                   5805: 
1.861     bisitz   5806: div.LC_docs_entry_move {
1.859     bisitz   5807:   border: 1px solid #BBBBBB;
1.545     albertel 5808:   background: #DDDDDD;
1.861     bisitz   5809:   width: 22px;
1.859     bisitz   5810:   padding: 1px;
                   5811:   margin: 0;
1.545     albertel 5812: }
                   5813: 
1.861     bisitz   5814: table.LC_data_table tr > td.LC_docs_entry_commands,
                   5815: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 5816:   background: #DDDDDD;
                   5817:   font-size: x-small;
                   5818: }
1.795     www      5819: 
1.861     bisitz   5820: .LC_docs_entry_parameter {
                   5821:   white-space: nowrap;
                   5822: }
                   5823: 
1.544     albertel 5824: .LC_docs_copy {
1.545     albertel 5825:   color: #000099;
1.544     albertel 5826: }
1.795     www      5827: 
1.544     albertel 5828: .LC_docs_cut {
1.545     albertel 5829:   color: #550044;
1.544     albertel 5830: }
1.795     www      5831: 
1.544     albertel 5832: .LC_docs_rename {
1.545     albertel 5833:   color: #009900;
1.544     albertel 5834: }
1.795     www      5835: 
1.544     albertel 5836: .LC_docs_remove {
1.545     albertel 5837:   color: #990000;
                   5838: }
                   5839: 
1.547     albertel 5840: .LC_docs_reinit_warn,
                   5841: .LC_docs_ext_edit {
                   5842:   font-size: x-small;
                   5843: }
                   5844: 
1.545     albertel 5845: table.LC_docs_adddocs td,
                   5846: table.LC_docs_adddocs th {
                   5847:   border: 1px solid #BBBBBB;
                   5848:   padding: 4px;
                   5849:   background: #DDDDDD;
1.543     albertel 5850: }
                   5851: 
1.584     albertel 5852: table.LC_sty_begin {
                   5853:   background: #BBFFBB;
                   5854: }
1.795     www      5855: 
1.584     albertel 5856: table.LC_sty_end {
                   5857:   background: #FFBBBB;
                   5858: }
                   5859: 
1.589     raeburn  5860: table.LC_double_column {
1.803     bisitz   5861:   border-width: 0;
1.589     raeburn  5862:   border-collapse: collapse;
                   5863:   width: 100%;
                   5864:   padding: 2px;
                   5865: }
                   5866: 
                   5867: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  5868:   top: 2px;
1.589     raeburn  5869:   left: 2px;
                   5870:   width: 47%;
                   5871:   vertical-align: top;
                   5872: }
                   5873: 
                   5874: table.LC_double_column tr td.LC_right_col {
                   5875:   top: 2px;
1.779     bisitz   5876:   right: 2px;
1.589     raeburn  5877:   width: 47%;
                   5878:   vertical-align: top;
                   5879: }
                   5880: 
1.591     raeburn  5881: div.LC_left_float {
                   5882:   float: left;
                   5883:   padding-right: 5%;
1.597     albertel 5884:   padding-bottom: 4px;
1.591     raeburn  5885: }
                   5886: 
                   5887: div.LC_clear_float_header {
1.597     albertel 5888:   padding-bottom: 2px;
1.591     raeburn  5889: }
                   5890: 
                   5891: div.LC_clear_float_footer {
1.597     albertel 5892:   padding-top: 10px;
1.591     raeburn  5893:   clear: both;
                   5894: }
                   5895: 
1.597     albertel 5896: div.LC_grade_show_user {
1.941     bisitz   5897: /*  border-left: 5px solid $sidebg; */
                   5898:   border-top: 5px solid #000000;
                   5899:   margin: 50px 0 0 0;
1.936     bisitz   5900:   padding: 15px 0 5px 10px;
1.597     albertel 5901: }
1.795     www      5902: 
1.936     bisitz   5903: div.LC_grade_show_user_odd_row {
1.941     bisitz   5904: /*  border-left: 5px solid #000000; */
                   5905: }
                   5906: 
                   5907: div.LC_grade_show_user div.LC_Box {
                   5908:   margin-right: 50px;
1.597     albertel 5909: }
                   5910: 
                   5911: div.LC_grade_submissions,
                   5912: div.LC_grade_message_center,
1.936     bisitz   5913: div.LC_grade_info_links {
1.597     albertel 5914:   margin: 5px;
                   5915:   width: 99%;
                   5916:   background: #FFFFFF;
                   5917: }
1.795     www      5918: 
1.597     albertel 5919: div.LC_grade_submissions_header,
1.936     bisitz   5920: div.LC_grade_message_center_header {
1.705     tempelho 5921:   font-weight: bold;
                   5922:   font-size: large;
1.597     albertel 5923: }
1.795     www      5924: 
1.597     albertel 5925: div.LC_grade_submissions_body,
1.936     bisitz   5926: div.LC_grade_message_center_body {
1.597     albertel 5927:   border: 1px solid black;
                   5928:   width: 99%;
                   5929:   background: #FFFFFF;
                   5930: }
1.795     www      5931: 
1.613     albertel 5932: table.LC_scantron_action {
                   5933:   width: 100%;
                   5934: }
1.795     www      5935: 
1.613     albertel 5936: table.LC_scantron_action tr th {
1.698     harmsja  5937:   font-weight:bold;
                   5938:   font-style:normal;
1.613     albertel 5939: }
1.795     www      5940: 
1.779     bisitz   5941: .LC_edit_problem_header,
1.614     albertel 5942: div.LC_edit_problem_footer {
1.705     tempelho 5943:   font-weight: normal;
                   5944:   font-size:  medium;
1.602     albertel 5945:   margin: 2px;
1.600     albertel 5946: }
1.795     www      5947: 
1.600     albertel 5948: div.LC_edit_problem_header,
1.602     albertel 5949: div.LC_edit_problem_header div,
1.614     albertel 5950: div.LC_edit_problem_footer,
                   5951: div.LC_edit_problem_footer div,
1.602     albertel 5952: div.LC_edit_problem_editxml_header,
                   5953: div.LC_edit_problem_editxml_header div {
1.600     albertel 5954:   margin-top: 5px;
                   5955: }
1.795     www      5956: 
1.600     albertel 5957: div.LC_edit_problem_header_title {
1.705     tempelho 5958:   font-weight: bold;
                   5959:   font-size: larger;
1.602     albertel 5960:   background: $tabbg;
                   5961:   padding: 3px;
                   5962: }
1.795     www      5963: 
1.602     albertel 5964: table.LC_edit_problem_header_title {
                   5965:   width: 100%;
1.600     albertel 5966:   background: $tabbg;
1.602     albertel 5967: }
                   5968: 
                   5969: div.LC_edit_problem_discards {
                   5970:   float: left;
                   5971:   padding-bottom: 5px;
                   5972: }
1.795     www      5973: 
1.602     albertel 5974: div.LC_edit_problem_saves {
                   5975:   float: right;
                   5976:   padding-bottom: 5px;
1.600     albertel 5977: }
1.795     www      5978: 
1.911     bisitz   5979: img.stift {
1.803     bisitz   5980:   border-width: 0;
                   5981:   vertical-align: middle;
1.677     riegler  5982: }
1.680     riegler  5983: 
1.923     bisitz   5984: table td.LC_mainmenu_col_fieldset {
1.680     riegler  5985:   vertical-align: top;
1.777     tempelho 5986: }
1.795     www      5987: 
1.716     raeburn  5988: div.LC_createcourse {
1.911     bisitz   5989:   margin: 10px 10px 10px 10px;
1.716     raeburn  5990: }
                   5991: 
1.917     raeburn  5992: .LC_dccid {
                   5993:   margin: 0.2em 0 0 0;
                   5994:   padding: 0;
                   5995:   font-size: 90%;
                   5996:   display:none;
                   5997: }
                   5998: 
1.698     harmsja  5999: a:hover,
1.897     wenzelju 6000: ol.LC_primary_menu a:hover,
1.721     harmsja  6001: ol#LC_MenuBreadcrumbs a:hover,
                   6002: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6003: ul#LC_secondary_menu a:hover,
1.721     harmsja  6004: .LC_FormSectionClearButton input:hover
1.795     www      6005: ul.LC_TabContent   li:hover a {
1.952     onken    6006:   color:$button_hover;
1.911     bisitz   6007:   text-decoration:none;
1.693     droeschl 6008: }
                   6009: 
1.779     bisitz   6010: h1 {
1.911     bisitz   6011:   padding: 0;
                   6012:   line-height:130%;
1.693     droeschl 6013: }
1.698     harmsja  6014: 
1.911     bisitz   6015: h2,
                   6016: h3,
                   6017: h4,
                   6018: h5,
                   6019: h6 {
                   6020:   margin: 5px 0 5px 0;
                   6021:   padding: 0;
                   6022:   line-height:130%;
1.693     droeschl 6023: }
1.795     www      6024: 
                   6025: .LC_hcell {
1.911     bisitz   6026:   padding:3px 15px 3px 15px;
                   6027:   margin: 0;
                   6028:   background-color:$tabbg;
                   6029:   color:$fontmenu;
                   6030:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6031: }
1.795     www      6032: 
1.840     bisitz   6033: .LC_Box > .LC_hcell {
1.911     bisitz   6034:   margin: 0 -10px 10px -10px;
1.835     bisitz   6035: }
                   6036: 
1.721     harmsja  6037: .LC_noBorder {
1.911     bisitz   6038:   border: 0;
1.698     harmsja  6039: }
1.693     droeschl 6040: 
1.721     harmsja  6041: .LC_FormSectionClearButton input {
1.911     bisitz   6042:   background-color:transparent;
                   6043:   border: none;
                   6044:   cursor:pointer;
                   6045:   text-decoration:underline;
1.693     droeschl 6046: }
1.763     bisitz   6047: 
                   6048: .LC_help_open_topic {
1.911     bisitz   6049:   color: #FFFFFF;
                   6050:   background-color: #EEEEFF;
                   6051:   margin: 1px;
                   6052:   padding: 4px;
                   6053:   border: 1px solid #000033;
                   6054:   white-space: nowrap;
                   6055:   /* vertical-align: middle; */
1.759     neumanie 6056: }
1.693     droeschl 6057: 
1.911     bisitz   6058: dl,
                   6059: ul,
                   6060: div,
                   6061: fieldset {
                   6062:   margin: 10px 10px 10px 0;
                   6063:   /* overflow: hidden; */
1.693     droeschl 6064: }
1.795     www      6065: 
1.838     bisitz   6066: fieldset > legend {
1.911     bisitz   6067:   font-weight: bold;
                   6068:   padding: 0 5px 0 5px;
1.838     bisitz   6069: }
                   6070: 
1.813     bisitz   6071: #LC_nav_bar {
1.911     bisitz   6072:   float: left;
1.995     raeburn  6073:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6074:   margin: 0 0 2px 0;
1.807     droeschl 6075: }
                   6076: 
1.916     droeschl 6077: #LC_realm {
                   6078:   margin: 0.2em 0 0 0;
                   6079:   padding: 0;
                   6080:   font-weight: bold;
                   6081:   text-align: center;
1.995     raeburn  6082:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6083: }
                   6084: 
1.911     bisitz   6085: #LC_nav_bar em {
                   6086:   font-weight: bold;
                   6087:   font-style: normal;
1.807     droeschl 6088: }
                   6089: 
1.897     wenzelju 6090: ol.LC_primary_menu {
1.911     bisitz   6091:   float: right;
1.934     droeschl 6092:   margin: 0;
1.995     raeburn  6093:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6094: }
                   6095: 
1.852     droeschl 6096: ol#LC_PathBreadcrumbs {
1.911     bisitz   6097:   margin: 0;
1.693     droeschl 6098: }
                   6099: 
1.897     wenzelju 6100: ol.LC_primary_menu li {
1.911     bisitz   6101:   display: inline;
                   6102:   padding: 5px 5px 0 10px;
                   6103:   vertical-align: top;
1.693     droeschl 6104: }
                   6105: 
1.897     wenzelju 6106: ol.LC_primary_menu li img {
1.911     bisitz   6107:   vertical-align: bottom;
1.934     droeschl 6108:   height: 1.1em;
1.693     droeschl 6109: }
                   6110: 
1.897     wenzelju 6111: ol.LC_primary_menu a {
1.911     bisitz   6112:   color: RGB(80, 80, 80);
                   6113:   text-decoration: none;
1.693     droeschl 6114: }
1.795     www      6115: 
1.949     droeschl 6116: ol.LC_primary_menu a.LC_new_message {
                   6117:   font-weight:bold;
                   6118:   color: darkred;
                   6119: }
                   6120: 
1.975     raeburn  6121: ol.LC_docs_parameters {
                   6122:   margin-left: 0;
                   6123:   padding: 0;
                   6124:   list-style: none;
                   6125: }
                   6126: 
                   6127: ol.LC_docs_parameters li {
                   6128:   margin: 0;
                   6129:   padding-right: 20px;
                   6130:   display: inline;
                   6131: }
                   6132: 
1.976     raeburn  6133: ol.LC_docs_parameters li:before {
                   6134:   content: "\\002022 \\0020";
                   6135: }
                   6136: 
                   6137: li.LC_docs_parameters_title {
                   6138:   font-weight: bold;
                   6139: }
                   6140: 
                   6141: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6142:   content: "";
                   6143: }
                   6144: 
1.897     wenzelju 6145: ul#LC_secondary_menu {
1.911     bisitz   6146:   clear: both;
                   6147:   color: $fontmenu;
                   6148:   background: $tabbg;
                   6149:   list-style: none;
                   6150:   padding: 0;
                   6151:   margin: 0;
                   6152:   width: 100%;
1.995     raeburn  6153:   text-align: left;
1.808     droeschl 6154: }
                   6155: 
1.897     wenzelju 6156: ul#LC_secondary_menu li {
1.911     bisitz   6157:   font-weight: bold;
                   6158:   line-height: 1.8em;
                   6159:   padding: 0 0.8em;
                   6160:   border-right: 1px solid black;
                   6161:   display: inline;
                   6162:   vertical-align: middle;
1.807     droeschl 6163: }
                   6164: 
1.847     tempelho 6165: ul.LC_TabContent {
1.911     bisitz   6166:   display:block;
                   6167:   background: $sidebg;
                   6168:   border-bottom: solid 1px $lg_border_color;
                   6169:   list-style:none;
                   6170:   margin: 0 -10px;
                   6171:   padding: 0;
1.693     droeschl 6172: }
                   6173: 
1.795     www      6174: ul.LC_TabContent li,
                   6175: ul.LC_TabContentBigger li {
1.911     bisitz   6176:   float:left;
1.741     harmsja  6177: }
1.795     www      6178: 
1.897     wenzelju 6179: ul#LC_secondary_menu li a {
1.911     bisitz   6180:   color: $fontmenu;
                   6181:   text-decoration: none;
1.693     droeschl 6182: }
1.795     www      6183: 
1.721     harmsja  6184: ul.LC_TabContent {
1.952     onken    6185:   min-height:20px;
1.721     harmsja  6186: }
1.795     www      6187: 
                   6188: ul.LC_TabContent li {
1.911     bisitz   6189:   vertical-align:middle;
1.959     onken    6190:   padding: 0 16px 0 10px;
1.911     bisitz   6191:   background-color:$tabbg;
                   6192:   border-bottom:solid 1px $lg_border_color;
1.952     onken    6193:   border-right: solid 1px $font;
1.721     harmsja  6194: }
1.795     www      6195: 
1.847     tempelho 6196: ul.LC_TabContent .right {
1.911     bisitz   6197:   float:right;
1.847     tempelho 6198: }
                   6199: 
1.911     bisitz   6200: ul.LC_TabContent li a,
                   6201: ul.LC_TabContent li {
                   6202:   color:rgb(47,47,47);
                   6203:   text-decoration:none;
                   6204:   font-size:95%;
                   6205:   font-weight:bold;
1.952     onken    6206:   min-height:20px;
                   6207: }
                   6208: 
1.959     onken    6209: ul.LC_TabContent li a:hover,
                   6210: ul.LC_TabContent li a:focus {
1.952     onken    6211:   color: $button_hover;
1.959     onken    6212:   background:none;
                   6213:   outline:none;
1.952     onken    6214: }
                   6215: 
                   6216: ul.LC_TabContent li:hover {
                   6217:   color: $button_hover;
                   6218:   cursor:pointer;
1.721     harmsja  6219: }
1.795     www      6220: 
1.911     bisitz   6221: ul.LC_TabContent li.active {
1.952     onken    6222:   color: $font;
1.911     bisitz   6223:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6224:   border-bottom:solid 1px #FFFFFF;
                   6225:   cursor: default;
1.744     ehlerst  6226: }
1.795     www      6227: 
1.959     onken    6228: ul.LC_TabContent li.active a {
                   6229:   color:$font;
                   6230:   background:#FFFFFF;
                   6231:   outline: none;
                   6232: }
1.870     tempelho 6233: #maincoursedoc {
1.911     bisitz   6234:   clear:both;
1.870     tempelho 6235: }
                   6236: 
                   6237: ul.LC_TabContentBigger {
1.911     bisitz   6238:   display:block;
                   6239:   list-style:none;
                   6240:   padding: 0;
1.870     tempelho 6241: }
                   6242: 
1.795     www      6243: ul.LC_TabContentBigger li {
1.911     bisitz   6244:   vertical-align:bottom;
                   6245:   height: 30px;
                   6246:   font-size:110%;
                   6247:   font-weight:bold;
                   6248:   color: #737373;
1.841     tempelho 6249: }
                   6250: 
1.957     onken    6251: ul.LC_TabContentBigger li.active {
                   6252:   position: relative;
                   6253:   top: 1px;
                   6254: }
                   6255: 
1.870     tempelho 6256: ul.LC_TabContentBigger li a {
1.911     bisitz   6257:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6258:   height: 30px;
                   6259:   line-height: 30px;
                   6260:   text-align: center;
                   6261:   display: block;
                   6262:   text-decoration: none;
1.958     onken    6263:   outline: none;  
1.741     harmsja  6264: }
1.795     www      6265: 
1.870     tempelho 6266: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6267:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6268:   color:$font;
1.744     ehlerst  6269: }
1.795     www      6270: 
1.870     tempelho 6271: ul.LC_TabContentBigger li b {
1.911     bisitz   6272:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6273:   display: block;
                   6274:   float: left;
                   6275:   padding: 0 30px;
1.957     onken    6276:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6277: }
                   6278: 
1.956     onken    6279: ul.LC_TabContentBigger li:hover b {
                   6280:   color:$button_hover;
                   6281: }
                   6282: 
1.870     tempelho 6283: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6284:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6285:   color:$font;
1.957     onken    6286:   border: 0;
1.956     onken    6287:   cursor:default;
1.741     harmsja  6288: }
1.693     droeschl 6289: 
1.870     tempelho 6290: 
1.862     bisitz   6291: ul.LC_CourseBreadcrumbs {
                   6292:   background: $sidebg;
                   6293:   line-height: 32px;
                   6294:   padding-left: 10px;
                   6295:   margin: 0 0 10px 0;
                   6296:   list-style-position: inside;
                   6297: 
                   6298: }
                   6299: 
1.911     bisitz   6300: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6301: ol#LC_PathBreadcrumbs {
1.911     bisitz   6302:   padding-left: 10px;
                   6303:   margin: 0;
1.933     droeschl 6304:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6305: }
                   6306: 
1.911     bisitz   6307: ol#LC_MenuBreadcrumbs li,
                   6308: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6309: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6310:   display: inline;
1.933     droeschl 6311:   white-space: normal;  
1.693     droeschl 6312: }
                   6313: 
1.823     bisitz   6314: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6315: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6316:   text-decoration: none;
                   6317:   font-size:90%;
1.693     droeschl 6318: }
1.795     www      6319: 
1.969     droeschl 6320: ol#LC_MenuBreadcrumbs h1 {
                   6321:   display: inline;
                   6322:   font-size: 90%;
                   6323:   line-height: 2.5em;
                   6324:   margin: 0;
                   6325:   padding: 0;
                   6326: }
                   6327: 
1.795     www      6328: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6329:   text-decoration:none;
                   6330:   font-size:100%;
                   6331:   font-weight:bold;
1.693     droeschl 6332: }
1.795     www      6333: 
1.840     bisitz   6334: .LC_Box {
1.911     bisitz   6335:   border: solid 1px $lg_border_color;
                   6336:   padding: 0 10px 10px 10px;
1.746     neumanie 6337: }
1.795     www      6338: 
                   6339: .LC_AboutMe_Image {
1.911     bisitz   6340:   float:left;
                   6341:   margin-right:10px;
1.747     neumanie 6342: }
1.795     www      6343: 
                   6344: .LC_Clear_AboutMe_Image {
1.911     bisitz   6345:   clear:left;
1.747     neumanie 6346: }
1.795     www      6347: 
1.721     harmsja  6348: dl.LC_ListStyleClean dt {
1.911     bisitz   6349:   padding-right: 5px;
                   6350:   display: table-header-group;
1.693     droeschl 6351: }
                   6352: 
1.721     harmsja  6353: dl.LC_ListStyleClean dd {
1.911     bisitz   6354:   display: table-row;
1.693     droeschl 6355: }
                   6356: 
1.721     harmsja  6357: .LC_ListStyleClean,
                   6358: .LC_ListStyleSimple,
                   6359: .LC_ListStyleNormal,
1.795     www      6360: .LC_ListStyleSpecial {
1.911     bisitz   6361:   /* display:block; */
                   6362:   list-style-position: inside;
                   6363:   list-style-type: none;
                   6364:   overflow: hidden;
                   6365:   padding: 0;
1.693     droeschl 6366: }
                   6367: 
1.721     harmsja  6368: .LC_ListStyleSimple li,
                   6369: .LC_ListStyleSimple dd,
                   6370: .LC_ListStyleNormal li,
                   6371: .LC_ListStyleNormal dd,
                   6372: .LC_ListStyleSpecial li,
1.795     www      6373: .LC_ListStyleSpecial dd {
1.911     bisitz   6374:   margin: 0;
                   6375:   padding: 5px 5px 5px 10px;
                   6376:   clear: both;
1.693     droeschl 6377: }
                   6378: 
1.721     harmsja  6379: .LC_ListStyleClean li,
                   6380: .LC_ListStyleClean dd {
1.911     bisitz   6381:   padding-top: 0;
                   6382:   padding-bottom: 0;
1.693     droeschl 6383: }
                   6384: 
1.721     harmsja  6385: .LC_ListStyleSimple dd,
1.795     www      6386: .LC_ListStyleSimple li {
1.911     bisitz   6387:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6388: }
                   6389: 
1.721     harmsja  6390: .LC_ListStyleSpecial li,
                   6391: .LC_ListStyleSpecial dd {
1.911     bisitz   6392:   list-style-type: none;
                   6393:   background-color: RGB(220, 220, 220);
                   6394:   margin-bottom: 4px;
1.693     droeschl 6395: }
                   6396: 
1.721     harmsja  6397: table.LC_SimpleTable {
1.911     bisitz   6398:   margin:5px;
                   6399:   border:solid 1px $lg_border_color;
1.795     www      6400: }
1.693     droeschl 6401: 
1.721     harmsja  6402: table.LC_SimpleTable tr {
1.911     bisitz   6403:   padding: 0;
                   6404:   border:solid 1px $lg_border_color;
1.693     droeschl 6405: }
1.795     www      6406: 
                   6407: table.LC_SimpleTable thead {
1.911     bisitz   6408:   background:rgb(220,220,220);
1.693     droeschl 6409: }
                   6410: 
1.721     harmsja  6411: div.LC_columnSection {
1.911     bisitz   6412:   display: block;
                   6413:   clear: both;
                   6414:   overflow: hidden;
                   6415:   margin: 0;
1.693     droeschl 6416: }
                   6417: 
1.721     harmsja  6418: div.LC_columnSection>* {
1.911     bisitz   6419:   float: left;
                   6420:   margin: 10px 20px 10px 0;
                   6421:   overflow:hidden;
1.693     droeschl 6422: }
1.721     harmsja  6423: 
1.795     www      6424: table em {
1.911     bisitz   6425:   font-weight: bold;
                   6426:   font-style: normal;
1.748     schulted 6427: }
1.795     www      6428: 
1.779     bisitz   6429: table.LC_tableBrowseRes,
1.795     www      6430: table.LC_tableOfContent {
1.911     bisitz   6431:   border:none;
                   6432:   border-spacing: 1px;
                   6433:   padding: 3px;
                   6434:   background-color: #FFFFFF;
                   6435:   font-size: 90%;
1.753     droeschl 6436: }
1.789     droeschl 6437: 
1.911     bisitz   6438: table.LC_tableOfContent {
                   6439:   border-collapse: collapse;
1.789     droeschl 6440: }
                   6441: 
1.771     droeschl 6442: table.LC_tableBrowseRes a,
1.768     schulted 6443: table.LC_tableOfContent a {
1.911     bisitz   6444:   background-color: transparent;
                   6445:   text-decoration: none;
1.753     droeschl 6446: }
                   6447: 
1.795     www      6448: table.LC_tableOfContent img {
1.911     bisitz   6449:   border: none;
                   6450:   height: 1.3em;
                   6451:   vertical-align: text-bottom;
                   6452:   margin-right: 0.3em;
1.753     droeschl 6453: }
1.757     schulted 6454: 
1.795     www      6455: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6456:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6457: }
                   6458: 
1.795     www      6459: a#LC_content_toolbar_everything {
1.911     bisitz   6460:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6461: }
                   6462: 
1.795     www      6463: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6464:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6465: }
                   6466: 
1.795     www      6467: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6468:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6469: }
                   6470: 
1.795     www      6471: a#LC_content_toolbar_changefolder {
1.911     bisitz   6472:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6473: }
                   6474: 
1.795     www      6475: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6476:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6477: }
                   6478: 
1.795     www      6479: ul#LC_toolbar li a:hover {
1.911     bisitz   6480:   background-position: bottom center;
1.757     schulted 6481: }
                   6482: 
1.795     www      6483: ul#LC_toolbar {
1.911     bisitz   6484:   padding: 0;
                   6485:   margin: 2px;
                   6486:   list-style:none;
                   6487:   position:relative;
                   6488:   background-color:white;
1.757     schulted 6489: }
                   6490: 
1.795     www      6491: ul#LC_toolbar li {
1.911     bisitz   6492:   border:1px solid white;
                   6493:   padding: 0;
                   6494:   margin: 0;
                   6495:   float: left;
                   6496:   display:inline;
                   6497:   vertical-align:middle;
                   6498: }
1.757     schulted 6499: 
1.783     amueller 6500: 
1.795     www      6501: a.LC_toolbarItem {
1.911     bisitz   6502:   display:block;
                   6503:   padding: 0;
                   6504:   margin: 0;
                   6505:   height: 32px;
                   6506:   width: 32px;
                   6507:   color:white;
                   6508:   border: none;
                   6509:   background-repeat:no-repeat;
                   6510:   background-color:transparent;
1.757     schulted 6511: }
                   6512: 
1.915     droeschl 6513: ul.LC_funclist {
                   6514:     margin: 0;
                   6515:     padding: 0.5em 1em 0.5em 0;
                   6516: }
                   6517: 
1.933     droeschl 6518: ul.LC_funclist > li:first-child {
                   6519:     font-weight:bold; 
                   6520:     margin-left:0.8em;
                   6521: }
                   6522: 
1.915     droeschl 6523: ul.LC_funclist + ul.LC_funclist {
                   6524:     /* 
                   6525:        left border as a seperator if we have more than
                   6526:        one list 
                   6527:     */
                   6528:     border-left: 1px solid $sidebg;
                   6529:     /* 
                   6530:        this hides the left border behind the border of the 
                   6531:        outer box if element is wrapped to the next 'line' 
                   6532:     */
                   6533:     margin-left: -1px;
                   6534: }
                   6535: 
1.843     bisitz   6536: ul.LC_funclist li {
1.915     droeschl 6537:   display: inline;
1.782     bisitz   6538:   white-space: nowrap;
1.915     droeschl 6539:   margin: 0 0 0 25px;
                   6540:   line-height: 150%;
1.782     bisitz   6541: }
                   6542: 
1.930     faziophi 6543: .ui-accordion .LC_advanced_toggle {
                   6544:   float: right;
                   6545:   font-size: 90%;
                   6546:   padding: 0px 4px
                   6547: }
1.757     schulted 6548: 
1.974     wenzelju 6549: .LC_hidden {
                   6550:   display: none;
                   6551: }
                   6552: 
1.343     albertel 6553: END
                   6554: }
                   6555: 
1.306     albertel 6556: =pod
                   6557: 
                   6558: =item * &headtag()
                   6559: 
                   6560: Returns a uniform footer for LON-CAPA web pages.
                   6561: 
1.307     albertel 6562: Inputs: $title - optional title for the head
                   6563:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 6564:         $args - optional arguments
1.319     albertel 6565:             force_register - if is true call registerurl so the remote is 
                   6566:                              informed
1.415     albertel 6567:             redirect       -> array ref of
                   6568:                                    1- seconds before redirect occurs
                   6569:                                    2- url to redirect to
                   6570:                                    3- whether the side effect should occur
1.315     albertel 6571:                            (side effect of setting 
                   6572:                                $env{'internal.head.redirect'} to the url 
                   6573:                                redirected too)
1.352     albertel 6574:             domain         -> force to color decorate a page for a specific
                   6575:                                domain
                   6576:             function       -> force usage of a specific rolish color scheme
                   6577:             bgcolor        -> override the default page bgcolor
1.460     albertel 6578:             no_auto_mt_title
                   6579:                            -> prevent &mt()ing the title arg
1.464     albertel 6580: 
1.306     albertel 6581: =cut
                   6582: 
                   6583: sub headtag {
1.313     albertel 6584:     my ($title,$head_extra,$args) = @_;
1.306     albertel 6585:     
1.363     albertel 6586:     my $function = $args->{'function'} || &get_users_function();
                   6587:     my $domain   = $args->{'domain'}   || &determinedomain();
                   6588:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 6589:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 6590: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 6591: 		   #time(),
1.418     albertel 6592: 		   $env{'environment.color.timestamp'},
1.363     albertel 6593: 		   $function,$domain,$bgcolor);
                   6594: 
1.369     www      6595:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 6596: 
1.308     albertel 6597:     my $result =
                   6598: 	'<head>'.
1.461     albertel 6599: 	&font_settings();
1.319     albertel 6600: 
1.461     albertel 6601:     if (!$args->{'frameset'}) {
                   6602: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   6603:     }
1.962     droeschl 6604:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   6605:         $result .= Apache::lonxml::display_title();
1.319     albertel 6606:     }
1.436     albertel 6607:     if (!$args->{'no_nav_bar'} 
                   6608: 	&& !$args->{'only_body'}
                   6609: 	&& !$args->{'frameset'}) {
                   6610: 	$result .= &help_menu_js();
                   6611:     }
1.319     albertel 6612: 
1.314     albertel 6613:     if (ref($args->{'redirect'})) {
1.414     albertel 6614: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6615: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6616: 	if (!$inhibit_continue) {
                   6617: 	    $env{'internal.head.redirect'} = $url;
                   6618: 	}
1.313     albertel 6619: 	$result.=<<ADDMETA
                   6620: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6621: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6622: ADDMETA
                   6623:     }
1.306     albertel 6624:     if (!defined($title)) {
                   6625: 	$title = 'The LearningOnline Network with CAPA';
                   6626:     }
1.460     albertel 6627:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6628:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6629: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
                   6630: 	.$head_extra;
1.962     droeschl 6631:     return $result.'</head>';
1.306     albertel 6632: }
                   6633: 
                   6634: =pod
                   6635: 
1.340     albertel 6636: =item * &font_settings()
                   6637: 
                   6638: Returns neccessary <meta> to set the proper encoding
                   6639: 
                   6640: Inputs: none
                   6641: 
                   6642: =cut
                   6643: 
                   6644: sub font_settings {
                   6645:     my $headerstring='';
1.647     www      6646:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6647: 	$headerstring.=
                   6648: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6649:     }
                   6650:     return $headerstring;
                   6651: }
                   6652: 
1.341     albertel 6653: =pod
                   6654: 
                   6655: =item * &xml_begin()
                   6656: 
                   6657: Returns the needed doctype and <html>
                   6658: 
                   6659: Inputs: none
                   6660: 
                   6661: =cut
                   6662: 
                   6663: sub xml_begin {
                   6664:     my $output='';
                   6665: 
                   6666:     if ($env{'browser.mathml'}) {
                   6667: 	$output='<?xml version="1.0"?>'
                   6668:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   6669: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   6670:             
                   6671: #	    .'<!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">] >'
                   6672: 	    .'<!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">'
                   6673:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   6674: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   6675:     } else {
1.849     bisitz   6676: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   6677:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 6678:     }
                   6679:     return $output;
                   6680: }
1.340     albertel 6681: 
                   6682: =pod
                   6683: 
1.306     albertel 6684: =item * &start_page()
                   6685: 
                   6686: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   6687: 
1.648     raeburn  6688: Inputs:
                   6689: 
                   6690: =over 4
                   6691: 
                   6692: $title - optional title for the page
                   6693: 
                   6694: $head_extra - optional extra HTML to incude inside the <head>
                   6695: 
                   6696: $args - additional optional args supported are:
                   6697: 
                   6698: =over 8
                   6699: 
                   6700:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 6701:                                     arg on
1.814     bisitz   6702:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  6703:              add_entries    -> additional attributes to add to the  <body>
                   6704:              domain         -> force to color decorate a page for a 
1.317     albertel 6705:                                     specific domain
1.648     raeburn  6706:              function       -> force usage of a specific rolish color
1.317     albertel 6707:                                     scheme
1.648     raeburn  6708:              redirect       -> see &headtag()
                   6709:              bgcolor        -> override the default page bg color
                   6710:              js_ready       -> return a string ready for being used in 
1.317     albertel 6711:                                     a javascript writeln
1.648     raeburn  6712:              html_encode    -> return a string ready for being used in 
1.320     albertel 6713:                                     a html attribute
1.648     raeburn  6714:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 6715:                                     $forcereg arg
1.648     raeburn  6716:              frameset       -> if true will start with a <frameset>
1.330     albertel 6717:                                     rather than <body>
1.648     raeburn  6718:              skip_phases    -> hash ref of 
1.338     albertel 6719:                                     head -> skip the <html><head> generation
                   6720:                                     body -> skip all <body> generation
1.648     raeburn  6721:              no_auto_mt_title -> prevent &mt()ing the title arg
                   6722:              inherit_jsmath -> when creating popup window in a page,
                   6723:                                     should it have jsmath forced on by the
                   6724:                                     current page
1.867     kalberla 6725:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  6726:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 6727: 
1.648     raeburn  6728: =back
1.460     albertel 6729: 
1.648     raeburn  6730: =back
1.562     albertel 6731: 
1.306     albertel 6732: =cut
                   6733: 
                   6734: sub start_page {
1.309     albertel 6735:     my ($title,$head_extra,$args) = @_;
1.318     albertel 6736:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.964     droeschl 6737: #SD
                   6738: #I don't see why we copy certain elements of %$args to %head_args
                   6739: #head args is passed to headtag() and this routine only reads those
                   6740: #keys that are needed. There doesn't happen any writes or any processing
                   6741: #of other keys.
                   6742: #proposal: just pass $args to headtag instead of \%head_args and delete 
                   6743: #marked lines
                   6744: #<- MARK
1.313     albertel 6745:     my %head_args;
1.352     albertel 6746:     foreach my $arg ('redirect','force_register','domain','function',
1.460     albertel 6747: 		     'bgcolor','frameset','no_nav_bar','only_body',
                   6748: 		     'no_auto_mt_title') {
1.319     albertel 6749: 	if (defined($args->{$arg})) {
1.324     raeburn  6750: 	    $head_args{$arg} = $args->{$arg};
1.319     albertel 6751: 	}
1.313     albertel 6752:     }
1.964     droeschl 6753: #MARK ->
1.319     albertel 6754: 
1.315     albertel 6755:     $env{'internal.start_page'}++;
1.338     albertel 6756:     my $result;
1.964     droeschl 6757: 
1.338     albertel 6758:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.964     droeschl 6759:         $result .= 
                   6760:                   &xml_begin() . &headtag($title,$head_extra,\%head_args);
                   6761: #replace prev line by
                   6762: #                 &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 6763:     }
                   6764:     
                   6765:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   6766: 	if ($args->{'frameset'}) {
                   6767: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   6768: 						$args->{'add_entries'});
                   6769: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   6770:         } else {
                   6771:             $result .=
                   6772:                 &bodytag($title, 
                   6773:                          $args->{'function'},       $args->{'add_entries'},
                   6774:                          $args->{'only_body'},      $args->{'domain'},
                   6775:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 6776:                          $args->{'bgcolor'},        $args);
1.831     bisitz   6777:         }
1.330     albertel 6778:     }
1.338     albertel 6779: 
1.315     albertel 6780:     if ($args->{'js_ready'}) {
1.713     kaisler  6781: 		$result = &js_ready($result);
1.315     albertel 6782:     }
1.320     albertel 6783:     if ($args->{'html_encode'}) {
1.713     kaisler  6784: 		$result = &html_encode($result);
                   6785:     }
                   6786: 
1.813     bisitz   6787:     # Preparation for new and consistent functionlist at top of screen
                   6788:     # if ($args->{'functionlist'}) {
                   6789:     #            $result .= &build_functionlist();
                   6790:     #}
                   6791: 
1.964     droeschl 6792:     # Don't add anything more if only_body wanted or in const space
                   6793:     return $result if    $args->{'only_body'} 
                   6794:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   6795: 
                   6796:     #Breadcrumbs
1.758     kaisler  6797:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   6798: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   6799: 		#if any br links exists, add them to the breadcrumbs
                   6800: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   6801: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   6802: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   6803: 			}
                   6804: 		}
                   6805: 
                   6806: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   6807: 		if(exists($args->{'bread_crumbs_component'})){
                   6808: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   6809: 		}else{
                   6810: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   6811: 		}
1.320     albertel 6812:     }
1.315     albertel 6813:     return $result;
1.306     albertel 6814: }
                   6815: 
                   6816: sub end_page {
1.315     albertel 6817:     my ($args) = @_;
                   6818:     $env{'internal.end_page'}++;
1.330     albertel 6819:     my $result;
1.335     albertel 6820:     if ($args->{'discussion'}) {
                   6821: 	my ($target,$parser);
                   6822: 	if (ref($args->{'discussion'})) {
                   6823: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   6824: 				$args->{'discussion'}{'parser'});
                   6825: 	}
                   6826: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   6827:     }
                   6828: 
1.330     albertel 6829:     if ($args->{'frameset'}) {
                   6830: 	$result .= '</frameset>';
                   6831:     } else {
1.635     raeburn  6832: 	$result .= &endbodytag($args);
1.330     albertel 6833:     }
                   6834:     $result .= "\n</html>";
                   6835: 
1.315     albertel 6836:     if ($args->{'js_ready'}) {
1.317     albertel 6837: 	$result = &js_ready($result);
1.315     albertel 6838:     }
1.335     albertel 6839: 
1.320     albertel 6840:     if ($args->{'html_encode'}) {
                   6841: 	$result = &html_encode($result);
                   6842:     }
1.335     albertel 6843: 
1.315     albertel 6844:     return $result;
                   6845: }
                   6846: 
1.320     albertel 6847: sub html_encode {
                   6848:     my ($result) = @_;
                   6849: 
1.322     albertel 6850:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 6851:     
                   6852:     return $result;
                   6853: }
1.317     albertel 6854: sub js_ready {
                   6855:     my ($result) = @_;
                   6856: 
1.323     albertel 6857:     $result =~ s/[\n\r]/ /xmsg;
                   6858:     $result =~ s/\\/\\\\/xmsg;
                   6859:     $result =~ s/'/\\'/xmsg;
1.372     albertel 6860:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 6861:     
                   6862:     return $result;
                   6863: }
                   6864: 
1.315     albertel 6865: sub validate_page {
                   6866:     if (  exists($env{'internal.start_page'})
1.316     albertel 6867: 	  &&     $env{'internal.start_page'} > 1) {
                   6868: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 6869: 				 $env{'internal.start_page'}.' '.
1.316     albertel 6870: 				 $ENV{'request.filename'});
1.315     albertel 6871:     }
                   6872:     if (  exists($env{'internal.end_page'})
1.316     albertel 6873: 	  &&     $env{'internal.end_page'} > 1) {
                   6874: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 6875: 				 $env{'internal.end_page'}.' '.
1.316     albertel 6876: 				 $env{'request.filename'});
1.315     albertel 6877:     }
                   6878:     if (     exists($env{'internal.start_page'})
                   6879: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 6880: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   6881: 				 $env{'request.filename'});
1.315     albertel 6882:     }
                   6883:     if (   ! exists($env{'internal.start_page'})
                   6884: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 6885: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   6886: 				 $env{'request.filename'});
1.315     albertel 6887:     }
1.306     albertel 6888: }
1.315     albertel 6889: 
1.996     www      6890: 
                   6891: sub start_scrollbox {
1.998     raeburn  6892:     my ($outerwidth,$width,$height)=@_;
                   6893:     unless ($outerwidth) { $outerwidth='520px'; }
                   6894:     unless ($width) { $width='500px'; }
                   6895:     unless ($height) { $height='200px'; }
                   6896:     return "<table style='width: $outerwidth; border: 1px solid black;'><tr><td style='width: $width;' bgcolor='#FFFFFF'><div style='overflow:auto; width:$width; height: $height;'>";
1.996     www      6897: }
                   6898: 
                   6899: sub end_scrollbox {
1.998     raeburn  6900:     return '</td></tr></table>';
1.996     www      6901: }
                   6902: 
1.318     albertel 6903: sub simple_error_page {
                   6904:     my ($r,$title,$msg) = @_;
                   6905:     my $page =
                   6906: 	&Apache::loncommon::start_page($title).
                   6907: 	&mt($msg).
                   6908: 	&Apache::loncommon::end_page();
                   6909:     if (ref($r)) {
                   6910: 	$r->print($page);
1.327     albertel 6911: 	return;
1.318     albertel 6912:     }
                   6913:     return $page;
                   6914: }
1.347     albertel 6915: 
                   6916: {
1.610     albertel 6917:     my @row_count;
1.961     onken    6918: 
                   6919:     sub start_data_table_count {
                   6920:         unshift(@row_count, 0);
                   6921:         return;
                   6922:     }
                   6923: 
                   6924:     sub end_data_table_count {
                   6925:         shift(@row_count);
                   6926:         return;
                   6927:     }
                   6928: 
1.347     albertel 6929:     sub start_data_table {
1.422     albertel 6930: 	my ($add_class) = @_;
                   6931: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.961     onken    6932: 	&start_data_table_count();
1.422     albertel 6933: 	return '<table class="'.$css_class.'">'."\n";
1.347     albertel 6934:     }
                   6935: 
                   6936:     sub end_data_table {
1.961     onken    6937: 	&end_data_table_count();
1.389     albertel 6938: 	return '</table>'."\n";;
1.347     albertel 6939:     }
                   6940: 
                   6941:     sub start_data_table_row {
1.974     wenzelju 6942: 	my ($add_class, $id) = @_;
1.610     albertel 6943: 	$row_count[0]++;
                   6944: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   6945: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 6946:         $id = (' id="'.$id.'"') unless ($id eq '');
                   6947:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 6948:     }
1.471     banghart 6949:     
                   6950:     sub continue_data_table_row {
1.974     wenzelju 6951: 	my ($add_class, $id) = @_;
1.610     albertel 6952: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 6953: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   6954:         $id = (' id="'.$id.'"') unless ($id eq '');
                   6955:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 6956:     }
1.347     albertel 6957: 
                   6958:     sub end_data_table_row {
1.389     albertel 6959: 	return '</tr>'."\n";;
1.347     albertel 6960:     }
1.367     www      6961: 
1.421     albertel 6962:     sub start_data_table_empty_row {
1.707     bisitz   6963: #	$row_count[0]++;
1.421     albertel 6964: 	return  '<tr class="LC_empty_row" >'."\n";;
                   6965:     }
                   6966: 
                   6967:     sub end_data_table_empty_row {
                   6968: 	return '</tr>'."\n";;
                   6969:     }
                   6970: 
1.367     www      6971:     sub start_data_table_header_row {
1.389     albertel 6972: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      6973:     }
                   6974: 
                   6975:     sub end_data_table_header_row {
1.389     albertel 6976: 	return '</tr>'."\n";;
1.367     www      6977:     }
1.890     droeschl 6978: 
                   6979:     sub data_table_caption {
                   6980:         my $caption = shift;
                   6981:         return "<caption class=\"LC_caption\">$caption</caption>";
                   6982:     }
1.347     albertel 6983: }
                   6984: 
1.548     albertel 6985: =pod
                   6986: 
                   6987: =item * &inhibit_menu_check($arg)
                   6988: 
                   6989: Checks for a inhibitmenu state and generates output to preserve it
                   6990: 
                   6991: Inputs:         $arg - can be any of
                   6992:                      - undef - in which case the return value is a string 
                   6993:                                to add  into arguments list of a uri
                   6994:                      - 'input' - in which case the return value is a HTML
                   6995:                                  <form> <input> field of type hidden to
                   6996:                                  preserve the value
                   6997:                      - a url - in which case the return value is the url with
                   6998:                                the neccesary cgi args added to preserve the
                   6999:                                inhibitmenu state
                   7000:                      - a ref to a url - no return value, but the string is
                   7001:                                         updated to include the neccessary cgi
                   7002:                                         args to preserve the inhibitmenu state
                   7003: 
                   7004: =cut
                   7005: 
                   7006: sub inhibit_menu_check {
                   7007:     my ($arg) = @_;
                   7008:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7009:     if ($arg eq 'input') {
                   7010: 	if ($env{'form.inhibitmenu'}) {
                   7011: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7012: 	} else {
                   7013: 	    return
                   7014: 	}
                   7015:     }
                   7016:     if ($env{'form.inhibitmenu'}) {
                   7017: 	if (ref($arg)) {
                   7018: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7019: 	} elsif ($arg eq '') {
                   7020: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7021: 	} else {
                   7022: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7023: 	}
                   7024:     }
                   7025:     if (!ref($arg)) {
                   7026: 	return $arg;
                   7027:     }
                   7028: }
                   7029: 
1.251     albertel 7030: ###############################################
1.182     matthew  7031: 
                   7032: =pod
                   7033: 
1.549     albertel 7034: =back
                   7035: 
                   7036: =head1 User Information Routines
                   7037: 
                   7038: =over 4
                   7039: 
1.405     albertel 7040: =item * &get_users_function()
1.182     matthew  7041: 
                   7042: Used by &bodytag to determine the current users primary role.
                   7043: Returns either 'student','coordinator','admin', or 'author'.
                   7044: 
                   7045: =cut
                   7046: 
                   7047: ###############################################
                   7048: sub get_users_function {
1.815     tempelho 7049:     my $function = 'norole';
1.818     tempelho 7050:     if ($env{'request.role'}=~/^(st)/) {
                   7051:         $function='student';
                   7052:     }
1.907     raeburn  7053:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7054:         $function='coordinator';
                   7055:     }
1.258     albertel 7056:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7057:         $function='admin';
                   7058:     }
1.826     bisitz   7059:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182     matthew  7060:         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                   7061:         $function='author';
                   7062:     }
                   7063:     return $function;
1.54      www      7064: }
1.99      www      7065: 
                   7066: ###############################################
                   7067: 
1.233     raeburn  7068: =pod
                   7069: 
1.821     raeburn  7070: =item * &show_course()
                   7071: 
                   7072: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7073: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7074: 
                   7075: Inputs:
                   7076: None
                   7077: 
                   7078: Outputs:
                   7079: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7080: 
                   7081: =cut
                   7082: 
                   7083: ###############################################
                   7084: sub show_course {
                   7085:     my $course = !$env{'user.adv'};
                   7086:     if (!$env{'user.adv'}) {
                   7087:         foreach my $env (keys(%env)) {
                   7088:             next if ($env !~ m/^user\.priv\./);
                   7089:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7090:                 $course = 0;
                   7091:                 last;
                   7092:             }
                   7093:         }
                   7094:     }
                   7095:     return $course;
                   7096: }
                   7097: 
                   7098: ###############################################
                   7099: 
                   7100: =pod
                   7101: 
1.542     raeburn  7102: =item * &check_user_status()
1.274     raeburn  7103: 
                   7104: Determines current status of supplied role for a
                   7105: specific user. Roles can be active, previous or future.
                   7106: 
                   7107: Inputs: 
                   7108: user's domain, user's username, course's domain,
1.375     raeburn  7109: course's number, optional section ID.
1.274     raeburn  7110: 
                   7111: Outputs:
                   7112: role status: active, previous or future. 
                   7113: 
                   7114: =cut
                   7115: 
                   7116: sub check_user_status {
1.412     raeburn  7117:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.982     raeburn  7118:     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   7119:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
1.274     raeburn  7120:     my @uroles = keys %userinfo;
                   7121:     my $srchstr;
                   7122:     my $active_chk = 'none';
1.412     raeburn  7123:     my $now = time;
1.274     raeburn  7124:     if (@uroles > 0) {
1.908     raeburn  7125:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7126:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7127:         } else {
1.412     raeburn  7128:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7129:         }
                   7130:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7131:             my $role_end = 0;
                   7132:             my $role_start = 0;
                   7133:             $active_chk = 'active';
1.412     raeburn  7134:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7135:                 $role_end = $1;
                   7136:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7137:                     $role_start = $1;
1.274     raeburn  7138:                 }
                   7139:             }
                   7140:             if ($role_start > 0) {
1.412     raeburn  7141:                 if ($now < $role_start) {
1.274     raeburn  7142:                     $active_chk = 'future';
                   7143:                 }
                   7144:             }
                   7145:             if ($role_end > 0) {
1.412     raeburn  7146:                 if ($now > $role_end) {
1.274     raeburn  7147:                     $active_chk = 'previous';
                   7148:                 }
                   7149:             }
                   7150:         }
                   7151:     }
                   7152:     return $active_chk;
                   7153: }
                   7154: 
                   7155: ###############################################
                   7156: 
                   7157: =pod
                   7158: 
1.405     albertel 7159: =item * &get_sections()
1.233     raeburn  7160: 
                   7161: Determines all the sections for a course including
                   7162: sections with students and sections containing other roles.
1.419     raeburn  7163: Incoming parameters: 
                   7164: 
                   7165: 1. domain
                   7166: 2. course number 
                   7167: 3. reference to array containing roles for which sections should 
                   7168: be gathered (optional).
                   7169: 4. reference to array containing status types for which sections 
                   7170: should be gathered (optional).
                   7171: 
                   7172: If the third argument is undefined, sections are gathered for any role. 
                   7173: If the fourth argument is undefined, sections are gathered for any status.
                   7174: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7175:  
1.374     raeburn  7176: Returns section hash (keys are section IDs, values are
                   7177: number of users in each section), subject to the
1.419     raeburn  7178: optional roles filter, optional status filter 
1.233     raeburn  7179: 
                   7180: =cut
                   7181: 
                   7182: ###############################################
                   7183: sub get_sections {
1.419     raeburn  7184:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7185:     if (!defined($cdom) || !defined($cnum)) {
                   7186:         my $cid =  $env{'request.course.id'};
                   7187: 
                   7188: 	return if (!defined($cid));
                   7189: 
                   7190:         $cdom = $env{'course.'.$cid.'.domain'};
                   7191:         $cnum = $env{'course.'.$cid.'.num'};
                   7192:     }
                   7193: 
                   7194:     my %sectioncount;
1.419     raeburn  7195:     my $now = time;
1.240     albertel 7196: 
1.366     albertel 7197:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7198: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7199: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7200: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7201:         my $start_index = &Apache::loncoursedata::CL_START();
                   7202:         my $end_index = &Apache::loncoursedata::CL_END();
                   7203:         my $status;
1.366     albertel 7204: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7205: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7206: 				                     $data->[$status_index],
                   7207:                                                      $data->[$start_index],
                   7208:                                                      $data->[$end_index]);
                   7209:             if ($stu_status eq 'Active') {
                   7210:                 $status = 'active';
                   7211:             } elsif ($end < $now) {
                   7212:                 $status = 'previous';
                   7213:             } elsif ($start > $now) {
                   7214:                 $status = 'future';
                   7215:             } 
                   7216: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7217:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7218:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7219: 		    $sectioncount{$section}++;
                   7220:                 }
1.240     albertel 7221: 	    }
                   7222: 	}
                   7223:     }
                   7224:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7225:     foreach my $user (sort(keys(%courseroles))) {
                   7226: 	if ($user !~ /^(\w{2})/) { next; }
                   7227: 	my ($role) = ($user =~ /^(\w{2})/);
                   7228: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7229: 	my ($section,$status);
1.240     albertel 7230: 	if ($role eq 'cr' &&
                   7231: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7232: 	    $section=$1;
                   7233: 	}
                   7234: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7235: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7236:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7237:         if ($end == -1 && $start == -1) {
                   7238:             next; #deleted role
                   7239:         }
                   7240:         if (!defined($possible_status)) { 
                   7241:             $sectioncount{$section}++;
                   7242:         } else {
                   7243:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7244:                 $status = 'active';
                   7245:             } elsif ($end < $now) {
                   7246:                 $status = 'future';
                   7247:             } elsif ($start > $now) {
                   7248:                 $status = 'previous';
                   7249:             }
                   7250:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7251:                 $sectioncount{$section}++;
                   7252:             }
                   7253:         }
1.233     raeburn  7254:     }
1.366     albertel 7255:     return %sectioncount;
1.233     raeburn  7256: }
                   7257: 
1.274     raeburn  7258: ###############################################
1.294     raeburn  7259: 
                   7260: =pod
1.405     albertel 7261: 
                   7262: =item * &get_course_users()
                   7263: 
1.275     raeburn  7264: Retrieves usernames:domains for users in the specified course
                   7265: with specific role(s), and access status. 
                   7266: 
                   7267: Incoming parameters:
1.277     albertel 7268: 1. course domain
                   7269: 2. course number
                   7270: 3. access status: users must have - either active, 
1.275     raeburn  7271: previous, future, or all.
1.277     albertel 7272: 4. reference to array of permissible roles
1.288     raeburn  7273: 5. reference to array of section restrictions (optional)
                   7274: 6. reference to results object (hash of hashes).
                   7275: 7. reference to optional userdata hash
1.609     raeburn  7276: 8. reference to optional statushash
1.630     raeburn  7277: 9. flag if privileged users (except those set to unhide in
                   7278:    course settings) should be excluded    
1.609     raeburn  7279: Keys of top level results hash are roles.
1.275     raeburn  7280: Keys of inner hashes are username:domain, with 
                   7281: values set to access type.
1.288     raeburn  7282: Optional userdata hash returns an array with arguments in the 
                   7283: same order as loncoursedata::get_classlist() for student data.
                   7284: 
1.609     raeburn  7285: Optional statushash returns
                   7286: 
1.288     raeburn  7287: Entries for end, start, section and status are blank because
                   7288: of the possibility of multiple values for non-student roles.
                   7289: 
1.275     raeburn  7290: =cut
1.405     albertel 7291: 
1.275     raeburn  7292: ###############################################
1.405     albertel 7293: 
1.275     raeburn  7294: sub get_course_users {
1.630     raeburn  7295:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7296:     my %idx = ();
1.419     raeburn  7297:     my %seclists;
1.288     raeburn  7298: 
                   7299:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7300:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7301:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7302:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7303:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7304:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7305:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7306:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7307: 
1.290     albertel 7308:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7309:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7310:         my $now = time;
1.277     albertel 7311:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7312:             my $match = 0;
1.412     raeburn  7313:             my $secmatch = 0;
1.419     raeburn  7314:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7315:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7316:             if ($section eq '') {
                   7317:                 $section = 'none';
                   7318:             }
1.291     albertel 7319:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7320:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7321:                     $secmatch = 1;
                   7322:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 7323:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7324:                         $secmatch = 1;
                   7325:                     }
                   7326:                 } else {  
1.419     raeburn  7327: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  7328: 		        $secmatch = 1;
                   7329:                     }
1.290     albertel 7330: 		}
1.412     raeburn  7331:                 if (!$secmatch) {
                   7332:                     next;
                   7333:                 }
1.419     raeburn  7334:             }
1.275     raeburn  7335:             if (defined($$types{'active'})) {
1.288     raeburn  7336:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  7337:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  7338:                     $match = 1;
1.275     raeburn  7339:                 }
                   7340:             }
                   7341:             if (defined($$types{'previous'})) {
1.609     raeburn  7342:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  7343:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  7344:                     $match = 1;
1.275     raeburn  7345:                 }
                   7346:             }
                   7347:             if (defined($$types{'future'})) {
1.609     raeburn  7348:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  7349:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  7350:                     $match = 1;
1.275     raeburn  7351:                 }
                   7352:             }
1.609     raeburn  7353:             if ($match) {
                   7354:                 push(@{$seclists{$student}},$section);
                   7355:                 if (ref($userdata) eq 'HASH') {
                   7356:                     $$userdata{$student} = $$classlist{$student};
                   7357:                 }
                   7358:                 if (ref($statushash) eq 'HASH') {
                   7359:                     $statushash->{$student}{'st'}{$section} = $status;
                   7360:                 }
1.288     raeburn  7361:             }
1.275     raeburn  7362:         }
                   7363:     }
1.412     raeburn  7364:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  7365:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7366:         my $now = time;
1.609     raeburn  7367:         my %displaystatus = ( previous => 'Expired',
                   7368:                               active   => 'Active',
                   7369:                               future   => 'Future',
                   7370:                             );
1.630     raeburn  7371:         my %nothide;
                   7372:         if ($hidepriv) {
                   7373:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   7374:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   7375:                 if ($user !~ /:/) {
                   7376:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   7377:                 } else {
                   7378:                     $nothide{$user} = 1;
                   7379:                 }
                   7380:             }
                   7381:         }
1.439     raeburn  7382:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  7383:             my $match = 0;
1.412     raeburn  7384:             my $secmatch = 0;
1.439     raeburn  7385:             my $status;
1.412     raeburn  7386:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  7387:             $user =~ s/:$//;
1.439     raeburn  7388:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   7389:             if ($end == -1 || $start == -1) {
                   7390:                 next;
                   7391:             }
                   7392:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   7393:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  7394:                 my ($uname,$udom) = split(/:/,$user);
                   7395:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7396:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7397:                         $secmatch = 1;
                   7398:                     } elsif ($usec eq '') {
1.420     albertel 7399:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  7400:                             $secmatch = 1;
                   7401:                         }
                   7402:                     } else {
                   7403:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   7404:                             $secmatch = 1;
                   7405:                         }
                   7406:                     }
                   7407:                     if (!$secmatch) {
                   7408:                         next;
                   7409:                     }
1.288     raeburn  7410:                 }
1.419     raeburn  7411:                 if ($usec eq '') {
                   7412:                     $usec = 'none';
                   7413:                 }
1.275     raeburn  7414:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  7415:                     if ($hidepriv) {
                   7416:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   7417:                             (!$nothide{$uname.':'.$udom})) {
                   7418:                             next;
                   7419:                         }
                   7420:                     }
1.503     raeburn  7421:                     if ($end > 0 && $end < $now) {
1.439     raeburn  7422:                         $status = 'previous';
                   7423:                     } elsif ($start > $now) {
                   7424:                         $status = 'future';
                   7425:                     } else {
                   7426:                         $status = 'active';
                   7427:                     }
1.277     albertel 7428:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  7429:                         if ($status eq $type) {
1.420     albertel 7430:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  7431:                                 push(@{$$users{$role}{$user}},$type);
                   7432:                             }
1.288     raeburn  7433:                             $match = 1;
                   7434:                         }
                   7435:                     }
1.419     raeburn  7436:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   7437:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   7438: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   7439:                         }
1.420     albertel 7440:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  7441:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   7442:                         }
1.609     raeburn  7443:                         if (ref($statushash) eq 'HASH') {
                   7444:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   7445:                         }
1.275     raeburn  7446:                     }
                   7447:                 }
                   7448:             }
                   7449:         }
1.290     albertel 7450:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  7451:             if ((defined($cdom)) && (defined($cnum))) {
                   7452:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   7453:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   7454:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  7455:                     next if ($owner eq '');
                   7456:                     my ($ownername,$ownerdom);
                   7457:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   7458:                         $ownername = $1;
                   7459:                         $ownerdom = $2;
                   7460:                     } else {
                   7461:                         $ownername = $owner;
                   7462:                         $ownerdom = $cdom;
                   7463:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  7464:                     }
                   7465:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 7466:                     if (defined($userdata) && 
1.609     raeburn  7467: 			!exists($$userdata{$owner})) {
                   7468: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   7469:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   7470:                             push(@{$seclists{$owner}},'none');
                   7471:                         }
                   7472:                         if (ref($statushash) eq 'HASH') {
                   7473:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  7474:                         }
1.290     albertel 7475: 		    }
1.279     raeburn  7476:                 }
                   7477:             }
                   7478:         }
1.419     raeburn  7479:         foreach my $user (keys(%seclists)) {
                   7480:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   7481:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   7482:         }
1.275     raeburn  7483:     }
                   7484:     return;
                   7485: }
                   7486: 
1.288     raeburn  7487: sub get_user_info {
                   7488:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 7489:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   7490: 	&plainname($uname,$udom,'lastname');
1.291     albertel 7491:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  7492:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  7493:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   7494:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  7495:     return;
                   7496: }
1.275     raeburn  7497: 
1.472     raeburn  7498: ###############################################
                   7499: 
                   7500: =pod
                   7501: 
                   7502: =item * &get_user_quota()
                   7503: 
                   7504: Retrieves quota assigned for storage of portfolio files for a user  
                   7505: 
                   7506: Incoming parameters:
                   7507: 1. user's username
                   7508: 2. user's domain
                   7509: 
                   7510: Returns:
1.536     raeburn  7511: 1. Disk quota (in Mb) assigned to student.
                   7512: 2. (Optional) Type of setting: custom or default
                   7513:    (individually assigned or default for user's 
                   7514:    institutional status).
                   7515: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   7516:    or student - types as defined in localenroll::inst_usertypes 
                   7517:    for user's domain, which determines default quota for user.
                   7518: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  7519: 
                   7520: If a value has been stored in the user's environment, 
1.536     raeburn  7521: it will return that, otherwise it returns the maximal default
                   7522: defined for the user's instituional status(es) in the domain.
1.472     raeburn  7523: 
                   7524: =cut
                   7525: 
                   7526: ###############################################
                   7527: 
                   7528: 
                   7529: sub get_user_quota {
                   7530:     my ($uname,$udom) = @_;
1.536     raeburn  7531:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  7532:     if (!defined($udom)) {
                   7533:         $udom = $env{'user.domain'};
                   7534:     }
                   7535:     if (!defined($uname)) {
                   7536:         $uname = $env{'user.name'};
                   7537:     }
                   7538:     if (($udom eq '' || $uname eq '') ||
                   7539:         ($udom eq 'public') && ($uname eq 'public')) {
                   7540:         $quota = 0;
1.536     raeburn  7541:         $quotatype = 'default';
                   7542:         $defquota = 0; 
1.472     raeburn  7543:     } else {
1.536     raeburn  7544:         my $inststatus;
1.472     raeburn  7545:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   7546:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  7547:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  7548:         } else {
1.536     raeburn  7549:             my %userenv = 
                   7550:                 &Apache::lonnet::get('environment',['portfolioquota',
                   7551:                                      'inststatus'],$udom,$uname);
1.472     raeburn  7552:             my ($tmp) = keys(%userenv);
                   7553:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   7554:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  7555:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  7556:             } else {
                   7557:                 undef(%userenv);
                   7558:             }
                   7559:         }
1.536     raeburn  7560:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  7561:         if ($quota eq '') {
1.536     raeburn  7562:             $quota = $defquota;
                   7563:             $quotatype = 'default';
                   7564:         } else {
                   7565:             $quotatype = 'custom';
1.472     raeburn  7566:         }
                   7567:     }
1.536     raeburn  7568:     if (wantarray) {
                   7569:         return ($quota,$quotatype,$settingstatus,$defquota);
                   7570:     } else {
                   7571:         return $quota;
                   7572:     }
1.472     raeburn  7573: }
                   7574: 
                   7575: ###############################################
                   7576: 
                   7577: =pod
                   7578: 
                   7579: =item * &default_quota()
                   7580: 
1.536     raeburn  7581: Retrieves default quota assigned for storage of user portfolio files,
                   7582: given an (optional) user's institutional status.
1.472     raeburn  7583: 
                   7584: Incoming parameters:
                   7585: 1. domain
1.536     raeburn  7586: 2. (Optional) institutional status(es).  This is a : separated list of 
                   7587:    status types (e.g., faculty, staff, student etc.)
                   7588:    which apply to the user for whom the default is being retrieved.
                   7589:    If the institutional status string in undefined, the domain
                   7590:    default quota will be returned. 
1.472     raeburn  7591: 
                   7592: Returns:
                   7593: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  7594: 2. (Optional) institutional type which determined the value of the
                   7595:    default quota.
1.472     raeburn  7596: 
                   7597: If a value has been stored in the domain's configuration db,
                   7598: it will return that, otherwise it returns 20 (for backwards 
                   7599: compatibility with domains which have not set up a configuration
                   7600: db file; the original statically defined portfolio quota was 20 Mb). 
                   7601: 
1.536     raeburn  7602: If the user's status includes multiple types (e.g., staff and student),
                   7603: the largest default quota which applies to the user determines the
                   7604: default quota returned.
                   7605: 
1.780     raeburn  7606: =back
                   7607: 
1.472     raeburn  7608: =cut
                   7609: 
                   7610: ###############################################
                   7611: 
                   7612: 
                   7613: sub default_quota {
1.536     raeburn  7614:     my ($udom,$inststatus) = @_;
                   7615:     my ($defquota,$settingstatus);
                   7616:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  7617:                                             ['quotas'],$udom);
                   7618:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  7619:         if ($inststatus ne '') {
1.765     raeburn  7620:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  7621:             foreach my $item (@statuses) {
1.711     raeburn  7622:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7623:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   7624:                         if ($defquota eq '') {
                   7625:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7626:                             $settingstatus = $item;
                   7627:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   7628:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   7629:                             $settingstatus = $item;
                   7630:                         }
                   7631:                     }
                   7632:                 } else {
                   7633:                     if ($quotahash{'quotas'}{$item} ne '') {
                   7634:                         if ($defquota eq '') {
                   7635:                             $defquota = $quotahash{'quotas'}{$item};
                   7636:                             $settingstatus = $item;
                   7637:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   7638:                             $defquota = $quotahash{'quotas'}{$item};
                   7639:                             $settingstatus = $item;
                   7640:                         }
1.536     raeburn  7641:                     }
                   7642:                 }
                   7643:             }
                   7644:         }
                   7645:         if ($defquota eq '') {
1.711     raeburn  7646:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   7647:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   7648:             } else {
                   7649:                 $defquota = $quotahash{'quotas'}{'default'};
                   7650:             }
1.536     raeburn  7651:             $settingstatus = 'default';
                   7652:         }
                   7653:     } else {
                   7654:         $settingstatus = 'default';
                   7655:         $defquota = 20;
                   7656:     }
                   7657:     if (wantarray) {
                   7658:         return ($defquota,$settingstatus);
1.472     raeburn  7659:     } else {
1.536     raeburn  7660:         return $defquota;
1.472     raeburn  7661:     }
                   7662: }
                   7663: 
1.384     raeburn  7664: sub get_secgrprole_info {
                   7665:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   7666:     my %sections_count = &get_sections($cdom,$cnum);
                   7667:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   7668:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   7669:     my @groups = sort(keys(%curr_groups));
                   7670:     my $allroles = [];
                   7671:     my $rolehash;
                   7672:     my $accesshash = {
                   7673:                      active => 'Currently has access',
                   7674:                      future => 'Will have future access',
                   7675:                      previous => 'Previously had access',
                   7676:                   };
                   7677:     if ($needroles) {
                   7678:         $rolehash = {'all' => 'all'};
1.385     albertel 7679:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7680: 	if (&Apache::lonnet::error(%user_roles)) {
                   7681: 	    undef(%user_roles);
                   7682: 	}
                   7683:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  7684:             my ($role)=split(/\:/,$item,2);
                   7685:             if ($role eq 'cr') { next; }
                   7686:             if ($role =~ /^cr/) {
                   7687:                 $$rolehash{$role} = (split('/',$role))[3];
                   7688:             } else {
                   7689:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   7690:             }
                   7691:         }
                   7692:         foreach my $key (sort(keys(%{$rolehash}))) {
                   7693:             push(@{$allroles},$key);
                   7694:         }
                   7695:         push (@{$allroles},'st');
                   7696:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   7697:     }
                   7698:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   7699: }
                   7700: 
1.555     raeburn  7701: sub user_picker {
1.994     raeburn  7702:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  7703:     my $currdom = $dom;
                   7704:     my %curr_selected = (
                   7705:                         srchin => 'dom',
1.580     raeburn  7706:                         srchby => 'lastname',
1.555     raeburn  7707:                       );
                   7708:     my $srchterm;
1.625     raeburn  7709:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  7710:         if ($srch->{'srchby'} ne '') {
                   7711:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   7712:         }
                   7713:         if ($srch->{'srchin'} ne '') {
                   7714:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   7715:         }
                   7716:         if ($srch->{'srchtype'} ne '') {
                   7717:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   7718:         }
                   7719:         if ($srch->{'srchdomain'} ne '') {
                   7720:             $currdom = $srch->{'srchdomain'};
                   7721:         }
                   7722:         $srchterm = $srch->{'srchterm'};
                   7723:     }
                   7724:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  7725:                     'usr'       => 'Search criteria',
1.563     raeburn  7726:                     'doma'      => 'Domain/institution to search',
1.558     albertel 7727:                     'uname'     => 'username',
                   7728:                     'lastname'  => 'last name',
1.555     raeburn  7729:                     'lastfirst' => 'last name, first name',
1.558     albertel 7730:                     'crs'       => 'in this course',
1.576     raeburn  7731:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 7732:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  7733:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 7734:                     'exact'     => 'is',
                   7735:                     'contains'  => 'contains',
1.569     raeburn  7736:                     'begins'    => 'begins with',
1.571     raeburn  7737:                     'youm'      => "You must include some text to search for.",
                   7738:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   7739:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   7740:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   7741:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   7742:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   7743:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   7744:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  7745:                                        );
1.563     raeburn  7746:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   7747:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  7748: 
                   7749:     my @srchins = ('crs','dom','alc','instd');
                   7750: 
                   7751:     foreach my $option (@srchins) {
                   7752:         # FIXME 'alc' option unavailable until 
                   7753:         #       loncreateuser::print_user_query_page()
                   7754:         #       has been completed.
                   7755:         next if ($option eq 'alc');
1.880     raeburn  7756:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  7757:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  7758:         if ($curr_selected{'srchin'} eq $option) {
                   7759:             $srchinsel .= ' 
                   7760:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7761:         } else {
                   7762:             $srchinsel .= '
                   7763:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7764:         }
1.555     raeburn  7765:     }
1.563     raeburn  7766:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  7767: 
                   7768:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  7769:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  7770:         if ($curr_selected{'srchby'} eq $option) {
                   7771:             $srchbysel .= '
                   7772:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7773:         } else {
                   7774:             $srchbysel .= '
                   7775:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7776:          }
                   7777:     }
                   7778:     $srchbysel .= "\n  </select>\n";
                   7779: 
                   7780:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  7781:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  7782:         if ($curr_selected{'srchtype'} eq $option) {
                   7783:             $srchtypesel .= '
                   7784:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   7785:         } else {
                   7786:             $srchtypesel .= '
                   7787:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   7788:         }
                   7789:     }
                   7790:     $srchtypesel .= "\n  </select>\n";
                   7791: 
1.558     albertel 7792:     my ($newuserscript,$new_user_create);
1.994     raeburn  7793:     my $context_dom = $env{'request.role.domain'};
                   7794:     if ($context eq 'requestcrs') {
                   7795:         if ($env{'form.coursedom'} ne '') { 
                   7796:             $context_dom = $env{'form.coursedom'};
                   7797:         }
                   7798:     }
1.556     raeburn  7799:     if ($forcenewuser) {
1.576     raeburn  7800:         if (ref($srch) eq 'HASH') {
1.994     raeburn  7801:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  7802:                 if ($cancreate) {
                   7803:                     $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>';
                   7804:                 } else {
1.799     bisitz   7805:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  7806:                     my %usertypetext = (
                   7807:                         official   => 'institutional',
                   7808:                         unofficial => 'non-institutional',
                   7809:                     );
1.799     bisitz   7810:                     $new_user_create = '<p class="LC_warning">'
                   7811:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   7812:                                       .' '
                   7813:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   7814:                                           ,'<a href="'.$helplink.'">','</a>')
                   7815:                                       .'</p><br />';
1.627     raeburn  7816:                 }
1.576     raeburn  7817:             }
                   7818:         }
                   7819: 
1.556     raeburn  7820:         $newuserscript = <<"ENDSCRIPT";
                   7821: 
1.570     raeburn  7822: function setSearch(createnew,callingForm) {
1.556     raeburn  7823:     if (createnew == 1) {
1.570     raeburn  7824:         for (var i=0; i<callingForm.srchby.length; i++) {
                   7825:             if (callingForm.srchby.options[i].value == 'uname') {
                   7826:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  7827:             }
                   7828:         }
1.570     raeburn  7829:         for (var i=0; i<callingForm.srchin.length; i++) {
                   7830:             if ( callingForm.srchin.options[i].value == 'dom') {
                   7831: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  7832:             }
                   7833:         }
1.570     raeburn  7834:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   7835:             if (callingForm.srchtype.options[i].value == 'exact') {
                   7836:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  7837:             }
                   7838:         }
1.570     raeburn  7839:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  7840:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  7841:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  7842:             }
                   7843:         }
                   7844:     }
                   7845: }
                   7846: ENDSCRIPT
1.558     albertel 7847: 
1.556     raeburn  7848:     }
                   7849: 
1.555     raeburn  7850:     my $output = <<"END_BLOCK";
1.556     raeburn  7851: <script type="text/javascript">
1.824     bisitz   7852: // <![CDATA[
1.570     raeburn  7853: function validateEntry(callingForm) {
1.558     albertel 7854: 
1.556     raeburn  7855:     var checkok = 1;
1.558     albertel 7856:     var srchin;
1.570     raeburn  7857:     for (var i=0; i<callingForm.srchin.length; i++) {
                   7858: 	if ( callingForm.srchin[i].checked ) {
                   7859: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 7860: 	}
                   7861:     }
                   7862: 
1.570     raeburn  7863:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   7864:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   7865:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   7866:     var srchterm =  callingForm.srchterm.value;
                   7867:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  7868:     var msg = "";
                   7869: 
                   7870:     if (srchterm == "") {
                   7871:         checkok = 0;
1.571     raeburn  7872:         msg += "$lt{'youm'}\\n";
1.556     raeburn  7873:     }
                   7874: 
1.569     raeburn  7875:     if (srchtype== 'begins') {
                   7876:         if (srchterm.length < 2) {
                   7877:             checkok = 0;
1.571     raeburn  7878:             msg += "$lt{'thte'}\\n";
1.569     raeburn  7879:         }
                   7880:     }
                   7881: 
1.556     raeburn  7882:     if (srchtype== 'contains') {
                   7883:         if (srchterm.length < 3) {
                   7884:             checkok = 0;
1.571     raeburn  7885:             msg += "$lt{'thet'}\\n";
1.556     raeburn  7886:         }
                   7887:     }
                   7888:     if (srchin == 'instd') {
                   7889:         if (srchdomain == '') {
                   7890:             checkok = 0;
1.571     raeburn  7891:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  7892:         }
                   7893:     }
                   7894:     if (srchin == 'dom') {
                   7895:         if (srchdomain == '') {
                   7896:             checkok = 0;
1.571     raeburn  7897:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  7898:         }
                   7899:     }
                   7900:     if (srchby == 'lastfirst') {
                   7901:         if (srchterm.indexOf(",") == -1) {
                   7902:             checkok = 0;
1.571     raeburn  7903:             msg += "$lt{'whus'}\\n";
1.556     raeburn  7904:         }
                   7905:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   7906:             checkok = 0;
1.571     raeburn  7907:             msg += "$lt{'whse'}\\n";
1.556     raeburn  7908:         }
                   7909:     }
                   7910:     if (checkok == 0) {
1.571     raeburn  7911:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  7912:         return;
                   7913:     }
                   7914:     if (checkok == 1) {
1.570     raeburn  7915:         callingForm.submit();
1.556     raeburn  7916:     }
                   7917: }
                   7918: 
                   7919: $newuserscript
                   7920: 
1.824     bisitz   7921: // ]]>
1.556     raeburn  7922: </script>
1.558     albertel 7923: 
                   7924: $new_user_create
                   7925: 
1.555     raeburn  7926: END_BLOCK
1.558     albertel 7927: 
1.876     raeburn  7928:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   7929:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   7930:                $domform.
                   7931:                &Apache::lonhtmlcommon::row_closure().
                   7932:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   7933:                $srchbysel.
                   7934:                $srchtypesel. 
                   7935:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   7936:                $srchinsel.
                   7937:                &Apache::lonhtmlcommon::row_closure(1). 
                   7938:                &Apache::lonhtmlcommon::end_pick_box().
                   7939:                '<br />';
1.555     raeburn  7940:     return $output;
                   7941: }
                   7942: 
1.612     raeburn  7943: sub user_rule_check {
1.615     raeburn  7944:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  7945:     my $response;
                   7946:     if (ref($usershash) eq 'HASH') {
                   7947:         foreach my $user (keys(%{$usershash})) {
                   7948:             my ($uname,$udom) = split(/:/,$user);
                   7949:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  7950:             my ($id,$newuser);
1.612     raeburn  7951:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  7952:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  7953:                 $id = $usershash->{$user}->{'id'};
                   7954:             }
                   7955:             my $inst_response;
                   7956:             if (ref($checks) eq 'HASH') {
                   7957:                 if (defined($checks->{'username'})) {
1.615     raeburn  7958:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  7959:                         &Apache::lonnet::get_instuser($udom,$uname);
                   7960:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  7961:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  7962:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   7963:                 }
1.615     raeburn  7964:             } else {
                   7965:                 ($inst_response,%{$inst_results->{$user}}) =
                   7966:                     &Apache::lonnet::get_instuser($udom,$uname);
                   7967:                 return;
1.612     raeburn  7968:             }
1.615     raeburn  7969:             if (!$got_rules->{$udom}) {
1.612     raeburn  7970:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   7971:                                                   ['usercreation'],$udom);
                   7972:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  7973:                     foreach my $item ('username','id') {
1.612     raeburn  7974:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   7975:                             $$curr_rules{$udom}{$item} = 
                   7976:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  7977:                         }
                   7978:                     }
                   7979:                 }
1.615     raeburn  7980:                 $got_rules->{$udom} = 1;  
1.585     raeburn  7981:             }
1.612     raeburn  7982:             foreach my $item (keys(%{$checks})) {
                   7983:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   7984:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   7985:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   7986:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   7987:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   7988:                                 if ($rule_check{$rule}) {
                   7989:                                     $$rulematch{$user}{$item} = $rule;
                   7990:                                     if ($inst_response eq 'ok') {
1.615     raeburn  7991:                                         if (ref($inst_results) eq 'HASH') {
                   7992:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   7993:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   7994:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   7995:                                                 }
1.612     raeburn  7996:                                             }
                   7997:                                         }
1.615     raeburn  7998:                                     }
                   7999:                                     last;
1.585     raeburn  8000:                                 }
                   8001:                             }
                   8002:                         }
                   8003:                     }
                   8004:                 }
                   8005:             }
                   8006:         }
                   8007:     }
1.612     raeburn  8008:     return;
                   8009: }
                   8010: 
                   8011: sub user_rule_formats {
                   8012:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8013:     my %text = ( 
                   8014:                  'username' => 'Usernames',
                   8015:                  'id'       => 'IDs',
                   8016:                );
                   8017:     my $output;
                   8018:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8019:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8020:         if (@{$ruleorder} > 0) {
                   8021:             $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>';
                   8022:             foreach my $rule (@{$ruleorder}) {
                   8023:                 if (ref($curr_rules) eq 'ARRAY') {
                   8024:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8025:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8026:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8027:                                         $rules->{$rule}{'desc'}.'</li>';
                   8028:                         }
                   8029:                     }
                   8030:                 }
                   8031:             }
                   8032:             $output .= '</ul>';
                   8033:         }
                   8034:     }
                   8035:     return $output;
                   8036: }
                   8037: 
                   8038: sub instrule_disallow_msg {
1.615     raeburn  8039:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8040:     my $response;
                   8041:     my %text = (
                   8042:                   item   => 'username',
                   8043:                   items  => 'usernames',
                   8044:                   match  => 'matches',
                   8045:                   do     => 'does',
                   8046:                   action => 'a username',
                   8047:                   one    => 'one',
                   8048:                );
                   8049:     if ($count > 1) {
                   8050:         $text{'item'} = 'usernames';
                   8051:         $text{'match'} ='match';
                   8052:         $text{'do'} = 'do';
                   8053:         $text{'action'} = 'usernames',
                   8054:         $text{'one'} = 'ones';
                   8055:     }
                   8056:     if ($checkitem eq 'id') {
                   8057:         $text{'items'} = 'IDs';
                   8058:         $text{'item'} = 'ID';
                   8059:         $text{'action'} = 'an ID';
1.615     raeburn  8060:         if ($count > 1) {
                   8061:             $text{'item'} = 'IDs';
                   8062:             $text{'action'} = 'IDs';
                   8063:         }
1.612     raeburn  8064:     }
1.674     bisitz   8065:     $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  8066:     if ($mode eq 'upload') {
                   8067:         if ($checkitem eq 'username') {
                   8068:             $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'}.");
                   8069:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8070:             $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  8071:         }
1.669     raeburn  8072:     } elsif ($mode eq 'selfcreate') {
                   8073:         if ($checkitem eq 'id') {
                   8074:             $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.");
                   8075:         }
1.615     raeburn  8076:     } else {
                   8077:         if ($checkitem eq 'username') {
                   8078:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8079:         } elsif ($checkitem eq 'id') {
                   8080:             $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.");
                   8081:         }
1.612     raeburn  8082:     }
                   8083:     return $response;
1.585     raeburn  8084: }
                   8085: 
1.624     raeburn  8086: sub personal_data_fieldtitles {
                   8087:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8088:                         id => 'Student/Employee ID',
                   8089:                         permanentemail => 'E-mail address',
                   8090:                         lastname => 'Last Name',
                   8091:                         firstname => 'First Name',
                   8092:                         middlename => 'Middle Name',
                   8093:                         generation => 'Generation',
                   8094:                         gen => 'Generation',
1.765     raeburn  8095:                         inststatus => 'Affiliation',
1.624     raeburn  8096:                    );
                   8097:     return %fieldtitles;
                   8098: }
                   8099: 
1.642     raeburn  8100: sub sorted_inst_types {
                   8101:     my ($dom) = @_;
                   8102:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8103:     my $othertitle = &mt('All users');
                   8104:     if ($env{'request.course.id'}) {
1.668     raeburn  8105:         $othertitle  = &mt('Any users');
1.642     raeburn  8106:     }
                   8107:     my @types;
                   8108:     if (ref($order) eq 'ARRAY') {
                   8109:         @types = @{$order};
                   8110:     }
                   8111:     if (@types == 0) {
                   8112:         if (ref($usertypes) eq 'HASH') {
                   8113:             @types = sort(keys(%{$usertypes}));
                   8114:         }
                   8115:     }
                   8116:     if (keys(%{$usertypes}) > 0) {
                   8117:         $othertitle = &mt('Other users');
                   8118:     }
                   8119:     return ($othertitle,$usertypes,\@types);
                   8120: }
                   8121: 
1.645     raeburn  8122: sub get_institutional_codes {
                   8123:     my ($settings,$allcourses,$LC_code) = @_;
                   8124: # Get complete list of course sections to update
                   8125:     my @currsections = ();
                   8126:     my @currxlists = ();
                   8127:     my $coursecode = $$settings{'internal.coursecode'};
                   8128: 
                   8129:     if ($$settings{'internal.sectionnums'} ne '') {
                   8130:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8131:     }
                   8132: 
                   8133:     if ($$settings{'internal.crosslistings'} ne '') {
                   8134:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8135:     }
                   8136: 
                   8137:     if (@currxlists > 0) {
                   8138:         foreach (@currxlists) {
                   8139:             if (m/^([^:]+):(\w*)$/) {
                   8140:                 unless (grep/^$1$/,@{$allcourses}) {
                   8141:                     push @{$allcourses},$1;
                   8142:                     $$LC_code{$1} = $2;
                   8143:                 }
                   8144:             }
                   8145:         }
                   8146:     }
                   8147:  
                   8148:     if (@currsections > 0) {
                   8149:         foreach (@currsections) {
                   8150:             if (m/^(\w+):(\w*)$/) {
                   8151:                 my $sec = $coursecode.$1;
                   8152:                 my $lc_sec = $2;
                   8153:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8154:                     push @{$allcourses},$sec;
                   8155:                     $$LC_code{$sec} = $lc_sec;
                   8156:                 }
                   8157:             }
                   8158:         }
                   8159:     }
                   8160:     return;
                   8161: }
                   8162: 
1.971     raeburn  8163: sub get_standard_codeitems {
                   8164:     return ('Year','Semester','Department','Number','Section');
                   8165: }
                   8166: 
1.112     bowersj2 8167: =pod
                   8168: 
1.780     raeburn  8169: =head1 Slot Helpers
                   8170: 
                   8171: =over 4
                   8172: 
                   8173: =item * sorted_slots()
                   8174: 
                   8175: Sorts an array of slot names in order of slot start time (earliest first). 
                   8176: 
                   8177: Inputs:
                   8178: 
                   8179: =over 4
                   8180: 
                   8181: slotsarr  - Reference to array of unsorted slot names.
                   8182: 
                   8183: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8184: 
1.549     albertel 8185: =back
                   8186: 
1.780     raeburn  8187: Returns:
                   8188: 
                   8189: =over 4
                   8190: 
                   8191: sorted   - An array of slot names sorted by the start time of the slot.
                   8192: 
                   8193: =back
                   8194: 
                   8195: =back
                   8196: 
                   8197: =cut
                   8198: 
                   8199: 
                   8200: sub sorted_slots {
                   8201:     my ($slotsarr,$slots) = @_;
                   8202:     my @sorted;
                   8203:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8204:         @sorted =
                   8205:             sort {
                   8206:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
                   8207:                          return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
                   8208:                      }
                   8209:                      if (ref($slots->{$a})) { return -1;}
                   8210:                      if (ref($slots->{$b})) { return 1;}
                   8211:                      return 0;
                   8212:                  } @{$slotsarr};
                   8213:     }
                   8214:     return @sorted;
                   8215: }
                   8216: 
                   8217: 
                   8218: =pod
                   8219: 
1.549     albertel 8220: =head1 HTTP Helpers
                   8221: 
                   8222: =over 4
                   8223: 
1.648     raeburn  8224: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 8225: 
1.258     albertel 8226: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 8227: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 8228: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 8229: 
                   8230: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   8231: $possible_names is an ref to an array of form element names.  As an example:
                   8232: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 8233: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 8234: 
                   8235: =cut
1.1       albertel 8236: 
1.6       albertel 8237: sub get_unprocessed_cgi {
1.25      albertel 8238:   my ($query,$possible_names)= @_;
1.26      matthew  8239:   # $Apache::lonxml::debug=1;
1.356     albertel 8240:   foreach my $pair (split(/&/,$query)) {
                   8241:     my ($name, $value) = split(/=/,$pair);
1.369     www      8242:     $name = &unescape($name);
1.25      albertel 8243:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   8244:       $value =~ tr/+/ /;
                   8245:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 8246:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 8247:     }
1.16      harris41 8248:   }
1.6       albertel 8249: }
                   8250: 
1.112     bowersj2 8251: =pod
                   8252: 
1.648     raeburn  8253: =item * &cacheheader() 
1.112     bowersj2 8254: 
                   8255: returns cache-controlling header code
                   8256: 
                   8257: =cut
                   8258: 
1.7       albertel 8259: sub cacheheader {
1.258     albertel 8260:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 8261:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   8262:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 8263:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   8264:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 8265:     return $output;
1.7       albertel 8266: }
                   8267: 
1.112     bowersj2 8268: =pod
                   8269: 
1.648     raeburn  8270: =item * &no_cache($r) 
1.112     bowersj2 8271: 
                   8272: specifies header code to not have cache
                   8273: 
                   8274: =cut
                   8275: 
1.9       albertel 8276: sub no_cache {
1.216     albertel 8277:     my ($r) = @_;
                   8278:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 8279: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 8280:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   8281:     $r->no_cache(1);
                   8282:     $r->header_out("Expires" => $date);
                   8283:     $r->header_out("Pragma" => "no-cache");
1.123     www      8284: }
                   8285: 
                   8286: sub content_type {
1.181     albertel 8287:     my ($r,$type,$charset) = @_;
1.299     foxr     8288:     if ($r) {
                   8289: 	#  Note that printout.pl calls this with undef for $r.
                   8290: 	&no_cache($r);
                   8291:     }
1.258     albertel 8292:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 8293:     unless ($charset) {
                   8294: 	$charset=&Apache::lonlocal::current_encoding;
                   8295:     }
                   8296:     if ($charset) { $type.='; charset='.$charset; }
                   8297:     if ($r) {
                   8298: 	$r->content_type($type);
                   8299:     } else {
                   8300: 	print("Content-type: $type\n\n");
                   8301:     }
1.9       albertel 8302: }
1.25      albertel 8303: 
1.112     bowersj2 8304: =pod
                   8305: 
1.648     raeburn  8306: =item * &add_to_env($name,$value) 
1.112     bowersj2 8307: 
1.258     albertel 8308: adds $name to the %env hash with value
1.112     bowersj2 8309: $value, if $name already exists, the entry is converted to an array
                   8310: reference and $value is added to the array.
                   8311: 
                   8312: =cut
                   8313: 
1.25      albertel 8314: sub add_to_env {
                   8315:   my ($name,$value)=@_;
1.258     albertel 8316:   if (defined($env{$name})) {
                   8317:     if (ref($env{$name})) {
1.25      albertel 8318:       #already have multiple values
1.258     albertel 8319:       push(@{ $env{$name} },$value);
1.25      albertel 8320:     } else {
                   8321:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 8322:       my $first=$env{$name};
                   8323:       undef($env{$name});
                   8324:       push(@{ $env{$name} },$first,$value);
1.25      albertel 8325:     }
                   8326:   } else {
1.258     albertel 8327:     $env{$name}=$value;
1.25      albertel 8328:   }
1.31      albertel 8329: }
1.149     albertel 8330: 
                   8331: =pod
                   8332: 
1.648     raeburn  8333: =item * &get_env_multiple($name) 
1.149     albertel 8334: 
1.258     albertel 8335: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 8336: values may be defined and end up as an array ref.
                   8337: 
                   8338: returns an array of values
                   8339: 
                   8340: =cut
                   8341: 
                   8342: sub get_env_multiple {
                   8343:     my ($name) = @_;
                   8344:     my @values;
1.258     albertel 8345:     if (defined($env{$name})) {
1.149     albertel 8346:         # exists is it an array
1.258     albertel 8347:         if (ref($env{$name})) {
                   8348:             @values=@{ $env{$name} };
1.149     albertel 8349:         } else {
1.258     albertel 8350:             $values[0]=$env{$name};
1.149     albertel 8351:         }
                   8352:     }
                   8353:     return(@values);
                   8354: }
                   8355: 
1.660     raeburn  8356: sub ask_for_embedded_content {
                   8357:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.987     raeburn  8358:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges);
1.660     raeburn  8359:     my $num = 0;
1.987     raeburn  8360:     my $numremref = 0;
                   8361:     my $numinvalid = 0;
                   8362:     my $numpathchg = 0;
                   8363:     my $numexisting = 0;
                   8364:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath);
1.984     raeburn  8365:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8366:         my $current_path='/';
                   8367:         if ($env{'form.currentpath'}) {
                   8368:             $current_path = $env{'form.currentpath'};
                   8369:         }
                   8370:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   8371:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8372:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   8373:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   8374:         } else {
                   8375:             $udom = $env{'user.domain'};
                   8376:             $uname = $env{'user.name'};
                   8377:             $url = '/userfiles/portfolio';
                   8378:         }
1.987     raeburn  8379:         $toplevel = $url.'/';
1.984     raeburn  8380:         $url .= $current_path;
                   8381:         $getpropath = 1;
1.987     raeburn  8382:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   8383:              ($actionurl eq '/adm/imsimport')) { 
1.984     raeburn  8384:         ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});
1.987     raeburn  8385:         $url = '/home/'.$uname.'/public_html/';
                   8386:         $toplevel = $url;
1.984     raeburn  8387:         if ($rest ne '') {
1.987     raeburn  8388:             $url .= $rest;
                   8389:         }
                   8390:     } elsif ($actionurl eq '/adm/coursedocs') {
                   8391:         if (ref($args) eq 'HASH') {
                   8392:            $url = $args->{'docs_url'};
                   8393:            $toplevel = $url;
                   8394:         }
                   8395:     }
                   8396:     my $now = time();
                   8397:     foreach my $embed_file (keys(%{$allfiles})) {
                   8398:         my $absolutepath;
                   8399:         if ($embed_file =~ m{^\w+://}) {
                   8400:             $newfiles{$embed_file} = 1;
                   8401:             $mapping{$embed_file} = $embed_file;
                   8402:         } else {
                   8403:             if ($embed_file =~ m{^/}) {
                   8404:                 $absolutepath = $embed_file;
                   8405:                 $embed_file =~ s{^(/+)}{};
                   8406:             }
                   8407:             if ($embed_file =~ m{/}) {
                   8408:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   8409:                 $path = &check_for_traversal($path,$url,$toplevel);
                   8410:                 my $item = $fname;
                   8411:                 if ($path ne '') {
                   8412:                     $item = $path.'/'.$fname;
                   8413:                     $subdependencies{$path}{$fname} = 1;
                   8414:                 } else {
                   8415:                     $dependencies{$item} = 1;
                   8416:                 }
                   8417:                 if ($absolutepath) {
                   8418:                     $mapping{$item} = $absolutepath;
                   8419:                 } else {
                   8420:                     $mapping{$item} = $embed_file;
                   8421:                 }
                   8422:             } else {
                   8423:                 $dependencies{$embed_file} = 1;
                   8424:                 if ($absolutepath) {
                   8425:                     $mapping{$embed_file} = $absolutepath;
                   8426:                 } else {
                   8427:                     $mapping{$embed_file} = $embed_file;
                   8428:                 }
                   8429:             }
1.984     raeburn  8430:         }
                   8431:     }
                   8432:     foreach my $path (keys(%subdependencies)) {
                   8433:         my %currsubfile;
                   8434:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
                   8435:             my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   8436:             foreach my $line (@subdir_list) {
                   8437:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   8438:                 $currsubfile{$file_name} = 1;
                   8439:             }
1.987     raeburn  8440:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8441:             if (opendir(my $dir,$url.'/'.$path)) {
                   8442:                 my @subdir_list = grep(!/^\./,readdir($dir));
                   8443:                 map {$currsubfile{$_} = 1;} @subdir_list;
                   8444:             }
                   8445:         }
                   8446:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.987     raeburn  8447:             if ($currsubfile{$file}) {
                   8448:                 my $item = $path.'/'.$file;
                   8449:                 unless ($mapping{$item} eq $item) {
                   8450:                     $pathchanges{$item} = 1;
                   8451:                 }
                   8452:                 $existing{$item} = 1;
                   8453:                 $numexisting ++;
                   8454:             } else {
                   8455:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  8456:             }
                   8457:         }
                   8458:     }
1.987     raeburn  8459:     my %currfile;
1.984     raeburn  8460:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8461:         my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   8462:         foreach my $line (@dir_list) {
                   8463:             my ($file_name,$rest) = split(/\&/,$line,2);
                   8464:             $currfile{$file_name} = 1;
                   8465:         }
1.987     raeburn  8466:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  8467:         if (opendir(my $dir,$url)) {
1.987     raeburn  8468:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  8469:             map {$currfile{$_} = 1;} @dir_list;
                   8470:         }
                   8471:     }
                   8472:     foreach my $file (keys(%dependencies)) {
1.987     raeburn  8473:         if ($currfile{$file}) {
                   8474:             unless ($mapping{$file} eq $file) {
                   8475:                 $pathchanges{$file} = 1;
                   8476:             }
                   8477:             $existing{$file} = 1;
                   8478:             $numexisting ++;
                   8479:         } else {
1.984     raeburn  8480:             $newfiles{$file} = 1;
                   8481:         }
                   8482:     }
                   8483:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.660     raeburn  8484:         $upload_output .= &start_data_table_row().
1.987     raeburn  8485:                           '<td><span class="LC_filename">'.$embed_file.'</span>';
                   8486:         unless ($mapping{$embed_file} eq $embed_file) {
                   8487:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   8488:         }
                   8489:         $upload_output .= '</td><td>';
1.660     raeburn  8490:         if ($args->{'ignore_remote_references'}
                   8491:             && $embed_file =~ m{^\w+://}) {
                   8492:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  8493:             $numremref++;
1.660     raeburn  8494:         } elsif ($args->{'error_on_invalid_names'}
                   8495:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   8496: 
1.987     raeburn  8497:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   8498:             $numinvalid++;
1.660     raeburn  8499:         } else {
1.987     raeburn  8500:             $upload_output .= &embedded_file_element('upload_embedded',$num,
                   8501:                                                      $embed_file,\%mapping,
                   8502:                                                      $allfiles,$codebase);
                   8503:             $num++;
                   8504:         }
                   8505:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   8506:     }
                   8507:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
                   8508:         $upload_output .= &start_data_table_row().
                   8509:                           '<td><span class="LC_filename">'.$embed_file.'</span></td>'.
                   8510:                           '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   8511:                           &Apache::loncommon::end_data_table_row()."\n";
                   8512:     }
                   8513:     if ($upload_output) {
                   8514:         $upload_output = &start_data_table().
                   8515:                          $upload_output.
                   8516:                          &end_data_table()."\n";
                   8517:     }
                   8518:     my $applies = 0;
                   8519:     if ($numremref) {
                   8520:         $applies ++;
                   8521:     }
                   8522:     if ($numinvalid) {
                   8523:         $applies ++;
                   8524:     }
                   8525:     if ($numexisting) {
                   8526:         $applies ++;
                   8527:     }
                   8528:     if ($num) {
                   8529:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   8530:                   ' method="post" enctype="multipart/form-data">'."\n".
                   8531:                   $state.
                   8532:                   '<h3>'.&mt('Upload embedded files').
                   8533:                   ':</h3>'.$upload_output.'<br />'."\n".
                   8534:                   '<input type ="hidden" name="number_embedded_items" value="'.
                   8535:                   $num.'" />'."\n";
                   8536:         if ($actionurl eq '') {
                   8537:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   8538:         }
                   8539:     } elsif ($applies) {
                   8540:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   8541:         if ($applies > 1) {
                   8542:             $output .=  
                   8543:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   8544:             if ($numremref) {
                   8545:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   8546:             }
                   8547:             if ($numinvalid) {
                   8548:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   8549:             }
                   8550:             if ($numexisting) {
                   8551:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   8552:             }
                   8553:             $output .= '</ul><br />';
                   8554:         } elsif ($numremref) {
                   8555:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   8556:         } elsif ($numinvalid) {
                   8557:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   8558:         } elsif ($numexisting) {
                   8559:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   8560:         }
                   8561:         $output .= $upload_output.'<br />';
                   8562:     }
                   8563:     my ($pathchange_output,$chgcount);
                   8564:     $chgcount = $num;
                   8565:     if (keys(%pathchanges) > 0) {
                   8566:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
                   8567:             if ($num) {
                   8568:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   8569:                                                   $embed_file,\%mapping,
                   8570:                                                   $allfiles,$codebase);
                   8571:             } else {
                   8572:                 $pathchange_output .= 
                   8573:                     &start_data_table_row().
                   8574:                     '<td><input type ="checkbox" name="namechange" value="'.
                   8575:                     $chgcount.'" checked="checked" /></td>'.
                   8576:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   8577:                     '<td>'.$embed_file.
                   8578:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
                   8579:                                            \%mapping,$allfiles,$codebase).
                   8580:                     '</td>'.&end_data_table_row();
1.660     raeburn  8581:             }
1.987     raeburn  8582:             $numpathchg ++;
                   8583:             $chgcount ++;
1.660     raeburn  8584:         }
                   8585:     }
1.984     raeburn  8586:     if ($num) {
1.987     raeburn  8587:         if ($numpathchg) {
                   8588:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   8589:                        $numpathchg.'" />'."\n";
                   8590:         }
                   8591:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   8592:             ($actionurl eq '/adm/imsimport')) {
                   8593:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   8594:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   8595:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
                   8596:         }
                   8597:         $output .=  '<input type ="submit" value="'.&mt('Upload Listed Files').'" />'."\n".
                   8598:                     &mt('(only files for which a location has been provided will be uploaded)').'</form>'."\n";
                   8599:     } elsif ($numpathchg) {
                   8600:         my %pathchange = ();
                   8601:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   8602:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8603:             $output .= '<p>'.&mt('or').'</p>'; 
                   8604:         } 
                   8605:     }
                   8606:     return ($output,$num,$numpathchg);
                   8607: }
                   8608: 
                   8609: sub embedded_file_element {
                   8610:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
                   8611:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   8612:                    (ref($codebase) eq 'HASH'));
                   8613:     my $output;
                   8614:     if ($context eq 'upload_embedded') {
                   8615:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   8616:     }
                   8617:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   8618:                &escape($embed_file).'" />';
                   8619:     unless (($context eq 'upload_embedded') && 
                   8620:             ($mapping->{$embed_file} eq $embed_file)) {
                   8621:         $output .='
                   8622:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   8623:     }
                   8624:     my $attrib;
                   8625:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   8626:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   8627:     }
                   8628:     $output .=
                   8629:         "\n\t\t".
                   8630:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   8631:         $attrib.'" />';
                   8632:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   8633:         $output .=
                   8634:             "\n\t\t".
                   8635:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   8636:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  8637:     }
1.987     raeburn  8638:     return $output;
1.660     raeburn  8639: }
                   8640: 
1.661     raeburn  8641: sub upload_embedded {
                   8642:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  8643:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   8644:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  8645:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   8646:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   8647:         my $orig_uploaded_filename =
                   8648:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  8649:         foreach my $type ('orig','ref','attrib','codebase') {
                   8650:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   8651:                 $env{'form.embedded_'.$type.'_'.$i} =
                   8652:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   8653:             }
                   8654:         }
1.661     raeburn  8655:         my ($path,$fname) =
                   8656:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   8657:         # no path, whole string is fname
                   8658:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   8659:         $fname = &Apache::lonnet::clean_filename($fname);
                   8660:         # See if there is anything left
                   8661:         next if ($fname eq '');
                   8662: 
                   8663:         # Check if file already exists as a file or directory.
                   8664:         my ($state,$msg);
                   8665:         if ($context eq 'portfolio') {
                   8666:             my $port_path = $dirpath;
                   8667:             if ($group ne '') {
                   8668:                 $port_path = "groups/$group/$port_path";
                   8669:             }
1.987     raeburn  8670:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   8671:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  8672:                                               $dir_root,$port_path,$disk_quota,
                   8673:                                               $current_disk_usage,$uname,$udom);
                   8674:             if ($state eq 'will_exceed_quota'
1.984     raeburn  8675:                 || $state eq 'file_locked') {
1.661     raeburn  8676:                 $output .= $msg;
                   8677:                 next;
                   8678:             }
                   8679:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   8680:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   8681:             if ($state eq 'exists') {
                   8682:                 $output .= $msg;
                   8683:                 next;
                   8684:             }
                   8685:         }
                   8686:         # Check if extension is valid
                   8687:         if (($fname =~ /\.(\w+)$/) &&
                   8688:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  8689:             $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  8690:             next;
                   8691:         } elsif (($fname =~ /\.(\w+)$/) &&
                   8692:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  8693:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  8694:             next;
                   8695:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  8696:             $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  8697:             next;
                   8698:         }
                   8699: 
                   8700:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   8701:         if ($context eq 'portfolio') {
1.984     raeburn  8702:             my $result;
                   8703:             if ($state eq 'existingfile') {
                   8704:                 $result=
                   8705:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  8706:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  8707:             } else {
1.984     raeburn  8708:                 $result=
                   8709:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  8710:                                                     $dirpath.
                   8711:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  8712:                 if ($result !~ m|^/uploaded/|) {
                   8713:                     $output .= '<span class="LC_error">'
                   8714:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8715:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8716:                                .'</span><br />';
                   8717:                     next;
                   8718:                 } else {
1.987     raeburn  8719:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8720:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  8721:                 }
1.661     raeburn  8722:             }
1.987     raeburn  8723:         } elsif ($context eq 'coursedoc') {
                   8724:             my $result =
                   8725:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   8726:                                                 $dirpath.'/'.$path);
                   8727:             if ($result !~ m|^/uploaded/|) {
                   8728:                 $output .= '<span class="LC_error">'
                   8729:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   8730:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   8731:                            .'</span><br />';
                   8732:                     next;
                   8733:             } else {
                   8734:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8735:                            $path.$fname.'</span>').'<br />';
                   8736:             }
1.661     raeburn  8737:         } else {
                   8738: # Save the file
                   8739:             my $target = $env{'form.embedded_item_'.$i};
                   8740:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   8741:             my $dest = $fullpath.$fname;
                   8742:             my $url = $url_root.$dirpath.'/'.$path.$fname;
                   8743:             my @parts=split(/\//,$fullpath);
                   8744:             my $count;
                   8745:             my $filepath = $dir_root;
                   8746:             for ($count=4;$count<=$#parts;$count++) {
                   8747:                 $filepath .= "/$parts[$count]";
                   8748:                 if ((-e $filepath)!=1) {
                   8749:                     mkdir($filepath,0770);
                   8750:                 }
                   8751:             }
                   8752:             my $fh;
                   8753:             if (!open($fh,'>'.$dest)) {
                   8754:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   8755:                 $output .= '<span class="LC_error">'.
                   8756:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8757:                            '</span><br />';
                   8758:             } else {
                   8759:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   8760:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   8761:                     $output .= '<span class="LC_error">'.
                   8762:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
                   8763:                               '</span><br />';
                   8764:                 } else {
1.987     raeburn  8765:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   8766:                                $url.'</span>').'<br />';
                   8767:                     unless ($context eq 'testbank') {
                   8768:                         $footer .= &mt('View embedded file: [_1]',
                   8769:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   8770:                     }
                   8771:                 }
                   8772:                 close($fh);
                   8773:             }
                   8774:         }
                   8775:         if ($env{'form.embedded_ref_'.$i}) {
                   8776:             $pathchange{$i} = 1;
                   8777:         }
                   8778:     }
                   8779:     if ($output) {
                   8780:         $output = '<p>'.$output.'</p>';
                   8781:     }
                   8782:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   8783:     $returnflag = 'ok';
                   8784:     if (keys(%pathchange) > 0) {
                   8785:         if ($context eq 'portfolio') {
                   8786:             $output .= '<p>'.&mt('or').'</p>';
                   8787:         } elsif ($context eq 'testbank') {
1.988     raeburn  8788:             $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  8789:             $returnflag = 'modify_orightml';
                   8790:         }
                   8791:     }
                   8792:     return ($output.$footer,$returnflag);
                   8793: }
                   8794: 
                   8795: sub modify_html_form {
                   8796:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   8797:     my $end = 0;
                   8798:     my $modifyform;
                   8799:     if ($context eq 'upload_embedded') {
                   8800:         return unless (ref($pathchange) eq 'HASH');
                   8801:         if ($env{'form.number_embedded_items'}) {
                   8802:             $end += $env{'form.number_embedded_items'};
                   8803:         }
                   8804:         if ($env{'form.number_pathchange_items'}) {
                   8805:             $end += $env{'form.number_pathchange_items'};
                   8806:         }
                   8807:         if ($end) {
                   8808:             for (my $i=0; $i<$end; $i++) {
                   8809:                 if ($i < $env{'form.number_embedded_items'}) {
                   8810:                     next unless($pathchange->{$i});
                   8811:                 }
                   8812:                 $modifyform .=
                   8813:                     &start_data_table_row().
                   8814:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   8815:                     'checked="checked" /></td>'.
                   8816:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   8817:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   8818:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   8819:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   8820:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   8821:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   8822:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   8823:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   8824:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   8825:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   8826:                     &end_data_table_row();
                   8827:             } 
                   8828:         }
                   8829:     } else {
                   8830:         $modifyform = $pathchgtable;
                   8831:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   8832:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   8833:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   8834:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   8835:         }
                   8836:     }
                   8837:     if ($modifyform) {
                   8838:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   8839:                '<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".
                   8840:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   8841:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   8842:                '</ol></p>'."\n".'<p>'.
                   8843:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   8844:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   8845:                &start_data_table()."\n".
                   8846:                &start_data_table_header_row().
                   8847:                '<th>'.&mt('Change?').'</th>'.
                   8848:                '<th>'.&mt('Current reference').'</th>'.
                   8849:                '<th>'.&mt('Required reference').'</th>'.
                   8850:                &end_data_table_header_row()."\n".
                   8851:                $modifyform.
                   8852:                &end_data_table().'<br />'."\n".$hiddenstate.
                   8853:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   8854:                '</form>'."\n";
                   8855:     }
                   8856:     return;
                   8857: }
                   8858: 
                   8859: sub modify_html_refs {
                   8860:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   8861:     my $container;
                   8862:     if ($context eq 'portfolio') {
                   8863:         $container = $env{'form.container'};
                   8864:     } elsif ($context eq 'coursedoc') {
                   8865:         $container = $env{'form.primaryurl'};
                   8866:     } else {
                   8867:         $container = $env{'form.filename'};
                   8868:         $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};
                   8869:     }
                   8870:     my (%allfiles,%codebase,$output,$content);
                   8871:     my @changes = &get_env_multiple('form.namechange');
                   8872:     return unless (@changes > 0);
                   8873:     if (($context eq 'portfolio') || ($context eq 'coursedoc')) {
                   8874:         return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});
                   8875:         $content = &Apache::lonnet::getfile($container);
                   8876:         return if ($content eq '-1');
                   8877:     } else {
                   8878:         return unless ($container =~ /^\Q$dir_root\E/); 
                   8879:         if (open(my $fh,"<$container")) {
                   8880:             $content = join('', <$fh>);
                   8881:             close($fh);
                   8882:         } else {
                   8883:             return;
                   8884:         }
                   8885:     }
                   8886:     my ($count,$codebasecount) = (0,0);
                   8887:     my $mm = new File::MMagic;
                   8888:     my $mime_type = $mm->checktype_contents($content);
                   8889:     if ($mime_type eq 'text/html') {
                   8890:         my $parse_result = 
                   8891:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   8892:                                                     \%codebase,\$content);
                   8893:         if ($parse_result eq 'ok') {
                   8894:             foreach my $i (@changes) {
                   8895:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   8896:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   8897:                 if ($allfiles{$ref}) {
                   8898:                     my $newname =  $orig;
                   8899:                     my ($attrib_regexp,$codebase);
                   8900:                     my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
                   8901:                     if ($attrib_regexp =~ /:/) {
                   8902:                         $attrib_regexp =~ s/\:/|/g;
                   8903:                     }
                   8904:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   8905:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   8906:                         $count += $numchg;
                   8907:                     }
                   8908:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
                   8909:                         my $codebase = &unescape($env{'form.embedded_codebase_'.$i});
                   8910:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   8911:                         $codebasecount ++;
                   8912:                     }
                   8913:                 }
                   8914:             }
                   8915:             if ($count || $codebasecount) {
                   8916:                 my $saveresult;
                   8917:                 if ($context eq 'portfolio' || $context eq 'coursedoc') {
                   8918:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   8919:                     if ($url eq $container) {
                   8920:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   8921:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   8922:                                             $count,'<span class="LC_filename">'.
                   8923:                                             $fname.'</span>').'</p>'; 
                   8924:                     } else {
                   8925:                          $output = '<p class="LC_error">'.
                   8926:                                    &mt('Error: update failed for: [_1].',
                   8927:                                    '<span class="LC_filename">'.
                   8928:                                    $container.'</span>').'</p>';
                   8929:                     }
                   8930:                 } else {
                   8931:                     if (open(my $fh,">$container")) {
                   8932:                         print $fh $content;
                   8933:                         close($fh);
                   8934:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   8935:                                   $count,'<span class="LC_filename">'.
                   8936:                                   $container.'</span>').'</p>';
1.661     raeburn  8937:                     } else {
1.987     raeburn  8938:                          $output = '<p class="LC_error">'.
                   8939:                                    &mt('Error: could not update [_1].',
                   8940:                                    '<span class="LC_filename">'.
                   8941:                                    $container.'</span>').'</p>';
1.661     raeburn  8942:                     }
                   8943:                 }
                   8944:             }
1.987     raeburn  8945:         } else {
                   8946:             &logthis('Failed to parse '.$container.
                   8947:                      ' to modify references: '.$parse_result);
1.661     raeburn  8948:         }
                   8949:     }
                   8950:     return $output;
                   8951: }
                   8952: 
                   8953: sub check_for_existing {
                   8954:     my ($path,$fname,$element) = @_;
                   8955:     my ($state,$msg);
                   8956:     if (-d $path.'/'.$fname) {
                   8957:         $state = 'exists';
                   8958:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   8959:     } elsif (-e $path.'/'.$fname) {
                   8960:         $state = 'exists';
                   8961:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   8962:     }
                   8963:     if ($state eq 'exists') {
                   8964:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   8965:     }
                   8966:     return ($state,$msg);
                   8967: }
                   8968: 
                   8969: sub check_for_upload {
                   8970:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   8971:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  8972:     my $filesize = length($env{'form.'.$element});
                   8973:     if (!$filesize) {
                   8974:         my $msg = '<span class="LC_error">'.
                   8975:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   8976:                       '<span class="LC_filename">'.$fname.'</span>',
                   8977:                       $filesize).'<br />'.
1.992     raeburn  8978:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />';
1.985     raeburn  8979:                   '</span>';
                   8980:         return ('zero_bytes',$msg);
                   8981:     }
                   8982:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  8983:     my $getpropath = 1;
                   8984:     my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
                   8985:                                             $getpropath);
                   8986:     my $found_file = 0;
                   8987:     my $locked_file = 0;
1.991     raeburn  8988:     my @lockers;
                   8989:     my $navmap;
                   8990:     if ($env{'request.course.id'}) {
                   8991:         $navmap = Apache::lonnavmaps::navmap->new();
                   8992:     }
1.661     raeburn  8993:     foreach my $line (@dir_list) {
1.984     raeburn  8994:         my ($file_name,$rest)=split(/\&/,$line,2);
1.661     raeburn  8995:         if ($file_name eq $fname){
                   8996:             $file_name = $path.$file_name;
                   8997:             if ($group ne '') {
                   8998:                 $file_name = $group.$file_name;
                   8999:             }
                   9000:             $found_file = 1;
1.991     raeburn  9001:             if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   9002:                 foreach my $lock (@lockers) {
                   9003:                     if (ref($lock) eq 'ARRAY') {
                   9004:                         my ($symb,$crsid) = @{$lock};
                   9005:                         if ($crsid eq $env{'request.course.id'}) {
                   9006:                             if (ref($navmap)) {
                   9007:                                 my $res = $navmap->getBySymb($symb);
                   9008:                                 foreach my $part (@{$res->parts()}) { 
                   9009:                                     my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   9010:                                     unless (($slot_status == $res->RESERVED) ||
                   9011:                                             ($slot_status == $res->RESERVED_LOCATION)) {
                   9012:                                         $locked_file = 1;
                   9013:                                     }
                   9014:                                 }
                   9015:                             } else {
                   9016:                                 $locked_file = 1;
                   9017:                             }
                   9018:                         } else {
                   9019:                             $locked_file = 1;
                   9020:                         }
                   9021:                     }
                   9022:                 }
1.984     raeburn  9023:             } else {
                   9024:                 my @info = split(/\&/,$rest);
                   9025:                 my $currsize = $info[6]/1000;
                   9026:                 if ($currsize < $filesize) {
                   9027:                     my $extra = $filesize - $currsize;
                   9028:                     if (($current_disk_usage + $extra) > $disk_quota) {
                   9029:                         my $msg = '<span class="LC_error">'.
                   9030:                                   &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.',
                   9031:                                       '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   9032:                                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   9033:                                                $disk_quota,$current_disk_usage);
                   9034:                         return ('will_exceed_quota',$msg);
                   9035:                     }
                   9036:                 }
1.661     raeburn  9037:             }
                   9038:         }
                   9039:     }
                   9040:     if (($current_disk_usage + $filesize) > $disk_quota){
                   9041:         my $msg = '<span class="LC_error">'.
                   9042:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   9043:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   9044:         return ('will_exceed_quota',$msg);
                   9045:     } elsif ($found_file) {
                   9046:         if ($locked_file) {
                   9047:             my $msg = '<span class="LC_error">';
                   9048:             $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>');
                   9049:             $msg .= '</span><br />';
                   9050:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   9051:             return ('file_locked',$msg);
                   9052:         } else {
                   9053:             my $msg = '<span class="LC_error">';
1.984     raeburn  9054:             $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  9055:             $msg .= '</span>';
1.984     raeburn  9056:             return ('existingfile',$msg);
1.661     raeburn  9057:         }
                   9058:     }
                   9059: }
                   9060: 
1.987     raeburn  9061: sub check_for_traversal {
                   9062:     my ($path,$url,$toplevel) = @_;
                   9063:     my @parts=split(/\//,$path);
                   9064:     my $cleanpath;
                   9065:     my $fullpath = $url;
                   9066:     for (my $i=0;$i<@parts;$i++) {
                   9067:         next if ($parts[$i] eq '.');
                   9068:         if ($parts[$i] eq '..') {
                   9069:             $fullpath =~ s{([^/]+/)$}{};
                   9070:         } else {
                   9071:             $fullpath .= $parts[$i].'/';
                   9072:         }
                   9073:     }
                   9074:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   9075:         $cleanpath = $1;
                   9076:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   9077:         my $curr_toprel = $1;
                   9078:         my @parts = split(/\//,$curr_toprel);
                   9079:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   9080:         my @urlparts = split(/\//,$url_toprel);
                   9081:         my $doubledots;
                   9082:         my $startdiff = -1;
                   9083:         for (my $i=0; $i<@urlparts; $i++) {
                   9084:             if ($startdiff == -1) {
                   9085:                 unless ($urlparts[$i] eq $parts[$i]) {
                   9086:                     $startdiff = $i;
                   9087:                     $doubledots .= '../';
                   9088:                 }
                   9089:             } else {
                   9090:                 $doubledots .= '../';
                   9091:             }
                   9092:         }
                   9093:         if ($startdiff > -1) {
                   9094:             $cleanpath = $doubledots;
                   9095:             for (my $i=$startdiff; $i<@parts; $i++) {
                   9096:                 $cleanpath .= $parts[$i].'/';
                   9097:             }
                   9098:         }
                   9099:     }
                   9100:     $cleanpath =~ s{(/)$}{};
                   9101:     return $cleanpath;
                   9102: }
1.31      albertel 9103: 
1.41      ng       9104: =pod
1.45      matthew  9105: 
1.464     albertel 9106: =back
1.41      ng       9107: 
1.112     bowersj2 9108: =head1 CSV Upload/Handling functions
1.38      albertel 9109: 
1.41      ng       9110: =over 4
                   9111: 
1.648     raeburn  9112: =item * &upfile_store($r)
1.41      ng       9113: 
                   9114: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 9115: needs $env{'form.upfile'}
1.41      ng       9116: returns $datatoken to be put into hidden field
                   9117: 
                   9118: =cut
1.31      albertel 9119: 
                   9120: sub upfile_store {
                   9121:     my $r=shift;
1.258     albertel 9122:     $env{'form.upfile'}=~s/\r/\n/gs;
                   9123:     $env{'form.upfile'}=~s/\f/\n/gs;
                   9124:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   9125:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 9126: 
1.258     albertel 9127:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   9128: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 9129:     {
1.158     raeburn  9130:         my $datafile = $r->dir_config('lonDaemons').
                   9131:                            '/tmp/'.$datatoken.'.tmp';
                   9132:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 9133:             print $fh $env{'form.upfile'};
1.158     raeburn  9134:             close($fh);
                   9135:         }
1.31      albertel 9136:     }
                   9137:     return $datatoken;
                   9138: }
                   9139: 
1.56      matthew  9140: =pod
                   9141: 
1.648     raeburn  9142: =item * &load_tmp_file($r)
1.41      ng       9143: 
                   9144: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 9145: needs $env{'form.datatoken'},
                   9146: sets $env{'form.upfile'} to the contents of the file
1.41      ng       9147: 
                   9148: =cut
1.31      albertel 9149: 
                   9150: sub load_tmp_file {
                   9151:     my $r=shift;
                   9152:     my @studentdata=();
                   9153:     {
1.158     raeburn  9154:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 9155:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  9156:         if ( open(my $fh,"<$studentfile") ) {
                   9157:             @studentdata=<$fh>;
                   9158:             close($fh);
                   9159:         }
1.31      albertel 9160:     }
1.258     albertel 9161:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 9162: }
                   9163: 
1.56      matthew  9164: =pod
                   9165: 
1.648     raeburn  9166: =item * &upfile_record_sep()
1.41      ng       9167: 
                   9168: Separate uploaded file into records
                   9169: returns array of records,
1.258     albertel 9170: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       9171: 
                   9172: =cut
1.31      albertel 9173: 
                   9174: sub upfile_record_sep {
1.258     albertel 9175:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 9176:     } else {
1.248     albertel 9177: 	my @records;
1.258     albertel 9178: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 9179: 	    if ($line=~/^\s*$/) { next; }
                   9180: 	    push(@records,$line);
                   9181: 	}
                   9182: 	return @records;
1.31      albertel 9183:     }
                   9184: }
                   9185: 
1.56      matthew  9186: =pod
                   9187: 
1.648     raeburn  9188: =item * &record_sep($record)
1.41      ng       9189: 
1.258     albertel 9190: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       9191: 
                   9192: =cut
                   9193: 
1.263     www      9194: sub takeleft {
                   9195:     my $index=shift;
                   9196:     return substr('0000'.$index,-4,4);
                   9197: }
                   9198: 
1.31      albertel 9199: sub record_sep {
                   9200:     my $record=shift;
                   9201:     my %components=();
1.258     albertel 9202:     if ($env{'form.upfiletype'} eq 'xml') {
                   9203:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 9204:         my $i=0;
1.356     albertel 9205:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 9206:             $field=~s/^(\"|\')//;
                   9207:             $field=~s/(\"|\')$//;
1.263     www      9208:             $components{&takeleft($i)}=$field;
1.31      albertel 9209:             $i++;
                   9210:         }
1.258     albertel 9211:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 9212:         my $i=0;
1.356     albertel 9213:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 9214:             $field=~s/^(\"|\')//;
                   9215:             $field=~s/(\"|\')$//;
1.263     www      9216:             $components{&takeleft($i)}=$field;
1.31      albertel 9217:             $i++;
                   9218:         }
                   9219:     } else {
1.561     www      9220:         my $separator=',';
1.480     banghart 9221:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      9222:             $separator=';';
1.480     banghart 9223:         }
1.31      albertel 9224:         my $i=0;
1.561     www      9225: # the character we are looking for to indicate the end of a quote or a record 
                   9226:         my $looking_for=$separator;
                   9227: # do not add the characters to the fields
                   9228:         my $ignore=0;
                   9229: # we just encountered a separator (or the beginning of the record)
                   9230:         my $just_found_separator=1;
                   9231: # store the field we are working on here
                   9232:         my $field='';
                   9233: # work our way through all characters in record
                   9234:         foreach my $character ($record=~/(.)/g) {
                   9235:             if ($character eq $looking_for) {
                   9236:                if ($character ne $separator) {
                   9237: # Found the end of a quote, again looking for separator
                   9238:                   $looking_for=$separator;
                   9239:                   $ignore=1;
                   9240:                } else {
                   9241: # Found a separator, store away what we got
                   9242:                   $components{&takeleft($i)}=$field;
                   9243: 	          $i++;
                   9244:                   $just_found_separator=1;
                   9245:                   $ignore=0;
                   9246:                   $field='';
                   9247:                }
                   9248:                next;
                   9249:             }
                   9250: # single or double quotation marks after a separator indicate beginning of a quote
                   9251: # we are now looking for the end of the quote and need to ignore separators
                   9252:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   9253:                $looking_for=$character;
                   9254:                next;
                   9255:             }
                   9256: # ignore would be true after we reached the end of a quote
                   9257:             if ($ignore) { next; }
                   9258:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   9259:             $field.=$character;
                   9260:             $just_found_separator=0; 
1.31      albertel 9261:         }
1.561     www      9262: # catch the very last entry, since we never encountered the separator
                   9263:         $components{&takeleft($i)}=$field;
1.31      albertel 9264:     }
                   9265:     return %components;
                   9266: }
                   9267: 
1.144     matthew  9268: ######################################################
                   9269: ######################################################
                   9270: 
1.56      matthew  9271: =pod
                   9272: 
1.648     raeburn  9273: =item * &upfile_select_html()
1.41      ng       9274: 
1.144     matthew  9275: Return HTML code to select a file from the users machine and specify 
                   9276: the file type.
1.41      ng       9277: 
                   9278: =cut
                   9279: 
1.144     matthew  9280: ######################################################
                   9281: ######################################################
1.31      albertel 9282: sub upfile_select_html {
1.144     matthew  9283:     my %Types = (
                   9284:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 9285:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  9286:                  space => &mt('Space separated'),
                   9287:                  tab   => &mt('Tabulator separated'),
                   9288: #                 xml   => &mt('HTML/XML'),
                   9289:                  );
                   9290:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  9291:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  9292:     foreach my $type (sort(keys(%Types))) {
                   9293:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   9294:     }
                   9295:     $Str .= "</select>\n";
                   9296:     return $Str;
1.31      albertel 9297: }
                   9298: 
1.301     albertel 9299: sub get_samples {
                   9300:     my ($records,$toget) = @_;
                   9301:     my @samples=({});
                   9302:     my $got=0;
                   9303:     foreach my $rec (@$records) {
                   9304: 	my %temp = &record_sep($rec);
                   9305: 	if (! grep(/\S/, values(%temp))) { next; }
                   9306: 	if (%temp) {
                   9307: 	    $samples[$got]=\%temp;
                   9308: 	    $got++;
                   9309: 	    if ($got == $toget) { last; }
                   9310: 	}
                   9311:     }
                   9312:     return \@samples;
                   9313: }
                   9314: 
1.144     matthew  9315: ######################################################
                   9316: ######################################################
                   9317: 
1.56      matthew  9318: =pod
                   9319: 
1.648     raeburn  9320: =item * &csv_print_samples($r,$records)
1.41      ng       9321: 
                   9322: Prints a table of sample values from each column uploaded $r is an
                   9323: Apache Request ref, $records is an arrayref from
                   9324: &Apache::loncommon::upfile_record_sep
                   9325: 
                   9326: =cut
                   9327: 
1.144     matthew  9328: ######################################################
                   9329: ######################################################
1.31      albertel 9330: sub csv_print_samples {
                   9331:     my ($r,$records) = @_;
1.662     bisitz   9332:     my $samples = &get_samples($records,5);
1.301     albertel 9333: 
1.594     raeburn  9334:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   9335:               &start_data_table_header_row());
1.356     albertel 9336:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   9337:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  9338:     $r->print(&end_data_table_header_row());
1.301     albertel 9339:     foreach my $hash (@$samples) {
1.594     raeburn  9340: 	$r->print(&start_data_table_row());
1.356     albertel 9341: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 9342: 	    $r->print('<td>');
1.356     albertel 9343: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 9344: 	    $r->print('</td>');
                   9345: 	}
1.594     raeburn  9346: 	$r->print(&end_data_table_row());
1.31      albertel 9347:     }
1.594     raeburn  9348:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 9349: }
                   9350: 
1.144     matthew  9351: ######################################################
                   9352: ######################################################
                   9353: 
1.56      matthew  9354: =pod
                   9355: 
1.648     raeburn  9356: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       9357: 
                   9358: Prints a table to create associations between values and table columns.
1.144     matthew  9359: 
1.41      ng       9360: $r is an Apache Request ref,
                   9361: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  9362: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       9363: 
                   9364: =cut
                   9365: 
1.144     matthew  9366: ######################################################
                   9367: ######################################################
1.31      albertel 9368: sub csv_print_select_table {
                   9369:     my ($r,$records,$d) = @_;
1.301     albertel 9370:     my $i=0;
                   9371:     my $samples = &get_samples($records,1);
1.144     matthew  9372:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  9373: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  9374:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  9375:               '<th>'.&mt('Column').'</th>'.
                   9376:               &end_data_table_header_row()."\n");
1.356     albertel 9377:     foreach my $array_ref (@$d) {
                   9378: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  9379: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 9380: 
1.875     bisitz   9381: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  9382: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 9383: 	$r->print('<option value="none"></option>');
1.356     albertel 9384: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   9385: 	    $r->print('<option value="'.$sample.'"'.
                   9386:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   9387:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 9388: 	}
1.594     raeburn  9389: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 9390: 	$i++;
                   9391:     }
1.594     raeburn  9392:     $r->print(&end_data_table());
1.31      albertel 9393:     $i--;
                   9394:     return $i;
                   9395: }
1.56      matthew  9396: 
1.144     matthew  9397: ######################################################
                   9398: ######################################################
                   9399: 
1.56      matthew  9400: =pod
1.31      albertel 9401: 
1.648     raeburn  9402: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       9403: 
                   9404: Prints a table of sample values from the upload and can make associate samples to internal names.
                   9405: 
                   9406: $r is an Apache Request ref,
                   9407: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   9408: $d is an array of 2 element arrays (internal name, displayed name)
                   9409: 
                   9410: =cut
                   9411: 
1.144     matthew  9412: ######################################################
                   9413: ######################################################
1.31      albertel 9414: sub csv_samples_select_table {
                   9415:     my ($r,$records,$d) = @_;
                   9416:     my $i=0;
1.144     matthew  9417:     #
1.662     bisitz   9418:     my $max_samples = 5;
                   9419:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  9420:     $r->print(&start_data_table().
                   9421:               &start_data_table_header_row().'<th>'.
                   9422:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   9423:               &end_data_table_header_row());
1.301     albertel 9424: 
                   9425:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  9426: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  9427: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 9428: 	foreach my $option (@$d) {
                   9429: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  9430: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 9431:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  9432:                       $display.'</option>');
1.31      albertel 9433: 	}
                   9434: 	$r->print('</select></td><td>');
1.662     bisitz   9435: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 9436: 	    if (defined($samples->[$line]{$key})) { 
                   9437: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   9438: 	    }
                   9439: 	}
1.594     raeburn  9440: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 9441: 	$i++;
                   9442:     }
1.594     raeburn  9443:     $r->print(&end_data_table());
1.31      albertel 9444:     $i--;
                   9445:     return($i);
1.115     matthew  9446: }
                   9447: 
1.144     matthew  9448: ######################################################
                   9449: ######################################################
                   9450: 
1.115     matthew  9451: =pod
                   9452: 
1.648     raeburn  9453: =item * &clean_excel_name($name)
1.115     matthew  9454: 
                   9455: Returns a replacement for $name which does not contain any illegal characters.
                   9456: 
                   9457: =cut
                   9458: 
1.144     matthew  9459: ######################################################
                   9460: ######################################################
1.115     matthew  9461: sub clean_excel_name {
                   9462:     my ($name) = @_;
                   9463:     $name =~ s/[:\*\?\/\\]//g;
                   9464:     if (length($name) > 31) {
                   9465:         $name = substr($name,0,31);
                   9466:     }
                   9467:     return $name;
1.25      albertel 9468: }
1.84      albertel 9469: 
1.85      albertel 9470: =pod
                   9471: 
1.648     raeburn  9472: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 9473: 
                   9474: Returns either 1 or undef
                   9475: 
                   9476: 1 if the part is to be hidden, undef if it is to be shown
                   9477: 
                   9478: Arguments are:
                   9479: 
                   9480: $id the id of the part to be checked
                   9481: $symb, optional the symb of the resource to check
                   9482: $udom, optional the domain of the user to check for
                   9483: $uname, optional the username of the user to check for
                   9484: 
                   9485: =cut
1.84      albertel 9486: 
                   9487: sub check_if_partid_hidden {
                   9488:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 9489:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 9490: 					 $symb,$udom,$uname);
1.141     albertel 9491:     my $truth=1;
                   9492:     #if the string starts with !, then the list is the list to show not hide
                   9493:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 9494:     my @hiddenlist=split(/,/,$hiddenparts);
                   9495:     foreach my $checkid (@hiddenlist) {
1.141     albertel 9496: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 9497:     }
1.141     albertel 9498:     return !$truth;
1.84      albertel 9499: }
1.127     matthew  9500: 
1.138     matthew  9501: 
                   9502: ############################################################
                   9503: ############################################################
                   9504: 
                   9505: =pod
                   9506: 
1.157     matthew  9507: =back 
                   9508: 
1.138     matthew  9509: =head1 cgi-bin script and graphing routines
                   9510: 
1.157     matthew  9511: =over 4
                   9512: 
1.648     raeburn  9513: =item * &get_cgi_id()
1.138     matthew  9514: 
                   9515: Inputs: none
                   9516: 
                   9517: Returns an id which can be used to pass environment variables
                   9518: to various cgi-bin scripts.  These environment variables will
                   9519: be removed from the users environment after a given time by
                   9520: the routine &Apache::lonnet::transfer_profile_to_env.
                   9521: 
                   9522: =cut
                   9523: 
                   9524: ############################################################
                   9525: ############################################################
1.152     albertel 9526: my $uniq=0;
1.136     matthew  9527: sub get_cgi_id {
1.154     albertel 9528:     $uniq=($uniq+1)%100000;
1.280     albertel 9529:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  9530: }
                   9531: 
1.127     matthew  9532: ############################################################
                   9533: ############################################################
                   9534: 
                   9535: =pod
                   9536: 
1.648     raeburn  9537: =item * &DrawBarGraph()
1.127     matthew  9538: 
1.138     matthew  9539: Facilitates the plotting of data in a (stacked) bar graph.
                   9540: Puts plot definition data into the users environment in order for 
                   9541: graph.png to plot it.  Returns an <img> tag for the plot.
                   9542: The bars on the plot are labeled '1','2',...,'n'.
                   9543: 
                   9544: Inputs:
                   9545: 
                   9546: =over 4
                   9547: 
                   9548: =item $Title: string, the title of the plot
                   9549: 
                   9550: =item $xlabel: string, text describing the X-axis of the plot
                   9551: 
                   9552: =item $ylabel: string, text describing the Y-axis of the plot
                   9553: 
                   9554: =item $Max: scalar, the maximum Y value to use in the plot
                   9555: If $Max is < any data point, the graph will not be rendered.
                   9556: 
1.140     matthew  9557: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  9558: they are plotted.  If undefined, default values will be used.
                   9559: 
1.178     matthew  9560: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   9561: 
1.138     matthew  9562: =item @Values: An array of array references.  Each array reference holds data
                   9563: to be plotted in a stacked bar chart.
                   9564: 
1.239     matthew  9565: =item If the final element of @Values is a hash reference the key/value
                   9566: pairs will be added to the graph definition.
                   9567: 
1.138     matthew  9568: =back
                   9569: 
                   9570: Returns:
                   9571: 
                   9572: An <img> tag which references graph.png and the appropriate identifying
                   9573: information for the plot.
                   9574: 
1.127     matthew  9575: =cut
                   9576: 
                   9577: ############################################################
                   9578: ############################################################
1.134     matthew  9579: sub DrawBarGraph {
1.178     matthew  9580:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  9581:     #
                   9582:     if (! defined($colors)) {
                   9583:         $colors = ['#33ff00', 
                   9584:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   9585:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   9586:                   ]; 
                   9587:     }
1.228     matthew  9588:     my $extra_settings = {};
                   9589:     if (ref($Values[-1]) eq 'HASH') {
                   9590:         $extra_settings = pop(@Values);
                   9591:     }
1.127     matthew  9592:     #
1.136     matthew  9593:     my $identifier = &get_cgi_id();
                   9594:     my $id = 'cgi.'.$identifier;        
1.129     matthew  9595:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  9596:         return '';
                   9597:     }
1.225     matthew  9598:     #
                   9599:     my @Labels;
                   9600:     if (defined($labels)) {
                   9601:         @Labels = @$labels;
                   9602:     } else {
                   9603:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   9604:             push (@Labels,$i+1);
                   9605:         }
                   9606:     }
                   9607:     #
1.129     matthew  9608:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  9609:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  9610:     my %ValuesHash;
                   9611:     my $NumSets=1;
                   9612:     foreach my $array (@Values) {
                   9613:         next if (! ref($array));
1.136     matthew  9614:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  9615:             join(',',@$array);
1.129     matthew  9616:     }
1.127     matthew  9617:     #
1.136     matthew  9618:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  9619:     if ($NumBars < 3) {
                   9620:         $width = 120+$NumBars*32;
1.220     matthew  9621:         $xskip = 1;
1.225     matthew  9622:         $bar_width = 30;
                   9623:     } elsif ($NumBars < 5) {
                   9624:         $width = 120+$NumBars*20;
                   9625:         $xskip = 1;
                   9626:         $bar_width = 20;
1.220     matthew  9627:     } elsif ($NumBars < 10) {
1.136     matthew  9628:         $width = 120+$NumBars*15;
                   9629:         $xskip = 1;
                   9630:         $bar_width = 15;
                   9631:     } elsif ($NumBars <= 25) {
                   9632:         $width = 120+$NumBars*11;
                   9633:         $xskip = 5;
                   9634:         $bar_width = 8;
                   9635:     } elsif ($NumBars <= 50) {
                   9636:         $width = 120+$NumBars*8;
                   9637:         $xskip = 5;
                   9638:         $bar_width = 4;
                   9639:     } else {
                   9640:         $width = 120+$NumBars*8;
                   9641:         $xskip = 5;
                   9642:         $bar_width = 4;
                   9643:     }
                   9644:     #
1.137     matthew  9645:     $Max = 1 if ($Max < 1);
                   9646:     if ( int($Max) < $Max ) {
                   9647:         $Max++;
                   9648:         $Max = int($Max);
                   9649:     }
1.127     matthew  9650:     $Title  = '' if (! defined($Title));
                   9651:     $xlabel = '' if (! defined($xlabel));
                   9652:     $ylabel = '' if (! defined($ylabel));
1.369     www      9653:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   9654:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   9655:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  9656:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  9657:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   9658:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   9659:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   9660:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9661:     $ValuesHash{$id.'.height'}   = $height;
                   9662:     $ValuesHash{$id.'.width'}    = $width;
                   9663:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   9664:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   9665:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  9666:     #
1.228     matthew  9667:     # Deal with other parameters
                   9668:     while (my ($key,$value) = each(%$extra_settings)) {
                   9669:         $ValuesHash{$id.'.'.$key} = $value;
                   9670:     }
                   9671:     #
1.646     raeburn  9672:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  9673:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9674: }
                   9675: 
                   9676: ############################################################
                   9677: ############################################################
                   9678: 
                   9679: =pod
                   9680: 
1.648     raeburn  9681: =item * &DrawXYGraph()
1.137     matthew  9682: 
1.138     matthew  9683: Facilitates the plotting of data in an XY graph.
                   9684: Puts plot definition data into the users environment in order for 
                   9685: graph.png to plot it.  Returns an <img> tag for the plot.
                   9686: 
                   9687: Inputs:
                   9688: 
                   9689: =over 4
                   9690: 
                   9691: =item $Title: string, the title of the plot
                   9692: 
                   9693: =item $xlabel: string, text describing the X-axis of the plot
                   9694: 
                   9695: =item $ylabel: string, text describing the Y-axis of the plot
                   9696: 
                   9697: =item $Max: scalar, the maximum Y value to use in the plot
                   9698: If $Max is < any data point, the graph will not be rendered.
                   9699: 
                   9700: =item $colors: Array ref containing the hex color codes for the data to be 
                   9701: plotted in.  If undefined, default values will be used.
                   9702: 
                   9703: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9704: 
                   9705: =item $Ydata: Array ref containing Array refs.  
1.185     www      9706: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  9707: 
                   9708: =item %Values: hash indicating or overriding any default values which are 
                   9709: passed to graph.png.  
                   9710: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9711: 
                   9712: =back
                   9713: 
                   9714: Returns:
                   9715: 
                   9716: An <img> tag which references graph.png and the appropriate identifying
                   9717: information for the plot.
                   9718: 
1.137     matthew  9719: =cut
                   9720: 
                   9721: ############################################################
                   9722: ############################################################
                   9723: sub DrawXYGraph {
                   9724:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   9725:     #
                   9726:     # Create the identifier for the graph
                   9727:     my $identifier = &get_cgi_id();
                   9728:     my $id = 'cgi.'.$identifier;
                   9729:     #
                   9730:     $Title  = '' if (! defined($Title));
                   9731:     $xlabel = '' if (! defined($xlabel));
                   9732:     $ylabel = '' if (! defined($ylabel));
                   9733:     my %ValuesHash = 
                   9734:         (
1.369     www      9735:          $id.'.title'  => &escape($Title),
                   9736:          $id.'.xlabel' => &escape($xlabel),
                   9737:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  9738:          $id.'.y_max_value'=> $Max,
                   9739:          $id.'.labels'     => join(',',@$Xlabels),
                   9740:          $id.'.PlotType'   => 'XY',
                   9741:          );
                   9742:     #
                   9743:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   9744:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9745:     }
                   9746:     #
                   9747:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   9748:         return '';
                   9749:     }
                   9750:     my $NumSets=1;
1.138     matthew  9751:     foreach my $array (@{$Ydata}){
1.137     matthew  9752:         next if (! ref($array));
                   9753:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   9754:     }
1.138     matthew  9755:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  9756:     #
                   9757:     # Deal with other parameters
                   9758:     while (my ($key,$value) = each(%Values)) {
                   9759:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  9760:     }
                   9761:     #
1.646     raeburn  9762:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  9763:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   9764: }
                   9765: 
                   9766: ############################################################
                   9767: ############################################################
                   9768: 
                   9769: =pod
                   9770: 
1.648     raeburn  9771: =item * &DrawXYYGraph()
1.138     matthew  9772: 
                   9773: Facilitates the plotting of data in an XY graph with two Y axes.
                   9774: Puts plot definition data into the users environment in order for 
                   9775: graph.png to plot it.  Returns an <img> tag for the plot.
                   9776: 
                   9777: Inputs:
                   9778: 
                   9779: =over 4
                   9780: 
                   9781: =item $Title: string, the title of the plot
                   9782: 
                   9783: =item $xlabel: string, text describing the X-axis of the plot
                   9784: 
                   9785: =item $ylabel: string, text describing the Y-axis of the plot
                   9786: 
                   9787: =item $colors: Array ref containing the hex color codes for the data to be 
                   9788: plotted in.  If undefined, default values will be used.
                   9789: 
                   9790: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   9791: 
                   9792: =item $Ydata1: The first data set
                   9793: 
                   9794: =item $Min1: The minimum value of the left Y-axis
                   9795: 
                   9796: =item $Max1: The maximum value of the left Y-axis
                   9797: 
                   9798: =item $Ydata2: The second data set
                   9799: 
                   9800: =item $Min2: The minimum value of the right Y-axis
                   9801: 
                   9802: =item $Max2: The maximum value of the left Y-axis
                   9803: 
                   9804: =item %Values: hash indicating or overriding any default values which are 
                   9805: passed to graph.png.  
                   9806: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   9807: 
                   9808: =back
                   9809: 
                   9810: Returns:
                   9811: 
                   9812: An <img> tag which references graph.png and the appropriate identifying
                   9813: information for the plot.
1.136     matthew  9814: 
                   9815: =cut
                   9816: 
                   9817: ############################################################
                   9818: ############################################################
1.137     matthew  9819: sub DrawXYYGraph {
                   9820:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   9821:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  9822:     #
                   9823:     # Create the identifier for the graph
                   9824:     my $identifier = &get_cgi_id();
                   9825:     my $id = 'cgi.'.$identifier;
                   9826:     #
                   9827:     $Title  = '' if (! defined($Title));
                   9828:     $xlabel = '' if (! defined($xlabel));
                   9829:     $ylabel = '' if (! defined($ylabel));
                   9830:     my %ValuesHash = 
                   9831:         (
1.369     www      9832:          $id.'.title'  => &escape($Title),
                   9833:          $id.'.xlabel' => &escape($xlabel),
                   9834:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  9835:          $id.'.labels' => join(',',@$Xlabels),
                   9836:          $id.'.PlotType' => 'XY',
                   9837:          $id.'.NumSets' => 2,
1.137     matthew  9838:          $id.'.two_axes' => 1,
                   9839:          $id.'.y1_max_value' => $Max1,
                   9840:          $id.'.y1_min_value' => $Min1,
                   9841:          $id.'.y2_max_value' => $Max2,
                   9842:          $id.'.y2_min_value' => $Min2,
1.136     matthew  9843:          );
                   9844:     #
1.137     matthew  9845:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   9846:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   9847:     }
                   9848:     #
                   9849:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   9850:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  9851:         return '';
                   9852:     }
                   9853:     my $NumSets=1;
1.137     matthew  9854:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  9855:         next if (! ref($array));
                   9856:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  9857:     }
                   9858:     #
                   9859:     # Deal with other parameters
                   9860:     while (my ($key,$value) = each(%Values)) {
                   9861:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  9862:     }
                   9863:     #
1.646     raeburn  9864:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 9865:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  9866: }
                   9867: 
                   9868: ############################################################
                   9869: ############################################################
                   9870: 
                   9871: =pod
                   9872: 
1.157     matthew  9873: =back 
                   9874: 
1.139     matthew  9875: =head1 Statistics helper routines?  
                   9876: 
                   9877: Bad place for them but what the hell.
                   9878: 
1.157     matthew  9879: =over 4
                   9880: 
1.648     raeburn  9881: =item * &chartlink()
1.139     matthew  9882: 
                   9883: Returns a link to the chart for a specific student.  
                   9884: 
                   9885: Inputs:
                   9886: 
                   9887: =over 4
                   9888: 
                   9889: =item $linktext: The text of the link
                   9890: 
                   9891: =item $sname: The students username
                   9892: 
                   9893: =item $sdomain: The students domain
                   9894: 
                   9895: =back
                   9896: 
1.157     matthew  9897: =back
                   9898: 
1.139     matthew  9899: =cut
                   9900: 
                   9901: ############################################################
                   9902: ############################################################
                   9903: sub chartlink {
                   9904:     my ($linktext, $sname, $sdomain) = @_;
                   9905:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      9906:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 9907:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  9908:        '">'.$linktext.'</a>';
1.153     matthew  9909: }
                   9910: 
                   9911: #######################################################
                   9912: #######################################################
                   9913: 
                   9914: =pod
                   9915: 
                   9916: =head1 Course Environment Routines
1.157     matthew  9917: 
                   9918: =over 4
1.153     matthew  9919: 
1.648     raeburn  9920: =item * &restore_course_settings()
1.153     matthew  9921: 
1.648     raeburn  9922: =item * &store_course_settings()
1.153     matthew  9923: 
                   9924: Restores/Store indicated form parameters from the course environment.
                   9925: Will not overwrite existing values of the form parameters.
                   9926: 
                   9927: Inputs: 
                   9928: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   9929: 
                   9930: a hash ref describing the data to be stored.  For example:
                   9931:    
                   9932: %Save_Parameters = ('Status' => 'scalar',
                   9933:     'chartoutputmode' => 'scalar',
                   9934:     'chartoutputdata' => 'scalar',
                   9935:     'Section' => 'array',
1.373     raeburn  9936:     'Group' => 'array',
1.153     matthew  9937:     'StudentData' => 'array',
                   9938:     'Maps' => 'array');
                   9939: 
                   9940: Returns: both routines return nothing
                   9941: 
1.631     raeburn  9942: =back
                   9943: 
1.153     matthew  9944: =cut
                   9945: 
                   9946: #######################################################
                   9947: #######################################################
                   9948: sub store_course_settings {
1.496     albertel 9949:     return &store_settings($env{'request.course.id'},@_);
                   9950: }
                   9951: 
                   9952: sub store_settings {
1.153     matthew  9953:     # save to the environment
                   9954:     # appenv the same items, just to be safe
1.300     albertel 9955:     my $udom  = $env{'user.domain'};
                   9956:     my $uname = $env{'user.name'};
1.496     albertel 9957:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  9958:     my %SaveHash;
                   9959:     my %AppHash;
                   9960:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 9961:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 9962:         my $envname = 'environment.'.$basename;
1.258     albertel 9963:         if (exists($env{'form.'.$setting})) {
1.153     matthew  9964:             # Save this value away
                   9965:             if ($type eq 'scalar' &&
1.258     albertel 9966:                 (! exists($env{$envname}) || 
                   9967:                  $env{$envname} ne $env{'form.'.$setting})) {
                   9968:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   9969:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  9970:             } elsif ($type eq 'array') {
                   9971:                 my $stored_form;
1.258     albertel 9972:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  9973:                     $stored_form = join(',',
                   9974:                                         map {
1.369     www      9975:                                             &escape($_);
1.258     albertel 9976:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  9977:                 } else {
                   9978:                     $stored_form = 
1.369     www      9979:                         &escape($env{'form.'.$setting});
1.153     matthew  9980:                 }
                   9981:                 # Determine if the array contents are the same.
1.258     albertel 9982:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  9983:                     $SaveHash{$basename} = $stored_form;
                   9984:                     $AppHash{$envname}   = $stored_form;
                   9985:                 }
                   9986:             }
                   9987:         }
                   9988:     }
                   9989:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 9990:                                           $udom,$uname);
1.153     matthew  9991:     if ($put_result !~ /^(ok|delayed)/) {
                   9992:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   9993:                                  'got error:'.$put_result);
                   9994:     }
                   9995:     # Make sure these settings stick around in this session, too
1.646     raeburn  9996:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  9997:     return;
                   9998: }
                   9999: 
                   10000: sub restore_course_settings {
1.499     albertel 10001:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 10002: }
                   10003: 
                   10004: sub restore_settings {
                   10005:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  10006:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 10007:         next if (exists($env{'form.'.$setting}));
1.496     albertel 10008:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  10009:             '.'.$setting;
1.258     albertel 10010:         if (exists($env{$envname})) {
1.153     matthew  10011:             if ($type eq 'scalar') {
1.258     albertel 10012:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  10013:             } elsif ($type eq 'array') {
1.258     albertel 10014:                 $env{'form.'.$setting} = [ 
1.153     matthew  10015:                                            map { 
1.369     www      10016:                                                &unescape($_); 
1.258     albertel 10017:                                            } split(',',$env{$envname})
1.153     matthew  10018:                                            ];
                   10019:             }
                   10020:         }
                   10021:     }
1.127     matthew  10022: }
                   10023: 
1.618     raeburn  10024: #######################################################
                   10025: #######################################################
                   10026: 
                   10027: =pod
                   10028: 
                   10029: =head1 Domain E-mail Routines  
                   10030: 
                   10031: =over 4
                   10032: 
1.648     raeburn  10033: =item * &build_recipient_list()
1.618     raeburn  10034: 
1.884     raeburn  10035: Build recipient lists for five types of e-mail:
1.766     raeburn  10036: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  10037: (d) Help requests, (e) Course requests needing approval,  generated by
                   10038: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   10039: loncoursequeueadmin.pm respectively.
1.618     raeburn  10040: 
                   10041: Inputs:
1.619     raeburn  10042: defmail (scalar - email address of default recipient), 
1.618     raeburn  10043: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  10044: defdom (domain for which to retrieve configuration settings),
                   10045: origmail (scalar - email address of recipient from loncapa.conf, 
                   10046: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  10047: 
1.655     raeburn  10048: Returns: comma separated list of addresses to which to send e-mail.
                   10049: 
                   10050: =back
1.618     raeburn  10051: 
                   10052: =cut
                   10053: 
                   10054: ############################################################
                   10055: ############################################################
                   10056: sub build_recipient_list {
1.619     raeburn  10057:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  10058:     my @recipients;
                   10059:     my $otheremails;
                   10060:     my %domconfig =
                   10061:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   10062:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  10063:         if (exists($domconfig{'contacts'}{$mailing})) {
                   10064:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   10065:                 my @contacts = ('adminemail','supportemail');
                   10066:                 foreach my $item (@contacts) {
                   10067:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   10068:                         my $addr = $domconfig{'contacts'}{$item}; 
                   10069:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10070:                             push(@recipients,$addr);
                   10071:                         }
1.619     raeburn  10072:                     }
1.766     raeburn  10073:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  10074:                 }
                   10075:             }
1.766     raeburn  10076:         } elsif ($origmail ne '') {
                   10077:             push(@recipients,$origmail);
1.618     raeburn  10078:         }
1.619     raeburn  10079:     } elsif ($origmail ne '') {
                   10080:         push(@recipients,$origmail);
1.618     raeburn  10081:     }
1.688     raeburn  10082:     if (defined($defmail)) {
                   10083:         if ($defmail ne '') {
                   10084:             push(@recipients,$defmail);
                   10085:         }
1.618     raeburn  10086:     }
                   10087:     if ($otheremails) {
1.619     raeburn  10088:         my @others;
                   10089:         if ($otheremails =~ /,/) {
                   10090:             @others = split(/,/,$otheremails);
1.618     raeburn  10091:         } else {
1.619     raeburn  10092:             push(@others,$otheremails);
                   10093:         }
                   10094:         foreach my $addr (@others) {
                   10095:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   10096:                 push(@recipients,$addr);
                   10097:             }
1.618     raeburn  10098:         }
                   10099:     }
1.619     raeburn  10100:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  10101:     return $recipientlist;
                   10102: }
                   10103: 
1.127     matthew  10104: ############################################################
                   10105: ############################################################
1.154     albertel 10106: 
1.655     raeburn  10107: =pod
                   10108: 
                   10109: =head1 Course Catalog Routines
                   10110: 
                   10111: =over 4
                   10112: 
                   10113: =item * &gather_categories()
                   10114: 
                   10115: Converts category definitions - keys of categories hash stored in  
                   10116: coursecategories in configuration.db on the primary library server in a 
                   10117: domain - to an array.  Also generates javascript and idx hash used to 
                   10118: generate Domain Coordinator interface for editing Course Categories.
                   10119: 
                   10120: Inputs:
1.663     raeburn  10121: 
1.655     raeburn  10122: categories (reference to hash of category definitions).
1.663     raeburn  10123: 
1.655     raeburn  10124: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10125:       categories and subcategories).
1.663     raeburn  10126: 
1.655     raeburn  10127: idx (reference to hash of counters used in Domain Coordinator interface for 
                   10128:       editing Course Categories).
1.663     raeburn  10129: 
1.655     raeburn  10130: jsarray (reference to array of categories used to create Javascript arrays for
                   10131:          Domain Coordinator interface for editing Course Categories).
                   10132: 
                   10133: Returns: nothing
                   10134: 
                   10135: Side effects: populates cats, idx and jsarray. 
                   10136: 
                   10137: =cut
                   10138: 
                   10139: sub gather_categories {
                   10140:     my ($categories,$cats,$idx,$jsarray) = @_;
                   10141:     my %counters;
                   10142:     my $num = 0;
                   10143:     foreach my $item (keys(%{$categories})) {
                   10144:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   10145:         if ($container eq '' && $depth == 0) {
                   10146:             $cats->[$depth][$categories->{$item}] = $cat;
                   10147:         } else {
                   10148:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   10149:         }
                   10150:         my ($escitem,$tail) = split(/:/,$item,2);
                   10151:         if ($counters{$tail} eq '') {
                   10152:             $counters{$tail} = $num;
                   10153:             $num ++;
                   10154:         }
                   10155:         if (ref($idx) eq 'HASH') {
                   10156:             $idx->{$item} = $counters{$tail};
                   10157:         }
                   10158:         if (ref($jsarray) eq 'ARRAY') {
                   10159:             push(@{$jsarray->[$counters{$tail}]},$item);
                   10160:         }
                   10161:     }
                   10162:     return;
                   10163: }
                   10164: 
                   10165: =pod
                   10166: 
                   10167: =item * &extract_categories()
                   10168: 
                   10169: Used to generate breadcrumb trails for course categories.
                   10170: 
                   10171: Inputs:
1.663     raeburn  10172: 
1.655     raeburn  10173: categories (reference to hash of category definitions).
1.663     raeburn  10174: 
1.655     raeburn  10175: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10176:       categories and subcategories).
1.663     raeburn  10177: 
1.655     raeburn  10178: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  10179: 
1.655     raeburn  10180: allitems (reference to hash - key is category key 
                   10181:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10182: 
1.655     raeburn  10183: idx (reference to hash of counters used in Domain Coordinator interface for
                   10184:       editing Course Categories).
1.663     raeburn  10185: 
1.655     raeburn  10186: jsarray (reference to array of categories used to create Javascript arrays for
                   10187:          Domain Coordinator interface for editing Course Categories).
                   10188: 
1.665     raeburn  10189: subcats (reference to hash of arrays containing all subcategories within each 
                   10190:          category, -recursive)
                   10191: 
1.655     raeburn  10192: Returns: nothing
                   10193: 
                   10194: Side effects: populates trails and allitems hash references.
                   10195: 
                   10196: =cut
                   10197: 
                   10198: sub extract_categories {
1.665     raeburn  10199:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  10200:     if (ref($categories) eq 'HASH') {
                   10201:         &gather_categories($categories,$cats,$idx,$jsarray);
                   10202:         if (ref($cats->[0]) eq 'ARRAY') {
                   10203:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   10204:                 my $name = $cats->[0][$i];
                   10205:                 my $item = &escape($name).'::0';
                   10206:                 my $trailstr;
                   10207:                 if ($name eq 'instcode') {
                   10208:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  10209:                 } elsif ($name eq 'communities') {
                   10210:                     $trailstr = &mt('Communities');
1.655     raeburn  10211:                 } else {
                   10212:                     $trailstr = $name;
                   10213:                 }
                   10214:                 if ($allitems->{$item} eq '') {
                   10215:                     push(@{$trails},$trailstr);
                   10216:                     $allitems->{$item} = scalar(@{$trails})-1;
                   10217:                 }
                   10218:                 my @parents = ($name);
                   10219:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   10220:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   10221:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  10222:                         if (ref($subcats) eq 'HASH') {
                   10223:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   10224:                         }
                   10225:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   10226:                     }
                   10227:                 } else {
                   10228:                     if (ref($subcats) eq 'HASH') {
                   10229:                         $subcats->{$item} = [];
1.655     raeburn  10230:                     }
                   10231:                 }
                   10232:             }
                   10233:         }
                   10234:     }
                   10235:     return;
                   10236: }
                   10237: 
                   10238: =pod
                   10239: 
                   10240: =item *&recurse_categories()
                   10241: 
                   10242: Recursively used to generate breadcrumb trails for course categories.
                   10243: 
                   10244: Inputs:
1.663     raeburn  10245: 
1.655     raeburn  10246: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   10247:       categories and subcategories).
1.663     raeburn  10248: 
1.655     raeburn  10249: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  10250: 
                   10251: category (current course category, for which breadcrumb trail is being generated).
                   10252: 
                   10253: trails (reference to array of breadcrumb trails for each category).
                   10254: 
1.655     raeburn  10255: allitems (reference to hash - key is category key
                   10256:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  10257: 
1.655     raeburn  10258: parents (array containing containers directories for current category, 
                   10259:          back to top level). 
                   10260: 
                   10261: Returns: nothing
                   10262: 
                   10263: Side effects: populates trails and allitems hash references
                   10264: 
                   10265: =cut
                   10266: 
                   10267: sub recurse_categories {
1.665     raeburn  10268:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  10269:     my $shallower = $depth - 1;
                   10270:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   10271:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   10272:             my $name = $cats->[$depth]{$category}[$k];
                   10273:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10274:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10275:             if ($allitems->{$item} eq '') {
                   10276:                 push(@{$trails},$trailstr);
                   10277:                 $allitems->{$item} = scalar(@{$trails})-1;
                   10278:             }
                   10279:             my $deeper = $depth+1;
                   10280:             push(@{$parents},$category);
1.665     raeburn  10281:             if (ref($subcats) eq 'HASH') {
                   10282:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   10283:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   10284:                     my $higher;
                   10285:                     if ($j > 0) {
                   10286:                         $higher = &escape($parents->[$j]).':'.
                   10287:                                   &escape($parents->[$j-1]).':'.$j;
                   10288:                     } else {
                   10289:                         $higher = &escape($parents->[$j]).'::'.$j;
                   10290:                     }
                   10291:                     push(@{$subcats->{$higher}},$subcat);
                   10292:                 }
                   10293:             }
                   10294:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   10295:                                 $subcats);
1.655     raeburn  10296:             pop(@{$parents});
                   10297:         }
                   10298:     } else {
                   10299:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   10300:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   10301:         if ($allitems->{$item} eq '') {
                   10302:             push(@{$trails},$trailstr);
                   10303:             $allitems->{$item} = scalar(@{$trails})-1;
                   10304:         }
                   10305:     }
                   10306:     return;
                   10307: }
                   10308: 
1.663     raeburn  10309: =pod
                   10310: 
                   10311: =item *&assign_categories_table()
                   10312: 
                   10313: Create a datatable for display of hierarchical categories in a domain,
                   10314: with checkboxes to allow a course to be categorized. 
                   10315: 
                   10316: Inputs:
                   10317: 
                   10318: cathash - reference to hash of categories defined for the domain (from
                   10319:           configuration.db)
                   10320: 
                   10321: currcat - scalar with an & separated list of categories assigned to a course. 
                   10322: 
1.919     raeburn  10323: type    - scalar contains course type (Course or Community).
                   10324: 
1.663     raeburn  10325: Returns: $output (markup to be displayed) 
                   10326: 
                   10327: =cut
                   10328: 
                   10329: sub assign_categories_table {
1.919     raeburn  10330:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  10331:     my $output;
                   10332:     if (ref($cathash) eq 'HASH') {
                   10333:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   10334:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   10335:         $maxdepth = scalar(@cats);
                   10336:         if (@cats > 0) {
                   10337:             my $itemcount = 0;
                   10338:             if (ref($cats[0]) eq 'ARRAY') {
                   10339:                 my @currcategories;
                   10340:                 if ($currcat ne '') {
                   10341:                     @currcategories = split('&',$currcat);
                   10342:                 }
1.919     raeburn  10343:                 my $table;
1.663     raeburn  10344:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   10345:                     my $parent = $cats[0][$i];
1.919     raeburn  10346:                     next if ($parent eq 'instcode');
                   10347:                     if ($type eq 'Community') {
                   10348:                         next unless ($parent eq 'communities');
                   10349:                     } else {
                   10350:                         next if ($parent eq 'communities');
                   10351:                     }
1.663     raeburn  10352:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10353:                     my $item = &escape($parent).'::0';
                   10354:                     my $checked = '';
                   10355:                     if (@currcategories > 0) {
                   10356:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   10357:                             $checked = ' checked="checked"';
1.663     raeburn  10358:                         }
                   10359:                     }
1.919     raeburn  10360:                     my $parent_title = $parent;
                   10361:                     if ($parent eq 'communities') {
                   10362:                         $parent_title = &mt('Communities');
                   10363:                     }
                   10364:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   10365:                               '<input type="checkbox" name="usecategory" value="'.
                   10366:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   10367:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  10368:                     my $depth = 1;
                   10369:                     push(@path,$parent);
1.919     raeburn  10370:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  10371:                     pop(@path);
1.919     raeburn  10372:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  10373:                     $itemcount ++;
                   10374:                 }
1.919     raeburn  10375:                 if ($itemcount) {
                   10376:                     $output = &Apache::loncommon::start_data_table().
                   10377:                               $table.
                   10378:                               &Apache::loncommon::end_data_table();
                   10379:                 }
1.663     raeburn  10380:             }
                   10381:         }
                   10382:     }
                   10383:     return $output;
                   10384: }
                   10385: 
                   10386: =pod
                   10387: 
                   10388: =item *&assign_category_rows()
                   10389: 
                   10390: Create a datatable row for display of nested categories in a domain,
                   10391: with checkboxes to allow a course to be categorized,called recursively.
                   10392: 
                   10393: Inputs:
                   10394: 
                   10395: itemcount - track row number for alternating colors
                   10396: 
                   10397: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   10398:       categories and subcategories.
                   10399: 
                   10400: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   10401: 
                   10402: parent - parent of current category item
                   10403: 
                   10404: path - Array containing all categories back up through the hierarchy from the
                   10405:        current category to the top level.
                   10406: 
                   10407: currcategories - reference to array of current categories assigned to the course
                   10408: 
                   10409: Returns: $output (markup to be displayed).
                   10410: 
                   10411: =cut
                   10412: 
                   10413: sub assign_category_rows {
                   10414:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   10415:     my ($text,$name,$item,$chgstr);
                   10416:     if (ref($cats) eq 'ARRAY') {
                   10417:         my $maxdepth = scalar(@{$cats});
                   10418:         if (ref($cats->[$depth]) eq 'HASH') {
                   10419:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   10420:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   10421:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   10422:                 $text .= '<td><table class="LC_datatable">';
                   10423:                 for (my $j=0; $j<$numchildren; $j++) {
                   10424:                     $name = $cats->[$depth]{$parent}[$j];
                   10425:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   10426:                     my $deeper = $depth+1;
                   10427:                     my $checked = '';
                   10428:                     if (ref($currcategories) eq 'ARRAY') {
                   10429:                         if (@{$currcategories} > 0) {
                   10430:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   10431:                                 $checked = ' checked="checked"';
1.663     raeburn  10432:                             }
                   10433:                         }
                   10434:                     }
1.664     raeburn  10435:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   10436:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  10437:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   10438:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   10439:                              '</td><td>';
1.663     raeburn  10440:                     if (ref($path) eq 'ARRAY') {
                   10441:                         push(@{$path},$name);
                   10442:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   10443:                         pop(@{$path});
                   10444:                     }
                   10445:                     $text .= '</td></tr>';
                   10446:                 }
                   10447:                 $text .= '</table></td>';
                   10448:             }
                   10449:         }
                   10450:     }
                   10451:     return $text;
                   10452: }
                   10453: 
1.655     raeburn  10454: ############################################################
                   10455: ############################################################
                   10456: 
                   10457: 
1.443     albertel 10458: sub commit_customrole {
1.664     raeburn  10459:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  10460:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 10461:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   10462:                          ($end?', ending '.localtime($end):'').': <b>'.
                   10463:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  10464:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 10465:                  '</b><br />';
                   10466:     return $output;
                   10467: }
                   10468: 
                   10469: sub commit_standardrole {
1.541     raeburn  10470:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   10471:     my ($output,$logmsg,$linefeed);
                   10472:     if ($context eq 'auto') {
                   10473:         $linefeed = "\n";
                   10474:     } else {
                   10475:         $linefeed = "<br />\n";
                   10476:     }  
1.443     albertel 10477:     if ($three eq 'st') {
1.541     raeburn  10478:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   10479:                                          $one,$two,$sec,$context);
                   10480:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  10481:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   10482:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 10483:         } else {
1.541     raeburn  10484:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 10485:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  10486:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   10487:             if ($context eq 'auto') {
                   10488:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   10489:             } else {
                   10490:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   10491:                &mt('Add to classlist').': <b>ok</b>';
                   10492:             }
                   10493:             $output .= $linefeed;
1.443     albertel 10494:         }
                   10495:     } else {
                   10496:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   10497:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  10498:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  10499:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  10500:         if ($context eq 'auto') {
                   10501:             $output .= $result.$linefeed;
                   10502:         } else {
                   10503:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   10504:         }
1.443     albertel 10505:     }
                   10506:     return $output;
                   10507: }
                   10508: 
                   10509: sub commit_studentrole {
1.541     raeburn  10510:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  10511:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  10512:     if ($context eq 'auto') {
                   10513:         $linefeed = "\n";
                   10514:     } else {
                   10515:         $linefeed = '<br />'."\n";
                   10516:     }
1.443     albertel 10517:     if (defined($one) && defined($two)) {
                   10518:         my $cid=$one.'_'.$two;
                   10519:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   10520:         my $secchange = 0;
                   10521:         my $expire_role_result;
                   10522:         my $modify_section_result;
1.628     raeburn  10523:         if ($oldsec ne '-1') { 
                   10524:             if ($oldsec ne $sec) {
1.443     albertel 10525:                 $secchange = 1;
1.628     raeburn  10526:                 my $now = time;
1.443     albertel 10527:                 my $uurl='/'.$cid;
                   10528:                 $uurl=~s/\_/\//g;
                   10529:                 if ($oldsec) {
                   10530:                     $uurl.='/'.$oldsec;
                   10531:                 }
1.626     raeburn  10532:                 $oldsecurl = $uurl;
1.628     raeburn  10533:                 $expire_role_result = 
1.652     raeburn  10534:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  10535:                 if ($env{'request.course.sec'} ne '') { 
                   10536:                     if ($expire_role_result eq 'refused') {
                   10537:                         my @roles = ('st');
                   10538:                         my @statuses = ('previous');
                   10539:                         my @roledoms = ($one);
                   10540:                         my $withsec = 1;
                   10541:                         my %roleshash = 
                   10542:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   10543:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   10544:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   10545:                             my ($oldstart,$oldend) = 
                   10546:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   10547:                             if ($oldend > 0 && $oldend <= $now) {
                   10548:                                 $expire_role_result = 'ok';
                   10549:                             }
                   10550:                         }
                   10551:                     }
                   10552:                 }
1.443     albertel 10553:                 $result = $expire_role_result;
                   10554:             }
                   10555:         }
                   10556:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  10557:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 10558:             if ($modify_section_result =~ /^ok/) {
                   10559:                 if ($secchange == 1) {
1.628     raeburn  10560:                     if ($sec eq '') {
                   10561:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   10562:                     } else {
                   10563:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   10564:                     }
1.443     albertel 10565:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  10566:                     if ($sec eq '') {
                   10567:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   10568:                     } else {
                   10569:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10570:                     }
1.443     albertel 10571:                 } else {
1.628     raeburn  10572:                     if ($sec eq '') {
                   10573:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   10574:                     } else {
                   10575:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   10576:                     }
1.443     albertel 10577:                 }
                   10578:             } else {
1.628     raeburn  10579:                 if ($secchange) {       
                   10580:                     $$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;
                   10581:                 } else {
                   10582:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   10583:                 }
1.443     albertel 10584:             }
                   10585:             $result = $modify_section_result;
                   10586:         } elsif ($secchange == 1) {
1.628     raeburn  10587:             if ($oldsec eq '') {
                   10588:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   10589:             } else {
                   10590:                 $$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;
                   10591:             }
1.626     raeburn  10592:             if ($expire_role_result eq 'refused') {
                   10593:                 my $newsecurl = '/'.$cid;
                   10594:                 $newsecurl =~ s/\_/\//g;
                   10595:                 if ($sec ne '') {
                   10596:                     $newsecurl.='/'.$sec;
                   10597:                 }
                   10598:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   10599:                     if ($sec eq '') {
                   10600:                         $$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;
                   10601:                     } else {
                   10602:                         $$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;
                   10603:                     }
                   10604:                 }
                   10605:             }
1.443     albertel 10606:         }
                   10607:     } else {
1.626     raeburn  10608:         $$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 10609:         $result = "error: incomplete course id\n";
                   10610:     }
                   10611:     return $result;
                   10612: }
                   10613: 
                   10614: ############################################################
                   10615: ############################################################
                   10616: 
1.566     albertel 10617: sub check_clone {
1.578     raeburn  10618:     my ($args,$linefeed) = @_;
1.566     albertel 10619:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   10620:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   10621:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   10622:     my $clonemsg;
                   10623:     my $can_clone = 0;
1.944     raeburn  10624:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  10625:     if ($lctype ne 'community') {
                   10626:         $lctype = 'course';
                   10627:     }
1.566     albertel 10628:     if ($clonehome eq 'no_host') {
1.944     raeburn  10629:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10630:             $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'});
                   10631:         } else {
                   10632:             $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'});
                   10633:         }     
1.566     albertel 10634:     } else {
                   10635: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  10636:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10637:             if ($clonedesc{'type'} ne 'Community') {
                   10638:                  $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'});
                   10639:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10640:             }
                   10641:         }
1.882     raeburn  10642: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   10643:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 10644: 	    $can_clone = 1;
                   10645: 	} else {
                   10646: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   10647: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   10648: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  10649:             if (grep(/^\*$/,@cloners)) {
                   10650:                 $can_clone = 1;
                   10651:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   10652:                 $can_clone = 1;
                   10653:             } else {
1.908     raeburn  10654:                 my $ccrole = 'cc';
1.944     raeburn  10655:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10656:                     $ccrole = 'co';
                   10657:                 }
1.578     raeburn  10658: 	        my %roleshash =
                   10659: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   10660: 					 $args->{'ccdomain'},
1.908     raeburn  10661:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  10662: 					 [$args->{'clonedomain'}]);
1.908     raeburn  10663: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  10664:                     $can_clone = 1;
                   10665:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   10666:                     $can_clone = 1;
                   10667:                 } else {
1.944     raeburn  10668:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  10669:                         $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'});
                   10670:                     } else {
                   10671:                         $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'});
                   10672:                     }
1.578     raeburn  10673: 	        }
1.566     albertel 10674: 	    }
1.578     raeburn  10675:         }
1.566     albertel 10676:     }
                   10677:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10678: }
                   10679: 
1.444     albertel 10680: sub construct_course {
1.885     raeburn  10681:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 10682:     my $outcome;
1.541     raeburn  10683:     my $linefeed =  '<br />'."\n";
                   10684:     if ($context eq 'auto') {
                   10685:         $linefeed = "\n";
                   10686:     }
1.566     albertel 10687: 
                   10688: #
                   10689: # Are we cloning?
                   10690: #
                   10691:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   10692:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  10693: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 10694: 	if ($context ne 'auto') {
1.578     raeburn  10695:             if ($clonemsg ne '') {
                   10696: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   10697:             }
1.566     albertel 10698: 	}
                   10699: 	$outcome .= $clonemsg.$linefeed;
                   10700: 
                   10701:         if (!$can_clone) {
                   10702: 	    return (0,$outcome);
                   10703: 	}
                   10704:     }
                   10705: 
1.444     albertel 10706: #
                   10707: # Open course
                   10708: #
                   10709:     my $crstype = lc($args->{'crstype'});
                   10710:     my %cenv=();
                   10711:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   10712:                                              $args->{'cdescr'},
                   10713:                                              $args->{'curl'},
                   10714:                                              $args->{'course_home'},
                   10715:                                              $args->{'nonstandard'},
                   10716:                                              $args->{'crscode'},
                   10717:                                              $args->{'ccuname'}.':'.
                   10718:                                              $args->{'ccdomain'},
1.882     raeburn  10719:                                              $args->{'crstype'},
1.885     raeburn  10720:                                              $cnum,$context,$category);
1.444     albertel 10721: 
                   10722:     # Note: The testing routines depend on this being output; see 
                   10723:     # Utils::Course. This needs to at least be output as a comment
                   10724:     # if anyone ever decides to not show this, and Utils::Course::new
                   10725:     # will need to be suitably modified.
1.541     raeburn  10726:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  10727:     if ($$courseid =~ /^error:/) {
                   10728:         return (0,$outcome);
                   10729:     }
                   10730: 
1.444     albertel 10731: #
                   10732: # Check if created correctly
                   10733: #
1.479     albertel 10734:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 10735:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  10736:     if ($crsuhome eq 'no_host') {
                   10737:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   10738:         return (0,$outcome);
                   10739:     }
1.541     raeburn  10740:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 10741: 
1.444     albertel 10742: #
1.566     albertel 10743: # Do the cloning
                   10744: #   
                   10745:     if ($can_clone && $cloneid) {
                   10746: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   10747: 	if ($context ne 'auto') {
                   10748: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   10749: 	}
                   10750: 	$outcome .= $clonemsg.$linefeed;
                   10751: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 10752: # Copy all files
1.637     www      10753: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 10754: # Restore URL
1.566     albertel 10755: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 10756: # Restore title
1.566     albertel 10757: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  10758: # Restore creation date, creator and creation context.
                   10759:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   10760:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   10761:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 10762: # Mark as cloned
1.566     albertel 10763: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      10764: # Need to clone grading mode
                   10765:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   10766:         $cenv{'grading'}=$newenv{'grading'};
                   10767: # Do not clone these environment entries
                   10768:         &Apache::lonnet::del('environment',
                   10769:                   ['default_enrollment_start_date',
                   10770:                    'default_enrollment_end_date',
                   10771:                    'question.email',
                   10772:                    'policy.email',
                   10773:                    'comment.email',
                   10774:                    'pch.users.denied',
1.725     raeburn  10775:                    'plc.users.denied',
                   10776:                    'hidefromcat',
                   10777:                    'categories'],
1.638     www      10778:                    $$crsudom,$$crsunum);
1.444     albertel 10779:     }
1.566     albertel 10780: 
1.444     albertel 10781: #
                   10782: # Set environment (will override cloned, if existing)
                   10783: #
                   10784:     my @sections = ();
                   10785:     my @xlists = ();
                   10786:     if ($args->{'crstype'}) {
                   10787:         $cenv{'type'}=$args->{'crstype'};
                   10788:     }
                   10789:     if ($args->{'crsid'}) {
                   10790:         $cenv{'courseid'}=$args->{'crsid'};
                   10791:     }
                   10792:     if ($args->{'crscode'}) {
                   10793:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   10794:     }
                   10795:     if ($args->{'crsquota'} ne '') {
                   10796:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   10797:     } else {
                   10798:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   10799:     }
                   10800:     if ($args->{'ccuname'}) {
                   10801:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   10802:                                         ':'.$args->{'ccdomain'};
                   10803:     } else {
                   10804:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   10805:     }
                   10806:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   10807:     if ($args->{'crssections'}) {
                   10808:         $cenv{'internal.sectionnums'} = '';
                   10809:         if ($args->{'crssections'} =~ m/,/) {
                   10810:             @sections = split/,/,$args->{'crssections'};
                   10811:         } else {
                   10812:             $sections[0] = $args->{'crssections'};
                   10813:         }
                   10814:         if (@sections > 0) {
                   10815:             foreach my $item (@sections) {
                   10816:                 my ($sec,$gp) = split/:/,$item;
                   10817:                 my $class = $args->{'crscode'}.$sec;
                   10818:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   10819:                 $cenv{'internal.sectionnums'} .= $item.',';
                   10820:                 unless ($addcheck eq 'ok') {
                   10821:                     push @badclasses, $class;
                   10822:                 }
                   10823:             }
                   10824:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   10825:         }
                   10826:     }
                   10827: # do not hide course coordinator from staff listing, 
                   10828: # even if privileged
                   10829:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10830: # add crosslistings
                   10831:     if ($args->{'crsxlist'}) {
                   10832:         $cenv{'internal.crosslistings'}='';
                   10833:         if ($args->{'crsxlist'} =~ m/,/) {
                   10834:             @xlists = split/,/,$args->{'crsxlist'};
                   10835:         } else {
                   10836:             $xlists[0] = $args->{'crsxlist'};
                   10837:         }
                   10838:         if (@xlists > 0) {
                   10839:             foreach my $item (@xlists) {
                   10840:                 my ($xl,$gp) = split/:/,$item;
                   10841:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   10842:                 $cenv{'internal.crosslistings'} .= $item.',';
                   10843:                 unless ($addcheck eq 'ok') {
                   10844:                     push @badclasses, $xl;
                   10845:                 }
                   10846:             }
                   10847:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   10848:         }
                   10849:     }
                   10850:     if ($args->{'autoadds'}) {
                   10851:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   10852:     }
                   10853:     if ($args->{'autodrops'}) {
                   10854:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   10855:     }
                   10856: # check for notification of enrollment changes
                   10857:     my @notified = ();
                   10858:     if ($args->{'notify_owner'}) {
                   10859:         if ($args->{'ccuname'} ne '') {
                   10860:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   10861:         }
                   10862:     }
                   10863:     if ($args->{'notify_dc'}) {
                   10864:         if ($uname ne '') { 
1.630     raeburn  10865:             push(@notified,$uname.':'.$udom);
1.444     albertel 10866:         }
                   10867:     }
                   10868:     if (@notified > 0) {
                   10869:         my $notifylist;
                   10870:         if (@notified > 1) {
                   10871:             $notifylist = join(',',@notified);
                   10872:         } else {
                   10873:             $notifylist = $notified[0];
                   10874:         }
                   10875:         $cenv{'internal.notifylist'} = $notifylist;
                   10876:     }
                   10877:     if (@badclasses > 0) {
                   10878:         my %lt=&Apache::lonlocal::texthash(
                   10879:                 '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',
                   10880:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   10881:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   10882:         );
1.541     raeburn  10883:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   10884:                            ' ('.$lt{'adby'}.')';
                   10885:         if ($context eq 'auto') {
                   10886:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 10887:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  10888:             foreach my $item (@badclasses) {
                   10889:                 if ($context eq 'auto') {
                   10890:                     $outcome .= " - $item\n";
                   10891:                 } else {
                   10892:                     $outcome .= "<li>$item</li>\n";
                   10893:                 }
                   10894:             }
                   10895:             if ($context eq 'auto') {
                   10896:                 $outcome .= $linefeed;
                   10897:             } else {
1.566     albertel 10898:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  10899:             }
                   10900:         } 
1.444     albertel 10901:     }
                   10902:     if ($args->{'no_end_date'}) {
                   10903:         $args->{'endaccess'} = 0;
                   10904:     }
                   10905:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   10906:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   10907:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   10908:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   10909:     if ($args->{'showphotos'}) {
                   10910:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   10911:     }
                   10912:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   10913:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   10914:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   10915:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  10916:             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'); 
                   10917:             if ($context eq 'auto') {
                   10918:                 $outcome .= $krb_msg;
                   10919:             } else {
1.566     albertel 10920:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  10921:             }
                   10922:             $outcome .= $linefeed;
1.444     albertel 10923:         }
                   10924:     }
                   10925:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   10926:        if ($args->{'setpolicy'}) {
                   10927:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10928:        }
                   10929:        if ($args->{'setcontent'}) {
                   10930:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   10931:        }
                   10932:     }
                   10933:     if ($args->{'reshome'}) {
                   10934: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   10935: 	$cenv{'reshome'}=~s/\/+$/\//;
                   10936:     }
                   10937: #
                   10938: # course has keyed access
                   10939: #
                   10940:     if ($args->{'setkeys'}) {
                   10941:        $cenv{'keyaccess'}='yes';
                   10942:     }
                   10943: # if specified, key authority is not course, but user
                   10944: # only active if keyaccess is yes
                   10945:     if ($args->{'keyauth'}) {
1.487     albertel 10946: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   10947: 	$user = &LONCAPA::clean_username($user);
                   10948: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     10949: 	if ($user ne '' && $domain ne '') {
1.487     albertel 10950: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 10951: 	}
                   10952:     }
                   10953: 
                   10954:     if ($args->{'disresdis'}) {
                   10955:         $cenv{'pch.roles.denied'}='st';
                   10956:     }
                   10957:     if ($args->{'disablechat'}) {
                   10958:         $cenv{'plc.roles.denied'}='st';
                   10959:     }
                   10960: 
                   10961:     # Record we've not yet viewed the Course Initialization Helper for this 
                   10962:     # course
                   10963:     $cenv{'course.helper.not.run'} = 1;
                   10964:     #
                   10965:     # Use new Randomseed
                   10966:     #
                   10967:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   10968:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   10969:     #
                   10970:     # The encryption code and receipt prefix for this course
                   10971:     #
                   10972:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   10973:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   10974:     #
                   10975:     # By default, use standard grading
                   10976:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   10977: 
1.541     raeburn  10978:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   10979:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 10980: #
                   10981: # Open all assignments
                   10982: #
                   10983:     if ($args->{'openall'}) {
                   10984:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   10985:        my %storecontent = ($storeunder         => time,
                   10986:                            $storeunder.'.type' => 'date_start');
                   10987:        
                   10988:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  10989:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 10990:    }
                   10991: #
                   10992: # Set first page
                   10993: #
                   10994:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   10995: 	    || ($cloneid)) {
1.445     albertel 10996: 	use LONCAPA::map;
1.444     albertel 10997: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 10998: 
                   10999: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   11000:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   11001: 
1.444     albertel 11002:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   11003:         my $title; my $url;
                   11004:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   11005: 	    $title=&mt('Syllabus');
1.444     albertel 11006:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   11007:         } else {
1.963     raeburn  11008:             $title=&mt('Table of Contents');
1.444     albertel 11009:             $url='/adm/navmaps';
                   11010:         }
1.445     albertel 11011: 
                   11012:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   11013: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   11014: 
                   11015: 	if ($errtext) { $fatal=2; }
1.541     raeburn  11016:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 11017:     }
1.566     albertel 11018: 
                   11019:     return (1,$outcome);
1.444     albertel 11020: }
                   11021: 
                   11022: ############################################################
                   11023: ############################################################
                   11024: 
1.953     droeschl 11025: #SD
                   11026: # only Community and Course, or anything else?
1.378     raeburn  11027: sub course_type {
                   11028:     my ($cid) = @_;
                   11029:     if (!defined($cid)) {
                   11030:         $cid = $env{'request.course.id'};
                   11031:     }
1.404     albertel 11032:     if (defined($env{'course.'.$cid.'.type'})) {
                   11033:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  11034:     } else {
                   11035:         return 'Course';
1.377     raeburn  11036:     }
                   11037: }
1.156     albertel 11038: 
1.406     raeburn  11039: sub group_term {
                   11040:     my $crstype = &course_type();
                   11041:     my %names = (
                   11042:                   'Course' => 'group',
1.865     raeburn  11043:                   'Community' => 'group',
1.406     raeburn  11044:                 );
                   11045:     return $names{$crstype};
                   11046: }
                   11047: 
1.902     raeburn  11048: sub course_types {
                   11049:     my @types = ('official','unofficial','community');
                   11050:     my %typename = (
                   11051:                          official   => 'Official course',
                   11052:                          unofficial => 'Unofficial course',
                   11053:                          community  => 'Community',
                   11054:                    );
                   11055:     return (\@types,\%typename);
                   11056: }
                   11057: 
1.156     albertel 11058: sub icon {
                   11059:     my ($file)=@_;
1.505     albertel 11060:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 11061:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 11062:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 11063:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   11064: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   11065: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11066: 	            $curfext.".gif") {
                   11067: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   11068: 		$curfext.".gif";
                   11069: 	}
                   11070:     }
1.249     albertel 11071:     return &lonhttpdurl($iconname);
1.154     albertel 11072: } 
1.84      albertel 11073: 
1.575     albertel 11074: sub lonhttpdurl {
1.692     www      11075: #
                   11076: # Had been used for "small fry" static images on separate port 8080.
                   11077: # Modify here if lightweight http functionality desired again.
                   11078: # Currently eliminated due to increasing firewall issues.
                   11079: #
1.575     albertel 11080:     my ($url)=@_;
1.692     www      11081:     return $url;
1.215     albertel 11082: }
                   11083: 
1.213     albertel 11084: sub connection_aborted {
                   11085:     my ($r)=@_;
                   11086:     $r->print(" ");$r->rflush();
                   11087:     my $c = $r->connection;
                   11088:     return $c->aborted();
                   11089: }
                   11090: 
1.221     foxr     11091: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     11092: #    strings as 'strings'.
                   11093: sub escape_single {
1.221     foxr     11094:     my ($input) = @_;
1.223     albertel 11095:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     11096:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   11097:     return $input;
                   11098: }
1.223     albertel 11099: 
1.222     foxr     11100: #  Same as escape_single, but escape's "'s  This 
                   11101: #  can be used for  "strings"
                   11102: sub escape_double {
                   11103:     my ($input) = @_;
                   11104:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   11105:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   11106:     return $input;
                   11107: }
1.223     albertel 11108:  
1.222     foxr     11109: #   Escapes the last element of a full URL.
                   11110: sub escape_url {
                   11111:     my ($url)   = @_;
1.238     raeburn  11112:     my @urlslices = split(/\//, $url,-1);
1.369     www      11113:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 11114:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     11115: }
1.462     albertel 11116: 
1.820     raeburn  11117: sub compare_arrays {
                   11118:     my ($arrayref1,$arrayref2) = @_;
                   11119:     my (@difference,%count);
                   11120:     @difference = ();
                   11121:     %count = ();
                   11122:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   11123:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   11124:         foreach my $element (keys(%count)) {
                   11125:             if ($count{$element} == 1) {
                   11126:                 push(@difference,$element);
                   11127:             }
                   11128:         }
                   11129:     }
                   11130:     return @difference;
                   11131: }
                   11132: 
1.817     bisitz   11133: # -------------------------------------------------------- Initialize user login
1.462     albertel 11134: sub init_user_environment {
1.463     albertel 11135:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 11136:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   11137: 
                   11138:     my $public=($username eq 'public' && $domain eq 'public');
                   11139: 
                   11140: # See if old ID present, if so, remove
                   11141: 
                   11142:     my ($filename,$cookie,$userroles);
                   11143:     my $now=time;
                   11144: 
                   11145:     if ($public) {
                   11146: 	my $max_public=100;
                   11147: 	my $oldest;
                   11148: 	my $oldest_time=0;
                   11149: 	for(my $next=1;$next<=$max_public;$next++) {
                   11150: 	    if (-e $lonids."/publicuser_$next.id") {
                   11151: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   11152: 		if ($mtime<$oldest_time || !$oldest_time) {
                   11153: 		    $oldest_time=$mtime;
                   11154: 		    $oldest=$next;
                   11155: 		}
                   11156: 	    } else {
                   11157: 		$cookie="publicuser_$next";
                   11158: 		last;
                   11159: 	    }
                   11160: 	}
                   11161: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   11162:     } else {
1.463     albertel 11163: 	# if this isn't a robot, kill any existing non-robot sessions
                   11164: 	if (!$args->{'robot'}) {
                   11165: 	    opendir(DIR,$lonids);
                   11166: 	    while ($filename=readdir(DIR)) {
                   11167: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   11168: 		    unlink($lonids.'/'.$filename);
                   11169: 		}
1.462     albertel 11170: 	    }
1.463     albertel 11171: 	    closedir(DIR);
1.462     albertel 11172: 	}
                   11173: # Give them a new cookie
1.463     albertel 11174: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      11175: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 11176: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 11177:     
                   11178: # Initialize roles
                   11179: 
                   11180: 	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
                   11181:     }
                   11182: # ------------------------------------ Check browser type and MathML capability
                   11183: 
                   11184:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   11185:         $clientunicode,$clientos) = &decode_user_agent($r);
                   11186: 
                   11187: # ------------------------------------------------------------- Get environment
                   11188: 
                   11189:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   11190:     my ($tmp) = keys(%userenv);
                   11191:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   11192:     } else {
                   11193: 	undef(%userenv);
                   11194:     }
                   11195:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   11196: 	$form->{'interface'}=$userenv{'interface'};
                   11197:     }
                   11198:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   11199: 
                   11200: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   11201:     foreach my $option ('interface','localpath','localres') {
                   11202:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 11203:     }
                   11204: # --------------------------------------------------------- Write first profile
                   11205: 
                   11206:     {
                   11207: 	my %initial_env = 
                   11208: 	    ("user.name"          => $username,
                   11209: 	     "user.domain"        => $domain,
                   11210: 	     "user.home"          => $authhost,
                   11211: 	     "browser.type"       => $clientbrowser,
                   11212: 	     "browser.version"    => $clientversion,
                   11213: 	     "browser.mathml"     => $clientmathml,
                   11214: 	     "browser.unicode"    => $clientunicode,
                   11215: 	     "browser.os"         => $clientos,
                   11216: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   11217: 	     "request.course.fn"  => '',
                   11218: 	     "request.course.uri" => '',
                   11219: 	     "request.course.sec" => '',
                   11220: 	     "request.role"       => 'cm',
                   11221: 	     "request.role.adv"   => $env{'user.adv'},
                   11222: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   11223: 
                   11224:         if ($form->{'localpath'}) {
                   11225: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   11226: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   11227:         }
                   11228: 	
                   11229: 	if ($form->{'interface'}) {
                   11230: 	    $form->{'interface'}=~s/\W//gs;
                   11231: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   11232: 	    $env{'browser.interface'}=$form->{'interface'};
                   11233: 	}
                   11234: 
1.981     raeburn  11235:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.980     raeburn  11236:         my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   11237: 
1.724     raeburn  11238:         foreach my $tool ('aboutme','blog','portfolio') {
                   11239:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  11240:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   11241:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  11242:         }
                   11243: 
1.864     raeburn  11244:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  11245:             $userenv{'canrequest.'.$crstype} =
                   11246:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  11247:                                                   'reload','requestcourses',
                   11248:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  11249:         }
                   11250: 
1.462     albertel 11251: 	$env{'user.environment'} = "$lonids/$cookie.id";
                   11252: 	
                   11253: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   11254: 		 &GDBM_WRCREAT(),0640)) {
                   11255: 	    &_add_to_env(\%disk_env,\%initial_env);
                   11256: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   11257: 	    &_add_to_env(\%disk_env,$userroles);
1.463     albertel 11258: 	    if (ref($args->{'extra_env'})) {
                   11259: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   11260: 	    }
1.462     albertel 11261: 	    untie(%disk_env);
                   11262: 	} else {
1.705     tempelho 11263: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   11264: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 11265: 	    return 'error: '.$!;
                   11266: 	}
                   11267:     }
                   11268:     $env{'request.role'}='cm';
                   11269:     $env{'request.role.adv'}=$env{'user.adv'};
                   11270:     $env{'browser.type'}=$clientbrowser;
                   11271: 
                   11272:     return $cookie;
                   11273: 
                   11274: }
                   11275: 
                   11276: sub _add_to_env {
                   11277:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  11278:     if (ref($env_data) eq 'HASH') {
                   11279:         while (my ($key,$value) = each(%$env_data)) {
                   11280: 	    $idf->{$prefix.$key} = $value;
                   11281: 	    $env{$prefix.$key}   = $value;
                   11282:         }
1.462     albertel 11283:     }
                   11284: }
                   11285: 
1.685     tempelho 11286: # --- Get the symbolic name of a problem and the url
                   11287: sub get_symb {
                   11288:     my ($request,$silent) = @_;
1.726     raeburn  11289:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 11290:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   11291:     if ($symb eq '') {
                   11292:         if (!$silent) {
                   11293:             $request->print("Unable to handle ambiguous references:$url:.");
                   11294:             return ();
                   11295:         }
                   11296:     }
                   11297:     &Apache::lonenc::check_decrypt(\$symb);
                   11298:     return ($symb);
                   11299: }
                   11300: 
                   11301: # --------------------------------------------------------------Get annotation
                   11302: 
                   11303: sub get_annotation {
                   11304:     my ($symb,$enc) = @_;
                   11305: 
                   11306:     my $key = $symb;
                   11307:     if (!$enc) {
                   11308:         $key =
                   11309:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   11310:     }
                   11311:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   11312:     return $annotation{$key};
                   11313: }
                   11314: 
                   11315: sub clean_symb {
1.731     raeburn  11316:     my ($symb,$delete_enc) = @_;
1.685     tempelho 11317: 
                   11318:     &Apache::lonenc::check_decrypt(\$symb);
                   11319:     my $enc = $env{'request.enc'};
1.731     raeburn  11320:     if ($delete_enc) {
1.730     raeburn  11321:         delete($env{'request.enc'});
                   11322:     }
1.685     tempelho 11323: 
                   11324:     return ($symb,$enc);
                   11325: }
1.462     albertel 11326: 
1.990     raeburn  11327: sub build_release_hashes {
                   11328:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   11329:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   11330:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   11331:                   (ref($randomizetry) eq 'HASH'));
                   11332:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   11333:         my ($item,$name,$value) = split(/:/,$key);
                   11334:         if ($item eq 'parameter') {
                   11335:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   11336:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   11337:                     push(@{$checkparms->{$name}},$value);
                   11338:                 }
                   11339:             } else {
                   11340:                 push(@{$checkparms->{$name}},$value);
                   11341:             }
                   11342:         } elsif ($item eq 'resourcetag') {
                   11343:             if ($name eq 'responsetype') {
                   11344:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   11345:             }
                   11346:         } elsif ($item eq 'course') {
                   11347:             if ($name eq 'crstype') {
                   11348:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   11349:             }
                   11350:         }
                   11351:     }
                   11352:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   11353:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   11354:     return;
                   11355: }
                   11356: 
1.41      ng       11357: =pod
                   11358: 
                   11359: =back
                   11360: 
1.112     bowersj2 11361: =cut
1.41      ng       11362: 
1.112     bowersj2 11363: 1;
                   11364: __END__;
1.41      ng       11365: 

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